diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Hs/Expr.hs | 13 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Utils.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Parser.y | 19 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 2 |
4 files changed, 26 insertions, 12 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index f812c66540..3cff120713 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -288,7 +288,7 @@ type instance XCase GhcPs = EpAnn EpAnnHsCase type instance XCase GhcRn = NoExtField type instance XCase GhcTc = NoExtField -type instance XIf GhcPs = EpAnn [AddEpAnn] +type instance XIf GhcPs = EpAnn AnnsIf type instance XIf GhcRn = NoExtField type instance XIf GhcTc = NoExtField @@ -388,6 +388,15 @@ data AnnProjection apClose :: EpaLocation -- ^ ')' } deriving Data +data AnnsIf + = AnnsIf { + aiIf :: EpaLocation, + aiThen :: EpaLocation, + aiElse :: EpaLocation, + aiThenSemi :: Maybe EpaLocation, + aiElseSemi :: Maybe EpaLocation + } deriving Data + -- --------------------------------------------------------------------- type instance XSCC (GhcPass _) = EpAnn AnnPragma @@ -1039,7 +1048,7 @@ type instance XCmdCase GhcTc = NoExtField type instance XCmdLamCase (GhcPass _) = EpAnn [AddEpAnn] -type instance XCmdIf GhcPs = EpAnn [AddEpAnn] +type instance XCmdIf GhcPs = EpAnn AnnsIf type instance XCmdIf GhcRn = NoExtField type instance XCmdIf GhcTc = NoExtField diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 34120f56cd..3c152af242 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -364,12 +364,12 @@ mkHsCompAnns ctxt stmts expr anns = mkHsDoAnns ctxt (mkLocatedList (stmts ++ [la last_stmt = L (noAnnSrcSpan $ getLocA expr) $ mkLastStmt expr -- restricted to GhcPs because other phases might need a SyntaxExpr -mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn [AddEpAnn] +mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf -> HsExpr GhcPs mkHsIf c a b anns = HsIf anns c a b -- restricted to GhcPs because other phases might need a SyntaxExpr -mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn [AddEpAnn] +mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn AnnsIf -> HsCmd GhcPs mkHsCmdIf c a b anns = HsCmdIf anns noSyntaxExpr c a b diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 483fb06e97..f9a4d10a4d 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2679,9 +2679,9 @@ exp10 :: { ECP } -- See Note [%shift: exp10 -> fexp] | fexp %shift { $1 } -optSemi :: { ([Located Token],Bool) } - : ';' { ([$1],True) } - | {- empty -} { ([],False) } +optSemi :: { (Maybe EpaLocation,Bool) } + : ';' { (msemim $1,True) } + | {- empty -} { (Nothing,False) } {- Note [Pragmas and operator fixity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2801,10 +2801,12 @@ aexp :: { ECP } unECP $5 >>= \ $5 -> unECP $8 >>= \ $8 -> mkHsIfPV (comb2A $1 $>) $2 (snd $3) $5 (snd $6) $8 - (mj AnnIf $1:mj AnnThen $4 - :mj AnnElse $7 - :(concatMap (\l -> mz AnnSemi l) (fst $3)) - ++(concatMap (\l -> mz AnnSemi l) (fst $6))) } + (AnnsIf + { aiIf = glAA $1 + , aiThen = glAA $4 + , aiElse = glAA $7 + , aiThenSemi = fst $3 + , aiElseSemi = fst $6})} | 'if' ifgdpats {% hintMultiWayIf (getLoc $1) >>= \_ -> fmap ecpFromExp $ @@ -4161,6 +4163,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (EpaSpan $ rs $ gl l msemi :: Located e -> [TrailingAnn] msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (EpaSpan $ rs $ gl l)] +msemim :: Located e -> Maybe EpaLocation +msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (EpaSpan $ rs $ gl l) + -- |Construct an AddEpAnn from the annotation keyword and the Located Token. If -- the token has a unicode equivalent and this has been used, provide the -- unicode variant of the annotation. diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 697161b564..8f9ba78b13 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -1450,7 +1450,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> LocatedA b -> Bool -- semicolon? -> LocatedA b - -> [AddEpAnn] + -> AnnsIf -> PV (LocatedA b) -- | Disambiguate "do { ... }" (do notation) mkHsDoPV :: |