summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
authorromes <rodrigo.m.mesquita@gmail.com>2022-02-15 09:34:23 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-03-18 05:10:58 -0400
commit8561c1afdbbda73a31cb8f8f1e80d1f403673e9b (patch)
treeb659ad4c4dd83551c2a096c0e48ea91346352317 /compiler/GHC/Hs
parent1a0dd0088247f9d4e403a460f0f6120184af3e15 (diff)
downloadhaskell-8561c1afdbbda73a31cb8f8f1e80d1f403673e9b.tar.gz
TTG: Refactor HsBracket
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Expr.hs63
-rw-r--r--compiler/GHC/Hs/Instances.hs4
-rw-r--r--compiler/GHC/Hs/Syn/Type.hs4
3 files changed, 46 insertions, 25 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 595adafdf9..881b005445 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -183,9 +183,37 @@ data HsWrap hs_syn = HsWrap HsWrapper -- the wrapper
deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn)
-type instance HsBracketRn (GhcPass _) = GhcRn
-type instance PendingRnSplice' (GhcPass _) = PendingRnSplice
-type instance PendingTcSplice' (GhcPass _) = PendingTcSplice
+type instance HsDoRn (GhcPass _) = GhcRn
+
+-- ---------------------------------------------------------------------
+
+ -- See Note [Pending Splices]
+data HsBracketRn
+ = HsBracketRnTyped
+ (EpAnn [AddEpAnn])
+
+ | HsBracketRnUntyped
+ (EpAnn [AddEpAnn])
+ [PendingRnSplice] -- Output of the renamer is the *original* renamed
+ -- expression, plus
+ -- _renamed_ splices to be type checked
+
+data HsBracketTc = HsBracketTc
+ Type
+ (Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument
+ -- to the quote.
+ [PendingTcSplice] -- Output of the type checker is the *original*
+ -- renamed expression, plus
+ -- _typechecked_ splices to be
+ -- pasted back in by the desugarer
+
+type instance XBracket GhcPs = EpAnn [AddEpAnn]
+type instance XBracket GhcRn = HsBracketRn
+type instance XBracket GhcTc = HsBracketTc
+
+type instance HsBracketBody GhcPs = HsBracket GhcPs
+type instance HsBracketBody GhcRn = HsBracket GhcRn
+type instance HsBracketBody GhcTc = HsBracket GhcRn
-- ---------------------------------------------------------------------
@@ -334,18 +362,6 @@ type instance XArithSeq GhcPs = EpAnn [AddEpAnn]
type instance XArithSeq GhcRn = NoExtField
type instance XArithSeq GhcTc = PostTcExpr
-type instance XBracket GhcPs = EpAnn [AddEpAnn]
-type instance XBracket GhcRn = EpAnn [AddEpAnn]
-type instance XBracket GhcTc = DataConCantHappen
-
-type instance XRnBracketOut GhcPs = DataConCantHappen
-type instance XRnBracketOut GhcRn = NoExtField
-type instance XRnBracketOut GhcTc = DataConCantHappen
-
-type instance XTcBracketOut GhcPs = DataConCantHappen
-type instance XTcBracketOut GhcRn = DataConCantHappen
-type instance XTcBracketOut GhcTc = Type -- Type of the TcBracketOut
-
type instance XSpliceE (GhcPass _) = EpAnnCO
type instance XProc (GhcPass _) = EpAnn [AddEpAnn]
@@ -641,11 +657,16 @@ ppr_expr (ExprWithTySig _ expr sig)
ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
ppr_expr (HsSpliceE _ s) = pprSplice s
-ppr_expr (HsBracket _ b) = pprHsBracket b
-ppr_expr (HsRnBracketOut _ e []) = ppr e
-ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
-ppr_expr (HsTcBracketOut _ _wrap e []) = ppr e
-ppr_expr (HsTcBracketOut _ _wrap e ps) = ppr e $$ text "pending(tc)" <+> pprIfTc @p (ppr ps)
+ppr_expr (HsBracket b e)
+ = case ghcPass @p of
+ GhcPs -> pprHsBracket e
+ GhcRn -> case b of
+ HsBracketRnTyped _ -> pprHsBracket e
+ HsBracketRnUntyped _ [] -> ppr e
+ HsBracketRnUntyped _ ps -> ppr e $$ text "pending(rn)" <+> ppr ps
+ GhcTc -> case b of
+ HsBracketTc _ty _wrap [] -> ppr e
+ HsBracketTc _ty _wrap ps -> ppr e $$ text "pending(tc)" <+> pprIfTc @p (ppr ps)
ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
= hsep [text "proc", ppr pat, text "->", ppr cmd]
@@ -786,8 +807,6 @@ hsExprNeedsParens prec = go
go (HsPragE{}) = prec >= appPrec
go (HsSpliceE{}) = False
go (HsBracket{}) = False
- go (HsRnBracketOut{}) = False
- go (HsTcBracketOut{}) = False
go (HsProc{}) = prec > topPrec
go (HsStatic{}) = prec >= appPrec
go (RecordCon{}) = False
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index ff5131f6e0..f93df4ac67 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -388,6 +388,10 @@ deriving instance Data (HsBracket GhcPs)
deriving instance Data (HsBracket GhcRn)
deriving instance Data (HsBracket GhcTc)
+deriving instance Data HsBracketRn
+
+deriving instance Data HsBracketTc
+
-- deriving instance (DataIdLR p p) => Data (ArithSeqInfo p)
deriving instance Data (ArithSeqInfo GhcPs)
deriving instance Data (ArithSeqInfo GhcRn)
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index c985c9237c..a57cd80145 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -129,9 +129,7 @@ hsExprType (ArithSeq _ mb_overloaded_op asi) = case mb_overloaded_op of
Nothing -> asi_ty
where
asi_ty = arithSeqInfoType asi
-hsExprType (HsBracket v _) = dataConCantHappen v
-hsExprType (HsRnBracketOut v _ _) = dataConCantHappen v
-hsExprType (HsTcBracketOut ty _wrap _bracket _pending) = ty
+hsExprType (HsBracket (HsBracketTc ty _wrap _pending) _) = ty
hsExprType e@(HsSpliceE{}) = pprPanic "hsExprType: Unexpected HsSpliceE"
(ppr e)
-- Typed splices should have been eliminated during zonking, but we