TTG for ForeignImport/Export

Add a TTG parameter to both `ForeignImport` and `ForeignExport` and,
according to #21592, move the GHC-specific bits in them and in the other
AST data types related to foreign imports and exports to the TTG
extension point.

18 files changed, 236 insertions, 216 deletions

diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 8fe416196b..ad49f81bcb 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -147,7 +147,7 @@ instance Diagnostic DriverMessage where
       -> mkSimpleDecorated (text "module" <+> ppr modname <+> text "was not found")
     DriverUserDefinedRuleIgnored (HsRule { rd_name = n })
       -> mkSimpleDecorated $
-            text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$
+            text "Rule \"" <> ftext (unLoc n) <> text "\" ignored" $+$
             text "Defining user rules is disabled under Safe Haskell"
     DriverMixedSafetyImport modName
       -> mkSimpleDecorated $
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index d2b1b6a117..accc349a11 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -187,6 +187,10 @@ partitionBindsAndSigs = go
           -> (bs, ss, ts, tfis, dfis, L l d : docs)
         _ -> pprPanic "partitionBindsAndSigs" (ppr decl)
 
+-- Okay, I need to reconstruct the document comments, but for now:
+instance Outputable (DocDecl name) where
+  ppr _ = text "<document comment>"
+
 type instance XCHsGroup (GhcPass _) = NoExtField
 type instance XXHsGroup (GhcPass _) = DataConCantHappen
 
@@ -316,6 +320,11 @@ instance OutputableBndrId p
   ppr (SpliceDecl _ (L _ e) DollarSplice) = pprUntypedSplice True Nothing e
   ppr (SpliceDecl _ (L _ e) BareSplice)   = pprUntypedSplice False Nothing e
 
+instance Outputable SpliceDecoration where
+  ppr x = text $ show x
+
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -344,6 +353,17 @@ type instance XXTyClDecl    (GhcPass _) = DataConCantHappen
 type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn]
 type instance XXTyFamInstDecl (GhcPass _) = DataConCantHappen
 
+------------- Pretty printing FamilyDecls -----------
+
+pprFlavour :: FamilyInfo pass -> SDoc
+pprFlavour DataFamily            = text "data"
+pprFlavour OpenTypeFamily        = text "type"
+pprFlavour (ClosedTypeFamily {}) = text "type"
+
+instance Outputable (FamilyInfo pass) where
+  ppr info = pprFlavour info <+> text "family"
+
+
 -- Dealing with names
 
 tyFamInstDeclName :: Anno (IdGhcP p) ~ SrcSpanAnnN
@@ -591,6 +611,15 @@ instance OutputableBndrId p
             Just (L _ via@ViaStrategy{}) -> (empty, ppr via)
             _                            -> (ppDerivStrategy dcs, empty)
 
+-- | A short description of a @DerivStrategy'@.
+derivStrategyName :: DerivStrategy a -> SDoc
+derivStrategyName = text . go
+  where
+    go StockStrategy    {} = "stock"
+    go AnyclassStrategy {} = "anyclass"
+    go NewtypeStrategy  {} = "newtype"
+    go ViaStrategy      {} = "via"
+
 type instance XDctSingle (GhcPass _) = NoExtField
 type instance XDctMulti  (GhcPass _) = NoExtField
 type instance XXDerivClauseTys (GhcPass _) = DataConCantHappen
@@ -871,6 +900,11 @@ instDeclDataFamInsts inst_decls
     do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]
     do_one (L _ (TyFamInstD {}))                              = []
 
+
+instance Outputable NewOrData where
+  ppr NewType  = text "newtype"
+  ppr DataType = text "data"
+
 {-
 ************************************************************************
 *                                                                      *
@@ -987,6 +1021,14 @@ type instance XForeignExport   GhcTc = Coercion
 
 type instance XXForeignDecl    (GhcPass _) = DataConCantHappen
 
+type instance XCImport (GhcPass _) = Located SourceText -- original source text for the C entity
+type instance XXForeignImport  (GhcPass _) = DataConCantHappen
+
+type instance XCExport (GhcPass _) = Located SourceText -- original source text for the C entity
+type instance XXForeignExport  (GhcPass _) = DataConCantHappen
+
+-- pretty printing of foreign declarations
+
 instance OutputableBndrId p
        => Outputable (ForeignDecl (GhcPass p)) where
   ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
@@ -996,6 +1038,40 @@ instance OutputableBndrId p
     hang (text "foreign export" <+> ppr fexport <+> ppr n)
        2 (dcolon <+> ppr ty)
 
+instance OutputableBndrId p
+       => Outputable (ForeignImport (GhcPass p)) where
+  ppr (CImport (L _ srcText) cconv safety mHeader spec) =
+    ppr cconv <+> ppr safety
+      <+> pprWithSourceText srcText (pprCEntity spec "")
+    where
+      pp_hdr = case mHeader of
+               Nothing -> empty
+               Just (Header _ header) -> ftext header
+
+      pprCEntity (CLabel lbl) _ =
+        doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl
+      pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =
+        if dqNeeded then doubleQuotes ce else empty
+          where
+            dqNeeded = (take 6 src == "static")
+                    || isJust mHeader
+                    || not isFun
+                    || st /= NoSourceText
+            ce =
+                  -- We may need to drop leading spaces first
+                  (if take 6 src == "static" then text "static" else empty)
+              <+> pp_hdr
+              <+> (if isFun then empty else text "value")
+              <+> (pprWithSourceText st empty)
+      pprCEntity (CFunction DynamicTarget) _ =
+        doubleQuotes $ text "dynamic"
+      pprCEntity CWrapper _ = doubleQuotes $ text "wrapper"
+
+instance OutputableBndrId p
+       => Outputable (ForeignExport (GhcPass p)) where
+  ppr (CExport _ (L _ (CExportStatic _ lbl cconv))) =
+    ppr cconv <+> char '"' <> ppr lbl <> char '"'
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1004,15 +1080,15 @@ instance OutputableBndrId p
 ************************************************************************
 -}
 
-type instance XCRuleDecls    GhcPs = EpAnn [AddEpAnn]
-type instance XCRuleDecls    GhcRn = NoExtField
-type instance XCRuleDecls    GhcTc = NoExtField
+type instance XCRuleDecls    GhcPs = (EpAnn [AddEpAnn], SourceText)
+type instance XCRuleDecls    GhcRn = SourceText
+type instance XCRuleDecls    GhcTc = SourceText
 
 type instance XXRuleDecls    (GhcPass _) = DataConCantHappen
 
-type instance XHsRule       GhcPs = EpAnn HsRuleAnn
-type instance XHsRule       GhcRn = HsRuleRn
-type instance XHsRule       GhcTc = HsRuleRn
+type instance XHsRule       GhcPs = (EpAnn HsRuleAnn, SourceText)
+type instance XHsRule       GhcRn = (HsRuleRn, SourceText)
+type instance XHsRule       GhcTc = (HsRuleRn, SourceText)
 
 type instance XXRuleDecl    (GhcPass _) = DataConCantHappen
 
@@ -1037,19 +1113,24 @@ type instance XRuleBndrSig  (GhcPass _) = EpAnn [AddEpAnn]
 type instance XXRuleBndr    (GhcPass _) = DataConCantHappen
 
 instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where
-  ppr (HsRules { rds_src = st
+  ppr (HsRules { rds_ext = ext
                , rds_rules = rules })
     = pprWithSourceText st (text "{-# RULES")
           <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
+              where st = case ghcPass @p of
+                           GhcPs | (_, st) <- ext -> st
+                           GhcRn -> ext
+                           GhcTc -> ext
 
 instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where
-  ppr (HsRule { rd_name = name
+  ppr (HsRule { rd_ext  = ext
+              , rd_name = name
               , rd_act  = act
               , rd_tyvs = tys
               , rd_tmvs = tms
               , rd_lhs  = lhs
               , rd_rhs  = rhs })
-        = sep [pprFullRuleName name <+> ppr act,
+        = sep [pprFullRuleName st name <+> ppr act,
                nest 4 (pp_forall_ty tys <+> pp_forall_tm tys
                                         <+> pprExpr (unLoc lhs)),
                nest 6 (equals <+> pprExpr (unLoc rhs)) ]
@@ -1058,11 +1139,19 @@ instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where
           pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot
           pp_forall_tm Nothing | null tms = empty
           pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot
+          st = case ghcPass @p of
+                 GhcPs | (_, st) <- ext -> st
+                 GhcRn | (_, st) <- ext -> st
+                 GhcTc | (_, st) <- ext -> st
 
 instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where
    ppr (RuleBndr _ name) = ppr name
    ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)
 
+pprFullRuleName :: SourceText -> GenLocated a (RuleName) -> SDoc
+pprFullRuleName st (L _ n) = pprWithSourceText st (doubleQuotes $ ftext n)
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1071,9 +1160,9 @@ instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where
 ************************************************************************
 -}
 
-type instance XWarnings      GhcPs = EpAnn [AddEpAnn]
-type instance XWarnings      GhcRn = NoExtField
-type instance XWarnings      GhcTc = NoExtField
+type instance XWarnings      GhcPs = (EpAnn [AddEpAnn], SourceText)
+type instance XWarnings      GhcRn = SourceText
+type instance XWarnings      GhcTc = SourceText
 
 type instance XXWarnDecls    (GhcPass _) = DataConCantHappen
 
@@ -1083,9 +1172,13 @@ type instance XXWarnDecl    (GhcPass _) = DataConCantHappen
 
 instance OutputableBndrId p
         => Outputable (WarnDecls (GhcPass p)) where
-    ppr (Warnings _ (SourceText src) decls)
+    ppr (Warnings ext decls)
       = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
-    ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"
+      where src = case ghcPass @p of
+              GhcPs | (_, SourceText src) <- ext -> src
+              GhcRn | SourceText src <- ext -> src
+              GhcTc | SourceText src <- ext -> src
+              _ -> panic "WarnDecls"
 
 instance OutputableBndrId p
        => Outputable (WarnDecl (GhcPass p)) where
@@ -1101,11 +1194,11 @@ instance OutputableBndrId p
 ************************************************************************
 -}
 
-type instance XHsAnnotation (GhcPass _) = EpAnn AnnPragma
+type instance XHsAnnotation (GhcPass _) = (EpAnn AnnPragma, SourceText)
 type instance XXAnnDecl     (GhcPass _) = DataConCantHappen
 
 instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where
-    ppr (HsAnnotation _ _ provenance expr)
+    ppr (HsAnnotation _ provenance expr)
       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
 
 pprAnnProvenance :: OutputableBndrId p => AnnProvenance (GhcPass p) -> SDoc
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 0a723cee11..ef849a17bb 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -231,6 +231,16 @@ deriving instance Data (ForeignDecl GhcPs)
 deriving instance Data (ForeignDecl GhcRn)
 deriving instance Data (ForeignDecl GhcTc)
 
+-- deriving instance (DataIdLR p p) => Data (ForeignImport p)
+deriving instance Data (ForeignImport GhcPs)
+deriving instance Data (ForeignImport GhcRn)
+deriving instance Data (ForeignImport GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ForeignExport p)
+deriving instance Data (ForeignExport GhcPs)
+deriving instance Data (ForeignExport GhcRn)
+deriving instance Data (ForeignExport GhcTc)
+
 -- deriving instance (DataIdLR p p) => Data (RuleDecls p)
 deriving instance Data (RuleDecls GhcPs)
 deriving instance Data (RuleDecls GhcRn)
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 7a21bcb391..0f8ce9fd5b 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -474,7 +474,7 @@ dsRule (L loc (HsRule { rd_name = name
               fn_name   = idName fn_id
               simpl_opts = initSimpleOpts dflags
               final_rhs = simpleOptExpr simpl_opts rhs''    -- De-crap it
-              rule_name = snd (unLoc name)
+              rule_name = unLoc name
               final_bndrs_set = mkVarSet final_bndrs
               arg_ids = filterOut (`elemVarSet` final_bndrs_set) $
                         exprsSomeFreeVarsList isId args
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 29bfb689e8..60212b0d23 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -93,8 +93,8 @@ dsForeigns' fos = do
 
    do_decl (ForeignExport { fd_name = L _ id
                           , fd_e_ext = co
-                          , fd_fe = CExport
-                              (L _ (CExportStatic _ ext_nm cconv)) _ }) = do
+                          , fd_fe = CExport _
+                              (L _ (CExportStatic _ ext_nm cconv)) }) = do
       (h, c, _, _) <- dsFExport id co ext_nm cconv False
       return (h, c, [id], [])
 
@@ -126,9 +126,9 @@ because it exposes the boxing to the call site.
 
 dsFImport :: Id
           -> Coercion
-          -> ForeignImport
+          -> ForeignImport (GhcPass p)
           -> DsM ([Binding], CHeader, CStub)
-dsFImport id co (CImport cconv safety mHeader spec _) =
+dsFImport id co (CImport _ cconv safety mHeader spec) =
     dsCImport id co spec (unLoc cconv) (unLoc safety) mHeader
 
 {-
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 57292e47f2..5ba188cbd8 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -735,8 +735,8 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn =
 
 repForD :: LForeignDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
 repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
-                                  , fd_fi = CImport (L _ cc)
-                                                    (L _ s) mch cis _ }))
+                                  , fd_fi = CImport _ (L _ cc)
+                                                    (L _ s) mch cis }))
  = do MkC name' <- lookupLOcc name
       MkC typ' <- repHsSigType typ
       MkC cc' <- repCCallConv cc
@@ -816,7 +816,7 @@ repRuleD (L loc (HsRule { rd_name = n
                          ; tm_bndrs' <- repListM ruleBndrTyConName
                                                 repRuleBndr
                                                 tm_bndrs
-                         ; n'   <- coreStringLit $ unpackFS $ snd $ unLoc n
+                         ; n'   <- coreStringLit $ unpackFS $ unLoc n
                          ; act' <- repPhases act
                          ; lhs' <- repLE lhs
                          ; rhs' <- repLE rhs
@@ -840,7 +840,7 @@ repRuleBndr (L _ (RuleBndrSig _ n sig))
        ; rep2 typedRuleVarName [n', ty'] }
 
 repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
-repAnnD (L loc (HsAnnotation _ _ ann_prov (L _ exp)))
+repAnnD (L loc (HsAnnotation _ ann_prov (L _ exp)))
   = do { target <- repAnnProv ann_prov
        ; exp'   <- repE exp
        ; dec    <- repPragAnn target exp'
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 553f872c29..43cd29bc1c 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1999,22 +1999,22 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where
         , toHie fe
         ]
 
-instance ToHie ForeignImport where
-  toHie (CImport (L a _) (L b _) _ _ (L c _)) = concatM $
+instance ToHie (ForeignImport GhcRn) where
+  toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $
     [ locOnly a
     , locOnly b
     , locOnly c
     ]
 
-instance ToHie ForeignExport where
-  toHie (CExport (L a _) (L b _)) = concatM $
+instance ToHie (ForeignExport GhcRn) where
+  toHie (CExport (L b _) (L a _)) = concatM $
     [ locOnly a
     , locOnly b
     ]
 
 instance ToHie (LocatedA (WarnDecls GhcRn)) where
   toHie (L span decl) = concatM $ makeNodeA decl span : case decl of
-      Warnings _ _ warnings ->
+      Warnings _ warnings ->
         [ toHie warnings
         ]
 
@@ -2026,7 +2026,7 @@ instance ToHie (LocatedA (WarnDecl GhcRn)) where
 
 instance ToHie (LocatedA (AnnDecl GhcRn)) where
   toHie (L span decl) = concatM $ makeNodeA decl span : case decl of
-      HsAnnotation _ _ prov expr ->
+      HsAnnotation _ prov expr ->
         [ toHie prov
         , toHie expr
         ]
@@ -2038,7 +2038,7 @@ instance ToHie (AnnProvenance GhcRn) where
 
 instance ToHie (LocatedA (RuleDecls GhcRn)) where
   toHie (L span decl) = concatM $ makeNodeA decl span : case decl of
-      HsRules _ _ rules ->
+      HsRules _ rules ->
         [ toHie rules
         ]
 
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 2731c6abd2..f0a7d69251 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1222,9 +1222,9 @@ topdecl :: { LHsDecl GhcPs }
         | 'default' '(' comma_types0 ')'        {% acsA (\cs -> sLL $1 $>
                                                     (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) }
         | 'foreign' fdecl                       {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) }
-        | '{-# DEPRECATED' deprecations '#-}'   {% acsA (\cs -> sLL $1 $> $ WarningD noExtField (Warnings (EpAnn (glR $1) [mo $1,mc $3] cs) (getDEPRECATED_PRAGs $1) (fromOL $2))) }
-        | '{-# WARNING' warnings '#-}'          {% acsA (\cs -> sLL $1 $> $ WarningD noExtField (Warnings (EpAnn (glR $1) [mo $1,mc $3] cs) (getWARNING_PRAGs $1) (fromOL $2))) }
-        | '{-# RULES' rules '#-}'               {% acsA (\cs -> sLL $1 $> $ RuleD noExtField (HsRules (EpAnn (glR $1) [mo $1,mc $3] cs) (getRULES_PRAGs $1) (reverse $2))) }
+        | '{-# DEPRECATED' deprecations '#-}'   {% acsA (\cs -> sLL $1 $> $ WarningD noExtField (Warnings ((EpAnn (glR $1) [mo $1,mc $3] cs), (getDEPRECATED_PRAGs $1)) (fromOL $2))) }
+        | '{-# WARNING' warnings '#-}'          {% acsA (\cs -> sLL $1 $> $ WarningD noExtField (Warnings ((EpAnn (glR $1) [mo $1,mc $3] cs), (getWARNING_PRAGs $1)) (fromOL $2))) }
+        | '{-# RULES' rules '#-}'               {% acsA (\cs -> sLL $1 $> $ RuleD noExtField (HsRules ((EpAnn (glR $1) [mo $1,mc $3] cs), (getRULES_PRAGs $1)) (reverse $2))) }
         | annotation { $1 }
         | decl_no_th                            { $1 }
 
@@ -1840,8 +1840,8 @@ rule    :: { LRuleDecl GhcPs }
          {%runPV (unECP $4) >>= \ $4 ->
            runPV (unECP $6) >>= \ $6 ->
            acsA (\cs -> (sLLlA $1 $> $ HsRule
-                                   { rd_ext = EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs
-                                   , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRINGs $1, getSTRING $1)
+                                   { rd_ext = (EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs, getSTRINGs $1)
+                                   , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1)
                                    , rd_act = (snd $2) `orElse` AlwaysActive
                                    , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3
                                    , rd_lhs = $4, rd_rhs = $6 })) }
@@ -1998,20 +1998,20 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
 annotation :: { LHsDecl GhcPs }
     : '{-# ANN' name_var aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->
                                             acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
-                                            (EpAnn (glR $1) (AnnPragma (mo $1) (mc $4) []) cs)
-                                            (getANN_PRAGs $1)
+                                            ((EpAnn (glR $1) (AnnPragma (mo $1) (mc $4) []) cs),
+                                            (getANN_PRAGs $1))
                                             (ValueAnnProvenance $2) $3)) }
 
     | '{-# ANN' 'type' otycon aexp '#-}' {% runPV (unECP $4) >>= \ $4 ->
                                             acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
-                                            (EpAnn (glR $1) (AnnPragma (mo $1) (mc $5) [mj AnnType $2]) cs)
-                                            (getANN_PRAGs $1)
+                                            ((EpAnn (glR $1) (AnnPragma (mo $1) (mc $5) [mj AnnType $2]) cs),
+                                            (getANN_PRAGs $1))
                                             (TypeAnnProvenance $3) $4)) }
 
     | '{-# ANN' 'module' aexp '#-}'      {% runPV (unECP $3) >>= \ $3 ->
                                             acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
-                                                (EpAnn (glR $1) (AnnPragma (mo $1) (mc $4) [mj AnnModule $2]) cs)
-                                                (getANN_PRAGs $1)
+                                                ((EpAnn (glR $1) (AnnPragma (mo $1) (mc $4) [mj AnnModule $2]) cs),
+                                                (getANN_PRAGs $1))
                                                  ModuleAnnProvenance $3)) }
 
 -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 486517ea2b..97768931e9 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2650,7 +2650,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =
                              PsErrMalformedEntityString
         Just importSpec -> return importSpec
 
-    isCWrapperImport (CImport _ _ _ CWrapper _) = True
+    isCWrapperImport (CImport _ _ _ _ CWrapper) = True
     isCWrapperImport _ = False
 
     -- currently, all the other import conventions only support a symbol name in
@@ -2661,7 +2661,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =
                         then mkExtName (unLoc v)
                         else entity
         funcTarget = CFunction (StaticTarget esrc entity' Nothing True)
-        importSpec = CImport cconv safety Nothing funcTarget (L loc esrc)
+        importSpec = CImport (L loc esrc) cconv safety Nothing funcTarget
 
     returnSpec spec = return $ \ann -> ForD noExtField $ ForeignImport
           { fd_i_ext  = ann
@@ -2677,7 +2677,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =
 -- that one.
 parseCImport :: Located CCallConv -> Located Safety -> FastString -> String
              -> Located SourceText
-             -> Maybe ForeignImport
+             -> Maybe (ForeignImport (GhcPass p))
 parseCImport cconv safety nm str sourceText =
  listToMaybe $ map fst $ filter (null.snd) $
      readP_to_S parse str
@@ -2704,7 +2704,7 @@ parseCImport cconv safety nm str sourceText =
                        | id_char c -> pfail
                       _            -> return ()
 
-   mk h n = CImport cconv safety h n sourceText
+   mk h n = CImport sourceText cconv safety h n
 
    hdr_char c = not (isSpace c)
    -- header files are filenames, which can contain
@@ -2739,8 +2739,7 @@ mkExport :: Located CCallConv
 mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty)
  = return $ \ann -> ForD noExtField $
    ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty
-                 , fd_fe = CExport (L lc (CExportStatic esrc entity' cconv))
-                                   (L le esrc) }
+                 , fd_fe = CExport (L le esrc) (L lc (CExportStatic esrc entity' cconv)) }
   where
     entity' | nullFS entity = mkExtName (unLoc v)
             | otherwise     = entity
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index be6dd17006..f34235b52d 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -319,12 +319,12 @@ findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (
 -}
 
 rnAnnDecl :: AnnDecl GhcPs -> RnM (AnnDecl GhcRn, FreeVars)
-rnAnnDecl ann@(HsAnnotation _ s provenance expr)
+rnAnnDecl ann@(HsAnnotation (_, s) provenance expr)
   = addErrCtxt (annCtxt ann) $
     do { (provenance', provenance_fvs) <- rnAnnProvenance provenance
        ; (expr', expr_fvs) <- setStage (Splice Untyped) $
                               rnLExpr expr
-       ; return (HsAnnotation noAnn s provenance' expr',
+       ; return (HsAnnotation (noAnn, s) provenance' expr',
                  provenance_fvs `plusFV` expr_fvs) }
 
 rnAnnProvenance :: AnnProvenance GhcPs
@@ -381,7 +381,7 @@ rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
        ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
        ; return (ForeignExport { fd_e_ext = noExtField
                                , fd_name = name', fd_sig_ty = ty'
-                               , fd_fe = spec }
+                               , fd_fe = (\(CExport x c) -> CExport x c) spec }
                 , fvs `addOneFV` unLoc name') }
         -- NB: a foreign export is an *occurrence site* for name, so
         --     we add it to the free-variable list.  It might, for example,
@@ -392,9 +392,9 @@ rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
 --      package, so if they get inlined across a package boundary we'll still
 --      know where they're from.
 --
-patchForeignImport :: Unit -> ForeignImport -> ForeignImport
-patchForeignImport unit (CImport cconv safety fs spec src)
-        = CImport cconv safety fs (patchCImportSpec unit spec) src
+patchForeignImport :: Unit -> (ForeignImport GhcPs) -> (ForeignImport GhcRn)
+patchForeignImport unit (CImport ext cconv safety fs spec)
+        = CImport ext cconv safety fs (patchCImportSpec unit spec)
 
 patchCImportSpec :: Unit -> CImportSpec -> CImportSpec
 patchCImportSpec unit spec
@@ -1219,15 +1219,15 @@ standaloneDerivErr
 -}
 
 rnHsRuleDecls :: RuleDecls GhcPs -> RnM (RuleDecls GhcRn, FreeVars)
-rnHsRuleDecls (HsRules { rds_src = src
+rnHsRuleDecls (HsRules { rds_ext = (_, src)
                        , rds_rules = rules })
   = do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules
-       ; return (HsRules { rds_ext = noExtField
-                         , rds_src = src
+       ; return (HsRules { rds_ext = src
                          , rds_rules = rn_rules }, fvs) }
 
 rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars)
-rnHsRuleDecl (HsRule { rd_name = rule_name
+rnHsRuleDecl (HsRule { rd_ext  = (_, st)
+                     , rd_name = rule_name
                      , rd_act  = act
                      , rd_tyvs = tyvs
                      , rd_tmvs = tmvs
@@ -1238,13 +1238,13 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
        ; checkDupRdrNamesN rdr_names_w_loc
        ; checkShadowedRdrNames rdr_names_w_loc
        ; names <- newLocalBndrsRn rdr_names_w_loc
-       ; let doc = RuleCtx (snd $ unLoc rule_name)
+       ; let doc = RuleCtx (unLoc rule_name)
        ; bindRuleTyVars doc tyvs $ \ tyvs' ->
          bindRuleTmVars doc tyvs' tmvs names $ \ tmvs' ->
     do { (lhs', fv_lhs') <- rnLExpr lhs
        ; (rhs', fv_rhs') <- rnLExpr rhs
-       ; checkValidRule (snd $ unLoc rule_name) names lhs' fv_lhs'
-       ; return (HsRule { rd_ext  = HsRuleRn fv_lhs' fv_rhs'
+       ; checkValidRule (unLoc rule_name) names lhs' fv_lhs'
+       ; return (HsRule { rd_ext  = (HsRuleRn fv_lhs' fv_rhs', st)
                         , rd_name = rule_name
                         , rd_act  = act
                         , rd_tyvs = tyvs'
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 1e52a526fe..e8c3c6e411 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1732,7 +1732,7 @@ data TcRnMessage where
 
     Test cases: ffi/should_fail/T20116
   -}
-  TcRnForeignImportPrimExtNotSet :: ForeignImport -> TcRnMessage
+  TcRnForeignImportPrimExtNotSet :: ForeignImport p -> TcRnMessage
 
   {- TcRnForeignImportPrimSafeAnn is an error declaring that the safe/unsafe
      annotation should not be used with @prim@ foreign imports.
@@ -1742,7 +1742,7 @@ data TcRnMessage where
 
     Test cases: None
   -}
-  TcRnForeignImportPrimSafeAnn :: ForeignImport -> TcRnMessage
+  TcRnForeignImportPrimSafeAnn :: ForeignImport p -> TcRnMessage
 
   {- TcRnForeignFunctionImportAsValue is an error explaining that foreign @value@
      imports cannot have function types.
@@ -1752,7 +1752,7 @@ data TcRnMessage where
 
     Test cases: ffi/should_fail/capi_value_function
   -}
-  TcRnForeignFunctionImportAsValue :: ForeignImport -> TcRnMessage
+  TcRnForeignFunctionImportAsValue :: ForeignImport p -> TcRnMessage
 
   {- TcRnFunPtrImportWithoutAmpersand is a warning controlled by @-Wdodgy-foreign-imports@
      that informs the user of a possible missing @&@ in the declaration of a
@@ -1763,7 +1763,7 @@ data TcRnMessage where
 
     Test cases: ffi/should_compile/T1357
   -}
-  TcRnFunPtrImportWithoutAmpersand :: ForeignImport -> TcRnMessage
+  TcRnFunPtrImportWithoutAmpersand :: ForeignImport p -> TcRnMessage
 
   {- TcRnIllegalForeignDeclBackend is an error occurring when a foreign import declaration
      is not compatible with the code generation backend being used.
@@ -1773,7 +1773,7 @@ data TcRnMessage where
     Test cases: None
   -}
   TcRnIllegalForeignDeclBackend
-    :: Either ForeignExport ForeignImport
+    :: Either (ForeignExport p) (ForeignImport p)
     -> Backend
     -> ExpectedBackends
     -> TcRnMessage
@@ -1787,7 +1787,7 @@ data TcRnMessage where
 
     Test cases: None
   -}
-  TcRnUnsupportedCallConv :: Either ForeignExport ForeignImport -> UnsupportedCallConvention -> TcRnMessage
+  TcRnUnsupportedCallConv :: Either (ForeignExport p) (ForeignImport p) -> UnsupportedCallConvention -> TcRnMessage
 
   {- TcRnIllegalForeignType is an error for when a type appears in a foreign
      function signature that is not compatible with the FFI.
diff --git a/compiler/GHC/Tc/Gen/Annotation.hs b/compiler/GHC/Tc/Gen/Annotation.hs
index 61c4e192b0..202e18ee74 100644
--- a/compiler/GHC/Tc/Gen/Annotation.hs
+++ b/compiler/GHC/Tc/Gen/Annotation.hs
@@ -48,7 +48,7 @@ warnAnns anns@(L loc _ : _)
        ; return [] }
 
 tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
-tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do
+tcAnnotation (L loc ann@(HsAnnotation _ provenance expr)) = do
     -- Work out what the full target of this annotation was
     mod <- getModule
     let target = annProvenanceToTarget mod provenance
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 819c66b2c2..ea251c2bcb 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -264,9 +264,9 @@ tcFImport d = pprPanic "tcFImport" (ppr d)
 
 -- ------------ Checking types for foreign import ----------------------
 
-tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
+tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport GhcRn -> TcM (ForeignImport GhcTc)
 
-tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh l@(CLabel _) src)
+tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh l@(CLabel _))
   -- Foreign import label
   = do checkCg (Right idecl) backendValidityOfCImport
        -- NB check res_ty not sig_ty!
@@ -274,9 +274,9 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh l@(CLabel _)
        check (isFFILabelTy (mkVisFunTys arg_tys res_ty))
              (TcRnIllegalForeignType Nothing)
        cconv' <- checkCConv (Right idecl) cconv
-       return (CImport (L lc cconv') safety mh l src)
+       return (CImport src (L lc cconv') safety mh l)
 
-tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh CWrapper src) = do
+tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh CWrapper) = do
         -- Foreign wrapper (former f.e.d.)
         -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
         -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.
@@ -292,10 +292,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh CWrapper src)
                   where
                      (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
         _ -> addErrTc (TcRnIllegalForeignType Nothing OneArgExpected)
-    return (CImport (L lc cconv') safety mh CWrapper src)
+    return (CImport src (L lc cconv') safety mh CWrapper)
 
-tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
-                                            (CFunction target) src)
+tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh
+                                            (CFunction target))
   | isDynamicTarget target = do -- Foreign import dynamic
       checkCg (Right idecl) backendValidityOfCImport
       cconv' <- checkCConv (Right idecl) cconv
@@ -310,7 +310,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
                 (TcRnIllegalForeignType (Just Arg))
           checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
           checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
-      return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src
+      return $ CImport src (L lc cconv') (L ls safety) mh (CFunction target)
   | cconv == PrimCallConv = do
       dflags <- getDynFlags
       checkTc (xopt LangExt.GHCForeignImportPrim dflags)
@@ -322,7 +322,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
       -- prim import result is more liberal, allows (#,,#)
       checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
-      return idecl
+      return (CImport src (L lc cconv) (L ls safety) mh (CFunction target))
   | otherwise = do              -- Normal foreign import
       checkCg (Right idecl) backendValidityOfCImport
       cconv' <- checkCConv (Right idecl) cconv
@@ -336,18 +336,18 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
            | not (null arg_tys) ->
               addErrTc (TcRnForeignFunctionImportAsValue idecl)
           _ -> return ()
-      return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src
+      return $ CImport src (L lc cconv') (L ls safety) mh (CFunction target)
 
 -- This makes a convenient place to check
 -- that the C identifier is valid for C
-checkCTarget :: ForeignImport -> CCallTarget -> TcM ()
+checkCTarget :: ForeignImport p -> CCallTarget -> TcM ()
 checkCTarget idecl (StaticTarget _ str _ _) = do
     checkCg (Right idecl) backendValidityOfCImport
     checkTc (isCLabelString str) (TcRnInvalidCIdentifier str)
 
 checkCTarget _ DynamicTarget = panic "checkCTarget DynamicTarget"
 
-checkMissingAmpersand :: ForeignImport -> [Type] -> Type -> TcM ()
+checkMissingAmpersand :: ForeignImport p -> [Type] -> Type -> TcM ()
 checkMissingAmpersand idecl arg_tys res_ty
   | null arg_tys && isFunPtrTy res_ty
   = addDiagnosticTc $ TcRnFunPtrImportWithoutAmpersand idecl
@@ -413,14 +413,14 @@ tcFExport d = pprPanic "tcFExport" (ppr d)
 
 -- ------------ Checking argument types for foreign export ----------------------
 
-tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
-tcCheckFEType sig_ty edecl@(CExport (L l (CExportStatic esrc str cconv)) src) = do
+tcCheckFEType :: Type -> ForeignExport GhcRn -> TcM (ForeignExport GhcTc)
+tcCheckFEType sig_ty edecl@(CExport src (L l (CExportStatic esrc str cconv))) = do
     checkCg (Left edecl) backendValidityOfCExport
     checkTc (isCLabelString str) (TcRnInvalidCIdentifier str)
     cconv' <- checkCConv (Left edecl) cconv
     checkForeignArgs isFFIExternalTy arg_tys
     checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
-    return (CExport (L l (CExportStatic esrc str cconv')) src)
+    return (CExport src (L l (CExportStatic esrc str cconv')))
   where
       -- Drop the foralls before inspecting
       -- the structure of the foreign type.
@@ -497,7 +497,7 @@ checkSafe, noCheckSafe :: Bool
 checkSafe   = True
 noCheckSafe = False
 
-checkCg :: Either ForeignExport ForeignImport -> (Backend -> Validity' ExpectedBackends) -> TcM ()
+checkCg :: Either (ForeignExport p) (ForeignImport p) -> (Backend -> Validity' ExpectedBackends) -> TcM ()
 checkCg decl check = do
     dflags <- getDynFlags
     let bcknd = backend dflags
@@ -508,7 +508,7 @@ checkCg decl check = do
 
 -- Calling conventions
 
-checkCConv :: Either ForeignExport ForeignImport -> CCallConv -> TcM CCallConv
+checkCConv :: Either (ForeignExport p) (ForeignImport p) -> CCallConv -> TcM CCallConv
 checkCConv _ CCallConv    = return CCallConv
 checkCConv _ CApiConv     = return CApiConv
 checkCConv decl StdCallConv = do
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index 1aae9a5ece..38572d7341 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -103,23 +103,22 @@ tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTc]
 tcRules decls = mapM (wrapLocMA tcRuleDecls) decls
 
 tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTc)
-tcRuleDecls (HsRules { rds_src = src
+tcRuleDecls (HsRules { rds_ext = src
                      , rds_rules = decls })
    = do { tc_decls <- mapM (wrapLocMA tcRule) decls
-        ; return $ HsRules { rds_ext   = noExtField
-                           , rds_src   = src
+        ; return $ HsRules { rds_ext   = src
                            , rds_rules = tc_decls } }
 
 tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTc)
 tcRule (HsRule { rd_ext  = ext
-               , rd_name = rname@(L _ (_,name))
+               , rd_name = rname@(L _ name)
                , rd_act  = act
                , rd_tyvs = ty_bndrs
                , rd_tmvs = tm_bndrs
                , rd_lhs  = lhs
                , rd_rhs  = rhs })
   = addErrCtxt (ruleCtxt name)  $
-    do { traceTc "---- Rule ------" (pprFullRuleName rname)
+    do { traceTc "---- Rule ------" (pprFullRuleName (snd ext) rname)
        ; skol_info <- mkSkolemInfo (RuleSkol name)
         -- Note [Typechecking rules]
        ; (tc_lvl, stuff) <- pushTcLevelM $
@@ -128,7 +127,7 @@ tcRule (HsRule { rd_ext  = ext
        ; let (id_bndrs, lhs', lhs_wanted
                       , rhs', rhs_wanted, rule_ty) = stuff
 
-       ; traceTc "tcRule 1" (vcat [ pprFullRuleName rname
+       ; traceTc "tcRule 1" (vcat [ pprFullRuleName (snd ext) rname
                                   , ppr lhs_wanted
                                   , ppr rhs_wanted ])
 
@@ -157,7 +156,7 @@ tcRule (HsRule { rd_ext  = ext
              quant_cands = forall_tkvs { dv_kvs = weed_out (dv_kvs forall_tkvs)
                                        , dv_tvs = weed_out (dv_tvs forall_tkvs) }
        ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars quant_cands
-       ; traceTc "tcRule" (vcat [ pprFullRuleName rname
+       ; traceTc "tcRule" (vcat [ pprFullRuleName (snd ext) rname
                                 , text "forall_tkvs:" <+> ppr forall_tkvs
                                 , text "quant_cands:" <+> ppr quant_cands
                                 , text "don't_default:" <+> ppr don't_default
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 9594927da3..52861159d5 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -758,11 +758,10 @@ cvtForD (ImportF callconv safety from nm ty) =
      ; if -- the prim and javascript calling conventions do not support headers
           -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess
           |  callconv == TH.Prim || callconv == TH.JavaScript
-          -> mk_imp (CImport (L l (cvt_conv callconv)) (L l safety') Nothing
+          -> mk_imp (CImport (L l $ quotedSourceText from) (L l (cvt_conv callconv)) (L l safety') Nothing
                              (CFunction (StaticTarget (SourceText from)
                                                       (mkFastString from) Nothing
-                                                      True))
-                             (L l $ quotedSourceText from))
+                                                      True)))
           |  Just impspec <- parseCImport (L l (cvt_conv callconv)) (L l safety')
                                           (mkFastString (TH.nameBase nm))
                                           from (L l $ quotedSourceText from)
@@ -787,10 +786,9 @@ cvtForD (ExportF callconv as nm ty)
   = do  { nm' <- vNameN nm
         ; ty' <- cvtSigType ty
         ; l <- getL
-        ; let e = CExport (L l (CExportStatic (SourceText as)
-                                              (mkFastString as)
-                                              (cvt_conv callconv)))
-                                              (L l (SourceText as))
+        ; let e = CExport (L l (SourceText as)) (L l (CExportStatic (SourceText as)
+                                                (mkFastString as)
+                                                (cvt_conv callconv))) 
         ; return $ ForeignExport { fd_e_ext = noAnn
                                  , fd_name = nm'
                                  , fd_sig_ty = ty'
@@ -861,14 +859,14 @@ cvtPragmaD (SpecialiseInstP ty)
 
 cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
   = do { let nm' = mkFastString nm
-       ; rd_name' <- returnLA (quotedSourceText nm,nm')
+       ; rd_name' <- returnLA nm'
        ; let act = cvtPhases phases AlwaysActive
        ; ty_bndrs' <- traverse cvtTvs ty_bndrs
        ; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs
        ; lhs'   <- cvtl lhs
        ; rhs'   <- cvtl rhs
        ; rule <- returnLA $
-                   HsRule { rd_ext  = noAnn
+                   HsRule { rd_ext  = (noAnn, quotedSourceText nm)
                           , rd_name = rd_name'
                           , rd_act  = act
                           , rd_tyvs = ty_bndrs'
@@ -876,8 +874,7 @@ cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
                           , rd_lhs  = lhs'
                           , rd_rhs  = rhs' }
        ; returnJustLA $ Hs.RuleD noExtField
-            $ HsRules { rds_ext = noAnn
-                      , rds_src = SourceText "{-# RULES"
+            $ HsRules { rds_ext = (noAnn, SourceText "{-# RULES")
                       , rds_rules = [rule] }
 
           }
@@ -893,7 +890,7 @@ cvtPragmaD (AnnP target exp)
            n' <- vcName n
            wrapParLA ValueAnnProvenance n'
        ; returnJustLA $ Hs.AnnD noExtField
-                     $ HsAnnotation noAnn (SourceText "{-# ANN") target' exp'
+                     $ HsAnnotation (noAnn, (SourceText "{-# ANN")) target' exp'
        }
 
 -- NB: This is the only place in GHC.ThToHs that makes use of the `setL`
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index 22f2116b04..c6193af03b 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -31,9 +31,9 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Pat
 import Language.Haskell.Syntax.Extension
 import Language.Haskell.Syntax.Type
 
-import GHC.Types.Basic (InlinePragma)
 import GHC.Types.Fixity
 import GHC.Data.Bag
+import GHC.Types.Basic (InlinePragma)
 
 import GHC.Data.BooleanFormula (LBooleanFormula)
 import GHC.Types.SourceText (StringLiteral)
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 0e0f0ff94c..0e013b3eea 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -46,7 +46,7 @@ module Language.Haskell.Syntax.Decls (
   FamilyDecl(..), LFamilyDecl,
 
   -- ** Instance declarations
-  InstDecl(..), LInstDecl, FamilyInfo(..), pprFlavour,
+  InstDecl(..), LInstDecl, FamilyInfo(..),
   TyFamInstDecl(..), LTyFamInstDecl,
   TyFamDefltDecl, LTyFamDefltDecl,
   DataFamInstDecl(..), LDataFamInstDecl,
@@ -57,12 +57,10 @@ module Language.Haskell.Syntax.Decls (
   DerivDecl(..), LDerivDecl,
   -- ** Deriving strategies
   DerivStrategy(..), LDerivStrategy,
-  derivStrategyName,
   -- ** @RULE@ declarations
   LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),
   RuleBndr(..),LRuleBndr,
   collectRuleBndrSigTys,
-  pprFullRuleName,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
   -- ** Template haskell declaration splice
@@ -111,15 +109,12 @@ import GHC.Types.Name.Set
 import GHC.Types.Fixity
 
 -- others:
-import GHC.Utils.Outputable
 import GHC.Utils.Misc
 import GHC.Types.SrcLoc
-import GHC.Types.SourceText
 import GHC.Core.Type
 import GHC.Unit.Module.Warnings
 
-import Data.Maybe
-import Data.Data        hiding (TyCon,Fixity, Infix)
+import Data.Data        hiding (TyCon, Fixity, Infix)
 import Data.Void
 
 {-
@@ -259,9 +254,6 @@ data SpliceDecoration
   | BareSplice    -- ^ bare splice
   deriving (Data, Eq, Show)
 
-instance Outputable SpliceDecoration where
-  ppr x = text $ show x
-
 {-
 ************************************************************************
 *                                                                      *
@@ -884,18 +876,6 @@ data FamilyInfo pass
   | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
 
 
-------------- Pretty printing FamilyDecls -----------
-
-pprFlavour :: FamilyInfo pass -> SDoc
-pprFlavour DataFamily            = text "data"
-pprFlavour OpenTypeFamily        = text "type"
-pprFlavour (ClosedTypeFamily {}) = text "type"
-
-instance Outputable (FamilyInfo pass) where
-  ppr info = pprFlavour info <+> text "family"
-
-
-
 {- *********************************************************************
 *                                                                      *
                Data types and data constructors
@@ -1231,10 +1211,6 @@ data HsConDeclGADTDetails pass
    = PrefixConGADT [HsScaled pass (LBangType pass)]
    | RecConGADT (XRec pass [LConDeclField pass]) (LHsUniToken "->" "→" pass)
 
-instance Outputable NewOrData where
-  ppr NewType  = text "newtype"
-  ppr DataType = text "data"
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1482,14 +1458,6 @@ data DerivStrategy pass
   | ViaStrategy (XViaStrategy pass)
                      -- ^ @-XDerivingVia@
 
--- | A short description of a @DerivStrategy'@.
-derivStrategyName :: DerivStrategy a -> SDoc
-derivStrategyName = text . go
-  where
-    go StockStrategy    {} = "stock"
-    go AnyclassStrategy {} = "anyclass"
-    go NewtypeStrategy  {} = "newtype"
-    go ViaStrategy      {} = "via"
 
 {-
 ************************************************************************
@@ -1538,13 +1506,13 @@ data ForeignDecl pass
       { fd_i_ext  :: XForeignImport pass   -- Post typechecker, rep_ty ~ sig_ty
       , fd_name   :: LIdP pass             -- defines this name
       , fd_sig_ty :: LHsSigType pass       -- sig_ty
-      , fd_fi     :: ForeignImport }
+      , fd_fi     :: ForeignImport pass }
 
   | ForeignExport
       { fd_e_ext  :: XForeignExport pass   -- Post typechecker, rep_ty ~ sig_ty
       , fd_name   :: LIdP pass             -- uses this name
       , fd_sig_ty :: LHsSigType pass       -- sig_ty
-      , fd_fe     :: ForeignExport }
+      , fd_fe     :: ForeignExport pass }
         -- ^
         --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForeign',
         --           'GHC.Parser.Annotation.AnnImport','GHC.Parser.Annotation.AnnExport',
@@ -1565,27 +1533,26 @@ data ForeignDecl pass
 -- Specification Of an imported external entity in dependence on the calling
 -- convention
 --
-data ForeignImport = -- import of a C entity
-                     --
-                     --  * the two strings specifying a header file or library
-                     --   may be empty, which indicates the absence of a
-                     --   header or object specification (both are not used
-                     --   in the case of `CWrapper' and when `CFunction'
-                     --   has a dynamic target)
-                     --
-                     --  * the calling convention is irrelevant for code
-                     --   generation in the case of `CLabel', but is needed
-                     --   for pretty printing
-                     --
-                     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
-                     --
-                     CImport  (Located CCallConv) -- ccall or stdcall
-                              (Located Safety)  -- interruptible, safe or unsafe
-                              (Maybe Header)       -- name of C header
-                              CImportSpec          -- details of the C entity
-                              (Located SourceText) -- original source text for
-                                                   -- the C entity
-  deriving Data
+data ForeignImport pass = -- import of a C entity
+                          --
+                          --  * the two strings specifying a header file or library
+                          --   may be empty, which indicates the absence of a
+                          --   header or object specification (both are not used
+                          --   in the case of `CWrapper' and when `CFunction'
+                          --   has a dynamic target)
+                          --
+                          --  * the calling convention is irrelevant for code
+                          --   generation in the case of `CLabel', but is needed
+                          --   for pretty printing
+                          --
+                          --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
+                          --
+                          CImport  (XCImport pass)
+                                   (Located CCallConv) -- ccall or stdcall
+                                   (Located Safety)  -- interruptible, safe or unsafe
+                                   (Maybe Header)       -- name of C header
+                                   CImportSpec          -- details of the C entity
+                        | XForeignImport !(XXForeignImport pass)
 
 -- details of an external C entity
 --
@@ -1598,46 +1565,9 @@ data CImportSpec = CLabel    CLabelString     -- import address of a C label
 -- specification of an externally exported entity in dependence on the calling
 -- convention
 --
-data ForeignExport = CExport  (Located CExportSpec) -- contains the calling
-                                                    -- convention
-                              (Located SourceText)  -- original source text for
-                                                    -- the C entity
-  deriving Data
-
--- pretty printing of foreign declarations
---
+data ForeignExport pass = CExport  (XCExport pass) (Located CExportSpec) -- contains the calling convention
+                        | XForeignExport !(XXForeignExport pass)
 
-instance Outputable ForeignImport where
-  ppr (CImport  cconv safety mHeader spec (L _ srcText)) =
-    ppr cconv <+> ppr safety
-      <+> pprWithSourceText srcText (pprCEntity spec "")
-    where
-      pp_hdr = case mHeader of
-               Nothing -> empty
-               Just (Header _ header) -> ftext header
-
-      pprCEntity (CLabel lbl) _ =
-        doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl
-      pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =
-        if dqNeeded then doubleQuotes ce else empty
-          where
-            dqNeeded = (take 6 src == "static")
-                    || isJust mHeader
-                    || not isFun
-                    || st /= NoSourceText
-            ce =
-                  -- We may need to drop leading spaces first
-                  (if take 6 src == "static" then text "static" else empty)
-              <+> pp_hdr
-              <+> (if isFun then empty else text "value")
-              <+> (pprWithSourceText st empty)
-      pprCEntity (CFunction DynamicTarget) _ =
-        doubleQuotes $ text "dynamic"
-      pprCEntity CWrapper _ = doubleQuotes $ text "wrapper"
-
-instance Outputable ForeignExport where
-  ppr (CExport  (L _ (CExportStatic _ lbl cconv)) _) =
-    ppr cconv <+> char '"' <> ppr lbl <> char '"'
 
 {-
 ************************************************************************
@@ -1650,10 +1580,8 @@ instance Outputable ForeignExport where
 -- | Located Rule Declarations
 type LRuleDecls pass = XRec pass (RuleDecls pass)
 
-  -- Note [Pragma source text] in GHC.Types.SourceText
 -- | Rule Declarations
 data RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass
-                              , rds_src   :: SourceText
                               , rds_rules :: [LRuleDecl pass] }
   | XRuleDecls !(XXRuleDecls pass)
 
@@ -1665,7 +1593,7 @@ data RuleDecl pass
   = HsRule -- Source rule
        { rd_ext  :: XHsRule pass
            -- ^ After renamer, free-vars from the LHS and RHS
-       , rd_name :: XRec pass (SourceText,RuleName)
+       , rd_name :: XRec pass RuleName
            -- ^ Note [Pragma source text] in "GHC.Types.Basic"
        , rd_act  :: Activation
        , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)]
@@ -1705,9 +1633,6 @@ data RuleBndr pass
 collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass]
 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
 
-pprFullRuleName :: GenLocated a (SourceText, RuleName) -> SDoc
-pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1728,10 +1653,6 @@ data DocDecl pass
 
 deriving instance (Data pass, Data (IdP pass)) => Data (DocDecl pass)
 
--- Okay, I need to reconstruct the document comments, but for now:
-instance Outputable (DocDecl name) where
-  ppr _ = text "<document comment>"
-
 docDeclDoc :: DocDecl pass -> LHsDoc pass
 docDeclDoc (DocCommentNext d) = d
 docDeclDoc (DocCommentPrev d) = d
@@ -1751,10 +1672,8 @@ We use exported entities for things to deprecate.
 -- | Located Warning Declarations
 type LWarnDecls pass = XRec pass (WarnDecls pass)
 
- -- Note [Pragma source text] in GHC.Types.SourceText
 -- | Warning pragma Declarations
 data WarnDecls pass = Warnings { wd_ext      :: XWarnings pass
-                               , wd_src      :: SourceText
                                , wd_warnings :: [LWarnDecl pass]
                                }
   | XWarnDecls !(XXWarnDecls pass)
@@ -1781,7 +1700,6 @@ type LAnnDecl pass = XRec pass (AnnDecl pass)
 -- | Annotation Declaration
 data AnnDecl pass = HsAnnotation
                       (XHsAnnotation pass)
-                      SourceText -- Note [Pragma source text] in GHC.Types.SourceText
                       (AnnProvenance pass) (XRec pass (HsExpr pass))
       -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
       --           'GHC.Parser.Annotation.AnnType'
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 6312681f52..74cdbb07e0 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -354,6 +354,10 @@ type family XXDefaultDecl      x
 type family XForeignImport     x
 type family XForeignExport     x
 type family XXForeignDecl      x
+type family XCImport           x
+type family XXForeignImport    x
+type family XCExport           x
+type family XXForeignExport    x
 
 -- -------------------------------------
 -- RuleDecls type families