summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Expr.hs18
-rw-r--r--compiler/GHC/Hs/Extension.hs5
-rw-r--r--compiler/GHC/Hs/Pat.hs25
-rw-r--r--compiler/GHC/Hs/Utils.hs27
4 files changed, 40 insertions, 35 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index a25f90d0b0..89292b59c3 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -278,7 +278,7 @@ type instance XNegApp GhcPs = EpAnn [AddEpAnn]
type instance XNegApp GhcRn = NoExtField
type instance XNegApp GhcTc = NoExtField
-type instance XPar (GhcPass _) = EpAnn AnnParen
+type instance XPar (GhcPass _) = EpAnnCO
type instance XExplicitTuple GhcPs = EpAnn [AddEpAnn]
type instance XExplicitTuple GhcRn = NoExtField
@@ -496,7 +496,7 @@ ppr_expr (HsIPVar _ v) = ppr v
ppr_expr (HsOverLabel _ l) = char '#' <> ppr l
ppr_expr (HsLit _ lit) = ppr lit
ppr_expr (HsOverLit _ lit) = ppr lit
-ppr_expr (HsPar _ e) = parens (ppr_lexpr e)
+ppr_expr (HsPar _ _ e _) = parens (ppr_lexpr e)
ppr_expr (HsPragE _ prag e) = sep [ppr prag, ppr_lexpr e]
@@ -810,19 +810,23 @@ hsExprNeedsParens prec = go
go_x_rn (HsExpanded a _) = hsExprNeedsParens prec a
+-- | Parenthesize an expression without token information
+gHsPar :: LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
+gHsPar e = HsPar noAnn noHsTok e noHsTok
+
-- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,
-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
parenthesizeHsExpr :: IsPass p => PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr p le@(L loc e)
- | hsExprNeedsParens p e = L loc (HsPar noAnn le)
+ | hsExprNeedsParens p e = L loc (gHsPar le)
| otherwise = le
stripParensLHsExpr :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-stripParensLHsExpr (L _ (HsPar _ e)) = stripParensLHsExpr e
+stripParensLHsExpr (L _ (HsPar _ _ e _)) = stripParensLHsExpr e
stripParensLHsExpr e = e
stripParensHsExpr :: HsExpr (GhcPass p) -> HsExpr (GhcPass p)
-stripParensHsExpr (HsPar _ (L _ e)) = stripParensHsExpr e
+stripParensHsExpr (HsPar _ _ (L _ e) _) = stripParensHsExpr e
stripParensHsExpr e = e
isAtomicHsExpr :: forall p. IsPass p => HsExpr (GhcPass p) -> Bool
@@ -1044,7 +1048,7 @@ type instance XCmdArrForm GhcTc = NoExtField
type instance XCmdApp (GhcPass _) = EpAnnCO
type instance XCmdLam (GhcPass _) = NoExtField
-type instance XCmdPar (GhcPass _) = EpAnn AnnParen
+type instance XCmdPar (GhcPass _) = EpAnnCO
type instance XCmdCase GhcPs = EpAnn EpAnnHsCase
type instance XCmdCase GhcRn = NoExtField
@@ -1116,7 +1120,7 @@ ppr_lcmd c = ppr_cmd (unLoc c)
ppr_cmd :: forall p. (OutputableBndrId p
) => HsCmd (GhcPass p) -> SDoc
-ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
+ppr_cmd (HsCmdPar _ _ c _) = parens (ppr_lcmd c)
ppr_cmd (HsCmdApp _ c e)
= let (fun, args) = collect_args c [e] in
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index e28bcddbf1..0a43cb8aa6 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -229,3 +229,8 @@ pprIfRn pp = case ghcPass @p of GhcRn -> pp
pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
pprIfTc pp = case ghcPass @p of GhcTc -> pp
_ -> empty
+
+type instance Anno (HsToken tok) = EpAnnCO
+
+noHsTok :: GenLocated (EpAnn a) (HsToken tok)
+noHsTok = L noAnn HsTok
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 239c57418b..68d76909a2 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -39,7 +39,7 @@ module GHC.Hs.Pat (
isSimplePat,
looksLazyPatBind,
isBangedLPat,
- patNeedsParens, parenthesizePat,
+ gParPat, patNeedsParens, parenthesizePat,
isIrrefutableHsPat,
collectEvVarsPat, collectEvVarsPats,
@@ -103,7 +103,7 @@ type instance XAsPat GhcPs = EpAnn [AddEpAnn] -- For '@'
type instance XAsPat GhcRn = NoExtField
type instance XAsPat GhcTc = NoExtField
-type instance XParPat (GhcPass _) = EpAnn AnnParen
+type instance XParPat (GhcPass _) = EpAnnCO
type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!'
type instance XBangPat GhcRn = NoExtField
@@ -285,7 +285,7 @@ pprPat (BangPat _ pat) = char '!' <> pprParendLPat appPrec pat
pprPat (AsPat _ name pat) = hcat [pprPrefixOcc (unLoc name), char '@',
pprParendLPat appPrec pat]
pprPat (ViewPat _ expr pat) = hcat [pprLExpr expr, text " -> ", ppr pat]
-pprPat (ParPat _ pat) = parens (ppr pat)
+pprPat (ParPat _ _ pat _) = parens (ppr pat)
pprPat (LitPat _ s) = ppr s
pprPat (NPat _ l Nothing _) = ppr l
pprPat (NPat _ l (Just _) _) = char '-' <> ppr l
@@ -420,7 +420,7 @@ isBangedLPat :: LPat (GhcPass p) -> Bool
isBangedLPat = isBangedPat . unLoc
isBangedPat :: Pat (GhcPass p) -> Bool
-isBangedPat (ParPat _ p) = isBangedLPat p
+isBangedPat (ParPat _ _ p _) = isBangedLPat p
isBangedPat (BangPat {}) = True
isBangedPat _ = False
@@ -441,8 +441,8 @@ looksLazyLPat :: LPat (GhcPass p) -> Bool
looksLazyLPat = looksLazyPat . unLoc
looksLazyPat :: Pat (GhcPass p) -> Bool
-looksLazyPat (ParPat _ p) = looksLazyLPat p
-looksLazyPat (AsPat _ _ p) = looksLazyLPat p
+looksLazyPat (ParPat _ _ p _) = looksLazyLPat p
+looksLazyPat (AsPat _ _ p) = looksLazyLPat p
looksLazyPat (BangPat {}) = False
looksLazyPat (VarPat {}) = False
looksLazyPat (WildPat {}) = False
@@ -508,7 +508,7 @@ isIrrefutableHsPat' is_strict = goL
= isIrrefutableHsPat' False p'
| otherwise = True
go (BangPat _ pat) = goL pat
- go (ParPat _ pat) = goL pat
+ go (ParPat _ _ pat _) = goL pat
go (AsPat _ _ pat) = goL pat
go (ViewPat _ _ pat) = goL pat
go (SigPat _ pat _) = goL pat
@@ -553,7 +553,7 @@ isIrrefutableHsPat' is_strict = goL
-- - x (variable)
isSimplePat :: LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat p = case unLoc p of
- ParPat _ x -> isSimplePat x
+ ParPat _ _ x _ -> isSimplePat x
SigPat _ x _ -> isSimplePat x
LazyPat _ x -> isSimplePat x
BangPat _ x -> isSimplePat x
@@ -628,6 +628,11 @@ conPatNeedsParens p = go
go (InfixCon {}) = p >= opPrec -- type args should be empty in this case
go (RecCon {}) = False
+
+-- | Parenthesize a pattern without token information
+gParPat :: LPat (GhcPass pass) -> Pat (GhcPass pass)
+gParPat p = ParPat noAnn noHsTok p noHsTok
+
-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
parenthesizePat :: IsPass p
@@ -635,7 +640,7 @@ parenthesizePat :: IsPass p
-> LPat (GhcPass p)
-> LPat (GhcPass p)
parenthesizePat p lpat@(L loc pat)
- | patNeedsParens p pat = L loc (ParPat noAnn lpat)
+ | patNeedsParens p pat = L loc (gParPat lpat)
| otherwise = lpat
{-
@@ -654,7 +659,7 @@ collectEvVarsPat pat =
case pat of
LazyPat _ p -> collectEvVarsLPat p
AsPat _ _ p -> collectEvVarsLPat p
- ParPat _ p -> collectEvVarsLPat p
+ ParPat _ _ p _ -> collectEvVarsLPat p
BangPat _ p -> collectEvVarsLPat p
ListPat _ ps -> unionManyBags $ map collectEvVarsLPat ps
TuplePat _ ps _ -> unionManyBags $ map collectEvVarsLPat ps
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 4f9e5c83bc..5c6a53a8a7 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -168,7 +168,7 @@ just attach 'noSrcSpan' to everything.
-- | @e => (e)@
mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsPar e = L (getLoc e) (HsPar noAnn e)
+mkHsPar e = L (getLoc e) (gHsPar e)
mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA,
@@ -284,17 +284,13 @@ nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
-- | Wrap in parens if @'hsExprNeedsParens' appPrec@ says it needs them
-- So @f x@ becomes @(f x)@, but @3@ stays as @3@.
mkLHsPar :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkLHsPar le@(L loc e)
- | hsExprNeedsParens appPrec e = L loc (HsPar noAnn le)
- | otherwise = le
+mkLHsPar = parenthesizeHsExpr appPrec
mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
-mkParPat lp@(L loc p)
- | patNeedsParens appPrec p = L loc (ParPat noAnn lp)
- | otherwise = lp
+mkParPat = parenthesizePat appPrec
nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
-nlParPat p = noLocA (ParPat noAnn p)
+nlParPat p = noLocA (gParPat p)
-------------------------------
-- These are the bits of syntax that contain rebindable names
@@ -594,7 +590,7 @@ nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
-- AZ:Is this used?
nlHsLam match = noLocA (HsLam noExtField (mkMatchGroup Generated (noLocA [match])))
-nlHsPar e = noLocA (HsPar noAnn e)
+nlHsPar e = noLocA (gHsPar e)
-- nlHsIf should generate if-expressions which are NOT subject to
-- RebindableSyntax, so the first field of HsIf is False. (#12080)
@@ -795,7 +791,7 @@ mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap co_fn e | isIdHsWrapper co_fn = e
mkHsWrap co_fn (XExpr (WrapExpr (HsWrap co_fn' e))) = mkHsWrap (co_fn <.> co_fn') e
-mkHsWrap co_fn (HsPar x (L l e)) = HsPar x (L l (mkHsWrap co_fn e))
+mkHsWrap co_fn (HsPar x lpar (L l e) rpar) = HsPar x lpar (L l (mkHsWrap co_fn e)) rpar
mkHsWrap co_fn e = XExpr (WrapExpr $ HsWrap co_fn e)
mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b
@@ -925,13 +921,8 @@ mkMatch :: forall p. IsPass p
mkMatch ctxt pats expr binds
= noLocA (Match { m_ext = noAnn
, m_ctxt = ctxt
- , m_pats = map paren pats
+ , m_pats = map mkParPat pats
, m_grhss = GRHSs noExtField (unguardedRHS noAnn noSrcSpan expr) binds })
- where
- paren :: LPat (GhcPass p) -> LPat (GhcPass p)
- paren lp@(L l p)
- | patNeedsParens appPrec p = L l (ParPat noAnn lp)
- | otherwise = lp
{-
************************************************************************
@@ -1209,7 +1200,7 @@ collect_pat flag pat bndrs = case pat of
BangPat _ pat -> collect_lpat flag pat bndrs
AsPat _ a pat -> unXRec @p a : collect_lpat flag pat bndrs
ViewPat _ _ pat -> collect_lpat flag pat bndrs
- ParPat _ pat -> collect_lpat flag pat bndrs
+ ParPat _ _ pat _ -> collect_lpat flag pat bndrs
ListPat _ pats -> foldr (collect_lpat flag) bndrs pats
TuplePat _ pats _ -> foldr (collect_lpat flag) bndrs pats
SumPat _ pat _ _ -> collect_lpat flag pat bndrs
@@ -1584,7 +1575,7 @@ lPatImplicits = hs_lpat
hs_pat (BangPat _ pat) = hs_lpat pat
hs_pat (AsPat _ _ pat) = hs_lpat pat
hs_pat (ViewPat _ _ pat) = hs_lpat pat
- hs_pat (ParPat _ pat) = hs_lpat pat
+ hs_pat (ParPat _ _ pat _) = hs_lpat pat
hs_pat (ListPat _ pats) = hs_lpats pats
hs_pat (TuplePat _ pats _) = hs_lpats pats
View Lorry Controller Status