summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Hs/Expr.hs24
-rw-r--r--compiler/GHC/Hs/Utils.hs6
-rw-r--r--compiler/GHC/HsToCore/Quote.hs8
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs6
-rw-r--r--compiler/GHC/Rename/Splice.hs24
-rw-r--r--compiler/GHC/Tc/Deriv/Generate.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs4
8 files changed, 40 insertions, 38 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index f4c5dde56c..1cca03b236 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1688,9 +1688,15 @@ pprQuals quals = interpp'SP quals
newtype HsSplicedT = HsSplicedT DelayedSplice deriving (Data)
-type instance XTypedSplice (GhcPass _) = EpAnn [AddEpAnn]
-type instance XUntypedSplice (GhcPass _) = EpAnn [AddEpAnn]
-type instance XQuasiQuote (GhcPass _) = NoExtField
+-- (IdP id): A unique name to identify this splice point
+type instance XTypedSplice (GhcPass p) = (EpAnn [AddEpAnn], IdP (GhcPass p))
+
+-- (IdP id): A unique name to identify this splice point
+type instance XUntypedSplice (GhcPass p) = (EpAnn [AddEpAnn], IdP (GhcPass p))
+
+type instance XQuasiQuote (GhcPass p) = ( (IdP (GhcPass p)) -- Splice point
+ , (IdP (GhcPass p)) ) -- Quoter
+
type instance XSpliced (GhcPass _) = NoExtField
type instance XXSplice GhcPs = DataConCantHappen
type instance XXSplice GhcRn = DataConCantHappen
@@ -1808,19 +1814,19 @@ pprSpliceDecl e ImplicitSplice = ppr_splice_decl e
ppr_splice_decl :: (OutputableBndrId p)
=> HsSplice (GhcPass p) -> SDoc
-ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
+ppr_splice_decl (HsUntypedSplice (_, n) _ e) = ppr_splice empty n e empty
ppr_splice_decl e = pprSplice e
pprSplice :: forall p. (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc
-pprSplice (HsTypedSplice _ DollarSplice n e)
+pprSplice (HsTypedSplice (_, n) DollarSplice e)
= ppr_splice (text "$$") n e empty
-pprSplice (HsTypedSplice _ BareSplice _ _ )
+pprSplice (HsTypedSplice _ BareSplice _ )
= panic "Bare typed splice" -- impossible
-pprSplice (HsUntypedSplice _ DollarSplice n e)
+pprSplice (HsUntypedSplice (_, n) DollarSplice e)
= ppr_splice (text "$") n e empty
-pprSplice (HsUntypedSplice _ BareSplice n e)
+pprSplice (HsUntypedSplice (_, n) BareSplice e)
= ppr_splice empty n e empty
-pprSplice (HsQuasiQuote _ n q _ s) = ppr_quasi n q s
+pprSplice (HsQuasiQuote (n, q) _ s) = ppr_quasi n q s
pprSplice (HsSpliced _ _ thing) = ppr thing
pprSplice (XSplice x) = case ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 51306d627c..420ea18ee6 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -444,14 +444,14 @@ unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkUntypedSplice ann hasParen e = HsUntypedSplice ann hasParen unqualSplice e
+mkUntypedSplice ann hasParen e = HsUntypedSplice (ann, unqualSplice) hasParen e
mkTypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkTypedSplice ann hasParen e = HsTypedSplice ann hasParen unqualSplice e
+mkTypedSplice ann hasParen e = HsTypedSplice (ann, unqualSplice) hasParen e
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote
- = HsQuasiQuote noExtField unqualSplice quoter span quote
+ = HsQuasiQuote (unqualSplice, quoter) span quote
mkHsString :: String -> HsLit (GhcPass p)
mkHsString s = HsString NoSourceText (mkFastString s)
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 38dc46364e..9ad6c718f0 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1451,10 +1451,10 @@ repRole (L _ Nothing) = rep2_nw inferRName []
repSplice :: HsSplice GhcRn -> MetaM (Core a)
-- See Note [How brackets and nested splices are handled] in GHC.Tc.Gen.Splice
-- We return a CoreExpr of any old type; the context should know
-repSplice (HsTypedSplice _ _ n _) = rep_splice n
-repSplice (HsUntypedSplice _ _ n _) = rep_splice n
-repSplice (HsQuasiQuote _ n _ _ _) = rep_splice n
-repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e)
+repSplice (HsTypedSplice (_, n) _ _) = rep_splice n
+repSplice (HsUntypedSplice (_, n) _ _) = rep_splice n
+repSplice (HsQuasiQuote (n, _) _ _) = rep_splice n
+repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e)
rep_splice :: Name -> MetaM (Core a)
rep_splice splice_name
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 60885ae7ee..ec9a43cd16 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1888,13 +1888,13 @@ instance ToHie (LocatedAn NoEpAnns HsIPName) where
instance HiePass p => ToHie (LocatedA (HsSplice (GhcPass p))) where
toHie (L span sp) = concatM $ makeNodeA sp span : case sp of
- HsTypedSplice _ _ _ expr ->
+ HsTypedSplice _ _ expr ->
[ toHie expr
]
- HsUntypedSplice _ _ _ expr ->
+ HsUntypedSplice _ _ expr ->
[ toHie expr
]
- HsQuasiQuote _ _ _ ispan _ ->
+ HsQuasiQuote _ ispan _ ->
[ locOnly ispan
]
HsSpliced _ _ _ ->
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index e9eb2c78bb..d73f8a53b8 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -361,10 +361,10 @@ runRnSplice flavour run_meta ppr_res splice
Just h -> h splice
; let the_expr = case splice' of
- HsUntypedSplice _ _ _ e -> e
- HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
- HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
- HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
+ HsUntypedSplice _ _ e -> e
+ HsQuasiQuote (_, q) qs str -> mkQuasiQuoteExpr flavour q qs str
+ HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
+ HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
-- Typecheck the expression
; meta_exp_ty <- tcMetaTy meta_ty_name
@@ -403,9 +403,9 @@ runRnSplice flavour run_meta ppr_res splice
makePending :: UntypedSpliceFlavour
-> HsSplice GhcRn
-> PendingRnSplice
-makePending flavour (HsUntypedSplice _ _ n e)
+makePending flavour (HsUntypedSplice (_, n) _ e)
= PendingRnSplice flavour n e
-makePending flavour (HsQuasiQuote _ n quoter q_span quote)
+makePending flavour (HsQuasiQuote (n, quoter) q_span quote)
= PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
makePending _ splice@(HsTypedSplice {})
= pprPanic "makePending" (ppr splice)
@@ -436,19 +436,19 @@ mkQuasiQuoteExpr flavour quoter q_span' quote
---------------------
rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
-- Not exported...used for all
-rnSplice (HsTypedSplice x hasParen splice_name expr)
+rnSplice (HsTypedSplice (x, splice_name) hasParen expr)
= do { loc <- getSrcSpanM
; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
; (expr', fvs) <- rnLExpr expr
- ; return (HsTypedSplice x hasParen n' expr', fvs) }
+ ; return (HsTypedSplice (x, n') hasParen expr', fvs) }
-rnSplice (HsUntypedSplice x hasParen splice_name expr)
+rnSplice (HsUntypedSplice (x, splice_name) hasParen expr)
= do { loc <- getSrcSpanM
; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
; (expr', fvs) <- rnLExpr expr
- ; return (HsUntypedSplice x hasParen n' expr', fvs) }
+ ; return (HsUntypedSplice (x, n') hasParen expr', fvs) }
-rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
+rnSplice (HsQuasiQuote (splice_name, quoter) q_loc quote)
= do { loc <- getSrcSpanM
; splice_name' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
@@ -458,7 +458,7 @@ rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
; when (nameIsLocalOrFrom this_mod quoter') $
checkThLocalName quoter'
- ; return (HsQuasiQuote x splice_name' quoter' q_loc quote
+ ; return (HsQuasiQuote (splice_name', quoter') q_loc quote
, unitFV quoter') }
rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 35375bc5a5..0f3430826a 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1637,8 +1637,8 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
mk_untyped_bracket = HsUntypedBracket noAnn . ExpBr noExtField
mk_typed_bracket = HsTypedBracket noAnn
- mk_usplice = HsUntypedSplice EpAnnNotUsed DollarSplice
- mk_tsplice = HsTypedSplice EpAnnNotUsed DollarSplice
+ mk_usplice = flip HsUntypedSplice DollarSplice . (,) EpAnnNotUsed
+ mk_tsplice = flip HsTypedSplice DollarSplice . (,) EpAnnNotUsed
data_cons = getPossibleDataCons tycon tycon_args
pats_etc mk_bracket mk_splice lift_name data_con
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index c42dd689fa..4d102985c7 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -599,7 +599,7 @@ That effort is tracked in #14838.
************************************************************************
-}
-tcSpliceExpr splice@(HsTypedSplice _ _ name expr) res_ty
+tcSpliceExpr splice@(HsTypedSplice (_, name) _ expr) res_ty
= addErrCtxt (spliceCtxtDoc splice) $
setSrcSpan (getLocA expr) $ do
{ stage <- getStage
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index d0f6097de8..daabec1984 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -1550,19 +1550,15 @@ data HsSplice id
= HsTypedSplice -- $$z or $$(f 4)
(XTypedSplice id)
SpliceDecoration -- Whether $$( ) variant found, for pretty printing
- (IdP id) -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsUntypedSplice -- $z or $(f 4)
(XUntypedSplice id)
SpliceDecoration -- Whether $( ) variant found, for pretty printing
- (IdP id) -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsQuasiQuote -- See Note [Quasi-quote overview]
(XQuasiQuote id)
- (IdP id) -- Splice point
- (IdP id) -- Quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
View Lorry Controller Status