Prune L.H.S modules of GHC dependencies

Move around datatypes, functions and instances that are GHC-specific out
of the `Language.Haskell.Syntax.*` modules to reduce the GHC
dependencies in them -- progressing towards #21592

Creates a module `Language.Haskell.Syntax.Basic` to hold basic
definitions required by the other L.H.S modules (and don't belong in any
of them)

29 files changed, 403 insertions, 329 deletions

diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 686d9e6b25..c08031c223 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -600,6 +600,10 @@ pprTicks pp_no_debug pp_when_debug
          then pp_when_debug
          else pp_no_debug
 
+instance Outputable (XRec a RdrName) => Outputable (RecordPatSynField a) where
+    ppr (RecordPatSynField { recordPatSynField = v }) = ppr v
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -651,20 +655,28 @@ instance OutputableBndrId p => Outputable (IPBind (GhcPass p)) where
 type instance XTypeSig          (GhcPass p) = EpAnn AnnSig
 type instance XPatSynSig        (GhcPass p) = EpAnn AnnSig
 type instance XClassOpSig       (GhcPass p) = EpAnn AnnSig
-type instance XIdSig            (GhcPass p) = NoExtField -- No anns, generated
 type instance XFixSig           (GhcPass p) = EpAnn [AddEpAnn]
 type instance XInlineSig        (GhcPass p) = EpAnn [AddEpAnn]
 type instance XSpecSig          (GhcPass p) = EpAnn [AddEpAnn]
-type instance XSpecInstSig      (GhcPass p) = EpAnn [AddEpAnn]
-type instance XMinimalSig       (GhcPass p) = EpAnn [AddEpAnn]
-type instance XSCCFunSig        (GhcPass p) = EpAnn [AddEpAnn]
-type instance XCompleteMatchSig (GhcPass p) = EpAnn [AddEpAnn]
-
-type instance XXSig             (GhcPass p) = DataConCantHappen
+type instance XSpecInstSig      (GhcPass p) = (EpAnn [AddEpAnn], SourceText)
+type instance XMinimalSig       (GhcPass p) = (EpAnn [AddEpAnn], SourceText)
+type instance XSCCFunSig        (GhcPass p) = (EpAnn [AddEpAnn], SourceText)
+type instance XCompleteMatchSig (GhcPass p) = (EpAnn [AddEpAnn], SourceText)
+    -- SourceText: Note [Pragma source text] in GHC.Types.SourceText
+type instance XXSig             GhcPs = DataConCantHappen
+type instance XXSig             GhcRn = IdSig
+type instance XXSig             GhcTc = IdSig
 
 type instance XFixitySig  (GhcPass p) = NoExtField
 type instance XXFixitySig (GhcPass p) = DataConCantHappen
 
+-- | A type signature in generated code, notably the code
+-- generated for record selectors. We simply record the desired Id
+-- itself, replete with its name, type and IdDetails. Otherwise it's
+-- just like a type signature: there should be an accompanying binding
+newtype IdSig = IdSig { unIdSig :: Id }
+    deriving Data
+
 data AnnSig
   = AnnSig {
       asDcolon :: AddEpAnn, -- Not an EpaAnchor to capture unicode option
@@ -714,7 +726,6 @@ ppr_sig (TypeSig _ vars ty)  = pprVarSig (map unLoc vars) (ppr ty)
 ppr_sig (ClassOpSig _ is_deflt vars ty)
   | is_deflt                 = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
   | otherwise                = pprVarSig (map unLoc vars) (ppr ty)
-ppr_sig (IdSig _ id)         = pprVarSig [id] (ppr (varType id))
 ppr_sig (FixSig _ fix_sig)   = ppr fix_sig
 ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))
   = pragSrcBrackets (inlinePragmaSource inl) pragmaSrc (pprSpec (unLoc var)
@@ -729,20 +740,20 @@ ppr_sig (InlineSig _ var inl)
       ppr_pfx = case inlinePragmaSource inl of
         SourceText src -> text src
         NoSourceText   -> text "{-#" <+> inlinePragmaName (inl_inline inl)
-ppr_sig (SpecInstSig _ src ty)
+ppr_sig (SpecInstSig (_, src) ty)
   = pragSrcBrackets src "{-# pragma" (text "instance" <+> ppr ty)
-ppr_sig (MinimalSig _ src bf)
+ppr_sig (MinimalSig (_, src) bf)
   = pragSrcBrackets src "{-# MINIMAL" (pprMinimalSig bf)
 ppr_sig (PatSynSig _ names sig_ty)
   = text "pattern" <+> pprVarSig (map unLoc names) (ppr sig_ty)
-ppr_sig (SCCFunSig _ src fn mlabel)
+ppr_sig (SCCFunSig (_, src) fn mlabel)
   = pragSrcBrackets src "{-# SCC" (ppr_fn <+> maybe empty ppr mlabel )
       where
         ppr_fn = case ghcPass @p of
           GhcPs -> ppr fn
           GhcRn -> ppr fn
           GhcTc -> ppr fn
-ppr_sig (CompleteMatchSig _ src cs mty)
+ppr_sig (CompleteMatchSig (_, src) cs mty)
   = pragSrcBrackets src "{-# COMPLETE"
       ((hsep (punctuate comma (map ppr_n (unLoc cs))))
         <+> opt_sig)
@@ -752,6 +763,40 @@ ppr_sig (CompleteMatchSig _ src cs mty)
         GhcPs -> ppr n
         GhcRn -> ppr n
         GhcTc -> ppr n
+ppr_sig (XSig x) = case ghcPass @p of
+                      GhcRn | IdSig id <- x -> pprVarSig [id] (ppr (varType id))
+                      GhcTc | IdSig id <- x -> pprVarSig [id] (ppr (varType id))
+
+hsSigDoc :: forall p. IsPass p => Sig (GhcPass p) -> SDoc
+hsSigDoc (TypeSig {})           = text "type signature"
+hsSigDoc (PatSynSig {})         = text "pattern synonym signature"
+hsSigDoc (ClassOpSig _ is_deflt _ _)
+ | is_deflt                     = text "default type signature"
+ | otherwise                    = text "class method signature"
+hsSigDoc (SpecSig _ _ _ inl)    = (inlinePragmaName . inl_inline $ inl) <+> text "pragma"
+hsSigDoc (InlineSig _ _ prag)   = (inlinePragmaName . inl_inline $ prag) <+> text "pragma"
+-- Using the 'inlinePragmaName' function ensures that the pragma name for any
+-- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted
+-- from the InlineSpec field of the pragma.
+hsSigDoc (SpecInstSig (_, src) _)  = text (extractSpecPragName src) <+> text "instance pragma"
+hsSigDoc (FixSig {})            = text "fixity declaration"
+hsSigDoc (MinimalSig {})        = text "MINIMAL pragma"
+hsSigDoc (SCCFunSig {})         = text "SCC pragma"
+hsSigDoc (CompleteMatchSig {})  = text "COMPLETE pragma"
+hsSigDoc (XSig _)               = case ghcPass @p of
+                                    GhcRn -> text "id signature"
+                                    GhcTc -> text "id signature"
+
+-- | Extracts the name for a SPECIALIZE instance pragma. In 'hsSigDoc', the src
+-- field of 'SpecInstSig' signature contains the SourceText for a SPECIALIZE
+-- instance pragma of the form: "SourceText {-# SPECIALIZE"
+--
+-- Extraction ensures that all variants of the pragma name (with a 'Z' or an
+-- 'S') are output exactly as used in the pragma.
+extractSpecPragName :: SourceText -> String
+extractSpecPragName srcTxt =  case (words $ show srcTxt) of
+     (_:_:pragName:_) -> filter (/= '\"') pragName
+     _                -> pprPanic "hsSigDoc: Misformed SPECIALISE instance pragma:" (ppr srcTxt)
 
 instance OutputableBndrId p
        => Outputable (FixitySig (GhcPass p)) where
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index 3b9b6948c6..838e3348dd 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -25,14 +25,15 @@ import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr( pprExpr )
 
-import Language.Haskell.Syntax.Lit
-
+import GHC.Types.Basic (PprPrec(..), topPrec )
+import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
 import GHC.Types.SourceText
 import GHC.Core.Type
 import GHC.Utils.Outputable
+import GHC.Hs.Extension
 import Language.Haskell.Syntax.Expr ( HsExpr )
 import Language.Haskell.Syntax.Extension
-import GHC.Hs.Extension
+import Language.Haskell.Syntax.Lit
 
 {-
 ************************************************************************
@@ -103,6 +104,37 @@ type instance XXOverLit (GhcPass _) = DataConCantHappen
 overLitType :: HsOverLit GhcTc -> Type
 overLitType (OverLit OverLitTc{ ol_type = ty } _) = ty
 
+-- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal
+-- @ol@ needs to be parenthesized under precedence @p@.
+hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
+hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
+  where
+    go :: OverLitVal -> Bool
+    go (HsIntegral x)   = p > topPrec && il_neg x
+    go (HsFractional x) = p > topPrec && fl_neg x
+    go (HsIsString {})  = False
+hsOverLitNeedsParens _ (XOverLit { }) = False
+
+-- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
+-- to be parenthesized under precedence @p@.
+hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
+hsLitNeedsParens p = go
+  where
+    go (HsChar {})        = False
+    go (HsCharPrim {})    = False
+    go (HsString {})      = False
+    go (HsStringPrim {})  = False
+    go (HsInt _ x)        = p > topPrec && il_neg x
+    go (HsIntPrim _ x)    = p > topPrec && x < 0
+    go (HsWordPrim {})    = False
+    go (HsInt64Prim _ x)  = p > topPrec && x < 0
+    go (HsWord64Prim {})  = False
+    go (HsInteger _ x _)  = p > topPrec && x < 0
+    go (HsRat _ x _)      = p > topPrec && fl_neg x
+    go (HsFloatPrim _ x)  = p > topPrec && fl_neg x
+    go (HsDoublePrim _ x) = p > topPrec && fl_neg x
+    go (XLit _)           = False
+
 -- | Convert a literal from one index type to another
 convertLit :: HsLit (GhcPass p1) -> HsLit (GhcPass p2)
 convertLit (HsChar a x)       = HsChar a x
@@ -161,6 +193,11 @@ instance OutputableBndrId p
   ppr (OverLit {ol_val=val, ol_ext=ext})
         = ppr val <+> (whenPprDebug (parens (pprXOverLit (ghcPass @p) ext)))
 
+instance Outputable OverLitVal where
+  ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))
+  ppr (HsFractional f)   = ppr f
+  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)
+
 -- | pmPprHsLit pretty prints literals and is used when pretty printing pattern
 -- match warnings. All are printed the same (i.e., without hashes if they are
 -- primitive and not wrapped in constructors if they are boxed). This happens
@@ -181,3 +218,4 @@ pmPprHsLit (HsInteger _ i _)  = integer i
 pmPprHsLit (HsRat _ f _)      = ppr f
 pmPprHsLit (HsFloatPrim _ f)  = ppr f
 pmPprHsLit (HsDoublePrim _ d) = ppr d
+
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 102587026e..2b8eb269bb 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -260,6 +261,24 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS
 ************************************************************************
 -}
 
+instance Outputable (HsPatSigType p) => Outputable (HsConPatTyArg p) where
+  ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty
+
+instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot)
+      => Outputable (HsRecFields p arg) where
+  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
+        = braces (fsep (punctuate comma (map ppr flds)))
+  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })
+        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
+        where
+          dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))
+
+instance (Outputable p, OutputableBndr p, Outputable arg)
+      => Outputable (HsFieldBind p arg) where
+  ppr (HsFieldBind { hfbLHS = f, hfbRHS = arg,
+                     hfbPun = pun })
+    = pprPrefixOcc f <+> (ppUnless pun $ equals <+> ppr arg)
+
 instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
     ppr = pprPat
 
@@ -734,3 +753,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
 type instance Anno (HsOverLit (GhcPass p)) = SrcAnn NoEpAnns
 type instance Anno ConLike = SrcSpanAnnN
 type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
+type instance Anno RecFieldsDotDot = SrcSpan
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 1635019dbe..73709e2849 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -112,8 +113,10 @@ import GHC.Hs.Doc
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable
+import GHC.Utils.Misc (count)
 
 import Data.Maybe
+import Data.Data (Data)
 
 import qualified Data.Semigroup as S
 
@@ -207,6 +210,14 @@ type instance XHsPS GhcPs = EpAnnCO
 type instance XHsPS GhcRn = HsPSRn
 type instance XHsPS GhcTc = HsPSRn
 
+-- | The extension field for 'HsPatSigType', which is only used in the
+-- renamer onwards. See @Note [Pattern signature binders and scoping]@.
+data HsPSRn = HsPSRn
+  { hsps_nwcs    :: [Name] -- ^ Wildcard names
+  , hsps_imp_tvs :: [Name] -- ^ Implicitly bound variable names
+  }
+  deriving Data
+
 type instance XXHsPatSigType (GhcPass _) = DataConCantHappen
 
 type instance XHsSig (GhcPass _) = NoExtField
@@ -533,6 +544,66 @@ lhsTypeArgSrcSpan arg = case arg of
 
 --------------------------------
 
+numVisibleArgs :: [HsArg tm ty] -> Arity
+numVisibleArgs = count is_vis
+  where is_vis (HsValArg _) = True
+        is_vis _            = False
+
+--------------------------------
+
+-- | @'pprHsArgsApp' id fixity args@ pretty-prints an application of @id@
+-- to @args@, using the @fixity@ to tell whether @id@ should be printed prefix
+-- or infix. Examples:
+--
+-- @
+-- pprHsArgsApp T Prefix [HsTypeArg Bool, HsValArg Int]                        = T \@Bool Int
+-- pprHsArgsApp T Prefix [HsTypeArg Bool, HsArgPar, HsValArg Int]              = (T \@Bool) Int
+-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double]                    = Char ++ Double
+-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
+-- @
+pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
+             => id -> LexicalFixity -> [HsArg tm ty] -> SDoc
+pprHsArgsApp thing fixity (argl:argr:args)
+  | Infix <- fixity
+  = let pp_op_app = hsep [ ppr_single_hs_arg argl
+                         , pprInfixOcc thing
+                         , ppr_single_hs_arg argr ] in
+    case args of
+      [] -> pp_op_app
+      _  -> ppr_hs_args_prefix_app (parens pp_op_app) args
+
+pprHsArgsApp thing _fixity args
+  = ppr_hs_args_prefix_app (pprPrefixOcc thing) args
+
+-- | Pretty-print a prefix identifier to a list of 'HsArg's.
+ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
+                        => SDoc -> [HsArg tm ty] -> SDoc
+ppr_hs_args_prefix_app acc []         = acc
+ppr_hs_args_prefix_app acc (arg:args) =
+  case arg of
+    HsValArg{}  -> ppr_hs_args_prefix_app (acc <+> ppr_single_hs_arg arg) args
+    HsTypeArg{} -> ppr_hs_args_prefix_app (acc <+> ppr_single_hs_arg arg) args
+    HsArgPar{}  -> ppr_hs_args_prefix_app (parens acc) args
+
+-- | Pretty-print an 'HsArg' in isolation.
+ppr_single_hs_arg :: (Outputable tm, Outputable ty)
+                  => HsArg tm ty -> SDoc
+ppr_single_hs_arg (HsValArg tm)    = ppr tm
+ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty
+-- GHC shouldn't be constructing ASTs such that this case is ever reached.
+-- Still, it's possible some wily user might construct their own AST that
+-- allows this to be reachable, so don't fail here.
+ppr_single_hs_arg (HsArgPar{})     = empty
+
+-- | This instance is meant for debug-printing purposes. If you wish to
+-- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
+instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
+  ppr (HsValArg tm)     = text "HsValArg"  <+> ppr tm
+  ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty
+  ppr (HsArgPar sp)     = text "HsArgPar"  <+> ppr sp
+
+--------------------------------
+
 -- | Decompose a pattern synonym type signature into its constituent parts.
 --
 -- Note that this function looks through parentheses, so it will work on types
@@ -919,6 +990,41 @@ instance (OutputableBndrId p)
        => Outputable (HsPatSigType (GhcPass p)) where
     ppr (HsPS { hsps_body = ty }) = ppr ty
 
+
+instance Outputable HsTyLit where
+    ppr = ppr_tylit
+
+instance Outputable HsIPName where
+    ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters
+
+instance OutputableBndr HsIPName where
+    pprBndr _ n   = ppr n         -- Simple for now
+    pprInfixOcc  n = ppr n
+    pprPrefixOcc n = ppr n
+
+instance (Outputable tyarg, Outputable arg, Outputable rec)
+         => Outputable (HsConDetails tyarg arg rec) where
+  ppr (PrefixCon tyargs args) = text "PrefixCon:" <+> hsep (map (\t -> text "@" <> ppr t) tyargs) <+> ppr args
+  ppr (RecCon rec)            = text "RecCon:" <+> ppr rec
+  ppr (InfixCon l r)          = text "InfixCon:" <+> ppr [l, r]
+
+instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where
+  ppr = ppr . foLabel
+
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where
+  pprInfixOcc  = pprInfixOcc . unXRec @pass . foLabel
+  pprPrefixOcc = pprPrefixOcc . unXRec @pass . foLabel
+
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
+  pprInfixOcc  = pprInfixOcc . unLoc
+  pprPrefixOcc = pprPrefixOcc . unLoc
+
+
+ppr_tylit :: HsTyLit -> SDoc
+ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i)
+ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s))
+ppr_tylit (HsCharTy source c) = pprWithSourceText source (text (show c))
+
 pprAnonWildCard :: SDoc
 pprAnonWildCard = char '_'
 
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 0cc5907c2b..86b6347e09 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -27,7 +27,7 @@ import GHC.Platform
 
 import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr)
 
-import GHC.Types.Basic ( Origin(..), isGenerated, Boxity(..) )
+import GHC.Types.Basic ( Origin(..), isGenerated )
 import GHC.Types.SourceText
 import GHC.Driver.Session
 import GHC.Hs
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 015ecb56f6..57292e47f2 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -989,16 +989,16 @@ rep_sig (L loc (PatSynSig _ nms ty))
 rep_sig (L loc (ClassOpSig _ is_deflt nms ty))
   | is_deflt     = mapM (rep_ty_sig defaultSigDName (locA loc) ty) nms
   | otherwise    = mapM (rep_ty_sig sigDName (locA loc) ty) nms
-rep_sig d@(L _ (IdSig {}))           = pprPanic "rep_sig IdSig" (ppr d)
 rep_sig (L loc (FixSig _ fix_sig))   = rep_fix_d (locA loc) fix_sig
 rep_sig (L loc (InlineSig _ nm ispec))= rep_inline nm ispec (locA loc)
 rep_sig (L loc (SpecSig _ nm tys ispec))
   = concatMapM (\t -> rep_specialise nm t ispec (locA loc)) tys
-rep_sig (L loc (SpecInstSig _ _ ty))  = rep_specialiseInst ty (locA loc)
+rep_sig (L loc (SpecInstSig _ ty))  = rep_specialiseInst ty (locA loc)
 rep_sig (L _   (MinimalSig {}))       = notHandled ThMinimalPragmas
 rep_sig (L _   (SCCFunSig {}))        = notHandled ThSCCPragmas
-rep_sig (L loc (CompleteMatchSig _ _st cls mty))
+rep_sig (L loc (CompleteMatchSig _ cls mty))
   = rep_complete_sig cls mty (locA loc)
+rep_sig d@(L _ (XSig {}))             = pprPanic "rep_sig IdSig" (ppr d)
 
 -- Desugar the explicit type variable binders in an 'LHsSigType', making
 -- sure not to gensym them.
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index e3c6ef1333..083c59b3cf 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -66,7 +66,6 @@ import GHC.Core.PatSyn
 import GHC.Core.Type
 import GHC.Core.Coercion
 import GHC.Builtin.Types
-import GHC.Types.Basic
 import GHC.Core.ConLike
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index dab2a7e7ad..c1465bf0bc 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1698,7 +1698,6 @@ instance HiePass p => ToHie (SigContext (LocatedA (Sig (GhcPass p)))) where
               _  -> toHie $ map (C $ TyDecl) names
           , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ
           ]
-        IdSig _ _ -> []
         FixSig _ fsig ->
           [ toHie $ L sp fsig
           ]
@@ -1709,21 +1708,22 @@ instance HiePass p => ToHie (SigContext (LocatedA (Sig (GhcPass p)))) where
           [ toHie $ (C Use) name
           , toHie $ map (TS (ResolvedScopes [])) typs
           ]
-        SpecInstSig _ _ typ ->
+        SpecInstSig _ typ ->
           [ toHie $ TS (ResolvedScopes []) typ
           ]
-        MinimalSig _ _ form ->
+        MinimalSig _ form ->
           [ toHie form
           ]
-        SCCFunSig _ _ name mtxt ->
+        SCCFunSig _ name mtxt ->
           [ toHie $ (C Use) name
           , maybe (pure []) (locOnly . getLocA) mtxt
           ]
-        CompleteMatchSig _ _ (L ispan names) typ ->
+        CompleteMatchSig _ (L ispan names) typ ->
           [ locOnly ispan
           , toHie $ map (C Use) names
           , toHie $ fmap (C Use) typ
           ]
+        XSig _ -> []
 
 instance ToHie (TScoped (LocatedA (HsSigType GhcRn))) where
   toHie (TS tsc (L span t@HsSig{sig_bndrs=bndrs,sig_body=body})) = concatM $ makeNodeA t span :
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index be897a1d14..2731c6abd2 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2580,7 +2580,7 @@ sigdecl :: { LHsDecl GhcPs }
                 {% let (dcolon, tc) = $3
                    in acsA
                        (\cs -> sLL $1 $>
-                         (SigD noExtField (CompleteMatchSig (EpAnn (glR $1) ([ mo $1 ] ++ dcolon ++ [mc $4]) cs) (getCOMPLETE_PRAGs $1) $2 tc))) }
+                         (SigD noExtField (CompleteMatchSig ((EpAnn (glR $1) ([ mo $1 ] ++ dcolon ++ [mc $4]) cs), (getCOMPLETE_PRAGs $1)) $2 tc))) }
 
         -- This rule is for both INLINE and INLINABLE pragmas
         | '{-# INLINE' activation qvarcon '#-}'
@@ -2591,12 +2591,12 @@ sigdecl :: { LHsDecl GhcPs }
                 {% acsA (\cs -> (sLL $1 $> $ SigD noExtField (InlineSig (EpAnn (glR $1) [mo $1, mc $3] cs) $2
                             (mkOpaquePragma (getOPAQUE_PRAGs $1))))) }
         | '{-# SCC' qvar '#-}'
-          {% acsA (\cs -> sLL $1 $> (SigD noExtField (SCCFunSig (EpAnn (glR $1) [mo $1, mc $3] cs) (getSCC_PRAGs $1) $2 Nothing))) }
+          {% acsA (\cs -> sLL $1 $> (SigD noExtField (SCCFunSig ((EpAnn (glR $1) [mo $1, mc $3] cs), (getSCC_PRAGs $1)) $2 Nothing))) }
 
         | '{-# SCC' qvar STRING '#-}'
           {% do { scc <- getSCC $3
                 ; let str_lit = StringLiteral (getSTRINGs $3) scc Nothing
-                ; acsA (\cs -> sLL $1 $> (SigD noExtField (SCCFunSig (EpAnn (glR $1) [mo $1, mc $4] cs) (getSCC_PRAGs $1) $2 (Just ( sL1a $3 str_lit))))) }}
+                ; acsA (\cs -> sLL $1 $> (SigD noExtField (SCCFunSig ((EpAnn (glR $1) [mo $1, mc $4] cs), (getSCC_PRAGs $1)) $2 (Just ( sL1a $3 str_lit))))) }}
 
         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
              {% acsA (\cs ->
@@ -2611,11 +2611,11 @@ sigdecl :: { LHsDecl GhcPs }
 
         | '{-# SPECIALISE' 'instance' inst_type '#-}'
                 {% acsA (\cs -> sLL $1 $>
-                                  $ SigD noExtField (SpecInstSig (EpAnn (glR $1) [mo $1,mj AnnInstance $2,mc $4] cs) (getSPEC_PRAGs $1) $3)) }
+                                  $ SigD noExtField (SpecInstSig ((EpAnn (glR $1) [mo $1,mj AnnInstance $2,mc $4] cs), (getSPEC_PRAGs $1)) $3)) }
 
         -- A minimal complete definition
         | '{-# MINIMAL' name_boolformula_opt '#-}'
-            {% acsA (\cs -> sLL $1 $> $ SigD noExtField (MinimalSig (EpAnn (glR $1) [mo $1,mc $3] cs) (getMINIMAL_PRAGs $1) $2)) }
+            {% acsA (\cs -> sLL $1 $> $ SigD noExtField (MinimalSig ((EpAnn (glR $1) [mo $1,mc $3] cs), (getMINIMAL_PRAGs $1)) $2)) }
 
 activation :: { ([AddEpAnn],Maybe Activation) }
         -- See Note [%shift: activation -> {- empty -}]
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 70489c0048..5ade2db117 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -970,9 +970,6 @@ renameSigs ctxt sigs
 -- Doesn't seem worth much trouble to sort this.
 
 renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
-renameSig _ (IdSig _ x)
-  = return (IdSig noExtField x, emptyFVs)    -- Actually this never occurs
-
 renameSig ctxt sig@(TypeSig _ vs ty)
   = do  { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
         ; let doc = TypeSigCtx (ppr_sig_bndrs vs)
@@ -992,7 +989,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
     ty_ctxt = GenericCtx (text "a class method signature for"
                           <+> quotes (ppr v1))
 
-renameSig _ (SpecInstSig _ src ty)
+renameSig _ (SpecInstSig (_, src) ty)
   = do  { checkInferredVars doc inf_msg ty
         ; (new_ty, fvs) <- rnHsSigType doc TypeLevel ty
           -- Check if there are any nested `forall`s or contexts, which are
@@ -1001,7 +998,7 @@ renameSig _ (SpecInstSig _ src ty)
           -- GHC.Hs.Type).
         ; addNoNestedForallsContextsErr doc (text "SPECIALISE instance type")
             (getLHsInstDeclHead new_ty)
-        ; return (SpecInstSig noAnn src new_ty,fvs) }
+        ; return (SpecInstSig (noAnn, src) new_ty,fvs) }
   where
     doc = SpecInstSigCtx
     inf_msg = Just (text "Inferred type variables are not allowed")
@@ -1031,9 +1028,9 @@ renameSig ctxt (FixSig _ fsig)
   = do  { new_fsig <- rnSrcFixityDecl ctxt fsig
         ; return (FixSig noAnn new_fsig, emptyFVs) }
 
-renameSig ctxt sig@(MinimalSig _ s (L l bf))
+renameSig ctxt sig@(MinimalSig (_, s) (L l bf))
   = do new_bf <- traverse (lookupSigOccRnN ctxt sig) bf
-       return (MinimalSig noAnn s (L l new_bf), emptyFVs)
+       return (MinimalSig (noAnn, s) (L l new_bf), emptyFVs)
 
 renameSig ctxt sig@(PatSynSig _ vs ty)
   = do  { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
@@ -1043,13 +1040,13 @@ renameSig ctxt sig@(PatSynSig _ vs ty)
     ty_ctxt = GenericCtx (text "a pattern synonym signature for"
                           <+> ppr_sig_bndrs vs)
 
-renameSig ctxt sig@(SCCFunSig _ st v s)
+renameSig ctxt sig@(SCCFunSig (_, st) v s)
   = do  { new_v <- lookupSigOccRnN ctxt sig v
-        ; return (SCCFunSig noAnn st new_v s, emptyFVs) }
+        ; return (SCCFunSig (noAnn, st) new_v s, emptyFVs) }
 
 -- COMPLETE Sigs can refer to imported IDs which is why we use
 -- lookupLocatedOccRn rather than lookupSigOccRn
-renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)
+renameSig _ctxt sig@(CompleteMatchSig (_, s) (L l bf) mty)
   = do new_bf <- traverse lookupLocatedOccRn bf
        new_mty  <- traverse lookupLocatedOccRn mty
 
@@ -1058,7 +1055,7 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)
          -- Why 'any'? See Note [Orphan COMPLETE pragmas]
          addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError
 
-       return (CompleteMatchSig noAnn s (L l new_bf) new_mty, emptyFVs)
+       return (CompleteMatchSig (noAnn, s) (L l new_bf) new_mty, emptyFVs)
   where
     orphanError :: TcRnMessage
     orphanError = TcRnUnknownMessage $ mkPlainError noHints $
@@ -1108,10 +1105,6 @@ okHsSig ctxt (L _ sig)
      (FixSig {}, InstDeclCtxt {}) -> False
      (FixSig {}, _)               -> True
 
-     (IdSig {}, TopSigCtxt {})   -> True
-     (IdSig {}, InstDeclCtxt {}) -> True
-     (IdSig {}, _)               -> False
-
      (InlineSig {}, HsBootCtxt {}) -> False
      (InlineSig {}, _)             -> True
 
@@ -1132,6 +1125,11 @@ okHsSig ctxt (L _ sig)
      (CompleteMatchSig {}, TopSigCtxt {} ) -> True
      (CompleteMatchSig {}, _)              -> False
 
+     (XSig {}, TopSigCtxt {})   -> True
+     (XSig {}, InstDeclCtxt {}) -> True
+     (XSig {}, _)               -> False
+
+
 -------------------
 findDupSigs :: [LSig GhcPs] -> [NonEmpty (LocatedN RdrName, Sig GhcPs)]
 -- Check for duplicates on RdrName version,
@@ -1151,7 +1149,7 @@ findDupSigs sigs
     expand_sig sig@(TypeSig _ ns _)              = [(n,sig) | n <- ns]
     expand_sig sig@(ClassOpSig _ _ ns _)         = [(n,sig) | n <- ns]
     expand_sig sig@(PatSynSig _ ns  _ )          = [(n,sig) | n <- ns]
-    expand_sig sig@(SCCFunSig _ _ n _)           = [(n,sig)]
+    expand_sig sig@(SCCFunSig (_, _) n _)           = [(n,sig)]
     expand_sig _ = []
 
     matching_sig :: (LocatedN RdrName, Sig GhcPs) -> (LocatedN RdrName, Sig GhcPs) -> Bool --AZ
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index bbcd5244af..eacfe233dc 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -71,7 +71,7 @@ import GHC.Types.Error
 import GHC.Utils.Misc
 import GHC.Types.Fixity ( compareFixity, negateFixity
                         , Fixity(..), FixityDirection(..), LexicalFixity(..) )
-import GHC.Types.Basic  ( PromotionFlag(..), isPromoted, TypeOrKind(..) )
+import GHC.Types.Basic  ( TypeOrKind(..) )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 08c4ca664c..3db286e3e5 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -208,7 +208,7 @@ tcCompleteSigs sigs =
       -- combinations are invalid it will be found so at match sites.
       -- There it is also where we consider if the type of the pattern match is
       -- compatible with the result type constructor 'mb_tc'.
-      doOne (L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) mb_tc_nm))
+      doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) (L _ ns) mb_tc_nm))
         = fmap Just $ setSrcSpanA loc $ addErrCtxt (text "In" <+> ppr c) $ do
             cls   <- mkUniqDSet <$> mapM (addLocMA tcLookupConLike) ns
             mb_tc <- traverse @Maybe tcLookupLocatedTyCon mb_tc_nm
@@ -658,7 +658,7 @@ tcPolyCheck _prag_fn sig bind
 funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn]
              -> TcM [CoreTickish]
 funBindTicks loc fun_id mod sigs
-  | (mb_cc_str : _) <- [ cc_name | L _ (SCCFunSig _ _ _ cc_name) <- sigs ]
+  | (mb_cc_str : _) <- [ cc_name | L _ (SCCFunSig _ _ cc_name) <- sigs ]
       -- this can only be a singleton list, as duplicate pragmas are rejected
       -- by the renamer
   , let cc_str
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index e26fee1f98..cb7f5cfb56 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -1376,7 +1376,7 @@ desugarRecordUpd record_expr rbnds res_ty
              upd_ids_lhs = [ (NonRecursive, unitBag $ genSimpleFunBind (idName id) [] rhs)
                            | (_, (id, rhs)) <- upd_ids ]
              mk_idSig :: (Name, (Id, LHsExpr GhcRn)) -> LSig GhcRn
-             mk_idSig (_, (id, _)) = L gen $ IdSig noExtField id
+             mk_idSig (_, (id, _)) = L gen $ XSig $ IdSig id
                -- We let-bind variables using 'IdSig' in order to accept
                -- record updates involving higher-rank types.
                -- See Wrinkle [Using IdSig] in Note [Record Updates].
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 69e65ce2d1..ce5e3bd394 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -189,7 +189,7 @@ tcTySigs hs_sigs
        ; return (poly_ids, lookupNameEnv env) }
 
 tcTySig :: LSig GhcRn -> TcM [TcSigInfo]
-tcTySig (L _ (IdSig _ id))
+tcTySig (L _ (XSig (IdSig id)))
   = do { let ctxt = FunSigCtxt (idName id) NoRRC
                     -- NoRRC: do not report redundant constraints
                     -- The user has no control over the signature!
@@ -581,7 +581,7 @@ mkPragEnv sigs binds
     get_sig :: LSig GhcRn -> Maybe (Name, LSig GhcRn)
     get_sig sig@(L _ (SpecSig _ (L _ nm) _ _))   = Just (nm, add_arity nm sig)
     get_sig sig@(L _ (InlineSig _ (L _ nm) _))   = Just (nm, add_arity nm sig)
-    get_sig sig@(L _ (SCCFunSig _ _ (L _ nm) _)) = Just (nm, sig)
+    get_sig sig@(L _ (SCCFunSig _ (L _ nm) _)) = Just (nm, sig)
     get_sig _ = Nothing
 
     add_arity n sig  -- Adjust inl_sat field to match visible arity of function
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index 3dc6154c84..f1a576dcbc 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -13,7 +13,7 @@ module GHC.Tc.Instance.Typeable(mkTypeableBinds, tyConIsTypeable) where
 import GHC.Prelude
 import GHC.Platform
 
-import GHC.Types.Basic ( Boxity(..), neverInlinePragma )
+import GHC.Types.Basic ( neverInlinePragma )
 import GHC.Types.SourceText ( SourceText(..) )
 import GHC.Iface.Env( newGlobalBinder )
 import GHC.Core.TyCo.Rep( Type(..), TyLit(..) )
diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs
index ee41b3e0aa..dee46e9189 100644
--- a/compiler/GHC/Tc/TyCl/Class.hs
+++ b/compiler/GHC/Tc/TyCl/Class.hs
@@ -403,7 +403,7 @@ findMinimalDef :: [LSig GhcRn] -> Maybe ClassMinimalDef
 findMinimalDef = firstJusts . map toMinimalDef
   where
     toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef
-    toMinimalDef (L _ (MinimalSig _ _ (L _ bf))) = Just (fmap unLoc bf)
+    toMinimalDef (L _ (MinimalSig _ (L _ bf))) = Just (fmap unLoc bf)
     toMinimalDef _                               = Nothing
 
 {-
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 160d8ceae9..c99beb861e 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -2346,7 +2346,7 @@ tcSpecInstPrags dfun_id (InstBindings { ib_binds = binds, ib_pragmas = uprags })
 
 ------------------------------
 tcSpecInst :: Id -> Sig GhcRn -> TcM TcSpecPrag
-tcSpecInst dfun_id prag@(SpecInstSig _ _ hs_ty)
+tcSpecInst dfun_id prag@(SpecInstSig _ hs_ty)
   = addErrCtxt (spec_ctxt prag) $
     do  { spec_dfun_ty <- tcHsClsInstType SpecInstCtxt hs_ty
         ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index e102507d63..a77d6be317 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -853,14 +853,14 @@ when typechecking the [d| .. |] quote, and typecheck them later.
 
 tcRecSelBinds :: [(Id, LHsBind GhcRn)] -> TcM TcGblEnv
 tcRecSelBinds sel_bind_prs
-  = tcExtendGlobalValEnv [sel_id | (L _ (IdSig _ sel_id)) <- sigs] $
+  = tcExtendGlobalValEnv [sel_id | (L _ (XSig (IdSig sel_id))) <- sigs] $
     do { (rec_sel_binds, tcg_env) <- discardWarnings $
                                      -- See Note [Impredicative record selectors]
                                      setXOptM LangExt.ImpredicativeTypes $
                                      tcValBinds TopLevel binds sigs getGblEnv
        ; return (tcg_env `addTypecheckedBinds` map snd rec_sel_binds) }
   where
-    sigs = [ L (noAnnSrcSpan loc) (IdSig noExtField sel_id)
+    sigs = [ L (noAnnSrcSpan loc) (XSig $ IdSig sel_id)
                                              | (sel_id, _) <- sel_bind_prs
                                              , let loc = getSrcSpan sel_id ]
     binds = [(NonRecursive, unitBag bind) | (_, bind) <- sel_bind_prs]
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 441c84bad7..0432de43fa 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -857,7 +857,7 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
 cvtPragmaD (SpecialiseInstP ty)
   = do { ty' <- cvtSigType ty
        ; returnJustLA $ Hs.SigD noExtField $
-         SpecInstSig noAnn (SourceText "{-# SPECIALISE") ty' }
+         SpecInstSig (noAnn, (SourceText "{-# SPECIALISE")) ty' }
 
 cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
   = do { let nm' = mkFastString nm
@@ -906,7 +906,7 @@ cvtPragmaD (CompleteP cls mty)
   = do { cls'  <- wrapL $ mapM cNameN cls
        ; mty'  <- traverse tconNameN mty
        ; returnJustLA $ Hs.SigD noExtField
-                   $ CompleteMatchSig noAnn NoSourceText cls' mty' }
+                   $ CompleteMatchSig (noAnn, NoSourceText) cls' mty' }
 
 dfltActivation :: TH.Inline -> Activation
 dfltActivation TH.NoInline = NeverActive
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index a2decc2ba4..d5eba8c4ad 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -122,6 +122,8 @@ import GHC.Types.SourceText
 import qualified GHC.LanguageExtensions as LangExt
 import Data.Data
 import qualified Data.Semigroup as Semi
+import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
+import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
 
 {-
 ************************************************************************
@@ -195,12 +197,6 @@ type FullArgCount = Int
 ************************************************************************
 -}
 
--- | A *one-index* constructor tag
---
--- Type of the tags associated with each constructor possibility or superclass
--- selector
-type ConTag = Int
-
 -- | A *zero-indexed* constructor tag
 type ConTagZ = Int
 
@@ -401,16 +397,6 @@ unSwap IsSwapped  f a b = f b a
 *                                                                      *
 ********************************************************************* -}
 
--- | Is a TyCon a promoted data constructor or just a normal type constructor?
-data PromotionFlag
-  = NotPromoted
-  | IsPromoted
-  deriving ( Eq, Data )
-
-isPromoted :: PromotionFlag -> Bool
-isPromoted IsPromoted  = True
-isPromoted NotPromoted = False
-
 instance Outputable PromotionFlag where
   ppr NotPromoted = text "NotPromoted"
   ppr IsPromoted  = text "IsPromoted"
@@ -498,15 +484,6 @@ instance Outputable TopLevelFlag where
 ************************************************************************
 -}
 
-data Boxity
-  = Boxed
-  | Unboxed
-  deriving( Eq, Data )
-
-isBoxed :: Boxity -> Bool
-isBoxed Boxed   = True
-isBoxed Unboxed = False
-
 instance Outputable Boxity where
   ppr Boxed   = text "Boxed"
   ppr Unboxed = text "Unboxed"
diff --git a/compiler/Language/Haskell/Syntax/Basic.hs b/compiler/Language/Haskell/Syntax/Basic.hs
new file mode 100644
index 0000000000..ad3e0e94ba
--- /dev/null
+++ b/compiler/Language/Haskell/Syntax/Basic.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.Haskell.Syntax.Basic where
+
+import Data.Int (Int)
+
+import Data.Eq
+import Data.Bool
+import Data.Data
+
+
+{-
+************************************************************************
+*                                                                      *
+Boxity
+*                                                                      *
+************************************************************************
+-}
+
+data Boxity
+  = Boxed
+  | Unboxed
+  deriving( Eq, Data )
+
+isBoxed :: Boxity -> Bool
+isBoxed Boxed   = True
+isBoxed Unboxed = False
+
+{-
+************************************************************************
+*                                                                      *
+Counts and indices
+*                                                                      *
+************************************************************************
+-}
+
+-- | The width of an unboxed sum
+type SumWidth = Int
+
+-- | A *one-index* constructor tag
+--
+-- Type of the tags associated with each constructor possibility or superclass
+-- selector
+type ConTag = Int
+
+
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index c50eb7e833..467304af53 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -21,8 +21,6 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
 module Language.Haskell.Syntax.Binds where
 
-import GHC.Prelude
-
 import {-# SOURCE #-} Language.Haskell.Syntax.Expr
   ( LHsExpr
   , MatchGroup
@@ -32,19 +30,18 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Pat
 
 import Language.Haskell.Syntax.Extension
 import Language.Haskell.Syntax.Type
-import GHC.Types.Name.Reader(RdrName)
+
 import GHC.Types.Basic
-import GHC.Types.SourceText
 import GHC.Types.Tickish
-import GHC.Types.Var
 import GHC.Types.Fixity
 import GHC.Data.Bag
-import GHC.Data.BooleanFormula (LBooleanFormula)
 
-import GHC.Utils.Outputable
-import GHC.Utils.Panic (pprPanic)
+import GHC.Data.BooleanFormula (LBooleanFormula)
+import GHC.Types.SourceText (StringLiteral)
 
 import Data.Void
+import Data.Bool
+import Data.Maybe
 
 {-
 ************************************************************************
@@ -372,13 +369,6 @@ data Sig pass
       --           'GHC.Parser.Annotation.AnnDcolon'
   | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass)
 
-        -- | A type signature in generated code, notably the code
-        -- generated for record selectors.  We simply record
-        -- the desired Id itself, replete with its name, type
-        -- and IdDetails.  Otherwise it's just like a type
-        -- signature: there should be an accompanying binding
-  | IdSig (XIdSig pass) Id
-
         -- | An ordinary fixity declaration
         --
         -- >     infixl 8 ***
@@ -435,8 +425,7 @@ data Sig pass
         --      'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose'
 
         -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-  | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
-                  -- Note [Pragma source text] in GHC.Types.SourceText
+  | SpecInstSig (XSpecInstSig pass) (LHsSigType pass)
 
         -- | A minimal complete definition pragma
         --
@@ -447,9 +436,7 @@ data Sig pass
         --      'GHC.Parser.Annotation.AnnClose'
 
         -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-  | MinimalSig (XMinimalSig pass)
-               SourceText (LBooleanFormula (LIdP pass))
-               -- Note [Pragma source text] in GHC.Types.SourceText
+  | MinimalSig (XMinimalSig pass) (LBooleanFormula (LIdP pass))
 
         -- | A "set cost centre" pragma for declarations
         --
@@ -460,7 +447,6 @@ data Sig pass
         -- > {-# SCC funName "cost_centre_name" #-}
 
   | SCCFunSig  (XSCCFunSig pass)
-               SourceText     -- Note [Pragma source text] in GHC.Types.SourceText
                (LIdP pass)    -- Function name
                (Maybe (XRec pass StringLiteral))
        -- | A complete match pragma
@@ -471,7 +457,6 @@ data Sig pass
        -- complete matchings which, for example, arise from pattern
        -- synonym definitions.
   | CompleteMatchSig (XCompleteMatchSig pass)
-                     SourceText
                      (XRec pass [LIdP pass])
                      (Maybe (LIdP pass))
   | XSig !(XXSig pass)
@@ -490,7 +475,7 @@ isFixityLSig _                 = False
 isTypeLSig :: forall p. UnXRec p => LSig p -> Bool  -- Type signatures
 isTypeLSig (unXRec @p -> TypeSig {})    = True
 isTypeLSig (unXRec @p -> ClassOpSig {}) = True
-isTypeLSig (unXRec @p -> IdSig {})      = True
+isTypeLSig (unXRec @p -> XSig {})       = True
 isTypeLSig _                    = False
 
 isSpecLSig :: forall p. UnXRec p => LSig p -> Bool
@@ -526,36 +511,6 @@ isCompleteMatchSig :: forall p. UnXRec p => LSig p -> Bool
 isCompleteMatchSig (unXRec @p -> CompleteMatchSig {} ) = True
 isCompleteMatchSig _                            = False
 
-hsSigDoc :: Sig name -> SDoc
-hsSigDoc (TypeSig {})           = text "type signature"
-hsSigDoc (PatSynSig {})         = text "pattern synonym signature"
-hsSigDoc (ClassOpSig _ is_deflt _ _)
- | is_deflt                     = text "default type signature"
- | otherwise                    = text "class method signature"
-hsSigDoc (IdSig {})             = text "id signature"
-hsSigDoc (SpecSig _ _ _ inl)    = (inlinePragmaName . inl_inline $ inl) <+> text "pragma"
-hsSigDoc (InlineSig _ _ prag)   = (inlinePragmaName . inl_inline $ prag) <+> text "pragma"
--- Using the 'inlinePragmaName' function ensures that the pragma name for any
--- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted
--- from the InlineSpec field of the pragma.
-hsSigDoc (SpecInstSig _ src _)  = text (extractSpecPragName src) <+> text "instance pragma"
-hsSigDoc (FixSig {})            = text "fixity declaration"
-hsSigDoc (MinimalSig {})        = text "MINIMAL pragma"
-hsSigDoc (SCCFunSig {})         = text "SCC pragma"
-hsSigDoc (CompleteMatchSig {})  = text "COMPLETE pragma"
-hsSigDoc (XSig {})              = text "XSIG TTG extension"
-
--- | Extracts the name for a SPECIALIZE instance pragma. In 'hsSigDoc', the src
--- field of 'SpecInstSig' signature contains the SourceText for a SPECIALIZE
--- instance pragma of the form: "SourceText {-# SPECIALIZE"
---
--- Extraction ensures that all variants of the pragma name (with a 'Z' or an
--- 'S') are output exactly as used in the pragma.
-extractSpecPragName :: SourceText -> String
-extractSpecPragName srcTxt =  case (words $ show srcTxt) of
-     (_:_:pragName:_) -> filter (/= '\"') pragName
-     _                -> pprPanic "hsSigDoc: Misformed SPECIALISE instance pragma:" (ppr srcTxt)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -605,9 +560,6 @@ when we have a different name for the local and top-level binder,
 making the distinction between the two names clear.
 
 -}
-instance Outputable (XRec a RdrName) => Outputable (RecordPatSynField a) where
-    ppr (RecordPatSynField { recordPatSynField = v }) = ppr v
-
 
 -- | Haskell Pattern Synonym Direction
 data HsPatSynDir id
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index da5265a144..0e0f0ff94c 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -100,11 +100,13 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
 
 import Language.Haskell.Syntax.Binds
 import Language.Haskell.Syntax.Type
+import Language.Haskell.Syntax.Extension
+
 import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST
+
 import GHC.Core.TyCon
 import GHC.Types.Basic
 import GHC.Types.ForeignCall
-import Language.Haskell.Syntax.Extension
 import GHC.Types.Name.Set
 import GHC.Types.Fixity
 
@@ -116,7 +118,7 @@ import GHC.Types.SourceText
 import GHC.Core.Type
 import GHC.Unit.Module.Warnings
 
-import GHC.Data.Maybe
+import Data.Maybe
 import Data.Data        hiding (TyCon,Fixity, Infix)
 import Data.Void
 
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 8d2a365a8c..6d57489eb5 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -25,6 +25,7 @@ module Language.Haskell.Syntax.Expr where
 
 import GHC.Prelude
 
+import Language.Haskell.Syntax.Basic
 import Language.Haskell.Syntax.Decls
 import Language.Haskell.Syntax.Pat
 import Language.Haskell.Syntax.Lit
@@ -35,7 +36,6 @@ import Language.Haskell.Syntax.Binds
 -- others:
 import GHC.Core.DataCon (FieldLabelString)
 import GHC.Types.Name
-import GHC.Types.Basic
 import GHC.Types.Fixity
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
@@ -437,8 +437,8 @@ data HsExpr p
   --  the expression, (arity - alternative) after it
   | ExplicitSum
           (XExplicitSum p)
-          ConTag --  Alternative (one-based)
-          Arity  --  Sum arity
+          ConTag   --  Alternative (one-based)
+          SumWidth --  Sum arity
           (LHsExpr p)
 
   -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase',
diff --git a/compiler/Language/Haskell/Syntax/Lit.hs b/compiler/Language/Haskell/Syntax/Lit.hs
index 3000aa345c..a6f3e015b7 100644
--- a/compiler/Language/Haskell/Syntax/Lit.hs
+++ b/compiler/Language/Haskell/Syntax/Lit.hs
@@ -18,18 +18,21 @@
 -- | Source-language literals
 module Language.Haskell.Syntax.Lit where
 
-import GHC.Prelude
+import Language.Haskell.Syntax.Extension
 
-import GHC.Types.Basic (PprPrec(..), topPrec )
+import GHC.Utils.Panic
 import GHC.Types.SourceText
 import GHC.Core.Type
-import GHC.Utils.Outputable
-import GHC.Utils.Panic
+
 import GHC.Data.FastString
-import Language.Haskell.Syntax.Extension
 
 import Data.ByteString (ByteString)
 import Data.Data hiding ( Fixity )
+import Data.Bool
+import Data.Ord
+import Data.Eq
+import Data.Char
+import GHC.Integer (Integer) -- ROMES:TODO where is integer
 
 {-
 ************************************************************************
@@ -147,38 +150,3 @@ instance Ord OverLitVal where
   compare (HsIsString _ _)    (HsIntegral   _)    = GT
   compare (HsIsString _ _)    (HsFractional _)    = GT
 
-instance Outputable OverLitVal where
-  ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))
-  ppr (HsFractional f)   = ppr f
-  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)
-
--- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
--- to be parenthesized under precedence @p@.
-hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
-hsLitNeedsParens p = go
-  where
-    go (HsChar {})        = False
-    go (HsCharPrim {})    = False
-    go (HsString {})      = False
-    go (HsStringPrim {})  = False
-    go (HsInt _ x)        = p > topPrec && il_neg x
-    go (HsIntPrim _ x)    = p > topPrec && x < 0
-    go (HsWordPrim {})    = False
-    go (HsInt64Prim _ x)  = p > topPrec && x < 0
-    go (HsWord64Prim {})  = False
-    go (HsInteger _ x _)  = p > topPrec && x < 0
-    go (HsRat _ x _)      = p > topPrec && fl_neg x
-    go (HsFloatPrim _ x)  = p > topPrec && fl_neg x
-    go (HsDoublePrim _ x) = p > topPrec && fl_neg x
-    go (XLit _)           = False
-
--- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal
--- @ol@ needs to be parenthesized under precedence @p@.
-hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
-hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
-  where
-    go :: OverLitVal -> Bool
-    go (HsIntegral x)   = p > topPrec && il_neg x
-    go (HsFractional x) = p > topPrec && fl_neg x
-    go (HsIsString {})  = False
-hsOverLitNeedsParens _ (XOverLit { }) = False
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 12ef7ae98a..5846796de4 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -27,23 +27,27 @@ module Language.Haskell.Syntax.Pat (
         HsRecFields(..), HsFieldBind(..), LHsFieldBind,
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
+        RecFieldsDotDot,
         hsRecFields, hsRecFieldSel, hsRecFieldsArgs,
     ) where
 
-import GHC.Prelude
-
 import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntypedSplice)
 
 -- friends:
+import Language.Haskell.Syntax.Basic
 import Language.Haskell.Syntax.Lit
 import Language.Haskell.Syntax.Extension
 import Language.Haskell.Syntax.Type
-import GHC.Types.Basic
--- others:
-import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
-import GHC.Utils.Outputable
-import GHC.Types.SrcLoc
+
 -- libraries:
+import Data.Maybe
+import Data.Functor
+import Data.Foldable
+import Data.Traversable
+import Data.Bool
+import Data.Int
+import Data.Function
+import Data.List
 
 type LPat p = XRec p (Pat p)
 
@@ -132,7 +136,7 @@ data Pat p
   | SumPat      (XSumPat p)        -- after typechecker, types of the alternative
                 (LPat p)           -- Sum sub-pattern
                 ConTag             -- Alternative (one-based)
-                Arity              -- Arity (INVARIANT: ≥ 2)
+                SumWidth           -- Arity (INVARIANT: ≥ 2)
     -- ^ Anonymous sum pattern
     --
     -- - 'GHC.Parser.Annotation.AnnKeywordId' :
@@ -243,10 +247,12 @@ data HsRecFields p arg         -- A bunch of record fields
                                 --      { x = 3, y = True }
         -- Used for both expressions and patterns
   = HsRecFields { rec_flds   :: [LHsRecField p arg],
-                  rec_dotdot :: Maybe (Located Int) }  -- Note [DotDot fields]
+                  rec_dotdot :: Maybe (XRec p RecFieldsDotDot) }  -- Note [DotDot fields]
   -- AZ:The XRec for LHsRecField makes the derivings fail.
   -- deriving (Functor, Foldable, Traversable)
 
+-- Type synonym to be able to have a specific XRec instance for the Int in `rec_dotdot`
+type RecFieldsDotDot = Int
 
 -- Note [DotDot fields]
 -- ~~~~~~~~~~~~~~~~~~~~
@@ -353,29 +359,3 @@ hsRecFieldsArgs rbinds = map (hfbRHS . unXRec @p) (rec_flds rbinds)
 hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
 hsRecFieldSel = foExt . unXRec @p . hfbLHS
 
-
-{-
-************************************************************************
-*                                                                      *
-*              Printing patterns
-*                                                                      *
-************************************************************************
--}
-
-instance Outputable (HsPatSigType p) => Outputable (HsConPatTyArg p) where
-  ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty
-
-instance (Outputable arg, Outputable (XRec p (HsRecField p arg)))
-      => Outputable (HsRecFields p arg) where
-  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
-        = braces (fsep (punctuate comma (map ppr flds)))
-  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })
-        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
-        where
-          dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))
-
-instance (Outputable p, OutputableBndr p, Outputable arg)
-      => Outputable (HsFieldBind p arg) where
-  ppr (HsFieldBind { hfbLHS = f, hfbRHS = arg,
-                     hfbPun = pun })
-    = pprPrefixOcc f <+> (ppUnless pun $ equals <+> ppr arg)
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index e394628f25..9bd8aa90e2 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -30,18 +30,20 @@ module Language.Haskell.Syntax.Type (
         LHsQTyVars(..),
         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
         HsWildCardBndrs(..),
-        HsPatSigType(..), HsPSRn(..),
+        HsPatSigType(..),
         HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType,
         HsTupleSort(..),
         HsContext, LHsContext,
         HsTyLit(..),
         HsIPName(..), hsIPNameFS,
-        HsArg(..), numVisibleArgs, pprHsArgsApp,
+        HsArg(..),
         LHsTypeArg,
 
         LBangType, BangType,
         HsSrcBang(..), HsImplBang(..),
         SrcStrictness(..), SrcUnpackedness(..),
+        Boxity(..), PromotionFlag(..),
+        isBoxed, isPromoted,
 
         ConDeclField(..), LConDeclField,
 
@@ -56,29 +58,47 @@ module Language.Haskell.Syntax.Type (
         hsPatSigType,
     ) where
 
-import GHC.Prelude
-
 import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice )
 
 import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Basic
 
 import GHC.Types.SourceText
-import GHC.Types.Name( Name )
 import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.DataCon( HsSrcBang(..), HsImplBang(..),
                          SrcStrictness(..), SrcUnpackedness(..) )
 import GHC.Core.Type
-import GHC.Hs.Doc
-import GHC.Types.Basic
-import GHC.Types.Fixity
 import GHC.Types.SrcLoc
-import GHC.Utils.Outputable
-import GHC.Data.FastString
-import GHC.Utils.Misc ( count )
 import GHC.Parser.Annotation
 
+import GHC.Hs.Doc
+import GHC.Data.FastString
+
 import Data.Data hiding ( Fixity, Prefix, Infix )
 import Data.Void
+import Data.Maybe
+import Data.Eq
+import Data.Bool
+import Data.Char
+import GHC.Num (Integer)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Promotion flag}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Is a TyCon a promoted data constructor or just a normal type constructor?
+data PromotionFlag
+  = NotPromoted
+  | IsPromoted
+  deriving ( Eq, Data )
+
+isPromoted :: PromotionFlag -> Bool
+isPromoted IsPromoted  = True
+isPromoted NotPromoted = False
 
 {-
 ************************************************************************
@@ -422,14 +442,6 @@ data HsPatSigType pass
     }
   | XHsPatSigType !(XXHsPatSigType pass)
 
--- | The extension field for 'HsPatSigType', which is only used in the
--- renamer onwards. See @Note [Pattern signature binders and scoping]@.
-data HsPSRn = HsPSRn
-  { hsps_nwcs    :: [Name] -- ^ Wildcard names
-  , hsps_imp_tvs :: [Name] -- ^ Implicitly bound variable names
-  }
-  deriving Data
-
 -- | Located Haskell Signature Type
 type LHsSigType   pass = XRec pass (HsSigType pass)               -- Implicit only
 
@@ -680,14 +692,6 @@ newtype HsIPName = HsIPName FastString
 hsIPNameFS :: HsIPName -> FastString
 hsIPNameFS (HsIPName n) = n
 
-instance Outputable HsIPName where
-    ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters
-
-instance OutputableBndr HsIPName where
-    pprBndr _ n   = ppr n         -- Simple for now
-    pprInfixOcc  n = ppr n
-    pprPrefixOcc n = ppr n
-
 --------------------------------------------------
 
 -- | Haskell Type Variable Binder
@@ -1081,12 +1085,6 @@ data HsConDetails tyarg arg rec
 noTypeArgs :: [Void]
 noTypeArgs = []
 
-instance (Outputable tyarg, Outputable arg, Outputable rec)
-         => Outputable (HsConDetails tyarg arg rec) where
-  ppr (PrefixCon tyargs args) = text "PrefixCon:" <+> hsep (map (\t -> text "@" <> ppr t) tyargs) <+> ppr args
-  ppr (RecCon rec)            = text "RecCon:" <+> ppr rec
-  ppr (InfixCon l r)          = text "InfixCon:" <+> ppr [l, r]
-
 {-
 Note [ConDeclField passs]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1203,64 +1201,9 @@ data HsArg tm ty
                          -- SrcSpan is location of the `@`
   | HsArgPar SrcSpan -- See Note [HsArgPar]
 
-numVisibleArgs :: [HsArg tm ty] -> Arity
-numVisibleArgs = count is_vis
-  where is_vis (HsValArg _) = True
-        is_vis _            = False
-
 -- type level equivalent
 type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)
 
--- | @'pprHsArgsApp' id fixity args@ pretty-prints an application of @id@
--- to @args@, using the @fixity@ to tell whether @id@ should be printed prefix
--- or infix. Examples:
---
--- @
--- pprHsArgsApp T Prefix [HsTypeArg Bool, HsValArg Int]                        = T \@Bool Int
--- pprHsArgsApp T Prefix [HsTypeArg Bool, HsArgPar, HsValArg Int]              = (T \@Bool) Int
--- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double]                    = Char ++ Double
--- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
--- @
-pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
-             => id -> LexicalFixity -> [HsArg tm ty] -> SDoc
-pprHsArgsApp thing fixity (argl:argr:args)
-  | Infix <- fixity
-  = let pp_op_app = hsep [ ppr_single_hs_arg argl
-                         , pprInfixOcc thing
-                         , ppr_single_hs_arg argr ] in
-    case args of
-      [] -> pp_op_app
-      _  -> ppr_hs_args_prefix_app (parens pp_op_app) args
-
-pprHsArgsApp thing _fixity args
-  = ppr_hs_args_prefix_app (pprPrefixOcc thing) args
-
--- | Pretty-print a prefix identifier to a list of 'HsArg's.
-ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
-                        => SDoc -> [HsArg tm ty] -> SDoc
-ppr_hs_args_prefix_app acc []         = acc
-ppr_hs_args_prefix_app acc (arg:args) =
-  case arg of
-    HsValArg{}  -> ppr_hs_args_prefix_app (acc <+> ppr_single_hs_arg arg) args
-    HsTypeArg{} -> ppr_hs_args_prefix_app (acc <+> ppr_single_hs_arg arg) args
-    HsArgPar{}  -> ppr_hs_args_prefix_app (parens acc) args
-
--- | Pretty-print an 'HsArg' in isolation.
-ppr_single_hs_arg :: (Outputable tm, Outputable ty)
-                  => HsArg tm ty -> SDoc
-ppr_single_hs_arg (HsValArg tm)    = ppr tm
-ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty
--- GHC shouldn't be constructing ASTs such that this case is ever reached.
--- Still, it's possible some wily user might construct their own AST that
--- allows this to be reachable, so don't fail here.
-ppr_single_hs_arg (HsArgPar{})     = empty
-
--- | This instance is meant for debug-printing purposes. If you wish to
--- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
-instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
-  ppr (HsValArg tm)     = text "HsValArg"  <+> ppr tm
-  ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty
-  ppr (HsArgPar sp)     = text "HsArgPar"  <+> ppr sp
 {-
 Note [HsArgPar]
 ~~~~~~~~~~~~~~~
@@ -1276,8 +1219,6 @@ The SrcSpan is the span of the original HsPar
 
 -}
 
---------------------------------
-
 
 {-
 ************************************************************************
@@ -1312,17 +1253,6 @@ deriving instance (
   , Eq (XXFieldOcc pass)
   ) => Eq (FieldOcc pass)
 
-instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where
-  ppr = ppr . foLabel
-
-instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where
-  pprInfixOcc  = pprInfixOcc . unXRec @pass . foLabel
-  pprPrefixOcc = pprPrefixOcc . unXRec @pass . foLabel
-
-instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
-  pprInfixOcc  = pprInfixOcc . unLoc
-  pprPrefixOcc = pprPrefixOcc . unLoc
-
 -- | Located Ambiguous Field Occurence
 type LAmbiguousFieldOcc pass = XRec pass (AmbiguousFieldOcc pass)
 
@@ -1350,11 +1280,3 @@ data AmbiguousFieldOcc pass
 *                                                                      *
 ************************************************************************
 -}
-
-instance Outputable HsTyLit where
-    ppr = ppr_tylit
---------------------------
-ppr_tylit :: HsTyLit -> SDoc
-ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i)
-ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s))
-ppr_tylit (HsCharTy source c) = pprWithSourceText source (text (show c))
diff --git a/compiler/Language/Haskell/Syntax/Type.hs-boot b/compiler/Language/Haskell/Syntax/Type.hs-boot
new file mode 100644
index 0000000000..126355528a
--- /dev/null
+++ b/compiler/Language/Haskell/Syntax/Type.hs-boot
@@ -0,0 +1,21 @@
+module Language.Haskell.Syntax.Type where
+
+import Data.Bool
+import Data.Eq
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Promotion flag}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Is a TyCon a promoted data constructor or just a normal type constructor?
+data PromotionFlag
+  = NotPromoted
+  | IsPromoted
+
+instance Eq PromotionFlag
+
+isPromoted :: PromotionFlag -> Bool
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 92b70c9ff8..452b34cce6 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -799,6 +799,7 @@ Library
         GHC.Utils.Trace
 
         Language.Haskell.Syntax
+        Language.Haskell.Syntax.Basic
         Language.Haskell.Syntax.Binds
         Language.Haskell.Syntax.Decls
         Language.Haskell.Syntax.Expr