TTG: Move GHC-specific IdP out of HsSplice in L.H.S.Expr

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