Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

12 changed files:

Changes:

  • compiler/GHC/Hs/Dump.hs
    ... ... @@ -69,6 +69,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    69 69 
                   `extQ` annotationAnnList
    70 70 
                   `extQ` annotationAnnListWhere
    71 71 
                   `extQ` annotationAnnListCommas
    72 
    +              `extQ` annotationAnnListEpaLocation
    72 73 
                   `extQ` annotationNoEpAnns
    73 74 
                   `extQ` annotationExprBracket
    74 75 
                   `extQ` annotationTypedBracket
    ... ... @@ -375,6 +376,12 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    375 376 
                 annotationAnnListCommas :: EpAnn (AnnList [EpToken ","]) -> SDoc
    376 377 
                 annotationAnnListCommas = annotation' (text "EpAnn (AnnList [EpToken \",\"])")
    377 378
    379 
    +            annotationAnnListEpaLocation :: AnnList EpaLocation -> SDoc
    380 
    +            annotationAnnListEpaLocation anns = case ba of
    381 
    +             BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList EpaLocation")
    382 
    +             NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns))
    383 
    +                                               $$ vcat (gmapQ showAstData' anns)
    384 
    +
    378 385 
                 annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc
    379 386 
                 annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns")
    380 387

  • compiler/GHC/Hs/Expr.hs
    ... ... @@ -535,9 +535,6 @@ type instance XPragE (GhcPass _) = NoExtField
    535 535
    536 536 
     type instance XFunRhs  = AnnFunRhs
    537 537
    538 
    -type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr)))))] = SrcSpanAnnLW
    539 
    -type instance Anno (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))) = SrcSpanAnnA
    540 
    -
    541 538 
     mkHsVar :: forall p. IsPass p => LIdP (GhcPass p) -> HsExpr (GhcPass p)
    542 539 
     mkHsVar n = HsVar noExtField $
    543 540 
       case ghcPass @p of
    ... ... @@ -2648,8 +2645,8 @@ instance UnXRec p => Outputable (DotFieldOcc p) where
    2648 2645
    2649 2646 
     type instance Anno (HsExpr (GhcPass p)) = SrcSpanAnnA
    2650 2647 
     type instance Anno [LocatedA (HsExpr (GhcPass p))] = SrcSpanAnnA
    2651 
    -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnLW
    2652 
    -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnLW
    2648 
    +type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnA
    2649 
    +type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnA
    2653 2650
    2654 2651 
     type instance Anno (HsCmd (GhcPass p)) = SrcSpanAnnA
    2655 2652
    ... ... @@ -2665,7 +2662,7 @@ type instance Anno (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr
    2665 2662
    2666 2663 
     type instance Anno (HsUntypedSplice (GhcPass p)) = SrcSpanAnnA
    2667 2664
    2668 
    -type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr))))] = SrcSpanAnnLW
    2665 
    +type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr))))] = SrcSpanAnnA
    2669 2666
    2670 2667 
     type instance Anno (FieldLabelStrings (GhcPass p)) = EpAnnCO
    2671 2668 
     type instance Anno FieldLabelString                = SrcSpanAnnN

  • compiler/GHC/Hs/Utils.hs
    ... ... @@ -320,8 +320,8 @@ nlParPat p = noLocA (gParPat p)
    320 320 
     mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs
    321 321 
     mkHsFractional :: FractionalLit -> HsOverLit GhcPs
    322 322 
     mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs
    323 
    -mkHsDo         :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> HsExpr GhcPs
    324 
    -mkHsDoAnns     :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> AnnList EpaLocation -> HsExpr GhcPs
    323 
    +mkHsDo         :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> HsExpr GhcPs
    324 
    +mkHsDoAnns     :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> AnnList EpaLocation -> HsExpr GhcPs
    325 325 
     mkHsComp       :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
    326 326 
                    -> HsExpr GhcPs
    327 327 
     mkHsCompAnns   :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
    ... ... @@ -349,12 +349,12 @@ mkTcBindStmt :: LPat GhcTc -> LocatedA (bodyR GhcTc)
    349 349 
     emptyRecStmt     :: (Anno [GenLocated
    350 350 
                                  (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
    351 351 
                                  (StmtLR (GhcPass idL) GhcPs bodyR)]
    352 
    -                        ~ SrcSpanAnnLW)
    352 
    +                        ~ SrcSpanAnnA)
    353 353 
                      => StmtLR (GhcPass idL) GhcPs bodyR
    354 354 
     emptyRecStmtName :: (Anno [GenLocated
    355 355 
                                  (Anno (StmtLR GhcRn GhcRn bodyR))
    356 356 
                                  (StmtLR GhcRn GhcRn bodyR)]
    357 
    -                        ~ SrcSpanAnnLW)
    357 
    +                        ~ SrcSpanAnnA)
    358 358 
                      => StmtLR GhcRn GhcRn bodyR
    359 359 
     emptyRecStmtId   :: Stmt GhcTc (LocatedA (HsCmd GhcTc))
    360 360
    ... ... @@ -362,9 +362,9 @@ mkRecStmt :: forall (idL :: Pass) bodyR.
    362 362 
                         (Anno [GenLocated
    363 363 
                                  (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
    364 364 
                                  (StmtLR (GhcPass idL) GhcPs bodyR)]
    365 
    -                        ~ SrcSpanAnnLW)
    365 
    +                        ~ SrcSpanAnnA)
    366 366 
                      => AnnList (EpToken "rec")
    367 
    -                 -> LocatedLW [LStmtLR (GhcPass idL) GhcPs bodyR]
    367 
    +                 -> LocatedA [LStmtLR (GhcPass idL) GhcPs bodyR]
    368 368 
                      -> StmtLR (GhcPass idL) GhcPs bodyR
    369 369 
     mkRecStmt anns stmts  = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)
    370 370 
                                  { recS_stmts = stmts }

  • compiler/GHC/Parser.y
    ... ... @@ -3144,15 +3144,17 @@ aexp :: { ECP }
    3144 3144 
                                           return $ ECP $
    3145 3145 
                                             $2 >>= \ $2 ->
    3146 3146 
                                             mkHsDoPV (comb2 $1 $2)
    3147 
    +                                                 (stmtlistAnns $2)
    3147 3148 
                                                      (fmap mkModuleNameFS (getDO $1))
    3148 
    -                                                 $2
    3149 
    +                                                 (stmtlistStmts $2)
    3149 3150 
                                                      (glR $1)
    3150 3151 
                                                      (glR $2) }
    3151 3152 
             | MDO stmtlist             {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 ->
    3152 3153 
                                            fmap ecpFromExp $
    3153 3154 
                                            amsA' (L (comb2 $1 $2)
    3154 
    -                                              (mkMDo (MDoExpr $ fmap mkModuleNameFS (getMDO $1))
    3155 
    -                                                     $2
    3155 
    +                                              (mkMDo (stmtlistAnns $2)
    3156 
    +                                                     (MDoExpr $ fmap mkModuleNameFS (getMDO $1))
    3157 
    +                                                     (stmtlistStmts $2)
    3156 3158 
                                                          (glR $1)
    3157 3159 
                                                          (glR $2))) }
    3158 3160 
             | 'proc' aexp '->' exp
    ... ... @@ -3648,11 +3650,11 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) }
    3648 3650 
     -----------------------------------------------------------------------------
    3649 3651 
     -- Statement sequences
    3650 3652
    3651 
    -stmtlist :: { forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))]) }
    3653 
    +stmtlist :: { forall b. DisambECP b => PV (LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), Located [LocatedA (Stmt GhcPs (LocatedA b))])) }
    3652 3654 
             : '{'           stmts '}'       { $2 >>= \ $2 ->
    3653 
    -                                          amsr (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) noAnn []) }
    3654 
    -        |     vocurly   stmts close     { $2 >>= \ $2 -> amsr
    3655 
    -                                          (L (stmtsLoc $2) (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) ListNone (fromOL $ fst $ unLoc $2) noAnn []) }
    3655 
    +                                          amsA' (sLL $1 $> ((epTok $1, fromOL $ fst $ unLoc $2, epTok $3), sL1 $2 $ reverse $ snd $ unLoc $2))}
    3656 
    +        |     vocurly   stmts close     { $2 >>= \ $2 ->
    3657 
    +                                          amsA' (L (stmtsLoc $2) ((NoEpTok, fromOL $ fst $ unLoc $2, NoEpTok), sL1 $2 $ reverse $ snd $ unLoc $2))}
    3656 3658
    3657 3659 
     --      do { ;; s ; s ; ; s ;; }
    3658 3660 
     -- The last Stmt should be an expression, but that's hard to enforce
    ... ... @@ -3694,7 +3696,8 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
    3694 3696 
     stmt  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
    3695 3697 
             : qual                          { $1 }
    3696 3698 
             | 'rec' stmtlist                {  $2 >>= \ $2 ->
    3697 
    -                                           amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) $2) $2) }
    3699 
    +                                           amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) (stmtlistAnns $2) $2)
    3700 
    +                                                                        (stmtlistStmts $2)) }
    3698 3701
    3699 3702 
     qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
    3700 3703 
         : bindpat '<-' exp                   { unECP $3 >>= \ $3 ->
    ... ... @@ -4717,9 +4720,9 @@ commentsPA la@(L l a) = do
    4717 4720 
       !cs <- getPriorCommentsFor (getLocA la)
    4718 4721 
       return (L (addCommentsToEpAnn l cs) a)
    4719 4722
    4720 
    -hsDoAnn :: EpToken "rec" -> LocatedAn t b -> AnnList (EpToken "rec")
    4721 
    -hsDoAnn tok (L ll _)
    4722 
    -  = AnnList (Just $ spanAsAnchor (locA ll)) ListNone [] tok []
    4723 
    +hsDoAnn :: EpToken "rec" -> (EpToken "{", [EpToken ";"], EpToken "}") -> LocatedAn t b -> AnnList (EpToken "rec")
    4724 
    +hsDoAnn rec (ob, semis, cb) (L ll _)
    4725 
    +  = AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis rec []
    4723 4726
    4724 4727 
     listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation
    4725 4728 
     listAsAnchorM [] = Nothing
    ... ... @@ -4745,6 +4748,17 @@ epExplicitBraces !t1 !t2 = EpExplicitBraces (epTok t1) (epTok t2)
    4745 4748
    4746 4749 
     -- -------------------------------------
    4747 4750
    4751 
    +stmtlistStmts :: LocatedA (a, Located [LocatedA (Stmt GhcPs (LocatedA b))])
    4752 
    +              -> LocatedA [LocatedA (Stmt GhcPs (LocatedA b))]
    4753 
    +stmtlistStmts (L la (_,L l stmts))
    4754 
    +  = L ((noAnnSrcSpan l) {comments = comments la}) stmts
    4755 
    +
    4756 
    +stmtlistAnns :: LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), a)
    4757 
    +             -> (EpToken "{", [EpToken ";"], EpToken "}")
    4758 
    +stmtlistAnns (L _ (an,_)) = an
    4759 
    +
    4760 
    +-- -------------------------------------
    4761 
    +
    4748 4762 
     addTrailingCommaFBind :: MonadP m => Fbind b -> EpToken "," -> m (Fbind b)
    4749 4763 
     addTrailingCommaFBind (Left b)  l = fmap Left  (addTrailingCommaA b l)
    4750 4764 
     addTrailingCommaFBind (Right b) l = fmap Right (addTrailingCommaA b l)

  • compiler/GHC/Parser/Annotation.hs
    ... ... @@ -28,10 +28,10 @@ module GHC.Parser.Annotation (
    28 28
    29 29 
       -- ** Annotations in 'GenLocated'
    30 30 
       LocatedA, LocatedN, LocatedAn, LocatedP,
    31 
    -  LocatedLC, LocatedLS, LocatedLW,
    31 
    +  LocatedLW,
    32 32 
       LocatedE, LocatedBF,
    33 33 
       SrcSpanAnnA, SrcSpanAnnP, SrcSpanAnnN,
    34 
    -  SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS,
    34 
    +  SrcSpanAnnLW,
    35 35 
       SrcSpanAnnBF,
    36 36
    37 37 
       -- ** Annotation data types used in 'GenLocated'
    ... ... @@ -432,18 +432,13 @@ emptyComments = EpaComments []
    432 432 
     type LocatedA = GenLocated SrcSpanAnnA
    433 433 
     type LocatedN = GenLocated SrcSpanAnnN
    434 434
    435 
    -type LocatedLC = GenLocated SrcSpanAnnLC
    436 
    -type LocatedLS = GenLocated SrcSpanAnnLS
    437 435 
     type LocatedLW = GenLocated SrcSpanAnnLW
    438 436 
     type LocatedP = GenLocated SrcSpanAnnP
    439 
    --- type LocatedC = GenLocated SrcSpanAnnC
    440 437 
     type LocatedBF = GenLocated SrcSpanAnnBF
    441 438
    442 439 
     type SrcSpanAnnA = EpAnn AnnListItem
    443 440 
     type SrcSpanAnnN = EpAnn NameAnn
    444 441
    445 
    -type SrcSpanAnnLC = EpAnn (AnnList [EpToken ","])
    446 
    -type SrcSpanAnnLS = EpAnn (AnnList ())
    447 442 
     type SrcSpanAnnLW = EpAnn (AnnList (EpToken "where"))
    448 443 
     type SrcSpanAnnP = EpAnn AnnPragma
    449 444 
     type SrcSpanAnnBF = EpAnn AnnBooleanFormula

  • compiler/GHC/Parser/PostProcess.hs
    ... ... @@ -436,9 +436,9 @@ mkRoleAnnotDecl loc tycon roles anns
    436 436 
                 addFatalError $ mkPlainErrorMsgEnvelope loc_role $
    437 437 
                   (PsErrIllegalRoleName role nearby)
    438 438
    439 
    -mkMDo :: HsDoFlavour -> LocatedLW [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs
    440 
    -mkMDo ctxt stmts tok loc
    441 
    -  = mkHsDoAnns ctxt stmts (AnnList (Just loc) ListNone [] tok [])
    439 
    +mkMDo :: (EpToken "{", [EpToken ";"], EpToken "}") -> HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs
    440 
    +mkMDo (ob, semis, cb) ctxt stmts tok loc
    441 
    +  = mkHsDoAnns ctxt stmts (AnnList (Just loc) (ListBraces ob cb) semis tok [])
    442 442
    443 443 
     -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to
    444 444 
     -- binders without annotations. Only accepts specified variables, and errors if
    ... ... @@ -1733,7 +1733,7 @@ type AnnoBody b
    1733 1733 
         , Anno (Match GhcPs (LocatedA (Body b GhcPs))) ~ SrcSpanAnnA
    1734 1734 
         , Anno (StmtLR GhcPs GhcPs (LocatedA (Body (Body b GhcPs) GhcPs))) ~ SrcSpanAnnA
    1735 1735 
         , Anno [LocatedA (StmtLR GhcPs GhcPs
    1736 
    -                       (LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnLW
    1736 
    +                       (LocatedA (Body (Body (Body b GhcPs) GhcPs) GhcPs)))] ~ SrcSpanAnnA
    1737 1737 
         )
    1738 1738
    1739 1739 
     -- | Disambiguate constructs that may appear when we do not know ahead of time whether we are
    ... ... @@ -1795,8 +1795,9 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
    1795 1795 
       -- | Disambiguate "do { ... }" (do notation)
    1796 1796 
       mkHsDoPV ::
    1797 1797 
         SrcSpan ->
    1798 
    +    (EpToken "{", [EpToken ";"], EpToken "}") ->
    1798 1799 
         Maybe ModuleName ->
    1799 
    -    LocatedLW [LStmt GhcPs (LocatedA b)] ->
    1800 
    +    LocatedA [LStmt GhcPs (LocatedA b)] ->
    1800 1801 
         EpaLocation -> -- Token
    1801 1802 
         EpaLocation -> -- Anchor
    1802 1803 
         PV (LocatedA b)
    ... ... @@ -1948,10 +1949,10 @@ instance DisambECP (HsCmd GhcPs) where
    1948 1949 
         checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b
    1949 1950 
         !cs <- getCommentsFor l
    1950 1951 
         return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)
    1951 
    -  mkHsDoPV l Nothing stmts tok_loc anc = do
    1952 
    +  mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do
    1952 1953 
         !cs <- getCommentsFor l
    1953 
    -    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) ListNone [] tok_loc []) stmts)
    1954 
    -  mkHsDoPV l (Just m)    _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
    1954 
    +    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis tok_loc []) stmts)
    1955 
    +  mkHsDoPV l _ (Just m) _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
    1955 1956 
       mkHsParPV l lpar c rpar = do
    1956 1957 
         !cs <- getCommentsFor l
    1957 1958 
         return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c)
    ... ... @@ -2047,9 +2048,9 @@ instance DisambECP (HsExpr GhcPs) where
    2047 2048 
         checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b
    2048 2049 
         !cs <- getCommentsFor l
    2049 2050 
         return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns)
    2050 
    -  mkHsDoPV l mod stmts loc_tok anc = do
    2051 
    +  mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do
    2051 2052 
         !cs <- getCommentsFor l
    2052 
    -    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) ListNone [] loc_tok []) (DoExpr mod) stmts)
    2053 
    +    return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) (ListBraces ob cb) semis loc_tok []) (DoExpr mod) stmts)
    2053 2054 
       mkHsParPV l lpar e rpar = do
    2054 2055 
         !cs <- getCommentsFor l
    2055 2056 
         return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
    ... ... @@ -2145,7 +2146,7 @@ instance DisambECP (PatBuilder GhcPs) where
    2145 2146 
         !cs <- getCommentsFor (locA l)
    2146 2147 
         return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t))
    2147 2148 
       mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat
    2148 
    -  mkHsDoPV l _ _ _ _    = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
    2149 
    +  mkHsDoPV l _ _ _ _ _   = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
    2149 2150 
       mkHsParPV l lpar p rpar   = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)
    2150 2151 
       mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v)
    2151 2152 
       mkHsLitPV lit@(L l a) = do

  • compiler/GHC/Parser/Types.hs
    ... ... @@ -110,7 +110,7 @@ instance Outputable DataConBuilder where
    110 110 
       ppr (InfixDataConBuilder lhs data_con rhs) =
    111 111 
         ppr lhs <+> ppr data_con <+> ppr rhs
    112 112
    113 
    -type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW
    113 
    +type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnA
    114 114
    115 115 
     data ExplicitNamespaceKeyword
    116 116 
       = ExplicitTypeNamespace !(EpToken "type")

  • compiler/GHC/Tc/Gen/Match.hs
    ... ... @@ -376,7 +376,7 @@ tcGRHSNE ctxt tc_body grhss res_ty
    376 376 
     -}
    377 377
    378 378 
     tcDoStmts :: HsDoFlavour
    379 
    -          -> LocatedLW [LStmt GhcRn (LHsExpr GhcRn)]
    379 
    +          -> LocatedA [LStmt GhcRn (LHsExpr GhcRn)]
    380 380 
               -> ExpRhoType
    381 381 
               -> TcM (HsExpr GhcTc)          -- Returns a HsDo
    382 382 
     tcDoStmts ListComp (L l stmts) res_ty

  • testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
    ... ... @@ -287,7 +287,9 @@
    287 287 
                      (AnnList
    288 288 
                       (Just
    289 289 
                        (EpaSpan { DumpParsedAstComments.hs:16:3 }))
    290 
    -                  (ListNone)
    290 
    +                  (ListBraces
    291 
    +                   (NoEpTok)
    292 
    +                   (NoEpTok))
    291 293 
                       []
    292 294 
                       (EpaSpan { DumpParsedAstComments.hs:14:7-8 })
    293 295 
                       [])
    ... ... @@ -296,12 +298,7 @@
    296 298 
                      (L
    297 299 
                       (EpAnn
    298 300 
                        (EpaSpan { DumpParsedAstComments.hs:16:3 })
    299 
    -                   (AnnList
    300 
    -                    (Just
    301 
    -                     (EpaSpan { DumpParsedAstComments.hs:16:3 }))
    302 
    -                    (ListNone)
    303 
    -                    []
    304 
    -                    (NoEpTok)
    301 
    +                   (AnnListItem
    305 302 
                         [])
    306 303 
                        (EpaComments
    307 304 
                         []))

  • testsuite/tests/parser/should_compile/DumpSemis.stderr
    ... ... @@ -337,7 +337,9 @@
    337 337 
                      (AnnList
    338 338 
                       (Just
    339 339 
                        (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
    340 
    -                  (ListNone)
    340 
    +                  (ListBraces
    341 
    +                   (NoEpTok)
    342 
    +                   (NoEpTok))
    341 343 
                       []
    342 344 
                       (EpaSpan { DumpSemis.hs:10:7-8 })
    343 345 
                       [])
    ... ... @@ -346,12 +348,7 @@
    346 348 
                      (L
    347 349 
                       (EpAnn
    348 350 
                        (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })
    349 
    -                   (AnnList
    350 
    -                    (Just
    351 
    -                     (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
    352 
    -                    (ListNone)
    353 
    -                    []
    354 
    -                    (NoEpTok)
    351 
    +                   (AnnListItem
    355 352 
                         [])
    356 353 
                        (EpaComments
    357 354 
                         []))
    ... ... @@ -375,30 +372,25 @@
    375 372 
                            (AnnList
    376 373 
                             (Just
    377 374 
                              (EpaSpan { DumpSemis.hs:11:6-15 }))
    378 
    -                        (ListNone)
    379 
    -                        []
    375 
    +                        (ListBraces
    376 
    +                         (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
    377 
    +                         (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
    378 
    +                        [(EpTok
    379 
    +                          (EpaSpan { DumpSemis.hs:11:8 }))
    380 
    +                        ,(EpTok
    381 
    +                          (EpaSpan { DumpSemis.hs:11:9 }))
    382 
    +                        ,(EpTok
    383 
    +                          (EpaSpan { DumpSemis.hs:11:10 }))
    384 
    +                        ,(EpTok
    385 
    +                          (EpaSpan { DumpSemis.hs:11:11 }))]
    380 386 
                             (EpaSpan { DumpSemis.hs:11:3-4 })
    381 387 
                             [])
    382 388 
                            (DoExpr
    383 389 
                             (Nothing))
    384 390 
                            (L
    385 391 
                             (EpAnn
    386 
    -                         (EpaSpan { DumpSemis.hs:11:6-15 })
    387 
    -                         (AnnList
    388 
    -                          (Just
    389 
    -                           (EpaSpan { DumpSemis.hs:11:8-13 }))
    390 
    -                          (ListBraces
    391 
    -                           (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
    392 
    -                           (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
    393 
    -                          [(EpTok
    394 
    -                            (EpaSpan { DumpSemis.hs:11:8 }))
    395 
    -                          ,(EpTok
    396 
    -                            (EpaSpan { DumpSemis.hs:11:9 }))
    397 
    -                          ,(EpTok
    398 
    -                            (EpaSpan { DumpSemis.hs:11:10 }))
    399 
    -                          ,(EpTok
    400 
    -                            (EpaSpan { DumpSemis.hs:11:11 }))]
    401 
    -                          (NoEpTok)
    392 
    +                         (EpaSpan { DumpSemis.hs:11:8-13 })
    393 
    +                         (AnnListItem
    402 394 
                               [])
    403 395 
                              (EpaComments
    404 396 
                               []))
    ... ... @@ -649,26 +641,21 @@
    649 641 
                      (AnnList
    650 642 
                       (Just
    651 643 
                        (EpaSpan { DumpSemis.hs:(16,3)-(19,3) }))
    652 
    -                  (ListNone)
    653 
    -                  []
    644 
    +                  (ListBraces
    645 
    +                   (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
    646 
    +                   (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
    647 
    +                  [(EpTok
    648 
    +                    (EpaSpan { DumpSemis.hs:16:5 }))
    649 
    +                  ,(EpTok
    650 
    +                    (EpaSpan { DumpSemis.hs:16:8 }))]
    654 651 
                       (EpaSpan { DumpSemis.hs:15:7-8 })
    655 652 
                       [])
    656 653 
                      (DoExpr
    657 654 
                       (Nothing))
    658 655 
                      (L
    659 656 
                       (EpAnn
    660 
    -                   (EpaSpan { DumpSemis.hs:(16,3)-(19,3) })
    661 
    -                   (AnnList
    662 
    -                    (Just
    663 
    -                     (EpaSpan { DumpSemis.hs:(16,5)-(18,5) }))
    664 
    -                    (ListBraces
    665 
    -                     (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
    666 
    -                     (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
    667 
    -                    [(EpTok
    668 
    -                      (EpaSpan { DumpSemis.hs:16:5 }))
    669 
    -                    ,(EpTok
    670 
    -                      (EpaSpan { DumpSemis.hs:16:8 }))]
    671 
    -                    (NoEpTok)
    657 
    +                   (EpaSpan { DumpSemis.hs:(16,5)-(18,5) })
    658 
    +                   (AnnListItem
    672 659 
                         [])
    673 660 
                        (EpaComments
    674 661 
                         []))
    ... ... @@ -913,26 +900,21 @@
    913 900 
                      (AnnList
    914 901 
                       (Just
    915 902 
                        (EpaSpan { DumpSemis.hs:22:10-30 }))
    916 
    -                  (ListNone)
    917 
    -                  []
    903 
    +                  (ListBraces
    904 
    +                   (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
    905 
    +                   (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
    906 
    +                  [(EpTok
    907 
    +                    (EpaSpan { DumpSemis.hs:22:12 }))
    908 
    +                  ,(EpTok
    909 
    +                    (EpaSpan { DumpSemis.hs:22:13 }))]
    918 910 
                       (EpaSpan { DumpSemis.hs:22:7-8 })
    919 911 
                       [])
    920 912 
                      (DoExpr
    921 913 
                       (Nothing))
    922 914 
                      (L
    923 915 
                       (EpAnn
    924 
    -                   (EpaSpan { DumpSemis.hs:22:10-30 })
    925 
    -                   (AnnList
    926 
    -                    (Just
    927 
    -                     (EpaSpan { DumpSemis.hs:22:12-28 }))
    928 
    -                    (ListBraces
    929 
    -                     (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
    930 
    -                     (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
    931 
    -                    [(EpTok
    932 
    -                      (EpaSpan { DumpSemis.hs:22:12 }))
    933 
    -                    ,(EpTok
    934 
    -                      (EpaSpan { DumpSemis.hs:22:13 }))]
    935 
    -                    (NoEpTok)
    916 
    +                   (EpaSpan { DumpSemis.hs:22:12-28 })
    917 
    +                   (AnnListItem
    936 918 
                         [])
    937 919 
                        (EpaComments
    938 920 
                         []))

  • testsuite/tests/printer/Test20297.stdout
    ... ... @@ -390,7 +390,9 @@
    390 390 
                                 (AnnList
    391 391 
                                  (Just
    392 392 
                                   (EpaSpan { Test20297.hs:11:22-26 }))
    393 
    -                             (ListNone)
    393 
    +                             (ListBraces
    394 
    +                              (NoEpTok)
    395 
    +                              (NoEpTok))
    394 396 
                                  []
    395 397 
                                  (EpaSpan { Test20297.hs:11:19-20 })
    396 398 
                                  [])
    ... ... @@ -399,12 +401,7 @@
    399 401 
                                 (L
    400 402 
                                  (EpAnn
    401 403 
                                   (EpaSpan { Test20297.hs:11:22-26 })
    402 
    -                              (AnnList
    403 
    -                               (Just
    404 
    -                                (EpaSpan { Test20297.hs:11:22-26 }))
    405 
    -                               (ListNone)
    406 
    -                               []
    407 
    -                               (NoEpTok)
    404 
    +                              (AnnListItem
    408 405 
                                    [])
    409 406 
                                   (EpaComments
    410 407 
                                    []))
    ... ... @@ -817,7 +814,9 @@
    817 814 
                                 (AnnList
    818 815 
                                  (Just
    819 816 
                                   (EpaSpan { Test20297.ppr.hs:9:20-24 }))
    820 
    -                             (ListNone)
    817 
    +                             (ListBraces
    818 
    +                              (NoEpTok)
    819 
    +                              (NoEpTok))
    821 820 
                                  []
    822 821 
                                  (EpaSpan { Test20297.ppr.hs:9:17-18 })
    823 822 
                                  [])
    ... ... @@ -826,12 +825,7 @@
    826 825 
                                 (L
    827 826 
                                  (EpAnn
    828 827 
                                   (EpaSpan { Test20297.ppr.hs:9:20-24 })
    829 
    -                              (AnnList
    830 
    -                               (Just
    831 
    -                                (EpaSpan { Test20297.ppr.hs:9:20-24 }))
    832 
    -                               (ListNone)
    833 
    -                               []
    834 
    -                               (NoEpTok)
    828 
    +                              (AnnListItem
    835 829 
                                    [])
    836 830 
                                   (EpaComments
    837 831 
                                    []))

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -1447,6 +1447,8 @@ instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where
    1447 1447 
         a' <- markAnnotated a
    1448 1448 
         return (L la a')
    1449 1449
    1450 
    +-- ---------------------------------------------------------------------
    1451 
    +
    1450 1452 
     instance (ExactPrint a) => ExactPrint (Maybe a) where
    1451 1453 
       getAnnotationEntry = const NoEntryVal
    1452 1454 
       setAnnotationAnchor ma _ _ _ = ma
    ... ... @@ -2417,7 +2419,7 @@ exactMatch (Match an mctxt pats grhss) = do
    2417 2419 
                 epTokensToComments "(" opens
    2418 2420 
                 epTokensToComments ")" closes
    2419 2421 
                 fun' <- markAnnotated fun
    2420 
    -            pats' <- mapM markAnnotated pats
    2422 
    +            pats' <- markAnnotated pats
    2421 2423 
                 return (FunRhs fun' fixity strictness (AnnFunRhs strict' [] []), pats')
    2422 2424 
               Infix ->
    2423 2425 
                 case pats of
    ... ... @@ -2438,11 +2440,11 @@ exactMatch (Match an mctxt pats grhss) = do
    2438 2440 
                   _ -> panic "FunRhs"
    2439 2441
    2440 2442 
           LamAlt v -> do
    2441 
    -        pats' <- markAnnotated pats
    2443 
    +        pats' <- (mapM . mapM) markAnnotated pats
    2442 2444 
             return (LamAlt v, pats')
    2443 2445
    2444 2446 
           CaseAlt -> do
    2445 
    -        pats' <- markAnnotated pats
    2447 
    +        pats' <- (mapM . mapM) markAnnotated pats
    2446 2448 
             return (CaseAlt, pats')
    2447 2449
    2448 2450 
           _ -> do
    ... ... @@ -2985,7 +2987,7 @@ instance ExactPrint (HsExpr GhcPs) where
    2985 2987
    2986 2988 
       exact (HsDo an do_or_list_comp stmts) = do
    2987 2989 
         debugM $ "HsDo"
    2988 
    -    (an',stmts') <- markAnnListA' an $ \a -> exactDo a do_or_list_comp stmts
    2990 
    +    (an',stmts') <- exactDo an do_or_list_comp stmts
    2989 2991 
         return (HsDo an' do_or_list_comp stmts')
    2990 2992
    2991 2993 
       exact (ExplicitList an es) = do
    ... ... @@ -3101,9 +3103,9 @@ instance ExactPrint (HsExpr GhcPs) where
    3101 3103 
         s' <- markAnnotated s
    3102 3104 
         return (HsTypedSplice an s')
    3103 3105
    3104 
    -  exact (HsUntypedSplice an s) = do
    3106 
    +  exact (HsUntypedSplice x s) = do
    3105 3107 
         s' <- markAnnotated s
    3106 
    -    return (HsUntypedSplice an s')
    3108 
    +    return (HsUntypedSplice x s')
    3107 3109
    3108 3110 
       exact (HsProc (pr,r) p c) = do
    3109 3111 
         debugM $ "HsProc start"
    ... ... @@ -3160,10 +3162,12 @@ instance ExactPrint (HsExpr GhcPs) where
    3160 3162 
     exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
    3161 3163 
             => AnnList EpaLocation -> HsDoFlavour -> LocatedAn an a
    3162 3164 
             -> EP w m (AnnList EpaLocation, LocatedAn an a)
    3163 
    -exactDo an (DoExpr m)    stmts = exactMdo an m "do"          >>= \an0 -> markMaybeDodgyStmts an0 stmts
    3165 
    +exactDo an (DoExpr m)    stmts = exactMdo an m "do" >>=
    3166 
    +                                 \an0 -> markMaybeDodgyStmts an0 stmts
    3164 3167 
     exactDo an GhciStmtCtxt  stmts = markLensFun an lal_rest (\l -> printStringAtAA l "do") >>=
    3165 3168 
                                      \an0 -> markMaybeDodgyStmts an0 stmts
    3166 
    -exactDo an (MDoExpr m)   stmts = exactMdo an m  "mdo" >>= \an0 -> markMaybeDodgyStmts an0 stmts
    3169 
    +exactDo an (MDoExpr m)   stmts = exactMdo an m  "mdo" >>=
    3170 
    +                                 \an0 -> markMaybeDodgyStmts an0 stmts
    3167 3171 
     exactDo an ListComp      stmts = markMaybeDodgyStmts an stmts
    3168 3172 
     exactDo an MonadComp     stmts = markMaybeDodgyStmts an stmts
    3169 3173
    ... ... @@ -3179,8 +3183,9 @@ markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
    3179 3183 
     markMaybeDodgyStmts an stmts =
    3180 3184 
       if notDodgy stmts
    3181 3185 
         then do
    3182 
    -      r <- markAnnotatedWithLayout stmts
    3183 
    -      return (an, r)
    3186 
    +      markAnnListA' an $ \a -> do
    3187 
    +         r <- markAnnotatedWithLayout stmts
    3188 
    +         return (a, r)
    3184 3189 
         else return (an, stmts)
    3185 3190
    3186 3191 
     notDodgy :: GenLocated (EpAnn ann) a -> Bool
    ... ... @@ -3465,19 +3470,21 @@ instance ExactPrint (HsCmd GhcPs) where
    3465 3470 
           e' <- markAnnotated e
    3466 3471 
           return (HsCmdLet (tkLet', tkIn') binds' e')
    3467 3472
    3468 
    -  exact (HsCmdDo an es) = do
    3473 
    +  exact (HsCmdDo an (L l es)) = do
    3469 3474 
         debugM $ "HsCmdDo"
    3470 
    -    an0 <- markLensFun an lal_rest (\l -> printStringAtAA l "do")
    3471 
    -    es' <- markAnnotated es
    3472 
    -    return (HsCmdDo an0 es')
    3475 
    +    an0 <- markLensFun an lal_rest (\ll -> printStringAtAA ll "do")
    3476 
    +    (an1,es') <- markAnnList' an0 $ do
    3477 
    +      ee <- mapM markAnnotated es
    3478 
    +      return ee
    3479 
    +    return (HsCmdDo an1 (L l es'))
    3473 3480
    3474 3481 
     -- ---------------------------------------------------------------------
    3475 3482
    3476 3483 
     instance (
    3477 3484 
       ExactPrint (LocatedA (body GhcPs)),
    3478 3485 
                      Anno (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) ~ SrcSpanAnnA,
    3479 
    -           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnLW,
    3480 
    -           (ExactPrint (LocatedLW [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))
    3486 
    +           Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnA,
    3487 
    +           (ExactPrint (LocatedA [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))
    3481 3488 
        => ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where
    3482 3489 
       getAnnotationEntry _ = NoEntryVal
    3483 3490 
       setAnnotationAnchor a _ _ _s = a
    ... ... @@ -4524,31 +4531,36 @@ instance (ExactPrint (Match GhcPs (LocatedA body)))
    4524 4531 
         an3 <- markLensBracketsC an2 lal_brackets
    4525 4532 
         return (L an3 a')
    4526 4533
    4527 
    -instance ExactPrint (LocatedLW [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]) where
    4528 
    -  getAnnotationEntry = entryFromLocatedA
    4529 
    -  setAnnotationAnchor = setAnchorAn
    4530 
    -  exact (L an stmts) = do
    4534 
    +instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))] where
    4535 
    +  getAnnotationEntry _ = NoEntryVal
    4536 
    +  setAnnotationAnchor a _ _ _ = a
    4537 
    +  exact stmts = do
    4531 4538 
         debugM $ "LocatedL [ExprLStmt"
    4532 
    -    (an'', stmts') <- markAnnList an $ do
    4533 
    -      case snocView stmts of
    4534 
    -        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
    4535 
    -          debugM $ "LocatedL [ExprLStmt: snocView"
    4536 
    -          ls' <- markAnnotated ls
    4537 
    -          initStmts' <- mapM markAnnotated initStmts
    4538 
    -          return (initStmts' ++ [ls'])
    4539 
    -        _ -> do
    4540 
    -          mapM markAnnotated stmts
    4541 
    -    return (L an'' stmts')
    4542 
    -
    4543 
    -instance ExactPrint (LocatedLW [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))]) where
    4544 
    -  getAnnotationEntry = entryFromLocatedA
    4545 
    -  setAnnotationAnchor = setAnchorAn
    4546 
    -  exact (L ann es) = do
    4547 
    -    debugM $ "LocatedL [CmdLStmt"
    4548 
    -    an0 <- markLensBracketsO ann lal_brackets
    4549 
    -    es' <- mapM markAnnotated es
    4550 
    -    an1 <- markLensBracketsC an0 lal_brackets
    4551 
    -    return (L an1 es')
    4539 
    +    case snocView stmts of
    4540 
    +      Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
    4541 
    +        debugM $ "LocatedL [ExprLStmt: snocView"
    4542 
    +        ls' <- markAnnotated ls
    4543 
    +        initStmts' <- markAnnotated initStmts
    4544 
    +        return (initStmts' ++ [ls'])
    4545 
    +      _ -> do
    4546 
    +        stmts' <- mapM markAnnotated stmts
    4547 
    +        return stmts'
    4548 
    +
    4549 
    +-- TODO: harmonise with prior, on payload
    4550 
    +instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] where
    4551 
    +  getAnnotationEntry _ = NoEntryVal
    4552 
    +  setAnnotationAnchor a _ _ _ = a
    4553 
    +  exact stmts = do
    4554 
    +    debugM $ "LocatedL [ExprLStmt"
    4555 
    +    case snocView stmts of
    4556 
    +      Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
    4557 
    +        debugM $ "LocatedL [ExprLStmt: snocView"
    4558 
    +        ls' <- markAnnotated ls
    4559 
    +        initStmts' <- markAnnotated initStmts
    4560 
    +        return (initStmts' ++ [ls'])
    4561 
    +      _ -> do
    4562 
    +        stmts' <- markAnnotated stmts
    4563 
    +        return stmts'
    4552 4564
    4553 4565 
     instance ExactPrint (LocatedBF (BF.BooleanFormula GhcPs)) where
    4554 4566 
       getAnnotationEntry = entryFromLocatedA

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help