Upgrade/hack Pattern

mxxun/ghc-9.2
mrkun 2022-01-30 23:45:23 +03:00
parent 4b4629289a
commit c201bdda16
3 changed files with 8 additions and 8 deletions

View File

@ -103,9 +103,9 @@ briDocByExactNoComment ast = do
briDocByExactInlineOnly briDocByExactInlineOnly
:: ::
-- (ExactPrint.Annotate.Annotate ast) -- (ExactPrint.Annotate.Annotate ast)
(Data ast, ExactPrint.ExactPrint ast) (Data ast, ExactPrint.ExactPrint (LocatedAn an ast), Data an)
=> String => String
-> Located ast -> LocatedAn an ast
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
briDocByExactInlineOnly infoStr ast = do briDocByExactInlineOnly infoStr ast = do
-- anns <- mAsk -- anns <- mAsk
@ -781,7 +781,7 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
unknownNodeError unknownNodeError
:: Data.Data.Data ast :: Data.Data.Data ast
=> String => String
-> GenLocated GHC.SrcSpan ast -> LocatedAn an ast
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do unknownNodeError infoStr ast = do
mTell [ErrorUnknownNode infoStr ast] mTell [ErrorUnknownNode infoStr ast]

View File

@ -57,7 +57,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- x1' <- docSeq [docLit $ Text.pack "(", return x1] -- x1' <- docSeq [docLit $ Text.pack "(", return x1]
-- xN' <- docSeq [return xN, docLit $ Text.pack ")"] -- xN' <- docSeq [return xN, docLit $ Text.pack ")"]
-- return $ (x1' Seq.<| middle) Seq.|> xN' -- return $ (x1' Seq.<| middle) Seq.|> xN'
ConPat _ lname (PrefixCon args) -> do ConPat _ lname (PrefixCon _tyargs args) -> do
-- Abc a b c -> expr -- Abc a b c -> expr
nameDoc <- lrdrNameToTextAnn lname nameDoc <- lrdrNameToTextAnn lname
argDocs <- layoutPat `mapM` args argDocs <- layoutPat `mapM` args
@ -84,7 +84,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- Abc { a = locA, b = locB, c = locC } -> expr1 -- Abc { a = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2 -- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField _ (L _ fieldOcc) fPat pun)) -> do
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
@ -111,7 +111,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
| dotdoti == length fs -> do | dotdoti == length fs -> do
-- Abc { a = locA, .. } -- Abc { a = locA, .. }
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField _ (L _ fieldOcc) fPat pun)) -> do
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
@ -171,7 +171,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
wrapPatPrepend pat1 (docLit $ Text.pack "~") wrapPatPrepend pat1 (docLit $ Text.pack "~")
NPat _ llit@(L _ ol) mNegative _ -> do NPat _ llit@(L _ ol) mNegative _ -> do
-- -13 -> expr -- -13 -> expr
litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol litDoc <- docWrapNode (reLocA llit) $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
negDoc <- docLit $ Text.pack "-" negDoc <- docLit $ Text.pack "-"
pure $ case mNegative of pure $ case mNegative of
Just{} -> Seq.fromList [negDoc, litDoc] Just{} -> Seq.fromList [negDoc, litDoc]

View File

@ -145,7 +145,7 @@ data BrittanyError
-- output and second the corresponding, ill-formed input. -- output and second the corresponding, ill-formed input.
| LayoutWarning String | LayoutWarning String
-- ^ some warning -- ^ some warning
| forall ast . Data.Data.Data ast => ErrorUnknownNode String (GenLocated SrcSpan ast) | forall ast an. Data.Data.Data ast => ErrorUnknownNode String (LocatedAn an ast)
-- ^ internal error: pretty-printing is not implemented for type of node -- ^ internal error: pretty-printing is not implemented for type of node
-- in the syntax-tree -- in the syntax-tree
| ErrorOutputCheck | ErrorOutputCheck