Module hierarchy: Hs (#13009)

Add GHC.Hs module hierarchy replacing hsSyn.

Metric Increase:
    haddock.compiler

17 files changed, 15488 insertions, 0 deletions

diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
new file mode 100644
index 0000000000..aa345f1476
--- /dev/null
+++ b/compiler/GHC/Hs.hs
@@ -0,0 +1,153 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section{Haskell abstract syntax definition}
+
+This module glues together the pieces of the Haskell abstract syntax,
+which is declared in the various \tr{Hs*} modules.  This module,
+therefore, is almost nothing but re-exporting.
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data
+
+module GHC.Hs (
+        module GHC.Hs.Binds,
+        module GHC.Hs.Decls,
+        module GHC.Hs.Expr,
+        module GHC.Hs.ImpExp,
+        module GHC.Hs.Lit,
+        module GHC.Hs.Pat,
+        module GHC.Hs.Types,
+        module GHC.Hs.Utils,
+        module GHC.Hs.Doc,
+        module GHC.Hs.PlaceHolder,
+        module GHC.Hs.Extension,
+        Fixity,
+
+        HsModule(..),
+) where
+
+-- friends:
+import GhcPrelude
+
+import GHC.Hs.Decls
+import GHC.Hs.Binds
+import GHC.Hs.Expr
+import GHC.Hs.ImpExp
+import GHC.Hs.Lit
+import GHC.Hs.PlaceHolder
+import GHC.Hs.Extension
+import GHC.Hs.Pat
+import GHC.Hs.Types
+import BasicTypes       ( Fixity, WarningTxt )
+import GHC.Hs.Utils
+import GHC.Hs.Doc
+import GHC.Hs.Instances () -- For Data instances
+
+-- others:
+import Outputable
+import SrcLoc
+import Module           ( ModuleName )
+
+-- libraries:
+import Data.Data hiding ( Fixity )
+
+-- | Haskell Module
+--
+-- All we actually declare here is the top-level structure for a module.
+data HsModule pass
+  = HsModule {
+      hsmodName :: Maybe (Located ModuleName),
+        -- ^ @Nothing@: \"module X where\" is omitted (in which case the next
+        --     field is Nothing too)
+      hsmodExports :: Maybe (Located [LIE pass]),
+        -- ^ Export list
+        --
+        --  - @Nothing@: export list omitted, so export everything
+        --
+        --  - @Just []@: export /nothing/
+        --
+        --  - @Just [...]@: as you would expect...
+        --
+        --
+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
+        --                                   ,'ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+      hsmodImports :: [LImportDecl pass],
+        -- ^ We snaffle interesting stuff out of the imported interfaces early
+        -- on, adding that info to TyDecls/etc; so this list is often empty,
+        -- downstream.
+      hsmodDecls :: [LHsDecl pass],
+        -- ^ Type, class, value, and interface signature decls
+      hsmodDeprecMessage :: Maybe (Located WarningTxt),
+        -- ^ reason\/explanation for warning/deprecation of this module
+        --
+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
+        --                                   ,'ApiAnnotation.AnnClose'
+        --
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+      hsmodHaddockModHeader :: Maybe LHsDocString
+        -- ^ Haddock module info and description, unparsed
+        --
+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
+        --                                   ,'ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+   }
+     -- ^ 'ApiAnnotation.AnnKeywordId's
+     --
+     --  - 'ApiAnnotation.AnnModule','ApiAnnotation.AnnWhere'
+     --
+     --  - 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnSemi',
+     --    'ApiAnnotation.AnnClose' for explicit braces and semi around
+     --    hsmodImports,hsmodDecls if this style is used.
+
+     -- For details on above see note [Api annotations] in ApiAnnotation
+-- deriving instance (DataIdLR name name) => Data (HsModule name)
+deriving instance Data (HsModule GhcPs)
+deriving instance Data (HsModule GhcRn)
+deriving instance Data (HsModule GhcTc)
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsModule p) where
+
+    ppr (HsModule Nothing _ imports decls _ mbDoc)
+      = pp_mb mbDoc $$ pp_nonnull imports
+                    $$ pp_nonnull decls
+
+    ppr (HsModule (Just name) exports imports decls deprec mbDoc)
+      = vcat [
+            pp_mb mbDoc,
+            case exports of
+              Nothing -> pp_header (text "where")
+              Just es -> vcat [
+                           pp_header lparen,
+                           nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),
+                           nest 4 (text ") where")
+                          ],
+            pp_nonnull imports,
+            pp_nonnull decls
+          ]
+      where
+        pp_header rest = case deprec of
+           Nothing -> pp_modname <+> rest
+           Just d -> vcat [ pp_modname, ppr d, rest ]
+
+        pp_modname = text "module" <+> ppr name
+
+pp_mb :: Outputable t => Maybe t -> SDoc
+pp_mb (Just x) = ppr x
+pp_mb Nothing  = empty
+
+pp_nonnull :: Outputable t => [t] -> SDoc
+pp_nonnull [] = empty
+pp_nonnull xs = vcat (map ppr xs)
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
new file mode 100644
index 0000000000..01c10b1ea1
--- /dev/null
+++ b/compiler/GHC/Hs/Binds.hs
@@ -0,0 +1,1310 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[HsBinds]{Abstract syntax: top-level bindings and signatures}
+
+Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Hs.Binds where
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, LHsExpr,
+                                    MatchGroup, pprFunBind,
+                                    GRHSs, pprPatBind )
+import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )
+
+import GHC.Hs.Extension
+import GHC.Hs.Types
+import CoreSyn
+import TcEvidence
+import Type
+import NameSet
+import BasicTypes
+import Outputable
+import SrcLoc
+import Var
+import Bag
+import FastString
+import BooleanFormula (LBooleanFormula)
+import DynFlags
+
+import Data.Data hiding ( Fixity )
+import Data.List hiding ( foldr )
+import Data.Ord
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Bindings: @BindGroup@}
+*                                                                      *
+************************************************************************
+
+Global bindings (where clauses)
+-}
+
+-- During renaming, we need bindings where the left-hand sides
+-- have been renamed but the right-hand sides have not.
+-- the ...LR datatypes are parametrized by two id types,
+-- one for the left and one for the right.
+-- Other than during renaming, these will be the same.
+
+-- | Haskell Local Bindings
+type HsLocalBinds id = HsLocalBindsLR id id
+
+-- | Located Haskell local bindings
+type LHsLocalBinds id = Located (HsLocalBinds id)
+
+-- | Haskell Local Bindings with separate Left and Right identifier types
+--
+-- Bindings in a 'let' expression
+-- or a 'where' clause
+data HsLocalBindsLR idL idR
+  = HsValBinds
+        (XHsValBinds idL idR)
+        (HsValBindsLR idL idR)
+      -- ^ Haskell Value Bindings
+
+         -- There should be no pattern synonyms in the HsValBindsLR
+         -- These are *local* (not top level) bindings
+         -- The parser accepts them, however, leaving the
+         -- renamer to report them
+
+  | HsIPBinds
+        (XHsIPBinds idL idR)
+        (HsIPBinds idR)
+      -- ^ Haskell Implicit Parameter Bindings
+
+  | EmptyLocalBinds (XEmptyLocalBinds idL idR)
+      -- ^ Empty Local Bindings
+
+  | XHsLocalBindsLR
+        (XXHsLocalBindsLR idL idR)
+
+type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
+
+type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
+
+
+-- | Haskell Value Bindings
+type HsValBinds id = HsValBindsLR id id
+
+-- | Haskell Value bindings with separate Left and Right identifier types
+-- (not implicit parameters)
+-- Used for both top level and nested bindings
+-- May contain pattern synonym bindings
+data HsValBindsLR idL idR
+  = -- | Value Bindings In
+    --
+    -- Before renaming RHS; idR is always RdrName
+    -- Not dependency analysed
+    -- Recursive by default
+    ValBinds
+        (XValBinds idL idR)
+        (LHsBindsLR idL idR) [LSig idR]
+
+    -- | Value Bindings Out
+    --
+    -- After renaming RHS; idR can be Name or Id Dependency analysed,
+    -- later bindings in the list may depend on earlier ones.
+  | XValBindsLR
+      (XXValBindsLR idL idR)
+
+-- ---------------------------------------------------------------------
+-- Deal with ValBindsOut
+
+-- TODO: make this the only type for ValBinds
+data NHsValBindsLR idL
+  = NValBinds
+      [(RecFlag, LHsBinds idL)]
+      [LSig GhcRn]
+
+type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
+            = NHsValBindsLR (GhcPass pL)
+
+-- ---------------------------------------------------------------------
+
+-- | Located Haskell Binding
+type LHsBind  id = LHsBindLR  id id
+
+-- | Located Haskell Bindings
+type LHsBinds id = LHsBindsLR id id
+
+-- | Haskell Binding
+type HsBind   id = HsBindLR   id id
+
+-- | Located Haskell Bindings with separate Left and Right identifier types
+type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
+
+-- | Located Haskell Binding with separate Left and Right identifier types
+type LHsBindLR  idL idR = Located (HsBindLR idL idR)
+
+{- Note [FunBind vs PatBind]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~
+The distinction between FunBind and PatBind is a bit subtle. FunBind covers
+patterns which resemble function bindings and simple variable bindings.
+
+    f x = e
+    f !x = e
+    f = e
+    !x = e          -- FunRhs has SrcStrict
+    x `f` y = e     -- FunRhs has Infix
+
+The actual patterns and RHSs of a FunBind are encoding in fun_matches.
+The m_ctxt field of each Match in fun_matches will be FunRhs and carries
+two bits of information about the match,
+
+  * The mc_fixity field on each Match describes the fixity of the
+    function binder in that match.  E.g. this is legal:
+         f True False  = e1
+         True `f` True = e2
+
+  * The mc_strictness field is used /only/ for nullary FunBinds: ones
+    with one Match, which has no pats. For these, it describes whether
+    the match is decorated with a bang (e.g. `!x = e`).
+
+By contrast, PatBind represents data constructor patterns, as well as a few
+other interesting cases. Namely,
+
+    Just x = e
+    (x) = e
+    x :: Ty = e
+-}
+
+-- | Haskell Binding with separate Left and Right id's
+data HsBindLR idL idR
+  = -- | Function-like Binding
+    --
+    -- FunBind is used for both functions     @f x = e@
+    -- and variables                          @f = \x -> e@
+    -- and strict variables                   @!x = x + 1@
+    --
+    -- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.
+    --
+    -- Reason 2: Instance decls can only have FunBinds, which is convenient.
+    --           If you change this, you'll need to change e.g. rnMethodBinds
+    --
+    -- But note that the form                 @f :: a->a = ...@
+    -- parses as a pattern binding, just like
+    --                                        @(f :: a -> a) = ... @
+    --
+    -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
+    -- 'MatchContext'. See Note [FunBind vs PatBind] for
+    -- details about the relationship between FunBind and PatBind.
+    --
+    --  'ApiAnnotation.AnnKeywordId's
+    --
+    --  - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
+    --
+    --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
+    --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+    FunBind {
+
+        fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains
+                                --  the locally-bound
+                                -- free variables of this defn.
+                                -- See Note [Bind free vars]
+
+        fun_id :: Located (IdP idL), -- Note [fun_id in Match] in GHC.Hs.Expr
+
+        fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload
+
+        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of
+                                -- the Id.  Example:
+                                --
+                                -- @
+                                --      f :: Int -> forall a. a -> a
+                                --      f x y = y
+                                -- @
+                                --
+                                -- Then the MatchGroup will have type (Int -> a' -> a')
+                                -- (with a free type variable a').  The coercion will take
+                                -- a CoreExpr of this type and convert it to a CoreExpr of
+                                -- type         Int -> forall a'. a' -> a'
+                                -- Notice that the coercion captures the free a'.
+
+        fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
+    }
+
+  -- | Pattern Binding
+  --
+  -- The pattern is never a simple variable;
+  -- That case is done by FunBind.
+  -- See Note [FunBind vs PatBind] for details about the
+  -- relationship between FunBind and PatBind.
+
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
+  --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
+  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | PatBind {
+        pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]
+        pat_lhs    :: LPat idL,
+        pat_rhs    :: GRHSs idR (LHsExpr idR),
+        pat_ticks  :: ([Tickish Id], [[Tickish Id]])
+               -- ^ Ticks to put on the rhs, if any, and ticks to put on
+               -- the bound variables.
+    }
+
+  -- | Variable Binding
+  --
+  -- Dictionary binding and suchlike.
+  -- All VarBinds are introduced by the type checker
+  | VarBind {
+        var_ext    :: XVarBind idL idR,
+        var_id     :: IdP idL,
+        var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency
+        var_inline :: Bool           -- ^ True <=> inline this binding regardless
+                                     -- (used for implication constraints only)
+    }
+
+  -- | Abstraction Bindings
+  | AbsBinds {                      -- Binds abstraction; TRANSLATION
+        abs_ext     :: XAbsBinds idL idR,
+        abs_tvs     :: [TyVar],
+        abs_ev_vars :: [EvVar],  -- ^ Includes equality constraints
+
+       -- | AbsBinds only gets used when idL = idR after renaming,
+       -- but these need to be idL's for the collect... code in HsUtil
+       -- to have the right type
+        abs_exports :: [ABExport idL],
+
+        -- | Evidence bindings
+        -- Why a list? See TcInstDcls
+        -- Note [Typechecking plan for instance declarations]
+        abs_ev_binds :: [TcEvBinds],
+
+        -- | Typechecked user bindings
+        abs_binds    :: LHsBinds idL,
+
+        abs_sig :: Bool  -- See Note [The abs_sig field of AbsBinds]
+    }
+
+  -- | Patterns Synonym Binding
+  | PatSynBind
+        (XPatSynBind idL idR)
+        (PatSynBind idL idR)
+        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
+        --          'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',
+        --          'ApiAnnotation.AnnWhere'
+        --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | XHsBindsLR (XXHsBindsLR idL idR)
+
+data NPatBindTc = NPatBindTc {
+     pat_fvs :: NameSet, -- ^ Free variables
+     pat_rhs_ty :: Type  -- ^ Type of the GRHSs
+     } deriving Data
+
+type instance XFunBind    (GhcPass pL) GhcPs = NoExtField
+type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables
+type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables
+
+type instance XPatBind    GhcPs (GhcPass pR) = NoExtField
+type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables
+type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc
+
+type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
+
+
+        -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
+        --
+        -- Creates bindings for (polymorphic, overloaded) poly_f
+        -- in terms of monomorphic, non-overloaded mono_f
+        --
+        -- Invariants:
+        --      1. 'binds' binds mono_f
+        --      2. ftvs is a subset of tvs
+        --      3. ftvs includes all tyvars free in ds
+        --
+        -- See Note [AbsBinds]
+
+-- | Abtraction Bindings Export
+data ABExport p
+  = ABE { abe_ext       :: XABE p
+        , abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id
+        , abe_mono      :: IdP p
+        , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
+             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
+        , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas
+        }
+   | XABExport (XXABExport p)
+
+type instance XABE       (GhcPass p) = NoExtField
+type instance XXABExport (GhcPass p) = NoExtCon
+
+
+-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
+--             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
+--             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
+--             'ApiAnnotation.AnnClose' @'}'@,
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Pattern Synonym binding
+data PatSynBind idL idR
+  = PSB { psb_ext  :: XPSB idL idR,            -- ^ Post renaming, FVs.
+                                               -- See Note [Bind free vars]
+          psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym
+          psb_args :: HsPatSynDetails (Located (IdP idR)),
+                                               -- ^ Formal parameter names
+          psb_def  :: LPat idR,                -- ^ Right-hand side
+          psb_dir  :: HsPatSynDir idR          -- ^ Directionality
+     }
+   | XPatSynBind (XXPatSynBind idL idR)
+
+type instance XPSB         (GhcPass idL) GhcPs = NoExtField
+type instance XPSB         (GhcPass idL) GhcRn = NameSet
+type instance XPSB         (GhcPass idL) GhcTc = NameSet
+
+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon
+
+{-
+Note [AbsBinds]
+~~~~~~~~~~~~~~~
+The AbsBinds constructor is used in the output of the type checker, to
+record *typechecked* and *generalised* bindings.  Specifically
+
+         AbsBinds { abs_tvs      = tvs
+                  , abs_ev_vars  = [d1,d2]
+                  , abs_exports  = [ABE { abe_poly = fp, abe_mono = fm
+                                        , abe_wrap = fwrap }
+                                    ABE { slly for g } ]
+                  , abs_ev_binds = DBINDS
+                  , abs_binds    = BIND[fm,gm] }
+
+where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means
+
+        fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS        ]
+                   [                       ; BIND[fm,gm] } ]
+                   [                 in fm                 ]
+
+        gp = ...same again, with gm instead of fm
+
+The 'fwrap' is an impedence-matcher that typically does nothing; see
+Note [ABExport wrapper].
+
+This is a pretty bad translation, because it duplicates all the bindings.
+So the desugarer tries to do a better job:
+
+        fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
+                                        (fm,gm) -> fm
+        ..ditto for gp..
+
+        tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND }
+                                      in (fm,gm)
+
+In general:
+
+  * abs_tvs are the type variables over which the binding group is
+    generalised
+  * abs_ev_var are the evidence variables (usually dictionaries)
+    over which the binding group is generalised
+  * abs_binds are the monomorphic bindings
+  * abs_ex_binds are the evidence bindings that wrap the abs_binds
+  * abs_exports connects the monomorphic Ids bound by abs_binds
+    with the polymorphic Ids bound by the AbsBinds itself.
+
+For example, consider a module M, with this top-level binding, where
+there is no type signature for M.reverse,
+    M.reverse []     = []
+    M.reverse (x:xs) = M.reverse xs ++ [x]
+
+In Hindley-Milner, a recursive binding is typechecked with the
+*recursive* uses being *monomorphic*.  So after typechecking *and*
+desugaring we will get something like this
+
+    M.reverse :: forall a. [a] -> [a]
+      = /\a. letrec
+                reverse :: [a] -> [a] = \xs -> case xs of
+                                                []     -> []
+                                                (x:xs) -> reverse xs ++ [x]
+             in reverse
+
+Notice that 'M.reverse' is polymorphic as expected, but there is a local
+definition for plain 'reverse' which is *monomorphic*.  The type variable
+'a' scopes over the entire letrec.
+
+That's after desugaring.  What about after type checking but before
+desugaring?  That's where AbsBinds comes in.  It looks like this:
+
+   AbsBinds { abs_tvs     = [a]
+            , abs_ev_vars = []
+            , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
+                                 , abe_mono = reverse :: [a] -> [a]}]
+            , abs_ev_binds = {}
+            , abs_binds = { reverse :: [a] -> [a]
+                               = \xs -> case xs of
+                                            []     -> []
+                                            (x:xs) -> reverse xs ++ [x] } }
+
+Here,
+
+  * abs_tvs says what type variables are abstracted over the binding
+    group, just 'a' in this case.
+  * abs_binds is the *monomorphic* bindings of the group
+  * abs_exports describes how to get the polymorphic Id 'M.reverse'
+    from the monomorphic one 'reverse'
+
+Notice that the *original* function (the polymorphic one you thought
+you were defining) appears in the abe_poly field of the
+abs_exports. The bindings in abs_binds are for fresh, local, Ids with
+a *monomorphic* Id.
+
+If there is a group of mutually recursive (see Note [Polymorphic
+recursion]) functions without type signatures, we get one AbsBinds
+with the monomorphic versions of the bindings in abs_binds, and one
+element of abe_exports for each variable bound in the mutually
+recursive group.  This is true even for pattern bindings.  Example:
+        (f,g) = (\x -> x, f)
+After type checking we get
+   AbsBinds { abs_tvs     = [a]
+            , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a
+                                  , abe_mono = f :: a -> a }
+                            , ABE { abe_poly = M.g :: forall a. a -> a
+                                  , abe_mono = g :: a -> a }]
+            , abs_binds = { (f,g) = (\x -> x, f) }
+
+Note [Polymorphic recursion]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   Rec { f x = ...(g ef)...
+
+       ; g :: forall a. [a] -> [a]
+       ; g y = ...(f eg)...  }
+
+These bindings /are/ mutually recursive (f calls g, and g calls f).
+But we can use the type signature for g to break the recursion,
+like this:
+
+  1. Add g :: forall a. [a] -> [a] to the type environment
+
+  2. Typecheck the definition of f, all by itself,
+     including generalising it to find its most general
+     type, say f :: forall b. b -> b -> [b]
+
+  3. Extend the type environment with that type for f
+
+  4. Typecheck the definition of g, all by itself,
+     checking that it has the type claimed by its signature
+
+Steps 2 and 4 each generate a separate AbsBinds, so we end
+up with
+   Rec { AbsBinds { ...for f ... }
+       ; AbsBinds { ...for g ... } }
+
+This approach allows both f and to call each other
+polymorphically, even though only g has a signature.
+
+We get an AbsBinds that encompasses multiple source-program
+bindings only when
+ * Each binding in the group has at least one binder that
+   lacks a user type signature
+ * The group forms a strongly connected component
+
+
+Note [The abs_sig field of AbsBinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The abs_sig field supports a couple of special cases for bindings.
+Consider
+
+  x :: Num a => (# a, a #)
+  x = (# 3, 4 #)
+
+The general desugaring for AbsBinds would give
+
+  x = /\a. \ ($dNum :: Num a) ->
+      letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
+      xm
+
+But that has an illegal let-binding for an unboxed tuple.  In this
+case we'd prefer to generate the (more direct)
+
+  x = /\ a. \ ($dNum :: Num a) ->
+     (# fromInteger $dNum 3, fromInteger $dNum 4 #)
+
+A similar thing happens with representation-polymorphic defns
+(#11405):
+
+  undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
+  undef = error "undef"
+
+Again, the vanilla desugaring gives a local let-binding for a
+representation-polymorphic (undefm :: a), which is illegal.  But
+again we can desugar without a let:
+
+  undef = /\ a. \ (d:HasCallStack) -> error a d "undef"
+
+The abs_sig field supports this direct desugaring, with no local
+let-bining.  When abs_sig = True
+
+ * the abs_binds is single FunBind
+
+ * the abs_exports is a singleton
+
+ * we have a complete type sig for binder
+   and hence the abs_binds is non-recursive
+   (it binds the mono_id but refers to the poly_id
+
+These properties are exploited in DsBinds.dsAbsBinds to
+generate code without a let-binding.
+
+Note [ABExport wrapper]
+~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   (f,g) = (\x.x, \y.y)
+This ultimately desugars to something like this:
+   tup :: forall a b. (a->a, b->b)
+   tup = /\a b. (\x:a.x, \y:b.y)
+   f :: forall a. a -> a
+   f = /\a. case tup a Any of
+               (fm::a->a,gm:Any->Any) -> fm
+   ...similarly for g...
+
+The abe_wrap field deals with impedance-matching between
+    (/\a b. case tup a b of { (f,g) -> f })
+and the thing we really want, which may have fewer type
+variables.  The action happens in TcBinds.mkExport.
+
+Note [Bind free vars]
+~~~~~~~~~~~~~~~~~~~~~
+The bind_fvs field of FunBind and PatBind records the free variables
+of the definition.  It is used for the following purposes
+
+a) Dependency analysis prior to type checking
+    (see TcBinds.tc_group)
+
+b) Deciding whether we can do generalisation of the binding
+    (see TcBinds.decideGeneralisationPlan)
+
+c) Deciding whether the binding can be used in static forms
+    (see TcExpr.checkClosedInStaticForm for the HsStatic case and
+     TcBinds.isClosedBndrGroup).
+
+Specifically,
+
+  * bind_fvs includes all free vars that are defined in this module
+    (including top-level things and lexically scoped type variables)
+
+  * bind_fvs excludes imported vars; this is just to keep the set smaller
+
+  * Before renaming, and after typechecking, the field is unused;
+    it's just an error thunk
+-}
+
+instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
+          OutputableBndrId idL, OutputableBndrId idR)
+        => Outputable (HsLocalBindsLR idL idR) where
+  ppr (HsValBinds _ bs)   = ppr bs
+  ppr (HsIPBinds _ bs)    = ppr bs
+  ppr (EmptyLocalBinds _) = empty
+  ppr (XHsLocalBindsLR x) = ppr x
+
+instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
+          OutputableBndrId idL, OutputableBndrId idR)
+        => Outputable (HsValBindsLR idL idR) where
+  ppr (ValBinds _ binds sigs)
+   = pprDeclList (pprLHsBindsForUser binds sigs)
+
+  ppr (XValBindsLR (NValBinds sccs sigs))
+    = getPprStyle $ \ sty ->
+      if debugStyle sty then    -- Print with sccs showing
+        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
+     else
+        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
+   where
+     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
+     pp_rec Recursive    = text "rec"
+     pp_rec NonRecursive = text "nonrec"
+
+pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
+pprLHsBinds binds
+  | isEmptyLHsBinds binds = empty
+  | otherwise = pprDeclList (map ppr (bagToList binds))
+
+pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),
+                       OutputableBndrId (GhcPass idR),
+                       OutputableBndrId (GhcPass id2))
+     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
+--  pprLHsBindsForUser is different to pprLHsBinds because
+--  a) No braces: 'let' and 'where' include a list of HsBindGroups
+--     and we don't want several groups of bindings each
+--     with braces around
+--  b) Sort by location before printing
+--  c) Include signatures
+pprLHsBindsForUser binds sigs
+  = map snd (sort_by_loc decls)
+  where
+
+    decls :: [(SrcSpan, SDoc)]
+    decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
+            [(loc, ppr bind) | L loc bind <- bagToList binds]
+
+    sort_by_loc decls = sortBy (comparing fst) decls
+
+pprDeclList :: [SDoc] -> SDoc   -- Braces with a space
+-- Print a bunch of declarations
+-- One could choose  { d1; d2; ... }, using 'sep'
+-- or      d1
+--         d2
+--         ..
+--    using vcat
+-- At the moment we chose the latter
+-- Also we do the 'pprDeeperList' thing.
+pprDeclList ds = pprDeeperList vcat ds
+
+------------
+emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
+emptyLocalBinds = EmptyLocalBinds noExtField
+
+-- AZ:These functions do not seem to be used at all?
+isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
+isEmptyLocalBindsTc (HsValBinds _ ds)   = isEmptyValBinds ds
+isEmptyLocalBindsTc (HsIPBinds _ ds)    = isEmptyIPBindsTc ds
+isEmptyLocalBindsTc (EmptyLocalBinds _) = True
+isEmptyLocalBindsTc (XHsLocalBindsLR _) = True
+
+isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
+isEmptyLocalBindsPR (HsValBinds _ ds)   = isEmptyValBinds ds
+isEmptyLocalBindsPR (HsIPBinds _ ds)    = isEmptyIPBindsPR ds
+isEmptyLocalBindsPR (EmptyLocalBinds _) = True
+isEmptyLocalBindsPR (XHsLocalBindsLR _) = True
+
+eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
+eqEmptyLocalBinds (EmptyLocalBinds _) = True
+eqEmptyLocalBinds _                   = False
+
+isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
+isEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs
+isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
+
+emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
+emptyValBindsIn  = ValBinds noExtField emptyBag []
+emptyValBindsOut = XValBindsLR (NValBinds [] [])
+
+emptyLHsBinds :: LHsBindsLR idL idR
+emptyLHsBinds = emptyBag
+
+isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
+isEmptyLHsBinds = isEmptyBag
+
+------------
+plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
+               -> HsValBinds(GhcPass a)
+plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
+  = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
+plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
+               (XValBindsLR (NValBinds ds2 sigs2))
+  = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
+plusHsValBinds _ _
+  = panic "HsBinds.plusHsValBinds"
+
+instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
+          OutputableBndrId idL, OutputableBndrId idR)
+         => Outputable (HsBindLR idL idR) where
+    ppr mbind = ppr_monobind mbind
+
+ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+             => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
+
+ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
+  = pprPatBind pat grhss
+ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
+  = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
+ppr_monobind (FunBind { fun_id = fun,
+                        fun_co_fn = wrap,
+                        fun_matches = matches,
+                        fun_tick = ticks })
+  = pprTicks empty (if null ticks then empty
+                    else text "-- ticks = " <> ppr ticks)
+    $$  whenPprDebug (pprBndr LetBind (unLoc fun))
+    $$  pprFunBind  matches
+    $$  whenPprDebug (ppr wrap)
+ppr_monobind (PatSynBind _ psb) = ppr psb
+ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
+                       , abs_exports = exports, abs_binds = val_binds
+                       , abs_ev_binds = ev_binds })
+  = sdocWithDynFlags $ \ dflags ->
+    if gopt Opt_PrintTypecheckerElaboration dflags then
+      -- Show extra information (bug number: #10662)
+      hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
+                                    <+> brackets (interpp'SP dictvars))
+         2 $ braces $ vcat
+      [ text "Exports:" <+>
+          brackets (sep (punctuate comma (map ppr exports)))
+      , text "Exported types:" <+>
+          vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
+      , text "Binds:" <+> pprLHsBinds val_binds
+      , text "Evidence:" <+> ppr ev_binds ]
+    else
+      pprLHsBinds val_binds
+ppr_monobind (XHsBindsLR x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
+  ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
+    = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
+           , nest 2 (pprTcSpecPrags prags)
+           , nest 2 (text "wrap:" <+> ppr wrap)]
+  ppr (XABExport x) = ppr x
+
+instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,
+         Outputable (XXPatSynBind idL idR))
+          => Outputable (PatSynBind idL idR) where
+  ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
+            psb_dir = dir })
+      = ppr_lhs <+> ppr_rhs
+    where
+      ppr_lhs = text "pattern" <+> ppr_details
+      ppr_simple syntax = syntax <+> ppr pat
+
+      ppr_details = case details of
+          InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]
+          PrefixCon vs   -> hsep (pprPrefixOcc psyn : map ppr vs)
+          RecCon vs      -> pprPrefixOcc psyn
+                            <> braces (sep (punctuate comma (map ppr vs)))
+
+      ppr_rhs = case dir of
+          Unidirectional           -> ppr_simple (text "<-")
+          ImplicitBidirectional    -> ppr_simple equals
+          ExplicitBidirectional mg -> ppr_simple (text "<-") <+> ptext (sLit "where") $$
+                                      (nest 2 $ pprFunBind mg)
+  ppr (XPatSynBind x) = ppr x
+
+pprTicks :: SDoc -> SDoc -> SDoc
+-- Print stuff about ticks only when -dppr-debug is on, to avoid
+-- them appearing in error messages (from the desugarer); see # 3263
+-- Also print ticks in dumpStyle, so that -ddump-hpc actually does
+-- something useful.
+pprTicks pp_no_debug pp_when_debug
+  = getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty
+                             then pp_when_debug
+                             else pp_no_debug)
+
+{-
+************************************************************************
+*                                                                      *
+                Implicit parameter bindings
+*                                                                      *
+************************************************************************
+-}
+
+-- | Haskell Implicit Parameter Bindings
+data HsIPBinds id
+  = IPBinds
+        (XIPBinds id)
+        [LIPBind id]
+        -- TcEvBinds       -- Only in typechecker output; binds
+        --                 -- uses of the implicit parameters
+  | XHsIPBinds (XXHsIPBinds id)
+
+type instance XIPBinds       GhcPs = NoExtField
+type instance XIPBinds       GhcRn = NoExtField
+type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the
+                                               -- implicit parameters
+
+
+type instance XXHsIPBinds    (GhcPass p) = NoExtCon
+
+isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
+isEmptyIPBindsPR (IPBinds _ is) = null is
+isEmptyIPBindsPR (XHsIPBinds _) = True
+
+isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
+isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
+isEmptyIPBindsTc (XHsIPBinds _) = True
+
+-- | Located Implicit Parameter Binding
+type LIPBind id = Located (IPBind id)
+-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
+--   list
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Implicit parameter bindings.
+--
+-- These bindings start off as (Left "x") in the parser and stay
+-- that way until after type-checking when they are replaced with
+-- (Right d), where "d" is the name of the dictionary holding the
+-- evidence for the implicit parameter.
+--
+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data IPBind id
+  = IPBind
+        (XCIPBind id)
+        (Either (Located HsIPName) (IdP id))
+        (LHsExpr id)
+  | XIPBind (XXIPBind id)
+
+type instance XCIPBind    (GhcPass p) = NoExtField
+type instance XXIPBind    (GhcPass p) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsIPBinds p) where
+  ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)
+                        $$ whenPprDebug (ppr ds)
+  ppr (XHsIPBinds x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
+  ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
+    where name = case lr of
+                   Left (L _ ip) -> pprBndr LetBind ip
+                   Right     id  -> pprBndr LetBind id
+  ppr (XIPBind x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{@Sig@: type signatures and value-modifying user pragmas}
+*                                                                      *
+************************************************************************
+
+It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
+``specialise this function to these four types...'') in with type
+signatures.  Then all the machinery to move them into place, etc.,
+serves for both.
+-}
+
+-- | Located Signature
+type LSig pass = Located (Sig pass)
+
+-- | Signatures and pragmas
+data Sig pass
+  =   -- | An ordinary type signature
+      --
+      -- > f :: Num a => a -> a
+      --
+      -- After renaming, this list of Names contains the named
+      -- wildcards brought into scope by this signature. For a signature
+      -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@
+      -- untouched, and the named wildcard @_a@ is then replaced with
+      -- fresh meta vars in the type. Their names are stored in the type
+      -- signature that brought them into scope, in this third field to be
+      -- more specific.
+      --
+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
+      --          'ApiAnnotation.AnnComma'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+    TypeSig
+       (XTypeSig pass)
+       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah
+       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards
+
+      -- | A pattern synonym type signature
+      --
+      -- > pattern Single :: () => (Show a) => a -> [a]
+      --
+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
+      --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
+      --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+  | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
+      -- P :: forall a b. Req => Prov => ty
+
+      -- | A signature for a class method
+      --   False: ordinary class-method signature
+      --   True:  generic-default class method signature
+      -- e.g.   class C a where
+      --          op :: a -> a                   -- Ordinary
+      --          default op :: Eq a => a -> a   -- Generic default
+      -- No wildcards allowed here
+      --
+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
+      --           'ApiAnnotation.AnnDcolon'
+  | ClassOpSig (XClassOpSig pass) Bool [Located (IdP 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 ***
+        --
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
+        --           'ApiAnnotation.AnnVal'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | FixSig (XFixSig pass) (FixitySig pass)
+
+        -- | An inline pragma
+        --
+        -- > {#- INLINE f #-}
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' :
+        --       'ApiAnnotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
+        --       'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',
+        --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',
+        --       'ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | InlineSig   (XInlineSig pass)
+                (Located (IdP pass)) -- Function name
+                InlinePragma         -- Never defaultInlinePragma
+
+        -- | A specialisation pragma
+        --
+        -- > {-# SPECIALISE f :: Int -> Int #-}
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+        --      'ApiAnnotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
+        --      'ApiAnnotation.AnnTilde',
+        --      'ApiAnnotation.AnnVal',
+        --      'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,
+        --      'ApiAnnotation.AnnDcolon'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | SpecSig     (XSpecSig pass)
+                (Located (IdP pass)) -- Specialise a function or datatype  ...
+                [LHsSigType pass]  -- ... to these types
+                InlinePragma       -- The pragma on SPECIALISE_INLINE form.
+                                   -- If it's just defaultInlinePragma, then we said
+                                   --    SPECIALISE, not SPECIALISE_INLINE
+
+        -- | A specialisation pragma for instance declarations only
+        --
+        -- > {-# SPECIALISE instance Eq [Int] #-}
+        --
+        -- (Class tys); should be a specialisation of the
+        -- current instance declaration
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+        --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
+                  -- Note [Pragma source text] in BasicTypes
+
+        -- | A minimal complete definition pragma
+        --
+        -- > {-# MINIMAL a | (b, c | (d | e)) #-}
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+        --      'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',
+        --      'ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | MinimalSig (XMinimalSig pass)
+               SourceText (LBooleanFormula (Located (IdP pass)))
+               -- Note [Pragma source text] in BasicTypes
+
+        -- | A "set cost centre" pragma for declarations
+        --
+        -- > {-# SCC funName #-}
+        --
+        -- or
+        --
+        -- > {-# SCC funName "cost_centre_name" #-}
+
+  | SCCFunSig  (XSCCFunSig pass)
+               SourceText      -- Note [Pragma source text] in BasicTypes
+               (Located (IdP pass))  -- Function name
+               (Maybe (Located StringLiteral))
+       -- | A complete match pragma
+       --
+       -- > {-# COMPLETE C, D [:: T] #-}
+       --
+       -- Used to inform the pattern match checker about additional
+       -- complete matchings which, for example, arise from pattern
+       -- synonym definitions.
+  | CompleteMatchSig (XCompleteMatchSig pass)
+                     SourceText
+                     (Located [Located (IdP pass)])
+                     (Maybe (Located (IdP pass)))
+  | XSig (XXSig pass)
+
+type instance XTypeSig          (GhcPass p) = NoExtField
+type instance XPatSynSig        (GhcPass p) = NoExtField
+type instance XClassOpSig       (GhcPass p) = NoExtField
+type instance XIdSig            (GhcPass p) = NoExtField
+type instance XFixSig           (GhcPass p) = NoExtField
+type instance XInlineSig        (GhcPass p) = NoExtField
+type instance XSpecSig          (GhcPass p) = NoExtField
+type instance XSpecInstSig      (GhcPass p) = NoExtField
+type instance XMinimalSig       (GhcPass p) = NoExtField
+type instance XSCCFunSig        (GhcPass p) = NoExtField
+type instance XCompleteMatchSig (GhcPass p) = NoExtField
+type instance XXSig             (GhcPass p) = NoExtCon
+
+-- | Located Fixity Signature
+type LFixitySig pass = Located (FixitySig pass)
+
+-- | Fixity Signature
+data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
+                    | XFixitySig (XXFixitySig pass)
+
+type instance XFixitySig  (GhcPass p) = NoExtField
+type instance XXFixitySig (GhcPass p) = NoExtCon
+
+-- | Type checker Specialisation Pragmas
+--
+-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer
+data TcSpecPrags
+  = IsDefaultMethod     -- ^ Super-specialised: a default method should
+                        -- be macro-expanded at every call site
+  | SpecPrags [LTcSpecPrag]
+  deriving Data
+
+-- | Located Type checker Specification Pragmas
+type LTcSpecPrag = Located TcSpecPrag
+
+-- | Type checker Specification Pragma
+data TcSpecPrag
+  = SpecPrag
+        Id
+        HsWrapper
+        InlinePragma
+  -- ^ The Id to be specialised, a wrapper that specialises the
+  -- polymorphic function, and inlining spec for the specialised function
+  deriving Data
+
+noSpecPrags :: TcSpecPrags
+noSpecPrags = SpecPrags []
+
+hasSpecPrags :: TcSpecPrags -> Bool
+hasSpecPrags (SpecPrags ps) = not (null ps)
+hasSpecPrags IsDefaultMethod = False
+
+isDefaultMethod :: TcSpecPrags -> Bool
+isDefaultMethod IsDefaultMethod = True
+isDefaultMethod (SpecPrags {})  = False
+
+
+isFixityLSig :: LSig name -> Bool
+isFixityLSig (L _ (FixSig {})) = True
+isFixityLSig _                 = False
+
+isTypeLSig :: LSig name -> Bool  -- Type signatures
+isTypeLSig (L _(TypeSig {}))    = True
+isTypeLSig (L _(ClassOpSig {})) = True
+isTypeLSig (L _(IdSig {}))      = True
+isTypeLSig _                    = False
+
+isSpecLSig :: LSig name -> Bool
+isSpecLSig (L _(SpecSig {})) = True
+isSpecLSig _                 = False
+
+isSpecInstLSig :: LSig name -> Bool
+isSpecInstLSig (L _ (SpecInstSig {})) = True
+isSpecInstLSig _                      = False
+
+isPragLSig :: LSig name -> Bool
+-- Identifies pragmas
+isPragLSig (L _ (SpecSig {}))   = True
+isPragLSig (L _ (InlineSig {})) = True
+isPragLSig (L _ (SCCFunSig {})) = True
+isPragLSig (L _ (CompleteMatchSig {})) = True
+isPragLSig _                    = False
+
+isInlineLSig :: LSig name -> Bool
+-- Identifies inline pragmas
+isInlineLSig (L _ (InlineSig {})) = True
+isInlineLSig _                    = False
+
+isMinimalLSig :: LSig name -> Bool
+isMinimalLSig (L _ (MinimalSig {})) = True
+isMinimalLSig _                     = False
+
+isSCCFunSig :: LSig name -> Bool
+isSCCFunSig (L _ (SCCFunSig {})) = True
+isSCCFunSig _                    = False
+
+isCompleteMatchSig :: LSig name -> Bool
+isCompleteMatchSig (L _ (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 {})           = text "SPECIALISE pragma"
+hsSigDoc (InlineSig _ _ prag)   = ppr (inlinePragmaSpec prag) <+> text "pragma"
+hsSigDoc (SpecInstSig {})       = text "SPECIALISE 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"
+
+{-
+Check if signatures overlap; this is used when checking for duplicate
+signatures. Since some of the signatures contain a list of names, testing for
+equality is not enough -- we have to check if they overlap.
+-}
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where
+    ppr sig = ppr_sig sig
+
+ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc
+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 (inl_src inl) pragmaSrc (pprSpec (unLoc var)
+                                             (interpp'SP ty) inl)
+    where
+      pragmaSrc = case spec of
+        NoUserInline -> "{-# SPECIALISE"
+        _            -> "{-# SPECIALISE_INLINE"
+ppr_sig (InlineSig _ var inl)
+  = pragSrcBrackets (inl_src inl) "{-# INLINE"  (pprInline inl
+                                   <+> pprPrefixOcc (unLoc var))
+ppr_sig (SpecInstSig _ src ty)
+  = pragSrcBrackets src "{-# SPECIALISE" (text "instance" <+> ppr ty)
+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)
+  = pragSrcBrackets src "{-# SCC" (ppr fn <+> maybe empty ppr mlabel )
+ppr_sig (CompleteMatchSig _ src cs mty)
+  = pragSrcBrackets src "{-# COMPLETE"
+      ((hsep (punctuate comma (map ppr (unLoc cs))))
+        <+> opt_sig)
+  where
+    opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
+ppr_sig (XSig x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (FixitySig p) where
+  ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
+    where
+      pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
+  ppr (XFixitySig x) = ppr x
+
+pragBrackets :: SDoc -> SDoc
+pragBrackets doc = text "{-#" <+> doc <+> text "#-}"
+
+-- | Using SourceText in case the pragma was spelled differently or used mixed
+-- case
+pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc
+pragSrcBrackets (SourceText src) _   doc = text src <+> doc <+> text "#-}"
+pragSrcBrackets NoSourceText     alt doc = text alt <+> doc <+> text "#-}"
+
+pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc
+pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]
+  where
+    pprvars = hsep $ punctuate comma (map pprPrefixOcc vars)
+
+pprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc
+pprSpec var pp_ty inl = pp_inl <+> pprVarSig [var] pp_ty
+  where
+    pp_inl | isDefaultInlinePragma inl = empty
+           | otherwise = pprInline inl
+
+pprTcSpecPrags :: TcSpecPrags -> SDoc
+pprTcSpecPrags IsDefaultMethod = text "<default method>"
+pprTcSpecPrags (SpecPrags ps)  = vcat (map (ppr . unLoc) ps)
+
+instance Outputable TcSpecPrag where
+  ppr (SpecPrag var _ inl)
+    = text "SPECIALIZE" <+> pprSpec var (text "<type>") inl
+
+pprMinimalSig :: (OutputableBndr name)
+              => LBooleanFormula (Located name) -> SDoc
+pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[PatSynBind]{A pattern synonym definition}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Haskell Pattern Synonym Details
+type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]
+
+-- See Note [Record PatSyn Fields]
+-- | Record Pattern Synonym Field
+data RecordPatSynField a
+  = RecordPatSynField {
+      recordPatSynSelectorId :: a  -- Selector name visible in rest of the file
+      , recordPatSynPatVar :: a
+      -- Filled in by renamer, the name used internally
+      -- by the pattern
+      } deriving (Data, Functor)
+
+
+
+{-
+Note [Record PatSyn Fields]
+
+Consider the following two pattern synonyms.
+
+pattern P x y = ([x,True], [y,'v'])
+pattern Q{ x, y } =([x,True], [y,'v'])
+
+In P, we just have two local binders, x and y.
+
+In Q, we have local binders but also top-level record selectors
+x :: ([Bool], [Char]) -> Bool and similarly for y.
+
+It would make sense to support record-like syntax
+
+pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])
+
+when we have a different name for the local and top-level binder
+the distinction between the two names clear
+
+-}
+instance Outputable a => Outputable (RecordPatSynField a) where
+    ppr (RecordPatSynField { recordPatSynSelectorId = v }) = ppr v
+
+instance Foldable RecordPatSynField  where
+    foldMap f (RecordPatSynField { recordPatSynSelectorId = visible
+                                 , recordPatSynPatVar = hidden })
+      = f visible `mappend` f hidden
+
+instance Traversable RecordPatSynField where
+    traverse f (RecordPatSynField { recordPatSynSelectorId =visible
+                                  , recordPatSynPatVar = hidden })
+      = (\ sel_id pat_var -> RecordPatSynField { recordPatSynSelectorId = sel_id
+                                               , recordPatSynPatVar = pat_var })
+          <$> f visible <*> f hidden
+
+
+-- | Haskell Pattern Synonym Direction
+data HsPatSynDir id
+  = Unidirectional
+  | ImplicitBidirectional
+  | ExplicitBidirectional (MatchGroup id (LHsExpr id))
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
new file mode 100644
index 0000000000..701c8b1a06
--- /dev/null
+++ b/compiler/GHC/Hs/Decls.hs
@@ -0,0 +1,2417 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
+             DeriveTraversable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Abstract syntax of global declarations.
+--
+-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
+-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
+module GHC.Hs.Decls (
+  -- * Toplevel declarations
+  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
+  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
+
+  -- ** Class or type declarations
+  TyClDecl(..), LTyClDecl, DataDeclRn(..),
+  TyClGroup(..),
+  tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
+  isClassDecl, isDataDecl, isSynDecl, tcdName,
+  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
+  isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
+  tyFamInstDeclName, tyFamInstDeclLName,
+  countTyClDecls, pprTyClDeclFlavour,
+  tyClDeclLName, tyClDeclTyVars,
+  hsDeclHasCusk, famDeclHasCusk,
+  FamilyDecl(..), LFamilyDecl,
+
+  -- ** Instance declarations
+  InstDecl(..), LInstDecl, FamilyInfo(..),
+  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
+  TyFamDefltDecl, LTyFamDefltDecl,
+  DataFamInstDecl(..), LDataFamInstDecl,
+  pprDataFamInstFlavour, pprTyFamInstDecl, pprHsFamInstLHS,
+  FamInstEqn, LFamInstEqn, FamEqn(..),
+  TyFamInstEqn, LTyFamInstEqn, HsTyPats,
+  LClsInstDecl, ClsInstDecl(..),
+
+  -- ** Standalone deriving declarations
+  DerivDecl(..), LDerivDecl,
+  -- ** Deriving strategies
+  DerivStrategy(..), LDerivStrategy,
+  derivStrategyName, foldDerivStrategy, mapDerivStrategy,
+  -- ** @RULE@ declarations
+  LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),
+  RuleBndr(..),LRuleBndr,
+  collectRuleBndrSigTys,
+  flattenRuleDecls, pprFullRuleName,
+  -- ** @default@ declarations
+  DefaultDecl(..), LDefaultDecl,
+  -- ** Template haskell declaration splice
+  SpliceExplicitFlag(..),
+  SpliceDecl(..), LSpliceDecl,
+  -- ** Foreign function interface declarations
+  ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
+  CImportSpec(..),
+  -- ** Data-constructor declarations
+  ConDecl(..), LConDecl,
+  HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta,
+  getConNames, getConArgs,
+  -- ** Document comments
+  DocDecl(..), LDocDecl, docDeclDoc,
+  -- ** Deprecations
+  WarnDecl(..),  LWarnDecl,
+  WarnDecls(..), LWarnDecls,
+  -- ** Annotations
+  AnnDecl(..), LAnnDecl,
+  AnnProvenance(..), annProvenanceName_maybe,
+  -- ** Role annotations
+  RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
+  -- ** Injective type families
+  FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
+  resultVariableName,
+
+  -- * Grouping
+  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls
+
+    ) where
+
+-- friends:
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, HsSplice, pprExpr,
+                                   pprSpliceDecl )
+        -- Because Expr imports Decls via HsBracket
+
+import GHC.Hs.Binds
+import GHC.Hs.Types
+import GHC.Hs.Doc
+import TyCon
+import BasicTypes
+import Coercion
+import ForeignCall
+import GHC.Hs.Extension
+import NameSet
+
+-- others:
+import Class
+import Outputable
+import Util
+import SrcLoc
+import Type
+
+import Bag
+import Maybes
+import Data.Data        hiding (TyCon,Fixity, Infix)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[HsDecl]{Declarations}
+*                                                                      *
+************************************************************************
+-}
+
+type LHsDecl p = Located (HsDecl p)
+        -- ^ When in a list this may have
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+        --
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | A Haskell Declaration
+data HsDecl p
+  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration
+  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration
+  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration
+  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration
+  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration
+  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration
+  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration
+  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration
+  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration
+  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration
+  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration
+                                                 -- (Includes quasi-quotes)
+  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration
+  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
+  | XHsDecl    (XXHsDecl p)
+
+type instance XTyClD      (GhcPass _) = NoExtField
+type instance XInstD      (GhcPass _) = NoExtField
+type instance XDerivD     (GhcPass _) = NoExtField
+type instance XValD       (GhcPass _) = NoExtField
+type instance XSigD       (GhcPass _) = NoExtField
+type instance XDefD       (GhcPass _) = NoExtField
+type instance XForD       (GhcPass _) = NoExtField
+type instance XWarningD   (GhcPass _) = NoExtField
+type instance XAnnD       (GhcPass _) = NoExtField
+type instance XRuleD      (GhcPass _) = NoExtField
+type instance XSpliceD    (GhcPass _) = NoExtField
+type instance XDocD       (GhcPass _) = NoExtField
+type instance XRoleAnnotD (GhcPass _) = NoExtField
+type instance XXHsDecl    (GhcPass _) = NoExtCon
+
+-- NB: all top-level fixity decls are contained EITHER
+-- EITHER SigDs
+-- OR     in the ClassDecls in TyClDs
+--
+-- The former covers
+--      a) data constructors
+--      b) class methods (but they can be also done in the
+--              signatures of class decls)
+--      c) imported functions (that have an IfacSig)
+--      d) top level decls
+--
+-- The latter is for class methods only
+
+-- | Haskell Group
+--
+-- A 'HsDecl' is categorised into a 'HsGroup' before being
+-- fed to the renamer.
+data HsGroup p
+  = HsGroup {
+        hs_ext    :: XCHsGroup p,
+        hs_valds  :: HsValBinds p,
+        hs_splcds :: [LSpliceDecl p],
+
+        hs_tyclds :: [TyClGroup p],
+                -- A list of mutually-recursive groups;
+                -- This includes `InstDecl`s as well;
+                -- Parser generates a singleton list;
+                -- renamer does dependency analysis
+
+        hs_derivds :: [LDerivDecl p],
+
+        hs_fixds  :: [LFixitySig p],
+                -- Snaffled out of both top-level fixity signatures,
+                -- and those in class declarations
+
+        hs_defds  :: [LDefaultDecl p],
+        hs_fords  :: [LForeignDecl p],
+        hs_warnds :: [LWarnDecls p],
+        hs_annds  :: [LAnnDecl p],
+        hs_ruleds :: [LRuleDecls p],
+
+        hs_docs   :: [LDocDecl]
+    }
+  | XHsGroup (XXHsGroup p)
+
+type instance XCHsGroup (GhcPass _) = NoExtField
+type instance XXHsGroup (GhcPass _) = NoExtCon
+
+
+emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
+emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
+emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
+
+hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
+hsGroupInstDecls = (=<<) group_instds . hs_tyclds
+
+emptyGroup = HsGroup { hs_ext = noExtField,
+                       hs_tyclds = [],
+                       hs_derivds = [],
+                       hs_fixds = [], hs_defds = [], hs_annds = [],
+                       hs_fords = [], hs_warnds = [], hs_ruleds = [],
+                       hs_valds = error "emptyGroup hs_valds: Can't happen",
+                       hs_splcds = [],
+                       hs_docs = [] }
+
+appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
+             -> HsGroup (GhcPass p)
+appendGroups
+    HsGroup {
+        hs_valds  = val_groups1,
+        hs_splcds = spliceds1,
+        hs_tyclds = tyclds1,
+        hs_derivds = derivds1,
+        hs_fixds  = fixds1,
+        hs_defds  = defds1,
+        hs_annds  = annds1,
+        hs_fords  = fords1,
+        hs_warnds = warnds1,
+        hs_ruleds = rulds1,
+        hs_docs   = docs1 }
+    HsGroup {
+        hs_valds  = val_groups2,
+        hs_splcds = spliceds2,
+        hs_tyclds = tyclds2,
+        hs_derivds = derivds2,
+        hs_fixds  = fixds2,
+        hs_defds  = defds2,
+        hs_annds  = annds2,
+        hs_fords  = fords2,
+        hs_warnds = warnds2,
+        hs_ruleds = rulds2,
+        hs_docs   = docs2 }
+  =
+    HsGroup {
+        hs_ext    = noExtField,
+        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
+        hs_splcds = spliceds1 ++ spliceds2,
+        hs_tyclds = tyclds1 ++ tyclds2,
+        hs_derivds = derivds1 ++ derivds2,
+        hs_fixds  = fixds1 ++ fixds2,
+        hs_annds  = annds1 ++ annds2,
+        hs_defds  = defds1 ++ defds2,
+        hs_fords  = fords1 ++ fords2,
+        hs_warnds = warnds1 ++ warnds2,
+        hs_ruleds = rulds1 ++ rulds2,
+        hs_docs   = docs1  ++ docs2 }
+appendGroups _ _ = panic "appendGroups"
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
+    ppr (TyClD _ dcl)             = ppr dcl
+    ppr (ValD _ binds)            = ppr binds
+    ppr (DefD _ def)              = ppr def
+    ppr (InstD _ inst)            = ppr inst
+    ppr (DerivD _ deriv)          = ppr deriv
+    ppr (ForD _ fd)               = ppr fd
+    ppr (SigD _ sd)               = ppr sd
+    ppr (RuleD _ rd)              = ppr rd
+    ppr (WarningD _ wd)           = ppr wd
+    ppr (AnnD _ ad)               = ppr ad
+    ppr (SpliceD _ dd)            = ppr dd
+    ppr (DocD _ doc)              = ppr doc
+    ppr (RoleAnnotD _ ra)         = ppr ra
+    ppr (XHsDecl x)               = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
+    ppr (HsGroup { hs_valds  = val_decls,
+                   hs_tyclds = tycl_decls,
+                   hs_derivds = deriv_decls,
+                   hs_fixds  = fix_decls,
+                   hs_warnds = deprec_decls,
+                   hs_annds  = ann_decls,
+                   hs_fords  = foreign_decls,
+                   hs_defds  = default_decls,
+                   hs_ruleds = rule_decls })
+        = vcat_mb empty
+            [ppr_ds fix_decls, ppr_ds default_decls,
+             ppr_ds deprec_decls, ppr_ds ann_decls,
+             ppr_ds rule_decls,
+             if isEmptyValBinds val_decls
+                then Nothing
+                else Just (ppr val_decls),
+             ppr_ds (tyClGroupRoleDecls tycl_decls),
+             ppr_ds (tyClGroupTyClDecls tycl_decls),
+             ppr_ds (tyClGroupInstDecls tycl_decls),
+             ppr_ds deriv_decls,
+             ppr_ds foreign_decls]
+        where
+          ppr_ds :: Outputable a => [a] -> Maybe SDoc
+          ppr_ds [] = Nothing
+          ppr_ds ds = Just (vcat (map ppr ds))
+
+          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
+          -- Concatenate vertically with white-space between non-blanks
+          vcat_mb _    []             = empty
+          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
+          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
+    ppr (XHsGroup x) = ppr x
+
+-- | Located Splice Declaration
+type LSpliceDecl pass = Located (SpliceDecl pass)
+
+-- | Splice Declaration
+data SpliceDecl p
+  = SpliceDecl                  -- Top level splice
+        (XSpliceDecl p)
+        (Located (HsSplice p))
+        SpliceExplicitFlag
+  | XSpliceDecl (XXSpliceDecl p)
+
+type instance XSpliceDecl      (GhcPass _) = NoExtField
+type instance XXSpliceDecl     (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (SpliceDecl p) where
+   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
+   ppr (XSpliceDecl x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+            Type and class declarations
+*                                                                      *
+************************************************************************
+
+Note [The Naming story]
+~~~~~~~~~~~~~~~~~~~~~~~
+Here is the story about the implicit names that go with type, class,
+and instance decls.  It's a bit tricky, so pay attention!
+
+"Implicit" (or "system") binders
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  Each data type decl defines
+        a worker name for each constructor
+        to-T and from-T convertors
+  Each class decl defines
+        a tycon for the class
+        a data constructor for that tycon
+        the worker for that constructor
+        a selector for each superclass
+
+All have occurrence names that are derived uniquely from their parent
+declaration.
+
+None of these get separate definitions in an interface file; they are
+fully defined by the data or class decl.  But they may *occur* in
+interface files, of course.  Any such occurrence must haul in the
+relevant type or class decl.
+
+Plan of attack:
+ - Ensure they "point to" the parent data/class decl
+   when loading that decl from an interface file
+   (See RnHiFiles.getSysBinders)
+
+ - When typechecking the decl, we build the implicit TyCons and Ids.
+   When doing so we look them up in the name cache (RnEnv.lookupSysName),
+   to ensure correct module and provenance is set
+
+These are the two places that we have to conjure up the magic derived
+names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
+
+Default methods
+~~~~~~~~~~~~~~~
+ - Occurrence name is derived uniquely from the method name
+   E.g. $dmmax
+
+ - If there is a default method name at all, it's recorded in
+   the ClassOpSig (in GHC.Hs.Binds), in the DefMethInfo field.
+   (DefMethInfo is defined in Class.hs)
+
+Source-code class decls and interface-code class decls are treated subtly
+differently, which has given me a great deal of confusion over the years.
+Here's the deal.  (We distinguish the two cases because source-code decls
+have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
+
+In *source-code* class declarations:
+
+ - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
+   This is done by RdrHsSyn.mkClassOpSigDM
+
+ - The renamer renames it to a Name
+
+ - During typechecking, we generate a binding for each $dm for
+   which there's a programmer-supplied default method:
+        class Foo a where
+          op1 :: <type>
+          op2 :: <type>
+          op1 = ...
+   We generate a binding for $dmop1 but not for $dmop2.
+   The Class for Foo has a Nothing for op2 and
+                         a Just ($dm_op1, VanillaDM) for op1.
+   The Name for $dmop2 is simply discarded.
+
+In *interface-file* class declarations:
+  - When parsing, we see if there's an explicit programmer-supplied default method
+    because there's an '=' sign to indicate it:
+        class Foo a where
+          op1 = :: <type>       -- NB the '='
+          op2   :: <type>
+    We use this info to generate a DefMeth with a suitable RdrName for op1,
+    and a NoDefMeth for op2
+  - The interface file has a separate definition for $dmop1, with unfolding etc.
+  - The renamer renames it to a Name.
+  - The renamer treats $dmop1 as a free variable of the declaration, so that
+    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
+    This doesn't happen for source code class decls, because they *bind* the default method.
+
+Dictionary functions
+~~~~~~~~~~~~~~~~~~~~
+Each instance declaration gives rise to one dictionary function binding.
+
+The type checker makes up new source-code instance declarations
+(e.g. from 'deriving' or generic default methods --- see
+TcInstDcls.tcInstDecls1).  So we can't generate the names for
+dictionary functions in advance (we don't know how many we need).
+
+On the other hand for interface-file instance declarations, the decl
+specifies the name of the dictionary function, and it has a binding elsewhere
+in the interface file:
+        instance {Eq Int} = dEqInt
+        dEqInt :: {Eq Int} <pragma info>
+
+So again we treat source code and interface file code slightly differently.
+
+Source code:
+  - Source code instance decls have a Nothing in the (Maybe name) field
+    (see data InstDecl below)
+
+  - The typechecker makes up a Local name for the dict fun for any source-code
+    instance decl, whether it comes from a source-code instance decl, or whether
+    the instance decl is derived from some other construct (e.g. 'deriving').
+
+  - The occurrence name it chooses is derived from the instance decl (just for
+    documentation really) --- e.g. dNumInt.  Two dict funs may share a common
+    occurrence name, but will have different uniques.  E.g.
+        instance Foo [Int]  where ...
+        instance Foo [Bool] where ...
+    These might both be dFooList
+
+  - The CoreTidy phase externalises the name, and ensures the occurrence name is
+    unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
+
+  - We can take this relaxed approach (changing the occurrence name later)
+    because dict fun Ids are not captured in a TyCon or Class (unlike default
+    methods, say).  Instead, they are kept separately in the InstEnv.  This
+    makes it easy to adjust them after compiling a module.  (Once we've finished
+    compiling that module, they don't change any more.)
+
+
+Interface file code:
+  - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
+    in the (Maybe name) field.
+
+  - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
+    suck in the dfun binding
+-}
+
+-- | Located Declaration of a Type or Class
+type LTyClDecl pass = Located (TyClDecl pass)
+
+-- | A type or class declaration.
+data TyClDecl pass
+  = -- | @type/data family T :: *->*@
+    --
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+    --             'ApiAnnotation.AnnData',
+    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
+    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
+    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
+    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
+    --             'ApiAnnotation.AnnVbar'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
+
+  | -- | @type@ declaration
+    --
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+    --             'ApiAnnotation.AnnEqual',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
+            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
+            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
+                                                  -- associated type these
+                                                  -- include outer binders
+            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
+            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration
+
+  | -- | @data@ declaration
+    --
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
+    --              'ApiAnnotation.AnnFamily',
+    --              'ApiAnnotation.AnnNewType',
+    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
+    --              'ApiAnnotation.AnnWhere',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs
+             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor
+             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables
+                              -- See Note [TyVar binders for associated declarations]
+             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration
+             , tcdDataDefn :: HsDataDefn pass }
+
+  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs
+                tcdCtxt    :: LHsContext pass,         -- ^ Context...
+                tcdLName   :: Located (IdP pass),      -- ^ Name of the class
+                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
+                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
+                tcdFDs     :: [LHsFunDep pass],         -- ^ Functional deps
+                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
+                tcdMeths   :: LHsBinds pass,            -- ^ Default methods
+                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
+                tcdATDefs  :: [LTyFamDefltDecl pass],   -- ^ Associated type defaults
+                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
+    }
+        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
+        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
+        --           'ApiAnnotation.AnnClose'
+        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',
+        --                          'ApiAnnotation.AnnComma'
+        --                          'ApiAnnotation.AnnRarrow'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | XTyClDecl (XXTyClDecl pass)
+
+type LHsFunDep pass = Located (FunDep (Located (IdP pass)))
+
+data DataDeclRn = DataDeclRn
+             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?
+                 -- See Note [CUSKs: complete user-supplied kind signatures]
+             , tcdFVs      :: NameSet }
+  deriving Data
+
+{- Note [TyVar binders for associated decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For an /associated/ data, newtype, or type-family decl, the LHsQTyVars
+/includes/ outer binders.  For example
+    class T a where
+       data D a c
+       type F a b :: *
+       type F a b = a -> a
+Here the data decl for 'D', and type-family decl for 'F', both include 'a'
+in their LHsQTyVars (tcdTyVars and fdTyVars resp).
+
+Ditto any implicit binders in the hsq_implicit field of the LHSQTyVars.
+
+The idea is that the associated type is really a top-level decl in its
+own right.  However we are careful to use the same name 'a', so that
+we can match things up.
+
+c.f. Note [Associated type tyvar names] in Class.hs
+     Note [Family instance declaration binders]
+-}
+
+type instance XFamDecl      (GhcPass _) = NoExtField
+
+type instance XSynDecl      GhcPs = NoExtField
+type instance XSynDecl      GhcRn = NameSet -- FVs
+type instance XSynDecl      GhcTc = NameSet -- FVs
+
+type instance XDataDecl     GhcPs = NoExtField
+type instance XDataDecl     GhcRn = DataDeclRn
+type instance XDataDecl     GhcTc = DataDeclRn
+
+type instance XClassDecl    GhcPs = NoExtField
+type instance XClassDecl    GhcRn = NameSet -- FVs
+type instance XClassDecl    GhcTc = NameSet -- FVs
+
+type instance XXTyClDecl    (GhcPass _) = NoExtCon
+
+-- Simple classifiers for TyClDecl
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+-- | @True@ <=> argument is a @data@\/@newtype@
+-- declaration.
+isDataDecl :: TyClDecl pass -> Bool
+isDataDecl (DataDecl {}) = True
+isDataDecl _other        = False
+
+-- | type or type instance declaration
+isSynDecl :: TyClDecl pass -> Bool
+isSynDecl (SynDecl {})   = True
+isSynDecl _other        = False
+
+-- | type class
+isClassDecl :: TyClDecl pass -> Bool
+isClassDecl (ClassDecl {}) = True
+isClassDecl _              = False
+
+-- | type/data family declaration
+isFamilyDecl :: TyClDecl pass -> Bool
+isFamilyDecl (FamDecl {})  = True
+isFamilyDecl _other        = False
+
+-- | type family declaration
+isTypeFamilyDecl :: TyClDecl pass -> Bool
+isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of
+  OpenTypeFamily      -> True
+  ClosedTypeFamily {} -> True
+  _                   -> False
+isTypeFamilyDecl _ = False
+
+-- | open type family info
+isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
+isOpenTypeFamilyInfo OpenTypeFamily = True
+isOpenTypeFamilyInfo _              = False
+
+-- | closed type family info
+isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
+isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
+isClosedTypeFamilyInfo _                     = False
+
+-- | data family declaration
+isDataFamilyDecl :: TyClDecl pass -> Bool
+isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True
+isDataFamilyDecl _other      = False
+
+-- Dealing with names
+
+tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
+tyFamInstDeclName = unLoc . tyFamInstDeclLName
+
+tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p))
+tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
+                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
+  = ln
+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec)))
+  = noExtCon nec
+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec))
+  = noExtCon nec
+
+tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
+tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
+tyClDeclLName decl = tcdLName decl
+
+tcdName :: TyClDecl pass -> (IdP pass)
+tcdName = unLoc . tyClDeclLName
+
+tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
+tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
+tyClDeclTyVars d = tcdTyVars d
+
+countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
+        -- class, synonym decls, data, newtype, family decls
+countTyClDecls decls
+ = (count isClassDecl    decls,
+    count isSynDecl      decls,  -- excluding...
+    count isDataTy       decls,  -- ...family...
+    count isNewTy        decls,  -- ...instances
+    count isFamilyDecl   decls)
+ where
+   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
+   isDataTy _                                                       = False
+
+   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
+   isNewTy _                                                      = False
+
+-- | Does this declaration have a complete, user-supplied kind signature?
+-- See Note [CUSKs: complete user-supplied kind signatures]
+hsDeclHasCusk
+  :: Bool  -- True <=> the -XCUSKs extension is enabled
+  -> TyClDecl GhcRn
+  -> Bool
+hsDeclHasCusk _cusks_enabled@False _ = False
+hsDeclHasCusk cusks_enabled (FamDecl { tcdFam = fam_decl })
+  = famDeclHasCusk cusks_enabled False fam_decl
+    -- False: this is not: an associated type of a class with no cusk
+hsDeclHasCusk _cusks_enabled@True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
+  -- NB: Keep this synchronized with 'getInitialKind'
+  = hsTvbAllKinded tyvars && rhs_annotated rhs
+  where
+    rhs_annotated (L _ ty) = case ty of
+      HsParTy _ lty  -> rhs_annotated lty
+      HsKindSig {}   -> True
+      _              -> False
+hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
+hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
+hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec
+
+-- Pretty-printing TyClDecl
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
+
+    ppr (FamDecl { tcdFam = decl }) = ppr decl
+    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
+                 , tcdRhs = rhs })
+      = hang (text "type" <+>
+              pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals)
+          4 (ppr rhs)
+
+    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
+                  , tcdDataDefn = defn })
+      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
+
+    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
+                    tcdFixity = fixity,
+                    tcdFDs  = fds,
+                    tcdSigs = sigs, tcdMeths = methods,
+                    tcdATs = ats, tcdATDefs = at_defs})
+      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
+      = top_matter
+
+      | otherwise       -- Laid out
+      = vcat [ top_matter <+> text "where"
+             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
+                                     map (pprTyFamDefltDecl . unLoc) at_defs ++
+                                     pprLHsBindsForUser methods sigs) ]
+      where
+        top_matter = text "class"
+                    <+> pp_vanilla_decl_head lclas tyvars fixity context
+                    <+> pprFundeps (map unLoc fds)
+
+    ppr (XTyClDecl x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (TyClGroup p) where
+  ppr (TyClGroup { group_tyclds = tyclds
+                 , group_roles = roles
+                 , group_instds = instds
+                 }
+      )
+    = ppr tyclds $$
+      ppr roles $$
+      ppr instds
+  ppr (XTyClGroup x) = ppr x
+
+pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
+   => Located (IdP (GhcPass p))
+   -> LHsQTyVars (GhcPass p)
+   -> LexicalFixity
+   -> LHsContext (GhcPass p)
+   -> SDoc
+pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
+ = hsep [pprLHsContext context, pp_tyvars tyvars]
+  where
+    pp_tyvars (varl:varsr)
+      | fixity == Infix && length varsr > 1
+         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
+                , (ppr.unLoc) (head varsr), char ')'
+                , hsep (map (ppr.unLoc) (tail varsr))]
+      | fixity == Infix
+         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
+         , hsep (map (ppr.unLoc) varsr)]
+      | otherwise = hsep [ pprPrefixOcc (unLoc thing)
+                  , hsep (map (ppr.unLoc) (varl:varsr))]
+    pp_tyvars [] = pprPrefixOcc (unLoc thing)
+pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
+
+pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
+pprTyClDeclFlavour (ClassDecl {})   = text "class"
+pprTyClDeclFlavour (SynDecl {})     = text "type"
+pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
+  = pprFlavour info <+> text "family"
+pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
+  = ppr x
+pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
+  = ppr nd
+pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
+  = ppr x
+pprTyClDeclFlavour (XTyClDecl x) = ppr x
+
+
+{- Note [CUSKs: complete user-supplied kind signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We kind-check declarations differently if they have a complete, user-supplied
+kind signature (CUSK). This is because we can safely generalise a CUSKed
+declaration before checking all of the others, supporting polymorphic recursion.
+See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy
+and #9200 for lots of discussion of how we got here.
+
+The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default.
+Under -XNoCUSKs, all declarations are treated as if they have no CUSK.
+See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst
+
+PRINCIPLE:
+  a type declaration has a CUSK iff we could produce a separate kind signature
+  for it, just like a type signature for a function,
+  looking only at the header of the declaration.
+
+Examples:
+  * data T1 (a :: *->*) (b :: *) = ....
+    -- Has CUSK; equivalant to   T1 :: (*->*) -> * -> *
+
+ * data T2 a b = ...
+   -- No CUSK; we do not want to guess T2 :: * -> * -> *
+   -- because the full decl might be   data T a b = MkT (a b)
+
+  * data T3 (a :: k -> *) (b :: *) = ...
+    -- CUSK; equivalent to   T3 :: (k -> *) -> * -> *
+    -- We lexically generalise over k to get
+    --    T3 :: forall k. (k -> *) -> * -> *
+    -- The generalisation is here is purely lexical, just like
+    --    f3 :: a -> a
+    -- means
+    --    f3 :: forall a. a -> a
+
+  * data T4 (a :: j k) = ...
+     -- CUSK; equivalent to   T4 :: j k -> *
+     -- which we lexically generalise to  T4 :: forall j k. j k -> *
+     -- and then, if PolyKinds is on, we further generalise to
+     --   T4 :: forall kk (j :: kk -> *) (k :: kk). j k -> *
+     -- Again this is exactly like what happens as the term level
+     -- when you write
+     --    f4 :: forall a b. a b -> Int
+
+NOTE THAT
+  * A CUSK does /not/ mean that everything about the kind signature is
+    fully specified by the user.  Look at T4 and f4: we had do do kind
+    inference to figure out the kind-quantification.  But in both cases
+    (T4 and f4) that inference is done looking /only/ at the header of T4
+    (or signature for f4), not at the definition thereof.
+
+  * The CUSK completely fixes the kind of the type constructor, forever.
+
+  * The precise rules, for each declaration form, for whethher a declaration
+    has a CUSK are given in the user manual section "Complete user-supplied
+    kind signatures and polymorphic recursion".  BUt they simply implement
+    PRINCIPLE above.
+
+  * Open type families are interesting:
+      type family T5 a b :: *
+    There simply /is/ no accompanying declaration, so that info is all
+    we'll ever get.  So we it has a CUSK by definition, and we default
+    any un-fixed kind variables to *.
+
+  * Associated types are a bit tricker:
+      class C6 a where
+         type family T6 a b :: *
+         op :: a Int -> Int
+    Here C6 does not have a CUSK (in fact we ultimately discover that
+    a :: * -> *).  And hence neither does T6, the associated family,
+    because we can't fix its kind until we have settled C6.  Another
+    way to say it: unlike a top-level, we /may/ discover more about
+    a's kind from C6's definition.
+
+  * A data definition with a top-level :: must explicitly bind all
+    kind variables to the right of the ::. See test
+    dependent/should_compile/KindLevels, which requires this
+    case. (Naturally, any kind variable mentioned before the :: should
+    not be bound after it.)
+
+    This last point is much more debatable than the others; see
+    #15142 comment:22
+
+    Because this is fiddly to check, there is a field in the DataDeclRn
+    structure (included in a DataDecl after the renamer) that stores whether
+    or not the declaration has a CUSK.
+-}
+
+
+{- *********************************************************************
+*                                                                      *
+                         TyClGroup
+        Strongly connected components of
+      type, class, instance, and role declarations
+*                                                                      *
+********************************************************************* -}
+
+{- Note [TyClGroups and dependency analysis]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A TyClGroup represents a strongly connected components of type/class/instance
+decls, together with the role annotations for the type/class declarations.
+
+The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order
+sequence of strongly-connected components.
+
+Invariants
+ * The type and class declarations, group_tyclds, may depend on each
+   other, or earlier TyClGroups, but not on later ones
+
+ * The role annotations, group_roles, are role-annotations for some or
+   all of the types and classes in group_tyclds (only).
+
+ * The instance declarations, group_instds, may (and usually will)
+   depend on group_tyclds, or on earlier TyClGroups, but not on later
+   ones.
+
+See Note [Dependency analsis of type, class, and instance decls]
+in RnSource for more info.
+-}
+
+-- | Type or Class Group
+data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
+  = TyClGroup { group_ext    :: XCTyClGroup pass
+              , group_tyclds :: [LTyClDecl pass]
+              , group_roles  :: [LRoleAnnotDecl pass]
+              , group_instds :: [LInstDecl pass] }
+  | XTyClGroup (XXTyClGroup pass)
+
+type instance XCTyClGroup (GhcPass _) = NoExtField
+type instance XXTyClGroup (GhcPass _) = NoExtCon
+
+
+tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
+tyClGroupTyClDecls = concatMap group_tyclds
+
+tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
+tyClGroupInstDecls = concatMap group_instds
+
+tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
+tyClGroupRoleDecls = concatMap group_roles
+
+
+
+{- *********************************************************************
+*                                                                      *
+               Data and type family declarations
+*                                                                      *
+********************************************************************* -}
+
+{- Note [FamilyResultSig]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+
+This data type represents the return signature of a type family.  Possible
+values are:
+
+ * NoSig - the user supplied no return signature:
+      type family Id a where ...
+
+ * KindSig - the user supplied the return kind:
+      type family Id a :: * where ...
+
+ * TyVarSig - user named the result with a type variable and possibly
+   provided a kind signature for that variable:
+      type family Id a = r where ...
+      type family Id a = (r :: *) where ...
+
+   Naming result of a type family is required if we want to provide
+   injectivity annotation for a type family:
+      type family Id a = r | r -> a where ...
+
+See also: Note [Injectivity annotation]
+
+Note [Injectivity annotation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A user can declare a type family to be injective:
+
+   type family Id a = r | r -> a where ...
+
+ * The part after the "|" is called "injectivity annotation".
+ * "r -> a" part is called "injectivity condition"; at the moment terms
+   "injectivity annotation" and "injectivity condition" are synonymous
+   because we only allow a single injectivity condition.
+ * "r" is the "LHS of injectivity condition". LHS can only contain the
+   variable naming the result of a type family.
+
+ * "a" is the "RHS of injectivity condition". RHS contains space-separated
+   type and kind variables representing the arguments of a type
+   family. Variables can be omitted if a type family is not injective in
+   these arguments. Example:
+         type family Foo a b c = d | d -> a c where ...
+
+Note that:
+ (a) naming of type family result is required to provide injectivity
+     annotation
+ (b) for associated types if the result was named then injectivity annotation
+     is mandatory. Otherwise result type variable is indistinguishable from
+     associated type default.
+
+It is possible that in the future this syntax will be extended to support
+more complicated injectivity annotations. For example we could declare that
+if we know the result of Plus and one of its arguments we can determine the
+other argument:
+
+   type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...
+
+Here injectivity annotation would consist of two comma-separated injectivity
+conditions.
+
+See also Note [Injective type families] in TyCon
+-}
+
+-- | Located type Family Result Signature
+type LFamilyResultSig pass = Located (FamilyResultSig pass)
+
+-- | type Family Result Signature
+data FamilyResultSig pass = -- see Note [FamilyResultSig]
+    NoSig (XNoSig pass)
+  -- ^ - 'ApiAnnotation.AnnKeywordId' :
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | KindSig  (XCKindSig pass) (LHsKind pass)
+  -- ^ - 'ApiAnnotation.AnnKeywordId' :
+  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
+  --             'ApiAnnotation.AnnCloseP'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
+  -- ^ - 'ApiAnnotation.AnnKeywordId' :
+  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
+  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
+  | XFamilyResultSig (XXFamilyResultSig pass)
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+type instance XNoSig            (GhcPass _) = NoExtField
+type instance XCKindSig         (GhcPass _) = NoExtField
+type instance XTyVarSig         (GhcPass _) = NoExtField
+type instance XXFamilyResultSig (GhcPass _) = NoExtCon
+
+
+-- | Located type Family Declaration
+type LFamilyDecl pass = Located (FamilyDecl pass)
+
+-- | type Family Declaration
+data FamilyDecl pass = FamilyDecl
+  { fdExt            :: XCFamilyDecl pass
+  , fdInfo           :: FamilyInfo pass              -- type/data, closed/open
+  , fdLName          :: Located (IdP pass)           -- type constructor
+  , fdTyVars         :: LHsQTyVars pass              -- type variables
+                       -- See Note [TyVar binders for associated declarations]
+  , fdFixity         :: LexicalFixity                -- Fixity used in the declaration
+  , fdResultSig      :: LFamilyResultSig pass        -- result signature
+  , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
+  }
+  | XFamilyDecl (XXFamilyDecl pass)
+  -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+  --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
+  --             'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
+  --             'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',
+  --             'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
+  --             'ApiAnnotation.AnnVbar'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+type instance XCFamilyDecl    (GhcPass _) = NoExtField
+type instance XXFamilyDecl    (GhcPass _) = NoExtCon
+
+
+-- | Located Injectivity Annotation
+type LInjectivityAnn pass = Located (InjectivityAnn pass)
+
+-- | If the user supplied an injectivity annotation it is represented using
+-- InjectivityAnn. At the moment this is a single injectivity condition - see
+-- Note [Injectivity annotation]. `Located name` stores the LHS of injectivity
+-- condition. `[Located name]` stores the RHS of injectivity condition. Example:
+--
+--   type family Foo a b c = r | r -> a c where ...
+--
+-- This will be represented as "InjectivityAnn `r` [`a`, `c`]"
+data InjectivityAnn pass
+  = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]
+  -- ^ - 'ApiAnnotation.AnnKeywordId' :
+  --             'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+data FamilyInfo pass
+  = DataFamily
+  | OpenTypeFamily
+     -- | 'Nothing' if we're in an hs-boot file and the user
+     -- said "type family Foo x where .."
+  | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
+
+-- | Does this family declaration have a complete, user-supplied kind signature?
+-- See Note [CUSKs: complete user-supplied kind signatures]
+famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled
+               -> Bool -- ^ True <=> this is an associated type family,
+                       --            and the parent class has /no/ CUSK
+               -> FamilyDecl (GhcPass pass)
+               -> Bool
+famDeclHasCusk _cusks_enabled@False _ _ = False
+famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
+               (FamilyDecl { fdInfo      = fam_info
+                           , fdTyVars    = tyvars
+                           , fdResultSig = L _ resultSig })
+  = case fam_info of
+      ClosedTypeFamily {} -> hsTvbAllKinded tyvars
+                          && hasReturnKindSignature resultSig
+      _ -> not assoc_with_no_cusk
+            -- Un-associated open type/data families have CUSKs
+            -- Associated type families have CUSKs iff the parent class does
+
+famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec
+
+-- | Does this family declaration have user-supplied return kind signature?
+hasReturnKindSignature :: FamilyResultSig a -> Bool
+hasReturnKindSignature (NoSig _)                        = False
+hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False
+hasReturnKindSignature _                                = True
+
+-- | Maybe return name of the result type variable
+resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
+resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
+resultVariableName _                = Nothing
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (FamilyDecl p) where
+  ppr = pprFamilyDecl TopLevel
+
+pprFamilyDecl :: (OutputableBndrId (GhcPass p))
+              => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
+pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
+                                    , fdTyVars = tyvars
+                                    , fdFixity = fixity
+                                    , fdResultSig = L _ result
+                                    , fdInjectivityAnn = mb_inj })
+  = vcat [ pprFlavour info <+> pp_top_level <+>
+           pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+>
+           pp_kind <+> pp_inj <+> pp_where
+         , nest 2 $ pp_eqns ]
+  where
+    pp_top_level = case top_level of
+                     TopLevel    -> text "family"
+                     NotTopLevel -> empty
+
+    pp_kind = case result of
+                NoSig    _         -> empty
+                KindSig  _ kind    -> dcolon <+> ppr kind
+                TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
+                XFamilyResultSig x -> ppr x
+    pp_inj = case mb_inj of
+               Just (L _ (InjectivityAnn lhs rhs)) ->
+                 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
+               Nothing -> empty
+    (pp_where, pp_eqns) = case info of
+      ClosedTypeFamily mb_eqns ->
+        ( text "where"
+        , case mb_eqns of
+            Nothing   -> text ".."
+            Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
+      _ -> (empty, empty)
+pprFamilyDecl _ (XFamilyDecl x) = ppr x
+
+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
+*                                                                      *
+********************************************************************* -}
+
+-- | Haskell Data type Definition
+data HsDataDefn pass   -- The payload of a data type defn
+                       -- Used *both* for vanilla data declarations,
+                       --       *and* for data family instances
+  = -- | Declares a data type or newtype, giving its constructors
+    -- @
+    --  data/newtype T a = <constrs>
+    --  data/newtype instance T [a] = <constrs>
+    -- @
+    HsDataDefn { dd_ext    :: XCHsDataDefn pass,
+                 dd_ND     :: NewOrData,
+                 dd_ctxt   :: LHsContext pass,           -- ^ Context
+                 dd_cType  :: Maybe (Located CType),
+                 dd_kindSig:: Maybe (LHsKind pass),
+                     -- ^ Optional kind signature.
+                     --
+                     -- @(Just k)@ for a GADT-style @data@,
+                     -- or @data instance@ decl, with explicit kind sig
+                     --
+                     -- Always @Nothing@ for H98-syntax decls
+
+                 dd_cons   :: [LConDecl pass],
+                     -- ^ Data constructors
+                     --
+                     -- For @data T a = T1 | T2 a@
+                     --   the 'LConDecl's all have 'ConDeclH98'.
+                     -- For @data T a where { T1 :: T a }@
+                     --   the 'LConDecls' all have 'ConDeclGADT'.
+
+                 dd_derivs :: HsDeriving pass  -- ^ Optional 'deriving' claues
+
+             -- For details on above see note [Api annotations] in ApiAnnotation
+   }
+  | XHsDataDefn (XXHsDataDefn pass)
+
+type instance XCHsDataDefn    (GhcPass _) = NoExtField
+type instance XXHsDataDefn    (GhcPass _) = NoExtCon
+
+-- | Haskell Deriving clause
+type HsDeriving pass = Located [LHsDerivingClause pass]
+  -- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is
+  -- plural because one can specify multiple deriving clauses using the
+  -- @-XDerivingStrategies@ language extension.
+  --
+  -- The list of 'LHsDerivingClause's corresponds to exactly what the user
+  -- requested to derive, in order. If no deriving clauses were specified,
+  -- the list is empty.
+
+type LHsDerivingClause pass = Located (HsDerivingClause pass)
+
+-- | A single @deriving@ clause of a data declaration.
+--
+--  - 'ApiAnnotation.AnnKeywordId' :
+--       'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
+--       'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
+--       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+data HsDerivingClause pass
+  -- See Note [Deriving strategies] in TcDeriv
+  = HsDerivingClause
+    { deriv_clause_ext :: XCHsDerivingClause pass
+    , deriv_clause_strategy :: Maybe (LDerivStrategy pass)
+      -- ^ The user-specified strategy (if any) to use when deriving
+      -- 'deriv_clause_tys'.
+    , deriv_clause_tys :: Located [LHsSigType pass]
+      -- ^ The types to derive.
+      --
+      -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
+      -- we can mention type variables that aren't bound by the datatype, e.g.
+      --
+      -- > data T b = ... deriving (C [a])
+      --
+      -- should produce a derived instance for @C [a] (T b)@.
+    }
+  | XHsDerivingClause (XXHsDerivingClause pass)
+
+type instance XCHsDerivingClause    (GhcPass _) = NoExtField
+type instance XXHsDerivingClause    (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsDerivingClause p) where
+  ppr (HsDerivingClause { deriv_clause_strategy = dcs
+                        , deriv_clause_tys      = L _ dct })
+    = hsep [ text "deriving"
+           , pp_strat_before
+           , pp_dct dct
+           , pp_strat_after ]
+      where
+        -- This complexity is to distinguish between
+        --    deriving Show
+        --    deriving (Show)
+        pp_dct [HsIB { hsib_body = ty }]
+                 = ppr (parenthesizeHsType appPrec ty)
+        pp_dct _ = parens (interpp'SP dct)
+
+        -- @via@ is unique in that in comes /after/ the class being derived,
+        -- so we must special-case it.
+        (pp_strat_before, pp_strat_after) =
+          case dcs of
+            Just (L _ via@ViaStrategy{}) -> (empty, ppr via)
+            _                            -> (ppDerivStrategy dcs, empty)
+  ppr (XHsDerivingClause x) = ppr x
+
+data NewOrData
+  = NewType                     -- ^ @newtype Blah ...@
+  | DataType                    -- ^ @data Blah ...@
+  deriving( Eq, Data )                -- Needed because Demand derives Eq
+
+-- | Convert a 'NewOrData' to a 'TyConFlavour'
+newOrDataToFlavour :: NewOrData -> TyConFlavour
+newOrDataToFlavour NewType  = NewtypeFlavour
+newOrDataToFlavour DataType = DataTypeFlavour
+
+-- | Located data Constructor Declaration
+type LConDecl pass = Located (ConDecl pass)
+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
+      --   in a GADT constructor list
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+-- |
+--
+-- @
+-- data T b = forall a. Eq a => MkT a b
+--   MkT :: forall b a. Eq a => MkT a b
+--
+-- data T b where
+--      MkT1 :: Int -> T Int
+--
+-- data T = Int `MkT` Int
+--        | MkT2
+--
+-- data T a where
+--      Int `MkT` Int :: T Int
+-- @
+--
+-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
+--            'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',
+--            'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',
+--            'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',
+--            'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | data Constructor Declaration
+data ConDecl pass
+  = ConDeclGADT
+      { con_g_ext   :: XConDeclGADT pass
+      , con_names   :: [Located (IdP pass)]
+
+      -- The next four fields describe the type after the '::'
+      -- See Note [GADT abstract syntax]
+      -- The following field is Located to anchor API Annotations,
+      -- AnnForall and AnnDot.
+      , con_forall  :: Located Bool      -- ^ True <=> explicit forall
+                                         --   False => hsq_explicit is empty
+      , con_qvars   :: LHsQTyVars pass
+                       -- Whether or not there is an /explicit/ forall, we still
+                       -- need to capture the implicitly-bound type/kind variables
+
+      , con_mb_cxt  :: Maybe (LHsContext pass) -- ^ User-written context (if any)
+      , con_args    :: HsConDeclDetails pass   -- ^ Arguments; never InfixCon
+      , con_res_ty  :: LHsType pass            -- ^ Result type
+
+      , con_doc     :: Maybe LHsDocString
+          -- ^ A possible Haddock comment.
+      }
+
+  | ConDeclH98
+      { con_ext     :: XConDeclH98 pass
+      , con_name    :: Located (IdP pass)
+
+      , con_forall  :: Located Bool
+                              -- ^ True <=> explicit user-written forall
+                              --     e.g. data T a = forall b. MkT b (b->a)
+                              --     con_ex_tvs = {b}
+                              -- False => con_ex_tvs is empty
+      , con_ex_tvs :: [LHsTyVarBndr pass]      -- ^ Existentials only
+      , con_mb_cxt :: Maybe (LHsContext pass)  -- ^ User-written context (if any)
+      , con_args   :: HsConDeclDetails pass    -- ^ Arguments; can be InfixCon
+
+      , con_doc       :: Maybe LHsDocString
+          -- ^ A possible Haddock comment.
+      }
+  | XConDecl (XXConDecl pass)
+
+type instance XConDeclGADT (GhcPass _) = NoExtField
+type instance XConDeclH98  (GhcPass _) = NoExtField
+type instance XXConDecl    (GhcPass _) = NoExtCon
+
+{- Note [GADT abstract syntax]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's a wrinkle in ConDeclGADT
+
+* For record syntax, it's all uniform.  Given:
+      data T a where
+        K :: forall a. Ord a => { x :: [a], ... } -> T a
+    we make the a ConDeclGADT for K with
+       con_qvars  = {a}
+       con_mb_cxt = Just [Ord a]
+       con_args   = RecCon <the record fields>
+       con_res_ty = T a
+
+  We need the RecCon before the reanmer, so we can find the record field
+  binders in GHC.Hs.Utils.hsConDeclsBinders.
+
+* However for a GADT constr declaration which is not a record, it can
+  be hard parse until we know operator fixities. Consider for example
+     C :: a :*: b -> a :*: b -> a :+: b
+  Initially this type will parse as
+      a :*: (b -> (a :*: (b -> (a :+: b))))
+  so it's hard to split up the arguments until we've done the precedence
+  resolution (in the renamer).
+
+  So:  - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr
+         type into the res_ty for a ConDeclGADT for now, and use
+         PrefixCon []
+            con_args   = PrefixCon []
+            con_res_ty = a :*: (b -> (a :*: (b -> (a :+: b))))
+
+       - In the renamer (RnSource.rnConDecl), we unravel it afer
+         operator fixities are sorted. So we generate. So we end
+         up with
+            con_args   = PrefixCon [ a :*: b, a :*: b ]
+            con_res_ty = a :+: b
+-}
+
+-- | Haskell data Constructor Declaration Details
+type HsConDeclDetails pass
+   = HsConDetails (LBangType pass) (Located [LConDeclField pass])
+
+getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
+getConNames ConDeclH98  {con_name  = name}  = [name]
+getConNames ConDeclGADT {con_names = names} = names
+getConNames (XConDecl nec) = noExtCon nec
+
+getConArgs :: ConDecl pass -> HsConDeclDetails pass
+getConArgs d = con_args d
+
+hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]
+hsConDeclArgTys (PrefixCon tys)    = tys
+hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
+hsConDeclArgTys (RecCon flds)      = map (cd_fld_type . unLoc) (unLoc flds)
+
+hsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]
+hsConDeclTheta Nothing            = []
+hsConDeclTheta (Just (L _ theta)) = theta
+
+pp_data_defn :: (OutputableBndrId (GhcPass p))
+                  => (LHsContext (GhcPass p) -> SDoc)   -- Printing the header
+                  -> HsDataDefn (GhcPass p)
+                  -> SDoc
+pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context
+                                , dd_cType = mb_ct
+                                , dd_kindSig = mb_sig
+                                , dd_cons = condecls, dd_derivs = derivings })
+  | null condecls
+  = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig
+    <+> pp_derivings derivings
+
+  | otherwise
+  = hang (ppr new_or_data <+> pp_ct  <+> pp_hdr context <+> pp_sig)
+       2 (pp_condecls condecls $$ pp_derivings derivings)
+  where
+    pp_ct = case mb_ct of
+               Nothing   -> empty
+               Just ct -> ppr ct
+    pp_sig = case mb_sig of
+               Nothing   -> empty
+               Just kind -> dcolon <+> ppr kind
+    pp_derivings (L _ ds) = vcat (map ppr ds)
+pp_data_defn _ (XHsDataDefn x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsDataDefn p) where
+   ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
+
+instance Outputable NewOrData where
+  ppr NewType  = text "newtype"
+  ppr DataType = text "data"
+
+pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc
+pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
+  = hang (text "where") 2 (vcat (map ppr cs))
+pp_condecls cs                    -- In H98 syntax
+  = equals <+> sep (punctuate (text " |") (map ppr cs))
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where
+    ppr = pprConDecl
+
+pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc
+pprConDecl (ConDeclH98 { con_name = L _ con
+                       , con_ex_tvs = ex_tvs
+                       , con_mb_cxt = mcxt
+                       , con_args = args
+                       , con_doc = doc })
+  = sep [ppr_mbDoc doc, pprHsForAll ForallInvis ex_tvs cxt, ppr_details args]
+  where
+    ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2]
+    ppr_details (PrefixCon tys)  = hsep (pprPrefixOcc con
+                                   : map (pprHsType . unLoc) tys)
+    ppr_details (RecCon fields)  = pprPrefixOcc con
+                                 <+> pprConDeclFields (unLoc fields)
+    cxt = fromMaybe noLHsContext mcxt
+
+pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
+                        , con_mb_cxt = mcxt, con_args = args
+                        , con_res_ty = res_ty, con_doc = doc })
+  = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
+    <+> (sep [pprHsForAll ForallInvis (hsq_explicit qvars) cxt,
+              ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])
+  where
+    get_args (PrefixCon args) = map ppr args
+    get_args (RecCon fields)  = [pprConDeclFields (unLoc fields)]
+    get_args (InfixCon {})    = pprPanic "pprConDecl:GADT" (ppr cons)
+
+    cxt = fromMaybe noLHsContext mcxt
+
+    ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
+    ppr_arrow_chain []     = empty
+
+pprConDecl (XConDecl x) = ppr x
+
+ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
+ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
+
+{-
+************************************************************************
+*                                                                      *
+                Instance declarations
+*                                                                      *
+************************************************************************
+
+Note [Type family instance declarations in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The data type FamEqn represents one equation of a type family instance.
+Aside from the pass, it is also parameterised over another field, feqn_rhs.
+feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType
+(for type family instances).
+
+Type family instances also include associated type family default equations.
+That is because a default for a type family looks like this:
+
+  class C a where
+    type family F a b :: Type
+    type F c d = (c,d)   -- Default instance
+
+The default declaration is really just a `type instance` declaration, but one
+with particularly simple patterns: they must all be distinct type variables.
+That's because we will instantiate it (in an instance declaration for `C`) if
+we don't give an explicit instance for `F`. Note that the names of the
+variables don't need to match those of the class: it really is like a
+free-standing `type instance` declaration.
+-}
+
+----------------- Type synonym family instances -------------
+
+-- | Located Type Family Instance Equation
+type LTyFamInstEqn pass = Located (TyFamInstEqn pass)
+  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+  --   when in a list
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Haskell Type Patterns
+type HsTyPats pass = [LHsTypeArg pass]
+
+{- Note [Family instance declaration binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The feqn_pats field of FamEqn (family instance equation) stores the LHS type
+(and kind) patterns. Any type (and kind) variables contained
+in these type patterns are bound in the hsib_vars field of the HsImplicitBndrs
+in FamInstEqn depending on whether or not an explicit forall is present. In
+the case of an explicit forall, the hsib_vars only includes kind variables not
+bound in the forall. Otherwise, all type (and kind) variables are bound in
+the hsib_vars. In the latter case, note that in particular
+
+* The hsib_vars *includes* any anonymous wildcards.  For example
+     type instance F a _ = a
+  The hsib_vars will be {a, _}.  Remember that each separate wildcard
+  '_' gets its own unique.  In this context wildcards behave just like
+  an ordinary type variable, only anonymous.
+
+* The hsib_vars *includes* type variables that are already in scope
+
+   Eg   class C s t where
+          type F t p :: *
+        instance C w (a,b) where
+          type F (a,b) x = x->a
+   The hsib_vars of the F decl are {a,b,x}, even though the F decl
+   is nested inside the 'instance' decl.
+
+   However after the renamer, the uniques will match up:
+        instance C w7 (a8,b9) where
+          type F (a8,b9) x10 = x10->a8
+   so that we can compare the type pattern in the 'instance' decl and
+   in the associated 'type' decl
+
+c.f. Note [TyVar binders for associated decls]
+-}
+
+-- | Type Family Instance Equation
+type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)
+
+-- | Type family default declarations.
+-- A convenient synonym for 'TyFamInstDecl'.
+-- See @Note [Type family instance declarations in HsSyn]@.
+type TyFamDefltDecl = TyFamInstDecl
+
+-- | Located type family default declarations.
+type LTyFamDefltDecl pass = Located (TyFamDefltDecl pass)
+
+-- | Located Type Family Instance Declaration
+type LTyFamInstDecl pass = Located (TyFamInstDecl pass)
+
+-- | Type Family Instance Declaration
+newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
+    -- ^
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+    --           'ApiAnnotation.AnnInstance',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+----------------- Data family instances -------------
+
+-- | Located Data Family Instance Declaration
+type LDataFamInstDecl pass = Located (DataFamInstDecl pass)
+
+-- | Data Family Instance Declaration
+newtype DataFamInstDecl pass
+  = DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }
+    -- ^
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
+    --           'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
+    --           'ApiAnnotation.AnnDcolon'
+    --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
+    --           'ApiAnnotation.AnnClose'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+----------------- Family instances (common types) -------------
+
+-- | Located Family Instance Equation
+type LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)
+
+-- | Family Instance Equation
+type FamInstEqn pass rhs = HsImplicitBndrs pass (FamEqn pass rhs)
+            -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).
+            -- See Note [Family instance declaration binders]
+
+-- | Family Equation
+--
+-- One equation in a type family instance declaration, data family instance
+-- declaration, or type family default.
+-- See Note [Type family instance declarations in HsSyn]
+-- See Note [Family instance declaration binders]
+data FamEqn pass rhs
+  = FamEqn
+       { feqn_ext    :: XCFamEqn pass rhs
+       , feqn_tycon  :: Located (IdP pass)
+       , feqn_bndrs  :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars
+       , feqn_pats   :: HsTyPats pass
+       , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
+       , feqn_rhs    :: rhs
+       }
+    -- ^
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
+  | XFamEqn (XXFamEqn pass rhs)
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+type instance XCFamEqn    (GhcPass _) r = NoExtField
+type instance XXFamEqn    (GhcPass _) r = NoExtCon
+
+----------------- Class instances -------------
+
+-- | Located Class Instance Declaration
+type LClsInstDecl pass = Located (ClsInstDecl pass)
+
+-- | Class Instance Declaration
+data ClsInstDecl pass
+  = ClsInstDecl
+      { cid_ext     :: XCClsInstDecl pass
+      , cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type
+                                          -- Using a polytype means that the renamer conveniently
+                                          -- figures out the quantified type variables for us.
+      , cid_binds         :: LHsBinds pass       -- Class methods
+      , cid_sigs          :: [LSig pass]         -- User-supplied pragmatic info
+      , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances
+      , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
+      , cid_overlap_mode  :: Maybe (Located OverlapMode)
+         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+         --                                    'ApiAnnotation.AnnClose',
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+      }
+    -- ^
+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',
+    --           'ApiAnnotation.AnnWhere',
+    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+  | XClsInstDecl (XXClsInstDecl pass)
+
+type instance XCClsInstDecl    (GhcPass _) = NoExtField
+type instance XXClsInstDecl    (GhcPass _) = NoExtCon
+
+----------------- Instances of all kinds -------------
+
+-- | Located Instance Declaration
+type LInstDecl pass = Located (InstDecl pass)
+
+-- | Instance Declaration
+data InstDecl pass  -- Both class and family instances
+  = ClsInstD
+      { cid_d_ext :: XClsInstD pass
+      , cid_inst  :: ClsInstDecl pass }
+  | DataFamInstD              -- data family instance
+      { dfid_ext  :: XDataFamInstD pass
+      , dfid_inst :: DataFamInstDecl pass }
+  | TyFamInstD              -- type family instance
+      { tfid_ext  :: XTyFamInstD pass
+      , tfid_inst :: TyFamInstDecl pass }
+  | XInstDecl (XXInstDecl pass)
+
+type instance XClsInstD     (GhcPass _) = NoExtField
+type instance XDataFamInstD (GhcPass _) = NoExtField
+type instance XTyFamInstD   (GhcPass _) = NoExtField
+type instance XXInstDecl    (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (TyFamInstDecl p) where
+  ppr = pprTyFamInstDecl TopLevel
+
+pprTyFamInstDecl :: (OutputableBndrId (GhcPass p))
+                 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
+pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
+   = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
+
+ppr_instance_keyword :: TopLevelFlag -> SDoc
+ppr_instance_keyword TopLevel    = text "instance"
+ppr_instance_keyword NotTopLevel = empty
+
+pprTyFamDefltDecl :: (OutputableBndrId (GhcPass p))
+                  => TyFamDefltDecl (GhcPass p) -> SDoc
+pprTyFamDefltDecl = pprTyFamInstDecl NotTopLevel
+
+ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))
+                 => TyFamInstEqn (GhcPass p) -> SDoc
+ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = L _ tycon
+                                            , feqn_bndrs  = bndrs
+                                            , feqn_pats   = pats
+                                            , feqn_fixity = fixity
+                                            , feqn_rhs    = rhs }})
+    = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs
+ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x
+ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (DataFamInstDecl p) where
+  ppr = pprDataFamInstDecl TopLevel
+
+pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))
+                   => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
+pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
+                             FamEqn { feqn_tycon  = L _ tycon
+                                    , feqn_bndrs  = bndrs
+                                    , feqn_pats   = pats
+                                    , feqn_fixity = fixity
+                                    , feqn_rhs    = defn }}})
+  = pp_data_defn pp_hdr defn
+  where
+    pp_hdr ctxt = ppr_instance_keyword top_lvl
+              <+> pprHsFamInstLHS tycon bndrs pats fixity ctxt
+                  -- pp_data_defn pretty-prints the kind sig. See #14817.
+
+pprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x)))
+  = ppr x
+pprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x))
+  = ppr x
+
+pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc
+pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
+                        FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
+  = ppr nd
+pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
+                        FamEqn { feqn_rhs = XHsDataDefn x}}})
+  = ppr x
+pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))
+  = ppr x
+pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))
+  = ppr x
+
+pprHsFamInstLHS :: (OutputableBndrId (GhcPass p))
+   => IdP (GhcPass p)
+   -> Maybe [LHsTyVarBndr (GhcPass p)]
+   -> HsTyPats (GhcPass p)
+   -> LexicalFixity
+   -> LHsContext (GhcPass p)
+   -> SDoc
+pprHsFamInstLHS thing bndrs typats fixity mb_ctxt
+   = hsep [ pprHsExplicitForAll ForallInvis bndrs
+          , pprLHsContext mb_ctxt
+          , pp_pats typats ]
+   where
+     pp_pats (patl:patr:pats)
+       | Infix <- fixity
+       = let pp_op_app = hsep [ ppr patl, pprInfixOcc thing, ppr patr ] in
+         case pats of
+           [] -> pp_op_app
+           _  -> hsep (parens pp_op_app : map ppr pats)
+
+     pp_pats pats = hsep [ pprPrefixOcc thing
+                         , hsep (map ppr pats)]
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (ClsInstDecl p) where
+    ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
+                     , cid_sigs = sigs, cid_tyfam_insts = ats
+                     , cid_overlap_mode = mbOverlap
+                     , cid_datafam_insts = adts })
+      | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
+      = top_matter
+
+      | otherwise       -- Laid out
+      = vcat [ top_matter <+> text "where"
+             , nest 2 $ pprDeclList $
+               map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++
+               map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
+               pprLHsBindsForUser binds sigs ]
+      where
+        top_matter = text "instance" <+> ppOverlapPragma mbOverlap
+                                             <+> ppr inst_ty
+    ppr (XClsInstDecl x) = ppr x
+
+ppDerivStrategy :: (p ~ GhcPass pass, OutputableBndrId p)
+                => Maybe (LDerivStrategy p) -> SDoc
+ppDerivStrategy mb =
+  case mb of
+    Nothing       -> empty
+    Just (L _ ds) -> ppr ds
+
+ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
+ppOverlapPragma mb =
+  case mb of
+    Nothing           -> empty
+    Just (L _ (NoOverlap s))    -> maybe_stext s "{-# NO_OVERLAP #-}"
+    Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
+    Just (L _ (Overlapping s))  -> maybe_stext s "{-# OVERLAPPING #-}"
+    Just (L _ (Overlaps s))     -> maybe_stext s "{-# OVERLAPS #-}"
+    Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"
+  where
+    maybe_stext NoSourceText     alt = text alt
+    maybe_stext (SourceText src) _   = text src <+> text "#-}"
+
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
+    ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
+    ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
+    ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
+    ppr (XInstDecl x) = ppr x
+
+-- Extract the declarations of associated data types from an instance
+
+instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)]
+instDeclDataFamInsts inst_decls
+  = concatMap do_one inst_decls
+  where
+    do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))
+      = map unLoc fam_insts
+    do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]
+    do_one (L _ (TyFamInstD {}))                              = []
+    do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec
+    do_one (L _ (XInstDecl nec))                 = noExtCon nec
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[DerivDecl]{A stand-alone instance deriving declaration}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located stand-alone 'deriving instance' declaration
+type LDerivDecl pass = Located (DerivDecl pass)
+
+-- | Stand-alone 'deriving instance' declaration
+data DerivDecl pass = DerivDecl
+        { deriv_ext          :: XCDerivDecl pass
+        , deriv_type         :: LHsSigWcType pass
+          -- ^ The instance type to derive.
+          --
+          -- It uses an 'LHsSigWcType' because the context is allowed to be a
+          -- single wildcard:
+          --
+          -- > deriving instance _ => Eq (Foo a)
+          --
+          -- Which signifies that the context should be inferred.
+
+          -- See Note [Inferring the instance context] in TcDerivInfer.
+
+        , deriv_strategy     :: Maybe (LDerivStrategy pass)
+        , deriv_overlap_mode :: Maybe (Located OverlapMode)
+         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
+         --        'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',
+         --        'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
+         --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+        }
+  | XDerivDecl (XXDerivDecl pass)
+
+type instance XCDerivDecl    (GhcPass _) = NoExtField
+type instance XXDerivDecl    (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (DerivDecl p) where
+    ppr (DerivDecl { deriv_type = ty
+                   , deriv_strategy = ds
+                   , deriv_overlap_mode = o })
+        = hsep [ text "deriving"
+               , ppDerivStrategy ds
+               , text "instance"
+               , ppOverlapPragma o
+               , ppr ty ]
+    ppr (XDerivDecl x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+                Deriving strategies
+*                                                                      *
+************************************************************************
+-}
+
+-- | A 'Located' 'DerivStrategy'.
+type LDerivStrategy pass = Located (DerivStrategy pass)
+
+-- | Which technique the user explicitly requested when deriving an instance.
+data DerivStrategy pass
+  -- See Note [Deriving strategies] in TcDeriv
+  = StockStrategy    -- ^ GHC's \"standard\" strategy, which is to implement a
+                     --   custom instance for the data type. This only works
+                     --   for certain types that GHC knows about (e.g., 'Eq',
+                     --   'Show', 'Functor' when @-XDeriveFunctor@ is enabled,
+                     --   etc.)
+  | AnyclassStrategy -- ^ @-XDeriveAnyClass@
+  | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@
+  | ViaStrategy (XViaStrategy pass)
+                     -- ^ @-XDerivingVia@
+
+type instance XViaStrategy GhcPs = LHsSigType GhcPs
+type instance XViaStrategy GhcRn = LHsSigType GhcRn
+type instance XViaStrategy GhcTc = Type
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+        => Outputable (DerivStrategy p) where
+    ppr StockStrategy    = text "stock"
+    ppr AnyclassStrategy = text "anyclass"
+    ppr NewtypeStrategy  = text "newtype"
+    ppr (ViaStrategy ty) = text "via" <+> ppr ty
+
+-- | 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"
+
+-- | Eliminate a 'DerivStrategy'.
+foldDerivStrategy :: (p ~ GhcPass pass)
+                  => r -> (XViaStrategy p -> r) -> DerivStrategy p -> r
+foldDerivStrategy other _   StockStrategy    = other
+foldDerivStrategy other _   AnyclassStrategy = other
+foldDerivStrategy other _   NewtypeStrategy  = other
+foldDerivStrategy _     via (ViaStrategy t)  = via t
+
+-- | Map over the @via@ type if dealing with 'ViaStrategy'. Otherwise,
+-- return the 'DerivStrategy' unchanged.
+mapDerivStrategy :: (p ~ GhcPass pass)
+                 => (XViaStrategy p -> XViaStrategy p)
+                 -> DerivStrategy p -> DerivStrategy p
+mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[DefaultDecl]{A @default@ declaration}
+*                                                                      *
+************************************************************************
+
+There can only be one default declaration per module, but it is hard
+for the parser to check that; we pass them all through in the abstract
+syntax, and that restriction must be checked in the front end.
+-}
+
+-- | Located Default Declaration
+type LDefaultDecl pass = Located (DefaultDecl pass)
+
+-- | Default Declaration
+data DefaultDecl pass
+  = DefaultDecl (XCDefaultDecl pass) [LHsType pass]
+        -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
+        --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | XDefaultDecl (XXDefaultDecl pass)
+
+type instance XCDefaultDecl    (GhcPass _) = NoExtField
+type instance XXDefaultDecl    (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (DefaultDecl p) where
+    ppr (DefaultDecl _ tys)
+      = text "default" <+> parens (interpp'SP tys)
+    ppr (XDefaultDecl x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Foreign function interface declaration}
+*                                                                      *
+************************************************************************
+-}
+
+-- foreign declarations are distinguished as to whether they define or use a
+-- Haskell name
+--
+--  * the Boolean value indicates whether the pre-standard deprecated syntax
+--   has been used
+
+-- | Located Foreign Declaration
+type LForeignDecl pass = Located (ForeignDecl pass)
+
+-- | Foreign Declaration
+data ForeignDecl pass
+  = ForeignImport
+      { fd_i_ext  :: XForeignImport pass   -- Post typechecker, rep_ty ~ sig_ty
+      , fd_name   :: Located (IdP pass)    -- defines this name
+      , fd_sig_ty :: LHsSigType pass       -- sig_ty
+      , fd_fi     :: ForeignImport }
+
+  | ForeignExport
+      { fd_e_ext  :: XForeignExport pass   -- Post typechecker, rep_ty ~ sig_ty
+      , fd_name   :: Located (IdP pass)    -- uses this name
+      , fd_sig_ty :: LHsSigType pass       -- sig_ty
+      , fd_fe     :: ForeignExport }
+        -- ^
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
+        --           'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',
+        --           'ApiAnnotation.AnnDcolon'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | XForeignDecl (XXForeignDecl pass)
+
+{-
+    In both ForeignImport and ForeignExport:
+        sig_ty is the type given in the Haskell code
+        rep_ty is the representation for this type, i.e. with newtypes
+               coerced away and type functions evaluated.
+    Thus if the declaration is valid, then rep_ty will only use types
+    such as Int and IO that we know how to make foreign calls with.
+-}
+
+type instance XForeignImport   GhcPs = NoExtField
+type instance XForeignImport   GhcRn = NoExtField
+type instance XForeignImport   GhcTc = Coercion
+
+type instance XForeignExport   GhcPs = NoExtField
+type instance XForeignExport   GhcRn = NoExtField
+type instance XForeignExport   GhcTc = Coercion
+
+type instance XXForeignDecl    (GhcPass _) = NoExtCon
+
+-- 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
+
+-- details of an external C entity
+--
+data CImportSpec = CLabel    CLabelString     -- import address of a C label
+                 | CFunction CCallTarget      -- static or dynamic function
+                 | CWrapper                   -- wrapper to expose closures
+                                              -- (former f.e.d.)
+  deriving Data
+
+-- 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
+--
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (ForeignDecl p) where
+  ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
+    = hang (text "foreign import" <+> ppr fimport <+> ppr n)
+         2 (dcolon <+> ppr ty)
+  ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
+    hang (text "foreign export" <+> ppr fexport <+> ppr n)
+       2 (dcolon <+> ppr ty)
+  ppr (XForeignDecl x) = ppr x
+
+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 '"'
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Transformation rules}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Rule Declarations
+type LRuleDecls pass = Located (RuleDecls pass)
+
+  -- Note [Pragma source text] in BasicTypes
+-- | Rule Declarations
+data RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass
+                              , rds_src   :: SourceText
+                              , rds_rules :: [LRuleDecl pass] }
+  | XRuleDecls (XXRuleDecls pass)
+
+type instance XCRuleDecls    (GhcPass _) = NoExtField
+type instance XXRuleDecls    (GhcPass _) = NoExtCon
+
+-- | Located Rule Declaration
+type LRuleDecl pass = Located (RuleDecl pass)
+
+-- | Rule Declaration
+data RuleDecl pass
+  = HsRule -- Source rule
+       { rd_ext  :: XHsRule pass
+           -- ^ After renamer, free-vars from the LHS and RHS
+       , rd_name :: Located (SourceText,RuleName)
+           -- ^ Note [Pragma source text] in BasicTypes
+       , rd_act  :: Activation
+       , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]
+           -- ^ Forall'd type vars
+       , rd_tmvs :: [LRuleBndr pass]
+           -- ^ Forall'd term vars, before typechecking; after typechecking
+           --    this includes all forall'd vars
+       , rd_lhs  :: Located (HsExpr pass)
+       , rd_rhs  :: Located (HsExpr pass)
+       }
+    -- ^
+    --  - 'ApiAnnotation.AnnKeywordId' :
+    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
+    --           'ApiAnnotation.AnnVal',
+    --           'ApiAnnotation.AnnClose',
+    --           'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
+    --           'ApiAnnotation.AnnEqual',
+  | XRuleDecl (XXRuleDecl pass)
+
+data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
+  deriving Data
+
+type instance XHsRule       GhcPs = NoExtField
+type instance XHsRule       GhcRn = HsRuleRn
+type instance XHsRule       GhcTc = HsRuleRn
+
+type instance XXRuleDecl    (GhcPass _) = NoExtCon
+
+flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
+flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
+
+-- | Located Rule Binder
+type LRuleBndr pass = Located (RuleBndr pass)
+
+-- | Rule Binder
+data RuleBndr pass
+  = RuleBndr (XCRuleBndr pass)  (Located (IdP pass))
+  | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)
+  | XRuleBndr (XXRuleBndr pass)
+        -- ^
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+        --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+
+type instance XCRuleBndr    (GhcPass _) = NoExtField
+type instance XRuleBndrSig  (GhcPass _) = NoExtField
+type instance XXRuleBndr    (GhcPass _) = NoExtCon
+
+collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
+collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
+
+pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
+pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecls p) where
+  ppr (HsRules { rds_src = st
+               , rds_rules = rules })
+    = pprWithSourceText st (text "{-# RULES")
+          <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
+  ppr (XRuleDecls x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
+  ppr (HsRule { rd_name = name
+              , rd_act  = act
+              , rd_tyvs = tys
+              , rd_tmvs = tms
+              , rd_lhs  = lhs
+              , rd_rhs  = rhs })
+        = sep [pprFullRuleName name <+> ppr act,
+               nest 4 (pp_forall_ty tys <+> pp_forall_tm tys
+                                        <+> pprExpr (unLoc lhs)),
+               nest 6 (equals <+> pprExpr (unLoc rhs)) ]
+        where
+          pp_forall_ty Nothing     = empty
+          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
+  ppr (XRuleDecl x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
+   ppr (RuleBndr _ name) = ppr name
+   ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)
+   ppr (XRuleBndr x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[DocDecl]{Document comments}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Documentation comment Declaration
+type LDocDecl = Located (DocDecl)
+
+-- | Documentation comment Declaration
+data DocDecl
+  = DocCommentNext HsDocString
+  | DocCommentPrev HsDocString
+  | DocCommentNamed String HsDocString
+  | DocGroup Int HsDocString
+  deriving Data
+
+-- Okay, I need to reconstruct the document comments, but for now:
+instance Outputable DocDecl where
+  ppr _ = text "<document comment>"
+
+docDeclDoc :: DocDecl -> HsDocString
+docDeclDoc (DocCommentNext d) = d
+docDeclDoc (DocCommentPrev d) = d
+docDeclDoc (DocCommentNamed _ d) = d
+docDeclDoc (DocGroup _ d) = d
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[DeprecDecl]{Deprecations}
+*                                                                      *
+************************************************************************
+
+We use exported entities for things to deprecate.
+-}
+
+-- | Located Warning Declarations
+type LWarnDecls pass = Located (WarnDecls pass)
+
+ -- Note [Pragma source text] in BasicTypes
+-- | Warning pragma Declarations
+data WarnDecls pass = Warnings { wd_ext      :: XWarnings pass
+                               , wd_src      :: SourceText
+                               , wd_warnings :: [LWarnDecl pass]
+                               }
+  | XWarnDecls (XXWarnDecls pass)
+
+type instance XWarnings      (GhcPass _) = NoExtField
+type instance XXWarnDecls    (GhcPass _) = NoExtCon
+
+-- | Located Warning pragma Declaration
+type LWarnDecl pass = Located (WarnDecl pass)
+
+-- | Warning pragma Declaration
+data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt
+                   | XWarnDecl (XXWarnDecl pass)
+
+type instance XWarning      (GhcPass _) = NoExtField
+type instance XXWarnDecl    (GhcPass _) = NoExtCon
+
+
+instance (p ~ GhcPass pass,OutputableBndr (IdP p))
+        => Outputable (WarnDecls p) where
+    ppr (Warnings _ (SourceText src) decls)
+      = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
+    ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"
+    ppr (XWarnDecls x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndr (IdP p))
+       => Outputable (WarnDecl p) where
+    ppr (Warning _ thing txt)
+      = hsep ( punctuate comma (map ppr thing))
+              <+> ppr txt
+    ppr (XWarnDecl x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[AnnDecl]{Annotations}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Annotation Declaration
+type LAnnDecl pass = Located (AnnDecl pass)
+
+-- | Annotation Declaration
+data AnnDecl pass = HsAnnotation
+                      (XHsAnnotation pass)
+                      SourceText -- Note [Pragma source text] in BasicTypes
+                      (AnnProvenance (IdP pass)) (Located (HsExpr pass))
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+      --           'ApiAnnotation.AnnType'
+      --           'ApiAnnotation.AnnModule'
+      --           'ApiAnnotation.AnnClose'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+  | XAnnDecl (XXAnnDecl pass)
+
+type instance XHsAnnotation (GhcPass _) = NoExtField
+type instance XXAnnDecl     (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
+    ppr (HsAnnotation _ _ provenance expr)
+      = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
+    ppr (XAnnDecl x) = ppr x
+
+-- | Annotation Provenance
+data AnnProvenance name = ValueAnnProvenance (Located name)
+                        | TypeAnnProvenance (Located name)
+                        | ModuleAnnProvenance
+deriving instance Functor     AnnProvenance
+deriving instance Foldable    AnnProvenance
+deriving instance Traversable AnnProvenance
+deriving instance (Data pass) => Data (AnnProvenance pass)
+
+annProvenanceName_maybe :: AnnProvenance name -> Maybe name
+annProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name
+annProvenanceName_maybe (TypeAnnProvenance (L _ name))  = Just name
+annProvenanceName_maybe ModuleAnnProvenance       = Nothing
+
+pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
+pprAnnProvenance ModuleAnnProvenance       = text "ANN module"
+pprAnnProvenance (ValueAnnProvenance (L _ name))
+  = text "ANN" <+> ppr name
+pprAnnProvenance (TypeAnnProvenance (L _ name))
+  = text "ANN type" <+> ppr name
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[RoleAnnot]{Role annotations}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Role Annotation Declaration
+type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)
+
+-- See #8185 for more info about why role annotations are
+-- top-level declarations
+-- | Role Annotation Declaration
+data RoleAnnotDecl pass
+  = RoleAnnotDecl (XCRoleAnnotDecl pass)
+                  (Located (IdP pass))   -- type constructor
+                  [Located (Maybe Role)] -- optional annotations
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+      --           'ApiAnnotation.AnnRole'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+  | XRoleAnnotDecl (XXRoleAnnotDecl pass)
+
+type instance XCRoleAnnotDecl (GhcPass _) = NoExtField
+type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndr (IdP p))
+       => Outputable (RoleAnnotDecl p) where
+  ppr (RoleAnnotDecl _ ltycon roles)
+    = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+>
+      hsep (map (pp_role . unLoc) roles)
+    where
+      pp_role Nothing  = underscore
+      pp_role (Just r) = ppr r
+  ppr (XRoleAnnotDecl x) = ppr x
+
+roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
+roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name
+roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs
new file mode 100644
index 0000000000..18a820fa6e
--- /dev/null
+++ b/compiler/GHC/Hs/Doc.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module GHC.Hs.Doc
+  ( HsDocString
+  , LHsDocString
+  , mkHsDocString
+  , mkHsDocStringUtf8ByteString
+  , unpackHDS
+  , hsDocStringToByteString
+  , ppr_mbDoc
+
+  , appendDocs
+  , concatDocs
+
+  , DeclDocMap(..)
+  , emptyDeclDocMap
+
+  , ArgDocMap(..)
+  , emptyArgDocMap
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Binary
+import Encoding
+import FastFunctions
+import Name
+import Outputable
+import SrcLoc
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Internal as BS
+import Data.Data
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import Foreign
+
+-- | Haskell Documentation String
+--
+-- Internally this is a UTF8-Encoded 'ByteString'.
+newtype HsDocString = HsDocString ByteString
+  -- There are at least two plausible Semigroup instances for this type:
+  --
+  -- 1. Simple string concatenation.
+  -- 2. Concatenation as documentation paragraphs with newlines in between.
+  --
+  -- To avoid confusion, we pass on defining an instance at all.
+  deriving (Eq, Show, Data)
+
+-- | Located Haskell Documentation String
+type LHsDocString = Located HsDocString
+
+instance Binary HsDocString where
+  put_ bh (HsDocString bs) = put_ bh bs
+  get bh = HsDocString <$> get bh
+
+instance Outputable HsDocString where
+  ppr = doubleQuotes . text . unpackHDS
+
+mkHsDocString :: String -> HsDocString
+mkHsDocString s =
+  inlinePerformIO $ do
+    let len = utf8EncodedLength s
+    buf <- mallocForeignPtrBytes len
+    withForeignPtr buf $ \ptr -> do
+      utf8EncodeString ptr s
+      pure (HsDocString (BS.fromForeignPtr buf 0 len))
+
+-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.
+mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
+mkHsDocStringUtf8ByteString = HsDocString
+
+unpackHDS :: HsDocString -> String
+unpackHDS = utf8DecodeByteString . hsDocStringToByteString
+
+-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.
+hsDocStringToByteString :: HsDocString -> ByteString
+hsDocStringToByteString (HsDocString bs) = bs
+
+ppr_mbDoc :: Maybe LHsDocString -> SDoc
+ppr_mbDoc (Just doc) = ppr doc
+ppr_mbDoc Nothing    = empty
+
+-- | Join two docstrings.
+--
+-- Non-empty docstrings are joined with two newlines in between,
+-- resulting in separate paragraphs.
+appendDocs :: HsDocString -> HsDocString -> HsDocString
+appendDocs x y =
+  fromMaybe
+    (HsDocString BS.empty)
+    (concatDocs [x, y])
+
+-- | Concat docstrings with two newlines in between.
+--
+-- Empty docstrings are skipped.
+--
+-- If all inputs are empty, 'Nothing' is returned.
+concatDocs :: [HsDocString] -> Maybe HsDocString
+concatDocs xs =
+    if BS.null b
+      then Nothing
+      else Just (HsDocString b)
+  where
+    b = BS.intercalate (C8.pack "\n\n")
+      . filter (not . BS.null)
+      . map hsDocStringToByteString
+      $ xs
+
+-- | Docs for declarations: functions, data types, instances, methods etc.
+newtype DeclDocMap = DeclDocMap (Map Name HsDocString)
+
+instance Binary DeclDocMap where
+  put_ bh (DeclDocMap m) = put_ bh (Map.toList m)
+  -- We can't rely on a deterministic ordering of the `Name`s here.
+  -- See the comments on `Name`'s `Ord` instance for context.
+  get bh = DeclDocMap . Map.fromList <$> get bh
+
+instance Outputable DeclDocMap where
+  ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m))
+    where
+      pprPair (name, doc) = ppr name Outputable.<> colon $$ nest 2 (ppr doc)
+
+emptyDeclDocMap :: DeclDocMap
+emptyDeclDocMap = DeclDocMap Map.empty
+
+-- | Docs for arguments. E.g. function arguments, method arguments.
+newtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString))
+
+instance Binary ArgDocMap where
+  put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> m))
+  -- We can't rely on a deterministic ordering of the `Name`s here.
+  -- See the comments on `Name`'s `Ord` instance for context.
+  get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh
+
+instance Outputable ArgDocMap where
+  ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m))
+    where
+      pprPair (name, int_map) =
+        ppr name Outputable.<> colon $$ nest 2 (pprIntMap int_map)
+      pprIntMap im = vcat (map pprIPair (Map.toAscList im))
+      pprIPair (i, doc) = ppr i Outputable.<> colon $$ nest 2 (ppr doc)
+
+emptyArgDocMap :: ArgDocMap
+emptyArgDocMap = ArgDocMap Map.empty
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
new file mode 100644
index 0000000000..5bdfc8668e
--- /dev/null
+++ b/compiler/GHC/Hs/Dump.hs
@@ -0,0 +1,220 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Contains a debug function to dump parts of the GHC.Hs AST. It uses a syb
+-- traversal which falls back to displaying based on the constructor name, so
+-- can be used to dump anything having a @Data.Data@ instance.
+
+module GHC.Hs.Dump (
+        -- * Dumping ASTs
+        showAstData,
+        BlankSrcSpan(..),
+    ) where
+
+import GhcPrelude
+
+import Data.Data hiding (Fixity)
+import Bag
+import BasicTypes
+import FastString
+import NameSet
+import Name
+import DataCon
+import SrcLoc
+import GHC.Hs
+import OccName hiding (occName)
+import Var
+import Module
+import Outputable
+
+import qualified Data.ByteString as B
+
+data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan
+                  deriving (Eq,Show)
+
+-- | Show a GHC syntax tree. This parameterised because it is also used for
+-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked
+-- out, to avoid comparing locations, only structure
+showAstData :: Data a => BlankSrcSpan -> a -> SDoc
+showAstData b a0 = blankLine $$ showAstData' a0
+  where
+    showAstData' :: Data a => a -> SDoc
+    showAstData' =
+      generic
+              `ext1Q` list
+              `extQ` string `extQ` fastString `extQ` srcSpan
+              `extQ` lit `extQ` litr `extQ` litt
+              `extQ` bytestring
+              `extQ` name `extQ` occName `extQ` moduleName `extQ` var
+              `extQ` dataCon
+              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
+              `extQ` fixity
+              `ext2Q` located
+
+      where generic :: Data a => a -> SDoc
+            generic t = parens $ text (showConstr (toConstr t))
+                                  $$ vcat (gmapQ showAstData' t)
+
+            string :: String -> SDoc
+            string     = text . normalize_newlines . show
+
+            fastString :: FastString -> SDoc
+            fastString s = braces $
+                            text "FastString: "
+                         <> text (normalize_newlines . show $ s)
+
+            bytestring :: B.ByteString -> SDoc
+            bytestring = text . normalize_newlines . show
+
+            list []    = brackets empty
+            list [x]   = brackets (showAstData' x)
+            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)
+                                $$ go x2 xs
+              where
+                go y [] = text "," <> showAstData' y <> text "]"
+                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys
+
+            -- Eliminate word-size dependence
+            lit :: HsLit GhcPs -> SDoc
+            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
+            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
+            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
+            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
+            lit l                  = generic l
+
+            litr :: HsLit GhcRn -> SDoc
+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
+            litr l                  = generic l
+
+            litt :: HsLit GhcTc -> SDoc
+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
+            litt l                  = generic l
+
+            numericLit :: String -> Integer -> SourceText -> SDoc
+            numericLit tag x s = braces $ hsep [ text tag
+                                               , generic x
+                                               , generic s ]
+
+            name :: Name -> SDoc
+            name nm    = braces $ text "Name: " <> ppr nm
+
+            occName n  =  braces $
+                          text "OccName: "
+                       <> text (OccName.occNameString n)
+
+            moduleName :: ModuleName -> SDoc
+            moduleName m = braces $ text "ModuleName: " <> ppr m
+
+            srcSpan :: SrcSpan -> SDoc
+            srcSpan ss = case b of
+             BlankSrcSpan -> text "{ ss }"
+             NoBlankSrcSpan -> braces $ char ' ' <>
+                             (hang (ppr ss) 1
+                                   -- TODO: show annotations here
+                                   (text ""))
+
+            var  :: Var -> SDoc
+            var v      = braces $ text "Var: " <> ppr v
+
+            dataCon :: DataCon -> SDoc
+            dataCon c  = braces $ text "DataCon: " <> ppr c
+
+            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc
+            bagRdrName bg =  braces $
+                             text "Bag(Located (HsBind GhcPs)):"
+                          $$ (list . bagToList $ bg)
+
+            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc
+            bagName bg  =  braces $
+                           text "Bag(Located (HsBind Name)):"
+                        $$ (list . bagToList $ bg)
+
+            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc
+            bagVar bg  =  braces $
+                          text "Bag(Located (HsBind Var)):"
+                       $$ (list . bagToList $ bg)
+
+            nameSet ns =  braces $
+                          text "NameSet:"
+                       $$ (list . nameSetElemsStable $ ns)
+
+            fixity :: Fixity -> SDoc
+            fixity fx =  braces $
+                         text "Fixity: "
+                      <> ppr fx
+
+            located :: (Data b,Data loc) => GenLocated loc b -> SDoc
+            located (L ss a) = parens $
+                   case cast ss of
+                        Just (s :: SrcSpan) ->
+                          srcSpan s
+                        Nothing -> text "nnnnnnnn"
+                      $$ showAstData' a
+
+normalize_newlines :: String -> String
+normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs
+normalize_newlines (x:xs)                 = x:normalize_newlines xs
+normalize_newlines []                     = []
+
+{-
+************************************************************************
+*                                                                      *
+* Copied from syb
+*                                                                      *
+************************************************************************
+-}
+
+
+-- | The type constructor for queries
+newtype Q q x = Q { unQ :: x -> q }
+
+-- | Extend a generic query by a type-specific case
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
+extQ f g a = maybe (f a) g (cast a)
+
+-- | Type extension of queries for type constructors
+ext1Q :: (Data d, Typeable t)
+      => (d -> q)
+      -> (forall e. Data e => t e -> q)
+      -> d -> q
+ext1Q def ext = unQ ((Q def) `ext1` (Q ext))
+
+
+-- | Type extension of queries for type constructors
+ext2Q :: (Data d, Typeable t)
+      => (d -> q)
+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
+      -> d -> q
+ext2Q def ext = unQ ((Q def) `ext2` (Q ext))
+
+-- | Flexible type extension
+ext1 :: (Data a, Typeable t)
+     => c a
+     -> (forall d. Data d => c (t d))
+     -> c a
+ext1 def ext = maybe def id (dataCast1 ext)
+
+
+
+-- | Flexible type extension
+ext2 :: (Data a, Typeable t)
+     => c a
+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
+     -> c a
+ext2 def ext = maybe def id (dataCast2 ext)
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
new file mode 100644
index 0000000000..2ea1ae3f73
--- /dev/null
+++ b/compiler/GHC/Hs/Expr.hs
@@ -0,0 +1,2828 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Abstract Haskell syntax for expressions.
+module GHC.Hs.Expr where
+
+#include "HsVersions.h"
+
+-- friends:
+import GhcPrelude
+
+import GHC.Hs.Decls
+import GHC.Hs.Pat
+import GHC.Hs.Lit
+import GHC.Hs.PlaceHolder ( NameOrRdrName )
+import GHC.Hs.Extension
+import GHC.Hs.Types
+import GHC.Hs.Binds
+
+-- others:
+import TcEvidence
+import CoreSyn
+import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
+import Name
+import NameSet
+import RdrName  ( GlobalRdrEnv )
+import BasicTypes
+import ConLike
+import SrcLoc
+import Util
+import Outputable
+import FastString
+import Type
+import TcType (TcType)
+import {-# SOURCE #-} TcRnTypes (TcLclEnv)
+
+-- libraries:
+import Data.Data hiding (Fixity(..))
+import qualified Data.Data as Data (Fixity(..))
+import Data.Maybe (isNothing)
+
+import GHCi.RemoteTypes ( ForeignRef )
+import qualified Language.Haskell.TH as TH (Q)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Expressions proper}
+*                                                                      *
+************************************************************************
+-}
+
+-- * Expressions proper
+
+-- | Located Haskell Expression
+type LHsExpr p = Located (HsExpr p)
+  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+  --   in a list
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+
+-------------------------
+-- | Post-Type checking Expression
+--
+-- PostTcExpr is an evidence expression attached to the syntax tree by the
+-- type checker (c.f. postTcType).
+type PostTcExpr  = HsExpr GhcTc
+
+-- | Post-Type checking Table
+--
+-- We use a PostTcTable where there are a bunch of pieces of evidence, more
+-- than is convenient to keep individually.
+type PostTcTable = [(Name, PostTcExpr)]
+
+-------------------------
+-- | Syntax Expression
+--
+-- SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
+-- by the renamer.  It's used for rebindable syntax.
+--
+-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
+--      @(>>=)@, and then instantiated by the type checker with its type args
+--      etc
+--
+-- This should desugar to
+--
+-- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)
+-- >                         (syn_arg_wraps[1] arg1) ...
+--
+-- where the actual arguments come from elsewhere in the AST.
+-- This could be defined using @GhcPass p@ and such, but it's
+-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
+-- write, for example.)
+data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
+                               , syn_arg_wraps :: [HsWrapper]
+                               , syn_res_wrap  :: HsWrapper }
+
+-- | This is used for rebindable-syntax pieces that are too polymorphic
+-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
+noExpr :: HsExpr (GhcPass p)
+noExpr = HsLit noExtField (HsString (SourceText  "noExpr") (fsLit "noExpr"))
+
+noSyntaxExpr :: SyntaxExpr (GhcPass p)
+                              -- Before renaming, and sometimes after,
+                              -- (if the syntax slot makes no sense)
+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExtField
+                                                  (HsString NoSourceText
+                                                  (fsLit "noSyntaxExpr"))
+                          , syn_arg_wraps = []
+                          , syn_res_wrap  = WpHole }
+
+-- | Make a 'SyntaxExpr (HsExpr _)', missing its HsWrappers.
+mkSyntaxExpr :: HsExpr (GhcPass p) -> SyntaxExpr (GhcPass p)
+mkSyntaxExpr expr = SyntaxExpr { syn_expr      = expr
+                               , syn_arg_wraps = []
+                               , syn_res_wrap  = WpHole }
+
+-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
+-- renamer), missing its HsWrappers.
+mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
+mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name
+  -- don't care about filling in syn_arg_wraps because we're clearly
+  -- not past the typechecker
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (SyntaxExpr p) where
+  ppr (SyntaxExpr { syn_expr      = expr
+                  , syn_arg_wraps = arg_wraps
+                  , syn_res_wrap  = res_wrap })
+    = sdocWithDynFlags $ \ dflags ->
+      getPprStyle $ \s ->
+      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags
+      then ppr expr <> braces (pprWithCommas ppr arg_wraps)
+                    <> braces (ppr res_wrap)
+      else ppr expr
+
+-- | Command Syntax Table (for Arrow syntax)
+type CmdSyntaxTable p = [(Name, HsExpr p)]
+-- See Note [CmdSyntaxTable]
+
+{-
+Note [CmdSyntaxtable]
+~~~~~~~~~~~~~~~~~~~~~
+Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
+track of the methods needed for a Cmd.
+
+* Before the renamer, this list is an empty list
+
+* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
+  For example, for the 'arr' method
+   * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)
+   * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)
+             where @arr_22@ is whatever 'arr' is in scope
+
+* After the type checker, it takes the form [(std_name, <expression>)]
+  where <expression> is the evidence for the method.  This evidence is
+  instantiated with the class, but is still polymorphic in everything
+  else.  For example, in the case of 'arr', the evidence has type
+         forall b c. (b->c) -> a b c
+  where 'a' is the ambient type of the arrow.  This polymorphism is
+  important because the desugarer uses the same evidence at multiple
+  different types.
+
+This is Less Cool than what we normally do for rebindable syntax, which is to
+make fully-instantiated piece of evidence at every use site.  The Cmd way
+is Less Cool because
+  * The renamer has to predict which methods are needed.
+    See the tedious RnExpr.methodNamesCmd.
+
+  * The desugarer has to know the polymorphic type of the instantiated
+    method. This is checked by Inst.tcSyntaxName, but is less flexible
+    than the rest of rebindable syntax, where the type is less
+    pre-ordained.  (And this flexibility is useful; for example we can
+    typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
+-}
+
+-- | An unbound variable; used for treating
+-- out-of-scope variables as expression holes
+--
+-- Either "x", "y"     Plain OutOfScope
+-- or     "_", "_x"    A TrueExprHole
+--
+-- Both forms indicate an out-of-scope variable,  but the latter
+-- indicates that the user /expects/ it to be out of scope, and
+-- just wants GHC to report its type
+data UnboundVar
+  = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope
+                                     -- variable, together with the GlobalRdrEnv
+                                     -- with respect to which it is unbound
+
+                                     -- See Note [OutOfScope and GlobalRdrEnv]
+
+  | TrueExprHole OccName             -- ^ A "true" expression hole (_ or _x)
+
+  deriving Data
+
+instance Outputable UnboundVar where
+    ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ)
+    ppr (TrueExprHole occ) = text "ExprHole"   <> parens (ppr occ)
+
+unboundVarOcc :: UnboundVar -> OccName
+unboundVarOcc (OutOfScope occ _) = occ
+unboundVarOcc (TrueExprHole occ) = occ
+
+{-
+Note [OutOfScope and GlobalRdrEnv]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To understand why we bundle a GlobalRdrEnv with an out-of-scope variable,
+consider the following module:
+
+    module A where
+
+    foo :: ()
+    foo = bar
+
+    bat :: [Double]
+    bat = [1.2, 3.4]
+
+    $(return [])
+
+    bar = ()
+    bad = False
+
+When A is compiled, the renamer determines that `bar` is not in scope in the
+declaration of `foo` (since `bar` is declared in the following inter-splice
+group).  Once it has finished typechecking the entire module, the typechecker
+then generates the associated error message, which specifies both the type of
+`bar` and a list of possible in-scope alternatives:
+
+    A.hs:6:7: error:
+        • Variable not in scope: bar :: ()
+        • ‘bar’ (line 13) is not in scope before the splice on line 11
+          Perhaps you meant ‘bat’ (line 9)
+
+When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the
+typechecker must provide a GlobalRdrEnv.  If it provided the current one, which
+contains top-level declarations for the entire module, the error message would
+incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives
+for `bar` (see #11680).  Instead, the typechecker must use the same
+GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.
+
+To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope
+`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to
+look it up in some global store?  Unfortunately, no.  The problem is that
+location information is not always sufficient for this task.  This is most
+apparent when dealing with the TH function addTopDecls, which adds its
+declarations to the FOLLOWING inter-splice group.  Consider these declarations:
+
+    ex9 = cat               -- cat is NOT in scope here
+
+    $(do -------------------------------------------------------------
+        ds <- [d| f = cab   -- cat and cap are both in scope here
+                  cat = ()
+                |]
+        addTopDecls ds
+        [d| g = cab         -- only cap is in scope here
+            cap = True
+          |])
+
+    ex10 = cat              -- cat is NOT in scope here
+
+    $(return []) -----------------------------------------------------
+
+    ex11 = cat              -- cat is in scope
+
+Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs
+the GlobalRdrEnvs which were used when they were renamed.  These GlobalRdrEnvs
+are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the
+locations of the two `cab`s are the same (they are both created in the same
+splice).  Thus, we must include some additional information with each `cab` to
+allow the typechecker to obtain the correct GlobalRdrEnv.  Clearly, the simplest
+information to use is the GlobalRdrEnv itself.
+-}
+
+-- | A Haskell expression.
+data HsExpr p
+  = HsVar     (XVar p)
+              (Located (IdP p)) -- ^ Variable
+
+                             -- See Note [Located RdrNames]
+
+  | HsUnboundVar (XUnboundVar p)
+                 UnboundVar  -- ^ Unbound variable; also used for "holes"
+                             --   (_ or _x).
+                             -- Turned from HsVar to HsUnboundVar by the
+                             --   renamer, when it finds an out-of-scope
+                             --   variable or hole.
+                             -- Turned into HsVar by type checker, to support
+                             --   deferred type errors.
+
+  | HsConLikeOut (XConLikeOut p)
+                 ConLike     -- ^ After typechecker only; must be different
+                             -- HsVar for pretty printing
+
+  | HsRecFld  (XRecFld p)
+              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
+                                    -- Not in use after typechecking
+
+  | HsOverLabel (XOverLabel p)
+                (Maybe (IdP p)) FastString
+     -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)
+     --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the
+     --   in-scope 'fromLabel'.
+     --   NB: Not in use after typechecking
+
+  | HsIPVar   (XIPVar p)
+              HsIPName   -- ^ Implicit parameter (not in use after typechecking)
+  | HsOverLit (XOverLitE p)
+              (HsOverLit p)  -- ^ Overloaded literals
+
+  | HsLit     (XLitE p)
+              (HsLit p)      -- ^ Simple (non-overloaded) literals
+
+  | HsLam     (XLam p)
+              (MatchGroup p (LHsExpr p))
+                       -- ^ Lambda abstraction. Currently always a single match
+       --
+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
+       --       'ApiAnnotation.AnnRarrow',
+
+       -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
+       --
+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
+       --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
+       --           'ApiAnnotation.AnnClose'
+
+       -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
+
+  | HsAppType (XAppTypeE p) (LHsExpr p) (LHsWcType (NoGhcTc p))  -- ^ Visible type application
+       --
+       -- Explicit type argument; e.g  f @Int x y
+       -- NB: Has wildcards, but no implicit quantification
+       --
+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',
+
+  -- | Operator applications:
+  -- NB Bracketed ops such as (+) come out as Vars.
+
+  -- NB We need an expr for the operator in an OpApp/Section since
+  -- the typechecker may need to apply the operator to a few types.
+
+  | OpApp       (XOpApp p)
+                (LHsExpr p)       -- left operand
+                (LHsExpr p)       -- operator
+                (LHsExpr p)       -- right operand
+
+  -- | Negation operator. Contains the negated expression and the name
+  -- of 'negate'
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | NegApp      (XNegApp p)
+                (LHsExpr p)
+                (SyntaxExpr p)
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
+  --             'ApiAnnotation.AnnClose' @')'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsPar       (XPar p)
+                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
+
+  | SectionL    (XSectionL p)
+                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
+                (LHsExpr p)    -- operator
+  | SectionR    (XSectionR p)
+                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
+                (LHsExpr p)    -- operand
+
+  -- | Used for explicit tuples and sections thereof
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+  --         'ApiAnnotation.AnnClose'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | ExplicitTuple
+        (XExplicitTuple p)
+        [LHsTupArg p]
+        Boxity
+
+  -- | Used for unboxed sum types
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
+  --          'ApiAnnotation.AnnVbar', 'ApiAnnotation.AnnClose' @'#)'@,
+  --
+  --  There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before
+  --  the expression, (arity - alternative) after it
+  | ExplicitSum
+          (XExplicitSum p)
+          ConTag --  Alternative (one-based)
+          Arity  --  Sum arity
+          (LHsExpr p)
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
+  --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
+  --       'ApiAnnotation.AnnClose' @'}'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsCase      (XCase p)
+                (LHsExpr p)
+                (MatchGroup p (LHsExpr p))
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
+  --       'ApiAnnotation.AnnSemi',
+  --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
+  --       'ApiAnnotation.AnnElse',
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsIf        (XIf p)
+                (Maybe (SyntaxExpr p)) -- cond function
+                                        -- Nothing => use the built-in 'if'
+                                        -- See Note [Rebindable if]
+                (LHsExpr p)    --  predicate
+                (LHsExpr p)    --  then part
+                (LHsExpr p)    --  else part
+
+  -- | Multi-way if
+  --
+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
+  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]
+
+  -- | let(rec)
+  --
+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
+  --       'ApiAnnotation.AnnOpen' @'{'@,
+  --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsLet       (XLet p)
+                (LHsLocalBinds p)
+                (LHsExpr  p)
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
+  --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
+  --             'ApiAnnotation.AnnVbar',
+  --             'ApiAnnotation.AnnClose'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsDo        (XDo p)                  -- Type of the whole expression
+                (HsStmtContext Name)     -- The parameterisation is unimportant
+                                         -- because in this context we never use
+                                         -- the PatGuard or ParStmt variant
+                (Located [ExprLStmt p]) -- "do":one or more stmts
+
+  -- | Syntactic list: [a,b,c,...]
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
+  --              'ApiAnnotation.AnnClose' @']'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | ExplicitList
+                (XExplicitList p)  -- Gives type of components of list
+                (Maybe (SyntaxExpr p))
+                                   -- For OverloadedLists, the fromListN witness
+                [LHsExpr p]
+
+  -- | Record construction
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
+  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | RecordCon
+      { rcon_ext      :: XRecordCon p
+      , rcon_con_name :: Located (IdP p)    -- The constructor name;
+                                            --  not used after type checking
+      , rcon_flds     :: HsRecordBinds p }  -- The fields
+
+  -- | Record update
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
+  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | RecordUpd
+      { rupd_ext  :: XRecordUpd p
+      , rupd_expr :: LHsExpr p
+      , rupd_flds :: [LHsRecUpdField p]
+      }
+  -- For a type family, the arg types are of the *instance* tycon,
+  -- not the family tycon
+
+  -- | Expression with an explicit type signature. @e :: type@
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | ExprWithTySig
+                (XExprWithTySig p)
+
+                (LHsExpr p)
+                (LHsSigWcType (NoGhcTc p))
+
+  -- | Arithmetic sequence
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
+  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
+  --              'ApiAnnotation.AnnClose' @']'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | ArithSeq
+                (XArithSeq p)
+                (Maybe (SyntaxExpr p))
+                                  -- For OverloadedLists, the fromList witness
+                (ArithSeqInfo p)
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsSCC       (XSCC p)
+                SourceText            -- Note [Pragma source text] in BasicTypes
+                StringLiteral         -- "set cost centre" SCC pragma
+                (LHsExpr p)           -- expr whose cost is to be measured
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
+  --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsCoreAnn   (XCoreAnn p)
+                SourceText            -- Note [Pragma source text] in BasicTypes
+                StringLiteral         -- hdaume: core annotation
+                (LHsExpr p)
+
+  -----------------------------------------------------------
+  -- MetaHaskell Extensions
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+  --         'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',
+  --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsBracket    (XBracket p) (HsBracket p)
+
+    -- See Note [Pending Splices]
+  | HsRnBracketOut
+      (XRnBracketOut p)
+      (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed
+                           -- expression, plus
+      [PendingRnSplice]    -- _renamed_ splices to be type checked
+
+  | HsTcBracketOut
+      (XTcBracketOut p)
+      (HsBracket GhcRn)    -- Output of the type checker is the *original*
+                           -- renamed expression, plus
+      [PendingTcSplice]    -- _typechecked_ splices to be
+                           -- pasted back in by the desugarer
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+  --         'ApiAnnotation.AnnClose'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsSpliceE  (XSpliceE p) (HsSplice p)
+
+  -----------------------------------------------------------
+  -- Arrow notation extension
+
+  -- | @proc@ notation for Arrows
+  --
+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
+  --          'ApiAnnotation.AnnRarrow'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsProc      (XProc p)
+                (LPat p)               -- arrow abstraction, proc
+                (LHsCmdTop p)          -- body of the abstraction
+                                       -- always has an empty stack
+
+  ---------------------------------------
+  -- static pointers extension
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsStatic (XStatic p) -- Free variables of the body
+             (LHsExpr p)        -- Body
+
+  ---------------------------------------
+  -- Haskell program coverage (Hpc) Support
+
+  | HsTick
+     (XTick p)
+     (Tickish (IdP p))
+     (LHsExpr p)                       -- sub-expression
+
+  | HsBinTick
+     (XBinTick p)
+     Int                                -- module-local tick number for True
+     Int                                -- module-local tick number for False
+     (LHsExpr p)                        -- sub-expression
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+  --       'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
+  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',
+  --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',
+  --       'ApiAnnotation.AnnMinus',
+  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',
+  --       'ApiAnnotation.AnnVal',
+  --       'ApiAnnotation.AnnClose' @'\#-}'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsTickPragma                      -- A pragma introduced tick
+     (XTickPragma p)
+     SourceText                       -- Note [Pragma source text] in BasicTypes
+     (StringLiteral,(Int,Int),(Int,Int))
+                                      -- external span for this tick
+     ((SourceText,SourceText),(SourceText,SourceText))
+        -- Source text for the four integers used in the span.
+        -- See note [Pragma source text] in BasicTypes
+     (LHsExpr p)
+
+  ---------------------------------------
+  -- Finally, HsWrap appears only in typechecker output
+  -- The contained Expr is *NOT* itself an HsWrap.
+  -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
+  -- is maintained by GHC.Hs.Utils.mkHsWrap.
+
+  |  HsWrap     (XWrap p)
+                HsWrapper    -- TRANSLATION
+                (HsExpr p)
+
+  | XExpr       (XXExpr p) -- Note [Trees that Grow] extension constructor
+
+
+-- | Extra data fields for a 'RecordCon', added by the type checker
+data RecordConTc = RecordConTc
+      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym
+      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function
+      }
+
+-- | Extra data fields for a 'RecordUpd', added by the type checker
+data RecordUpdTc = RecordUpdTc
+      { rupd_cons :: [ConLike]
+                -- Filled in by the type checker to the
+                -- _non-empty_ list of DataCons that have
+                -- all the upd'd fields
+
+      , rupd_in_tys  :: [Type] -- Argument types of *input* record type
+      , rupd_out_tys :: [Type] --             and  *output* record type
+                               -- The original type can be reconstructed
+                               -- with conLikeResTy
+      , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
+      } deriving Data
+
+-- ---------------------------------------------------------------------
+
+type instance XVar           (GhcPass _) = NoExtField
+type instance XUnboundVar    (GhcPass _) = NoExtField
+type instance XConLikeOut    (GhcPass _) = NoExtField
+type instance XRecFld        (GhcPass _) = NoExtField
+type instance XOverLabel     (GhcPass _) = NoExtField
+type instance XIPVar         (GhcPass _) = NoExtField
+type instance XOverLitE      (GhcPass _) = NoExtField
+type instance XLitE          (GhcPass _) = NoExtField
+type instance XLam           (GhcPass _) = NoExtField
+type instance XLamCase       (GhcPass _) = NoExtField
+type instance XApp           (GhcPass _) = NoExtField
+
+type instance XAppTypeE      (GhcPass _) = NoExtField
+
+type instance XOpApp         GhcPs = NoExtField
+type instance XOpApp         GhcRn = Fixity
+type instance XOpApp         GhcTc = Fixity
+
+type instance XNegApp        (GhcPass _) = NoExtField
+type instance XPar           (GhcPass _) = NoExtField
+type instance XSectionL      (GhcPass _) = NoExtField
+type instance XSectionR      (GhcPass _) = NoExtField
+type instance XExplicitTuple (GhcPass _) = NoExtField
+
+type instance XExplicitSum   GhcPs = NoExtField
+type instance XExplicitSum   GhcRn = NoExtField
+type instance XExplicitSum   GhcTc = [Type]
+
+type instance XCase          (GhcPass _) = NoExtField
+type instance XIf            (GhcPass _) = NoExtField
+
+type instance XMultiIf       GhcPs = NoExtField
+type instance XMultiIf       GhcRn = NoExtField
+type instance XMultiIf       GhcTc = Type
+
+type instance XLet           (GhcPass _) = NoExtField
+
+type instance XDo            GhcPs = NoExtField
+type instance XDo            GhcRn = NoExtField
+type instance XDo            GhcTc = Type
+
+type instance XExplicitList  GhcPs = NoExtField
+type instance XExplicitList  GhcRn = NoExtField
+type instance XExplicitList  GhcTc = Type
+
+type instance XRecordCon     GhcPs = NoExtField
+type instance XRecordCon     GhcRn = NoExtField
+type instance XRecordCon     GhcTc = RecordConTc
+
+type instance XRecordUpd     GhcPs = NoExtField
+type instance XRecordUpd     GhcRn = NoExtField
+type instance XRecordUpd     GhcTc = RecordUpdTc
+
+type instance XExprWithTySig (GhcPass _) = NoExtField
+
+type instance XArithSeq      GhcPs = NoExtField
+type instance XArithSeq      GhcRn = NoExtField
+type instance XArithSeq      GhcTc = PostTcExpr
+
+type instance XSCC           (GhcPass _) = NoExtField
+type instance XCoreAnn       (GhcPass _) = NoExtField
+type instance XBracket       (GhcPass _) = NoExtField
+
+type instance XRnBracketOut  (GhcPass _) = NoExtField
+type instance XTcBracketOut  (GhcPass _) = NoExtField
+
+type instance XSpliceE       (GhcPass _) = NoExtField
+type instance XProc          (GhcPass _) = NoExtField
+
+type instance XStatic        GhcPs = NoExtField
+type instance XStatic        GhcRn = NameSet
+type instance XStatic        GhcTc = NameSet
+
+type instance XTick          (GhcPass _) = NoExtField
+type instance XBinTick       (GhcPass _) = NoExtField
+type instance XTickPragma    (GhcPass _) = NoExtField
+type instance XWrap          (GhcPass _) = NoExtField
+type instance XXExpr         (GhcPass _) = NoExtCon
+
+-- ---------------------------------------------------------------------
+
+-- | Located Haskell Tuple Argument
+--
+-- 'HsTupArg' is used for tuple sections
+-- @(,a,)@ is represented by
+-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@
+-- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@
+type LHsTupArg id = Located (HsTupArg id)
+-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Haskell Tuple Argument
+data HsTupArg id
+  = Present (XPresent id) (LHsExpr id)     -- ^ The argument
+  | Missing (XMissing id)    -- ^ The argument is missing, but this is its type
+  | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point
+
+type instance XPresent         (GhcPass _) = NoExtField
+
+type instance XMissing         GhcPs = NoExtField
+type instance XMissing         GhcRn = NoExtField
+type instance XMissing         GhcTc = Type
+
+type instance XXTupArg         (GhcPass _) = NoExtCon
+
+tupArgPresent :: LHsTupArg id -> Bool
+tupArgPresent (L _ (Present {})) = True
+tupArgPresent (L _ (Missing {})) = False
+tupArgPresent (L _ (XTupArg {})) = False
+
+{-
+Note [Parens in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~
+HsPar (and ParPat in patterns, HsParTy in types) is used as follows
+
+  * HsPar is required; the pretty printer does not add parens.
+
+  * HsPars are respected when rearranging operator fixities.
+    So   a * (b + c)  means what it says (where the parens are an HsPar)
+
+  * For ParPat and HsParTy the pretty printer does add parens but this should be
+    a no-op for ParsedSource, based on the pretty printer round trip feature
+    introduced in
+    https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c
+
+  * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or
+    not they are strictly necessary. This should be addressed when #13238 is
+    completed, to be treated the same as HsPar.
+
+
+Note [Sections in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Sections should always appear wrapped in an HsPar, thus
+         HsPar (SectionR ...)
+The parser parses sections in a wider variety of situations
+(See Note [Parsing sections]), but the renamer checks for those
+parens.  This invariant makes pretty-printing easier; we don't need
+a special case for adding the parens round sections.
+
+Note [Rebindable if]
+~~~~~~~~~~~~~~~~~~~~
+The rebindable syntax for 'if' is a bit special, because when
+rebindable syntax is *off* we do not want to treat
+   (if c then t else e)
+as if it was an application (ifThenElse c t e).  Why not?
+Because we allow an 'if' to return *unboxed* results, thus
+  if blah then 3# else 4#
+whereas that would not be possible using a all to a polymorphic function
+(because you can't call a polymorphic function at an unboxed type).
+
+So we use Nothing to mean "use the old built-in typing rule".
+
+Note [Record Update HsWrapper]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There is a wrapper in RecordUpd which is used for the *required*
+constraints for pattern synonyms. This wrapper is created in the
+typechecking and is then directly used in the desugaring without
+modification.
+
+For example, if we have the record pattern synonym P,
+  pattern P :: (Show a) => a -> Maybe a
+  pattern P{x} = Just x
+
+  foo = (Just True) { x = False }
+then `foo` desugars to something like
+  foo = case Just True of
+          P x -> P False
+hence we need to provide the correct dictionaries to P's matcher on
+the RHS so that we can build the expression.
+
+Note [Located RdrNames]
+~~~~~~~~~~~~~~~~~~~~~~~
+A number of syntax elements have seemingly redundant locations attached to them.
+This is deliberate, to allow transformations making use of the API Annotations
+to easily correlate a Located Name in the RenamedSource with a Located RdrName
+in the ParsedSource.
+
+There are unfortunately enough differences between the ParsedSource and the
+RenamedSource that the API Annotations cannot be used directly with
+RenamedSource, so this allows a simple mapping to be used based on the location.
+-}
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where
+    ppr expr = pprExpr expr
+
+-----------------------
+-- pprExpr, pprLExpr, pprBinds call pprDeeper;
+-- the underscore versions do not
+pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+pprLExpr (L _ e) = pprExpr e
+
+pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
+pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
+          | otherwise                           = pprDeeper (ppr_expr e)
+
+isQuietHsExpr :: HsExpr id -> Bool
+-- Parentheses do display something, but it gives little info and
+-- if we go deeper when we go inside them then we get ugly things
+-- like (...)
+isQuietHsExpr (HsPar {})        = True
+-- applications don't display anything themselves
+isQuietHsExpr (HsApp {})        = True
+isQuietHsExpr (HsAppType {})    = True
+isQuietHsExpr (OpApp {})        = True
+isQuietHsExpr _ = False
+
+pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
+         => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
+pprBinds b = pprDeeper (ppr b)
+
+-----------------------
+ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+ppr_lexpr e = ppr_expr (unLoc e)
+
+ppr_expr :: forall p. (OutputableBndrId (GhcPass p))
+         => HsExpr (GhcPass p) -> SDoc
+ppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v
+ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)
+ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c
+ppr_expr (HsIPVar _ v)      = ppr v
+ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l
+ppr_expr (HsLit _ lit)      = ppr lit
+ppr_expr (HsOverLit _ lit)  = ppr lit
+ppr_expr (HsPar _ e)        = parens (ppr_lexpr e)
+
+ppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)
+  = vcat [pprWithSourceText stc (text "{-# CORE")
+          <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"
+         , ppr_lexpr e]
+
+ppr_expr e@(HsApp {})        = ppr_apps e []
+ppr_expr e@(HsAppType {})    = ppr_apps e []
+
+ppr_expr (OpApp _ e1 op e2)
+  | Just pp_op <- ppr_infix_expr (unLoc op)
+  = pp_infixly pp_op
+  | otherwise
+  = pp_prefixly
+
+  where
+    pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens
+    pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear
+
+    pp_prefixly
+      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
+
+    pp_infixly pp_op
+      = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])
+
+ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e
+
+ppr_expr (SectionL _ expr op)
+  | Just pp_op <- ppr_infix_expr (unLoc op)
+  = pp_infixly pp_op
+  | otherwise
+  = pp_prefixly
+  where
+    pp_expr = pprDebugParendExpr opPrec expr
+
+    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
+                       4 (hsep [pp_expr, text "x_ )"])
+
+    pp_infixly v = (sep [pp_expr, v])
+
+ppr_expr (SectionR _ op expr)
+  | Just pp_op <- ppr_infix_expr (unLoc op)
+  = pp_infixly pp_op
+  | otherwise
+  = pp_prefixly
+  where
+    pp_expr = pprDebugParendExpr opPrec expr
+
+    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
+                       4 (pp_expr <> rparen)
+
+    pp_infixly v = sep [v, pp_expr]
+
+ppr_expr (ExplicitTuple _ exprs boxity)
+  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
+  where
+    ppr_tup_args []               = []
+    ppr_tup_args (Present _ e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
+    ppr_tup_args (Missing _   : es) = punc es : ppr_tup_args es
+    ppr_tup_args (XTupArg x   : es) = (ppr x <> punc es) : ppr_tup_args es
+
+    punc (Present {} : _) = comma <> space
+    punc (Missing {} : _) = comma
+    punc (XTupArg {} : _) = comma <> space
+    punc []               = empty
+
+ppr_expr (ExplicitSum _ alt arity expr)
+  = text "(#" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text "#)"
+  where
+    ppr_bars n = hsep (replicate n (char '|'))
+
+ppr_expr (HsLam _ matches)
+  = pprMatches matches
+
+ppr_expr (HsLamCase _ matches)
+  = sep [ sep [text "\\case"],
+          nest 2 (pprMatches matches) ]
+
+ppr_expr (HsCase _ expr matches@(MG { mg_alts = L _ [_] }))
+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
+          nest 2 (pprMatches matches) <+> char '}']
+ppr_expr (HsCase _ expr matches)
+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
+          nest 2 (pprMatches matches) ]
+
+ppr_expr (HsIf _ _ e1 e2 e3)
+  = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
+         nest 4 (ppr e2),
+         text "else",
+         nest 4 (ppr e3)]
+
+ppr_expr (HsMultiIf _ alts)
+  = hang (text "if") 3  (vcat (map ppr_alt alts))
+  where ppr_alt (L _ (GRHS _ guards expr)) =
+          hang vbar 2 (ppr_one one_alt)
+          where
+            ppr_one [] = panic "ppr_exp HsMultiIf"
+            ppr_one (h:t) = hang h 2 (sep t)
+            one_alt = [ interpp'SP guards
+                      , text "->" <+> pprDeeper (ppr expr) ]
+        ppr_alt (L _ (XGRHS x)) = ppr x
+
+-- special case: let ... in let ...
+ppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))
+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
+         ppr_lexpr expr]
+
+ppr_expr (HsLet _ (L _ binds) expr)
+  = sep [hang (text "let") 2 (pprBinds binds),
+         hang (text "in")  2 (ppr expr)]
+
+ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts
+
+ppr_expr (ExplicitList _ _ exprs)
+  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
+
+ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
+  = hang (ppr con_id) 2 (ppr rbinds)
+
+ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
+  = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
+
+ppr_expr (ExprWithTySig _ expr sig)
+  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
+         4 (ppr sig)
+
+ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
+
+ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)
+  = sep [ pprWithSourceText st (text "{-# SCC")
+         -- no doublequotes if stl empty, for the case where the SCC was written
+         -- without quotes.
+          <+> pprWithSourceText stl (ftext lbl) <+> text "#-}",
+          ppr expr ]
+
+ppr_expr (HsWrap _ co_fn e)
+  = pprHsWrapper co_fn (\parens -> if parens then pprExpr e
+                                             else pprExpr e)
+
+ppr_expr (HsSpliceE _ s)         = pprSplice s
+ppr_expr (HsBracket _ b)         = pprHsBracket b
+ppr_expr (HsRnBracketOut _ e []) = ppr e
+ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
+ppr_expr (HsTcBracketOut _ e []) = ppr e
+ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
+
+ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
+  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
+ppr_expr (HsProc _ pat (L _ (XCmdTop x)))
+  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr x]
+
+ppr_expr (HsStatic _ e)
+  = hsep [text "static", ppr e]
+
+ppr_expr (HsTick _ tickish exp)
+  = pprTicks (ppr exp) $
+    ppr tickish <+> ppr_lexpr exp
+ppr_expr (HsBinTick _ tickIdTrue tickIdFalse exp)
+  = pprTicks (ppr exp) $
+    hcat [text "bintick<",
+          ppr tickIdTrue,
+          text ",",
+          ppr tickIdFalse,
+          text ">(",
+          ppr exp, text ")"]
+ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
+  = pprTicks (ppr exp) $
+    hcat [text "tickpragma<",
+          pprExternalSrcLoc externalSrcLoc,
+          text ">(",
+          ppr exp,
+          text ")"]
+
+ppr_expr (HsRecFld _ f) = ppr f
+ppr_expr (XExpr x) = ppr x
+
+ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc
+ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
+ppr_infix_expr (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
+ppr_infix_expr (HsRecFld _ f)    = Just (pprInfixOcc f)
+ppr_infix_expr (HsUnboundVar _ h@TrueExprHole{}) = Just (pprInfixOcc (unboundVarOcc h))
+ppr_infix_expr (HsWrap _ _ e)    = ppr_infix_expr e
+ppr_infix_expr _                 = Nothing
+
+ppr_apps :: (OutputableBndrId (GhcPass p))
+         => HsExpr (GhcPass p)
+         -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
+         -> SDoc
+ppr_apps (HsApp _ (L _ fun) arg)        args
+  = ppr_apps fun (Left arg : args)
+ppr_apps (HsAppType _ (L _ fun) arg)    args
+  = ppr_apps fun (Right arg : args)
+ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))
+  where
+    pp (Left arg)                             = ppr arg
+    -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
+    --   = char '@' <> pprHsType arg
+    pp (Right arg)
+      = char '@' <> ppr arg
+
+pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
+pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
+  = ppr (src,(n1,n2),(n3,n4))
+
+{-
+HsSyn records exactly where the user put parens, with HsPar.
+So generally speaking we print without adding any parens.
+However, some code is internally generated, and in some places
+parens are absolutely required; so for these places we use
+pprParendLExpr (but don't print double parens of course).
+
+For operator applications we don't add parens, because the operator
+fixities should do the job, except in debug mode (-dppr-debug) so we
+can see the structure of the parse tree.
+-}
+
+pprDebugParendExpr :: (OutputableBndrId (GhcPass p))
+                   => PprPrec -> LHsExpr (GhcPass p) -> SDoc
+pprDebugParendExpr p expr
+  = getPprStyle (\sty ->
+    if debugStyle sty then pprParendLExpr p expr
+                      else pprLExpr      expr)
+
+pprParendLExpr :: (OutputableBndrId (GhcPass p))
+               => PprPrec -> LHsExpr (GhcPass p) -> SDoc
+pprParendLExpr p (L _ e) = pprParendExpr p e
+
+pprParendExpr :: (OutputableBndrId (GhcPass p))
+              => PprPrec -> HsExpr (GhcPass p) -> SDoc
+pprParendExpr p expr
+  | hsExprNeedsParens p expr = parens (pprExpr expr)
+  | otherwise                = pprExpr expr
+        -- Using pprLExpr makes sure that we go 'deeper'
+        -- I think that is usually (always?) right
+
+-- | @'hsExprNeedsParens' p e@ returns 'True' if the expression @e@ needs
+-- parentheses under precedence @p@.
+hsExprNeedsParens :: PprPrec -> HsExpr p -> Bool
+hsExprNeedsParens p = go
+  where
+    go (HsVar{})                      = False
+    go (HsUnboundVar{})               = False
+    go (HsConLikeOut{})               = False
+    go (HsIPVar{})                    = False
+    go (HsOverLabel{})                = False
+    go (HsLit _ l)                    = hsLitNeedsParens p l
+    go (HsOverLit _ ol)               = hsOverLitNeedsParens p ol
+    go (HsPar{})                      = False
+    go (HsCoreAnn _ _ _ (L _ e))      = go e
+    go (HsApp{})                      = p >= appPrec
+    go (HsAppType {})                 = p >= appPrec
+    go (OpApp{})                      = p >= opPrec
+    go (NegApp{})                     = p > topPrec
+    go (SectionL{})                   = True
+    go (SectionR{})                   = True
+    go (ExplicitTuple{})              = False
+    go (ExplicitSum{})                = False
+    go (HsLam{})                      = p > topPrec
+    go (HsLamCase{})                  = p > topPrec
+    go (HsCase{})                     = p > topPrec
+    go (HsIf{})                       = p > topPrec
+    go (HsMultiIf{})                  = p > topPrec
+    go (HsLet{})                      = p > topPrec
+    go (HsDo _ sc _)
+      | isComprehensionContext sc     = False
+      | otherwise                     = p > topPrec
+    go (ExplicitList{})               = False
+    go (RecordUpd{})                  = False
+    go (ExprWithTySig{})              = p >= sigPrec
+    go (ArithSeq{})                   = False
+    go (HsSCC{})                      = p >= appPrec
+    go (HsWrap _ _ e)                 = go e
+    go (HsSpliceE{})                  = False
+    go (HsBracket{})                  = False
+    go (HsRnBracketOut{})             = False
+    go (HsTcBracketOut{})             = False
+    go (HsProc{})                     = p > topPrec
+    go (HsStatic{})                   = p >= appPrec
+    go (HsTick _ _ (L _ e))           = go e
+    go (HsBinTick _ _ _ (L _ e))      = go e
+    go (HsTickPragma _ _ _ _ (L _ e)) = go e
+    go (RecordCon{})                  = False
+    go (HsRecFld{})                   = False
+    go (XExpr{})                      = True
+
+-- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,
+-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
+parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+parenthesizeHsExpr p le@(L loc e)
+  | hsExprNeedsParens p e = L loc (HsPar noExtField le)
+  | otherwise             = le
+
+isAtomicHsExpr :: HsExpr id -> Bool
+-- True of a single token
+isAtomicHsExpr (HsVar {})        = True
+isAtomicHsExpr (HsConLikeOut {}) = True
+isAtomicHsExpr (HsLit {})        = True
+isAtomicHsExpr (HsOverLit {})    = True
+isAtomicHsExpr (HsIPVar {})      = True
+isAtomicHsExpr (HsOverLabel {})  = True
+isAtomicHsExpr (HsUnboundVar {}) = True
+isAtomicHsExpr (HsWrap _ _ e)    = isAtomicHsExpr e
+isAtomicHsExpr (HsPar _ e)       = isAtomicHsExpr (unLoc e)
+isAtomicHsExpr (HsRecFld{})      = True
+isAtomicHsExpr _                 = False
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Commands (in arrow abstractions)}
+*                                                                      *
+************************************************************************
+
+We re-use HsExpr to represent these.
+-}
+
+-- | Located Haskell Command (for arrow syntax)
+type LHsCmd id = Located (HsCmd id)
+
+-- | Haskell Command (e.g. a "statement" in an Arrow proc block)
+data HsCmd id
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
+  --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
+  --          'ApiAnnotation.AnnRarrowtail'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)
+        (XCmdArrApp id)  -- type of the arrow expressions f,
+                         -- of the form a t t', where arg :: t
+        (LHsExpr id)     -- arrow expression, f
+        (LHsExpr id)     -- input expression, arg
+        HsArrAppType     -- higher-order (-<<) or first-order (-<)
+        Bool             -- True => right-to-left (f -< arg)
+                         -- False => left-to-right (arg >- f)
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
+  --         'ApiAnnotation.AnnCloseB' @'|)'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)
+        (XCmdArrForm id)
+        (LHsExpr id)     -- The operator.
+                         -- After type-checking, a type abstraction to be
+                         -- applied to the type of the local environment tuple
+        LexicalFixity    -- Whether the operator appeared prefix or infix when
+                         -- parsed.
+        (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that
+                         -- were converted from OpApp's by the renamer
+        [LHsCmdTop id]   -- argument commands
+
+  | HsCmdApp    (XCmdApp id)
+                (LHsCmd id)
+                (LHsExpr id)
+
+  | HsCmdLam    (XCmdLam id)
+                (MatchGroup id (LHsCmd id))     -- kappa
+       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
+       --       'ApiAnnotation.AnnRarrow',
+
+       -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdPar    (XCmdPar id)
+                (LHsCmd id)                     -- parenthesised command
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
+    --             'ApiAnnotation.AnnClose' @')'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdCase   (XCmdCase id)
+                (LHsExpr id)
+                (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
+    --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
+    --       'ApiAnnotation.AnnClose' @'}'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdIf     (XCmdIf id)
+                (Maybe (SyntaxExpr id))         -- cond function
+                (LHsExpr id)                    -- predicate
+                (LHsCmd id)                     -- then part
+                (LHsCmd id)                     -- else part
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
+    --       'ApiAnnotation.AnnSemi',
+    --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
+    --       'ApiAnnotation.AnnElse',
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdLet    (XCmdLet id)
+                (LHsLocalBinds id)      -- let(rec)
+                (LHsCmd  id)
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
+    --       'ApiAnnotation.AnnOpen' @'{'@,
+    --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression
+                (Located [CmdLStmt id])
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
+    --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
+    --             'ApiAnnotation.AnnVbar',
+    --             'ApiAnnotation.AnnClose'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsCmdWrap   (XCmdWrap id)
+                HsWrapper
+                (HsCmd id)     -- If   cmd :: arg1 --> res
+                               --      wrap :: arg1 "->" arg2
+                               -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
+  | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point
+
+type instance XCmdArrApp  GhcPs = NoExtField
+type instance XCmdArrApp  GhcRn = NoExtField
+type instance XCmdArrApp  GhcTc = Type
+
+type instance XCmdArrForm (GhcPass _) = NoExtField
+type instance XCmdApp     (GhcPass _) = NoExtField
+type instance XCmdLam     (GhcPass _) = NoExtField
+type instance XCmdPar     (GhcPass _) = NoExtField
+type instance XCmdCase    (GhcPass _) = NoExtField
+type instance XCmdIf      (GhcPass _) = NoExtField
+type instance XCmdLet     (GhcPass _) = NoExtField
+
+type instance XCmdDo      GhcPs = NoExtField
+type instance XCmdDo      GhcRn = NoExtField
+type instance XCmdDo      GhcTc = Type
+
+type instance XCmdWrap    (GhcPass _) = NoExtField
+type instance XXCmd       (GhcPass _) = NoExtCon
+
+-- | Haskell Array Application Type
+data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
+  deriving Data
+
+
+{- | Top-level command, introducing a new arrow.
+This may occur inside a proc (where the stack is empty) or as an
+argument of a command-forming operator.
+-}
+
+-- | Located Haskell Top-level Command
+type LHsCmdTop p = Located (HsCmdTop p)
+
+-- | Haskell Top-level Command
+data HsCmdTop p
+  = HsCmdTop (XCmdTop p)
+             (LHsCmd p)
+  | XCmdTop (XXCmdTop p)        -- Note [Trees that Grow] extension point
+
+data CmdTopTc
+  = CmdTopTc Type    -- Nested tuple of inputs on the command's stack
+             Type    -- return type of the command
+             (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
+
+type instance XCmdTop  GhcPs = NoExtField
+type instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
+type instance XCmdTop  GhcTc = CmdTopTc
+
+type instance XXCmdTop (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
+    ppr cmd = pprCmd cmd
+
+-----------------------
+-- pprCmd and pprLCmd call pprDeeper;
+-- the underscore versions do not
+pprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
+pprLCmd (L _ c) = pprCmd c
+
+pprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
+pprCmd c | isQuietHsCmd c =            ppr_cmd c
+         | otherwise      = pprDeeper (ppr_cmd c)
+
+isQuietHsCmd :: HsCmd id -> Bool
+-- Parentheses do display something, but it gives little info and
+-- if we go deeper when we go inside them then we get ugly things
+-- like (...)
+isQuietHsCmd (HsCmdPar {}) = True
+-- applications don't display anything themselves
+isQuietHsCmd (HsCmdApp {}) = True
+isQuietHsCmd _ = False
+
+-----------------------
+ppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc
+ppr_lcmd c = ppr_cmd (unLoc c)
+
+ppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc
+ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
+
+ppr_cmd (HsCmdApp _ c e)
+  = let (fun, args) = collect_args c [e] in
+    hang (ppr_lcmd fun) 2 (sep (map ppr args))
+  where
+    collect_args (L _ (HsCmdApp _ fun arg)) args = collect_args fun (arg:args)
+    collect_args fun args = (fun, args)
+
+ppr_cmd (HsCmdLam _ matches)
+  = pprMatches matches
+
+ppr_cmd (HsCmdCase _ expr matches)
+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
+          nest 2 (pprMatches matches) ]
+
+ppr_cmd (HsCmdIf _ _ e ct ce)
+  = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],
+         nest 4 (ppr ct),
+         text "else",
+         nest 4 (ppr ce)]
+
+-- special case: let ... in let ...
+ppr_cmd (HsCmdLet _ (L _ binds) cmd@(L _ (HsCmdLet {})))
+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
+         ppr_lcmd cmd]
+
+ppr_cmd (HsCmdLet _ (L _ binds) cmd)
+  = sep [hang (text "let") 2 (pprBinds binds),
+         hang (text "in")  2 (ppr cmd)]
+
+ppr_cmd (HsCmdDo _ (L _ stmts))  = pprDo ArrowExpr stmts
+
+ppr_cmd (HsCmdWrap _ w cmd)
+  = pprHsWrapper w (\_ -> parens (ppr_cmd cmd))
+ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True)
+  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
+ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False)
+  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
+ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)
+  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
+ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)
+  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
+
+ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) _ (Just _) [arg1, arg2])
+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
+                                         , pprCmdArg (unLoc arg2)])
+ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) Infix _    [arg1, arg2])
+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
+                                         , pprCmdArg (unLoc arg2)])
+ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) _ (Just _) [arg1, arg2])
+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
+                                         , pprCmdArg (unLoc arg2)])
+ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _    [arg1, arg2])
+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
+                                         , pprCmdArg (unLoc arg2)])
+ppr_cmd (HsCmdArrForm _ op _ _ args)
+  = hang (text "(|" <+> ppr_lexpr op)
+         4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
+ppr_cmd (XCmd x) = ppr x
+
+pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc
+pprCmdArg (HsCmdTop _ cmd)
+  = ppr_lcmd cmd
+pprCmdArg (XCmdTop x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmdTop p) where
+    ppr = pprCmdArg
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Record binds}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Haskell Record Bindings
+type HsRecordBinds p = HsRecFields p (LHsExpr p)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
+*                                                                      *
+************************************************************************
+
+@Match@es are sets of pattern bindings and right hand sides for
+functions, patterns or case branches. For example, if a function @g@
+is defined as:
+\begin{verbatim}
+g (x,y) = y
+g ((x:ys),y) = y+1,
+\end{verbatim}
+then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
+
+It is always the case that each element of an @[Match]@ list has the
+same number of @pats@s inside it.  This corresponds to saying that
+a function defined by pattern matching must have the same number of
+patterns in each equation.
+-}
+
+data MatchGroup p body
+  = MG { mg_ext     :: XMG p body -- Posr typechecker, types of args and result
+       , mg_alts    :: Located [LMatch p body]  -- The alternatives
+       , mg_origin  :: Origin }
+     -- The type is the type of the entire group
+     --      t1 -> ... -> tn -> tr
+     -- where there are n patterns
+  | XMatchGroup (XXMatchGroup p body)
+
+data MatchGroupTc
+  = MatchGroupTc
+       { mg_arg_tys :: [Type]  -- Types of the arguments, t1..tn
+       , mg_res_ty  :: Type    -- Type of the result, tr
+       } deriving Data
+
+type instance XMG         GhcPs b = NoExtField
+type instance XMG         GhcRn b = NoExtField
+type instance XMG         GhcTc b = MatchGroupTc
+
+type instance XXMatchGroup (GhcPass _) b = NoExtCon
+
+-- | Located Match
+type LMatch id body = Located (Match id body)
+-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
+--   list
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data Match p body
+  = Match {
+        m_ext :: XCMatch p body,
+        m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),
+          -- See note [m_ctxt in Match]
+        m_pats :: [LPat p], -- The patterns
+        m_grhss :: (GRHSs p body)
+  }
+  | XMatch (XXMatch p body)
+
+type instance XCMatch (GhcPass _) b = NoExtField
+type instance XXMatch (GhcPass _) b = NoExtCon
+
+instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
+            => Outputable (Match idR body) where
+  ppr = pprMatch
+
+{-
+Note [m_ctxt in Match]
+~~~~~~~~~~~~~~~~~~~~~~
+
+A Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and
+so on.
+
+In order to simplify tooling processing and pretty print output, the provenance
+is captured in an HsMatchContext.
+
+This is particularly important for the API Annotations for a multi-equation
+FunBind.
+
+The parser initially creates a FunBind with a single Match in it for
+every function definition it sees.
+
+These are then grouped together by getMonoBind into a single FunBind,
+where all the Matches are combined.
+
+In the process, all the original FunBind fun_id's bar one are
+discarded, including the locations.
+
+This causes a problem for source to source conversions via API
+Annotations, so the original fun_ids and infix flags are preserved in
+the Match, when it originates from a FunBind.
+
+Example infix function definition requiring individual API Annotations
+
+    (&&&  ) [] [] =  []
+    xs    &&&   [] =  xs
+    (  &&&  ) [] ys =  ys
+
+
+
+-}
+
+
+isInfixMatch :: Match id body -> Bool
+isInfixMatch match = case m_ctxt match of
+  FunRhs {mc_fixity = Infix} -> True
+  _                          -> False
+
+isEmptyMatchGroup :: MatchGroup id body -> Bool
+isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
+isEmptyMatchGroup (XMatchGroup {})      = False
+
+-- | Is there only one RHS in this list of matches?
+isSingletonMatchGroup :: [LMatch id body] -> Bool
+isSingletonMatchGroup matches
+  | [L _ match] <- matches
+  , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match
+  = True
+  | otherwise
+  = False
+
+matchGroupArity :: MatchGroup (GhcPass id) body -> Arity
+-- Precondition: MatchGroup is non-empty
+-- This is called before type checking, when mg_arg_tys is not set
+matchGroupArity (MG { mg_alts = alts })
+  | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
+  | otherwise        = panic "matchGroupArity"
+matchGroupArity (XMatchGroup nec) = noExtCon nec
+
+hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]
+hsLMatchPats (L _ (Match { m_pats = pats })) = pats
+hsLMatchPats (L _ (XMatch nec)) = noExtCon nec
+
+-- | Guarded Right-Hand Sides
+--
+-- GRHSs are used both for pattern bindings and for Matches
+--
+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
+--        'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
+--        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+--        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data GRHSs p body
+  = GRHSs {
+      grhssExt :: XCGRHSs p body,
+      grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs
+      grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
+    }
+  | XGRHSs (XXGRHSs p body)
+
+type instance XCGRHSs (GhcPass _) b = NoExtField
+type instance XXGRHSs (GhcPass _) b = NoExtCon
+
+-- | Located Guarded Right-Hand Side
+type LGRHS id body = Located (GRHS id body)
+
+-- | Guarded Right Hand Side.
+data GRHS p body = GRHS (XCGRHS p body)
+                        [GuardLStmt p] -- Guards
+                        body           -- Right hand side
+                  | XGRHS (XXGRHS p body)
+
+type instance XCGRHS (GhcPass _) b = NoExtField
+type instance XXGRHS (GhcPass _) b = NoExtCon
+
+-- We know the list must have at least one @Match@ in it.
+
+pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)
+           => MatchGroup (GhcPass idR) body -> SDoc
+pprMatches MG { mg_alts = matches }
+    = vcat (map pprMatch (map unLoc (unLoc matches)))
+      -- Don't print the type; it's only a place-holder before typechecking
+pprMatches (XMatchGroup x) = ppr x
+
+-- Exported to GHC.Hs.Binds, which can't see the defn of HsMatchContext
+pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
+           => MatchGroup (GhcPass idR) body -> SDoc
+pprFunBind matches = pprMatches matches
+
+-- Exported to GHC.Hs.Binds, which can't see the defn of HsMatchContext
+pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
+                                   OutputableBndrId (GhcPass p),
+                                   Outputable body)
+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
+pprPatBind pat (grhss)
+ = sep [ppr pat,
+       nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]
+
+pprMatch :: (OutputableBndrId (GhcPass idR), Outputable body)
+         => Match (GhcPass idR) body -> SDoc
+pprMatch match
+  = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)
+        , nest 2 (pprGRHSs ctxt (m_grhss match)) ]
+  where
+    ctxt = m_ctxt match
+    (herald, other_pats)
+        = case ctxt of
+            FunRhs {mc_fun=L _ fun, mc_fixity=fixity, mc_strictness=strictness}
+                | strictness == SrcStrict -> ASSERT(null $ m_pats match)
+                                             (char '!'<>pprPrefixOcc fun, m_pats match)
+                        -- a strict variable binding
+                | fixity == Prefix -> (pprPrefixOcc fun, m_pats match)
+                        -- f x y z = e
+                        -- Not pprBndr; the AbsBinds will
+                        -- have printed the signature
+
+                | null pats2 -> (pp_infix, [])
+                        -- x &&& y = e
+
+                | otherwise -> (parens pp_infix, pats2)
+                        -- (x &&& y) z = e
+                where
+                  pp_infix = pprParendLPat opPrec pat1
+                         <+> pprInfixOcc fun
+                         <+> pprParendLPat opPrec pat2
+
+            LambdaExpr -> (char '\\', m_pats match)
+
+            _  -> if null (m_pats match)
+                     then (empty, [])
+                     else ASSERT2( null pats1, ppr ctxt $$ ppr pat1 $$ ppr pats1 )
+                          (ppr pat1, [])        -- No parens around the single pat
+
+    (pat1:pats1) = m_pats match
+    (pat2:pats2) = pats1
+
+pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)
+         => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc
+pprGRHSs ctxt (GRHSs _ grhss (L _ binds))
+  = vcat (map (pprGRHS ctxt . unLoc) grhss)
+  -- Print the "where" even if the contents of the binds is empty. Only
+  -- EmptyLocalBinds means no "where" keyword
+ $$ ppUnless (eqEmptyLocalBinds binds)
+      (text "where" $$ nest 4 (pprBinds binds))
+pprGRHSs _ (XGRHSs x) = ppr x
+
+pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)
+        => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc
+pprGRHS ctxt (GRHS _ [] body)
+ =  pp_rhs ctxt body
+
+pprGRHS ctxt (GRHS _ guards body)
+ = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]
+
+pprGRHS _ (XGRHS x) = ppr x
+
+pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
+pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Do stmts and list comprehensions}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located @do@ block Statement
+type LStmt id body = Located (StmtLR id id body)
+
+-- | Located Statement with separate Left and Right id's
+type LStmtLR idL idR body = Located (StmtLR idL idR body)
+
+-- | @do@ block Statement
+type Stmt id body = StmtLR id id body
+
+-- | Command Located Statement
+type CmdLStmt   id = LStmt id (LHsCmd  id)
+
+-- | Command Statement
+type CmdStmt    id = Stmt  id (LHsCmd  id)
+
+-- | Expression Located Statement
+type ExprLStmt  id = LStmt id (LHsExpr id)
+
+-- | Expression Statement
+type ExprStmt   id = Stmt  id (LHsExpr id)
+
+-- | Guard Located Statement
+type GuardLStmt id = LStmt id (LHsExpr id)
+
+-- | Guard Statement
+type GuardStmt  id = Stmt  id (LHsExpr id)
+
+-- | Ghci Located Statement
+type GhciLStmt  id = LStmt id (LHsExpr id)
+
+-- | Ghci Statement
+type GhciStmt   id = Stmt  id (LHsExpr id)
+
+-- The SyntaxExprs in here are used *only* for do-notation and monad
+-- comprehensions, which have rebindable syntax. Otherwise they are unused.
+-- | API Annotations when in qualifier lists or guards
+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
+--         'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',
+--         'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
+--         'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data StmtLR idL idR body -- body should always be (LHs**** idR)
+  = LastStmt  -- Always the last Stmt in ListComp, MonadComp,
+              -- and (after the renamer, see RnExpr.checkLastStmt) DoExpr, MDoExpr
+              -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
+          (XLastStmt idL idR body)
+          body
+          Bool               -- True <=> return was stripped by ApplicativeDo
+          (SyntaxExpr idR)   -- The return operator
+            -- The return operator is used only for MonadComp
+            -- For ListComp we use the baked-in 'return'
+            -- For DoExpr, MDoExpr, we don't apply a 'return' at all
+            -- See Note [Monad Comprehensions]
+            -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | BindStmt (XBindStmt idL idR body) -- Post typechecking,
+                                -- result type of the function passed to bind;
+                                -- that is, S in (>>=) :: Q -> (R -> S) -> T
+             (LPat idL)
+             body
+             (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]
+             (SyntaxExpr idR) -- The fail operator
+             -- The fail operator is noSyntaxExpr
+             -- if the pattern match can't fail
+
+  -- | 'ApplicativeStmt' represents an applicative expression built with
+  -- '<$>' and '<*>'.  It is generated by the renamer, and is desugared into the
+  -- appropriate applicative expression by the desugarer, but it is intended
+  -- to be invisible in error messages.
+  --
+  -- For full details, see Note [ApplicativeDo] in RnExpr
+  --
+  | ApplicativeStmt
+             (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body
+             [ ( SyntaxExpr idR
+               , ApplicativeArg idL) ]
+                      -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
+             (Maybe (SyntaxExpr idR))  -- 'join', if necessary
+
+  | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type
+                                      -- of the RHS (used for arrows)
+             body              -- See Note [BodyStmt]
+             (SyntaxExpr idR)  -- The (>>) operator
+             (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp
+                               -- See notes [Monad Comprehensions]
+
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
+  --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | LetStmt  (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)
+
+  -- ParStmts only occur in a list/monad comprehension
+  | ParStmt  (XParStmt idL idR body)    -- Post typecheck,
+                                        -- S in (>>=) :: Q -> (R -> S) -> T
+             [ParStmtBlock idL idR]
+             (HsExpr idR)               -- Polymorphic `mzip` for monad comprehensions
+             (SyntaxExpr idR)           -- The `>>=` operator
+                                        -- See notes [Monad Comprehensions]
+            -- After renaming, the ids are the binders
+            -- bound by the stmts and used after themp
+
+  | TransStmt {
+      trS_ext   :: XTransStmt idL idR body, -- Post typecheck,
+                                            -- R in (>>=) :: Q -> (R -> S) -> T
+      trS_form  :: TransForm,
+      trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'
+                                      -- which generates the tuples to be grouped
+
+      trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map]
+
+      trS_using :: LHsExpr idR,
+      trS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)
+        -- Invariant: if trS_form = GroupBy, then grp_by = Just e
+
+      trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for
+                                      -- the inner monad comprehensions
+      trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
+      trS_fmap :: HsExpr idR          -- The polymorphic 'fmap' function for desugaring
+                                      -- Only for 'group' forms
+                                      -- Just a simple HsExpr, because it's
+                                      -- too polymorphic for tcSyntaxOp
+    }                                 -- See Note [Monad Comprehensions]
+
+  -- Recursive statement (see Note [How RecStmt works] below)
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | RecStmt
+     { recS_ext :: XRecStmt idL idR body
+     , recS_stmts :: [LStmtLR idL idR body]
+
+        -- The next two fields are only valid after renaming
+     , recS_later_ids :: [IdP idR]
+                         -- The ids are a subset of the variables bound by the
+                         -- stmts that are used in stmts that follow the RecStmt
+
+     , recS_rec_ids :: [IdP idR]
+                         -- Ditto, but these variables are the "recursive" ones,
+                         -- that are used before they are bound in the stmts of
+                         -- the RecStmt.
+        -- An Id can be in both groups
+        -- Both sets of Ids are (now) treated monomorphically
+        -- See Note [How RecStmt works] for why they are separate
+
+        -- Rebindable syntax
+     , recS_bind_fn :: SyntaxExpr idR -- The bind function
+     , recS_ret_fn  :: SyntaxExpr idR -- The return function
+     , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
+      }
+  | XStmtLR (XXStmtLR idL idR body)
+
+-- Extra fields available post typechecking for RecStmt.
+data RecStmtTc =
+  RecStmtTc
+     { recS_bind_ty :: Type       -- S in (>>=) :: Q -> (R -> S) -> T
+     , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
+     , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1
+                                  -- with recS_later_ids and recS_rec_ids,
+                                  -- and are the expressions that should be
+                                  -- returned by the recursion.
+                                  -- They may not quite be the Ids themselves,
+                                  -- because the Id may be *polymorphic*, but
+                                  -- the returned thing has to be *monomorphic*,
+                                  -- so they may be type applications
+
+      , recS_ret_ty :: Type        -- The type of
+                                   -- do { stmts; return (a,b,c) }
+                                   -- With rebindable syntax the type might not
+                                   -- be quite as simple as (m (tya, tyb, tyc)).
+      }
+
+
+type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExtField
+
+type instance XBindStmt        (GhcPass _) GhcPs b = NoExtField
+type instance XBindStmt        (GhcPass _) GhcRn b = NoExtField
+type instance XBindStmt        (GhcPass _) GhcTc b = Type
+
+type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField
+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField
+type instance XApplicativeStmt (GhcPass _) GhcTc b = Type
+
+type instance XBodyStmt        (GhcPass _) GhcPs b = NoExtField
+type instance XBodyStmt        (GhcPass _) GhcRn b = NoExtField
+type instance XBodyStmt        (GhcPass _) GhcTc b = Type
+
+type instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExtField
+
+type instance XParStmt         (GhcPass _) GhcPs b = NoExtField
+type instance XParStmt         (GhcPass _) GhcRn b = NoExtField
+type instance XParStmt         (GhcPass _) GhcTc b = Type
+
+type instance XTransStmt       (GhcPass _) GhcPs b = NoExtField
+type instance XTransStmt       (GhcPass _) GhcRn b = NoExtField
+type instance XTransStmt       (GhcPass _) GhcTc b = Type
+
+type instance XRecStmt         (GhcPass _) GhcPs b = NoExtField
+type instance XRecStmt         (GhcPass _) GhcRn b = NoExtField
+type instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc
+
+type instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExtCon
+
+data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function
+  = ThenForm     -- then f               or    then f by e             (depending on trS_by)
+  | GroupForm    -- then group using f   or    then group by e using f (depending on trS_by)
+  deriving Data
+
+-- | Parenthesised Statement Block
+data ParStmtBlock idL idR
+  = ParStmtBlock
+        (XParStmtBlock idL idR)
+        [ExprLStmt idL]
+        [IdP idR]          -- The variables to be returned
+        (SyntaxExpr idR)   -- The return operator
+  | XParStmtBlock (XXParStmtBlock idL idR)
+
+type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon
+
+-- | Applicative Argument
+data ApplicativeArg idL
+  = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)
+      (XApplicativeArgOne idL)
+      (LPat idL)           -- WildPat if it was a BodyStmt (see below)
+      (LHsExpr idL)
+      Bool                 -- True <=> was a BodyStmt
+                           -- False <=> was a BindStmt
+                           -- See Note [Applicative BodyStmt]
+
+  | ApplicativeArgMany     -- do { stmts; return vars }
+      (XApplicativeArgMany idL)
+      [ExprLStmt idL]      -- stmts
+      (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)
+      (LPat idL)           -- (v1,...,vn)
+  | XApplicativeArg (XXApplicativeArg idL)
+
+type instance XApplicativeArgOne  (GhcPass _) = NoExtField
+type instance XApplicativeArgMany (GhcPass _) = NoExtField
+type instance XXApplicativeArg    (GhcPass _) = NoExtCon
+
+{-
+Note [The type of bind in Stmts]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Some Stmts, notably BindStmt, keep the (>>=) bind operator.
+We do NOT assume that it has type
+    (>>=) :: m a -> (a -> m b) -> m b
+In some cases (see #303, #1537) it might have a more
+exotic type, such as
+    (>>=) :: m i j a -> (a -> m j k b) -> m i k b
+So we must be careful not to make assumptions about the type.
+In particular, the monad may not be uniform throughout.
+
+Note [TransStmt binder map]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The [(idR,idR)] in a TransStmt behaves as follows:
+
+  * Before renaming: []
+
+  * After renaming:
+          [ (x27,x27), ..., (z35,z35) ]
+    These are the variables
+       bound by the stmts to the left of the 'group'
+       and used either in the 'by' clause,
+                or     in the stmts following the 'group'
+    Each item is a pair of identical variables.
+
+  * After typechecking:
+          [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
+    Each pair has the same unique, but different *types*.
+
+Note [BodyStmt]
+~~~~~~~~~~~~~~~
+BodyStmts are a bit tricky, because what they mean
+depends on the context.  Consider the following contexts:
+
+        A do expression of type (m res_ty)
+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        * BodyStmt E any_ty:   do { ....; E; ... }
+                E :: m any_ty
+          Translation: E >> ...
+
+        A list comprehensions of type [elt_ty]
+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        * BodyStmt E Bool:   [ .. | .... E ]
+                        [ .. | ..., E, ... ]
+                        [ .. | .... | ..., E | ... ]
+                E :: Bool
+          Translation: if E then fail else ...
+
+        A guard list, guarding a RHS of type rhs_ty
+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        * BodyStmt E BooParStmtBlockl:   f x | ..., E, ... = ...rhs...
+                E :: Bool
+          Translation: if E then fail else ...
+
+        A monad comprehension of type (m res_ty)
+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        * BodyStmt E Bool:   [ .. | .... E ]
+                E :: Bool
+          Translation: guard E >> ...
+
+Array comprehensions are handled like list comprehensions.
+
+Note [How RecStmt works]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Example:
+   HsDo [ BindStmt x ex
+
+        , RecStmt { recS_rec_ids   = [a, c]
+                  , recS_stmts     = [ BindStmt b (return (a,c))
+                                     , LetStmt a = ...b...
+                                     , BindStmt c ec ]
+                  , recS_later_ids = [a, b]
+
+        , return (a b) ]
+
+Here, the RecStmt binds a,b,c; but
+  - Only a,b are used in the stmts *following* the RecStmt,
+  - Only a,c are used in the stmts *inside* the RecStmt
+        *before* their bindings
+
+Why do we need *both* rec_ids and later_ids?  For monads they could be
+combined into a single set of variables, but not for arrows.  That
+follows from the types of the respective feedback operators:
+
+        mfix :: MonadFix m => (a -> m a) -> m a
+        loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
+
+* For mfix, the 'a' covers the union of the later_ids and the rec_ids
+* For 'loop', 'c' is the later_ids and 'd' is the rec_ids
+
+Note [Typing a RecStmt]
+~~~~~~~~~~~~~~~~~~~~~~~
+A (RecStmt stmts) types as if you had written
+
+  (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
+                                 do { stmts
+                                    ; return (v1,..vn, r1, ..., rm) })
+
+where v1..vn are the later_ids
+      r1..rm are the rec_ids
+
+Note [Monad Comprehensions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Monad comprehensions require separate functions like 'return' and
+'>>=' for desugaring. These functions are stored in the statements
+used in monad comprehensions. For example, the 'return' of the 'LastStmt'
+expression is used to lift the body of the monad comprehension:
+
+  [ body | stmts ]
+   =>
+  stmts >>= \bndrs -> return body
+
+In transform and grouping statements ('then ..' and 'then group ..') the
+'return' function is required for nested monad comprehensions, for example:
+
+  [ body | stmts, then f, rest ]
+   =>
+  f [ env | stmts ] >>= \bndrs -> [ body | rest ]
+
+BodyStmts require the 'Control.Monad.guard' function for boolean
+expressions:
+
+  [ body | exp, stmts ]
+   =>
+  guard exp >> [ body | stmts ]
+
+Parallel statements require the 'Control.Monad.Zip.mzip' function:
+
+  [ body | stmts1 | stmts2 | .. ]
+   =>
+  mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
+
+In any other context than 'MonadComp', the fields for most of these
+'SyntaxExpr's stay bottom.
+
+
+Note [Applicative BodyStmt]
+
+(#12143) For the purposes of ApplicativeDo, we treat any BodyStmt
+as if it was a BindStmt with a wildcard pattern.  For example,
+
+  do
+    x <- A
+    B
+    return x
+
+is transformed as if it were
+
+  do
+    x <- A
+    _ <- B
+    return x
+
+so it transforms to
+
+  (\(x,_) -> x) <$> A <*> B
+
+But we have to remember when we treat a BodyStmt like a BindStmt,
+because in error messages we want to emit the original syntax the user
+wrote, not our internal representation.  So ApplicativeArgOne has a
+Bool flag that is True when the original statement was a BodyStmt, so
+that we can pretty-print it correctly.
+-}
+
+instance (Outputable (StmtLR idL idL (LHsExpr idL)),
+          Outputable (XXParStmtBlock idL idR))
+        => Outputable (ParStmtBlock idL idR) where
+  ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts
+  ppr (XParStmtBlock x)          = ppr x
+
+instance (idL ~ GhcPass pl,idR ~ GhcPass pr,
+          OutputableBndrId idL, OutputableBndrId idR,
+          Outputable body)
+         => Outputable (StmtLR idL idR body) where
+    ppr stmt = pprStmt stmt
+
+pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),
+                                  OutputableBndrId (GhcPass idR),
+                                  Outputable body)
+        => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc
+pprStmt (LastStmt _ expr ret_stripped _)
+  = whenPprDebug (text "[last]") <+>
+       (if ret_stripped then text "return" else empty) <+>
+       ppr expr
+pprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]
+pprStmt (LetStmt _ (L _ binds))   = hsep [text "let", pprBinds binds]
+pprStmt (BodyStmt _ expr _ _)     = ppr expr
+pprStmt (ParStmt _ stmtss _ _)   = sep (punctuate (text " | ") (map ppr stmtss))
+
+pprStmt (TransStmt { trS_stmts = stmts, trS_by = by
+                   , trS_using = using, trS_form = form })
+  = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
+
+pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
+                 , recS_later_ids = later_ids })
+  = text "rec" <+>
+    vcat [ ppr_do_stmts segment
+         , whenPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids
+                            , text "later_ids=" <> ppr later_ids])]
+
+pprStmt (ApplicativeStmt _ args mb_join)
+  = getPprStyle $ \style ->
+      if userStyle style
+         then pp_for_user
+         else pp_debug
+  where
+  -- make all the Applicative stuff invisible in error messages by
+  -- flattening the whole ApplicativeStmt nest back to a sequence
+  -- of statements.
+   pp_for_user = vcat $ concatMap flattenArg args
+
+   -- ppr directly rather than transforming here, because we need to
+   -- inject a "return" which is hard when we're polymorphic in the id
+   -- type.
+   flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]
+   flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args
+   flattenStmt stmt = [ppr stmt]
+
+   flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]
+   flattenArg (_, ApplicativeArgOne _ pat expr isBody)
+     | isBody =  -- See Note [Applicative BodyStmt]
+     [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
+             :: ExprStmt (GhcPass idL))]
+     | otherwise =
+     [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
+             :: ExprStmt (GhcPass idL))]
+   flattenArg (_, ApplicativeArgMany _ stmts _ _) =
+     concatMap flattenStmt stmts
+   flattenArg (_, XApplicativeArg nec) = noExtCon nec
+
+   pp_debug =
+     let
+         ap_expr = sep (punctuate (text " |") (map pp_arg args))
+     in
+       if isNothing mb_join
+          then ap_expr
+          else text "join" <+> parens ap_expr
+
+   pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
+   pp_arg (_, ApplicativeArgOne _ pat expr isBody)
+     | isBody =  -- See Note [Applicative BodyStmt]
+     ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
+            :: ExprStmt (GhcPass idL))
+     | otherwise =
+     ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
+            :: ExprStmt (GhcPass idL))
+   pp_arg (_, ApplicativeArgMany _ stmts return pat) =
+     ppr pat <+>
+     text "<-" <+>
+     ppr (HsDo (panic "pprStmt") DoExpr (noLoc
+               (stmts ++
+                   [noLoc (LastStmt noExtField (noLoc return) False noSyntaxExpr)])))
+   pp_arg (_, XApplicativeArg x) = ppr x
+
+pprStmt (XStmtLR x) = ppr x
+
+pprTransformStmt :: (OutputableBndrId (GhcPass p))
+                 => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
+                 -> Maybe (LHsExpr (GhcPass p)) -> SDoc
+pprTransformStmt bndrs using by
+  = sep [ text "then" <+> whenPprDebug (braces (ppr bndrs))
+        , nest 2 (ppr using)
+        , nest 2 (pprBy by)]
+
+pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc
+pprTransStmt by using ThenForm
+  = sep [ text "then", nest 2 (ppr using), nest 2 (pprBy by)]
+pprTransStmt by using GroupForm
+  = sep [ text "then group", nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
+
+pprBy :: Outputable body => Maybe body -> SDoc
+pprBy Nothing  = empty
+pprBy (Just e) = text "by" <+> ppr e
+
+pprDo :: (OutputableBndrId (GhcPass p), Outputable body)
+      => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc
+pprDo DoExpr        stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo GhciStmtCtxt  stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo ArrowExpr     stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo MDoExpr       stmts = text "mdo" <+> ppr_do_stmts stmts
+pprDo ListComp      stmts = brackets    $ pprComp stmts
+pprDo MonadComp     stmts = brackets    $ pprComp stmts
+pprDo _             _     = panic "pprDo" -- PatGuard, ParStmtCxt
+
+ppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),
+                 Outputable body)
+             => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc
+-- Print a bunch of do stmts
+ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
+
+pprComp :: (OutputableBndrId (GhcPass p), Outputable body)
+        => [LStmt (GhcPass p) body] -> SDoc
+pprComp quals     -- Prints:  body | qual1, ..., qualn
+  | Just (initStmts, L _ (LastStmt _ body _ _)) <- snocView quals
+  = if null initStmts
+       -- If there are no statements in a list comprehension besides the last
+       -- one, we simply treat it like a normal list. This does arise
+       -- occasionally in code that GHC generates, e.g., in implementations of
+       -- 'range' for derived 'Ix' instances for product datatypes with exactly
+       -- one constructor (e.g., see #12583).
+       then ppr body
+       else hang (ppr body <+> vbar) 2 (pprQuals initStmts)
+  | otherwise
+  = pprPanic "pprComp" (pprQuals quals)
+
+pprQuals :: (OutputableBndrId (GhcPass p), Outputable body)
+         => [LStmt (GhcPass p) body] -> SDoc
+-- Show list comprehension qualifiers separated by commas
+pprQuals quals = interpp'SP quals
+
+{-
+************************************************************************
+*                                                                      *
+                Template Haskell quotation brackets
+*                                                                      *
+************************************************************************
+-}
+
+-- | Haskell Splice
+data HsSplice id
+   = HsTypedSplice       --  $$z  or $$(f 4)
+        (XTypedSplice id)
+        SpliceDecoration -- Whether $$( ) variant found, for pretty printing
+        (IdP id)         -- A unique name to identify this splice point
+        (LHsExpr id)     -- See Note [Pending Splices]
+
+   | HsUntypedSplice     --  $z  or $(f 4)
+        (XUntypedSplice id)
+        SpliceDecoration -- Whether $( ) variant found, for pretty printing
+        (IdP id)         -- A unique name to identify this splice point
+        (LHsExpr id)     -- See Note [Pending Splices]
+
+   | HsQuasiQuote        -- See Note [Quasi-quote overview] in TcSplice
+        (XQuasiQuote id)
+        (IdP id)         -- Splice point
+        (IdP id)         -- Quoter
+        SrcSpan          -- The span of the enclosed string
+        FastString       -- The enclosed string
+
+   -- AZ:TODO: use XSplice instead of HsSpliced
+   | HsSpliced  -- See Note [Delaying modFinalizers in untyped splices] in
+                -- RnSplice.
+                -- This is the result of splicing a splice. It is produced by
+                -- the renamer and consumed by the typechecker. It lives only
+                -- between the two.
+        (XSpliced id)
+        ThModFinalizers     -- TH finalizers produced by the splice.
+        (HsSplicedThing id) -- The result of splicing
+   | HsSplicedT
+      DelayedSplice
+   | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point
+
+type instance XTypedSplice   (GhcPass _) = NoExtField
+type instance XUntypedSplice (GhcPass _) = NoExtField
+type instance XQuasiQuote    (GhcPass _) = NoExtField
+type instance XSpliced       (GhcPass _) = NoExtField
+type instance XXSplice       (GhcPass _) = NoExtCon
+
+-- | A splice can appear with various decorations wrapped around it. This data
+-- type captures explicitly how it was originally written, for use in the pretty
+-- printer.
+data SpliceDecoration
+  = HasParens -- ^ $( splice ) or $$( splice )
+  | HasDollar -- ^ $splice or $$splice
+  | NoParens  -- ^ bare splice
+  deriving (Data, Eq, Show)
+
+instance Outputable SpliceDecoration where
+  ppr x = text $ show x
+
+
+isTypedSplice :: HsSplice id -> Bool
+isTypedSplice (HsTypedSplice {}) = True
+isTypedSplice _                  = False   -- Quasi-quotes are untyped splices
+
+-- | Finalizers produced by a splice with
+-- 'Language.Haskell.TH.Syntax.addModFinalizer'
+--
+-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
+-- this is used.
+--
+newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]
+
+-- A Data instance which ignores the argument of 'ThModFinalizers'.
+instance Data ThModFinalizers where
+  gunfold _ z _ = z $ ThModFinalizers []
+  toConstr  a   = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
+  dataTypeOf a  = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
+
+-- See Note [Running typed splices in the zonker]
+-- These are the arguments that are passed to `TcSplice.runTopSplice`
+data DelayedSplice =
+  DelayedSplice
+    TcLclEnv          -- The local environment to run the splice in
+    (LHsExpr GhcRn)   -- The original renamed expression
+    TcType            -- The result type of running the splice, unzonked
+    (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result
+
+-- A Data instance which ignores the argument of 'DelayedSplice'.
+instance Data DelayedSplice where
+  gunfold _ _ _ = panic "DelayedSplice"
+  toConstr  a   = mkConstr (dataTypeOf a) "DelayedSplice" [] Data.Prefix
+  dataTypeOf a  = mkDataType "HsExpr.DelayedSplice" [toConstr a]
+
+-- | Haskell Spliced Thing
+--
+-- Values that can result from running a splice.
+data HsSplicedThing id
+    = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression
+    | HsSplicedTy   (HsType id) -- ^ Haskell Spliced Type
+    | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern
+
+
+-- See Note [Pending Splices]
+type SplicePointName = Name
+
+-- | Pending Renamer Splice
+data PendingRnSplice
+  = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)
+
+data UntypedSpliceFlavour
+  = UntypedExpSplice
+  | UntypedPatSplice
+  | UntypedTypeSplice
+  | UntypedDeclSplice
+  deriving Data
+
+-- | Pending Type-checker Splice
+data PendingTcSplice
+  = PendingTcSplice SplicePointName (LHsExpr GhcTc)
+
+{-
+Note [Pending Splices]
+~~~~~~~~~~~~~~~~~~~~~~
+When we rename an untyped bracket, we name and lift out all the nested
+splices, so that when the typechecker hits the bracket, it can
+typecheck those nested splices without having to walk over the untyped
+bracket code.  So for example
+    [| f $(g x) |]
+looks like
+
+    HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))
+
+which the renamer rewrites to
+
+    HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
+                   [PendingRnSplice UntypedExpSplice sn (g x)]
+
+* The 'sn' is the Name of the splice point, the SplicePointName
+
+* The PendingRnExpSplice gives the splice that splice-point name maps to;
+  and the typechecker can now conveniently find these sub-expressions
+
+* The other copy of the splice, in the second argument of HsSpliceE
+                                in the renamed first arg of HsRnBracketOut
+  is used only for pretty printing
+
+There are four varieties of pending splices generated by the renamer,
+distinguished by their UntypedSpliceFlavour
+
+ * Pending expression splices (UntypedExpSplice), e.g.,
+       [|$(f x) + 2|]
+
+   UntypedExpSplice is also used for
+     * quasi-quotes, where the pending expression expands to
+          $(quoter "...blah...")
+       (see RnSplice.makePending, HsQuasiQuote case)
+
+     * cross-stage lifting, where the pending expression expands to
+          $(lift x)
+       (see RnSplice.checkCrossStageLifting)
+
+ * Pending pattern splices (UntypedPatSplice), e.g.,
+       [| \$(f x) -> x |]
+
+ * Pending type splices (UntypedTypeSplice), e.g.,
+       [| f :: $(g x) |]
+
+ * Pending declaration (UntypedDeclSplice), e.g.,
+       [| let $(f x) in ... |]
+
+There is a fifth variety of pending splice, which is generated by the type
+checker:
+
+  * Pending *typed* expression splices, (PendingTcSplice), e.g.,
+        [||1 + $$(f 2)||]
+
+It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
+output of the renamer. However, when pretty printing the output of the renamer,
+e.g., in a type error message, we *do not* want to print out the pending
+splices. In contrast, when pretty printing the output of the type checker, we
+*do* want to print the pending splices. So splitting them up seems to make
+sense, although I hate to add another constructor to HsExpr.
+-}
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsSplicedThing p) where
+  ppr (HsSplicedExpr e) = ppr_expr e
+  ppr (HsSplicedTy   t) = ppr t
+  ppr (HsSplicedPat  p) = ppr p
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsSplice p) where
+  ppr s = pprSplice s
+
+pprPendingSplice :: (OutputableBndrId (GhcPass p))
+                 => SplicePointName -> LHsExpr (GhcPass p) -> SDoc
+pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
+
+pprSpliceDecl ::  (OutputableBndrId (GhcPass p))
+          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
+pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
+pprSpliceDecl e ExplicitSplice   = text "$(" <> ppr_splice_decl e <> text ")"
+pprSpliceDecl e ImplicitSplice   = ppr_splice_decl e
+
+ppr_splice_decl :: (OutputableBndrId (GhcPass p))
+                => HsSplice (GhcPass p) -> SDoc
+ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
+ppr_splice_decl e = pprSplice e
+
+pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
+pprSplice (HsTypedSplice _ HasParens  n e)
+  = ppr_splice (text "$$(") n e (text ")")
+pprSplice (HsTypedSplice _ HasDollar n e)
+  = ppr_splice (text "$$") n e empty
+pprSplice (HsTypedSplice _ NoParens n e)
+  = ppr_splice empty n e empty
+pprSplice (HsUntypedSplice _ HasParens  n e)
+  = ppr_splice (text "$(") n e (text ")")
+pprSplice (HsUntypedSplice _ HasDollar n e)
+  = ppr_splice (text "$")  n e empty
+pprSplice (HsUntypedSplice _ NoParens n e)
+  = ppr_splice empty  n e empty
+pprSplice (HsQuasiQuote _ n q _ s)      = ppr_quasi n q s
+pprSplice (HsSpliced _ _ thing)         = ppr thing
+pprSplice (HsSplicedT {})               = text "Unevaluated typed splice"
+pprSplice (XSplice x)                   = ppr x
+
+ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc
+ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>
+                           char '[' <> ppr quoter <> vbar <>
+                           ppr quote <> text "|]"
+
+ppr_splice :: (OutputableBndrId (GhcPass p))
+           => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc
+ppr_splice herald n e trail
+    = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail
+
+-- | Haskell Bracket
+data HsBracket p
+  = ExpBr  (XExpBr p)   (LHsExpr p)    -- [|  expr  |]
+  | PatBr  (XPatBr p)   (LPat p)      -- [p| pat   |]
+  | DecBrL (XDecBrL p)  [LHsDecl p]   -- [d| decls |]; result of parser
+  | DecBrG (XDecBrG p)  (HsGroup p)   -- [d| decls |]; result of renamer
+  | TypBr  (XTypBr p)   (LHsType p)   -- [t| type  |]
+  | VarBr  (XVarBr p)   Bool (IdP p)  -- True: 'x, False: ''T
+                                -- (The Bool flag is used only in pprHsBracket)
+  | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]
+  | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point
+
+type instance XExpBr      (GhcPass _) = NoExtField
+type instance XPatBr      (GhcPass _) = NoExtField
+type instance XDecBrL     (GhcPass _) = NoExtField
+type instance XDecBrG     (GhcPass _) = NoExtField
+type instance XTypBr      (GhcPass _) = NoExtField
+type instance XVarBr      (GhcPass _) = NoExtField
+type instance XTExpBr     (GhcPass _) = NoExtField
+type instance XXBracket   (GhcPass _) = NoExtCon
+
+isTypedBracket :: HsBracket id -> Bool
+isTypedBracket (TExpBr {}) = True
+isTypedBracket _           = False
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+          => Outputable (HsBracket p) where
+  ppr = pprHsBracket
+
+
+pprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc
+pprHsBracket (ExpBr _ e)   = thBrackets empty (ppr e)
+pprHsBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)
+pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
+pprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))
+pprHsBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)
+pprHsBracket (VarBr _ True n)
+  = char '\'' <> pprPrefixOcc n
+pprHsBracket (VarBr _ False n)
+  = text "''" <> pprPrefixOcc n
+pprHsBracket (TExpBr _ e)  = thTyBrackets (ppr e)
+pprHsBracket (XBracket e)  = ppr e
+
+thBrackets :: SDoc -> SDoc -> SDoc
+thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
+                             pp_body <+> text "|]"
+
+thTyBrackets :: SDoc -> SDoc
+thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]")
+
+instance Outputable PendingRnSplice where
+  ppr (PendingRnSplice _ n e) = pprPendingSplice n e
+
+instance Outputable PendingTcSplice where
+  ppr (PendingTcSplice n e) = pprPendingSplice n e
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Enumerations and list comprehensions}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Arithmetic Sequence Information
+data ArithSeqInfo id
+  = From            (LHsExpr id)
+  | FromThen        (LHsExpr id)
+                    (LHsExpr id)
+  | FromTo          (LHsExpr id)
+                    (LHsExpr id)
+  | FromThenTo      (LHsExpr id)
+                    (LHsExpr id)
+                    (LHsExpr id)
+-- AZ: Sould ArithSeqInfo have a TTG extension?
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+         => Outputable (ArithSeqInfo p) where
+    ppr (From e1)             = hcat [ppr e1, pp_dotdot]
+    ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
+    ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
+    ppr (FromThenTo e1 e2 e3)
+      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
+
+pp_dotdot :: SDoc
+pp_dotdot = text " .. "
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{HsMatchCtxt}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Haskell Match Context
+--
+-- Context of a pattern match. This is more subtle than it would seem. See Note
+-- [Varieties of pattern matches].
+data HsMatchContext id -- Not an extensible tag
+  = FunRhs { mc_fun        :: Located id    -- ^ function binder of @f@
+           , mc_fixity     :: LexicalFixity -- ^ fixing of @f@
+           , mc_strictness :: SrcStrictness -- ^ was @f@ banged?
+                                            -- See Note [FunBind vs PatBind]
+           }
+                                -- ^A pattern matching on an argument of a
+                                -- function binding
+  | LambdaExpr                  -- ^Patterns of a lambda
+  | CaseAlt                     -- ^Patterns and guards on a case alternative
+  | IfAlt                       -- ^Guards of a multi-way if alternative
+  | ProcExpr                    -- ^Patterns of a proc
+  | PatBindRhs                  -- ^A pattern binding  eg [y] <- e = e
+  | PatBindGuards               -- ^Guards of pattern bindings, e.g.,
+                                --    (Just b) | Just _ <- x = e
+                                --             | otherwise   = e'
+
+  | RecUpd                      -- ^Record update [used only in DsExpr to
+                                --    tell matchWrapper what sort of
+                                --    runtime error message to generate]
+
+  | StmtCtxt (HsStmtContext id) -- ^Pattern of a do-stmt, list comprehension,
+                                -- pattern guard, etc
+
+  | ThPatSplice            -- ^A Template Haskell pattern splice
+  | ThPatQuote             -- ^A Template Haskell pattern quotation [p| (a,b) |]
+  | PatSyn                 -- ^A pattern synonym declaration
+  deriving Functor
+deriving instance (Data id) => Data (HsMatchContext id)
+
+instance OutputableBndr id => Outputable (HsMatchContext id) where
+  ppr m@(FunRhs{})          = text "FunRhs" <+> ppr (mc_fun m) <+> ppr (mc_fixity m)
+  ppr LambdaExpr            = text "LambdaExpr"
+  ppr CaseAlt               = text "CaseAlt"
+  ppr IfAlt                 = text "IfAlt"
+  ppr ProcExpr              = text "ProcExpr"
+  ppr PatBindRhs            = text "PatBindRhs"
+  ppr PatBindGuards         = text "PatBindGuards"
+  ppr RecUpd                = text "RecUpd"
+  ppr (StmtCtxt _)          = text "StmtCtxt _"
+  ppr ThPatSplice           = text "ThPatSplice"
+  ppr ThPatQuote            = text "ThPatQuote"
+  ppr PatSyn                = text "PatSyn"
+
+isPatSynCtxt :: HsMatchContext id -> Bool
+isPatSynCtxt ctxt =
+  case ctxt of
+    PatSyn -> True
+    _      -> False
+
+-- | Haskell Statement Context. It expects to be parameterised with one of
+-- 'RdrName', 'Name' or 'Id'
+data HsStmtContext id
+  = ListComp
+  | MonadComp
+
+  | DoExpr                           -- ^do { ... }
+  | MDoExpr                          -- ^mdo { ... }  ie recursive do-expression
+  | ArrowExpr                        -- ^do-notation in an arrow-command context
+
+  | GhciStmtCtxt                     -- ^A command-line Stmt in GHCi pat <- rhs
+  | PatGuard (HsMatchContext id)     -- ^Pattern guard for specified thing
+  | ParStmtCtxt (HsStmtContext id)   -- ^A branch of a parallel stmt
+  | TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt
+  deriving Functor
+deriving instance (Data id) => Data (HsStmtContext id)
+
+isComprehensionContext :: HsStmtContext id -> Bool
+-- Uses comprehension syntax [ e | quals ]
+isComprehensionContext ListComp          = True
+isComprehensionContext MonadComp         = True
+isComprehensionContext (ParStmtCtxt c)   = isComprehensionContext c
+isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c
+isComprehensionContext _ = False
+
+-- | Should pattern match failure in a 'HsStmtContext' be desugared using
+-- 'MonadFail'?
+isMonadFailStmtContext :: HsStmtContext id -> Bool
+isMonadFailStmtContext MonadComp            = True
+isMonadFailStmtContext DoExpr               = True
+isMonadFailStmtContext MDoExpr              = True
+isMonadFailStmtContext GhciStmtCtxt         = True
+isMonadFailStmtContext (ParStmtCtxt ctxt)   = isMonadFailStmtContext ctxt
+isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt
+isMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr
+
+isMonadCompContext :: HsStmtContext id -> Bool
+isMonadCompContext MonadComp = True
+isMonadCompContext _         = False
+
+matchSeparator :: HsMatchContext id -> SDoc
+matchSeparator (FunRhs {})   = text "="
+matchSeparator CaseAlt       = text "->"
+matchSeparator IfAlt         = text "->"
+matchSeparator LambdaExpr    = text "->"
+matchSeparator ProcExpr      = text "->"
+matchSeparator PatBindRhs    = text "="
+matchSeparator PatBindGuards = text "="
+matchSeparator (StmtCtxt _)  = text "<-"
+matchSeparator RecUpd        = text "=" -- This can be printed by the pattern
+                                       -- match checker trace
+matchSeparator ThPatSplice  = panic "unused"
+matchSeparator ThPatQuote   = panic "unused"
+matchSeparator PatSyn       = panic "unused"
+
+pprMatchContext :: (Outputable (NameOrRdrName id),Outputable id)
+                => HsMatchContext id -> SDoc
+pprMatchContext ctxt
+  | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
+  | otherwise    = text "a"  <+> pprMatchContextNoun ctxt
+  where
+    want_an (FunRhs {}) = True  -- Use "an" in front
+    want_an ProcExpr    = True
+    want_an _           = False
+
+pprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)
+                    => HsMatchContext id -> SDoc
+pprMatchContextNoun (FunRhs {mc_fun=L _ fun})
+                                    = text "equation for"
+                                      <+> quotes (ppr fun)
+pprMatchContextNoun CaseAlt         = text "case alternative"
+pprMatchContextNoun IfAlt           = text "multi-way if alternative"
+pprMatchContextNoun RecUpd          = text "record-update construct"
+pprMatchContextNoun ThPatSplice     = text "Template Haskell pattern splice"
+pprMatchContextNoun ThPatQuote      = text "Template Haskell pattern quotation"
+pprMatchContextNoun PatBindRhs      = text "pattern binding"
+pprMatchContextNoun PatBindGuards   = text "pattern binding guards"
+pprMatchContextNoun LambdaExpr      = text "lambda abstraction"
+pprMatchContextNoun ProcExpr        = text "arrow abstraction"
+pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"
+                                      $$ pprAStmtContext ctxt
+pprMatchContextNoun PatSyn          = text "pattern synonym declaration"
+
+-----------------
+pprAStmtContext, pprStmtContext :: (Outputable id,
+                                    Outputable (NameOrRdrName id))
+                                => HsStmtContext id -> SDoc
+pprAStmtContext ctxt = article <+> pprStmtContext ctxt
+  where
+    pp_an = text "an"
+    pp_a  = text "a"
+    article = case ctxt of
+                  MDoExpr       -> pp_an
+                  GhciStmtCtxt  -> pp_an
+                  _             -> pp_a
+
+
+-----------------
+pprStmtContext GhciStmtCtxt    = text "interactive GHCi command"
+pprStmtContext DoExpr          = text "'do' block"
+pprStmtContext MDoExpr         = text "'mdo' block"
+pprStmtContext ArrowExpr       = text "'do' block in an arrow command"
+pprStmtContext ListComp        = text "list comprehension"
+pprStmtContext MonadComp       = text "monad comprehension"
+pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt
+
+-- Drop the inner contexts when reporting errors, else we get
+--     Unexpected transform statement
+--     in a transformed branch of
+--          transformed branch of
+--          transformed branch of monad comprehension
+pprStmtContext (ParStmtCtxt c) =
+  ifPprDebug (sep [text "parallel branch of", pprAStmtContext c])
+             (pprStmtContext c)
+pprStmtContext (TransStmtCtxt c) =
+  ifPprDebug (sep [text "transformed branch of", pprAStmtContext c])
+             (pprStmtContext c)
+
+instance (Outputable p, Outputable (NameOrRdrName p))
+      => Outputable (HsStmtContext p) where
+    ppr = pprStmtContext
+
+-- Used to generate the string for a *runtime* error message
+matchContextErrString :: Outputable id
+                      => HsMatchContext id -> SDoc
+matchContextErrString (FunRhs{mc_fun=L _ fun})   = text "function" <+> ppr fun
+matchContextErrString CaseAlt                    = text "case"
+matchContextErrString IfAlt                      = text "multi-way if"
+matchContextErrString PatBindRhs                 = text "pattern binding"
+matchContextErrString PatBindGuards              = text "pattern binding guards"
+matchContextErrString RecUpd                     = text "record update"
+matchContextErrString LambdaExpr                 = text "lambda"
+matchContextErrString ProcExpr                   = text "proc"
+matchContextErrString ThPatSplice                = panic "matchContextErrString"  -- Not used at runtime
+matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
+matchContextErrString PatSyn                     = panic "matchContextErrString"  -- Not used at runtime
+matchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)
+matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
+matchContextErrString (StmtCtxt (PatGuard _))      = text "pattern guard"
+matchContextErrString (StmtCtxt GhciStmtCtxt)      = text "interactive GHCi command"
+matchContextErrString (StmtCtxt DoExpr)            = text "'do' block"
+matchContextErrString (StmtCtxt ArrowExpr)         = text "'do' block"
+matchContextErrString (StmtCtxt MDoExpr)           = text "'mdo' block"
+matchContextErrString (StmtCtxt ListComp)          = text "list comprehension"
+matchContextErrString (StmtCtxt MonadComp)         = text "monad comprehension"
+
+pprMatchInCtxt :: (OutputableBndrId (GhcPass idR),
+                   -- TODO:AZ these constraints do not make sense
+                 Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),
+                 Outputable body)
+               => Match (GhcPass idR) body -> SDoc
+pprMatchInCtxt match  = hang (text "In" <+> pprMatchContext (m_ctxt match)
+                                        <> colon)
+                             4 (pprMatch match)
+
+pprStmtInCtxt :: (OutputableBndrId (GhcPass idL),
+                  OutputableBndrId (GhcPass idR),
+                  Outputable body)
+              => HsStmtContext (IdP (GhcPass idL))
+              -> StmtLR (GhcPass idL) (GhcPass idR) body
+              -> SDoc
+pprStmtInCtxt ctxt (LastStmt _ e _ _)
+  | isComprehensionContext ctxt      -- For [ e | .. ], do not mutter about "stmts"
+  = hang (text "In the expression:") 2 (ppr e)
+
+pprStmtInCtxt ctxt stmt
+  = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)
+       2 (ppr_stmt stmt)
+  where
+    -- For Group and Transform Stmts, don't print the nested stmts!
+    ppr_stmt (TransStmt { trS_by = by, trS_using = using
+                        , trS_form = form }) = pprTransStmt by using form
+    ppr_stmt stmt = pprStmt stmt
diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot
new file mode 100644
index 0000000000..8fd8f3857a
--- /dev/null
+++ b/compiler/GHC/Hs/Expr.hs-boot
@@ -0,0 +1,51 @@
+{-# LANGUAGE CPP, KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Hs.Expr where
+
+import SrcLoc     ( Located )
+import Outputable ( SDoc, Outputable )
+import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )
+import BasicTypes ( SpliceExplicitFlag(..))
+import GHC.Hs.Extension ( OutputableBndrId, GhcPass )
+
+type role HsExpr nominal
+type role HsCmd nominal
+type role MatchGroup nominal nominal
+type role GRHSs nominal nominal
+type role HsSplice nominal
+type role SyntaxExpr nominal
+data HsExpr (i :: *)
+data HsCmd  (i :: *)
+data HsSplice (i :: *)
+data MatchGroup (a :: *) (body :: *)
+data GRHSs (a :: *) (body :: *)
+data SyntaxExpr (i :: *)
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p)
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p)
+
+type LHsExpr a = Located (HsExpr a)
+
+pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
+
+pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
+
+pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
+
+pprSpliceDecl ::  (OutputableBndrId (GhcPass p))
+          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
+
+pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
+                                   OutputableBndrId (GhcPass p),
+                                   Outputable body)
+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
+
+pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
+           => MatchGroup (GhcPass idR) body -> SDoc
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
new file mode 100644
index 0000000000..f360e1c32e
--- /dev/null
+++ b/compiler/GHC/Hs/Extension.hs
@@ -0,0 +1,1168 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE EmptyDataDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+
+module GHC.Hs.Extension where
+
+-- This module captures the type families to precisely identify the extension
+-- points for GHC.Hs syntax
+
+import GhcPrelude
+
+import Data.Data hiding ( Fixity )
+import GHC.Hs.PlaceHolder
+import Name
+import RdrName
+import Var
+import Outputable
+import SrcLoc (Located)
+
+import Data.Kind
+
+{-
+Note [Trees that grow]
+~~~~~~~~~~~~~~~~~~~~~~
+
+See https://gitlab.haskell.org/ghc/ghc/wikis/implementing-trees-that-grow
+
+The hsSyn AST is reused across multiple compiler passes. We also have the
+Template Haskell AST, and the haskell-src-exts one (outside of GHC)
+
+Supporting multiple passes means the AST has various warts on it to cope with
+the specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',
+'SigPatOut' etc.
+
+The growable AST will allow each of these variants to be captured explicitly,
+such that they only exist in the given compiler pass AST, as selected by the
+type parameter to the AST.
+
+In addition it will allow tool writers to define their own extensions to capture
+additional information for the tool, in a natural way.
+
+A further goal is to provide a means to harmonise the Template Haskell and
+haskell-src-exts ASTs as well.
+
+-}
+
+-- | A placeholder type for TTG extension points that are not currently
+-- unused to represent any particular value.
+--
+-- This should not be confused with 'NoExtCon', which are found in unused
+-- extension /constructors/ and therefore should never be inhabited. In
+-- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of
+-- some constructor), so it must have an inhabitant to construct AST passes
+-- that manipulate fields with that extension point as their type.
+data NoExtField = NoExtField
+  deriving (Data,Eq,Ord)
+
+instance Outputable NoExtField where
+  ppr _ = text "NoExtField"
+
+-- | Used when constructing a term with an unused extension point.
+noExtField :: NoExtField
+noExtField = NoExtField
+
+-- | Used in TTG extension constructors that have yet to be extended with
+-- anything. If an extension constructor has 'NoExtCon' as its field, it is
+-- not intended to ever be constructed anywhere, and any function that consumes
+-- the extension constructor can eliminate it by way of 'noExtCon'.
+--
+-- This should not be confused with 'NoExtField', which are found in unused
+-- extension /points/ (not /constructors/) and therefore can be inhabited.
+
+-- See also [NoExtCon and strict fields].
+data NoExtCon
+  deriving (Data,Eq,Ord)
+
+instance Outputable NoExtCon where
+  ppr = noExtCon
+
+-- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.
+noExtCon :: NoExtCon -> a
+noExtCon x = case x of {}
+
+{-
+Note [NoExtCon and strict fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Currently, any unused TTG extension constructor will generally look like the
+following:
+
+  type instance XXHsDecl (GhcPass _) = NoExtCon
+  data HsDecl p
+    = ...
+    | XHsDecl (XXHsDecl p)
+
+This means that any function that wishes to consume an HsDecl will need to
+have a case for XHsDecl. This might look like this:
+
+  ex :: HsDecl GhcPs -> HsDecl GhcRn
+  ...
+  ex (XHsDecl nec) = noExtCon nec
+
+Ideally, we wouldn't need a case for XHsDecl at all (it /is/ supposed to be
+an unused extension constructor, after all). There is a way to achieve this
+on GHC 8.8 or later: make the field of XHsDecl strict:
+
+  data HsDecl p
+    = ...
+    | XHsDecl !(XXHsDecl p)
+
+If this is done, GHC's pattern-match coverage checker is clever enough to
+figure out that the XHsDecl case of `ex` is unreachable, so it can simply be
+omitted. (See Note [Extensions to GADTs Meet Their Match] in Check for more on
+how this works.)
+
+When GHC drops support for bootstrapping with GHC 8.6 and earlier, we can make
+the strict field changes described above and delete gobs of code involving
+`noExtCon`. Until then, it is necessary to use, so be aware of it when writing
+code that consumes unused extension constructors.
+-}
+
+-- | Used as a data type index for the hsSyn AST
+data GhcPass (c :: Pass)
+deriving instance Eq (GhcPass c)
+deriving instance Typeable c => Data (GhcPass c)
+
+data Pass = Parsed | Renamed | Typechecked
+         deriving (Data)
+
+-- Type synonyms as a shorthand for tagging
+type GhcPs   = GhcPass 'Parsed      -- Old 'RdrName' type param
+type GhcRn   = GhcPass 'Renamed     -- Old 'Name' type param
+type GhcTc   = GhcPass 'Typechecked -- Old 'Id' type para,
+type GhcTcId = GhcTc                -- Old 'TcId' type param
+
+-- | Maps the "normal" id type for a given pass
+type family IdP p
+type instance IdP GhcPs = RdrName
+type instance IdP GhcRn = Name
+type instance IdP GhcTc = Id
+
+type LIdP p = Located (IdP p)
+
+-- | Marks that a field uses the GhcRn variant even when the pass
+-- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because
+-- HsType GhcTc should never occur.
+type family NoGhcTc (p :: Type) where
+    -- this way, GHC can figure out that the result is a GhcPass
+  NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)
+  NoGhcTc other          = other
+
+type family NoGhcTcPass (p :: Pass) :: Pass where
+  NoGhcTcPass 'Typechecked = 'Renamed
+  NoGhcTcPass other        = other
+
+-- =====================================================================
+-- Type families for the HsBinds extension points
+
+-- HsLocalBindsLR type families
+type family XHsValBinds      x x'
+type family XHsIPBinds       x x'
+type family XEmptyLocalBinds x x'
+type family XXHsLocalBindsLR x x'
+
+type ForallXHsLocalBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =
+       ( c (XHsValBinds      x x')
+       , c (XHsIPBinds       x x')
+       , c (XEmptyLocalBinds x x')
+       , c (XXHsLocalBindsLR x x')
+       )
+
+-- ValBindsLR type families
+type family XValBinds    x x'
+type family XXValBindsLR x x'
+
+type ForallXValBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =
+       ( c (XValBinds    x x')
+       , c (XXValBindsLR x x')
+       )
+
+
+-- HsBindsLR type families
+type family XFunBind    x x'
+type family XPatBind    x x'
+type family XVarBind    x x'
+type family XAbsBinds   x x'
+type family XPatSynBind x x'
+type family XXHsBindsLR x x'
+
+type ForallXHsBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =
+       ( c (XFunBind    x x')
+       , c (XPatBind    x x')
+       , c (XVarBind    x x')
+       , c (XAbsBinds   x x')
+       , c (XPatSynBind x x')
+       , c (XXHsBindsLR x x')
+       )
+
+-- ABExport type families
+type family XABE x
+type family XXABExport x
+
+type ForallXABExport (c :: * -> Constraint) (x :: *) =
+       ( c (XABE       x)
+       , c (XXABExport x)
+       )
+
+-- PatSynBind type families
+type family XPSB x x'
+type family XXPatSynBind x x'
+
+type ForallXPatSynBind  (c :: * -> Constraint) (x :: *) (x' :: *) =
+       ( c (XPSB         x x')
+       , c (XXPatSynBind x x')
+       )
+
+-- HsIPBinds type families
+type family XIPBinds    x
+type family XXHsIPBinds x
+
+type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) =
+       ( c (XIPBinds    x)
+       , c (XXHsIPBinds x)
+       )
+
+-- IPBind type families
+type family XCIPBind x
+type family XXIPBind x
+
+type ForallXIPBind (c :: * -> Constraint) (x :: *) =
+       ( c (XCIPBind x)
+       , c (XXIPBind x)
+       )
+
+-- Sig type families
+type family XTypeSig          x
+type family XPatSynSig        x
+type family XClassOpSig       x
+type family XIdSig            x
+type family XFixSig           x
+type family XInlineSig        x
+type family XSpecSig          x
+type family XSpecInstSig      x
+type family XMinimalSig       x
+type family XSCCFunSig        x
+type family XCompleteMatchSig x
+type family XXSig             x
+
+type ForallXSig (c :: * -> Constraint) (x :: *) =
+       ( c (XTypeSig          x)
+       , c (XPatSynSig        x)
+       , c (XClassOpSig       x)
+       , c (XIdSig            x)
+       , c (XFixSig           x)
+       , c (XInlineSig        x)
+       , c (XSpecSig          x)
+       , c (XSpecInstSig      x)
+       , c (XMinimalSig       x)
+       , c (XSCCFunSig        x)
+       , c (XCompleteMatchSig x)
+       , c (XXSig             x)
+       )
+
+-- FixitySig type families
+type family XFixitySig          x
+type family XXFixitySig         x
+
+type ForallXFixitySig (c :: * -> Constraint) (x :: *) =
+       ( c (XFixitySig         x)
+       , c (XXFixitySig        x)
+       )
+
+-- =====================================================================
+-- Type families for the HsDecls extension points
+
+-- HsDecl type families
+type family XTyClD       x
+type family XInstD       x
+type family XDerivD      x
+type family XValD        x
+type family XSigD        x
+type family XDefD        x
+type family XForD        x
+type family XWarningD    x
+type family XAnnD        x
+type family XRuleD       x
+type family XSpliceD     x
+type family XDocD        x
+type family XRoleAnnotD  x
+type family XXHsDecl     x
+
+type ForallXHsDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XTyClD       x)
+       , c (XInstD       x)
+       , c (XDerivD      x)
+       , c (XValD        x)
+       , c (XSigD        x)
+       , c (XDefD        x)
+       , c (XForD        x)
+       , c (XWarningD    x)
+       , c (XAnnD        x)
+       , c (XRuleD       x)
+       , c (XSpliceD     x)
+       , c (XDocD        x)
+       , c (XRoleAnnotD  x)
+       , c (XXHsDecl    x)
+       )
+
+-- -------------------------------------
+-- HsGroup type families
+type family XCHsGroup      x
+type family XXHsGroup      x
+
+type ForallXHsGroup (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsGroup       x)
+       , c (XXHsGroup       x)
+       )
+
+-- -------------------------------------
+-- SpliceDecl type families
+type family XSpliceDecl       x
+type family XXSpliceDecl      x
+
+type ForallXSpliceDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XSpliceDecl        x)
+       , c (XXSpliceDecl       x)
+       )
+
+-- -------------------------------------
+-- TyClDecl type families
+type family XFamDecl       x
+type family XSynDecl       x
+type family XDataDecl      x
+type family XClassDecl     x
+type family XXTyClDecl     x
+
+type ForallXTyClDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XFamDecl       x)
+       , c (XSynDecl       x)
+       , c (XDataDecl      x)
+       , c (XClassDecl     x)
+       , c (XXTyClDecl     x)
+       )
+
+-- -------------------------------------
+-- TyClGroup type families
+type family XCTyClGroup      x
+type family XXTyClGroup      x
+
+type ForallXTyClGroup (c :: * -> Constraint) (x :: *) =
+       ( c (XCTyClGroup       x)
+       , c (XXTyClGroup       x)
+       )
+
+-- -------------------------------------
+-- FamilyResultSig type families
+type family XNoSig            x
+type family XCKindSig         x -- Clashes with XKindSig above
+type family XTyVarSig         x
+type family XXFamilyResultSig x
+
+type ForallXFamilyResultSig (c :: * -> Constraint) (x :: *) =
+       ( c (XNoSig            x)
+       , c (XCKindSig         x)
+       , c (XTyVarSig         x)
+       , c (XXFamilyResultSig x)
+       )
+
+-- -------------------------------------
+-- FamilyDecl type families
+type family XCFamilyDecl      x
+type family XXFamilyDecl      x
+
+type ForallXFamilyDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCFamilyDecl       x)
+       , c (XXFamilyDecl       x)
+       )
+
+-- -------------------------------------
+-- HsDataDefn type families
+type family XCHsDataDefn      x
+type family XXHsDataDefn      x
+
+type ForallXHsDataDefn (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsDataDefn       x)
+       , c (XXHsDataDefn       x)
+       )
+
+-- -------------------------------------
+-- HsDerivingClause type families
+type family XCHsDerivingClause      x
+type family XXHsDerivingClause      x
+
+type ForallXHsDerivingClause (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsDerivingClause       x)
+       , c (XXHsDerivingClause       x)
+       )
+
+-- -------------------------------------
+-- ConDecl type families
+type family XConDeclGADT   x
+type family XConDeclH98    x
+type family XXConDecl      x
+
+type ForallXConDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XConDeclGADT    x)
+       , c (XConDeclH98     x)
+       , c (XXConDecl       x)
+       )
+
+-- -------------------------------------
+-- FamEqn type families
+type family XCFamEqn      x r
+type family XXFamEqn      x r
+
+type ForallXFamEqn (c :: * -> Constraint) (x :: *) (r :: *) =
+       ( c (XCFamEqn       x r)
+       , c (XXFamEqn       x r)
+       )
+
+-- -------------------------------------
+-- ClsInstDecl type families
+type family XCClsInstDecl      x
+type family XXClsInstDecl      x
+
+type ForallXClsInstDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCClsInstDecl       x)
+       , c (XXClsInstDecl       x)
+       )
+
+-- -------------------------------------
+-- ClsInstDecl type families
+type family XClsInstD      x
+type family XDataFamInstD  x
+type family XTyFamInstD    x
+type family XXInstDecl     x
+
+type ForallXInstDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XClsInstD       x)
+       , c (XDataFamInstD   x)
+       , c (XTyFamInstD     x)
+       , c (XXInstDecl      x)
+       )
+
+-- -------------------------------------
+-- DerivDecl type families
+type family XCDerivDecl      x
+type family XXDerivDecl      x
+
+type ForallXDerivDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCDerivDecl       x)
+       , c (XXDerivDecl       x)
+       )
+
+-- -------------------------------------
+-- DerivStrategy type family
+type family XViaStrategy x
+
+-- -------------------------------------
+-- DefaultDecl type families
+type family XCDefaultDecl      x
+type family XXDefaultDecl      x
+
+type ForallXDefaultDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCDefaultDecl       x)
+       , c (XXDefaultDecl       x)
+       )
+
+-- -------------------------------------
+-- DefaultDecl type families
+type family XForeignImport     x
+type family XForeignExport     x
+type family XXForeignDecl      x
+
+type ForallXForeignDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XForeignImport      x)
+       , c (XForeignExport      x)
+       , c (XXForeignDecl       x)
+       )
+
+-- -------------------------------------
+-- RuleDecls type families
+type family XCRuleDecls      x
+type family XXRuleDecls      x
+
+type ForallXRuleDecls (c :: * -> Constraint) (x :: *) =
+       ( c (XCRuleDecls       x)
+       , c (XXRuleDecls       x)
+       )
+
+
+-- -------------------------------------
+-- RuleDecl type families
+type family XHsRule          x
+type family XXRuleDecl       x
+
+type ForallXRuleDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XHsRule           x)
+       , c (XXRuleDecl        x)
+       )
+
+-- -------------------------------------
+-- RuleBndr type families
+type family XCRuleBndr      x
+type family XRuleBndrSig    x
+type family XXRuleBndr      x
+
+type ForallXRuleBndr (c :: * -> Constraint) (x :: *) =
+       ( c (XCRuleBndr       x)
+       , c (XRuleBndrSig     x)
+       , c (XXRuleBndr       x)
+       )
+
+-- -------------------------------------
+-- WarnDecls type families
+type family XWarnings        x
+type family XXWarnDecls      x
+
+type ForallXWarnDecls (c :: * -> Constraint) (x :: *) =
+       ( c (XWarnings        x)
+       , c (XXWarnDecls      x)
+       )
+
+-- -------------------------------------
+-- AnnDecl type families
+type family XWarning        x
+type family XXWarnDecl      x
+
+type ForallXWarnDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XWarning        x)
+       , c (XXWarnDecl      x)
+       )
+
+-- -------------------------------------
+-- AnnDecl type families
+type family XHsAnnotation  x
+type family XXAnnDecl      x
+
+type ForallXAnnDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XHsAnnotation  x)
+       , c (XXAnnDecl      x)
+       )
+
+-- -------------------------------------
+-- RoleAnnotDecl type families
+type family XCRoleAnnotDecl  x
+type family XXRoleAnnotDecl  x
+
+type ForallXRoleAnnotDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCRoleAnnotDecl  x)
+       , c (XXRoleAnnotDecl  x)
+       )
+
+-- =====================================================================
+-- Type families for the HsExpr extension points
+
+type family XVar            x
+type family XUnboundVar     x
+type family XConLikeOut     x
+type family XRecFld         x
+type family XOverLabel      x
+type family XIPVar          x
+type family XOverLitE       x
+type family XLitE           x
+type family XLam            x
+type family XLamCase        x
+type family XApp            x
+type family XAppTypeE       x
+type family XOpApp          x
+type family XNegApp         x
+type family XPar            x
+type family XSectionL       x
+type family XSectionR       x
+type family XExplicitTuple  x
+type family XExplicitSum    x
+type family XCase           x
+type family XIf             x
+type family XMultiIf        x
+type family XLet            x
+type family XDo             x
+type family XExplicitList   x
+type family XRecordCon      x
+type family XRecordUpd      x
+type family XExprWithTySig  x
+type family XArithSeq       x
+type family XSCC            x
+type family XCoreAnn        x
+type family XBracket        x
+type family XRnBracketOut   x
+type family XTcBracketOut   x
+type family XSpliceE        x
+type family XProc           x
+type family XStatic         x
+type family XTick           x
+type family XBinTick        x
+type family XTickPragma     x
+type family XWrap           x
+type family XXExpr          x
+
+type ForallXExpr (c :: * -> Constraint) (x :: *) =
+       ( c (XVar            x)
+       , c (XUnboundVar     x)
+       , c (XConLikeOut     x)
+       , c (XRecFld         x)
+       , c (XOverLabel      x)
+       , c (XIPVar          x)
+       , c (XOverLitE       x)
+       , c (XLitE           x)
+       , c (XLam            x)
+       , c (XLamCase        x)
+       , c (XApp            x)
+       , c (XAppTypeE       x)
+       , c (XOpApp          x)
+       , c (XNegApp         x)
+       , c (XPar            x)
+       , c (XSectionL       x)
+       , c (XSectionR       x)
+       , c (XExplicitTuple  x)
+       , c (XExplicitSum    x)
+       , c (XCase           x)
+       , c (XIf             x)
+       , c (XMultiIf        x)
+       , c (XLet            x)
+       , c (XDo             x)
+       , c (XExplicitList   x)
+       , c (XRecordCon      x)
+       , c (XRecordUpd      x)
+       , c (XExprWithTySig  x)
+       , c (XArithSeq       x)
+       , c (XSCC            x)
+       , c (XCoreAnn        x)
+       , c (XBracket        x)
+       , c (XRnBracketOut   x)
+       , c (XTcBracketOut   x)
+       , c (XSpliceE        x)
+       , c (XProc           x)
+       , c (XStatic         x)
+       , c (XTick           x)
+       , c (XBinTick        x)
+       , c (XTickPragma     x)
+       , c (XWrap           x)
+       , c (XXExpr          x)
+       )
+-- ---------------------------------------------------------------------
+
+type family XUnambiguous        x
+type family XAmbiguous          x
+type family XXAmbiguousFieldOcc x
+
+type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =
+       ( c (XUnambiguous        x)
+       , c (XAmbiguous          x)
+       , c (XXAmbiguousFieldOcc x)
+       )
+
+-- ----------------------------------------------------------------------
+
+type family XPresent  x
+type family XMissing  x
+type family XXTupArg  x
+
+type ForallXTupArg (c :: * -> Constraint) (x :: *) =
+       ( c (XPresent x)
+       , c (XMissing x)
+       , c (XXTupArg x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XTypedSplice   x
+type family XUntypedSplice x
+type family XQuasiQuote    x
+type family XSpliced       x
+type family XXSplice       x
+
+type ForallXSplice (c :: * -> Constraint) (x :: *) =
+       ( c (XTypedSplice   x)
+       , c (XUntypedSplice x)
+       , c (XQuasiQuote    x)
+       , c (XSpliced       x)
+       , c (XXSplice       x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XExpBr      x
+type family XPatBr      x
+type family XDecBrL     x
+type family XDecBrG     x
+type family XTypBr      x
+type family XVarBr      x
+type family XTExpBr     x
+type family XXBracket   x
+
+type ForallXBracket (c :: * -> Constraint) (x :: *) =
+       ( c (XExpBr      x)
+       , c (XPatBr      x)
+       , c (XDecBrL     x)
+       , c (XDecBrG     x)
+       , c (XTypBr      x)
+       , c (XVarBr      x)
+       , c (XTExpBr     x)
+       , c (XXBracket   x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XCmdTop  x
+type family XXCmdTop x
+
+type ForallXCmdTop (c :: * -> Constraint) (x :: *) =
+       ( c (XCmdTop  x)
+       , c (XXCmdTop x)
+       )
+
+-- -------------------------------------
+
+type family XMG           x b
+type family XXMatchGroup  x b
+
+type ForallXMatchGroup (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XMG          x b)
+       , c (XXMatchGroup x b)
+       )
+
+-- -------------------------------------
+
+type family XCMatch  x b
+type family XXMatch  x b
+
+type ForallXMatch (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCMatch  x b)
+       , c (XXMatch  x b)
+       )
+
+-- -------------------------------------
+
+type family XCGRHSs  x b
+type family XXGRHSs  x b
+
+type ForallXGRHSs (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCGRHSs  x b)
+       , c (XXGRHSs  x b)
+       )
+
+-- -------------------------------------
+
+type family XCGRHS  x b
+type family XXGRHS  x b
+
+type ForallXGRHS (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCGRHS  x b)
+       , c (XXGRHS  x b)
+       )
+
+-- -------------------------------------
+
+type family XLastStmt        x x' b
+type family XBindStmt        x x' b
+type family XApplicativeStmt x x' b
+type family XBodyStmt        x x' b
+type family XLetStmt         x x' b
+type family XParStmt         x x' b
+type family XTransStmt       x x' b
+type family XRecStmt         x x' b
+type family XXStmtLR         x x' b
+
+type ForallXStmtLR (c :: * -> Constraint) (x :: *)  (x' :: *) (b :: *) =
+       ( c (XLastStmt         x x' b)
+       , c (XBindStmt         x x' b)
+       , c (XApplicativeStmt  x x' b)
+       , c (XBodyStmt         x x' b)
+       , c (XLetStmt          x x' b)
+       , c (XParStmt          x x' b)
+       , c (XTransStmt        x x' b)
+       , c (XRecStmt          x x' b)
+       , c (XXStmtLR          x x' b)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XCmdArrApp  x
+type family XCmdArrForm x
+type family XCmdApp     x
+type family XCmdLam     x
+type family XCmdPar     x
+type family XCmdCase    x
+type family XCmdIf      x
+type family XCmdLet     x
+type family XCmdDo      x
+type family XCmdWrap    x
+type family XXCmd       x
+
+type ForallXCmd (c :: * -> Constraint) (x :: *) =
+       ( c (XCmdArrApp  x)
+       , c (XCmdArrForm x)
+       , c (XCmdApp     x)
+       , c (XCmdLam     x)
+       , c (XCmdPar     x)
+       , c (XCmdCase    x)
+       , c (XCmdIf      x)
+       , c (XCmdLet     x)
+       , c (XCmdDo      x)
+       , c (XCmdWrap    x)
+       , c (XXCmd       x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XParStmtBlock  x x'
+type family XXParStmtBlock x x'
+
+type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =
+       ( c (XParStmtBlock  x x')
+       , c (XXParStmtBlock x x')
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XApplicativeArgOne   x
+type family XApplicativeArgMany  x
+type family XXApplicativeArg     x
+
+type ForallXApplicativeArg (c :: * -> Constraint) (x :: *) =
+       ( c (XApplicativeArgOne   x)
+       , c (XApplicativeArgMany  x)
+       , c (XXApplicativeArg     x)
+       )
+
+-- =====================================================================
+-- Type families for the HsImpExp extension points
+
+-- TODO
+
+-- =====================================================================
+-- Type families for the HsLit extension points
+
+-- We define a type family for each extension point. This is based on prepending
+-- 'X' to the constructor name, for ease of reference.
+type family XHsChar x
+type family XHsCharPrim x
+type family XHsString x
+type family XHsStringPrim x
+type family XHsInt x
+type family XHsIntPrim x
+type family XHsWordPrim x
+type family XHsInt64Prim x
+type family XHsWord64Prim x
+type family XHsInteger x
+type family XHsRat x
+type family XHsFloatPrim x
+type family XHsDoublePrim x
+type family XXLit x
+
+-- | Helper to apply a constraint to all extension points. It has one
+-- entry per extension point type family.
+type ForallXHsLit (c :: * -> Constraint) (x :: *) =
+  ( c (XHsChar       x)
+  , c (XHsCharPrim   x)
+  , c (XHsDoublePrim x)
+  , c (XHsFloatPrim  x)
+  , c (XHsInt        x)
+  , c (XHsInt64Prim  x)
+  , c (XHsIntPrim    x)
+  , c (XHsInteger    x)
+  , c (XHsRat        x)
+  , c (XHsString     x)
+  , c (XHsStringPrim x)
+  , c (XHsWord64Prim x)
+  , c (XHsWordPrim   x)
+  , c (XXLit         x)
+  )
+
+type family XOverLit  x
+type family XXOverLit x
+
+type ForallXOverLit (c :: * -> Constraint) (x :: *) =
+       ( c (XOverLit  x)
+       , c (XXOverLit x)
+       )
+
+-- =====================================================================
+-- Type families for the HsPat extension points
+
+type family XWildPat   x
+type family XVarPat    x
+type family XLazyPat   x
+type family XAsPat     x
+type family XParPat    x
+type family XBangPat   x
+type family XListPat   x
+type family XTuplePat  x
+type family XSumPat    x
+type family XConPat    x
+type family XViewPat   x
+type family XSplicePat x
+type family XLitPat    x
+type family XNPat      x
+type family XNPlusKPat x
+type family XSigPat    x
+type family XCoPat     x
+type family XXPat      x
+
+
+type ForallXPat (c :: * -> Constraint) (x :: *) =
+       ( c (XWildPat   x)
+       , c (XVarPat    x)
+       , c (XLazyPat   x)
+       , c (XAsPat     x)
+       , c (XParPat    x)
+       , c (XBangPat   x)
+       , c (XListPat   x)
+       , c (XTuplePat  x)
+       , c (XSumPat    x)
+       , c (XViewPat   x)
+       , c (XSplicePat x)
+       , c (XLitPat    x)
+       , c (XNPat      x)
+       , c (XNPlusKPat x)
+       , c (XSigPat    x)
+       , c (XCoPat     x)
+       , c (XXPat      x)
+       )
+
+-- =====================================================================
+-- Type families for the HsTypes type families
+
+type family XHsQTvs       x
+type family XXLHsQTyVars  x
+
+type ForallXLHsQTyVars (c :: * -> Constraint) (x :: *) =
+       ( c (XHsQTvs       x)
+       , c (XXLHsQTyVars  x)
+       )
+
+-- -------------------------------------
+
+type family XHsIB              x b
+type family XXHsImplicitBndrs  x b
+
+type ForallXHsImplicitBndrs (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XHsIB              x b)
+       , c (XXHsImplicitBndrs  x b)
+       )
+
+-- -------------------------------------
+
+type family XHsWC              x b
+type family XXHsWildCardBndrs  x b
+
+type ForallXHsWildCardBndrs(c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XHsWC              x b)
+       , c (XXHsWildCardBndrs  x b)
+       )
+
+-- -------------------------------------
+
+type family XForAllTy        x
+type family XQualTy          x
+type family XTyVar           x
+type family XAppTy           x
+type family XAppKindTy       x
+type family XFunTy           x
+type family XListTy          x
+type family XTupleTy         x
+type family XSumTy           x
+type family XOpTy            x
+type family XParTy           x
+type family XIParamTy        x
+type family XStarTy          x
+type family XKindSig         x
+type family XSpliceTy        x
+type family XDocTy           x
+type family XBangTy          x
+type family XRecTy           x
+type family XExplicitListTy  x
+type family XExplicitTupleTy x
+type family XTyLit           x
+type family XWildCardTy      x
+type family XXType           x
+
+-- | Helper to apply a constraint to all extension points. It has one
+-- entry per extension point type family.
+type ForallXType (c :: * -> Constraint) (x :: *) =
+       ( c (XForAllTy        x)
+       , c (XQualTy          x)
+       , c (XTyVar           x)
+       , c (XAppTy           x)
+       , c (XAppKindTy       x)
+       , c (XFunTy           x)
+       , c (XListTy          x)
+       , c (XTupleTy         x)
+       , c (XSumTy           x)
+       , c (XOpTy            x)
+       , c (XParTy           x)
+       , c (XIParamTy        x)
+       , c (XStarTy          x)
+       , c (XKindSig         x)
+       , c (XSpliceTy        x)
+       , c (XDocTy           x)
+       , c (XBangTy          x)
+       , c (XRecTy           x)
+       , c (XExplicitListTy  x)
+       , c (XExplicitTupleTy x)
+       , c (XTyLit           x)
+       , c (XWildCardTy      x)
+       , c (XXType           x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XUserTyVar   x
+type family XKindedTyVar x
+type family XXTyVarBndr  x
+
+type ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =
+       ( c (XUserTyVar      x)
+       , c (XKindedTyVar    x)
+       , c (XXTyVarBndr     x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XConDeclField  x
+type family XXConDeclField x
+
+type ForallXConDeclField (c :: * -> Constraint) (x :: *) =
+       ( c (XConDeclField  x)
+       , c (XXConDeclField x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XCFieldOcc x
+type family XXFieldOcc x
+
+type ForallXFieldOcc (c :: * -> Constraint) (x :: *) =
+       ( c (XCFieldOcc x)
+       , c (XXFieldOcc x)
+       )
+
+
+-- =====================================================================
+-- Type families for the HsImpExp type families
+
+type family XCImportDecl       x
+type family XXImportDecl       x
+
+type ForallXImportDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCImportDecl x)
+       , c (XXImportDecl x)
+       )
+
+-- -------------------------------------
+
+type family XIEVar             x
+type family XIEThingAbs        x
+type family XIEThingAll        x
+type family XIEThingWith       x
+type family XIEModuleContents  x
+type family XIEGroup           x
+type family XIEDoc             x
+type family XIEDocNamed        x
+type family XXIE               x
+
+type ForallXIE (c :: * -> Constraint) (x :: *) =
+       ( c (XIEVar x)
+       , c (XIEThingAbs        x)
+       , c (XIEThingAll        x)
+       , c (XIEThingWith       x)
+       , c (XIEModuleContents  x)
+       , c (XIEGroup           x)
+       , c (XIEDoc             x)
+       , c (XIEDocNamed        x)
+       , c (XXIE               x)
+       )
+
+-- -------------------------------------
+
+
+-- =====================================================================
+-- End of Type family definitions
+-- =====================================================================
+
+-- ----------------------------------------------------------------------
+-- | Conversion of annotations from one type index to another. This is required
+-- where the AST is converted from one pass to another, and the extension values
+-- need to be brought along if possible. So for example a 'SourceText' is
+-- converted via 'id', but needs a type signature to keep the type checker
+-- happy.
+class Convertable a b  | a -> b where
+  convert :: a -> b
+
+instance Convertable a a where
+  convert = id
+
+-- | A constraint capturing all the extension points that can be converted via
+-- @instance Convertable a a@
+type ConvertIdX a b =
+  (XHsDoublePrim a ~ XHsDoublePrim b,
+   XHsFloatPrim a ~ XHsFloatPrim b,
+   XHsRat a ~ XHsRat b,
+   XHsInteger a ~ XHsInteger b,
+   XHsWord64Prim a ~ XHsWord64Prim b,
+   XHsInt64Prim a ~ XHsInt64Prim b,
+   XHsWordPrim a ~ XHsWordPrim b,
+   XHsIntPrim a ~ XHsIntPrim b,
+   XHsInt a ~ XHsInt b,
+   XHsStringPrim a ~ XHsStringPrim b,
+   XHsString a ~ XHsString b,
+   XHsCharPrim a ~ XHsCharPrim b,
+   XHsChar a ~ XHsChar b,
+   XXLit a ~ XXLit b)
+
+-- ----------------------------------------------------------------------
+
+-- Note [OutputableX]
+-- ~~~~~~~~~~~~~~~~~~
+--
+-- is required because the type family resolution
+-- process cannot determine that all cases are handled for a `GhcPass p`
+-- case where the cases are listed separately.
+--
+-- So
+--
+--   type instance XXHsIPBinds    (GhcPass p) = NoExtCon
+--
+-- will correctly deduce Outputable for (GhcPass p), but
+--
+--   type instance XIPBinds       GhcPs = NoExt
+--   type instance XIPBinds       GhcRn = NoExt
+--   type instance XIPBinds       GhcTc = TcEvBinds
+--
+-- will not.
+
+
+-- | Provide a summary constraint that gives all am Outputable constraint to
+-- extension points needing one
+type OutputableX p = -- See Note [OutputableX]
+  ( Outputable (XIPBinds    p)
+  , Outputable (XViaStrategy p)
+  , Outputable (XViaStrategy GhcRn)
+  )
+-- TODO: Should OutputableX be included in OutputableBndrId?
+
+-- ----------------------------------------------------------------------
+
+-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
+-- the @id@ and the 'NameOrRdrName' type for it
+type OutputableBndrId id =
+  ( OutputableBndr (NameOrRdrName (IdP id))
+  , OutputableBndr (IdP id)
+  , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id)))
+  , OutputableBndr (IdP (NoGhcTc id))
+  , NoGhcTc id ~ NoGhcTc (NoGhcTc id)
+  , OutputableX id
+  , OutputableX (NoGhcTc id)
+  )
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
new file mode 100644
index 0000000000..56d1691ac4
--- /dev/null
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -0,0 +1,366 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+
+GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+
+module GHC.Hs.ImpExp where
+
+import GhcPrelude
+
+import Module           ( ModuleName )
+import GHC.Hs.Doc       ( HsDocString )
+import OccName          ( HasOccName(..), isTcOcc, isSymOcc )
+import BasicTypes       ( SourceText(..), StringLiteral(..), pprWithSourceText )
+import FieldLabel       ( FieldLbl(..) )
+
+import Outputable
+import FastString
+import SrcLoc
+import GHC.Hs.Extension
+
+import Data.Data
+import Data.Maybe
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Import and export declaration lists}
+*                                                                      *
+************************************************************************
+
+One per \tr{import} declaration in a module.
+-}
+
+-- | Located Import Declaration
+type LImportDecl pass = Located (ImportDecl pass)
+        -- ^ When in a list this may have
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | If/how an import is 'qualified'.
+data ImportDeclQualifiedStyle
+  = QualifiedPre  -- ^ 'qualified' appears in prepositive position.
+  | QualifiedPost -- ^ 'qualified' appears in postpositive position.
+  | NotQualified  -- ^ Not qualified.
+  deriving (Eq, Data)
+
+-- | Given two possible located 'qualified' tokens, compute a style
+-- (in a conforming Haskell program only one of the two can be not
+-- 'Nothing'). This is called from 'Parser.y'.
+importDeclQualifiedStyle :: Maybe (Located a)
+                         -> Maybe (Located a)
+                         -> ImportDeclQualifiedStyle
+importDeclQualifiedStyle mPre mPost =
+  if isJust mPre then QualifiedPre
+  else if isJust mPost then QualifiedPost else NotQualified
+
+-- | Convenience function to answer the question if an import decl. is
+-- qualified.
+isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool
+isImportDeclQualified NotQualified = False
+isImportDeclQualified _ = True
+
+-- | Import Declaration
+--
+-- A single Haskell @import@ declaration.
+data ImportDecl pass
+  = ImportDecl {
+      ideclExt       :: XCImportDecl pass,
+      ideclSourceSrc :: SourceText,
+                                 -- Note [Pragma source text] in BasicTypes
+      ideclName      :: Located ModuleName, -- ^ Module name.
+      ideclPkgQual   :: Maybe StringLiteral,  -- ^ Package qualifier.
+      ideclSource    :: Bool,          -- ^ True <=> {-\# SOURCE \#-} import
+      ideclSafe      :: Bool,          -- ^ True => safe import
+      ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.
+      ideclImplicit  :: Bool,          -- ^ True => implicit import (of Prelude)
+      ideclAs        :: Maybe (Located ModuleName),  -- ^ as Module
+      ideclHiding    :: Maybe (Bool, Located [LIE pass])
+                                       -- ^ (True => hiding, names)
+    }
+  | XImportDecl (XXImportDecl pass)
+     -- ^
+     --  'ApiAnnotation.AnnKeywordId's
+     --
+     --  - 'ApiAnnotation.AnnImport'
+     --
+     --  - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource
+     --
+     --  - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',
+     --    'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',
+     --    'ApiAnnotation.AnnVal'
+     --
+     --  - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',
+     --    'ApiAnnotation.AnnClose' attached
+     --     to location in ideclHiding
+
+     -- For details on above see note [Api annotations] in ApiAnnotation
+
+type instance XCImportDecl  (GhcPass _) = NoExtField
+type instance XXImportDecl  (GhcPass _) = NoExtCon
+
+simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)
+simpleImportDecl mn = ImportDecl {
+      ideclExt       = noExtField,
+      ideclSourceSrc = NoSourceText,
+      ideclName      = noLoc mn,
+      ideclPkgQual   = Nothing,
+      ideclSource    = False,
+      ideclSafe      = False,
+      ideclImplicit  = False,
+      ideclQualified = NotQualified,
+      ideclAs        = Nothing,
+      ideclHiding    = Nothing
+    }
+
+instance (p ~ GhcPass pass,OutputableBndrId p)
+       => Outputable (ImportDecl p) where
+    ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
+                    , ideclPkgQual = pkg
+                    , ideclSource = from, ideclSafe = safe
+                    , ideclQualified = qual, ideclImplicit = implicit
+                    , ideclAs = as, ideclHiding = spec })
+      = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
+                    pp_qual qual False, pp_pkg pkg, ppr mod', pp_qual qual True, pp_as as])
+             4 (pp_spec spec)
+      where
+        pp_implicit False = empty
+        pp_implicit True = ptext (sLit ("(implicit)"))
+
+        pp_pkg Nothing                    = empty
+        pp_pkg (Just (StringLiteral st p))
+          = pprWithSourceText st (doubleQuotes (ftext p))
+
+        pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position.
+        pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position.
+        pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position.
+        pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position.
+        pp_qual NotQualified _ = empty
+
+        pp_safe False   = empty
+        pp_safe True    = text "safe"
+
+        pp_as Nothing   = empty
+        pp_as (Just a)  = text "as" <+> ppr a
+
+        ppr_imp True  = case mSrcText of
+                          NoSourceText   -> text "{-# SOURCE #-}"
+                          SourceText src -> text src <+> text "#-}"
+        ppr_imp False = empty
+
+        pp_spec Nothing             = empty
+        pp_spec (Just (False, (L _ ies))) = ppr_ies ies
+        pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies
+
+        ppr_ies []  = text "()"
+        ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
+    ppr (XImportDecl x) = ppr x
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Imported and exported entities}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A name in an import or export specification which may have adornments. Used
+-- primarily for accurate pretty printing of ParsedSource, and API Annotation
+-- placement.
+data IEWrappedName name
+  = IEName    (Located name)  -- ^ no extra
+  | IEPattern (Located name)  -- ^ pattern X
+  | IEType    (Located name)  -- ^ type (:+:)
+  deriving (Eq,Data)
+
+-- | Located name with possible adornment
+-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
+--         'ApiAnnotation.AnnPattern'
+type LIEWrappedName name = Located (IEWrappedName name)
+-- For details on above see note [Api annotations] in ApiAnnotation
+
+
+-- | Located Import or Export
+type LIE pass = Located (IE pass)
+        -- ^ When in a list this may have
+        --
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Imported or exported entity.
+data IE pass
+  = IEVar       (XIEVar pass) (LIEWrappedName (IdP pass))
+        -- ^ Imported or Exported Variable
+
+  | IEThingAbs  (XIEThingAbs pass) (LIEWrappedName (IdP pass))
+        -- ^ Imported or exported Thing with Absent list
+        --
+        -- The thing is a Class/Type (can't tell)
+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
+        --             'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- See Note [Located RdrNames] in GHC.Hs.Expr
+  | IEThingAll  (XIEThingAll pass) (LIEWrappedName (IdP pass))
+        -- ^ Imported or exported Thing with All imported or exported
+        --
+        -- The thing is a Class/Type and the All refers to methods/constructors
+        --
+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
+        --       'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',
+        --                                 'ApiAnnotation.AnnType'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- See Note [Located RdrNames] in GHC.Hs.Expr
+
+  | IEThingWith (XIEThingWith pass)
+                (LIEWrappedName (IdP pass))
+                IEWildcard
+                [LIEWrappedName (IdP pass)]
+                [Located (FieldLbl (IdP pass))]
+        -- ^ Imported or exported Thing With given imported or exported
+        --
+        -- The thing is a Class/Type and the imported or exported things are
+        -- methods/constructors and record fields; see Note [IEThingWith]
+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
+        --                                   'ApiAnnotation.AnnClose',
+        --                                   'ApiAnnotation.AnnComma',
+        --                                   'ApiAnnotation.AnnType'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | IEModuleContents  (XIEModuleContents pass) (Located ModuleName)
+        -- ^ Imported or exported module contents
+        --
+        -- (Export Only)
+        --
+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+  | IEGroup             (XIEGroup pass) Int HsDocString -- ^ Doc section heading
+  | IEDoc               (XIEDoc pass) HsDocString       -- ^ Some documentation
+  | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc
+  | XIE (XXIE pass)
+
+type instance XIEVar             (GhcPass _) = NoExtField
+type instance XIEThingAbs        (GhcPass _) = NoExtField
+type instance XIEThingAll        (GhcPass _) = NoExtField
+type instance XIEThingWith       (GhcPass _) = NoExtField
+type instance XIEModuleContents  (GhcPass _) = NoExtField
+type instance XIEGroup           (GhcPass _) = NoExtField
+type instance XIEDoc             (GhcPass _) = NoExtField
+type instance XIEDocNamed        (GhcPass _) = NoExtField
+type instance XXIE               (GhcPass _) = NoExtCon
+
+-- | Imported or Exported Wildcard
+data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
+
+{-
+Note [IEThingWith]
+~~~~~~~~~~~~~~~~~~
+
+A definition like
+
+    module M ( T(MkT, x) ) where
+      data T = MkT { x :: Int }
+
+gives rise to
+
+    IEThingWith T [MkT] [FieldLabel "x" False x)]           (without DuplicateRecordFields)
+    IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)]   (with    DuplicateRecordFields)
+
+See Note [Representing fields in AvailInfo] in Avail for more details.
+-}
+
+ieName :: IE (GhcPass p) -> IdP (GhcPass p)
+ieName (IEVar _ (L _ n))              = ieWrappedName n
+ieName (IEThingAbs  _ (L _ n))        = ieWrappedName n
+ieName (IEThingWith _ (L _ n) _ _ _)  = ieWrappedName n
+ieName (IEThingAll  _ (L _ n))        = ieWrappedName n
+ieName _ = panic "ieName failed pattern match!"
+
+ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)]
+ieNames (IEVar       _ (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAbs  _ (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAll  _ (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n
+                                       : map (ieWrappedName . unLoc) ns
+ieNames (IEModuleContents {})     = []
+ieNames (IEGroup          {})     = []
+ieNames (IEDoc            {})     = []
+ieNames (IEDocNamed       {})     = []
+ieNames (XIE nec) = noExtCon nec
+
+ieWrappedName :: IEWrappedName name -> name
+ieWrappedName (IEName    (L _ n)) = n
+ieWrappedName (IEPattern (L _ n)) = n
+ieWrappedName (IEType    (L _ n)) = n
+
+lieWrappedName :: LIEWrappedName name -> name
+lieWrappedName (L _ n) = ieWrappedName n
+
+ieLWrappedName :: LIEWrappedName name -> Located name
+ieLWrappedName (L l n) = L l (ieWrappedName n)
+
+replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2
+replaceWrappedName (IEName    (L l _)) n = IEName    (L l n)
+replaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)
+replaceWrappedName (IEType    (L l _)) n = IEType    (L l n)
+
+replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
+replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
+
+instance (p ~ GhcPass pass,OutputableBndrId p) => Outputable (IE p) where
+    ppr (IEVar       _     var) = ppr (unLoc var)
+    ppr (IEThingAbs  _   thing) = ppr (unLoc thing)
+    ppr (IEThingAll  _   thing) = hcat [ppr (unLoc thing), text "(..)"]
+    ppr (IEThingWith _ thing wc withs flds)
+        = ppr (unLoc thing) <> parens (fsep (punctuate comma
+                                              (ppWiths ++
+                                              map (ppr . flLabel . unLoc) flds)))
+      where
+        ppWiths =
+          case wc of
+              NoIEWildcard ->
+                map (ppr . unLoc) withs
+              IEWildcard pos ->
+                let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
+                in bs ++ [text ".."] ++ as
+    ppr (IEModuleContents _ mod')
+        = text "module" <+> ppr mod'
+    ppr (IEGroup _ n _)           = text ("<IEGroup: " ++ show n ++ ">")
+    ppr (IEDoc _ doc)             = ppr doc
+    ppr (IEDocNamed _ string)     = text ("<IEDocNamed: " ++ string ++ ">")
+    ppr (XIE x) = ppr x
+
+instance (HasOccName name) => HasOccName (IEWrappedName name) where
+  occName w = occName (ieWrappedName w)
+
+instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where
+  pprBndr bs   w = pprBndr bs   (ieWrappedName w)
+  pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
+  pprInfixOcc  w = pprInfixOcc  (ieWrappedName w)
+
+instance (OutputableBndr name) => Outputable (IEWrappedName name) where
+  ppr (IEName    n) = pprPrefixOcc (unLoc n)
+  ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)
+  ppr (IEType    n) = text "type"    <+> pprPrefixOcc (unLoc n)
+
+pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
+pprImpExp name = type_pref <+> pprPrefixOcc name
+    where
+    occ = occName name
+    type_pref | isTcOcc occ && isSymOcc occ = text "type"
+              | otherwise                   = empty
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
new file mode 100644
index 0000000000..d55e20c2e7
--- /dev/null
+++ b/compiler/GHC/Hs/Instances.hs
@@ -0,0 +1,420 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module GHC.Hs.Instances where
+
+-- This module defines the Data instances for the hsSyn AST.
+
+-- It happens here to avoid massive constraint types on the AST with concomitant
+-- slow GHC bootstrap times.
+
+-- UndecidableInstances ?
+
+import Data.Data hiding ( Fixity )
+
+import GhcPrelude
+import GHC.Hs.Extension
+import GHC.Hs.Binds
+import GHC.Hs.Decls
+import GHC.Hs.Expr
+import GHC.Hs.Lit
+import GHC.Hs.Types
+import GHC.Hs.Pat
+import GHC.Hs.ImpExp
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs-----------------------------------------
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Binds ----------------------------------
+
+-- deriving instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR)
+deriving instance Data (HsLocalBindsLR GhcPs GhcPs)
+deriving instance Data (HsLocalBindsLR GhcPs GhcRn)
+deriving instance Data (HsLocalBindsLR GhcRn GhcRn)
+deriving instance Data (HsLocalBindsLR GhcTc GhcTc)
+
+-- deriving instance (DataIdLR pL pR) => Data (HsValBindsLR pL pR)
+deriving instance Data (HsValBindsLR GhcPs GhcPs)
+deriving instance Data (HsValBindsLR GhcPs GhcRn)
+deriving instance Data (HsValBindsLR GhcRn GhcRn)
+deriving instance Data (HsValBindsLR GhcTc GhcTc)
+
+-- deriving instance (DataIdLR pL pL) => Data (NHsValBindsLR pL)
+deriving instance Data (NHsValBindsLR GhcPs)
+deriving instance Data (NHsValBindsLR GhcRn)
+deriving instance Data (NHsValBindsLR GhcTc)
+
+-- deriving instance (DataIdLR pL pR) => Data (HsBindLR pL pR)
+deriving instance Data (HsBindLR GhcPs GhcPs)
+deriving instance Data (HsBindLR GhcPs GhcRn)
+deriving instance Data (HsBindLR GhcRn GhcRn)
+deriving instance Data (HsBindLR GhcTc GhcTc)
+
+-- deriving instance (DataId p)       => Data (ABExport p)
+deriving instance Data (ABExport GhcPs)
+deriving instance Data (ABExport GhcRn)
+deriving instance Data (ABExport GhcTc)
+
+-- deriving instance (DataIdLR pL pR) => Data (PatSynBind pL pR)
+deriving instance Data (PatSynBind GhcPs GhcPs)
+deriving instance Data (PatSynBind GhcPs GhcRn)
+deriving instance Data (PatSynBind GhcRn GhcRn)
+deriving instance Data (PatSynBind GhcTc GhcTc)
+
+-- deriving instance (DataIdLR p p)   => Data (HsIPBinds p)
+deriving instance Data (HsIPBinds GhcPs)
+deriving instance Data (HsIPBinds GhcRn)
+deriving instance Data (HsIPBinds GhcTc)
+
+-- deriving instance (DataIdLR p p)   => Data (IPBind p)
+deriving instance Data (IPBind GhcPs)
+deriving instance Data (IPBind GhcRn)
+deriving instance Data (IPBind GhcTc)
+
+-- deriving instance (DataIdLR p p)   => Data (Sig p)
+deriving instance Data (Sig GhcPs)
+deriving instance Data (Sig GhcRn)
+deriving instance Data (Sig GhcTc)
+
+-- deriving instance (DataId p)       => Data (FixitySig p)
+deriving instance Data (FixitySig GhcPs)
+deriving instance Data (FixitySig GhcRn)
+deriving instance Data (FixitySig GhcTc)
+
+-- deriving instance (DataIdLR p p)   => Data (HsPatSynDir p)
+deriving instance Data (HsPatSynDir GhcPs)
+deriving instance Data (HsPatSynDir GhcRn)
+deriving instance Data (HsPatSynDir GhcTc)
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Decls ----------------------------------
+
+-- deriving instance (DataIdLR p p) => Data (HsDecl p)
+deriving instance Data (HsDecl GhcPs)
+deriving instance Data (HsDecl GhcRn)
+deriving instance Data (HsDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsGroup p)
+deriving instance Data (HsGroup GhcPs)
+deriving instance Data (HsGroup GhcRn)
+deriving instance Data (HsGroup GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (SpliceDecl p)
+deriving instance Data (SpliceDecl GhcPs)
+deriving instance Data (SpliceDecl GhcRn)
+deriving instance Data (SpliceDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (TyClDecl p)
+deriving instance Data (TyClDecl GhcPs)
+deriving instance Data (TyClDecl GhcRn)
+deriving instance Data (TyClDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (TyClGroup p)
+deriving instance Data (TyClGroup GhcPs)
+deriving instance Data (TyClGroup GhcRn)
+deriving instance Data (TyClGroup GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (FamilyResultSig p)
+deriving instance Data (FamilyResultSig GhcPs)
+deriving instance Data (FamilyResultSig GhcRn)
+deriving instance Data (FamilyResultSig GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (FamilyDecl p)
+deriving instance Data (FamilyDecl GhcPs)
+deriving instance Data (FamilyDecl GhcRn)
+deriving instance Data (FamilyDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (InjectivityAnn p)
+deriving instance Data (InjectivityAnn GhcPs)
+deriving instance Data (InjectivityAnn GhcRn)
+deriving instance Data (InjectivityAnn GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (FamilyInfo p)
+deriving instance Data (FamilyInfo GhcPs)
+deriving instance Data (FamilyInfo GhcRn)
+deriving instance Data (FamilyInfo GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsDataDefn p)
+deriving instance Data (HsDataDefn GhcPs)
+deriving instance Data (HsDataDefn GhcRn)
+deriving instance Data (HsDataDefn GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsDerivingClause p)
+deriving instance Data (HsDerivingClause GhcPs)
+deriving instance Data (HsDerivingClause GhcRn)
+deriving instance Data (HsDerivingClause GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ConDecl p)
+deriving instance Data (ConDecl GhcPs)
+deriving instance Data (ConDecl GhcRn)
+deriving instance Data (ConDecl GhcTc)
+
+-- deriving instance DataIdLR p p   => Data (TyFamInstDecl p)
+deriving instance Data (TyFamInstDecl GhcPs)
+deriving instance Data (TyFamInstDecl GhcRn)
+deriving instance Data (TyFamInstDecl GhcTc)
+
+-- deriving instance DataIdLR p p   => Data (DataFamInstDecl p)
+deriving instance Data (DataFamInstDecl GhcPs)
+deriving instance Data (DataFamInstDecl GhcRn)
+deriving instance Data (DataFamInstDecl GhcTc)
+
+-- deriving instance (DataIdLR p p,Data rhs)=>Data (FamEqn p rhs)
+deriving instance Data rhs => Data (FamEqn GhcPs rhs)
+deriving instance Data rhs => Data (FamEqn GhcRn rhs)
+deriving instance Data rhs => Data (FamEqn GhcTc rhs)
+
+-- deriving instance (DataIdLR p p) => Data (ClsInstDecl p)
+deriving instance Data (ClsInstDecl GhcPs)
+deriving instance Data (ClsInstDecl GhcRn)
+deriving instance Data (ClsInstDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (InstDecl p)
+deriving instance Data (InstDecl GhcPs)
+deriving instance Data (InstDecl GhcRn)
+deriving instance Data (InstDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (DerivDecl p)
+deriving instance Data (DerivDecl GhcPs)
+deriving instance Data (DerivDecl GhcRn)
+deriving instance Data (DerivDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (DerivStrategy p)
+deriving instance Data (DerivStrategy GhcPs)
+deriving instance Data (DerivStrategy GhcRn)
+deriving instance Data (DerivStrategy GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (DefaultDecl p)
+deriving instance Data (DefaultDecl GhcPs)
+deriving instance Data (DefaultDecl GhcRn)
+deriving instance Data (DefaultDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ForeignDecl p)
+deriving instance Data (ForeignDecl GhcPs)
+deriving instance Data (ForeignDecl GhcRn)
+deriving instance Data (ForeignDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (RuleDecls p)
+deriving instance Data (RuleDecls GhcPs)
+deriving instance Data (RuleDecls GhcRn)
+deriving instance Data (RuleDecls GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (RuleDecl p)
+deriving instance Data (RuleDecl GhcPs)
+deriving instance Data (RuleDecl GhcRn)
+deriving instance Data (RuleDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (RuleBndr p)
+deriving instance Data (RuleBndr GhcPs)
+deriving instance Data (RuleBndr GhcRn)
+deriving instance Data (RuleBndr GhcTc)
+
+-- deriving instance (DataId p)     => Data (WarnDecls p)
+deriving instance Data (WarnDecls GhcPs)
+deriving instance Data (WarnDecls GhcRn)
+deriving instance Data (WarnDecls GhcTc)
+
+-- deriving instance (DataId p)     => Data (WarnDecl p)
+deriving instance Data (WarnDecl GhcPs)
+deriving instance Data (WarnDecl GhcRn)
+deriving instance Data (WarnDecl GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (AnnDecl p)
+deriving instance Data (AnnDecl GhcPs)
+deriving instance Data (AnnDecl GhcRn)
+deriving instance Data (AnnDecl GhcTc)
+
+-- deriving instance (DataId p)     => Data (RoleAnnotDecl p)
+deriving instance Data (RoleAnnotDecl GhcPs)
+deriving instance Data (RoleAnnotDecl GhcRn)
+deriving instance Data (RoleAnnotDecl GhcTc)
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Expr -----------------------------------
+
+-- deriving instance (DataIdLR p p) => Data (SyntaxExpr p)
+deriving instance Data (SyntaxExpr GhcPs)
+deriving instance Data (SyntaxExpr GhcRn)
+deriving instance Data (SyntaxExpr GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsExpr p)
+deriving instance Data (HsExpr GhcPs)
+deriving instance Data (HsExpr GhcRn)
+deriving instance Data (HsExpr GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsTupArg p)
+deriving instance Data (HsTupArg GhcPs)
+deriving instance Data (HsTupArg GhcRn)
+deriving instance Data (HsTupArg GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsCmd p)
+deriving instance Data (HsCmd GhcPs)
+deriving instance Data (HsCmd GhcRn)
+deriving instance Data (HsCmd GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsCmdTop p)
+deriving instance Data (HsCmdTop GhcPs)
+deriving instance Data (HsCmdTop GhcRn)
+deriving instance Data (HsCmdTop GhcTc)
+
+-- deriving instance (DataIdLR p p,Data body) => Data (MatchGroup p body)
+deriving instance (Data body) => Data (MatchGroup GhcPs body)
+deriving instance (Data body) => Data (MatchGroup GhcRn body)
+deriving instance (Data body) => Data (MatchGroup GhcTc body)
+
+-- deriving instance (DataIdLR p p,Data body) => Data (Match      p body)
+deriving instance (Data body) => Data (Match      GhcPs body)
+deriving instance (Data body) => Data (Match      GhcRn body)
+deriving instance (Data body) => Data (Match      GhcTc body)
+
+-- deriving instance (DataIdLR p p,Data body) => Data (GRHSs      p body)
+deriving instance (Data body) => Data (GRHSs     GhcPs body)
+deriving instance (Data body) => Data (GRHSs     GhcRn body)
+deriving instance (Data body) => Data (GRHSs     GhcTc body)
+
+-- deriving instance (DataIdLR p p,Data body) => Data (GRHS       p body)
+deriving instance (Data body) => Data (GRHS     GhcPs body)
+deriving instance (Data body) => Data (GRHS     GhcRn body)
+deriving instance (Data body) => Data (GRHS     GhcTc body)
+
+-- deriving instance (DataIdLR p p,Data body) => Data (StmtLR   p p body)
+deriving instance (Data body) => Data (StmtLR   GhcPs GhcPs body)
+deriving instance (Data body) => Data (StmtLR   GhcPs GhcRn body)
+deriving instance (Data body) => Data (StmtLR   GhcRn GhcRn body)
+deriving instance (Data body) => Data (StmtLR   GhcTc GhcTc body)
+
+deriving instance Data RecStmtTc
+
+-- deriving instance (DataIdLR p p) => Data (ParStmtBlock p p)
+deriving instance Data (ParStmtBlock GhcPs GhcPs)
+deriving instance Data (ParStmtBlock GhcPs GhcRn)
+deriving instance Data (ParStmtBlock GhcRn GhcRn)
+deriving instance Data (ParStmtBlock GhcTc GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ApplicativeArg p)
+deriving instance Data (ApplicativeArg GhcPs)
+deriving instance Data (ApplicativeArg GhcRn)
+deriving instance Data (ApplicativeArg GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsSplice p)
+deriving instance Data (HsSplice GhcPs)
+deriving instance Data (HsSplice GhcRn)
+deriving instance Data (HsSplice GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsSplicedThing p)
+deriving instance Data (HsSplicedThing GhcPs)
+deriving instance Data (HsSplicedThing GhcRn)
+deriving instance Data (HsSplicedThing GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsBracket p)
+deriving instance Data (HsBracket GhcPs)
+deriving instance Data (HsBracket GhcRn)
+deriving instance Data (HsBracket GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ArithSeqInfo p)
+deriving instance Data (ArithSeqInfo GhcPs)
+deriving instance Data (ArithSeqInfo GhcRn)
+deriving instance Data (ArithSeqInfo GhcTc)
+
+deriving instance                   Data RecordConTc
+deriving instance                   Data CmdTopTc
+deriving instance                   Data PendingRnSplice
+deriving instance                   Data PendingTcSplice
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Lit ------------------------------------
+
+-- deriving instance (DataId p) => Data (HsLit p)
+deriving instance Data (HsLit GhcPs)
+deriving instance Data (HsLit GhcRn)
+deriving instance Data (HsLit GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsOverLit p)
+deriving instance Data (HsOverLit GhcPs)
+deriving instance Data (HsOverLit GhcRn)
+deriving instance Data (HsOverLit GhcTc)
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Pat ------------------------------------
+
+-- deriving instance (DataIdLR p p) => Data (Pat p)
+deriving instance Data (Pat GhcPs)
+deriving instance Data (Pat GhcRn)
+deriving instance Data (Pat GhcTc)
+
+deriving instance Data ListPatTc
+
+-- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body)
+deriving instance (Data body) => Data (HsRecFields GhcPs body)
+deriving instance (Data body) => Data (HsRecFields GhcRn body)
+deriving instance (Data body) => Data (HsRecFields GhcTc body)
+
+-- ---------------------------------------------------------------------
+-- Data derivations from GHC.Hs.Types ----------------------------------
+
+-- deriving instance (DataIdLR p p) => Data (LHsQTyVars p)
+deriving instance Data (LHsQTyVars GhcPs)
+deriving instance Data (LHsQTyVars GhcRn)
+deriving instance Data (LHsQTyVars GhcTc)
+
+-- deriving instance (DataIdLR p p, Data thing) =>Data (HsImplicitBndrs p thing)
+deriving instance (Data thing) => Data (HsImplicitBndrs GhcPs thing)
+deriving instance (Data thing) => Data (HsImplicitBndrs GhcRn thing)
+deriving instance (Data thing) => Data (HsImplicitBndrs GhcTc thing)
+
+-- deriving instance (DataIdLR p p, Data thing) =>Data (HsWildCardBndrs p thing)
+deriving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing)
+deriving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing)
+deriving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing)
+
+-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)
+deriving instance Data (HsTyVarBndr GhcPs)
+deriving instance Data (HsTyVarBndr GhcRn)
+deriving instance Data (HsTyVarBndr GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsType p)
+deriving instance Data (HsType GhcPs)
+deriving instance Data (HsType GhcRn)
+deriving instance Data (HsType GhcTc)
+
+deriving instance Data (LHsTypeArg GhcPs)
+deriving instance Data (LHsTypeArg GhcRn)
+deriving instance Data (LHsTypeArg GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (ConDeclField p)
+deriving instance Data (ConDeclField GhcPs)
+deriving instance Data (ConDeclField GhcRn)
+deriving instance Data (ConDeclField GhcTc)
+
+-- deriving instance (DataId p)     => Data (FieldOcc p)
+deriving instance Data (FieldOcc GhcPs)
+deriving instance Data (FieldOcc GhcRn)
+deriving instance Data (FieldOcc GhcTc)
+
+-- deriving instance DataId p       => Data (AmbiguousFieldOcc p)
+deriving instance Data (AmbiguousFieldOcc GhcPs)
+deriving instance Data (AmbiguousFieldOcc GhcRn)
+deriving instance Data (AmbiguousFieldOcc GhcTc)
+
+
+-- deriving instance (DataId name) => Data (ImportDecl name)
+deriving instance Data (ImportDecl GhcPs)
+deriving instance Data (ImportDecl GhcRn)
+deriving instance Data (ImportDecl GhcTc)
+
+-- deriving instance (DataId name)             => Data (IE name)
+deriving instance Data (IE GhcPs)
+deriving instance Data (IE GhcRn)
+deriving instance Data (IE GhcTc)
+
+-- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)
+deriving instance Eq (IE GhcPs)
+deriving instance Eq (IE GhcRn)
+deriving instance Eq (IE GhcTc)
+
+-- ---------------------------------------------------------------------
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
new file mode 100644
index 0000000000..ab30de87ac
--- /dev/null
+++ b/compiler/GHC/Hs/Lit.hs
@@ -0,0 +1,314 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[HsLit]{Abstract syntax: source-language literals}
+-}
+
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Hs.Lit where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, pprExpr )
+import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
+                    negateFractionalLit,SourceText(..),pprWithSourceText )
+import Type
+import Outputable
+import FastString
+import GHC.Hs.Extension
+
+import Data.ByteString (ByteString)
+import Data.Data hiding ( Fixity )
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[HsLit]{Literals}
+*                                                                      *
+************************************************************************
+-}
+
+-- Note [Literal source text] in BasicTypes for SourceText fields in
+-- the following
+-- Note [Trees that grow] in GHC.Hs.Extension for the Xxxxx fields in the following
+-- | Haskell Literal
+data HsLit x
+  = HsChar (XHsChar x) {- SourceText -} Char
+      -- ^ Character
+  | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
+      -- ^ Unboxed character
+  | HsString (XHsString x) {- SourceText -} FastString
+      -- ^ String
+  | HsStringPrim (XHsStringPrim x) {- SourceText -} ByteString
+      -- ^ Packed bytes
+  | HsInt (XHsInt x)  IntegralLit
+      -- ^ Genuinely an Int; arises from
+      -- @TcGenDeriv@, and from TRANSLATION
+  | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
+      -- ^ literal @Int#@
+  | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
+      -- ^ literal @Word#@
+  | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
+      -- ^ literal @Int64#@
+  | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
+      -- ^ literal @Word64#@
+  | HsInteger (XHsInteger x) {- SourceText -} Integer Type
+      -- ^ Genuinely an integer; arises only
+      -- from TRANSLATION (overloaded
+      -- literals are done with HsOverLit)
+  | HsRat (XHsRat x)  FractionalLit Type
+      -- ^ Genuinely a rational; arises only from
+      -- TRANSLATION (overloaded literals are
+      -- done with HsOverLit)
+  | HsFloatPrim (XHsFloatPrim x)   FractionalLit
+      -- ^ Unboxed Float
+  | HsDoublePrim (XHsDoublePrim x) FractionalLit
+      -- ^ Unboxed Double
+
+  | XLit (XXLit x)
+
+type instance XHsChar       (GhcPass _) = SourceText
+type instance XHsCharPrim   (GhcPass _) = SourceText
+type instance XHsString     (GhcPass _) = SourceText
+type instance XHsStringPrim (GhcPass _) = SourceText
+type instance XHsInt        (GhcPass _) = NoExtField
+type instance XHsIntPrim    (GhcPass _) = SourceText
+type instance XHsWordPrim   (GhcPass _) = SourceText
+type instance XHsInt64Prim  (GhcPass _) = SourceText
+type instance XHsWord64Prim (GhcPass _) = SourceText
+type instance XHsInteger    (GhcPass _) = SourceText
+type instance XHsRat        (GhcPass _) = NoExtField
+type instance XHsFloatPrim  (GhcPass _) = NoExtField
+type instance XHsDoublePrim (GhcPass _) = NoExtField
+type instance XXLit         (GhcPass _) = NoExtCon
+
+instance Eq (HsLit x) where
+  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
+  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2
+  (HsString _ x1)     == (HsString _ x2)     = x1==x2
+  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
+  (HsInt _ x1)        == (HsInt _ x2)        = x1==x2
+  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2
+  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2
+  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2
+  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
+  (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2
+  (HsRat _ x1 _)      == (HsRat _ x2 _)      = x1==x2
+  (HsFloatPrim _ x1)  == (HsFloatPrim _ x2)  = x1==x2
+  (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
+  _                   == _                   = False
+
+-- | Haskell Overloaded Literal
+data HsOverLit p
+  = OverLit {
+      ol_ext :: (XOverLit p),
+      ol_val :: OverLitVal,
+      ol_witness :: HsExpr p}         -- Note [Overloaded literal witnesses]
+
+  | XOverLit
+      (XXOverLit p)
+
+data OverLitTc
+  = OverLitTc {
+        ol_rebindable :: Bool, -- Note [ol_rebindable]
+        ol_type :: Type }
+  deriving Data
+
+type instance XOverLit GhcPs = NoExtField
+type instance XOverLit GhcRn = Bool            -- Note [ol_rebindable]
+type instance XOverLit GhcTc = OverLitTc
+
+type instance XXOverLit (GhcPass _) = NoExtCon
+
+-- Note [Literal source text] in BasicTypes for SourceText fields in
+-- the following
+-- | Overloaded Literal Value
+data OverLitVal
+  = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;
+  | HsFractional !FractionalLit          -- ^ Frac-looking literals
+  | HsIsString   !SourceText !FastString -- ^ String-looking literals
+  deriving Data
+
+negateOverLitVal :: OverLitVal -> OverLitVal
+negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
+negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
+negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
+
+overLitType :: HsOverLit GhcTc -> Type
+overLitType (OverLit (OverLitTc _ ty) _ _) = ty
+overLitType (XOverLit nec) = noExtCon nec
+
+-- | Convert a literal from one index type to another, updating the annotations
+-- according to the relevant 'Convertable' instance
+convertLit :: (ConvertIdX a b) => HsLit a -> HsLit b
+convertLit (HsChar a x)       = (HsChar (convert a) x)
+convertLit (HsCharPrim a x)   = (HsCharPrim (convert a) x)
+convertLit (HsString a x)     = (HsString (convert a) x)
+convertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)
+convertLit (HsInt a x)        = (HsInt (convert a) x)
+convertLit (HsIntPrim a x)    = (HsIntPrim (convert a) x)
+convertLit (HsWordPrim a x)   = (HsWordPrim (convert a) x)
+convertLit (HsInt64Prim a x)  = (HsInt64Prim (convert a) x)
+convertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)
+convertLit (HsInteger a x b)  = (HsInteger (convert a) x b)
+convertLit (HsRat a x b)      = (HsRat (convert a) x b)
+convertLit (HsFloatPrim a x)  = (HsFloatPrim (convert a) x)
+convertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)
+convertLit (XLit a)           = (XLit (convert a))
+
+{-
+Note [ol_rebindable]
+~~~~~~~~~~~~~~~~~~~~
+The ol_rebindable field is True if this literal is actually
+using rebindable syntax.  Specifically:
+
+  False iff ol_witness is the standard one
+  True  iff ol_witness is non-standard
+
+Equivalently it's True if
+  a) RebindableSyntax is on
+  b) the witness for fromInteger/fromRational/fromString
+     that happens to be in scope isn't the standard one
+
+Note [Overloaded literal witnesses]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*Before* type checking, the HsExpr in an HsOverLit is the
+name of the coercion function, 'fromInteger' or 'fromRational'.
+*After* type checking, it is a witness for the literal, such as
+        (fromInteger 3) or lit_78
+This witness should replace the literal.
+
+This dual role is unusual, because we're replacing 'fromInteger' with
+a call to fromInteger.  Reason: it allows commoning up of the fromInteger
+calls, which wouldn't be possible if the desugarer made the application.
+
+The PostTcType in each branch records the type the overload literal is
+found to have.
+-}
+
+-- Comparison operations are needed when grouping literals
+-- for compiling pattern-matching (module MatchLit)
+instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
+  (OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2
+  (XOverLit  val1)   == (XOverLit  val2)   = val1 == val2
+  _ == _ = panic "Eq HsOverLit"
+
+instance Eq OverLitVal where
+  (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2
+  (HsFractional f1)   == (HsFractional f2)   = f1 == f2
+  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2
+  _                   == _                   = False
+
+instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
+  compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2
+  compare (XOverLit  val1)   (XOverLit  val2)   = val1 `compare` val2
+  compare _ _ = panic "Ord HsOverLit"
+
+instance Ord OverLitVal where
+  compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2
+  compare (HsIntegral _)      (HsFractional _)    = LT
+  compare (HsIntegral _)      (HsIsString _ _)    = LT
+  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2
+  compare (HsFractional _)    (HsIntegral   _)    = GT
+  compare (HsFractional _)    (HsIsString _ _)    = LT
+  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `compare` s2
+  compare (HsIsString _ _)    (HsIntegral   _)    = GT
+  compare (HsIsString _ _)    (HsFractional _)    = GT
+
+-- Instance specific to GhcPs, need the SourceText
+instance p ~ GhcPass pass => Outputable (HsLit p) where
+    ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)
+    ppr (HsCharPrim st c)   = pp_st_suffix st primCharSuffix (pprPrimChar c)
+    ppr (HsString st s)     = pprWithSourceText st (pprHsString s)
+    ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
+    ppr (HsInt _ i)
+      = pprWithSourceText (il_text i) (integer (il_value i))
+    ppr (HsInteger st i _)  = pprWithSourceText st (integer i)
+    ppr (HsRat _ f _)       = ppr f
+    ppr (HsFloatPrim _ f)   = ppr f <> primFloatSuffix
+    ppr (HsDoublePrim _ d)  = ppr d <> primDoubleSuffix
+    ppr (HsIntPrim st i)    = pprWithSourceText st (pprPrimInt i)
+    ppr (HsWordPrim st w)   = pprWithSourceText st (pprPrimWord w)
+    ppr (HsInt64Prim st i)  = pp_st_suffix st primInt64Suffix  (pprPrimInt64 i)
+    ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
+    ppr (XLit x) = ppr x
+
+pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
+pp_st_suffix NoSourceText         _ doc = doc
+pp_st_suffix (SourceText st) suffix _   = text st <> suffix
+
+-- in debug mode, print the expression that it's resolved to, too
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsOverLit p) where
+  ppr (OverLit {ol_val=val, ol_witness=witness})
+        = ppr val <+> (whenPprDebug (parens (pprExpr witness)))
+  ppr (XOverLit x) = ppr x
+
+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
+-- mainly for too reasons:
+--  * We do not want to expose their internal representation
+--  * The warnings become too messy
+pmPprHsLit :: HsLit (GhcPass x) -> SDoc
+pmPprHsLit (HsChar _ c)       = pprHsChar c
+pmPprHsLit (HsCharPrim _ c)   = pprHsChar c
+pmPprHsLit (HsString st s)    = pprWithSourceText st (pprHsString s)
+pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
+pmPprHsLit (HsInt _ i)        = integer (il_value i)
+pmPprHsLit (HsIntPrim _ i)    = integer i
+pmPprHsLit (HsWordPrim _ w)   = integer w
+pmPprHsLit (HsInt64Prim _ i)  = integer i
+pmPprHsLit (HsWord64Prim _ w) = integer w
+pmPprHsLit (HsInteger _ i _)  = integer i
+pmPprHsLit (HsRat _ f _)      = ppr f
+pmPprHsLit (HsFloatPrim _ f)  = ppr f
+pmPprHsLit (HsDoublePrim _ d) = ppr d
+pmPprHsLit (XLit x)           = ppr x
+
+-- | @'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/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
new file mode 100644
index 0000000000..fe8a4e88d5
--- /dev/null
+++ b/compiler/GHC/Hs/Pat.hs
@@ -0,0 +1,846 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[PatSyntax]{Abstract Haskell syntax---patterns}
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module GHC.Hs.Pat (
+        Pat(..), InPat, OutPat, LPat,
+        ListPatTc(..),
+
+        HsConPatDetails, hsConPatArgs,
+        HsRecFields(..), HsRecField'(..), LHsRecField',
+        HsRecField, LHsRecField,
+        HsRecUpdField, LHsRecUpdField,
+        hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
+        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
+
+        mkPrefixConPat, mkCharLitPat, mkNilPat,
+
+        looksLazyPatBind,
+        isBangedLPat,
+        patNeedsParens, parenthesizePat,
+        isIrrefutableHsPat,
+
+        collectEvVarsPat, collectEvVarsPats,
+
+        pprParendLPat, pprConArgs
+    ) where
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Hs.Expr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
+
+-- friends:
+import GHC.Hs.Binds
+import GHC.Hs.Lit
+import GHC.Hs.Extension
+import GHC.Hs.Types
+import TcEvidence
+import BasicTypes
+-- others:
+import PprCore          ( {- instance OutputableBndr TyVar -} )
+import TysWiredIn
+import Var
+import RdrName ( RdrName )
+import ConLike
+import DataCon
+import TyCon
+import Outputable
+import Type
+import SrcLoc
+import Bag -- collect ev vars from pats
+import DynFlags( gopt, GeneralFlag(..) )
+import Maybes
+-- libraries:
+import Data.Data hiding (TyCon,Fixity)
+
+type InPat p  = LPat p        -- No 'Out' constructors
+type OutPat p = LPat p        -- No 'In' constructors
+
+type LPat p = Pat p
+
+-- | Pattern
+--
+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data Pat p
+  =     ------------ Simple patterns ---------------
+    WildPat     (XWildPat p)        -- ^ Wildcard Pattern
+        -- The sole reason for a type on a WildPat is to
+        -- support hsPatType :: Pat Id -> Type
+
+       -- AZ:TODO above comment needs to be updated
+  | VarPat      (XVarPat p)
+                (Located (IdP p))  -- ^ Variable Pattern
+
+                             -- See Note [Located RdrNames] in GHC.Hs.Expr
+  | LazyPat     (XLazyPat p)
+                (LPat p)                -- ^ Lazy Pattern
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | AsPat       (XAsPat p)
+                (Located (IdP p)) (LPat p)    -- ^ As pattern
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | ParPat      (XParPat p)
+                (LPat p)                -- ^ Parenthesised pattern
+                                        -- See Note [Parens in HsSyn] in GHC.Hs.Expr
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
+    --                                    'ApiAnnotation.AnnClose' @')'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+  | BangPat     (XBangPat p)
+                (LPat p)                -- ^ Bang pattern
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+        ------------ Lists, tuples, arrays ---------------
+  | ListPat     (XListPat p)
+                [LPat p]
+                   -- For OverloadedLists a Just (ty,fn) gives
+                   -- overall type of the pattern, and the toList
+-- function to convert the scrutinee to a list value
+
+    -- ^ Syntactic List
+    --
+    -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
+    --                                    'ApiAnnotation.AnnClose' @']'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | TuplePat    (XTuplePat p)
+                  -- after typechecking, holds the types of the tuple components
+                [LPat p]         -- Tuple sub-patterns
+                Boxity           -- UnitPat is TuplePat []
+        -- You might think that the post typechecking Type was redundant,
+        -- because we can get the pattern type by getting the types of the
+        -- sub-patterns.
+        -- But it's essential
+        --      data T a where
+        --        T1 :: Int -> T Int
+        --      f :: (T a, a) -> Int
+        --      f (T1 x, z) = z
+        -- When desugaring, we must generate
+        --      f = /\a. \v::a.  case v of (t::T a, w::a) ->
+        --                       case t of (T1 (x::Int)) ->
+        -- Note the (w::a), NOT (w::Int), because we have not yet
+        -- refined 'a' to Int.  So we must know that the second component
+        -- of the tuple is of type 'a' not Int.  See selectMatchVar
+        -- (June 14: I'm not sure this comment is right; the sub-patterns
+        --           will be wrapped in CoPats, no?)
+    -- ^ Tuple sub-patterns
+    --
+    -- - 'ApiAnnotation.AnnKeywordId' :
+    --            'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
+    --            'ApiAnnotation.AnnClose' @')'@ or  @'#)'@
+
+  | SumPat      (XSumPat p)        -- GHC.Hs.PlaceHolder before typechecker, filled in
+                                   -- afterwards with the types of the
+                                   -- alternative
+                (LPat p)           -- Sum sub-pattern
+                ConTag             -- Alternative (one-based)
+                Arity              -- Arity (INVARIANT: ≥ 2)
+    -- ^ Anonymous sum pattern
+    --
+    -- - 'ApiAnnotation.AnnKeywordId' :
+    --            'ApiAnnotation.AnnOpen' @'(#'@,
+    --            'ApiAnnotation.AnnClose' @'#)'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+        ------------ Constructor patterns ---------------
+  | ConPatIn    (Located (IdP p))
+                (HsConPatDetails p)
+    -- ^ Constructor Pattern In
+
+  | ConPatOut {
+        pat_con     :: Located ConLike,
+        pat_arg_tys :: [Type],          -- The universal arg types, 1-1 with the universal
+                                        -- tyvars of the constructor/pattern synonym
+                                        --   Use (conLikeResTy pat_con pat_arg_tys) to get
+                                        --   the type of the pattern
+
+        pat_tvs   :: [TyVar],           -- Existentially bound type variables
+                                        -- in correctly-scoped order e.g. [k:*, x:k]
+        pat_dicts :: [EvVar],           -- Ditto *coercion variables* and *dictionaries*
+                                        -- One reason for putting coercion variable here, I think,
+                                        --      is to ensure their kinds are zonked
+
+        pat_binds :: TcEvBinds,         -- Bindings involving those dictionaries
+        pat_args  :: HsConPatDetails p,
+        pat_wrap  :: HsWrapper          -- Extra wrapper to pass to the matcher
+                                        -- Only relevant for pattern-synonyms;
+                                        --   ignored for data cons
+    }
+    -- ^ Constructor Pattern Out
+
+        ------------ View patterns ---------------
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | ViewPat       (XViewPat p)     -- The overall type of the pattern
+                                   -- (= the argument type of the view function)
+                                   -- for hsPatType.
+                  (LHsExpr p)
+                  (LPat p)
+    -- ^ View Pattern
+
+        ------------ Pattern splices ---------------
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@
+  --        'ApiAnnotation.AnnClose' @')'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | SplicePat       (XSplicePat p)
+                    (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)
+
+        ------------ Literal and n+k patterns ---------------
+  | LitPat          (XLitPat p)
+                    (HsLit p)           -- ^ Literal Pattern
+                                        -- Used for *non-overloaded* literal patterns:
+                                        -- Int#, Char#, Int, Char, String, etc.
+
+  | NPat                -- Natural Pattern
+                        -- Used for all overloaded literals,
+                        -- including overloaded strings with -XOverloadedStrings
+                    (XNPat p)            -- Overall type of pattern. Might be
+                                         -- different than the literal's type
+                                         -- if (==) or negate changes the type
+                    (Located (HsOverLit p))     -- ALWAYS positive
+                    (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
+                                           -- negative patterns, Nothing
+                                           -- otherwise
+                    (SyntaxExpr p)       -- Equality checker, of type t->t->Bool
+
+  -- ^ Natural Pattern
+  --
+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
+                    (Located (IdP p))        -- n+k pattern
+                    (Located (HsOverLit p))  -- It'll always be an HsIntegral
+                    (HsOverLit p)       -- See Note [NPlusK patterns] in TcPat
+                     -- NB: This could be (PostTc ...), but that induced a
+                     -- a new hs-boot file. Not worth it.
+
+                    (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool
+                    (SyntaxExpr p)   -- Name of '-' (see RnEnv.lookupSyntaxName)
+  -- ^ n+k pattern
+
+        ------------ Pattern type signatures ---------------
+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+
+  -- For details on above see note [Api annotations] in ApiAnnotation
+  | SigPat          (XSigPat p)             -- After typechecker: Type
+                    (LPat p)                -- Pattern with a type signature
+                    (LHsSigWcType (NoGhcTc p)) --  Signature can bind both
+                                               --  kind and type vars
+
+    -- ^ Pattern with a type signature
+
+        ------------ Pattern coercions (translation only) ---------------
+  | CoPat       (XCoPat p)
+                HsWrapper           -- Coercion Pattern
+                                    -- If co :: t1 ~ t2, p :: t2,
+                                    -- then (CoPat co p) :: t1
+                (Pat p)             -- Why not LPat?  Ans: existing locn will do
+                Type                -- Type of whole pattern, t1
+        -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
+        -- the scrutinee, followed by a match on 'pat'
+    -- ^ Coercion Pattern
+
+  -- | Trees that Grow extension point for new constructors
+  | XPat
+      (XXPat p)
+
+-- ---------------------------------------------------------------------
+
+data ListPatTc
+  = ListPatTc
+      Type                             -- The type of the elements
+      (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
+
+type instance XWildPat GhcPs = NoExtField
+type instance XWildPat GhcRn = NoExtField
+type instance XWildPat GhcTc = Type
+
+type instance XVarPat  (GhcPass _) = NoExtField
+type instance XLazyPat (GhcPass _) = NoExtField
+type instance XAsPat   (GhcPass _) = NoExtField
+type instance XParPat  (GhcPass _) = NoExtField
+type instance XBangPat (GhcPass _) = NoExtField
+
+-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
+-- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for
+-- `SyntaxExpr`
+type instance XListPat GhcPs = NoExtField
+type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
+type instance XListPat GhcTc = ListPatTc
+
+type instance XTuplePat GhcPs = NoExtField
+type instance XTuplePat GhcRn = NoExtField
+type instance XTuplePat GhcTc = [Type]
+
+type instance XSumPat GhcPs = NoExtField
+type instance XSumPat GhcRn = NoExtField
+type instance XSumPat GhcTc = [Type]
+
+type instance XViewPat GhcPs = NoExtField
+type instance XViewPat GhcRn = NoExtField
+type instance XViewPat GhcTc = Type
+
+type instance XSplicePat (GhcPass _) = NoExtField
+type instance XLitPat    (GhcPass _) = NoExtField
+
+type instance XNPat GhcPs = NoExtField
+type instance XNPat GhcRn = NoExtField
+type instance XNPat GhcTc = Type
+
+type instance XNPlusKPat GhcPs = NoExtField
+type instance XNPlusKPat GhcRn = NoExtField
+type instance XNPlusKPat GhcTc = Type
+
+type instance XSigPat GhcPs = NoExtField
+type instance XSigPat GhcRn = NoExtField
+type instance XSigPat GhcTc = Type
+
+type instance XCoPat  (GhcPass _) = NoExtField
+type instance XXPat   (GhcPass p) = Located (Pat (GhcPass p))
+
+
+{-
+************************************************************************
+*                                                                      *
+*              HasSrcSpan Instance
+*                                                                      *
+************************************************************************
+-}
+
+type instance SrcSpanLess (LPat (GhcPass p)) = Pat (GhcPass p)
+instance HasSrcSpan (LPat (GhcPass p)) where
+  -- NB: The following chooses the behaviour of the outer location
+  --     wrapper replacing the inner ones.
+  composeSrcSpan (L sp p) =  if sp == noSrcSpan
+                             then p
+                             else XPat (L sp (stripSrcSpanPat p))
+
+  -- NB: The following only returns the top-level location, if any.
+  decomposeSrcSpan (XPat (L sp p)) = L sp (stripSrcSpanPat p)
+  decomposeSrcSpan p               = L noSrcSpan p
+
+stripSrcSpanPat :: LPat (GhcPass p) -> Pat (GhcPass p)
+stripSrcSpanPat (XPat (L _  p)) = stripSrcSpanPat p
+stripSrcSpanPat p               = p
+
+
+
+-- ---------------------------------------------------------------------
+
+
+-- | Haskell Constructor Pattern Details
+type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
+
+hsConPatArgs :: HsConPatDetails p -> [LPat p]
+hsConPatArgs (PrefixCon ps)   = ps
+hsConPatArgs (RecCon fs)      = map (hsRecFieldArg . unLoc) (rec_flds fs)
+hsConPatArgs (InfixCon p1 p2) = [p1,p2]
+
+-- | Haskell Record Fields
+--
+-- HsRecFields is used only for patterns and expressions (not data type
+-- declarations)
+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]
+  deriving (Functor, Foldable, Traversable)
+
+
+-- Note [DotDot fields]
+-- ~~~~~~~~~~~~~~~~~~~~
+-- The rec_dotdot field means this:
+--   Nothing => the normal case
+--   Just n  => the group uses ".." notation,
+--
+-- In the latter case:
+--
+--   *before* renamer: rec_flds are exactly the n user-written fields
+--
+--   *after* renamer:  rec_flds includes *all* fields, with
+--                     the first 'n' being the user-written ones
+--                     and the remainder being 'filled in' implicitly
+
+-- | Located Haskell Record Field
+type LHsRecField' p arg = Located (HsRecField' p arg)
+
+-- | Located Haskell Record Field
+type LHsRecField  p arg = Located (HsRecField  p arg)
+
+-- | Located Haskell Record Update Field
+type LHsRecUpdField p   = Located (HsRecUpdField p)
+
+-- | Haskell Record Field
+type HsRecField    p arg = HsRecField' (FieldOcc p) arg
+
+-- | Haskell Record Update Field
+type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
+
+-- | Haskell Record Field
+--
+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',
+--
+-- For details on above see note [Api annotations] in ApiAnnotation
+data HsRecField' id arg = HsRecField {
+        hsRecFieldLbl :: Located id,
+        hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning
+        hsRecPun      :: Bool           -- ^ Note [Punning]
+  } deriving (Data, Functor, Foldable, Traversable)
+
+
+-- Note [Punning]
+-- ~~~~~~~~~~~~~~
+-- If you write T { x, y = v+1 }, the HsRecFields will be
+--      HsRecField x x True ...
+--      HsRecField y (v+1) False ...
+-- That is, for "punned" field x is expanded (in the renamer)
+-- to x=x; but with a punning flag so we can detect it later
+-- (e.g. when pretty printing)
+--
+-- If the original field was qualified, we un-qualify it, thus
+--    T { A.x } means T { A.x = x }
+
+
+-- Note [HsRecField and HsRecUpdField]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+-- A HsRecField (used for record construction and pattern matching)
+-- contains an unambiguous occurrence of a field (i.e. a FieldOcc).
+-- We can't just store the Name, because thanks to
+-- DuplicateRecordFields this may not correspond to the label the user
+-- wrote.
+--
+-- A HsRecUpdField (used for record update) contains a potentially
+-- ambiguous occurrence of a field (an AmbiguousFieldOcc).  The
+-- renamer will fill in the selector function if it can, but if the
+-- selector is ambiguous the renamer will defer to the typechecker.
+-- After the typechecker, a unique selector will have been determined.
+--
+-- The renamer produces an Unambiguous result if it can, rather than
+-- just doing the lookup in the typechecker, so that completely
+-- unambiguous updates can be represented by 'DsMeta.repUpdFields'.
+--
+-- For example, suppose we have:
+--
+--     data S = MkS { x :: Int }
+--     data T = MkT { x :: Int }
+--
+--     f z = (z { x = 3 }) :: S
+--
+-- The parsed HsRecUpdField corresponding to the record update will have:
+--
+--     hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
+--
+-- After the renamer, this will become:
+--
+--     hsRecFieldLbl = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name
+--
+-- (note that the Unambiguous constructor is not type-correct here).
+-- The typechecker will determine the particular selector:
+--
+--     hsRecFieldLbl = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id
+--
+-- See also Note [Disambiguating record fields] in TcExpr.
+
+hsRecFields :: HsRecFields p arg -> [XCFieldOcc p]
+hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
+
+-- Probably won't typecheck at once, things have changed :/
+hsRecFieldsArgs :: HsRecFields p arg -> [arg]
+hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)
+
+hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)
+hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl
+
+hsRecFieldId :: HsRecField GhcTc arg -> Located Id
+hsRecFieldId = hsRecFieldSel
+
+hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
+hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
+
+hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
+hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
+
+hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
+hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
+
+
+{-
+************************************************************************
+*                                                                      *
+*              Printing patterns
+*                                                                      *
+************************************************************************
+-}
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p) where
+    ppr = pprPat
+
+pprPatBndr :: OutputableBndr name => name -> SDoc
+pprPatBndr var                  -- Print with type info if -dppr-debug is on
+  = getPprStyle $ \ sty ->
+    if debugStyle sty then
+        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat
+                                                -- but is it worth it?
+    else
+        pprPrefixOcc var
+
+pprParendLPat :: (OutputableBndrId (GhcPass p))
+              => PprPrec -> LPat (GhcPass p) -> SDoc
+pprParendLPat p = pprParendPat p . unLoc
+
+pprParendPat :: (OutputableBndrId (GhcPass p))
+             => PprPrec -> Pat (GhcPass p) -> SDoc
+pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
+                     if need_parens dflags pat
+                     then parens (pprPat pat)
+                     else  pprPat pat
+  where
+    need_parens dflags pat
+      | CoPat {} <- pat = gopt Opt_PrintTypecheckerElaboration dflags
+      | otherwise       = patNeedsParens p pat
+      -- For a CoPat we need parens if we are going to show it, which
+      -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)
+      -- But otherwise the CoPat is discarded, so it
+      -- is the pattern inside that matters.  Sigh.
+
+pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc
+pprPat (VarPat _ lvar)          = pprPatBndr (unLoc lvar)
+pprPat (WildPat _)              = char '_'
+pprPat (LazyPat _ pat)          = char '~' <> pprParendLPat appPrec pat
+pprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat
+pprPat (AsPat _ name pat)       = hcat [pprPrefixOcc (unLoc name), char '@',
+                                        pprParendLPat appPrec pat]
+pprPat (ViewPat _ expr pat)     = hcat [pprLExpr expr, text " -> ", ppr pat]
+pprPat (ParPat _ pat)           = parens (ppr pat)
+pprPat (LitPat _ s)             = ppr s
+pprPat (NPat _ l Nothing  _)    = ppr l
+pprPat (NPat _ l (Just _) _)    = char '-' <> ppr l
+pprPat (NPlusKPat _ n k _ _ _)  = hcat [ppr n, char '+', ppr k]
+pprPat (SplicePat _ splice)     = pprSplice splice
+pprPat (CoPat _ co pat _)       = pprHsWrapper co $ \parens
+                                            -> if parens
+                                                 then pprParendPat appPrec pat
+                                                 else pprPat pat
+pprPat (SigPat _ pat ty)        = ppr pat <+> dcolon <+> ppr ty
+pprPat (ListPat _ pats)         = brackets (interpp'SP pats)
+pprPat (TuplePat _ pats bx)     = tupleParens (boxityTupleSort bx)
+                                              (pprWithCommas ppr pats)
+pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)
+pprPat (ConPatIn con details)   = pprUserCon (unLoc con) details
+pprPat (ConPatOut { pat_con = con
+                  , pat_tvs = tvs
+                  , pat_dicts = dicts
+                  , pat_binds = binds
+                  , pat_args = details })
+  = sdocWithDynFlags $ \dflags ->
+       -- Tiresome; in TcBinds.tcRhs we print out a
+       -- typechecked Pat in an error message,
+       -- and we want to make sure it prints nicely
+    if gopt Opt_PrintTypecheckerElaboration dflags then
+        ppr con
+          <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
+                         , ppr binds])
+          <+> pprConArgs details
+    else pprUserCon (unLoc con) details
+pprPat (XPat x)               = ppr x
+
+
+pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))
+           => con -> HsConPatDetails (GhcPass p) -> SDoc
+pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
+pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details
+
+pprConArgs :: (OutputableBndrId (GhcPass p))
+           => HsConPatDetails (GhcPass p) -> SDoc
+pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats)
+pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1
+                                  , pprParendLPat appPrec p2 ]
+pprConArgs (RecCon rpats)   = ppr rpats
+
+instance (Outputable 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, Outputable arg)
+      => Outputable (HsRecField' p arg) where
+  ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,
+                    hsRecPun = pun })
+    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
+
+
+{-
+************************************************************************
+*                                                                      *
+*              Building patterns
+*                                                                      *
+************************************************************************
+-}
+
+mkPrefixConPat :: DataCon ->
+                  [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p)
+-- Make a vanilla Prefix constructor pattern
+mkPrefixConPat dc pats tys
+  = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc)
+                      , pat_tvs = []
+                      , pat_dicts = []
+                      , pat_binds = emptyTcEvBinds
+                      , pat_args = PrefixCon pats
+                      , pat_arg_tys = tys
+                      , pat_wrap = idHsWrapper }
+
+mkNilPat :: Type -> OutPat (GhcPass p)
+mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
+
+mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
+mkCharLitPat src c = mkPrefixConPat charDataCon
+                          [noLoc $ LitPat noExtField (HsCharPrim src c)] []
+
+{-
+************************************************************************
+*                                                                      *
+* Predicates for checking things about pattern-lists in EquationInfo   *
+*                                                                      *
+************************************************************************
+
+\subsection[Pat-list-predicates]{Look for interesting things in patterns}
+
+Unlike in the Wadler chapter, where patterns are either ``variables''
+or ``constructors,'' here we distinguish between:
+\begin{description}
+\item[unfailable:]
+Patterns that cannot fail to match: variables, wildcards, and lazy
+patterns.
+
+These are the irrefutable patterns; the two other categories
+are refutable patterns.
+
+\item[constructor:]
+A non-literal constructor pattern (see next category).
+
+\item[literal patterns:]
+At least the numeric ones may be overloaded.
+\end{description}
+
+A pattern is in {\em exactly one} of the above three categories; `as'
+patterns are treated specially, of course.
+
+The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
+-}
+
+isBangedLPat :: LPat (GhcPass p) -> Bool
+isBangedLPat = isBangedPat . unLoc
+
+isBangedPat :: Pat (GhcPass p) -> Bool
+isBangedPat (ParPat _ p) = isBangedLPat p
+isBangedPat (BangPat {}) = True
+isBangedPat _            = False
+
+looksLazyPatBind :: HsBind (GhcPass p) -> Bool
+-- Returns True of anything *except*
+--     a StrictHsBind (as above) or
+--     a VarPat
+-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
+-- Looks through AbsBinds
+looksLazyPatBind (PatBind { pat_lhs = p })
+  = looksLazyLPat p
+looksLazyPatBind (AbsBinds { abs_binds = binds })
+  = anyBag (looksLazyPatBind . unLoc) binds
+looksLazyPatBind _
+  = False
+
+looksLazyLPat :: LPat (GhcPass p) -> Bool
+looksLazyLPat = looksLazyPat . unLoc
+
+looksLazyPat :: Pat (GhcPass p) -> Bool
+looksLazyPat (ParPat _ p)  = looksLazyLPat p
+looksLazyPat (AsPat _ _ p) = looksLazyLPat p
+looksLazyPat (BangPat {})  = False
+looksLazyPat (VarPat {})   = False
+looksLazyPat (WildPat {})  = False
+looksLazyPat _             = True
+
+isIrrefutableHsPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> Bool
+-- (isIrrefutableHsPat p) is true if matching against p cannot fail,
+-- in the sense of falling through to the next pattern.
+--      (NB: this is not quite the same as the (silly) defn
+--      in 3.17.2 of the Haskell 98 report.)
+--
+-- WARNING: isIrrefutableHsPat returns False if it's in doubt.
+-- Specifically on a ConPatIn, which is what it sees for a
+-- (LPat Name) in the renamer, it doesn't know the size of the
+-- constructor family, so it returns False.  Result: only
+-- tuple patterns are considered irrefuable at the renamer stage.
+--
+-- But if it returns True, the pattern is definitely irrefutable
+isIrrefutableHsPat
+  = goL
+  where
+    goL = go . unLoc
+
+    go (WildPat {})        = True
+    go (VarPat {})         = True
+    go (LazyPat {})        = True
+    go (BangPat _ pat)     = goL pat
+    go (CoPat _ _ pat _)   = go  pat
+    go (ParPat _ pat)      = goL pat
+    go (AsPat _ _ pat)     = goL pat
+    go (ViewPat _ _ pat)   = goL pat
+    go (SigPat _ pat _)    = goL pat
+    go (TuplePat _ pats _) = all goL pats
+    go (SumPat {})         = False
+                    -- See Note [Unboxed sum patterns aren't irrefutable]
+    go (ListPat {})        = False
+
+    go (ConPatIn {})       = False     -- Conservative
+    go (ConPatOut
+        { pat_con  = (dL->L _ (RealDataCon con))
+        , pat_args = details })
+                           =
+      isJust (tyConSingleDataCon_maybe (dataConTyCon con))
+      -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
+      -- the latter is false of existentials. See #4439
+      && all goL (hsConPatArgs details)
+    go (ConPatOut
+        { pat_con = (dL->L _ (PatSynCon _pat)) })
+                           = False -- Conservative
+    go (ConPatOut{})       = panic "ConPatOut:Impossible Match" -- due to #15884
+    go (LitPat {})         = False
+    go (NPat {})           = False
+    go (NPlusKPat {})      = False
+
+    -- We conservatively assume that no TH splices are irrefutable
+    -- since we cannot know until the splice is evaluated.
+    go (SplicePat {})      = False
+
+    go (XPat {})           = False
+
+{- Note [Unboxed sum patterns aren't irrefutable]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
+patterns. A simple example that demonstrates this is from #14228:
+
+  pattern Just' x = (# x | #)
+  pattern Nothing' = (# | () #)
+
+  foo x = case x of
+    Nothing' -> putStrLn "nothing"
+    Just'    -> putStrLn "just"
+
+In foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,
+as does not match an unboxed sum value of the same arity—namely, (# | y #)
+(covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the
+minimum unboxed sum arity is 2.
+
+Failing to mark unboxed sum patterns as non-irrefutable would cause the Just'
+case in foo to be unreachable, as GHC would mistakenly believe that Nothing'
+is the only thing that could possibly be matched!
+-}
+
+-- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs
+-- parentheses under precedence @p@.
+patNeedsParens :: PprPrec -> Pat p -> Bool
+patNeedsParens p = go
+  where
+    go (NPlusKPat {})    = p > opPrec
+    go (SplicePat {})    = False
+    go (ConPatIn _ ds)   = conPatNeedsParens p ds
+    go cp@(ConPatOut {}) = conPatNeedsParens p (pat_args cp)
+    go (SigPat {})       = p >= sigPrec
+    go (ViewPat {})      = True
+    go (CoPat _ _ p _)   = go p
+    go (WildPat {})      = False
+    go (VarPat {})       = False
+    go (LazyPat {})      = False
+    go (BangPat {})      = False
+    go (ParPat {})       = False
+    go (AsPat {})        = False
+    go (TuplePat {})     = False
+    go (SumPat {})       = False
+    go (ListPat {})      = False
+    go (LitPat _ l)      = hsLitNeedsParens p l
+    go (NPat _ lol _ _)  = hsOverLitNeedsParens p (unLoc lol)
+    go (XPat {})         = True -- conservative default
+
+-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
+-- needs parentheses under precedence @p@.
+conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool
+conPatNeedsParens p = go
+  where
+    go (PrefixCon args) = p >= appPrec && not (null args)
+    go (InfixCon {})    = p >= opPrec
+    go (RecCon {})      = False
+
+-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
+-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
+parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
+parenthesizePat p lpat@(dL->L loc pat)
+  | patNeedsParens p pat = cL loc (ParPat noExtField lpat)
+  | otherwise            = lpat
+
+{-
+% Collect all EvVars from all constructor patterns
+-}
+
+-- May need to add more cases
+collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
+collectEvVarsPats = unionManyBags . map collectEvVarsPat
+
+collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
+collectEvVarsLPat = collectEvVarsPat . unLoc
+
+collectEvVarsPat :: Pat GhcTc -> Bag EvVar
+collectEvVarsPat pat =
+  case pat of
+    LazyPat _ p      -> collectEvVarsLPat p
+    AsPat _ _ p      -> collectEvVarsLPat p
+    ParPat  _ p      -> collectEvVarsLPat p
+    BangPat _ p      -> collectEvVarsLPat p
+    ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
+    TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
+    SumPat _ p _ _   -> collectEvVarsLPat p
+    ConPatOut {pat_dicts = dicts, pat_args  = args}
+                     -> unionBags (listToBag dicts)
+                                   $ unionManyBags
+                                   $ map collectEvVarsLPat
+                                   $ hsConPatArgs args
+    SigPat  _ p _    -> collectEvVarsLPat p
+    CoPat _ _ p _    -> collectEvVarsPat  p
+    ConPatIn _  _    -> panic "foldMapPatBag: ConPatIn"
+    _other_pat       -> emptyBag
diff --git a/compiler/GHC/Hs/Pat.hs-boot b/compiler/GHC/Hs/Pat.hs-boot
new file mode 100644
index 0000000000..801f481879
--- /dev/null
+++ b/compiler/GHC/Hs/Pat.hs-boot
@@ -0,0 +1,18 @@
+{-# LANGUAGE CPP, KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Hs.Pat where
+
+import Outputable
+import GHC.Hs.Extension ( OutputableBndrId, GhcPass )
+
+type role Pat nominal
+data Pat (i :: *)
+type LPat i = Pat i
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p)
diff --git a/compiler/GHC/Hs/PlaceHolder.hs b/compiler/GHC/Hs/PlaceHolder.hs
new file mode 100644
index 0000000000..faaa1331ab
--- /dev/null
+++ b/compiler/GHC/Hs/PlaceHolder.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module GHC.Hs.PlaceHolder where
+
+import Name
+import NameSet
+import RdrName
+import Var
+
+
+
+{-
+%************************************************************************
+%*                                                                      *
+\subsection{Annotating the syntax}
+%*                                                                      *
+%************************************************************************
+-}
+
+-- NB: These are intentionally open, allowing API consumers (like Haddock)
+-- to declare new instances
+
+placeHolderNamesTc :: NameSet
+placeHolderNamesTc = emptyNameSet
+
+{-
+TODO:AZ: remove this, and check if we still need all the UndecidableInstances
+
+Note [Pass sensitive types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Since the same AST types are re-used through parsing,renaming and type
+checking there are naturally some places in the AST that do not have
+any meaningful value prior to the pass they are assigned a value.
+
+Historically these have been filled in with place holder values of the form
+
+  panic "error message"
+
+This has meant the AST is difficult to traverse using standard generic
+programming techniques. The problem is addressed by introducing
+pass-specific data types, implemented as a pair of open type families,
+one for PostTc and one for PostRn. These are then explicitly populated
+with a PlaceHolder value when they do not yet have meaning.
+
+In terms of actual usage, we have the following
+
+  PostTc id Kind
+  PostTc id Type
+
+  PostRn id Fixity
+  PostRn id NameSet
+
+TcId and Var are synonyms for Id
+
+Unfortunately the type checker termination checking conditions fail for the
+DataId constraint type based on this, so even though it is safe the
+UndecidableInstances pragma is required where this is used.
+-}
+
+
+-- |Follow the @id@, but never beyond Name. This is used in a 'HsMatchContext',
+-- for printing messages related to a 'Match'
+type family NameOrRdrName id where
+  NameOrRdrName Id      = Name
+  NameOrRdrName Name    = Name
+  NameOrRdrName RdrName = RdrName
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
new file mode 100644
index 0000000000..f14d59ba4a
--- /dev/null
+++ b/compiler/GHC/Hs/Types.hs
@@ -0,0 +1,1724 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+
+GHC.Hs.Types: Abstract syntax: user-defined types
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+                                      -- in module GHC.Hs.PlaceHolder
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Hs.Types (
+        HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,
+        HsTyVarBndr(..), LHsTyVarBndr, ForallVisFlag(..),
+        LHsQTyVars(..),
+        HsImplicitBndrs(..),
+        HsWildCardBndrs(..),
+        LHsSigType, LHsSigWcType, LHsWcType,
+        HsTupleSort(..),
+        HsContext, LHsContext, noLHsContext,
+        HsTyLit(..),
+        HsIPName(..), hsIPNameFS,
+        HsArg(..), numVisibleArgs,
+        LHsTypeArg,
+
+        LBangType, BangType,
+        HsSrcBang(..), HsImplBang(..),
+        SrcStrictness(..), SrcUnpackedness(..),
+        getBangType, getBangStrictness,
+
+        ConDeclField(..), LConDeclField, pprConDeclFields,
+
+        HsConDetails(..),
+
+        FieldOcc(..), LFieldOcc, mkFieldOcc,
+        AmbiguousFieldOcc(..), mkAmbiguousFieldOcc,
+        rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
+        unambiguousFieldOcc, ambiguousFieldOcc,
+
+        mkAnonWildCardTy, pprAnonWildCard,
+
+        mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
+        mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
+        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,
+        isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,
+        hsScopedTvs, hsWcScopedTvs, dropWildCards,
+        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
+        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,
+        splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
+        splitLHsPatSynTy,
+        splitLHsForAllTy, splitLHsForAllTyInvis,
+        splitLHsQualTy, splitLHsSigmaTy, splitLHsSigmaTyInvis,
+        splitHsFunType, hsTyGetAppHead_maybe,
+        mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
+        ignoreParens, hsSigType, hsSigWcType,
+        hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
+        hsConDetailsArgs,
+
+        -- Printing
+        pprHsType, pprHsForAll, pprHsForAllExtra, pprHsExplicitForAll,
+        pprLHsContext,
+        hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Hs.Expr ( HsSplice, pprSplice )
+
+import GHC.Hs.Extension
+
+import Id ( Id )
+import Name( Name )
+import RdrName ( RdrName )
+import DataCon( HsSrcBang(..), HsImplBang(..),
+                SrcStrictness(..), SrcUnpackedness(..) )
+import TysPrim( funTyConName )
+import Type
+import GHC.Hs.Doc
+import BasicTypes
+import SrcLoc
+import Outputable
+import FastString
+import Maybes( isJust )
+import Util ( count, debugIsOn )
+
+import Data.Data hiding ( Fixity, Prefix, Infix )
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Bang annotations}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Bang Type
+type LBangType pass = Located (BangType pass)
+
+-- | Bang Type
+--
+-- In the parser, strictness and packedness annotations bind more tightly
+-- than docstrings. This means that when consuming a 'BangType' (and looking
+-- for 'HsBangTy') we must be ready to peer behind a potential layer of
+-- 'HsDocTy'. See #15206 for motivation and 'getBangType' for an example.
+type BangType pass  = HsType pass       -- Bangs are in the HsType data type
+
+getBangType :: LHsType a -> LHsType a
+getBangType                 (L _ (HsBangTy _ _ lty))       = lty
+getBangType (L _ (HsDocTy x (L _ (HsBangTy _ _ lty)) lds)) =
+  addCLoc lty lds (HsDocTy x lty lds)
+getBangType lty                                            = lty
+
+getBangStrictness :: LHsType a -> HsSrcBang
+getBangStrictness                 (L _ (HsBangTy _ s _))     = s
+getBangStrictness (L _ (HsDocTy _ (L _ (HsBangTy _ s _)) _)) = s
+getBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Data types}
+*                                                                      *
+************************************************************************
+
+This is the syntax for types as seen in type signatures.
+
+Note [HsBSig binder lists]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a binder (or pattern) decorated with a type or kind,
+   \ (x :: a -> a). blah
+   forall (a :: k -> *) (b :: k). blah
+Then we use a LHsBndrSig on the binder, so that the
+renamer can decorate it with the variables bound
+by the pattern ('a' in the first example, 'k' in the second),
+assuming that neither of them is in scope already
+See also Note [Kind and type-variable binders] in RnTypes
+
+Note [HsType binders]
+~~~~~~~~~~~~~~~~~~~~~
+The system for recording type and kind-variable binders in HsTypes
+is a bit complicated.  Here's how it works.
+
+* In a HsType,
+     HsForAllTy   represents an /explicit, user-written/ 'forall'
+                   e.g.   forall a b.   {...} or
+                          forall a b -> {...}
+     HsQualTy     represents an /explicit, user-written/ context
+                   e.g.   (Eq a, Show a) => ...
+                  The context can be empty if that's what the user wrote
+  These constructors represent what the user wrote, no more
+  and no less.
+
+* The ForallVisFlag field of HsForAllTy represents whether a forall is
+  invisible (e.g., forall a b. {...}, with a dot) or visible
+  (e.g., forall a b -> {...}, with an arrow).
+
+* HsTyVarBndr describes a quantified type variable written by the
+  user.  For example
+     f :: forall a (b :: *).  blah
+  here 'a' and '(b::*)' are each a HsTyVarBndr.  A HsForAllTy has
+  a list of LHsTyVarBndrs.
+
+* HsImplicitBndrs is a wrapper that gives the implicitly-quantified
+  kind and type variables of the wrapped thing.  It is filled in by
+  the renamer. For example, if the user writes
+     f :: a -> a
+  the HsImplicitBinders binds the 'a' (not a HsForAllTy!).
+  NB: this implicit quantification is purely lexical: we bind any
+      type or kind variables that are not in scope. The type checker
+      may subsequently quantify over further kind variables.
+
+* HsWildCardBndrs is a wrapper that binds the wildcard variables
+  of the wrapped thing.  It is filled in by the renamer
+     f :: _a -> _
+  The enclosing HsWildCardBndrs binds the wildcards _a and _.
+
+* The explicit presence of these wrappers specifies, in the HsSyn,
+  exactly where implicit quantification is allowed, and where
+  wildcards are allowed.
+
+* LHsQTyVars is used in data/class declarations, where the user gives
+  explicit *type* variable bindings, but we need to implicitly bind
+  *kind* variables.  For example
+      class C (a :: k -> *) where ...
+  The 'k' is implicitly bound in the hsq_tvs field of LHsQTyVars
+
+Note [The wildcard story for types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Types can have wildcards in them, to support partial type signatures,
+like       f :: Int -> (_ , _a) -> _a
+
+A wildcard in a type can be
+
+  * An anonymous wildcard,
+        written '_'
+    In HsType this is represented by HsWildCardTy.
+    The renamer leaves it untouched, and it is later given fresh meta tyvars in
+    the typechecker.
+
+  * A named wildcard,
+        written '_a', '_foo', etc
+    In HsType this is represented by (HsTyVar "_a")
+    i.e. a perfectly ordinary type variable that happens
+         to start with an underscore
+
+Note carefully:
+
+* When NamedWildCards is off, type variables that start with an
+  underscore really /are/ ordinary type variables.  And indeed, even
+  when NamedWildCards is on you can bind _a explicitly as an ordinary
+  type variable:
+        data T _a _b = MkT _b _a
+  Or even:
+        f :: forall _a. _a -> _b
+  Here _a is an ordinary forall'd binder, but (With NamedWildCards)
+  _b is a named wildcard.  (See the comments in #10982)
+
+* Named wildcards are bound by the HsWildCardBndrs construct, which wraps
+  types that are allowed to have wildcards. Unnamed wildcards however are left
+  unchanged until typechecking, where we give them fresh wild tyavrs and
+  determine whether or not to emit hole constraints on each wildcard
+  (we don't if it's a visible type/kind argument or a type family pattern).
+  See related notes Note [Wildcards in visible kind application]
+  and Note [Wildcards in visible type application] in TcHsType.hs
+
+* After type checking is done, we report what types the wildcards
+  got unified with.
+
+Note [Ordering of implicit variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Since the advent of -XTypeApplications, GHC makes promises about the ordering
+of implicit variable quantification. Specifically, we offer that implicitly
+quantified variables (such as those in const :: a -> b -> a, without a `forall`)
+will occur in left-to-right order of first occurrence. Here are a few examples:
+
+  const :: a -> b -> a       -- forall a b. ...
+  f :: Eq a => b -> a -> a   -- forall a b. ...  contexts are included
+
+  type a <-< b = b -> a
+  g :: a <-< b               -- forall a b. ...  type synonyms matter
+
+  class Functor f where
+    fmap :: (a -> b) -> f a -> f b   -- forall f a b. ...
+    -- The f is quantified by the class, so only a and b are considered in fmap
+
+This simple story is complicated by the possibility of dependency: all variables
+must come after any variables mentioned in their kinds.
+
+  typeRep :: Typeable a => TypeRep (a :: k)   -- forall k a. ...
+
+The k comes first because a depends on k, even though the k appears later than
+the a in the code. Thus, GHC does a *stable topological sort* on the variables.
+By "stable", we mean that any two variables who do not depend on each other
+preserve their existing left-to-right ordering.
+
+Implicitly bound variables are collected by the extract- family of functions
+(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.) in RnTypes.
+These functions thus promise to keep left-to-right ordering.
+Look for pointers to this note to see the places where the action happens.
+
+Note that we also maintain this ordering in kind signatures. Even though
+there's no visible kind application (yet), having implicit variables be
+quantified in left-to-right order in kind signatures is nice since:
+
+* It's consistent with the treatment for type signatures.
+* It can affect how types are displayed with -fprint-explicit-kinds (see
+  #15568 for an example), which is a situation where knowing the order in
+  which implicit variables are quantified can be useful.
+* In the event that visible kind application is implemented, the order in
+  which we would expect implicit variables to be ordered in kinds will have
+  already been established.
+-}
+
+-- | Located Haskell Context
+type LHsContext pass = Located (HsContext pass)
+      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+noLHsContext :: LHsContext pass
+-- Use this when there is no context in the original program
+-- It would really be more kosher to use a Maybe, to distinguish
+--     class () => C a where ...
+-- from
+--     class C a where ...
+noLHsContext = noLoc []
+
+-- | Haskell Context
+type HsContext pass = [LHsType pass]
+
+-- | Located Haskell Type
+type LHsType pass = Located (HsType pass)
+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+      --   in a list
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Haskell Kind
+type HsKind pass = HsType pass
+
+-- | Located Haskell Kind
+type LHsKind pass = Located (HsKind pass)
+      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+--------------------------------------------------
+--             LHsQTyVars
+--  The explicitly-quantified binders in a data/type declaration
+
+-- | Located Haskell Type Variable Binder
+type LHsTyVarBndr pass = Located (HsTyVarBndr pass)
+                         -- See Note [HsType binders]
+
+-- | Located Haskell Quantified Type Variables
+data LHsQTyVars pass   -- See Note [HsType binders]
+  = HsQTvs { hsq_ext :: XHsQTvs pass
+
+           , hsq_explicit :: [LHsTyVarBndr pass]
+                -- Explicit variables, written by the user
+                -- See Note [HsForAllTy tyvar binders]
+    }
+  | XLHsQTyVars (XXLHsQTyVars pass)
+
+type HsQTvsRn = [Name]  -- Implicit variables
+  -- For example, in   data T (a :: k1 -> k2) = ...
+  -- the 'a' is explicit while 'k1', 'k2' are implicit
+
+type instance XHsQTvs GhcPs = NoExtField
+type instance XHsQTvs GhcRn = HsQTvsRn
+type instance XHsQTvs GhcTc = HsQTvsRn
+
+type instance XXLHsQTyVars  (GhcPass _) = NoExtCon
+
+mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
+mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }
+
+hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
+hsQTvExplicit = hsq_explicit
+
+emptyLHsQTvs :: LHsQTyVars GhcRn
+emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] }
+
+isEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool
+isEmptyLHsQTvs (HsQTvs { hsq_ext = imp, hsq_explicit = exp })
+  = null imp && null exp
+isEmptyLHsQTvs _ = False
+
+------------------------------------------------
+--            HsImplicitBndrs
+-- Used to quantify the implicit binders of a type
+--    * Implicit binders of a type signature (LHsSigType/LHsSigWcType)
+--    * Patterns in a type/data family instance (HsTyPats)
+
+-- | Haskell Implicit Binders
+data HsImplicitBndrs pass thing   -- See Note [HsType binders]
+  = HsIB { hsib_ext  :: XHsIB pass thing -- after renamer: [Name]
+                                         -- Implicitly-bound kind & type vars
+                                         -- Order is important; see
+                                         -- Note [Ordering of implicit variables]
+                                         -- in RnTypes
+
+         , hsib_body :: thing            -- Main payload (type or list of types)
+    }
+  | XHsImplicitBndrs (XXHsImplicitBndrs pass thing)
+
+type instance XHsIB              GhcPs _ = NoExtField
+type instance XHsIB              GhcRn _ = [Name]
+type instance XHsIB              GhcTc _ = [Name]
+
+type instance XXHsImplicitBndrs  (GhcPass _) _ = NoExtCon
+
+-- | Haskell Wildcard Binders
+data HsWildCardBndrs pass thing
+    -- See Note [HsType binders]
+    -- See Note [The wildcard story for types]
+  = HsWC { hswc_ext :: XHsWC pass thing
+                -- after the renamer
+                -- Wild cards, only named
+                -- See Note [Wildcards in visible kind application]
+
+         , hswc_body :: thing
+                -- Main payload (type or list of types)
+                -- If there is an extra-constraints wildcard,
+                -- it's still there in the hsc_body.
+    }
+  | XHsWildCardBndrs (XXHsWildCardBndrs pass thing)
+
+type instance XHsWC              GhcPs b = NoExtField
+type instance XHsWC              GhcRn b = [Name]
+type instance XHsWC              GhcTc b = [Name]
+
+type instance XXHsWildCardBndrs  (GhcPass _) b = NoExtCon
+
+-- | Located Haskell Signature Type
+type LHsSigType   pass = HsImplicitBndrs pass (LHsType pass)    -- Implicit only
+
+-- | Located Haskell Wildcard Type
+type LHsWcType    pass = HsWildCardBndrs pass (LHsType pass)    -- Wildcard only
+
+-- | Located Haskell Signature Wildcard Type
+type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
+
+-- See Note [Representing type signatures]
+
+hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing
+hsImplicitBody (HsIB { hsib_body = body }) = body
+hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec
+
+hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
+hsSigType = hsImplicitBody
+
+hsSigWcType :: LHsSigWcType pass -> LHsType pass
+hsSigWcType sig_ty = hsib_body (hswc_body sig_ty)
+
+dropWildCards :: LHsSigWcType pass -> LHsSigType pass
+-- Drop the wildcard part of a LHsSigWcType
+dropWildCards sig_ty = hswc_body sig_ty
+
+{- Note [Representing type signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+HsSigType is used to represent an explicit user type signature
+such as   f :: a -> a
+     or   g (x :: a -> a) = x
+
+A HsSigType is just a HsImplicitBndrs wrapping a LHsType.
+ * The HsImplicitBndrs binds the /implicitly/ quantified tyvars
+ * The LHsType binds the /explicitly/ quantified tyvars
+
+E.g. For a signature like
+   f :: forall (a::k). blah
+we get
+   HsIB { hsib_vars = [k]
+        , hsib_body = HsForAllTy { hst_bndrs = [(a::*)]
+                                 , hst_body = blah }
+The implicit kind variable 'k' is bound by the HsIB;
+the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
+-}
+
+mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
+mkHsImplicitBndrs x = HsIB { hsib_ext  = noExtField
+                           , hsib_body = x }
+
+mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
+mkHsWildCardBndrs x = HsWC { hswc_body = x
+                           , hswc_ext  = noExtField }
+
+-- Add empty binders.  This is a bit suspicious; what if
+-- the wrapped thing had free type variables?
+mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing
+mkEmptyImplicitBndrs x = HsIB { hsib_ext = []
+                              , hsib_body = x }
+
+mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
+mkEmptyWildCardBndrs x = HsWC { hswc_body = x
+                              , hswc_ext  = [] }
+
+
+--------------------------------------------------
+-- | These names are used early on to store the names of implicit
+-- parameters.  They completely disappear after type-checking.
+newtype HsIPName = HsIPName FastString
+  deriving( Eq, Data )
+
+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
+data HsTyVarBndr pass
+  = UserTyVar        -- no explicit kinding
+         (XUserTyVar pass)
+         (Located (IdP pass))
+        -- See Note [Located RdrNames] in GHC.Hs.Expr
+  | KindedTyVar
+         (XKindedTyVar pass)
+         (Located (IdP pass))
+         (LHsKind pass)  -- The user-supplied kind signature
+        -- ^
+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+        --          'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'
+
+        -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | XTyVarBndr
+      (XXTyVarBndr pass)
+
+type instance XUserTyVar    (GhcPass _) = NoExtField
+type instance XKindedTyVar  (GhcPass _) = NoExtField
+type instance XXTyVarBndr   (GhcPass _) = NoExtCon
+
+-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
+isHsKindedTyVar :: HsTyVarBndr pass -> Bool
+isHsKindedTyVar (UserTyVar {})   = False
+isHsKindedTyVar (KindedTyVar {}) = True
+isHsKindedTyVar (XTyVarBndr {})  = False
+
+-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
+hsTvbAllKinded :: LHsQTyVars pass -> Bool
+hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
+
+-- | Haskell Type
+data HsType pass
+  = HsForAllTy   -- See Note [HsType binders]
+      { hst_xforall :: XForAllTy pass
+      , hst_fvf     :: ForallVisFlag -- Is this `forall a -> {...}` or
+                                     --         `forall a. {...}`?
+      , hst_bndrs   :: [LHsTyVarBndr pass]
+                                       -- Explicit, user-supplied 'forall a b c'
+      , hst_body    :: LHsType pass      -- body type
+      }
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
+      --         'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsQualTy   -- See Note [HsType binders]
+      { hst_xqual :: XQualTy pass
+      , hst_ctxt  :: LHsContext pass       -- Context C => blah
+      , hst_body  :: LHsType pass }
+
+  | HsTyVar  (XTyVar pass)
+              PromotionFlag    -- Whether explicitly promoted,
+                               -- for the pretty printer
+             (Located (IdP pass))
+                  -- Type variable, type constructor, or data constructor
+                  -- see Note [Promotions (HsTyVar)]
+                  -- See Note [Located RdrNames] in GHC.Hs.Expr
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsAppTy             (XAppTy pass)
+                        (LHsType pass)
+                        (LHsType pass)
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsAppKindTy         (XAppKindTy pass) -- type level type app
+                        (LHsType pass)
+                        (LHsKind pass)
+
+  | HsFunTy             (XFunTy pass)
+                        (LHsType pass)   -- function type
+                        (LHsType pass)
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsListTy            (XListTy pass)
+                        (LHsType pass)  -- Element type
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
+      --         'ApiAnnotation.AnnClose' @']'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsTupleTy           (XTupleTy pass)
+                        HsTupleSort
+                        [LHsType pass]  -- Element types (length gives arity)
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,
+    --         'ApiAnnotation.AnnClose' @')' or '#)'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsSumTy             (XSumTy pass)
+                        [LHsType pass]  -- Element types (length gives arity)
+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
+    --         'ApiAnnotation.AnnClose' '#)'@
+
+    -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsOpTy              (XOpTy pass)
+                        (LHsType pass) (Located (IdP pass)) (LHsType pass)
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsParTy             (XParTy pass)
+                        (LHsType pass)   -- See Note [Parens in HsSyn] in GHC.Hs.Expr
+        -- Parenthesis preserved for the precedence re-arrangement in RnTypes
+        -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
+      --         'ApiAnnotation.AnnClose' @')'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsIParamTy          (XIParamTy pass)
+                        (Located HsIPName) -- (?x :: ty)
+                        (LHsType pass)   -- Implicit parameters as they occur in
+                                         -- contexts
+      -- ^
+      -- > (?x :: ty)
+      --
+      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsStarTy            (XStarTy pass)
+                        Bool             -- Is this the Unicode variant?
+                                         -- Note [HsStarTy]
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+  | HsKindSig           (XKindSig pass)
+                        (LHsType pass)  -- (ty :: kind)
+                        (LHsKind pass)  -- A type with a kind signature
+      -- ^
+      -- > (ty :: kind)
+      --
+      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
+      --         'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsSpliceTy          (XSpliceTy pass)
+                        (HsSplice pass)   -- Includes quasi-quotes
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
+      --         'ApiAnnotation.AnnClose' @')'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsDocTy             (XDocTy pass)
+                        (LHsType pass) LHsDocString -- A documented type
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsBangTy    (XBangTy pass)
+                HsSrcBang (LHsType pass)   -- Bang-style type annotations
+      -- ^ - 'ApiAnnotation.AnnKeywordId' :
+      --         'ApiAnnotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,
+      --         'ApiAnnotation.AnnClose' @'#-}'@
+      --         'ApiAnnotation.AnnBang' @\'!\'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsRecTy     (XRecTy pass)
+                [LConDeclField pass]    -- Only in data type declarations
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
+      --         'ApiAnnotation.AnnClose' @'}'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed*
+  --                                -- Core Type through HsSyn.
+  --     -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsExplicitListTy       -- A promoted explicit list
+        (XExplicitListTy pass)
+        PromotionFlag      -- whether explcitly promoted, for pretty printer
+        [LHsType pass]
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
+      --         'ApiAnnotation.AnnClose' @']'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsExplicitTupleTy      -- A promoted explicit tuple
+        (XExplicitTupleTy pass)
+        [LHsType pass]
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
+      --         'ApiAnnotation.AnnClose' @')'@
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsTyLit (XTyLit pass) HsTyLit      -- A promoted numeric literal.
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  | HsWildCardTy (XWildCardTy pass)  -- A type wildcard
+      -- See Note [The wildcard story for types]
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+  -- For adding new constructors via Trees that Grow
+  | XHsType
+      (XXType pass)
+
+data NewHsTypeX
+  = NHsCoreTy Type -- An escape hatch for tunnelling a *closed*
+                   -- Core Type through HsSyn.
+    deriving Data
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+
+instance Outputable NewHsTypeX where
+  ppr (NHsCoreTy ty) = ppr ty
+
+type instance XForAllTy        (GhcPass _) = NoExtField
+type instance XQualTy          (GhcPass _) = NoExtField
+type instance XTyVar           (GhcPass _) = NoExtField
+type instance XAppTy           (GhcPass _) = NoExtField
+type instance XFunTy           (GhcPass _) = NoExtField
+type instance XListTy          (GhcPass _) = NoExtField
+type instance XTupleTy         (GhcPass _) = NoExtField
+type instance XSumTy           (GhcPass _) = NoExtField
+type instance XOpTy            (GhcPass _) = NoExtField
+type instance XParTy           (GhcPass _) = NoExtField
+type instance XIParamTy        (GhcPass _) = NoExtField
+type instance XStarTy          (GhcPass _) = NoExtField
+type instance XKindSig         (GhcPass _) = NoExtField
+
+type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives
+
+type instance XSpliceTy        GhcPs = NoExtField
+type instance XSpliceTy        GhcRn = NoExtField
+type instance XSpliceTy        GhcTc = Kind
+
+type instance XDocTy           (GhcPass _) = NoExtField
+type instance XBangTy          (GhcPass _) = NoExtField
+type instance XRecTy           (GhcPass _) = NoExtField
+
+type instance XExplicitListTy  GhcPs = NoExtField
+type instance XExplicitListTy  GhcRn = NoExtField
+type instance XExplicitListTy  GhcTc = Kind
+
+type instance XExplicitTupleTy GhcPs = NoExtField
+type instance XExplicitTupleTy GhcRn = NoExtField
+type instance XExplicitTupleTy GhcTc = [Kind]
+
+type instance XTyLit           (GhcPass _) = NoExtField
+
+type instance XWildCardTy      (GhcPass _) = NoExtField
+
+type instance XXType         (GhcPass _) = NewHsTypeX
+
+
+-- Note [Literal source text] in BasicTypes for SourceText fields in
+-- the following
+-- | Haskell Type Literal
+data HsTyLit
+  = HsNumTy SourceText Integer
+  | HsStrTy SourceText FastString
+    deriving Data
+
+
+{-
+Note [HsForAllTy tyvar binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+After parsing:
+  * Implicit => empty
+    Explicit => the variables the user wrote
+
+After renaming
+  * Implicit => the *type* variables free in the type
+    Explicit => the variables the user wrote (renamed)
+
+Qualified currently behaves exactly as Implicit,
+but it is deprecated to use it for implicit quantification.
+In this case, GHC 7.10 gives a warning; see
+Note [Context quantification] in RnTypes, and #4426.
+In GHC 8.0, Qualified will no longer bind variables
+and this will become an error.
+
+The kind variables bound in the hsq_implicit field come both
+  a) from the kind signatures on the kind vars (eg k1)
+  b) from the scope of the forall (eg k2)
+Example:   f :: forall (a::k1) b. T a (b::k2)
+
+
+Note [Unit tuples]
+~~~~~~~~~~~~~~~~~~
+Consider the type
+    type instance F Int = ()
+We want to parse that "()"
+    as HsTupleTy HsBoxedOrConstraintTuple [],
+NOT as HsTyVar unitTyCon
+
+Why? Because F might have kind (* -> Constraint), so we when parsing we
+don't know if that tuple is going to be a constraint tuple or an ordinary
+unit tuple.  The HsTupleSort flag is specifically designed to deal with
+that, but it has to work for unit tuples too.
+
+Note [Promotions (HsTyVar)]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+HsTyVar: A name in a type or kind.
+  Here are the allowed namespaces for the name.
+    In a type:
+      Var: not allowed
+      Data: promoted data constructor
+      Tv: type variable
+      TcCls before renamer: type constructor, class constructor, or promoted data constructor
+      TcCls after renamer: type constructor or class constructor
+    In a kind:
+      Var, Data: not allowed
+      Tv: kind variable
+      TcCls: kind constructor or promoted type constructor
+
+  The 'Promoted' field in an HsTyVar captures whether the type was promoted in
+  the source code by prefixing an apostrophe.
+
+Note [HsStarTy]
+~~~~~~~~~~~~~~~
+When the StarIsType extension is enabled, we want to treat '*' and its Unicode
+variant identically to 'Data.Kind.Type'. Unfortunately, doing so in the parser
+would mean that when we pretty-print it back, we don't know whether the user
+wrote '*' or 'Type', and lose the parse/ppr roundtrip property.
+
+As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type')
+and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type).
+When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not
+involved.
+
+
+Note [Promoted lists and tuples]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Notice the difference between
+   HsListTy    HsExplicitListTy
+   HsTupleTy   HsExplicitListTupleTy
+
+E.g.    f :: [Int]                      HsListTy
+
+        g3  :: T '[]                   All these use
+        g2  :: T '[True]                  HsExplicitListTy
+        g1  :: T '[True,False]
+        g1a :: T [True,False]             (can omit ' where unambiguous)
+
+  kind of T :: [Bool] -> *        This kind uses HsListTy!
+
+E.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair
+        k :: S '(True,False)            HsExplicitTypleTy; S is indexed by
+                                           a type-level pair of booleans
+        kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy
+
+Note [Distinguishing tuple kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Apart from promotion, tuples can have one of three different kinds:
+
+        x :: (Int, Bool)                -- Regular boxed tuples
+        f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples
+        g :: (Eq a, Ord a) => a         -- Constraint tuples
+
+For convenience, internally we use a single constructor for all of these,
+namely HsTupleTy, but keep track of the tuple kind (in the first argument to
+HsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,
+because of the #. However, with -XConstraintKinds we can only distinguish
+between constraint and boxed tuples during type checking, in general. Hence the
+four constructors of HsTupleSort:
+
+        HsUnboxedTuple                  -> Produced by the parser
+        HsBoxedTuple                    -> Certainly a boxed tuple
+        HsConstraintTuple               -> Certainly a constraint tuple
+        HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint
+                                        tuple. Produced by the parser only,
+                                        disappears after type checking
+-}
+
+-- | Haskell Tuple Sort
+data HsTupleSort = HsUnboxedTuple
+                 | HsBoxedTuple
+                 | HsConstraintTuple
+                 | HsBoxedOrConstraintTuple
+                 deriving Data
+
+-- | Located Constructor Declaration Field
+type LConDeclField pass = Located (ConDeclField pass)
+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+      --   in a list
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+
+-- | Constructor Declaration Field
+data ConDeclField pass  -- Record fields have Haddoc docs on them
+  = ConDeclField { cd_fld_ext  :: XConDeclField pass,
+                   cd_fld_names :: [LFieldOcc pass],
+                                   -- ^ See Note [ConDeclField passs]
+                   cd_fld_type :: LBangType pass,
+                   cd_fld_doc  :: Maybe LHsDocString }
+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+
+      -- For details on above see note [Api annotations] in ApiAnnotation
+  | XConDeclField (XXConDeclField pass)
+
+type instance XConDeclField  (GhcPass _) = NoExtField
+type instance XXConDeclField (GhcPass _) = NoExtCon
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (ConDeclField p) where
+  ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty
+  ppr (XConDeclField x) = ppr x
+
+-- HsConDetails is used for patterns/expressions *and* for data type
+-- declarations
+-- | Haskell Constructor Details
+data HsConDetails arg rec
+  = PrefixCon [arg]             -- C p1 p2 p3
+  | RecCon    rec               -- C { x = p1, y = p2 }
+  | InfixCon  arg arg           -- p1 `C` p2
+  deriving Data
+
+instance (Outputable arg, Outputable rec)
+         => Outputable (HsConDetails arg rec) where
+  ppr (PrefixCon args) = text "PrefixCon" <+> ppr args
+  ppr (RecCon rec)     = text "RecCon:" <+> ppr rec
+  ppr (InfixCon l r)   = text "InfixCon:" <+> ppr [l, r]
+
+hsConDetailsArgs ::
+     HsConDetails (LHsType a) (Located [LConDeclField a])
+  -> [LHsType a]
+hsConDetailsArgs details = case details of
+  InfixCon a b -> [a,b]
+  PrefixCon xs -> xs
+  RecCon r -> map (cd_fld_type . unLoc) (unLoc r)
+
+{-
+Note [ConDeclField passs]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A ConDeclField contains a list of field occurrences: these always
+include the field label as the user wrote it.  After the renamer, it
+will additionally contain the identity of the selector function in the
+second component.
+
+Due to DuplicateRecordFields, the OccName of the selector function
+may have been mangled, which is why we keep the original field label
+separately.  For example, when DuplicateRecordFields is enabled
+
+    data T = MkT { x :: Int }
+
+gives
+
+    ConDeclField { cd_fld_names = [L _ (FieldOcc "x" $sel:x:MkT)], ... }.
+-}
+
+-----------------------
+-- A valid type must have a for-all at the top of the type, or of the fn arg
+-- types
+
+---------------------
+hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]
+-- Get the lexically-scoped type variables of a HsSigType
+--  - the explicitly-given forall'd type variables
+--  - the named wildcars; see Note [Scoping of named wildcards]
+-- because they scope in the same way
+hsWcScopedTvs sig_ty
+  | HsWC { hswc_ext = nwcs, hswc_body = sig_ty1 }  <- sig_ty
+  , HsIB { hsib_ext = vars
+         , hsib_body = sig_ty2 } <- sig_ty1
+  = case sig_ty2 of
+      L _ (HsForAllTy { hst_fvf = vis_flag
+                      , hst_bndrs = tvs }) ->
+        ASSERT( vis_flag == ForallInvis ) -- See Note [hsScopedTvs vis_flag]
+        vars ++ nwcs ++ hsLTyVarNames tvs
+      _                                    -> nwcs
+hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec
+
+hsScopedTvs :: LHsSigType GhcRn -> [Name]
+-- Same as hsWcScopedTvs, but for a LHsSigType
+hsScopedTvs sig_ty
+  | HsIB { hsib_ext = vars
+         , hsib_body = sig_ty2 } <- sig_ty
+  , L _ (HsForAllTy { hst_fvf = vis_flag
+                    , hst_bndrs = tvs }) <- sig_ty2
+  = ASSERT( vis_flag == ForallInvis ) -- See Note [hsScopedTvs vis_flag]
+    vars ++ hsLTyVarNames tvs
+  | otherwise
+  = []
+
+{- Note [Scoping of named wildcards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  f :: _a -> _a
+  f x = let g :: _a -> _a
+            g = ...
+        in ...
+
+Currently, for better or worse, the "_a" variables are all the same. So
+although there is no explicit forall, the "_a" scopes over the definition.
+I don't know if this is a good idea, but there it is.
+-}
+
+{- Note [hsScopedTvs vis_flag]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-XScopedTypeVariables can be defined in terms of a desugaring to
+-XTypeAbstractions (GHC Proposal #50):
+
+    fn :: forall a b c. tau(a,b,c)            fn :: forall a b c. tau(a,b,c)
+    fn = defn(a,b,c)                   ==>    fn @x @y @z = defn(x,y,z)
+
+That is, for every type variable of the leading 'forall' in the type signature,
+we add an invisible binder at term level.
+
+This model does not extend to visible forall, as discussed here:
+
+* https://gitlab.haskell.org/ghc/ghc/issues/16734#note_203412
+* https://github.com/ghc-proposals/ghc-proposals/pull/238
+
+The conclusion of these discussions can be summarized as follows:
+
+  > Assuming support for visible 'forall' in terms, consider this example:
+  >
+  >     vfn :: forall x y -> tau(x,y)
+  >     vfn = \a b -> ...
+  >
+  > The user has written their own binders 'a' and 'b' to stand for 'x' and
+  > 'y', and we definitely should not desugar this into:
+  >
+  >     vfn :: forall x y -> tau(x,y)
+  >     vfn x y = \a b -> ...         -- bad!
+
+At the moment, GHC does not support visible 'forall' in terms, so we simply cement
+our assumptions with an assert:
+
+    hsScopedTvs (HsForAllTy { hst_fvf = vis_flag, ... }) =
+      ASSERT( vis_flag == ForallInvis )
+      ...
+
+In the future, this assert can be safely turned into a pattern match to support
+visible forall in terms:
+
+    hsScopedTvs (HsForAllTy { hst_fvf = ForallInvis, ... }) = ...
+-}
+
+---------------------
+hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
+hsTyVarName (UserTyVar _ (L _ n))     = n
+hsTyVarName (KindedTyVar _ (L _ n) _) = n
+hsTyVarName (XTyVarBndr nec) = noExtCon nec
+
+hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
+hsLTyVarName = hsTyVarName . unLoc
+
+hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
+hsLTyVarNames = map hsLTyVarName
+
+hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
+-- Explicit variables only
+hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
+
+hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
+-- All variables
+hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
+                         , hsq_explicit = tvs })
+  = kvs ++ hsLTyVarNames tvs
+hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec
+
+hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
+hsLTyVarLocName = onHasSrcSpan hsTyVarName
+
+hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))]
+hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
+
+-- | Convert a LHsTyVarBndr to an equivalent LHsType.
+hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)
+hsLTyVarBndrToType = onHasSrcSpan cvt
+  where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
+        cvt (KindedTyVar _ (L name_loc n) kind)
+          = HsKindSig noExtField
+                   (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind
+        cvt (XTyVarBndr nec) = noExtCon nec
+
+-- | Convert a LHsTyVarBndrs to a list of types.
+-- Works on *type* variable only, no kind vars.
+hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
+hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
+hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec
+
+---------------------
+ignoreParens :: LHsType pass -> LHsType pass
+ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty
+ignoreParens ty                   = ty
+
+isLHsForAllTy :: LHsType p -> Bool
+isLHsForAllTy (L _ (HsForAllTy {})) = True
+isLHsForAllTy _                     = False
+
+{-
+************************************************************************
+*                                                                      *
+                Building types
+*                                                                      *
+************************************************************************
+-}
+
+mkAnonWildCardTy :: HsType GhcPs
+mkAnonWildCardTy = HsWildCardTy noExtField
+
+mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))
+         -> LHsType (GhcPass p) -> HsType (GhcPass p)
+mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2
+
+mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppTy t1 t2
+  = addCLoc t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
+
+mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
+           -> LHsType (GhcPass p)
+mkHsAppTys = foldl' mkHsAppTy
+
+mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+              -> LHsType (GhcPass p)
+mkHsAppKindTy ext ty k
+  = addCLoc ty k (HsAppKindTy ext ty k)
+
+{-
+************************************************************************
+*                                                                      *
+                Decomposing HsTypes
+*                                                                      *
+************************************************************************
+-}
+
+---------------------------------
+-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
+-- Breaks up any parens in the result type:
+--      splitHsFunType (a -> (b -> c)) = ([a,b], c)
+-- Also deals with (->) t1 t2; that is why it only works on LHsType Name
+--   (see #9096)
+splitHsFunType :: LHsType GhcRn -> ([LHsType GhcRn], LHsType GhcRn)
+splitHsFunType (L _ (HsParTy _ ty))
+  = splitHsFunType ty
+
+splitHsFunType (L _ (HsFunTy _ x y))
+  | (args, res) <- splitHsFunType y
+  = (x:args, res)
+{- This is not so correct, because it won't work with visible kind app, in case
+  someone wants to write '(->) @k1 @k2 t1 t2'. Fixing this would require changing
+  ConDeclGADT abstract syntax -}
+splitHsFunType orig_ty@(L _ (HsAppTy _ t1 t2))
+  = go t1 [t2]
+  where  -- Look for (->) t1 t2, possibly with parenthesisation
+    go (L _ (HsTyVar _ _ (L _ fn))) tys | fn == funTyConName
+                                 , [t1,t2] <- tys
+                                 , (args, res) <- splitHsFunType t2
+                                 = (t1:args, res)
+    go (L _ (HsAppTy _ t1 t2)) tys = go t1 (t2:tys)
+    go (L _ (HsParTy _ ty))    tys = go ty tys
+    go _                       _   = ([], orig_ty)  -- Failure to match
+
+splitHsFunType other = ([], other)
+
+-- retrieve the name of the "head" of a nested type application
+-- somewhat like splitHsAppTys, but a little more thorough
+-- used to examine the result of a GADT-like datacon, so it doesn't handle
+-- *all* cases (like lists, tuples, (~), etc.)
+hsTyGetAppHead_maybe :: LHsType (GhcPass p)
+                     -> Maybe (Located (IdP (GhcPass p)))
+hsTyGetAppHead_maybe = go
+  where
+    go (L _ (HsTyVar _ _ ln))          = Just ln
+    go (L _ (HsAppTy _ l _))           = go l
+    go (L _ (HsAppKindTy _ t _))       = go t
+    go (L _ (HsOpTy _ _ (L loc n) _))  = Just (L loc n)
+    go (L _ (HsParTy _ t))             = go t
+    go (L _ (HsKindSig _ t _))         = go t
+    go _                               = Nothing
+
+------------------------------------------------------------
+-- Arguments in an expression/type after splitting
+data HsArg tm ty
+  = HsValArg tm   -- Argument is an ordinary expression     (f arg)
+  | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @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)
+
+instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
+  ppr (HsValArg tm)    = ppr tm
+  ppr (HsTypeArg _ ty) = char '@' <> ppr ty
+  ppr (HsArgPar sp)    = text "HsArgPar"  <+> ppr sp
+{-
+Note [HsArgPar]
+A HsArgPar indicates that everything to the left of this in the argument list is
+enclosed in parentheses together with the function itself. It is necessary so
+that we can recreate the parenthesis structure in the original source after
+typechecking the arguments.
+
+The SrcSpan is the span of the original HsPar
+
+((f arg1) arg2 arg3) results in an input argument list of
+[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2]
+
+-}
+
+--------------------------------
+
+-- | Decompose a pattern synonym type signature into its constituent parts.
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall a. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsPatSynTy :: LHsType pass
+                 -> ( [LHsTyVarBndr pass]    -- universals
+                    , LHsContext pass        -- required constraints
+                    , [LHsTyVarBndr pass]    -- existentials
+                    , LHsContext pass        -- provided constraints
+                    , LHsType pass)          -- body type
+splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
+  where
+    (univs, ty1) = splitLHsForAllTyInvis ty
+    (reqs,  ty2) = splitLHsQualTy ty1
+    (exis,  ty3) = splitLHsForAllTyInvis ty2
+    (provs, ty4) = splitLHsQualTy ty3
+
+-- | Decompose a sigma type (of the form @forall <tvs>. context => body@)
+-- into its constituent parts.
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall a. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsSigmaTy :: LHsType pass
+                -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
+splitLHsSigmaTy ty
+  | (tvs, ty1)  <- splitLHsForAllTy ty
+  , (ctxt, ty2) <- splitLHsQualTy ty1
+  = (tvs, ctxt, ty2)
+
+-- | Like 'splitLHsSigmaTy', but only splits type variable binders that were
+-- quantified invisibly (e.g., @forall a.@, with a dot).
+--
+-- This function is used to split apart certain types, such as instance
+-- declaration types, which disallow visible @forall@s. For instance, if GHC
+-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that
+-- declaration would mistakenly be accepted!
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall a. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsSigmaTyInvis :: LHsType pass
+                     -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
+splitLHsSigmaTyInvis ty
+  | (tvs,  ty1) <- splitLHsForAllTyInvis ty
+  , (ctxt, ty2) <- splitLHsQualTy ty1
+  = (tvs, ctxt, ty2)
+
+-- | Decompose a type of the form @forall <tvs>. body@) into its constituent
+-- parts.
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall a. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
+splitLHsForAllTy (L _ (HsParTy _ ty)) = splitLHsForAllTy ty
+splitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body)
+splitLHsForAllTy body              = ([], body)
+
+-- | Like 'splitLHsForAllTy', but only splits type variable binders that
+-- were quantified invisibly (e.g., @forall a.@, with a dot).
+--
+-- This function is used to split apart certain types, such as instance
+-- declaration types, which disallow visible @forall@s. For instance, if GHC
+-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that
+-- declaration would mistakenly be accepted!
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall a. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsForAllTyInvis :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
+splitLHsForAllTyInvis lty@(L _ ty) =
+  case ty of
+    HsParTy _ ty' -> splitLHsForAllTyInvis ty'
+    HsForAllTy { hst_fvf = fvf', hst_bndrs = tvs', hst_body = body' }
+      |  fvf' == ForallInvis
+      -> (tvs', body')
+    _ -> ([], lty)
+
+-- | Decompose a type of the form @context => body@ into its constituent parts.
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(context => <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass)
+splitLHsQualTy (L _ (HsParTy _ ty)) = splitLHsQualTy ty
+splitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt,     body)
+splitLHsQualTy body              = (noLHsContext, body)
+
+-- | Decompose a type class instance type (of the form
+-- @forall <tvs>. context => instance_head@) into its constituent parts.
+--
+-- Note that this function looks through parentheses, so it will work on types
+-- such as @(forall <tvs>. <...>)@. The downside to this is that it is not
+-- generally possible to take the returned types and reconstruct the original
+-- type (parentheses and all) from them.
+splitLHsInstDeclTy :: LHsSigType GhcRn
+                   -> ([Name], LHsContext GhcRn, LHsType GhcRn)
+-- Split up an instance decl type, returning the pieces
+splitLHsInstDeclTy (HsIB { hsib_ext = itkvs
+                         , hsib_body = inst_ty })
+  | (tvs, cxt, body_ty) <- splitLHsSigmaTyInvis inst_ty
+  = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)
+         -- Return implicitly bound type and kind vars
+         -- For an instance decl, all of them are in scope
+splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec
+
+getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
+getLHsInstDeclHead inst_ty
+  | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)
+  = body_ty
+
+getLHsInstDeclClass_maybe :: LHsSigType (GhcPass p)
+                          -> Maybe (Located (IdP (GhcPass p)))
+-- Works on (HsSigType RdrName)
+getLHsInstDeclClass_maybe inst_ty
+  = do { let head_ty = getLHsInstDeclHead inst_ty
+       ; cls <- hsTyGetAppHead_maybe head_ty
+       ; return cls }
+
+{-
+************************************************************************
+*                                                                      *
+                FieldOcc
+*                                                                      *
+************************************************************************
+-}
+
+-- | Located Field Occurrence
+type LFieldOcc pass = Located (FieldOcc pass)
+
+-- | Field Occurrence
+--
+-- Represents an *occurrence* of an unambiguous field.  We store
+-- both the 'RdrName' the user originally wrote, and after the
+-- renamer, the selector function.
+data FieldOcc pass = FieldOcc { extFieldOcc     :: XCFieldOcc pass
+                              , rdrNameFieldOcc :: Located RdrName
+                                 -- ^ See Note [Located RdrNames] in GHC.Hs.Expr
+                              }
+
+  | XFieldOcc
+      (XXFieldOcc pass)
+deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq  (FieldOcc p)
+deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)
+
+type instance XCFieldOcc GhcPs = NoExtField
+type instance XCFieldOcc GhcRn = Name
+type instance XCFieldOcc GhcTc = Id
+
+type instance XXFieldOcc (GhcPass _) = NoExtCon
+
+instance Outputable (FieldOcc pass) where
+  ppr = ppr . rdrNameFieldOcc
+
+mkFieldOcc :: Located RdrName -> FieldOcc GhcPs
+mkFieldOcc rdr = FieldOcc noExtField rdr
+
+
+-- | Ambiguous Field Occurrence
+--
+-- Represents an *occurrence* of a field that is potentially
+-- ambiguous after the renamer, with the ambiguity resolved by the
+-- typechecker.  We always store the 'RdrName' that the user
+-- originally wrote, and store the selector function after the renamer
+-- (for unambiguous occurrences) or the typechecker (for ambiguous
+-- occurrences).
+--
+-- See Note [HsRecField and HsRecUpdField] in GHC.Hs.Pat and
+-- Note [Disambiguating record fields] in TcExpr.
+-- See Note [Located RdrNames] in GHC.Hs.Expr
+data AmbiguousFieldOcc pass
+  = Unambiguous (XUnambiguous pass) (Located RdrName)
+  | Ambiguous   (XAmbiguous pass)   (Located RdrName)
+  | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)
+
+type instance XUnambiguous GhcPs = NoExtField
+type instance XUnambiguous GhcRn = Name
+type instance XUnambiguous GhcTc = Id
+
+type instance XAmbiguous GhcPs = NoExtField
+type instance XAmbiguous GhcRn = NoExtField
+type instance XAmbiguous GhcTc = Id
+
+type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon
+
+instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where
+  ppr = ppr . rdrNameAmbiguousFieldOcc
+
+instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where
+  pprInfixOcc  = pprInfixOcc . rdrNameAmbiguousFieldOcc
+  pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
+
+mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs
+mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr
+
+rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName
+rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr
+rdrNameAmbiguousFieldOcc (Ambiguous   _ (L _ rdr)) = rdr
+rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+  = noExtCon nec
+
+selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
+selectorAmbiguousFieldOcc (Unambiguous sel _) = sel
+selectorAmbiguousFieldOcc (Ambiguous   sel _) = sel
+selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+  = noExtCon nec
+
+unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
+unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
+unambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel
+unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec
+
+ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
+ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr
+ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Pretty printing}
+*                                                                      *
+************************************************************************
+-}
+
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsType p) where
+    ppr ty = pprHsType ty
+
+instance Outputable HsTyLit where
+    ppr = ppr_tylit
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (LHsQTyVars p) where
+    ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
+    ppr (XLHsQTyVars x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (HsTyVarBndr p) where
+    ppr (UserTyVar _ n)     = ppr n
+    ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
+    ppr (XTyVarBndr n)      = ppr n
+
+instance (p ~ GhcPass pass,Outputable thing)
+       => Outputable (HsImplicitBndrs p thing) where
+    ppr (HsIB { hsib_body = ty }) = ppr ty
+    ppr (XHsImplicitBndrs x) = ppr x
+
+instance (p ~ GhcPass pass,Outputable thing)
+       => Outputable (HsWildCardBndrs p thing) where
+    ppr (HsWC { hswc_body = ty }) = ppr ty
+    ppr (XHsWildCardBndrs x) = ppr x
+
+pprAnonWildCard :: SDoc
+pprAnonWildCard = char '_'
+
+-- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@
+-- only when @-dppr-debug@ is enabled.
+pprHsForAll :: (OutputableBndrId (GhcPass p))
+            => ForallVisFlag -> [LHsTyVarBndr (GhcPass p)]
+            -> LHsContext (GhcPass p) -> SDoc
+pprHsForAll = pprHsForAllExtra Nothing
+
+-- | Version of 'pprHsForAll' that can also print an extra-constraints
+-- wildcard, e.g. @_ => a -> Bool@ or @(Show a, _) => a -> String@. This
+-- underscore will be printed when the 'Maybe SrcSpan' argument is a 'Just'
+-- containing the location of the extra-constraints wildcard. A special
+-- function for this is needed, as the extra-constraints wildcard is removed
+-- from the actual context and type, and stored in a separate field, thus just
+-- printing the type will not print the extra-constraints wildcard.
+pprHsForAllExtra :: (OutputableBndrId (GhcPass p))
+                 => Maybe SrcSpan -> ForallVisFlag
+                 -> [LHsTyVarBndr (GhcPass p)]
+                 -> LHsContext (GhcPass p) -> SDoc
+pprHsForAllExtra extra fvf qtvs cxt
+  = pp_forall <+> pprLHsContextExtra (isJust extra) cxt
+  where
+    pp_forall | null qtvs = whenPprDebug (forAllLit <> separator)
+              | otherwise = forAllLit <+> interppSP qtvs <> separator
+
+    separator = ppr_forall_separator fvf
+
+-- | Version of 'pprHsForAll' or 'pprHsForAllExtra' that will always print
+-- @forall.@ when passed @Just []@. Prints nothing if passed 'Nothing'
+pprHsExplicitForAll :: (OutputableBndrId (GhcPass p))
+                    => ForallVisFlag
+                    -> Maybe [LHsTyVarBndr (GhcPass p)] -> SDoc
+pprHsExplicitForAll fvf (Just qtvs) = forAllLit <+> interppSP qtvs
+                                                 <> ppr_forall_separator fvf
+pprHsExplicitForAll _   Nothing     = empty
+
+-- | Prints an arrow for visible @forall@s (e.g., @forall a ->@) and a dot for
+-- invisible @forall@s (e.g., @forall a.@).
+ppr_forall_separator :: ForallVisFlag -> SDoc
+ppr_forall_separator ForallVis   = space <> arrow
+ppr_forall_separator ForallInvis = dot
+
+pprLHsContext :: (OutputableBndrId (GhcPass p))
+              => LHsContext (GhcPass p) -> SDoc
+pprLHsContext lctxt
+  | null (unLoc lctxt) = empty
+  | otherwise          = pprLHsContextAlways lctxt
+
+-- For use in a HsQualTy, which always gets printed if it exists.
+pprLHsContextAlways :: (OutputableBndrId (GhcPass p))
+                    => LHsContext (GhcPass p) -> SDoc
+pprLHsContextAlways (L _ ctxt)
+  = case ctxt of
+      []       -> parens empty             <+> darrow
+      [L _ ty] -> ppr_mono_ty ty           <+> darrow
+      _        -> parens (interpp'SP ctxt) <+> darrow
+
+-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@
+pprLHsContextExtra :: (OutputableBndrId (GhcPass p))
+                   => Bool -> LHsContext (GhcPass p) -> SDoc
+pprLHsContextExtra show_extra lctxt@(L _ ctxt)
+  | not show_extra = pprLHsContext lctxt
+  | null ctxt      = char '_' <+> darrow
+  | otherwise      = parens (sep (punctuate comma ctxt')) <+> darrow
+  where
+    ctxt' = map ppr ctxt ++ [char '_']
+
+pprConDeclFields :: (OutputableBndrId (GhcPass p))
+                 => [LConDeclField (GhcPass p)] -> SDoc
+pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
+  where
+    ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,
+                                 cd_fld_doc = doc }))
+        = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
+    ppr_fld (L _ (XConDeclField x)) = ppr x
+    ppr_names [n] = ppr n
+    ppr_names ns = sep (punctuate comma (map ppr ns))
+
+{-
+Note [Printing KindedTyVars]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#3830 reminded me that we should really only print the kind
+signature on a KindedTyVar if the kind signature was put there by the
+programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,
+rather than converting to KindedTyVars as before.
+
+(As it happens, the message in #3830 comes out a different way now,
+and the problem doesn't show up; but having the flag on a KindedTyVar
+seems like the Right Thing anyway.)
+-}
+
+-- Printing works more-or-less as for Types
+
+pprHsType :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc
+pprHsType ty = ppr_mono_ty ty
+
+ppr_mono_lty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> SDoc
+ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
+
+ppr_mono_ty :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc
+ppr_mono_ty (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs, hst_body = ty })
+  = sep [pprHsForAll fvf tvs noLHsContext, ppr_mono_lty ty]
+
+ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty })
+  = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty]
+
+ppr_mono_ty (HsBangTy _ b ty)   = ppr b <> ppr_mono_lty ty
+ppr_mono_ty (HsRecTy _ flds)      = pprConDeclFields flds
+ppr_mono_ty (HsTyVar _ prom (L _ name))
+  | isPromoted prom = quote (pprPrefixOcc name)
+  | otherwise       = pprPrefixOcc name
+ppr_mono_ty (HsFunTy _ ty1 ty2)   = ppr_fun_ty ty1 ty2
+ppr_mono_ty (HsTupleTy _ con tys) = tupleParens std_con (pprWithCommas ppr tys)
+  where std_con = case con of
+                    HsUnboxedTuple -> UnboxedTuple
+                    _              -> BoxedTuple
+ppr_mono_ty (HsSumTy _ tys)
+  = tupleParens UnboxedTuple (pprWithBars ppr tys)
+ppr_mono_ty (HsKindSig _ ty kind)
+  = ppr_mono_lty ty <+> dcolon <+> ppr kind
+ppr_mono_ty (HsListTy _ ty)       = brackets (ppr_mono_lty ty)
+ppr_mono_ty (HsIParamTy _ n ty)   = (ppr n <+> dcolon <+> ppr_mono_lty ty)
+ppr_mono_ty (HsSpliceTy _ s)      = pprSplice s
+ppr_mono_ty (HsExplicitListTy _ prom tys)
+  | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)
+  | otherwise       = brackets (interpp'SP tys)
+ppr_mono_ty (HsExplicitTupleTy _ tys)
+  = quote $ parens (maybeAddSpace tys $ interpp'SP tys)
+ppr_mono_ty (HsTyLit _ t)       = ppr_tylit t
+ppr_mono_ty (HsWildCardTy {})   = char '_'
+
+ppr_mono_ty (HsStarTy _ isUni)  = char (if isUni then '★' else '*')
+
+ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
+  = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
+ppr_mono_ty (HsAppKindTy _ ty k)
+  = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
+ppr_mono_ty (HsOpTy _ ty1 (L _ op) ty2)
+  = sep [ ppr_mono_lty ty1
+        , sep [pprInfixOcc op, ppr_mono_lty ty2 ] ]
+
+ppr_mono_ty (HsParTy _ ty)
+  = parens (ppr_mono_lty ty)
+  -- Put the parens in where the user did
+  -- But we still use the precedence stuff to add parens because
+  --    toHsType doesn't put in any HsParTys, so we may still need them
+
+ppr_mono_ty (HsDocTy _ ty doc)
+  -- AZ: Should we add parens?  Should we introduce "-- ^"?
+  = ppr_mono_lty ty <+> ppr (unLoc doc)
+  -- we pretty print Haddock comments on types as if they were
+  -- postfix operators
+
+ppr_mono_ty (XHsType t) = ppr t
+
+--------------------------
+ppr_fun_ty :: (OutputableBndrId (GhcPass p))
+           => LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
+ppr_fun_ty ty1 ty2
+  = let p1 = ppr_mono_lty ty1
+        p2 = ppr_mono_lty ty2
+    in
+    sep [p1, arrow <+> p2]
+
+--------------------------
+ppr_tylit :: HsTyLit -> SDoc
+ppr_tylit (HsNumTy _ i) = integer i
+ppr_tylit (HsStrTy _ s) = text (show s)
+
+
+-- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses
+-- under precedence @p@.
+hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool
+hsTypeNeedsParens p = go
+  where
+    go (HsForAllTy{})        = p >= funPrec
+    go (HsQualTy{})          = p >= funPrec
+    go (HsBangTy{})          = p > topPrec
+    go (HsRecTy{})           = False
+    go (HsTyVar{})           = False
+    go (HsFunTy{})           = p >= funPrec
+    go (HsTupleTy{})         = False
+    go (HsSumTy{})           = False
+    go (HsKindSig{})         = p >= sigPrec
+    go (HsListTy{})          = False
+    go (HsIParamTy{})        = p > topPrec
+    go (HsSpliceTy{})        = False
+    go (HsExplicitListTy{})  = False
+    go (HsExplicitTupleTy{}) = False
+    go (HsTyLit{})           = False
+    go (HsWildCardTy{})      = False
+    go (HsStarTy{})          = False
+    go (HsAppTy{})           = p >= appPrec
+    go (HsAppKindTy{})       = p >= appPrec
+    go (HsOpTy{})            = p >= opPrec
+    go (HsParTy{})           = False
+    go (HsDocTy _ (L _ t) _) = go t
+    go (XHsType{})           = False
+
+maybeAddSpace :: [LHsType pass] -> SDoc -> SDoc
+-- See Note [Printing promoted type constructors]
+-- in IfaceType.  This code implements the same
+-- logic for printing HsType
+maybeAddSpace tys doc
+  | (ty : _) <- tys
+  , lhsTypeHasLeadingPromotionQuote ty = space <> doc
+  | otherwise                          = doc
+
+lhsTypeHasLeadingPromotionQuote :: LHsType pass -> Bool
+lhsTypeHasLeadingPromotionQuote ty
+  = goL ty
+  where
+    goL (L _ ty) = go ty
+
+    go (HsForAllTy{})        = False
+    go (HsQualTy{ hst_ctxt = ctxt, hst_body = body})
+      | L _ (c:_) <- ctxt    = goL c
+      | otherwise            = goL body
+    go (HsBangTy{})          = False
+    go (HsRecTy{})           = False
+    go (HsTyVar _ p _)       = isPromoted p
+    go (HsFunTy _ arg _)     = goL arg
+    go (HsListTy{})          = False
+    go (HsTupleTy{})         = False
+    go (HsSumTy{})           = False
+    go (HsOpTy _ t1 _ _)     = goL t1
+    go (HsKindSig _ t _)     = goL t
+    go (HsIParamTy{})        = False
+    go (HsSpliceTy{})        = False
+    go (HsExplicitListTy _ p _) = isPromoted p
+    go (HsExplicitTupleTy{}) = True
+    go (HsTyLit{})           = False
+    go (HsWildCardTy{})      = False
+    go (HsStarTy{})          = False
+    go (HsAppTy _ t _)       = goL t
+    go (HsAppKindTy _ t _)   = goL t
+    go (HsParTy{})           = False
+    go (HsDocTy _ t _)       = goL t
+    go (XHsType{})           = False
+
+-- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is
+-- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply
+-- returns @ty@.
+parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+parenthesizeHsType p lty@(L loc ty)
+  | hsTypeNeedsParens p ty = L loc (HsParTy noExtField lty)
+  | otherwise              = lty
+
+-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint
+-- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@
+-- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply
+-- returns @ctxt@ unchanged.
+parenthesizeHsContext :: PprPrec
+                      -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
+parenthesizeHsContext p lctxt@(L loc ctxt) =
+  case ctxt of
+    [c] -> L loc [parenthesizeHsType p c]
+    _   -> lctxt -- Other contexts are already "parenthesized" by virtue of
+                 -- being tuples.
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
new file mode 100644
index 0000000000..5d54196af2
--- /dev/null
+++ b/compiler/GHC/Hs/Utils.hs
@@ -0,0 +1,1416 @@
+{-
+(c) The University of Glasgow, 1992-2006
+
+
+Here we collect a variety of helper functions that construct or
+analyse HsSyn.  All these functions deal with generic HsSyn; functions
+which deal with the instantiated versions are located elsewhere:
+
+   Parameterised by          Module
+   ----------------          -------------
+   GhcPs/RdrName             parser/RdrHsSyn
+   GhcRn/Name                rename/RnHsSyn
+   GhcTc/Id                  typecheck/TcHsSyn
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module GHC.Hs.Utils(
+  -- Terms
+  mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypes, mkHsCaseAlt,
+  mkSimpleMatch, unguardedGRHSs, unguardedRHS,
+  mkMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf,
+  mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo,
+  mkHsDictLet, mkHsLams,
+  mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,
+  mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap,
+  mkHsCmdIf,
+
+  nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon,
+  nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,
+  nlHsIntLit, nlHsVarApps,
+  nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
+  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
+  typeToLHsType,
+
+  -- * Constructing general big tuples
+  -- $big_tuples
+  mkChunkified, chunkify,
+
+  -- Bindings
+  mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind, mkTopFunBind,
+  mkPatSynBind,
+  isInfixFunBind,
+
+  -- Literals
+  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringPrimLit,
+
+  -- Patterns
+  mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,
+  nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat,
+  nlWildPatName, nlTuplePat, mkParPat, nlParPat,
+  mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup,
+
+  -- Types
+  mkHsAppTy, mkHsAppKindTy,
+  mkLHsSigType, mkLHsSigWcType, mkClassOpSigs, mkHsSigEnv,
+  nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,
+
+  -- Stmts
+  mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkTcBindStmt,
+  mkLastStmt,
+  emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,
+  emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
+  unitRecStmtTc,
+
+  -- Template Haskell
+  mkUntypedSplice, mkTypedSplice,
+  mkHsQuasiQuote, unqualQuasiQuote,
+
+  -- Collecting binders
+  isUnliftedHsBind, isBangedHsBind,
+
+  collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
+  collectHsIdBinders,
+  collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
+  collectPatBinders, collectPatsBinders,
+  collectLStmtsBinders, collectStmtsBinders,
+  collectLStmtBinders, collectStmtBinders,
+
+  hsLTyClDeclBinders, hsTyClForeignBinders,
+  hsPatSynSelectors, getPatSynBinds,
+  hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,
+
+  -- Collecting implicit binders
+  lStmtsImplicits, hsValBindsImplicits, lPatImplicits
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Hs.Decls
+import GHC.Hs.Binds
+import GHC.Hs.Expr
+import GHC.Hs.Pat
+import GHC.Hs.Types
+import GHC.Hs.Lit
+import GHC.Hs.PlaceHolder
+import GHC.Hs.Extension
+
+import TcEvidence
+import RdrName
+import Var
+import TyCoRep
+import Type   ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig )
+import TysWiredIn ( unitTy )
+import TcType
+import DataCon
+import ConLike
+import Id
+import Name
+import NameSet hiding ( unitFV )
+import NameEnv
+import BasicTypes
+import SrcLoc
+import FastString
+import Util
+import Bag
+import Outputable
+import Constants
+
+import Data.Either
+import Data.Function
+import Data.List
+
+{-
+************************************************************************
+*                                                                      *
+        Some useful helpers for constructing syntax
+*                                                                      *
+************************************************************************
+
+These functions attempt to construct a not-completely-useless SrcSpan
+from their components, compared with the nl* functions below which
+just attach noSrcSpan to everything.
+-}
+
+mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkHsPar e = cL (getLoc e) (HsPar noExtField e)
+
+mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
+              -> [LPat (GhcPass p)] -> Located (body (GhcPass p))
+              -> LMatch (GhcPass p) (Located (body (GhcPass p)))
+mkSimpleMatch ctxt pats rhs
+  = cL loc $
+    Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats
+          , m_grhss = unguardedGRHSs rhs }
+  where
+    loc = case pats of
+                []      -> getLoc rhs
+                (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
+
+unguardedGRHSs :: Located (body (GhcPass p))
+               -> GRHSs (GhcPass p) (Located (body (GhcPass p)))
+unguardedGRHSs rhs@(dL->L loc _)
+  = GRHSs noExtField (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
+
+unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
+             -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
+unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)]
+
+mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)
+             => Origin -> [LMatch name (Located (body name))]
+             -> MatchGroup name (Located (body name))
+mkMatchGroup origin matches = MG { mg_ext = noExtField
+                                 , mg_alts = mkLocatedList matches
+                                 , mg_origin = origin }
+
+mkLocatedList ::  [Located a] -> Located [Located a]
+mkLocatedList [] = noLoc []
+mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms
+
+mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2)
+
+mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)
+            => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
+mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct)
+  where
+    t_body    = hswc_body t
+    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
+
+mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
+mkHsAppTypes = foldl' mkHsAppType
+
+mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
+  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches))
+  where
+    matches = mkMatchGroup Generated
+                           [mkSimpleMatch LambdaExpr pats' body]
+    pats' = map (parenthesizePat appPrec) pats
+
+mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
+mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars
+                                       <.> mkWpLams dicts) expr
+
+-- |A simple case alternative with a single pattern, no binds, no guards;
+-- pre-typechecking
+mkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p)))
+            -> LMatch (GhcPass p) (Located (body (GhcPass p)))
+mkHsCaseAlt pat expr
+  = mkSimpleMatch CaseAlt [pat] expr
+
+nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
+nlHsTyApp fun_id tys
+  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id)))
+
+nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]
+           -> LHsExpr (GhcPass id)
+nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
+
+--------- Adding parens ---------
+mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+-- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them
+-- So   'f x'  becomes '(f x)', but '3' stays as '3'
+mkLHsPar le@(dL->L loc e)
+  | hsExprNeedsParens appPrec e = cL loc (HsPar noExtField le)
+  | otherwise                   = le
+
+mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
+mkParPat lp@(dL->L loc p)
+  | patNeedsParens appPrec p = cL loc (ParPat noExtField lp)
+  | otherwise                = lp
+
+nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
+nlParPat p = noLoc (ParPat noExtField p)
+
+-------------------------------
+-- These are the bits of syntax that contain rebindable names
+-- See RnEnv.lookupSyntaxName
+
+mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs
+mkHsFractional :: FractionalLit -> HsOverLit GhcPs
+mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs
+mkHsDo         :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
+mkHsComp       :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+               -> HsExpr GhcPs
+
+mkNPat      :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)
+            -> Pat GhcPs
+mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs
+
+mkLastStmt :: Located (bodyR (GhcPass idR))
+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
+mkBodyStmt :: Located (bodyR GhcPs)
+           -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
+mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
+                         (Located (bodyR (GhcPass idR))) ~ NoExtField)
+           => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
+mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
+             -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
+
+emptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR
+emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
+emptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR
+mkRecStmt        :: [LStmtLR (GhcPass idL) GhcPs bodyR]
+                 -> StmtLR (GhcPass idL) GhcPs bodyR
+
+
+mkHsIntegral     i  = OverLit noExtField (HsIntegral       i) noExpr
+mkHsFractional   f  = OverLit noExtField (HsFractional     f) noExpr
+mkHsIsString src s  = OverLit noExtField (HsIsString   src s) noExpr
+
+mkHsDo ctxt stmts = HsDo noExtField ctxt (mkLocatedList stmts)
+mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
+  where
+    last_stmt = cL (getLoc expr) $ mkLastStmt expr
+
+mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+       -> HsExpr (GhcPass p)
+mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b
+
+mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
+       -> HsCmd (GhcPass p)
+mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b
+
+mkNPat lit neg     = NPat noExtField lit neg noSyntaxExpr
+mkNPlusKPat id lit
+  = NPlusKPat noExtField id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
+
+mkTransformStmt    :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkTransformByStmt  :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkGroupUsingStmt   :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+
+emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+emptyTransStmt = TransStmt { trS_ext = noExtField
+                           , trS_form = panic "emptyTransStmt: form"
+                           , trS_stmts = [], trS_bndrs = []
+                           , trS_by = Nothing, trS_using = noLoc noExpr
+                           , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr
+                           , trS_fmap = noExpr }
+mkTransformStmt    ss u   = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }
+mkTransformByStmt  ss u b = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }
+mkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
+mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
+
+mkLastStmt body = LastStmt noExtField body False noSyntaxExpr
+mkBodyStmt body
+  = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr
+mkBindStmt pat body
+  = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr
+mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr
+  -- don't use placeHolderTypeTc above, because that panics during zonking
+
+emptyRecStmt' :: forall idL idR body.
+                 XRecStmt (GhcPass idL) (GhcPass idR) body
+              -> StmtLR (GhcPass idL) (GhcPass idR) body
+emptyRecStmt' tyVal =
+   RecStmt
+     { recS_stmts = [], recS_later_ids = []
+     , recS_rec_ids = []
+     , recS_ret_fn = noSyntaxExpr
+     , recS_mfix_fn = noSyntaxExpr
+     , recS_bind_fn = noSyntaxExpr
+     , recS_ext = tyVal }
+
+unitRecStmtTc :: RecStmtTc
+unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy
+                          , recS_later_rets = []
+                          , recS_rec_rets = []
+                          , recS_ret_ty = unitTy }
+
+emptyRecStmt     = emptyRecStmt' noExtField
+emptyRecStmtName = emptyRecStmt' noExtField
+emptyRecStmtId   = emptyRecStmt' unitRecStmtTc
+                                        -- a panic might trigger during zonking
+mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }
+
+-------------------------------
+--- A useful function for building @OpApps@.  The operator is always a
+-- variable, and we don't know the fixity yet.
+mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
+mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLoc (HsVar noExtField (noLoc op))) e2
+
+unqualSplice :: RdrName
+unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
+
+mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
+mkUntypedSplice hasParen e = HsUntypedSplice noExtField hasParen unqualSplice e
+
+mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
+mkTypedSplice hasParen e = HsTypedSplice noExtField hasParen unqualSplice e
+
+mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
+mkHsQuasiQuote quoter span quote
+  = HsQuasiQuote noExtField unqualSplice quoter span quote
+
+unqualQuasiQuote :: RdrName
+unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
+                -- A name (uniquified later) to
+                -- identify the quasi-quote
+
+mkHsString :: String -> HsLit (GhcPass p)
+mkHsString s = HsString NoSourceText (mkFastString s)
+
+mkHsStringPrimLit :: FastString -> HsLit (GhcPass p)
+mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)
+
+
+{-
+************************************************************************
+*                                                                      *
+        Constructing syntax with no location info
+*                                                                      *
+************************************************************************
+-}
+
+nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsVar n = noLoc (HsVar noExtField (noLoc n))
+
+-- NB: Only for LHsExpr **Id**
+nlHsDataCon :: DataCon -> LHsExpr GhcTc
+nlHsDataCon con = noLoc (HsConLikeOut noExtField (RealDataCon con))
+
+nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
+nlHsLit n = noLoc (HsLit noExtField n)
+
+nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
+nlHsIntLit n = noLoc (HsLit noExtField (HsInt noExtField (mkIntegralLit n)))
+
+nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)
+nlVarPat n = noLoc (VarPat noExtField (noLoc n))
+
+nlLitPat :: HsLit GhcPs -> LPat GhcPs
+nlLitPat l = noLoc (LitPat noExtField l)
+
+nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x))
+
+nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]
+               -> LHsExpr (GhcPass id)
+nlHsSyntaxApps (SyntaxExpr { syn_expr      = fun
+                           , syn_arg_wraps = arg_wraps
+                           , syn_res_wrap  = res_wrap }) args
+  | [] <- arg_wraps   -- in the noSyntaxExpr case
+  = ASSERT( isIdHsWrapper res_wrap )
+    foldl' nlHsApp (noLoc fun) args
+
+  | otherwise
+  = mkLHsWrap res_wrap (foldl' nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps"
+                                                     mkLHsWrap arg_wraps args))
+
+nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
+nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs
+
+nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
+nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExtField (noLoc f))
+                                               (map ((HsVar noExtField) . noLoc) xs))
+                 where
+                   mk f a = HsApp noExtField (noLoc f) (noLoc a)
+
+nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
+nlConVarPat con vars = nlConPat con (map nlVarPat vars)
+
+nlConVarPatName :: Name -> [Name] -> LPat GhcRn
+nlConVarPatName con vars = nlConPatName con (map nlVarPat vars)
+
+nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs
+nlInfixConPat con l r = noLoc (ConPatIn (noLoc con)
+                              (InfixCon (parenthesizePat opPrec l)
+                                        (parenthesizePat opPrec r)))
+
+nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
+nlConPat con pats =
+  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))
+
+nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
+nlConPatName con pats =
+  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))
+
+nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
+nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
+
+nlWildConPat :: DataCon -> LPat GhcPs
+nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
+                         (PrefixCon (replicate (dataConSourceArity con)
+                                             nlWildPat)))
+
+nlWildPat :: LPat GhcPs
+nlWildPat  = noLoc (WildPat noExtField )  -- Pre-typechecking
+
+nlWildPatName :: LPat GhcRn
+nlWildPatName  = noLoc (WildPat noExtField )  -- Pre-typechecking
+
+nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
+       -> LHsExpr GhcPs
+nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)
+
+nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
+nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
+
+nlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
+nlHsPar  :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsIf   :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+         -> LHsExpr (GhcPass id)
+nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
+         -> LHsExpr GhcPs
+nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs
+
+nlHsLam match          = noLoc (HsLam noExtField (mkMatchGroup Generated [match]))
+nlHsPar e              = noLoc (HsPar noExtField e)
+
+-- Note [Rebindable nlHsIf]
+-- nlHsIf should generate if-expressions which are NOT subject to
+-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)
+nlHsIf cond true false = noLoc (HsIf noExtField Nothing cond true false)
+
+nlHsCase expr matches
+  = noLoc (HsCase noExtField expr (mkMatchGroup Generated matches))
+nlList exprs          = noLoc (ExplicitList noExtField Nothing exprs)
+
+nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)
+nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
+
+nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t))
+nlHsTyVar x   = noLoc (HsTyVar noExtField NotPromoted (noLoc x))
+nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b)
+nlHsParTy t   = noLoc (HsParTy noExtField t)
+
+nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
+nlHsTyConApp tycon tys  = foldl' nlHsAppTy (nlHsTyVar tycon) tys
+
+nlHsAppKindTy ::
+  LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
+nlHsAppKindTy f k
+  = noLoc (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))
+
+{-
+Tuples.  All these functions are *pre-typechecker* because they lack
+types on the tuple.
+-}
+
+mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
+-- Makes a pre-typechecker boxed tuple, deals with 1 case
+mkLHsTupleExpr [e] = e
+mkLHsTupleExpr es
+  = noLoc $ ExplicitTuple noExtField (map (noLoc . (Present noExtField)) es) Boxed
+
+mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
+mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)
+
+nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
+nlTuplePat pats box = noLoc (TuplePat noExtField pats box)
+
+missingTupArg :: HsTupArg GhcPs
+missingTupArg = Missing noExtField
+
+mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
+mkLHsPatTup []     = noLoc $ TuplePat noExtField [] Boxed
+mkLHsPatTup [lpat] = lpat
+mkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
+
+-- The Big equivalents for the source tuple expressions
+mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
+mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids)
+
+mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
+mkBigLHsTup = mkChunkified mkLHsTupleExpr
+
+-- The Big equivalents for the source tuple patterns
+mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn
+mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)
+
+mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
+mkBigLHsPatTup = mkChunkified mkLHsPatTup
+
+-- $big_tuples
+-- #big_tuples#
+--
+-- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but
+-- we might concievably want to build such a massive tuple as part of the
+-- output of a desugaring stage (notably that for list comprehensions).
+--
+-- We call tuples above this size \"big tuples\", and emulate them by
+-- creating and pattern matching on >nested< tuples that are expressible
+-- by GHC.
+--
+-- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)
+-- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any
+-- construction to be big.
+--
+-- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'
+-- and 'mkTupleCase' functions to do all your work with tuples you should be
+-- fine, and not have to worry about the arity limitation at all.
+
+-- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decompositon
+mkChunkified :: ([a] -> a)      -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'
+             -> [a]             -- ^ Possible \"big\" list of things to construct from
+             -> a               -- ^ Constructed thing made possible by recursive decomposition
+mkChunkified small_tuple as = mk_big_tuple (chunkify as)
+  where
+        -- Each sub-list is short enough to fit in a tuple
+    mk_big_tuple [as] = small_tuple as
+    mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s))
+
+chunkify :: [a] -> [[a]]
+-- ^ Split a list into lists that are small enough to have a corresponding
+-- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'
+-- But there may be more than 'mAX_TUPLE_SIZE' sub-lists
+chunkify xs
+  | n_xs <= mAX_TUPLE_SIZE = [xs]
+  | otherwise              = split xs
+  where
+    n_xs     = length xs
+    split [] = []
+    split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)
+
+{-
+************************************************************************
+*                                                                      *
+        LHsSigType and LHsSigWcType
+*                                                                      *
+********************************************************************* -}
+
+mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
+mkLHsSigType ty = mkHsImplicitBndrs ty
+
+mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
+mkLHsSigWcType ty = mkHsWildCardBndrs (mkHsImplicitBndrs ty)
+
+mkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([Located Name], a))
+                     -> [LSig GhcRn]
+                     -> NameEnv a
+mkHsSigEnv get_info sigs
+  = mkNameEnv          (mk_pairs ordinary_sigs)
+   `extendNameEnvList` (mk_pairs gen_dm_sigs)
+   -- The subtlety is this: in a class decl with a
+   -- default-method signature as well as a method signature
+   -- we want the latter to win (#12533)
+   --    class C x where
+   --       op :: forall a . x a -> x a
+   --       default op :: forall b . x b -> x b
+   --       op x = ...(e :: b -> b)...
+   -- The scoped type variables of the 'default op', namely 'b',
+   -- scope over the code for op.   The 'forall a' does not!
+   -- This applies both in the renamer and typechecker, both
+   -- of which use this function
+  where
+    (gen_dm_sigs, ordinary_sigs) = partition is_gen_dm_sig sigs
+    is_gen_dm_sig (dL->L _ (ClassOpSig _ True _ _)) = True
+    is_gen_dm_sig _                                 = False
+
+    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
+    mk_pairs sigs = [ (n,a) | Just (ns,a) <- map get_info sigs
+                            , (dL->L _ n) <- ns ]
+
+mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
+-- Convert TypeSig to ClassOpSig
+-- The former is what is parsed, but the latter is
+-- what we need in class/instance declarations
+mkClassOpSigs sigs
+  = map fiddle sigs
+  where
+    fiddle (dL->L loc (TypeSig _ nms ty))
+      = cL loc (ClassOpSig noExtField False nms (dropWildCards ty))
+    fiddle sig = sig
+
+typeToLHsType :: Type -> LHsType GhcPs
+-- ^ Converting a Type to an HsType RdrName
+-- This is needed to implement GeneralizedNewtypeDeriving.
+--
+-- Note that we use 'getRdrName' extensively, which
+-- generates Exact RdrNames rather than strings.
+typeToLHsType ty
+  = go ty
+  where
+    go :: Type -> LHsType GhcPs
+    go ty@(FunTy { ft_af = af, ft_arg = arg, ft_res = res })
+      = case af of
+          VisArg   -> nlHsFunTy (go arg) (go res)
+          InvisArg | (theta, tau) <- tcSplitPhiTy ty
+                   -> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)
+                                      , hst_xqual = noExtField
+                                      , hst_body = go tau })
+
+    go ty@(ForAllTy (Bndr _ argf) _)
+      | (tvs, tau) <- tcSplitForAllTysSameVis argf ty
+      = noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf
+                          , hst_bndrs = map go_tv tvs
+                          , hst_xforall = noExtField
+                          , hst_body = go tau })
+    go (TyVarTy tv)         = nlHsTyVar (getRdrName tv)
+    go (LitTy (NumTyLit n))
+      = noLoc $ HsTyLit noExtField (HsNumTy NoSourceText n)
+    go (LitTy (StrTyLit s))
+      = noLoc $ HsTyLit noExtField (HsStrTy NoSourceText s)
+    go ty@(TyConApp tc args)
+      | tyConAppNeedsKindSig True tc (length args)
+        -- We must produce an explicit kind signature here to make certain
+        -- programs kind-check. See Note [Kind signatures in typeToLHsType].
+      = nlHsParTy $ noLoc $ HsKindSig noExtField ty' (go (tcTypeKind ty))
+      | otherwise = ty'
+       where
+        ty' :: LHsType GhcPs
+        ty' = go_app (nlHsTyVar (getRdrName tc)) args (tyConArgFlags tc args)
+    go ty@(AppTy {})        = go_app (go head) args (appTyArgFlags head args)
+      where
+        head :: Type
+        args :: [Type]
+        (head, args) = splitAppTys ty
+    go (CastTy ty _)        = go ty
+    go (CoercionTy co)      = pprPanic "toLHsSigWcType" (ppr co)
+
+         -- Source-language types have _invisible_ kind arguments,
+         -- so we must remove them here (#8563)
+
+    go_app :: LHsType GhcPs -- The type being applied
+           -> [Type]        -- The argument types
+           -> [ArgFlag]     -- The argument types' visibilities
+           -> LHsType GhcPs
+    go_app head args arg_flags =
+      foldl' (\f (arg, flag) ->
+               let arg' = go arg in
+               case flag of
+                 Inferred  -> f
+                 Specified -> f `nlHsAppKindTy` arg'
+                 Required  -> f `nlHsAppTy`     arg')
+             head (zip args arg_flags)
+
+    go_tv :: TyVar -> LHsTyVarBndr GhcPs
+    go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv))
+                                   (go (tyVarKind tv))
+
+{-
+Note [Kind signatures in typeToLHsType]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are types that typeToLHsType can produce which require explicit kind
+signatures in order to kind-check. Here is an example from #14579:
+
+  -- type P :: forall {k} {t :: k}. Proxy t
+  type P = 'Proxy
+
+  -- type Wat :: forall a. Proxy a -> *
+  newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
+    deriving Eq
+
+  -- type Wat2 :: forall {a}. Proxy a -> *
+  type Wat2 = Wat
+
+  -- type Glurp :: * -> *
+  newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))
+    deriving Eq
+
+The derived Eq instance for Glurp (without any kind signatures) would be:
+
+  instance Eq a => Eq (Glurp a) where
+    (==) = coerce @(Wat2 P  -> Wat2 P  -> Bool)
+                  @(Glurp a -> Glurp a -> Bool)
+                  (==) :: Glurp a -> Glurp a -> Bool
+
+(Where the visible type applications use types produced by typeToLHsType.)
+
+The type P (in Wat2 P) has an underspecified kind, so we must ensure that
+typeToLHsType ascribes it with its kind: Wat2 (P :: Proxy a). To accomplish
+this, whenever we see an application of a tycon to some arguments, we use
+the tyConAppNeedsKindSig function to determine if it requires an explicit kind
+signature to resolve some ambiguity. (See Note
+Note [When does a tycon application need an explicit kind signature?] for a
+more detailed explanation of how this works.)
+
+Note that we pass True to tyConAppNeedsKindSig since we are generated code with
+visible kind applications, so even specified arguments count towards injective
+positions in the kind of the tycon.
+-}
+
+{- *********************************************************************
+*                                                                      *
+    --------- HsWrappers: type args, dict args, casts ---------
+*                                                                      *
+********************************************************************* -}
+
+mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)
+
+-- Avoid (HsWrap co (HsWrap co' _)).
+-- See Note [Detecting forced eta expansion] in DsExpr
+mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
+mkHsWrap co_fn e | isIdHsWrapper co_fn = e
+mkHsWrap co_fn (HsWrap _ co_fn' e)     = mkHsWrap (co_fn <.> co_fn') e
+mkHsWrap co_fn e                       = HsWrap noExtField co_fn e
+
+mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b
+           -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
+mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e
+
+mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b
+            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
+mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e
+
+mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)
+
+mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
+mkHsCmdWrap w cmd | isIdHsWrapper w = cmd
+                  | otherwise       = HsCmdWrap noExtField w cmd
+
+mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
+mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)
+
+mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
+mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
+                       | otherwise           = CoPat noExtField co_fn p ty
+
+mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
+mkHsWrapPatCo co pat ty | isTcReflCo co = pat
+                        | otherwise    = CoPat noExtField (mkWpCastN co) pat ty
+
+mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
+mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
+
+{-
+l
+************************************************************************
+*                                                                      *
+                Bindings; with a location at the top
+*                                                                      *
+************************************************************************
+-}
+
+mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
+          -> HsBind GhcPs
+-- Not infix, with place holders for coercion and free vars
+mkFunBind fn ms = FunBind { fun_id = fn
+                          , fun_matches = mkMatchGroup Generated ms
+                          , fun_co_fn = idHsWrapper
+                          , fun_ext = noExtField
+                          , fun_tick = [] }
+
+mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]
+             -> HsBind GhcRn
+-- In Name-land, with empty bind_fvs
+mkTopFunBind origin fn ms = FunBind { fun_id = fn
+                                    , fun_matches = mkMatchGroup origin ms
+                                    , fun_co_fn = idHsWrapper
+                                    , fun_ext  = emptyNameSet -- NB: closed
+                                                              --     binding
+                                    , fun_tick = [] }
+
+mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
+mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
+
+mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
+mkVarBind var rhs = cL (getLoc rhs) $
+                    VarBind { var_ext = noExtField,
+                              var_id = var, var_rhs = rhs, var_inline = False }
+
+mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)
+             -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs
+mkPatSynBind name details lpat dir = PatSynBind noExtField psb
+  where
+    psb = PSB{ psb_ext = noExtField
+             , psb_id = name
+             , psb_args = details
+             , psb_def = lpat
+             , psb_dir = dir }
+
+-- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is
+-- considered infix.
+isInfixFunBind :: HsBindLR id1 id2 -> Bool
+isInfixFunBind (FunBind _ _ (MG _ matches _) _ _)
+  = any (isInfixMatch . unLoc) (unLoc matches)
+isInfixFunBind _ = False
+
+
+------------
+mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
+                -> LHsExpr GhcPs -> LHsBind GhcPs
+mk_easy_FunBind loc fun pats expr
+  = cL loc $ mkFunBind (cL loc fun)
+              [mkMatch (mkPrefixFunRhs (cL loc fun)) pats expr
+                       (noLoc emptyLocalBinds)]
+
+-- | Make a prefix, non-strict function 'HsMatchContext'
+mkPrefixFunRhs :: Located id -> HsMatchContext id
+mkPrefixFunRhs n = FunRhs { mc_fun = n
+                          , mc_fixity = Prefix
+                          , mc_strictness = NoSrcStrict }
+
+------------
+mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
+        -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p)
+        -> Located (HsLocalBinds (GhcPass p))
+        -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
+mkMatch ctxt pats expr lbinds
+  = noLoc (Match { m_ext   = noExtField
+                 , m_ctxt  = ctxt
+                 , m_pats  = map paren pats
+                 , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })
+  where
+    paren lp@(dL->L l p)
+      | patNeedsParens appPrec p = cL l (ParPat noExtField lp)
+      | otherwise                = lp
+
+{-
+************************************************************************
+*                                                                      *
+        Collecting binders
+*                                                                      *
+************************************************************************
+
+Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
+
+...
+where
+  (x, y) = ...
+  f i j  = ...
+  [a, b] = ...
+
+it should return [x, y, f, a, b] (remember, order important).
+
+Note [Collect binders only after renaming]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+These functions should only be used on HsSyn *after* the renamer,
+to return a [Name] or [Id].  Before renaming the record punning
+and wild-card mechanism makes it hard to know what is bound.
+So these functions should not be applied to (HsSyn RdrName)
+
+Note [Unlifted id check in isUnliftedHsBind]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The function isUnliftedHsBind is used to complain if we make a top-level
+binding for a variable of unlifted type.
+
+Such a binding is illegal if the top-level binding would be unlifted;
+but also if the local letrec generated by desugaring AbsBinds would be.
+E.g.
+      f :: Num a => (# a, a #)
+      g :: Num a => a -> a
+      f = ...g...
+      g = ...g...
+
+The top-level bindings for f,g are not unlifted (because of the Num a =>),
+but the local, recursive, monomorphic bindings are:
+
+      t = /\a \(d:Num a).
+         letrec fm :: (# a, a #) = ...g...
+                gm :: a -> a = ...f...
+         in (fm, gm)
+
+Here the binding for 'fm' is illegal.  So generally we check the abe_mono types.
+
+BUT we have a special case when abs_sig is true;
+  see Note [The abs_sig field of AbsBinds] in GHC.Hs.Binds
+-}
+
+----------------- Bindings --------------------------
+
+-- | Should we treat this as an unlifted bind? This will be true for any
+-- bind that binds an unlifted variable, but we must be careful around
+-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
+-- information, see Note [Strict binds check] is DsBinds.
+isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds
+isUnliftedHsBind bind
+  | AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind
+  = if has_sig
+    then any (is_unlifted_id . abe_poly) exports
+    else any (is_unlifted_id . abe_mono) exports
+    -- If has_sig is True we wil never generate a binding for abe_mono,
+    -- so we don't need to worry about it being unlifted. The abe_poly
+    -- binding might not be: e.g. forall a. Num a => (# a, a #)
+
+  | otherwise
+  = any is_unlifted_id (collectHsBindBinders bind)
+  where
+    is_unlifted_id id = isUnliftedType (idType id)
+
+-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
+isBangedHsBind :: HsBind GhcTc -> Bool
+isBangedHsBind (AbsBinds { abs_binds = binds })
+  = anyBag (isBangedHsBind . unLoc) binds
+isBangedHsBind (FunBind {fun_matches = matches})
+  | [dL->L _ match] <- unLoc $ mg_alts matches
+  , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
+  = True
+isBangedHsBind (PatBind {pat_lhs = pat})
+  = isBangedLPat pat
+isBangedHsBind _
+  = False
+
+collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR)
+                    -> [IdP (GhcPass idL)]
+collectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds
+                                         -- No pattern synonyms here
+collectLocalBinders (HsIPBinds {})      = []
+collectLocalBinders (EmptyLocalBinds _) = []
+collectLocalBinders (XHsLocalBindsLR _) = []
+
+collectHsIdBinders, collectHsValBinders
+  :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
+-- Collect Id binders only, or Ids + pattern synonyms, respectively
+collectHsIdBinders  = collect_hs_val_binders True
+collectHsValBinders = collect_hs_val_binders False
+
+collectHsBindBinders :: (SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p))=>
+                        HsBindLR p idR -> [IdP p]
+-- Collect both Ids and pattern-synonym binders
+collectHsBindBinders b = collect_bind False b []
+
+collectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
+collectHsBindsBinders binds = collect_binds False binds []
+
+collectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]
+-- Same as collectHsBindsBinders, but works over a list of bindings
+collectHsBindListBinders = foldr (collect_bind False . unLoc) []
+
+collect_hs_val_binders :: Bool -> HsValBindsLR (GhcPass idL) (GhcPass idR)
+                       -> [IdP (GhcPass idL)]
+collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds []
+collect_hs_val_binders ps (XValBindsLR (NValBinds binds _))
+  = collect_out_binds ps binds
+
+collect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] ->
+                     [IdP (GhcPass p)]
+collect_out_binds ps = foldr (collect_binds ps . snd) []
+
+collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
+                 [IdP (GhcPass p)] -> [IdP (GhcPass p)]
+-- Collect Ids, or Ids + pattern synonyms, depending on boolean flag
+collect_binds ps binds acc = foldr (collect_bind ps . unLoc) acc binds
+
+collect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
+                Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
+collect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc
+collect_bind _ (FunBind { fun_id = (dL->L _ f) })  acc = f : acc
+collect_bind _ (VarBind { var_id = f })            acc = f : acc
+collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc
+        -- I don't think we want the binders from the abe_binds
+
+        -- binding (hence see AbsBinds) is in zonking in TcHsSyn
+collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = (dL->L _ ps) })) acc
+  | omitPatSyn                  = acc
+  | otherwise                   = ps : acc
+collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc
+collect_bind _ (XHsBindsLR _) acc = acc
+
+collectMethodBinders :: LHsBindsLR idL idR -> [Located (IdP idL)]
+-- Used exclusively for the bindings of an instance decl which are all FunBinds
+collectMethodBinders binds = foldr (get . unLoc) [] binds
+  where
+    get (FunBind { fun_id = f }) fs = f : fs
+    get _                        fs = fs
+       -- Someone else complains about non-FunBinds
+
+----------------- Statements --------------------------
+collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body]
+                     -> [IdP (GhcPass idL)]
+collectLStmtsBinders = concatMap collectLStmtBinders
+
+collectStmtsBinders :: [StmtLR (GhcPass idL) (GhcPass idR) body]
+                    -> [IdP (GhcPass idL)]
+collectStmtsBinders = concatMap collectStmtBinders
+
+collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body
+                    -> [IdP (GhcPass idL)]
+collectLStmtBinders = collectStmtBinders . unLoc
+
+collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body
+                   -> [IdP (GhcPass idL)]
+  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
+collectStmtBinders (BindStmt _ pat _ _ _)  = collectPatBinders pat
+collectStmtBinders (LetStmt _  binds)      = collectLocalBinders (unLoc binds)
+collectStmtBinders (BodyStmt {})           = []
+collectStmtBinders (LastStmt {})           = []
+collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
+                                    $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
+collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
+collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
+collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
+ where
+  collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat
+  collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
+  collectArgBinders _ = []
+collectStmtBinders (XStmtLR nec) = noExtCon nec
+
+
+----------------- Patterns --------------------------
+collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
+collectPatBinders pat = collect_lpat pat []
+
+collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
+collectPatsBinders pats = foldr collect_lpat [] pats
+
+-------------
+collect_lpat :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
+                 LPat p -> [IdP p] -> [IdP p]
+collect_lpat p bndrs
+  = go (unLoc p)
+  where
+    go (VarPat _ var)             = unLoc var : bndrs
+    go (WildPat _)                = bndrs
+    go (LazyPat _ pat)            = collect_lpat pat bndrs
+    go (BangPat _ pat)            = collect_lpat pat bndrs
+    go (AsPat _ a pat)            = unLoc a : collect_lpat pat bndrs
+    go (ViewPat _ _ pat)          = collect_lpat pat bndrs
+    go (ParPat _ pat)             = collect_lpat pat bndrs
+
+    go (ListPat _ pats)           = foldr collect_lpat bndrs pats
+    go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats
+    go (SumPat _ pat _ _)         = collect_lpat pat bndrs
+
+    go (ConPatIn _ ps)            = foldr collect_lpat bndrs (hsConPatArgs ps)
+    go (ConPatOut {pat_args=ps})  = foldr collect_lpat bndrs (hsConPatArgs ps)
+        -- See Note [Dictionary binders in ConPatOut]
+    go (LitPat _ _)               = bndrs
+    go (NPat {})                  = bndrs
+    go (NPlusKPat _ n _ _ _ _)    = unLoc n : bndrs
+
+    go (SigPat _ pat _)           = collect_lpat pat bndrs
+
+    go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
+                                  = go pat
+    go (SplicePat _ _)            = bndrs
+    go (CoPat _ _ pat _)          = go pat
+    go (XPat {})                  = bndrs
+
+{-
+Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Do *not* gather (a) dictionary and (b) dictionary bindings as binders
+of a ConPatOut pattern.  For most calls it doesn't matter, because
+it's pre-typechecker and there are no ConPatOuts.  But it does matter
+more in the desugarer; for example, DsUtils.mkSelectorBinds uses
+collectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,
+we want to generate bindings for x,y but not for dictionaries bound by
+C.  (The type checker ensures they would not be used.)
+
+Desugaring of arrow case expressions needs these bindings (see DsArrows
+and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
+own pat-binder-collector:
+
+Here's the problem.  Consider
+
+data T a where
+   C :: Num a => a -> Int -> T a
+
+f ~(C (n+1) m) = (n,m)
+
+Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
+and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
+variables bound by the lazy pattern are n,m, *not* the dictionary d.
+So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
+-}
+
+hsGroupBinders :: HsGroup GhcRn -> [Name]
+hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
+                          hs_fords = foreign_decls })
+  =  collectHsValBinders val_decls
+  ++ hsTyClForeignBinders tycl_decls foreign_decls
+hsGroupBinders (XHsGroup nec) = noExtCon nec
+
+hsTyClForeignBinders :: [TyClGroup GhcRn]
+                     -> [LForeignDecl GhcRn]
+                     -> [Name]
+-- We need to look at instance declarations too,
+-- because their associated types may bind data constructors
+hsTyClForeignBinders tycl_decls foreign_decls
+  =    map unLoc (hsForeignDeclsBinders foreign_decls)
+    ++ getSelectorNames
+         (foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls
+         `mappend`
+         foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)
+  where
+    getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]
+    getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs
+
+-------------------
+hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
+                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+-- ^ Returns all the /binding/ names of the decl.  The first one is
+-- guaranteed to be the name of the decl. The first component
+-- represents all binding names except record fields; the second
+-- represents field occurrences. For record fields mentioned in
+-- multiple constructors, the SrcLoc will be from the first occurrence.
+--
+-- Each returned (Located name) has a SrcSpan for the /whole/ declaration.
+-- See Note [SrcSpan for binders]
+
+hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl
+                                            { fdLName = (dL->L _ name) } }))
+  = ([cL loc name], [])
+hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec }))
+  = noExtCon nec
+hsLTyClDeclBinders (dL->L loc (SynDecl
+                               { tcdLName = (dL->L _ name) }))
+  = ([cL loc name], [])
+hsLTyClDeclBinders (dL->L loc (ClassDecl
+                               { tcdLName = (dL->L _ cls_name)
+                               , tcdSigs  = sigs
+                               , tcdATs   = ats }))
+  = (cL loc cls_name :
+     [ cL fam_loc fam_name | (dL->L fam_loc (FamilyDecl
+                                        { fdLName = L _ fam_name })) <- ats ]
+     ++
+     [ cL mem_loc mem_name | (dL->L mem_loc (ClassOpSig _ False ns _)) <- sigs
+                           , (dL->L _ mem_name) <- ns ]
+    , [])
+hsLTyClDeclBinders (dL->L loc (DataDecl    { tcdLName = (dL->L _ name)
+                                           , tcdDataDefn = defn }))
+  = (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn
+hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec
+hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"
+                             -- due to #15884
+
+
+-------------------
+hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
+-- See Note [SrcSpan for binders]
+hsForeignDeclsBinders foreign_decls
+  = [ cL decl_loc n
+    | (dL->L decl_loc (ForeignImport { fd_name = (dL->L _ n) }))
+        <- foreign_decls]
+
+
+-------------------
+hsPatSynSelectors :: HsValBinds (GhcPass p) -> [IdP (GhcPass p)]
+-- Collects record pattern-synonym selectors only; the pattern synonym
+-- names are collected by collectHsValBinders.
+hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors"
+hsPatSynSelectors (XValBindsLR (NValBinds binds _))
+  = foldr addPatSynSelector [] . unionManyBags $ map snd binds
+
+addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
+addPatSynSelector bind sels
+  | PatSynBind _ (PSB { psb_args = RecCon as }) <- unLoc bind
+  = map (unLoc . recordPatSynSelectorId) as ++ sels
+  | otherwise = sels
+
+getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
+getPatSynBinds binds
+  = [ psb | (_, lbinds) <- binds
+          , (dL->L _ (PatSynBind _ psb)) <- bagToList lbinds ]
+
+-------------------
+hsLInstDeclBinders :: LInstDecl (GhcPass p)
+                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+hsLInstDeclBinders (dL->L _ (ClsInstD
+                             { cid_inst = ClsInstDecl
+                                          { cid_datafam_insts = dfis }}))
+  = foldMap (hsDataFamInstBinders . unLoc) dfis
+hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))
+  = hsDataFamInstBinders fi
+hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty
+hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec)))
+  = noExtCon nec
+hsLInstDeclBinders (dL->L _ (XInstDecl nec))
+  = noExtCon nec
+hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"
+                             -- due to #15884
+
+-------------------
+-- the SrcLoc returned are for the whole declarations, not just the names
+hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)
+                     -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
+                       FamEqn { feqn_rhs = defn }}})
+  = hsDataDefnBinders defn
+  -- There can't be repeated symbols because only data instances have binders
+hsDataFamInstBinders (DataFamInstDecl
+                                    { dfid_eqn = HsIB { hsib_body = XFamEqn nec}})
+  = noExtCon nec
+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs nec))
+  = noExtCon nec
+
+-------------------
+-- the SrcLoc returned are for the whole declarations, not just the names
+hsDataDefnBinders :: HsDataDefn (GhcPass p)
+                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+hsDataDefnBinders (HsDataDefn { dd_cons = cons })
+  = hsConDeclsBinders cons
+  -- See Note [Binders in family instances]
+hsDataDefnBinders (XHsDataDefn nec) = noExtCon nec
+
+-------------------
+type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)]
+                 -- Filters out ones that have already been seen
+
+hsConDeclsBinders :: [LConDecl (GhcPass p)]
+                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+   -- See hsLTyClDeclBinders for what this does
+   -- The function is boringly complicated because of the records
+   -- And since we only have equality, we have to be a little careful
+hsConDeclsBinders cons
+  = go id cons
+  where
+    go :: Seen p -> [LConDecl (GhcPass p)]
+       -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
+    go _ [] = ([], [])
+    go remSeen (r:rs)
+      -- Don't re-mangle the location of field names, because we don't
+      -- have a record of the full location of the field declaration anyway
+      = let loc = getLoc r
+        in case unLoc r of
+           -- remove only the first occurrence of any seen field in order to
+           -- avoid circumventing detection of duplicate fields (#9156)
+           ConDeclGADT { con_names = names, con_args = args }
+             -> (map (cL loc . unLoc) names ++ ns, flds ++ fs)
+             where
+                (remSeen', flds) = get_flds remSeen args
+                (ns, fs) = go remSeen' rs
+
+           ConDeclH98 { con_name = name, con_args = args }
+             -> ([cL loc (unLoc name)] ++ ns, flds ++ fs)
+             where
+                (remSeen', flds) = get_flds remSeen args
+                (ns, fs) = go remSeen' rs
+
+           XConDecl nec -> noExtCon nec
+
+    get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
+             -> (Seen p, [LFieldOcc (GhcPass p)])
+    get_flds remSeen (RecCon flds)
+       = (remSeen', fld_names)
+       where
+          fld_names = remSeen (concatMap (cd_fld_names . unLoc) (unLoc flds))
+          remSeen' = foldr (.) remSeen
+                               [deleteBy ((==) `on` unLoc . rdrNameFieldOcc . unLoc) v
+                               | v <- fld_names]
+    get_flds remSeen _
+       = (remSeen, [])
+
+{-
+
+Note [SrcSpan for binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+When extracting the (Located RdrNme) for a binder, at least for the
+main name (the TyCon of a type declaration etc), we want to give it
+the @SrcSpan@ of the whole /declaration/, not just the name itself
+(which is how it appears in the syntax tree).  This SrcSpan (for the
+entire declaration) is used as the SrcSpan for the Name that is
+finally produced, and hence for error messages.  (See #8607.)
+
+Note [Binders in family instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In a type or data family instance declaration, the type
+constructor is an *occurrence* not a binding site
+    type instance T Int = Int -> Int   -- No binders
+    data instance S Bool = S1 | S2     -- Binders are S1,S2
+
+
+************************************************************************
+*                                                                      *
+        Collecting binders the user did not write
+*                                                                      *
+************************************************************************
+
+The job of this family of functions is to run through binding sites and find the set of all Names
+that were defined "implicitly", without being explicitly written by the user.
+
+The main purpose is to find names introduced by record wildcards so that we can avoid
+warning the user when they don't use those names (#4404)
+
+Since the addition of -Wunused-record-wildcards, this function returns a pair
+of [(SrcSpan, [Name])]. Each element of the list is one set of implicit
+binders, the first component of the tuple is the document describes the possible
+fix to the problem (by removing the ..).
+
+This means there is some unfortunate coupling between this function and where it
+is used but it's only used for one specific purpose in one place so it seemed
+easier.
+-}
+
+lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
+                -> [(SrcSpan, [Name])]
+lStmtsImplicits = hs_lstmts
+  where
+    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
+              -> [(SrcSpan, [Name])]
+    hs_lstmts = concatMap (hs_stmt . unLoc)
+
+    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
+            -> [(SrcSpan, [Name])]
+    hs_stmt (BindStmt _ pat _ _ _) = lPatImplicits pat
+    hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args
+      where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat
+            do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts
+            do_arg (_, XApplicativeArg nec) = noExtCon nec
+    hs_stmt (LetStmt _ binds)     = hs_local_binds (unLoc binds)
+    hs_stmt (BodyStmt {})         = []
+    hs_stmt (LastStmt {})         = []
+    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs
+                                                , s <- ss]
+    hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
+    hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss
+    hs_stmt (XStmtLR nec)         = noExtCon nec
+
+    hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds
+    hs_local_binds (HsIPBinds {})           = []
+    hs_local_binds (EmptyLocalBinds _)      = []
+    hs_local_binds (XHsLocalBindsLR _)      = []
+
+hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]
+hsValBindsImplicits (XValBindsLR (NValBinds binds _))
+  = concatMap (lhsBindsImplicits . snd) binds
+hsValBindsImplicits (ValBinds _ binds _)
+  = lhsBindsImplicits binds
+
+lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
+lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []
+  where
+    lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
+    lhs_bind _ = []
+
+lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
+lPatImplicits = hs_lpat
+  where
+    hs_lpat lpat = hs_pat (unLoc lpat)
+
+    hs_lpats = foldr (\pat rest -> hs_lpat pat ++ rest) []
+
+    hs_pat (LazyPat _ pat)      = hs_lpat pat
+    hs_pat (BangPat _ pat)      = hs_lpat pat
+    hs_pat (AsPat _ _ pat)      = hs_lpat pat
+    hs_pat (ViewPat _ _ pat)    = hs_lpat pat
+    hs_pat (ParPat _ pat)       = hs_lpat pat
+    hs_pat (ListPat _ pats)     = hs_lpats pats
+    hs_pat (TuplePat _ pats _)  = hs_lpats pats
+
+    hs_pat (SigPat _ pat _)     = hs_lpat pat
+    hs_pat (CoPat _ _ pat _)    = hs_pat pat
+
+    hs_pat (ConPatIn n ps)           = details n ps
+    hs_pat (ConPatOut {pat_con=con, pat_args=ps}) = details (fmap conLikeName con) ps
+
+    hs_pat _ = []
+
+    details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
+    details _ (PrefixCon ps)   = hs_lpats ps
+    details n (RecCon fs)      =
+      [(err_loc, collectPatsBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]
+        ++ hs_lpats explicit_pats
+
+      where implicit_pats = map (hsRecFieldArg . unLoc) implicit
+            explicit_pats = map (hsRecFieldArg . unLoc) explicit
+
+
+            (explicit, implicit) = partitionEithers [if pat_explicit then Left fld else Right fld
+                                                    | (i, fld) <- [0..] `zip` rec_flds fs
+                                                    ,  let  pat_explicit =
+                                                              maybe True ((i<) . unLoc)
+                                                                         (rec_dotdot fs)]
+            err_loc = maybe (getLoc n) getLoc (rec_dotdot fs)
+
+    details _ (InfixCon p1 p2) = hs_lpat p1 ++ hs_lpat p2
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
new file mode 100644
index 0000000000..ca38d07ddc
--- /dev/null
+++ b/compiler/GHC/ThToHs.hs
@@ -0,0 +1,2015 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+
+This module converts Template Haskell syntax into Hs syntax
+-}
+
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module GHC.ThToHs
+   ( convertToHsExpr
+   , convertToPat
+   , convertToHsDecls
+   , convertToHsType
+   , thRdrNameGuesses
+   )
+where
+
+import GhcPrelude
+
+import GHC.Hs as Hs
+import PrelNames
+import RdrName
+import qualified Name
+import Module
+import RdrHsSyn
+import OccName
+import SrcLoc
+import Type
+import qualified Coercion ( Role(..) )
+import TysWiredIn
+import BasicTypes as Hs
+import ForeignCall
+import Unique
+import ErrUtils
+import Bag
+import Lexeme
+import Util
+import FastString
+import Outputable
+import MonadUtils ( foldrM )
+
+import qualified Data.ByteString as BS
+import Control.Monad( unless, ap )
+
+import Data.Maybe( catMaybes, isNothing )
+import Language.Haskell.TH as TH hiding (sigP)
+import Language.Haskell.TH.Syntax as TH
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import System.IO.Unsafe
+
+-------------------------------------------------------------------
+--              The external interface
+
+convertToHsDecls :: SrcSpan -> [TH.Dec] -> Either MsgDoc [LHsDecl GhcPs]
+convertToHsDecls loc ds = initCvt loc (fmap catMaybes (mapM cvt_dec ds))
+  where
+    cvt_dec d = wrapMsg "declaration" d (cvtDec d)
+
+convertToHsExpr :: SrcSpan -> TH.Exp -> Either MsgDoc (LHsExpr GhcPs)
+convertToHsExpr loc e
+  = initCvt loc $ wrapMsg "expression" e $ cvtl e
+
+convertToPat :: SrcSpan -> TH.Pat -> Either MsgDoc (LPat GhcPs)
+convertToPat loc p
+  = initCvt loc $ wrapMsg "pattern" p $ cvtPat p
+
+convertToHsType :: SrcSpan -> TH.Type -> Either MsgDoc (LHsType GhcPs)
+convertToHsType loc t
+  = initCvt loc $ wrapMsg "type" t $ cvtType t
+
+-------------------------------------------------------------------
+newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either MsgDoc (SrcSpan, a) }
+    deriving (Functor)
+        -- Push down the source location;
+        -- Can fail, with a single error message
+
+-- NB: If the conversion succeeds with (Right x), there should
+--     be no exception values hiding in x
+-- Reason: so a (head []) in TH code doesn't subsequently
+--         make GHC crash when it tries to walk the generated tree
+
+-- Use the loc everywhere, for lack of anything better
+-- In particular, we want it on binding locations, so that variables bound in
+-- the spliced-in declarations get a location that at least relates to the splice point
+
+instance Applicative CvtM where
+    pure x = CvtM $ \loc -> Right (loc,x)
+    (<*>) = ap
+
+instance Monad CvtM where
+  (CvtM m) >>= k = CvtM $ \loc -> case m loc of
+                                  Left err -> Left err
+                                  Right (loc',v) -> unCvtM (k v) loc'
+
+initCvt :: SrcSpan -> CvtM a -> Either MsgDoc a
+initCvt loc (CvtM m) = fmap snd (m loc)
+
+force :: a -> CvtM ()
+force a = a `seq` return ()
+
+failWith :: MsgDoc -> CvtM a
+failWith m = CvtM (\_ -> Left m)
+
+getL :: CvtM SrcSpan
+getL = CvtM (\loc -> Right (loc,loc))
+
+setL :: SrcSpan -> CvtM ()
+setL loc = CvtM (\_ -> Right (loc, ()))
+
+returnL :: HasSrcSpan a => SrcSpanLess a -> CvtM a
+returnL x = CvtM (\loc -> Right (loc, cL loc x))
+
+returnJustL :: HasSrcSpan a => SrcSpanLess a -> CvtM (Maybe a)
+returnJustL = fmap Just . returnL
+
+wrapParL :: HasSrcSpan a =>
+            (a -> SrcSpanLess a) -> SrcSpanLess a -> CvtM (SrcSpanLess  a)
+wrapParL add_par x = CvtM (\loc -> Right (loc, add_par (cL loc x)))
+
+wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b
+-- E.g  wrapMsg "declaration" dec thing
+wrapMsg what item (CvtM m)
+  = CvtM (\loc -> case m loc of
+                     Left err -> Left (err $$ getPprStyle msg)
+                     Right v  -> Right v)
+  where
+        -- Show the item in pretty syntax normally,
+        -- but with all its constructors if you say -dppr-debug
+    msg sty = hang (text "When splicing a TH" <+> text what <> colon)
+                 2 (if debugStyle sty
+                    then text (show item)
+                    else text (pprint item))
+
+wrapL :: HasSrcSpan a => CvtM (SrcSpanLess a) -> CvtM a
+wrapL (CvtM m) = CvtM (\loc -> case m loc of
+                               Left err -> Left err
+                               Right (loc',v) -> Right (loc',cL loc v))
+
+-------------------------------------------------------------------
+cvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]
+cvtDecs = fmap catMaybes . mapM cvtDec
+
+cvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl GhcPs))
+cvtDec (TH.ValD pat body ds)
+  | TH.VarP s <- pat
+  = do  { s' <- vNameL s
+        ; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds)
+        ; returnJustL $ Hs.ValD noExtField $ mkFunBind s' [cl'] }
+
+  | otherwise
+  = do  { pat' <- cvtPat pat
+        ; body' <- cvtGuard body
+        ; ds' <- cvtLocalDecs (text "a where clause") ds
+        ; returnJustL $ Hs.ValD noExtField $
+          PatBind { pat_lhs = pat'
+                  , pat_rhs = GRHSs noExtField body' (noLoc ds')
+                  , pat_ext = noExtField
+                  , pat_ticks = ([],[]) } }
+
+cvtDec (TH.FunD nm cls)
+  | null cls
+  = failWith (text "Function binding for"
+                 <+> quotes (text (TH.pprint nm))
+                 <+> text "has no equations")
+  | otherwise
+  = do  { nm' <- vNameL nm
+        ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls
+        ; returnJustL $ Hs.ValD noExtField $ mkFunBind nm' cls' }
+
+cvtDec (TH.SigD nm typ)
+  = do  { nm' <- vNameL nm
+        ; ty' <- cvtType typ
+        ; returnJustL $ Hs.SigD noExtField
+                                    (TypeSig noExtField [nm'] (mkLHsSigWcType ty')) }
+
+cvtDec (TH.InfixD fx nm)
+  -- Fixity signatures are allowed for variables, constructors, and types
+  -- the renamer automatically looks for types during renaming, even when
+  -- the RdrName says it's a variable or a constructor. So, just assume
+  -- it's a variable or constructor and proceed.
+  = do { nm' <- vcNameL nm
+       ; returnJustL (Hs.SigD noExtField (FixSig noExtField
+                                      (FixitySig noExtField [nm'] (cvtFixity fx)))) }
+
+cvtDec (PragmaD prag)
+  = cvtPragmaD prag
+
+cvtDec (TySynD tc tvs rhs)
+  = do  { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
+        ; rhs' <- cvtType rhs
+        ; returnJustL $ TyClD noExtField $
+          SynDecl { tcdSExt = noExtField, tcdLName = tc', tcdTyVars = tvs'
+                  , tcdFixity = Prefix
+                  , tcdRhs = rhs' } }
+
+cvtDec (DataD ctxt tc tvs ksig constrs derivs)
+  = do  { let isGadtCon (GadtC    _ _ _) = True
+              isGadtCon (RecGadtC _ _ _) = True
+              isGadtCon (ForallC  _ _ c) = isGadtCon c
+              isGadtCon _                = False
+              isGadtDecl  = all isGadtCon constrs
+              isH98Decl   = all (not . isGadtCon) constrs
+        ; unless (isGadtDecl || isH98Decl)
+                 (failWith (text "Cannot mix GADT constructors with Haskell 98"
+                        <+> text "constructors"))
+        ; unless (isNothing ksig || isGadtDecl)
+                 (failWith (text "Kind signatures are only allowed on GADTs"))
+        ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
+        ; ksig' <- cvtKind `traverse` ksig
+        ; cons' <- mapM cvtConstr constrs
+        ; derivs' <- cvtDerivs derivs
+        ; let defn = HsDataDefn { dd_ext = noExtField
+                                , dd_ND = DataType, dd_cType = Nothing
+                                , dd_ctxt = ctxt'
+                                , dd_kindSig = ksig'
+                                , dd_cons = cons', dd_derivs = derivs' }
+        ; returnJustL $ TyClD noExtField $
+          DataDecl { tcdDExt = noExtField
+                   , tcdLName = tc', tcdTyVars = tvs'
+                   , tcdFixity = Prefix
+                   , tcdDataDefn = defn } }
+
+cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
+  = do  { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
+        ; ksig' <- cvtKind `traverse` ksig
+        ; con' <- cvtConstr constr
+        ; derivs' <- cvtDerivs derivs
+        ; let defn = HsDataDefn { dd_ext = noExtField
+                                , dd_ND = NewType, dd_cType = Nothing
+                                , dd_ctxt = ctxt'
+                                , dd_kindSig = ksig'
+                                , dd_cons = [con']
+                                , dd_derivs = derivs' }
+        ; returnJustL $ TyClD noExtField $
+          DataDecl { tcdDExt = noExtField
+                   , tcdLName = tc', tcdTyVars = tvs'
+                   , tcdFixity = Prefix
+                   , tcdDataDefn = defn } }
+
+cvtDec (ClassD ctxt cl tvs fds decs)
+  = do  { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
+        ; fds'  <- mapM cvt_fundep fds
+        ; (binds', sigs', fams', at_defs', adts') <- cvt_ci_decs (text "a class declaration") decs
+        ; unless (null adts')
+            (failWith $ (text "Default data instance declarations"
+                     <+> text "are not allowed:")
+                   $$ (Outputable.ppr adts'))
+        ; returnJustL $ TyClD noExtField $
+          ClassDecl { tcdCExt = noExtField
+                    , tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
+                    , tcdFixity = Prefix
+                    , tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
+                    , tcdMeths = binds'
+                    , tcdATs = fams', tcdATDefs = at_defs', tcdDocs = [] }
+                              -- no docs in TH ^^
+        }
+
+cvtDec (InstanceD o ctxt ty decs)
+  = do  { let doc = text "an instance declaration"
+        ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs
+        ; unless (null fams') (failWith (mkBadDecMsg doc fams'))
+        ; ctxt' <- cvtContext funPrec ctxt
+        ; (dL->L loc ty') <- cvtType ty
+        ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'
+        ; returnJustL $ InstD noExtField $ ClsInstD noExtField $
+          ClsInstDecl { cid_ext = noExtField, cid_poly_ty = mkLHsSigType inst_ty'
+                      , cid_binds = binds'
+                      , cid_sigs = Hs.mkClassOpSigs sigs'
+                      , cid_tyfam_insts = ats', cid_datafam_insts = adts'
+                      , cid_overlap_mode = fmap (cL loc . overlap) o } }
+  where
+  overlap pragma =
+    case pragma of
+      TH.Overlaps      -> Hs.Overlaps     (SourceText "OVERLAPS")
+      TH.Overlappable  -> Hs.Overlappable (SourceText "OVERLAPPABLE")
+      TH.Overlapping   -> Hs.Overlapping  (SourceText "OVERLAPPING")
+      TH.Incoherent    -> Hs.Incoherent   (SourceText "INCOHERENT")
+
+
+
+
+cvtDec (ForeignD ford)
+  = do { ford' <- cvtForD ford
+       ; returnJustL $ ForD noExtField ford' }
+
+cvtDec (DataFamilyD tc tvs kind)
+  = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
+       ; result <- cvtMaybeKindToFamilyResultSig kind
+       ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+         FamilyDecl noExtField DataFamily tc' tvs' Prefix result Nothing }
+
+cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
+  = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
+       ; ksig' <- cvtKind `traverse` ksig
+       ; cons' <- mapM cvtConstr constrs
+       ; derivs' <- cvtDerivs derivs
+       ; let defn = HsDataDefn { dd_ext = noExtField
+                               , dd_ND = DataType, dd_cType = Nothing
+                               , dd_ctxt = ctxt'
+                               , dd_kindSig = ksig'
+                               , dd_cons = cons', dd_derivs = derivs' }
+
+       ; returnJustL $ InstD noExtField $ DataFamInstD
+           { dfid_ext = noExtField
+           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
+                           FamEqn { feqn_ext = noExtField
+                                  , feqn_tycon = tc'
+                                  , feqn_bndrs = bndrs'
+                                  , feqn_pats = typats'
+                                  , feqn_rhs = defn
+                                  , feqn_fixity = Prefix } }}}
+
+cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
+  = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
+       ; ksig' <- cvtKind `traverse` ksig
+       ; con' <- cvtConstr constr
+       ; derivs' <- cvtDerivs derivs
+       ; let defn = HsDataDefn { dd_ext = noExtField
+                               , dd_ND = NewType, dd_cType = Nothing
+                               , dd_ctxt = ctxt'
+                               , dd_kindSig = ksig'
+                               , dd_cons = [con'], dd_derivs = derivs' }
+       ; returnJustL $ InstD noExtField $ DataFamInstD
+           { dfid_ext = noExtField
+           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
+                           FamEqn { feqn_ext = noExtField
+                                  , feqn_tycon = tc'
+                                  , feqn_bndrs = bndrs'
+                                  , feqn_pats = typats'
+                                  , feqn_rhs = defn
+                                  , feqn_fixity = Prefix } }}}
+
+cvtDec (TySynInstD eqn)
+  = do  { (dL->L _ eqn') <- cvtTySynEqn eqn
+        ; returnJustL $ InstD noExtField $ TyFamInstD
+            { tfid_ext = noExtField
+            , tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
+
+cvtDec (OpenTypeFamilyD head)
+  = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
+       ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+         FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix result' injectivity'
+       }
+
+cvtDec (ClosedTypeFamilyD head eqns)
+  = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
+       ; eqns' <- mapM cvtTySynEqn eqns
+       ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+         FamilyDecl noExtField (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
+                           result' injectivity' }
+
+cvtDec (TH.RoleAnnotD tc roles)
+  = do { tc' <- tconNameL tc
+       ; let roles' = map (noLoc . cvtRole) roles
+       ; returnJustL $ Hs.RoleAnnotD noExtField (RoleAnnotDecl noExtField tc' roles') }
+
+cvtDec (TH.StandaloneDerivD ds cxt ty)
+  = do { cxt' <- cvtContext funPrec cxt
+       ; ds'  <- traverse cvtDerivStrategy ds
+       ; (dL->L loc ty') <- cvtType ty
+       ; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'
+       ; returnJustL $ DerivD noExtField $
+         DerivDecl { deriv_ext =noExtField
+                   , deriv_strategy = ds'
+                   , deriv_type = mkLHsSigWcType inst_ty'
+                   , deriv_overlap_mode = Nothing } }
+
+cvtDec (TH.DefaultSigD nm typ)
+  = do { nm' <- vNameL nm
+       ; ty' <- cvtType typ
+       ; returnJustL $ Hs.SigD noExtField
+                     $ ClassOpSig noExtField True [nm'] (mkLHsSigType ty')}
+
+cvtDec (TH.PatSynD nm args dir pat)
+  = do { nm'   <- cNameL nm
+       ; args' <- cvtArgs args
+       ; dir'  <- cvtDir nm' dir
+       ; pat'  <- cvtPat pat
+       ; returnJustL $ Hs.ValD noExtField $ PatSynBind noExtField $
+           PSB noExtField nm' args' pat' dir' }
+  where
+    cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args
+    cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2
+    cvtArgs (TH.RecordPatSyn sels)
+      = do { sels' <- mapM vNameL sels
+           ; vars' <- mapM (vNameL . mkNameS . nameBase) sels
+           ; return $ Hs.RecCon $ zipWith RecordPatSynField sels' vars' }
+
+    cvtDir _ Unidir          = return Unidirectional
+    cvtDir _ ImplBidir       = return ImplicitBidirectional
+    cvtDir n (ExplBidir cls) =
+      do { ms <- mapM (cvtClause (mkPrefixFunRhs n)) cls
+         ; return $ ExplicitBidirectional $ mkMatchGroup FromSource ms }
+
+cvtDec (TH.PatSynSigD nm ty)
+  = do { nm' <- cNameL nm
+       ; ty' <- cvtPatSynSigTy ty
+       ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] (mkLHsSigType ty')}
+
+-- Implicit parameter bindings are handled in cvtLocalDecs and
+-- cvtImplicitParamBind. They are not allowed in any other scope, so
+-- reaching this case indicates an error.
+cvtDec (TH.ImplicitParamBindD _ _)
+  = failWith (text "Implicit parameter binding only allowed in let or where")
+
+----------------
+cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
+cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
+  = do { mb_bndrs' <- traverse (mapM cvt_tv) mb_bndrs
+       ; (head_ty, args) <- split_ty_app lhs
+       ; case head_ty of
+           ConT nm -> do { nm' <- tconNameL nm
+                         ; rhs' <- cvtType rhs
+                         ; let args' = map wrap_tyarg args
+                         ; returnL $ mkHsImplicitBndrs
+                            $ FamEqn { feqn_ext    = noExtField
+                                     , feqn_tycon  = nm'
+                                     , feqn_bndrs  = mb_bndrs'
+                                     , feqn_pats   = args'
+                                     , feqn_fixity = Prefix
+                                     , feqn_rhs    = rhs' } }
+           InfixT t1 nm t2 -> do { nm' <- tconNameL nm
+                                 ; args' <- mapM cvtType [t1,t2]
+                                 ; rhs' <- cvtType rhs
+                                 ; returnL $ mkHsImplicitBndrs
+                                      $ FamEqn { feqn_ext    = noExtField
+                                               , feqn_tycon  = nm'
+                                               , feqn_bndrs  = mb_bndrs'
+                                               , feqn_pats   =
+                                                (map HsValArg args') ++ args
+                                               , feqn_fixity = Hs.Infix
+                                               , feqn_rhs    = rhs' } }
+           _ -> failWith $ text "Invalid type family instance LHS:"
+                          <+> text (show lhs)
+        }
+
+----------------
+cvt_ci_decs :: MsgDoc -> [TH.Dec]
+            -> CvtM (LHsBinds GhcPs,
+                     [LSig GhcPs],
+                     [LFamilyDecl GhcPs],
+                     [LTyFamInstDecl GhcPs],
+                     [LDataFamInstDecl GhcPs])
+-- Convert the declarations inside a class or instance decl
+-- ie signatures, bindings, and associated types
+cvt_ci_decs doc decs
+  = do  { decs' <- cvtDecs decs
+        ; let (ats', bind_sig_decs') = partitionWith is_tyfam_inst decs'
+        ; let (adts', no_ats')       = partitionWith is_datafam_inst bind_sig_decs'
+        ; let (sigs', prob_binds')   = partitionWith is_sig no_ats'
+        ; let (binds', prob_fams')   = partitionWith is_bind prob_binds'
+        ; let (fams', bads)          = partitionWith is_fam_decl prob_fams'
+        ; unless (null bads) (failWith (mkBadDecMsg doc bads))
+          --We use FromSource as the origin of the bind
+          -- because the TH declaration is user-written
+        ; return (listToBag binds', sigs', fams', ats', adts') }
+
+----------------
+cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]
+             -> CvtM ( LHsContext GhcPs
+                     , Located RdrName
+                     , LHsQTyVars GhcPs)
+cvt_tycl_hdr cxt tc tvs
+  = do { cxt' <- cvtContext funPrec cxt
+       ; tc'  <- tconNameL tc
+       ; tvs' <- cvtTvs tvs
+       ; return (cxt', tc', tvs')
+       }
+
+cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr] -> TH.Type
+               -> CvtM ( LHsContext GhcPs
+                       , Located RdrName
+                       , Maybe [LHsTyVarBndr GhcPs]
+                       , HsTyPats GhcPs)
+cvt_datainst_hdr cxt bndrs tys
+  = do { cxt' <- cvtContext funPrec cxt
+       ; bndrs' <- traverse (mapM cvt_tv) bndrs
+       ; (head_ty, args) <- split_ty_app tys
+       ; case head_ty of
+          ConT nm -> do { nm' <- tconNameL nm
+                        ; let args' = map wrap_tyarg args
+                        ; return (cxt', nm', bndrs', args') }
+          InfixT t1 nm t2 -> do { nm' <- tconNameL nm
+                                ; args' <- mapM cvtType [t1,t2]
+                                ; return (cxt', nm', bndrs',
+                                         ((map HsValArg args') ++ args)) }
+          _ -> failWith $ text "Invalid type instance header:"
+                          <+> text (show tys) }
+
+----------------
+cvt_tyfam_head :: TypeFamilyHead
+               -> CvtM ( Located RdrName
+                       , LHsQTyVars GhcPs
+                       , Hs.LFamilyResultSig GhcPs
+                       , Maybe (Hs.LInjectivityAnn GhcPs))
+
+cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
+  = do {(_, tc', tyvars') <- cvt_tycl_hdr [] tc tyvars
+       ; result' <- cvtFamilyResultSig result
+       ; injectivity' <- traverse cvtInjectivityAnnotation injectivity
+       ; return (tc', tyvars', result', injectivity') }
+
+-------------------------------------------------------------------
+--              Partitioning declarations
+-------------------------------------------------------------------
+
+is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
+is_fam_decl (dL->L loc (TyClD _ (FamDecl { tcdFam = d }))) = Left (cL loc d)
+is_fam_decl decl = Right decl
+
+is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
+is_tyfam_inst (dL->L loc (Hs.InstD _ (TyFamInstD { tfid_inst = d })))
+  = Left (cL loc d)
+is_tyfam_inst decl
+  = Right decl
+
+is_datafam_inst :: LHsDecl GhcPs
+                -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
+is_datafam_inst (dL->L loc (Hs.InstD  _ (DataFamInstD { dfid_inst = d })))
+  = Left (cL loc d)
+is_datafam_inst decl
+  = Right decl
+
+is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
+is_sig (dL->L loc (Hs.SigD _ sig)) = Left (cL loc sig)
+is_sig decl                        = Right decl
+
+is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
+is_bind (dL->L loc (Hs.ValD _ bind)) = Left (cL loc bind)
+is_bind decl                         = Right decl
+
+is_ip_bind :: TH.Dec -> Either (String, TH.Exp) TH.Dec
+is_ip_bind (TH.ImplicitParamBindD n e) = Left (n, e)
+is_ip_bind decl             = Right decl
+
+mkBadDecMsg :: Outputable a => MsgDoc -> [a] -> MsgDoc
+mkBadDecMsg doc bads
+  = sep [ text "Illegal declaration(s) in" <+> doc <> colon
+        , nest 2 (vcat (map Outputable.ppr bads)) ]
+
+---------------------------------------------------
+--      Data types
+---------------------------------------------------
+
+cvtConstr :: TH.Con -> CvtM (LConDecl GhcPs)
+
+cvtConstr (NormalC c strtys)
+  = do  { c'   <- cNameL c
+        ; tys' <- mapM cvt_arg strtys
+        ; returnL $ mkConDeclH98 c' Nothing Nothing (PrefixCon tys') }
+
+cvtConstr (RecC c varstrtys)
+  = do  { c'    <- cNameL c
+        ; args' <- mapM cvt_id_arg varstrtys
+        ; returnL $ mkConDeclH98 c' Nothing Nothing
+                                   (RecCon (noLoc args')) }
+
+cvtConstr (InfixC st1 c st2)
+  = do  { c'   <- cNameL c
+        ; st1' <- cvt_arg st1
+        ; st2' <- cvt_arg st2
+        ; returnL $ mkConDeclH98 c' Nothing Nothing (InfixCon st1' st2') }
+
+cvtConstr (ForallC tvs ctxt con)
+  = do  { tvs'      <- cvtTvs tvs
+        ; ctxt'     <- cvtContext funPrec ctxt
+        ; (dL->L _ con')  <- cvtConstr con
+        ; returnL $ add_forall tvs' ctxt' con' }
+  where
+    add_cxt lcxt         Nothing           = Just lcxt
+    add_cxt (dL->L loc cxt1) (Just (dL->L _ cxt2))
+      = Just (cL loc (cxt1 ++ cxt2))
+
+    add_forall tvs' cxt' con@(ConDeclGADT { con_qvars = qvars, con_mb_cxt = cxt })
+      = con { con_forall = noLoc $ not (null all_tvs)
+            , con_qvars  = mkHsQTvs all_tvs
+            , con_mb_cxt = add_cxt cxt' cxt }
+      where
+        all_tvs = hsQTvExplicit tvs' ++ hsQTvExplicit qvars
+
+    add_forall tvs' cxt' con@(ConDeclH98 { con_ex_tvs = ex_tvs, con_mb_cxt = cxt })
+      = con { con_forall = noLoc $ not (null all_tvs)
+            , con_ex_tvs = all_tvs
+            , con_mb_cxt = add_cxt cxt' cxt }
+      where
+        all_tvs = hsQTvExplicit tvs' ++ ex_tvs
+
+    add_forall _ _ (XConDecl nec) = noExtCon nec
+
+cvtConstr (GadtC c strtys ty)
+  = do  { c'      <- mapM cNameL c
+        ; args    <- mapM cvt_arg strtys
+        ; (dL->L _ ty') <- cvtType ty
+        ; c_ty    <- mk_arr_apps args ty'
+        ; returnL $ fst $ mkGadtDecl c' c_ty}
+
+cvtConstr (RecGadtC c varstrtys ty)
+  = do  { c'       <- mapM cNameL c
+        ; ty'      <- cvtType ty
+        ; rec_flds <- mapM cvt_id_arg varstrtys
+        ; let rec_ty = noLoc (HsFunTy noExtField
+                                           (noLoc $ HsRecTy noExtField rec_flds) ty')
+        ; returnL $ fst $ mkGadtDecl c' rec_ty }
+
+cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
+cvtSrcUnpackedness NoSourceUnpackedness = NoSrcUnpack
+cvtSrcUnpackedness SourceNoUnpack       = SrcNoUnpack
+cvtSrcUnpackedness SourceUnpack         = SrcUnpack
+
+cvtSrcStrictness :: TH.SourceStrictness -> SrcStrictness
+cvtSrcStrictness NoSourceStrictness = NoSrcStrict
+cvtSrcStrictness SourceLazy         = SrcLazy
+cvtSrcStrictness SourceStrict       = SrcStrict
+
+cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs)
+cvt_arg (Bang su ss, ty)
+  = do { ty'' <- cvtType ty
+       ; let ty' = parenthesizeHsType appPrec ty''
+             su' = cvtSrcUnpackedness su
+             ss' = cvtSrcStrictness ss
+       ; returnL $ HsBangTy noExtField (HsSrcBang NoSourceText su' ss') ty' }
+
+cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
+cvt_id_arg (i, str, ty)
+  = do  { (dL->L li i') <- vNameL i
+        ; ty' <- cvt_arg (str,ty)
+        ; return $ noLoc (ConDeclField
+                          { cd_fld_ext = noExtField
+                          , cd_fld_names
+                              = [cL li $ FieldOcc noExtField (cL li i')]
+                          , cd_fld_type =  ty'
+                          , cd_fld_doc = Nothing}) }
+
+cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs)
+cvtDerivs cs = do { cs' <- mapM cvtDerivClause cs
+                  ; returnL cs' }
+
+cvt_fundep :: FunDep -> CvtM (LHsFunDep GhcPs)
+cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs
+                               ; ys' <- mapM tNameL ys
+                               ; returnL (xs', ys') }
+
+
+------------------------------------------
+--      Foreign declarations
+------------------------------------------
+
+cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
+cvtForD (ImportF callconv safety from nm ty)
+  -- the prim and javascript calling conventions do not support headers
+  -- and are inserted verbatim, analogous to mkImport in RdrHsSyn
+  | callconv == TH.Prim || callconv == TH.JavaScript
+  = mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing
+                    (CFunction (StaticTarget (SourceText from)
+                                             (mkFastString from) Nothing
+                                             True))
+                    (noLoc $ quotedSourceText from))
+  | Just impspec <- parseCImport (noLoc (cvt_conv callconv)) (noLoc safety')
+                                 (mkFastString (TH.nameBase nm))
+                                 from (noLoc $ quotedSourceText from)
+  = mk_imp impspec
+  | otherwise
+  = failWith $ text (show from) <+> text "is not a valid ccall impent"
+  where
+    mk_imp impspec
+      = do { nm' <- vNameL nm
+           ; ty' <- cvtType ty
+           ; return (ForeignImport { fd_i_ext = noExtField
+                                   , fd_name = nm'
+                                   , fd_sig_ty = mkLHsSigType ty'
+                                   , fd_fi = impspec })
+           }
+    safety' = case safety of
+                     Unsafe     -> PlayRisky
+                     Safe       -> PlaySafe
+                     Interruptible -> PlayInterruptible
+
+cvtForD (ExportF callconv as nm ty)
+  = do  { nm' <- vNameL nm
+        ; ty' <- cvtType ty
+        ; let e = CExport (noLoc (CExportStatic (SourceText as)
+                                                (mkFastString as)
+                                                (cvt_conv callconv)))
+                                                (noLoc (SourceText as))
+        ; return $ ForeignExport { fd_e_ext = noExtField
+                                 , fd_name = nm'
+                                 , fd_sig_ty = mkLHsSigType ty'
+                                 , fd_fe = e } }
+
+cvt_conv :: TH.Callconv -> CCallConv
+cvt_conv TH.CCall      = CCallConv
+cvt_conv TH.StdCall    = StdCallConv
+cvt_conv TH.CApi       = CApiConv
+cvt_conv TH.Prim       = PrimCallConv
+cvt_conv TH.JavaScript = JavaScriptCallConv
+
+------------------------------------------
+--              Pragmas
+------------------------------------------
+
+cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl GhcPs))
+cvtPragmaD (InlineP nm inline rm phases)
+  = do { nm' <- vNameL nm
+       ; let dflt = dfltActivation inline
+       ; let src TH.NoInline  = "{-# NOINLINE"
+             src TH.Inline    = "{-# INLINE"
+             src TH.Inlinable = "{-# INLINABLE"
+       ; let ip   = InlinePragma { inl_src    = SourceText $ src inline
+                                 , inl_inline = cvtInline inline
+                                 , inl_rule   = cvtRuleMatch rm
+                                 , inl_act    = cvtPhases phases dflt
+                                 , inl_sat    = Nothing }
+       ; returnJustL $ Hs.SigD noExtField $ InlineSig noExtField nm' ip }
+
+cvtPragmaD (SpecialiseP nm ty inline phases)
+  = do { nm' <- vNameL nm
+       ; ty' <- cvtType ty
+       ; let src TH.NoInline  = "{-# SPECIALISE NOINLINE"
+             src TH.Inline    = "{-# SPECIALISE INLINE"
+             src TH.Inlinable = "{-# SPECIALISE INLINE"
+       ; let (inline', dflt,srcText) = case inline of
+               Just inline1 -> (cvtInline inline1, dfltActivation inline1,
+                                src inline1)
+               Nothing      -> (NoUserInline,   AlwaysActive,
+                                "{-# SPECIALISE")
+       ; let ip = InlinePragma { inl_src    = SourceText srcText
+                               , inl_inline = inline'
+                               , inl_rule   = Hs.FunLike
+                               , inl_act    = cvtPhases phases dflt
+                               , inl_sat    = Nothing }
+       ; returnJustL $ Hs.SigD noExtField $ SpecSig noExtField nm' [mkLHsSigType ty'] ip }
+
+cvtPragmaD (SpecialiseInstP ty)
+  = do { ty' <- cvtType ty
+       ; returnJustL $ Hs.SigD noExtField $
+         SpecInstSig noExtField (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
+
+cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
+  = do { let nm' = mkFastString nm
+       ; let act = cvtPhases phases AlwaysActive
+       ; ty_bndrs' <- traverse (mapM cvt_tv) ty_bndrs
+       ; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs
+       ; lhs'   <- cvtl lhs
+       ; rhs'   <- cvtl rhs
+       ; returnJustL $ Hs.RuleD noExtField
+            $ HsRules { rds_ext = noExtField
+                      , rds_src = SourceText "{-# RULES"
+                      , rds_rules = [noLoc $
+                          HsRule { rd_ext  = noExtField
+                                 , rd_name = (noLoc (quotedSourceText nm,nm'))
+                                 , rd_act  = act
+                                 , rd_tyvs = ty_bndrs'
+                                 , rd_tmvs = tm_bndrs'
+                                 , rd_lhs  = lhs'
+                                 , rd_rhs  = rhs' }] }
+
+          }
+
+cvtPragmaD (AnnP target exp)
+  = do { exp' <- cvtl exp
+       ; target' <- case target of
+         ModuleAnnotation  -> return ModuleAnnProvenance
+         TypeAnnotation n  -> do
+           n' <- tconName n
+           return (TypeAnnProvenance  (noLoc n'))
+         ValueAnnotation n -> do
+           n' <- vcName n
+           return (ValueAnnProvenance (noLoc n'))
+       ; returnJustL $ Hs.AnnD noExtField
+                     $ HsAnnotation noExtField (SourceText "{-# ANN") target' exp'
+       }
+
+cvtPragmaD (LineP line file)
+  = do { setL (srcLocSpan (mkSrcLoc (fsLit file) line 1))
+       ; return Nothing
+       }
+cvtPragmaD (CompleteP cls mty)
+  = do { cls' <- noLoc <$> mapM cNameL cls
+       ; mty'  <- traverse tconNameL mty
+       ; returnJustL $ Hs.SigD noExtField
+                   $ CompleteMatchSig noExtField NoSourceText cls' mty' }
+
+dfltActivation :: TH.Inline -> Activation
+dfltActivation TH.NoInline = NeverActive
+dfltActivation _           = AlwaysActive
+
+cvtInline :: TH.Inline -> Hs.InlineSpec
+cvtInline TH.NoInline  = Hs.NoInline
+cvtInline TH.Inline    = Hs.Inline
+cvtInline TH.Inlinable = Hs.Inlinable
+
+cvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo
+cvtRuleMatch TH.ConLike = Hs.ConLike
+cvtRuleMatch TH.FunLike = Hs.FunLike
+
+cvtPhases :: TH.Phases -> Activation -> Activation
+cvtPhases AllPhases       dflt = dflt
+cvtPhases (FromPhase i)   _    = ActiveAfter NoSourceText i
+cvtPhases (BeforePhase i) _    = ActiveBefore NoSourceText i
+
+cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
+cvtRuleBndr (RuleVar n)
+  = do { n' <- vNameL n
+       ; return $ noLoc $ Hs.RuleBndr noExtField n' }
+cvtRuleBndr (TypedRuleVar n ty)
+  = do { n'  <- vNameL n
+       ; ty' <- cvtType ty
+       ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' }
+
+---------------------------------------------------
+--              Declarations
+---------------------------------------------------
+
+cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
+cvtLocalDecs doc ds
+  = case partitionWith is_ip_bind ds of
+      ([], []) -> return (EmptyLocalBinds noExtField)
+      ([], _) -> do
+        ds' <- cvtDecs ds
+        let (binds, prob_sigs) = partitionWith is_bind ds'
+        let (sigs, bads) = partitionWith is_sig prob_sigs
+        unless (null bads) (failWith (mkBadDecMsg doc bads))
+        return (HsValBinds noExtField (ValBinds noExtField (listToBag binds) sigs))
+      (ip_binds, []) -> do
+        binds <- mapM (uncurry cvtImplicitParamBind) ip_binds
+        return (HsIPBinds noExtField (IPBinds noExtField binds))
+      ((_:_), (_:_)) ->
+        failWith (text "Implicit parameters mixed with other bindings")
+
+cvtClause :: HsMatchContext RdrName
+          -> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
+cvtClause ctxt (Clause ps body wheres)
+  = do  { ps' <- cvtPats ps
+        ; let pps = map (parenthesizePat appPrec) ps'
+        ; g'  <- cvtGuard body
+        ; ds' <- cvtLocalDecs (text "a where clause") wheres
+        ; returnL $ Hs.Match noExtField ctxt pps (GRHSs noExtField g' (noLoc ds')) }
+
+cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
+cvtImplicitParamBind n e = do
+    n' <- wrapL (ipName n)
+    e' <- cvtl e
+    returnL (IPBind noExtField (Left n') e')
+
+-------------------------------------------------------------------
+--              Expressions
+-------------------------------------------------------------------
+
+cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
+cvtl e = wrapL (cvt e)
+  where
+    cvt (VarE s)        = do { s' <- vName s; return $ HsVar noExtField (noLoc s') }
+    cvt (ConE s)        = do { s' <- cName s; return $ HsVar noExtField (noLoc s') }
+    cvt (LitE l)
+      | overloadedLit l = go cvtOverLit (HsOverLit noExtField)
+                             (hsOverLitNeedsParens appPrec)
+      | otherwise       = go cvtLit (HsLit noExtField)
+                             (hsLitNeedsParens appPrec)
+      where
+        go :: (Lit -> CvtM (l GhcPs))
+           -> (l GhcPs -> HsExpr GhcPs)
+           -> (l GhcPs -> Bool)
+           -> CvtM (HsExpr GhcPs)
+        go cvt_lit mk_expr is_compound_lit = do
+          l' <- cvt_lit l
+          let e' = mk_expr l'
+          return $ if is_compound_lit l' then HsPar noExtField (noLoc e') else e'
+    cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
+                                   ; return $ HsApp noExtField (mkLHsPar x')
+                                                          (mkLHsPar y')}
+    cvt (AppE x y)            = do { x' <- cvtl x; y' <- cvtl y
+                                   ; return $ HsApp noExtField (mkLHsPar x')
+                                                          (mkLHsPar y')}
+    cvt (AppTypeE e t) = do { e' <- cvtl e
+                            ; t' <- cvtType t
+                            ; let tp = parenthesizeHsType appPrec t'
+                            ; return $ HsAppType noExtField e'
+                                     $ mkHsWildCardBndrs tp }
+    cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
+                               -- own expression to avoid pretty-printing
+                               -- oddities that can result from zero-argument
+                               -- lambda expressions. See #13856.
+    cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e
+                            ; let pats = map (parenthesizePat appPrec) ps'
+                            ; return $ HsLam noExtField (mkMatchGroup FromSource
+                                             [mkSimpleMatch LambdaExpr
+                                             pats e'])}
+    cvt (LamCaseE ms)  = do { ms' <- mapM (cvtMatch CaseAlt) ms
+                            ; return $ HsLamCase noExtField
+                                                   (mkMatchGroup FromSource ms')
+                            }
+    cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExtField e' }
+                                 -- Note [Dropping constructors]
+                                 -- Singleton tuples treated like nothing (just parens)
+    cvt (TupE es)        = cvt_tup es Boxed
+    cvt (UnboxedTupE es) = cvt_tup es Unboxed
+    cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
+                                       ; unboxedSumChecks alt arity
+                                       ; return $ ExplicitSum noExtField
+                                                                   alt arity e'}
+    cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
+                            ; return $ HsIf noExtField (Just noSyntaxExpr) x' y' z' }
+    cvt (MultiIfE alts)
+      | null alts      = failWith (text "Multi-way if-expression with no alternatives")
+      | otherwise      = do { alts' <- mapM cvtpair alts
+                            ; return $ HsMultiIf noExtField alts' }
+    cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text "a let expression") ds
+                            ; e' <- cvtl e; return $ HsLet noExtField (noLoc ds') e'}
+    cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
+                            ; return $ HsCase noExtField e'
+                                                 (mkMatchGroup FromSource ms') }
+    cvt (DoE ss)       = cvtHsDo DoExpr ss
+    cvt (MDoE ss)      = cvtHsDo MDoExpr ss
+    cvt (CompE ss)     = cvtHsDo ListComp ss
+    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd
+                            ; return $ ArithSeq noExtField Nothing dd' }
+    cvt (ListE xs)
+      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s)
+                                          ; return (HsLit noExtField l') }
+             -- Note [Converting strings]
+      | otherwise       = do { xs' <- mapM cvtl xs
+                             ; return $ ExplicitList noExtField Nothing xs'
+                             }
+
+    -- Infix expressions
+    cvt (InfixE (Just x) s (Just y)) = ensureValidOpExp s $
+      do { x' <- cvtl x
+         ; s' <- cvtl s
+         ; y' <- cvtl y
+         ; let px = parenthesizeHsExpr opPrec x'
+               py = parenthesizeHsExpr opPrec y'
+         ; wrapParL (HsPar noExtField)
+           $ OpApp noExtField px s' py }
+           -- Parenthesise both arguments and result,
+           -- to ensure this operator application does
+           -- does not get re-associated
+           -- See Note [Operator association]
+    cvt (InfixE Nothing  s (Just y)) = ensureValidOpExp s $
+                                       do { s' <- cvtl s; y' <- cvtl y
+                                          ; wrapParL (HsPar noExtField) $
+                                                          SectionR noExtField s' y' }
+                                            -- See Note [Sections in HsSyn] in GHC.Hs.Expr
+    cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $
+                                       do { x' <- cvtl x; s' <- cvtl s
+                                          ; wrapParL (HsPar noExtField) $
+                                                          SectionL noExtField x' s' }
+
+    cvt (InfixE Nothing  s Nothing ) = ensureValidOpExp s $
+                                       do { s' <- cvtl s
+                                          ; return $ HsPar noExtField s' }
+                                       -- Can I indicate this is an infix thing?
+                                       -- Note [Dropping constructors]
+
+    cvt (UInfixE x s y)  = ensureValidOpExp s $
+                           do { x' <- cvtl x
+                              ; let x'' = case unLoc x' of
+                                            OpApp {} -> x'
+                                            _ -> mkLHsPar x'
+                              ; cvtOpApp x'' s y } --  Note [Converting UInfix]
+
+    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar noExtField e' }
+    cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtType t
+                              ; let pe = parenthesizeHsExpr sigPrec e'
+                              ; return $ ExprWithTySig noExtField pe (mkLHsSigWcType t') }
+    cvt (RecConE c flds) = do { c' <- cNameL c
+                              ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
+                              ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
+    cvt (RecUpdE e flds) = do { e' <- cvtl e
+                              ; flds'
+                                  <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
+                                           flds
+                              ; return $ mkRdrRecordUpd e' flds' }
+    cvt (StaticE e)      = fmap (HsStatic noExtField) $ cvtl e
+    cvt (UnboundVarE s)  = do -- Use of 'vcName' here instead of 'vName' is
+                              -- important, because UnboundVarE may contain
+                              -- constructor names - see #14627.
+                              { s' <- vcName s
+                              ; return $ HsVar noExtField (noLoc s') }
+    cvt (LabelE s)       = do { return $ HsOverLabel noExtField Nothing (fsLit s) }
+    cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' }
+
+{- | #16895 Ensure an infix expression's operator is a variable/constructor.
+Consider this example:
+
+  $(uInfixE [|1|] [|id id|] [|2|])
+
+This infix expression is obviously ill-formed so we use this helper function
+to reject such programs outright.
+
+The constructors `ensureValidOpExp` permits should be in sync with `pprInfixExp`
+in Language.Haskell.TH.Ppr from the template-haskell library.
+-}
+ensureValidOpExp :: TH.Exp -> CvtM a -> CvtM a
+ensureValidOpExp (VarE _n) m = m
+ensureValidOpExp (ConE _n) m = m
+ensureValidOpExp (UnboundVarE _n) m = m
+ensureValidOpExp _e _m =
+    failWith (text "Non-variable expression is not allowed in an infix expression")
+
+{- Note [Dropping constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we drop constructors from the input (for instance, when we encounter @TupE [e]@)
+we must insert parentheses around the argument. Otherwise, @UInfix@ constructors in @e@
+could meet @UInfix@ constructors containing the @TupE [e]@. For example:
+
+  UInfixE x * (TupE [UInfixE y + z])
+
+If we drop the singleton tuple but don't insert parentheses, the @UInfixE@s would meet
+and the above expression would be reassociated to
+
+  OpApp (OpApp x * y) + z
+
+which we don't want.
+-}
+
+cvtFld :: (RdrName -> t) -> (TH.Name, TH.Exp)
+       -> CvtM (LHsRecField' t (LHsExpr GhcPs))
+cvtFld f (v,e)
+  = do  { v' <- vNameL v; e' <- cvtl e
+        ; return (noLoc $ HsRecField { hsRecFieldLbl = fmap f v'
+                                     , hsRecFieldArg = e'
+                                     , hsRecPun      = False}) }
+
+cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
+cvtDD (FromR x)           = do { x' <- cvtl x; return $ From x' }
+cvtDD (FromThenR x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x' y' }
+cvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' }
+cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' }
+
+cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
+cvt_tup es boxity = do { let cvtl_maybe Nothing  = return missingTupArg
+                             cvtl_maybe (Just e) = fmap (Present noExtField) (cvtl e)
+                       ; es' <- mapM cvtl_maybe es
+                       ; return $ ExplicitTuple
+                                    noExtField
+                                    (map noLoc es')
+                                    boxity }
+
+{- Note [Operator assocation]
+We must be quite careful about adding parens:
+  * Infix (UInfix ...) op arg      Needs parens round the first arg
+  * Infix (Infix ...) op arg       Needs parens round the first arg
+  * UInfix (UInfix ...) op arg     No parens for first arg
+  * UInfix (Infix ...) op arg      Needs parens round first arg
+
+
+Note [Converting UInfix]
+~~~~~~~~~~~~~~~~~~~~~~~~
+When converting @UInfixE@, @UInfixP@, and @UInfixT@ values, we want to readjust
+the trees to reflect the fixities of the underlying operators:
+
+  UInfixE x * (UInfixE y + z) ---> (x * y) + z
+
+This is done by the renamer (see @mkOppAppRn@, @mkConOppPatRn@, and
+@mkHsOpTyRn@ in RnTypes), which expects that the input will be completely
+right-biased for types and left-biased for everything else. So we left-bias the
+trees of @UInfixP@ and @UInfixE@ and right-bias the trees of @UInfixT@.
+
+Sample input:
+
+  UInfixE
+   (UInfixE x op1 y)
+   op2
+   (UInfixE z op3 w)
+
+Sample output:
+
+  OpApp
+    (OpApp
+      (OpApp x op1 y)
+      op2
+      z)
+    op3
+    w
+
+The functions @cvtOpApp@, @cvtOpAppP@, and @cvtOpAppT@ are responsible for this
+biasing.
+-}
+
+{- | @cvtOpApp x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
+The produced tree of infix expressions will be left-biased, provided @x@ is.
+
+We can see that @cvtOpApp@ is correct as follows. The inductive hypothesis
+is that @cvtOpApp x op y@ is left-biased, provided @x@ is. It is clear that
+this holds for both branches (of @cvtOpApp@), provided we assume it holds for
+the recursive calls to @cvtOpApp@.
+
+When we call @cvtOpApp@ from @cvtl@, the first argument will always be left-biased
+since we have already run @cvtl@ on it.
+-}
+cvtOpApp :: LHsExpr GhcPs -> TH.Exp -> TH.Exp -> CvtM (HsExpr GhcPs)
+cvtOpApp x op1 (UInfixE y op2 z)
+  = do { l <- wrapL $ cvtOpApp x op1 y
+       ; cvtOpApp l op2 z }
+cvtOpApp x op y
+  = do { op' <- cvtl op
+       ; y' <- cvtl y
+       ; return (OpApp noExtField x op' y') }
+
+-------------------------------------
+--      Do notation and statements
+-------------------------------------
+
+cvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr GhcPs)
+cvtHsDo do_or_lc stmts
+  | null stmts = failWith (text "Empty stmt list in do-block")
+  | otherwise
+  = do  { stmts' <- cvtStmts stmts
+        ; let Just (stmts'', last') = snocView stmts'
+
+        ; last'' <- case last' of
+                    (dL->L loc (BodyStmt _ body _ _))
+                      -> return (cL loc (mkLastStmt body))
+                    _ -> failWith (bad_last last')
+
+        ; return $ HsDo noExtField do_or_lc (noLoc (stmts'' ++ [last''])) }
+  where
+    bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
+                         , nest 2 $ Outputable.ppr stmt
+                         , text "(It should be an expression.)" ]
+
+cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt GhcPs (LHsExpr GhcPs)]
+cvtStmts = mapM cvtStmt
+
+cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
+cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
+cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
+cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text "a let binding") ds
+                            ; returnL $ LetStmt noExtField (noLoc ds') }
+cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss
+                            ; returnL $ ParStmt noExtField dss' noExpr noSyntaxExpr }
+  where
+    cvt_one ds = do { ds' <- cvtStmts ds
+                    ; return (ParStmtBlock noExtField ds' undefined noSyntaxExpr) }
+cvtStmt (TH.RecS ss) = do { ss' <- mapM cvtStmt ss; returnL (mkRecStmt ss') }
+
+cvtMatch :: HsMatchContext RdrName
+         -> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
+cvtMatch ctxt (TH.Match p body decs)
+  = do  { p' <- cvtPat p
+        ; let lp = case p' of
+                     (dL->L loc SigPat{}) -> cL loc (ParPat noExtField p') -- #14875
+                     _                    -> p'
+        ; g' <- cvtGuard body
+        ; decs' <- cvtLocalDecs (text "a where clause") decs
+        ; returnL $ Hs.Match noExtField ctxt [lp] (GRHSs noExtField g' (noLoc decs')) }
+
+cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
+cvtGuard (GuardedB pairs) = mapM cvtpair pairs
+cvtGuard (NormalB e)      = do { e' <- cvtl e
+                               ; g' <- returnL $ GRHS noExtField [] e'; return [g'] }
+
+cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
+cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
+                              ; g' <- returnL $ mkBodyStmt ge'
+                              ; returnL $ GRHS noExtField [g'] rhs' }
+cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
+                              ; returnL $ GRHS noExtField gs' rhs' }
+
+cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
+cvtOverLit (IntegerL i)
+  = do { force i; return $ mkHsIntegral   (mkIntegralLit i) }
+cvtOverLit (RationalL r)
+  = do { force r; return $ mkHsFractional (mkFractionalLit r) }
+cvtOverLit (StringL s)
+  = do { let { s' = mkFastString s }
+       ; force s'
+       ; return $ mkHsIsString (quotedSourceText s) s'
+       }
+cvtOverLit _ = panic "Convert.cvtOverLit: Unexpected overloaded literal"
+-- An Integer is like an (overloaded) '3' in a Haskell source program
+-- Similarly 3.5 for fractionals
+
+{- Note [Converting strings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we get (ListE [CharL 'x', CharL 'y']) we'd like to convert to
+a string literal for "xy".  Of course, we might hope to get
+(LitE (StringL "xy")), but not always, and allCharLs fails quickly
+if it isn't a literal string
+-}
+
+allCharLs :: [TH.Exp] -> Maybe String
+-- Note [Converting strings]
+-- NB: only fire up this setup for a non-empty list, else
+--     there's a danger of returning "" for [] :: [Int]!
+allCharLs xs
+  = case xs of
+      LitE (CharL c) : ys -> go [c] ys
+      _                   -> Nothing
+  where
+    go cs []                    = Just (reverse cs)
+    go cs (LitE (CharL c) : ys) = go (c:cs) ys
+    go _  _                     = Nothing
+
+cvtLit :: Lit -> CvtM (HsLit GhcPs)
+cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim NoSourceText i }
+cvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim NoSourceText w }
+cvtLit (FloatPrimL f)
+  = do { force f; return $ HsFloatPrim noExtField (mkFractionalLit f) }
+cvtLit (DoublePrimL f)
+  = do { force f; return $ HsDoublePrim noExtField (mkFractionalLit f) }
+cvtLit (CharL c)       = do { force c; return $ HsChar NoSourceText c }
+cvtLit (CharPrimL c)   = do { force c; return $ HsCharPrim NoSourceText c }
+cvtLit (StringL s)     = do { let { s' = mkFastString s }
+                            ; force s'
+                            ; return $ HsString (quotedSourceText s) s' }
+cvtLit (StringPrimL s) = do { let { s' = BS.pack s }
+                            ; force s'
+                            ; return $ HsStringPrim NoSourceText s' }
+cvtLit (BytesPrimL (Bytes fptr off sz)) = do
+  let bs = unsafePerformIO $ withForeignPtr fptr $ \ptr ->
+             BS.packCStringLen (ptr `plusPtr` fromIntegral off, fromIntegral sz)
+  force bs
+  return $ HsStringPrim NoSourceText bs
+cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
+        -- cvtLit should not be called on IntegerL, RationalL
+        -- That precondition is established right here in
+        -- Convert.hs, hence panic
+
+quotedSourceText :: String -> SourceText
+quotedSourceText s = SourceText $ "\"" ++ s ++ "\""
+
+cvtPats :: [TH.Pat] -> CvtM [Hs.LPat GhcPs]
+cvtPats pats = mapM cvtPat pats
+
+cvtPat :: TH.Pat -> CvtM (Hs.LPat GhcPs)
+cvtPat pat = wrapL (cvtp pat)
+
+cvtp :: TH.Pat -> CvtM (Hs.Pat GhcPs)
+cvtp (TH.LitP l)
+  | overloadedLit l    = do { l' <- cvtOverLit l
+                            ; return (mkNPat (noLoc l') Nothing) }
+                                  -- Not right for negative patterns;
+                                  -- need to think about that!
+  | otherwise          = do { l' <- cvtLit l; return $ Hs.LitPat noExtField l' }
+cvtp (TH.VarP s)       = do { s' <- vName s
+                            ; return $ Hs.VarPat noExtField (noLoc s') }
+cvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat noExtField p' }
+                                         -- Note [Dropping constructors]
+cvtp (TupP ps)         = do { ps' <- cvtPats ps
+                            ; return $ TuplePat noExtField ps' Boxed }
+cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps
+                            ; return $ TuplePat noExtField ps' Unboxed }
+cvtp (UnboxedSumP p alt arity)
+                       = do { p' <- cvtPat p
+                            ; unboxedSumChecks alt arity
+                            ; return $ SumPat noExtField p' alt arity }
+cvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps
+                            ; let pps = map (parenthesizePat appPrec) ps'
+                            ; return $ ConPatIn s' (PrefixCon pps) }
+cvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
+                            ; wrapParL (ParPat noExtField) $
+                              ConPatIn s' $
+                              InfixCon (parenthesizePat opPrec p1')
+                                       (parenthesizePat opPrec p2') }
+                            -- See Note [Operator association]
+cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
+cvtp (ParensP p)       = do { p' <- cvtPat p;
+                            ; case unLoc p' of  -- may be wrapped ConPatIn
+                                ParPat {} -> return $ unLoc p'
+                                _         -> return $ ParPat noExtField p' }
+cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat noExtField p' }
+cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat noExtField p' }
+cvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p
+                            ; return $ AsPat noExtField s' p' }
+cvtp TH.WildP          = return $ WildPat noExtField
+cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
+                            ; return $ ConPatIn c'
+                                     $ Hs.RecCon (HsRecFields fs' Nothing) }
+cvtp (ListP ps)        = do { ps' <- cvtPats ps
+                            ; return
+                                   $ ListPat noExtField ps'}
+cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
+                            ; return $ SigPat noExtField p' (mkLHsSigWcType t') }
+cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
+                            ; return $ ViewPat noExtField e' p'}
+
+cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
+cvtPatFld (s,p)
+  = do  { (dL->L ls s') <- vNameL s
+        ; p' <- cvtPat p
+        ; return (noLoc $ HsRecField { hsRecFieldLbl
+                                         = cL ls $ mkFieldOcc (cL ls s')
+                                     , hsRecFieldArg = p'
+                                     , hsRecPun      = False}) }
+
+{- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
+The produced tree of infix patterns will be left-biased, provided @x@ is.
+
+See the @cvtOpApp@ documentation for how this function works.
+-}
+cvtOpAppP :: Hs.LPat GhcPs -> TH.Name -> TH.Pat -> CvtM (Hs.Pat GhcPs)
+cvtOpAppP x op1 (UInfixP y op2 z)
+  = do { l <- wrapL $ cvtOpAppP x op1 y
+       ; cvtOpAppP l op2 z }
+cvtOpAppP x op y
+  = do { op' <- cNameL op
+       ; y' <- cvtPat y
+       ; return (ConPatIn op' (InfixCon x y')) }
+
+-----------------------------------------------------------
+--      Types and type variables
+
+cvtTvs :: [TH.TyVarBndr] -> CvtM (LHsQTyVars GhcPs)
+cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
+
+cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)
+cvt_tv (TH.PlainTV nm)
+  = do { nm' <- tNameL nm
+       ; returnL $ UserTyVar noExtField nm' }
+cvt_tv (TH.KindedTV nm ki)
+  = do { nm' <- tNameL nm
+       ; ki' <- cvtKind ki
+       ; returnL $ KindedTyVar noExtField nm' ki' }
+
+cvtRole :: TH.Role -> Maybe Coercion.Role
+cvtRole TH.NominalR          = Just Coercion.Nominal
+cvtRole TH.RepresentationalR = Just Coercion.Representational
+cvtRole TH.PhantomR          = Just Coercion.Phantom
+cvtRole TH.InferR            = Nothing
+
+cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs)
+cvtContext p tys = do { preds' <- mapM cvtPred tys
+                      ; parenthesizeHsContext p <$> returnL preds' }
+
+cvtPred :: TH.Pred -> CvtM (LHsType GhcPs)
+cvtPred = cvtType
+
+cvtDerivClause :: TH.DerivClause
+               -> CvtM (LHsDerivingClause GhcPs)
+cvtDerivClause (TH.DerivClause ds ctxt)
+  = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt
+       ; ds'   <- traverse cvtDerivStrategy ds
+       ; returnL $ HsDerivingClause noExtField ds' ctxt' }
+
+cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)
+cvtDerivStrategy TH.StockStrategy    = returnL Hs.StockStrategy
+cvtDerivStrategy TH.AnyclassStrategy = returnL Hs.AnyclassStrategy
+cvtDerivStrategy TH.NewtypeStrategy  = returnL Hs.NewtypeStrategy
+cvtDerivStrategy (TH.ViaStrategy ty) = do
+  ty' <- cvtType ty
+  returnL $ Hs.ViaStrategy (mkLHsSigType ty')
+
+cvtType :: TH.Type -> CvtM (LHsType GhcPs)
+cvtType = cvtTypeKind "type"
+
+cvtTypeKind :: String -> TH.Type -> CvtM (LHsType GhcPs)
+cvtTypeKind ty_str ty
+  = do { (head_ty, tys') <- split_ty_app ty
+       ; let m_normals = mapM extract_normal tys'
+                                where extract_normal (HsValArg ty) = Just ty
+                                      extract_normal _ = Nothing
+
+       ; case head_ty of
+           TupleT n
+            | Just normals <- m_normals
+            , normals `lengthIs` n         -- Saturated
+               -> if n==1 then return (head normals) -- Singleton tuples treated
+                                                     -- like nothing (ie just parens)
+                          else returnL (HsTupleTy noExtField
+                                        HsBoxedOrConstraintTuple normals)
+            | n == 1
+               -> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor")))
+            | otherwise
+            -> mk_apps
+               (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))
+               tys'
+           UnboxedTupleT n
+             | Just normals <- m_normals
+             , normals `lengthIs` n               -- Saturated
+             -> returnL (HsTupleTy noExtField HsUnboxedTuple normals)
+             | otherwise
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))
+                tys'
+           UnboxedSumT n
+             | n < 2
+            -> failWith $
+                   vcat [ text "Illegal sum arity:" <+> text (show n)
+                        , nest 2 $
+                            text "Sums must have an arity of at least 2" ]
+             | Just normals <- m_normals
+             , normals `lengthIs` n -- Saturated
+             -> returnL (HsSumTy noExtField normals)
+             | otherwise
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName (sumTyCon n))))
+                tys'
+           ArrowT
+             | Just normals <- m_normals
+             , [x',y'] <- normals -> do
+                 x'' <- case unLoc x' of
+                          HsFunTy{}    -> returnL (HsParTy noExtField x')
+                          HsForAllTy{} -> returnL (HsParTy noExtField x') -- #14646
+                          HsQualTy{}   -> returnL (HsParTy noExtField x') -- #15324
+                          _            -> return $
+                                          parenthesizeHsType sigPrec x'
+                 let y'' = parenthesizeHsType sigPrec y'
+                 returnL (HsFunTy noExtField x'' y'')
+             | otherwise
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName funTyCon)))
+                tys'
+           ListT
+             | Just normals <- m_normals
+             , [x'] <- normals -> do
+                returnL (HsListTy noExtField x')
+             | otherwise
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName listTyCon)))
+                tys'
+
+           VarT nm -> do { nm' <- tNameL nm
+                         ; mk_apps (HsTyVar noExtField NotPromoted nm') tys' }
+           ConT nm -> do { nm' <- tconName nm
+                         ; -- ConT can contain both data constructor (i.e.,
+                           -- promoted) names and other (i.e, unpromoted)
+                           -- names, as opposed to PromotedT, which can only
+                           -- contain data constructor names. See #15572.
+                           let prom = if isRdrDataCon nm'
+                                      then IsPromoted
+                                      else NotPromoted
+                         ; mk_apps (HsTyVar noExtField prom (noLoc nm')) tys'}
+
+           ForallT tvs cxt ty
+             | null tys'
+             -> do { tvs' <- cvtTvs tvs
+                   ; cxt' <- cvtContext funPrec cxt
+                   ; ty'  <- cvtType ty
+                   ; loc <- getL
+                   ; let hs_ty  = mkHsForAllTy tvs loc ForallInvis tvs' rho_ty
+                         rho_ty = mkHsQualTy cxt loc cxt' ty'
+
+                   ; return hs_ty }
+
+           ForallVisT tvs ty
+             | null tys'
+             -> do { tvs' <- cvtTvs tvs
+                   ; ty'  <- cvtType ty
+                   ; loc  <- getL
+                   ; pure $ mkHsForAllTy tvs loc ForallVis tvs' ty' }
+
+           SigT ty ki
+             -> do { ty' <- cvtType ty
+                   ; ki' <- cvtKind ki
+                   ; mk_apps (HsKindSig noExtField ty' ki') tys'
+                   }
+
+           LitT lit
+             -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys'
+
+           WildCardT
+             -> mk_apps mkAnonWildCardTy tys'
+
+           InfixT t1 s t2
+             -> do { s'  <- tconName s
+                   ; t1' <- cvtType t1
+                   ; t2' <- cvtType t2
+                   ; mk_apps
+                      (HsTyVar noExtField NotPromoted (noLoc s'))
+                      ([HsValArg t1', HsValArg t2'] ++ tys')
+                   }
+
+           UInfixT t1 s t2
+             -> do { t2' <- cvtType t2
+                   ; t <- cvtOpAppT t1 s t2'
+                   ; mk_apps (unLoc t) tys'
+                   } -- Note [Converting UInfix]
+
+           ParensT t
+             -> do { t' <- cvtType t
+                   ; mk_apps (HsParTy noExtField t') tys'
+                   }
+
+           PromotedT nm -> do { nm' <- cName nm
+                              ; mk_apps (HsTyVar noExtField IsPromoted (noLoc nm'))
+                                        tys' }
+                 -- Promoted data constructor; hence cName
+
+           PromotedTupleT n
+              | n == 1
+              -> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str)))
+              | Just normals <- m_normals
+              , normals `lengthIs` n   -- Saturated
+              -> returnL (HsExplicitTupleTy noExtField normals)
+              | otherwise
+              -> mk_apps
+                 (HsTyVar noExtField IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))
+                 tys'
+
+           PromotedNilT
+             -> mk_apps (HsExplicitListTy noExtField IsPromoted []) tys'
+
+           PromotedConsT  -- See Note [Representing concrete syntax in types]
+                          -- in Language.Haskell.TH.Syntax
+              | Just normals <- m_normals
+              , [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals
+              -> do
+                  returnL (HsExplicitListTy noExtField ip (ty1:tys2))
+              | otherwise
+              -> mk_apps
+                 (HsTyVar noExtField IsPromoted (noLoc (getRdrName consDataCon)))
+                 tys'
+
+           StarT
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))
+                tys'
+
+           ConstraintT
+             -> mk_apps
+                (HsTyVar noExtField NotPromoted (noLoc (getRdrName constraintKindTyCon)))
+                tys'
+
+           EqualityT
+             | Just normals <- m_normals
+             , [x',y'] <- normals ->
+                   let px = parenthesizeHsType opPrec x'
+                       py = parenthesizeHsType opPrec y'
+                   in returnL (HsOpTy noExtField px (noLoc eqTyCon_RDR) py)
+               -- The long-term goal is to remove the above case entirely and
+               -- subsume it under the case for InfixT. See #15815, comment:6,
+               -- for more details.
+
+             | otherwise ->
+                   mk_apps (HsTyVar noExtField NotPromoted
+                            (noLoc eqTyCon_RDR)) tys'
+           ImplicitParamT n t
+             -> do { n' <- wrapL $ ipName n
+                   ; t' <- cvtType t
+                   ; returnL (HsIParamTy noExtField n' t')
+                   }
+
+           _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty))
+    }
+
+-- | Constructs an application of a type to arguments passed in a list.
+mk_apps :: HsType GhcPs -> [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
+mk_apps head_ty type_args = do
+  head_ty' <- returnL head_ty
+  -- We must parenthesize the function type in case of an explicit
+  -- signature. For instance, in `(Maybe :: Type -> Type) Int`, there
+  -- _must_ be parentheses around `Maybe :: Type -> Type`.
+  let phead_ty :: LHsType GhcPs
+      phead_ty = parenthesizeHsType sigPrec head_ty'
+
+      go :: [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
+      go [] = pure head_ty'
+      go (arg:args) =
+        case arg of
+          HsValArg ty  -> do p_ty <- add_parens ty
+                             mk_apps (HsAppTy noExtField phead_ty p_ty) args
+          HsTypeArg l ki -> do p_ki <- add_parens ki
+                               mk_apps (HsAppKindTy l phead_ty p_ki) args
+          HsArgPar _   -> mk_apps (HsParTy noExtField phead_ty) args
+
+  go type_args
+   where
+    -- See Note [Adding parens for splices]
+    add_parens lt@(dL->L _ t)
+      | hsTypeNeedsParens appPrec t = returnL (HsParTy noExtField lt)
+      | otherwise                   = return lt
+
+wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
+wrap_tyarg (HsValArg ty)    = HsValArg  $ parenthesizeHsType appPrec ty
+wrap_tyarg (HsTypeArg l ki) = HsTypeArg l $ parenthesizeHsType appPrec ki
+wrap_tyarg ta@(HsArgPar {}) = ta -- Already parenthesized
+
+-- ---------------------------------------------------------------------
+-- Note [Adding parens for splices]
+{-
+The hsSyn representation of parsed source explicitly contains all the original
+parens, as written in the source.
+
+When a Template Haskell (TH) splice is evaluated, the original splice is first
+renamed and type checked and then finally converted to core in DsMeta. This core
+is then run in the TH engine, and the result comes back as a TH AST.
+
+In the process, all parens are stripped out, as they are not needed.
+
+This Convert module then converts the TH AST back to hsSyn AST.
+
+In order to pretty-print this hsSyn AST, parens need to be adde back at certain
+points so that the code is readable with its original meaning.
+
+So scattered through Convert.hs are various points where parens are added.
+
+See (among other closed issued) https://gitlab.haskell.org/ghc/ghc/issues/14289
+-}
+-- ---------------------------------------------------------------------
+
+-- | Constructs an arrow type with a specified return type
+mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)
+mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL
+    where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)
+          go arg ret_ty = do { ret_ty_l <- returnL ret_ty
+                             ; return (HsFunTy noExtField arg ret_ty_l) }
+
+split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
+split_ty_app ty = go ty []
+  where
+    go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') }
+    go (AppKindT ty ki) as' = do { ki' <- cvtKind ki
+                                 ; go ty (HsTypeArg noSrcSpan ki':as') }
+    go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }
+    go f as           = return (f,as)
+
+cvtTyLit :: TH.TyLit -> HsTyLit
+cvtTyLit (TH.NumTyLit i) = HsNumTy NoSourceText i
+cvtTyLit (TH.StrTyLit s) = HsStrTy NoSourceText (fsLit s)
+
+{- | @cvtOpAppT x op y@ converts @op@ and @y@ and produces the operator
+application @x `op` y@. The produced tree of infix types will be right-biased,
+provided @y@ is.
+
+See the @cvtOpApp@ documentation for how this function works.
+-}
+cvtOpAppT :: TH.Type -> TH.Name -> LHsType GhcPs -> CvtM (LHsType GhcPs)
+cvtOpAppT (UInfixT x op2 y) op1 z
+  = do { l <- cvtOpAppT y op1 z
+       ; cvtOpAppT x op2 l }
+cvtOpAppT x op y
+  = do { op' <- tconNameL op
+       ; x' <- cvtType x
+       ; returnL (mkHsOpTy x' op' y) }
+
+cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
+cvtKind = cvtTypeKind "kind"
+
+-- | Convert Maybe Kind to a type family result signature. Used with data
+-- families where naming of the result is not possible (thus only kind or no
+-- signature is possible).
+cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
+                              -> CvtM (LFamilyResultSig GhcPs)
+cvtMaybeKindToFamilyResultSig Nothing   = returnL (Hs.NoSig noExtField)
+cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki
+                                             ; returnL (Hs.KindSig noExtField ki') }
+
+-- | Convert type family result signature. Used with both open and closed type
+-- families.
+cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
+cvtFamilyResultSig TH.NoSig           = returnL (Hs.NoSig noExtField)
+cvtFamilyResultSig (TH.KindSig ki)    = do { ki' <- cvtKind ki
+                                           ; returnL (Hs.KindSig noExtField  ki') }
+cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr
+                                           ; returnL (Hs.TyVarSig noExtField tv) }
+
+-- | Convert injectivity annotation of a type family.
+cvtInjectivityAnnotation :: TH.InjectivityAnn
+                         -> CvtM (Hs.LInjectivityAnn GhcPs)
+cvtInjectivityAnnotation (TH.InjectivityAnn annLHS annRHS)
+  = do { annLHS' <- tNameL annLHS
+       ; annRHS' <- mapM tNameL annRHS
+       ; returnL (Hs.InjectivityAnn annLHS' annRHS') }
+
+cvtPatSynSigTy :: TH.Type -> CvtM (LHsType GhcPs)
+-- pattern synonym types are of peculiar shapes, which is why we treat
+-- them separately from regular types;
+-- see Note [Pattern synonym type signatures and Template Haskell]
+cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
+  | null exis, null provs = cvtType (ForallT univs reqs ty)
+  | null univs, null reqs = do { l   <- getL
+                               ; ty' <- cvtType (ForallT exis provs ty)
+                               ; return $ cL l (HsQualTy { hst_ctxt = cL l []
+                                                         , hst_xqual = noExtField
+                                                         , hst_body = ty' }) }
+  | null reqs             = do { l      <- getL
+                               ; univs' <- hsQTvExplicit <$> cvtTvs univs
+                               ; ty'    <- cvtType (ForallT exis provs ty)
+                               ; let forTy = HsForAllTy
+                                              { hst_fvf = ForallInvis
+                                              , hst_bndrs = univs'
+                                              , hst_xforall = noExtField
+                                              , hst_body = cL l cxtTy }
+                                     cxtTy = HsQualTy { hst_ctxt = cL l []
+                                                      , hst_xqual = noExtField
+                                                      , hst_body = ty' }
+                               ; return $ cL l forTy }
+  | otherwise             = cvtType (ForallT univs reqs (ForallT exis provs ty))
+cvtPatSynSigTy ty         = cvtType ty
+
+-----------------------------------------------------------
+cvtFixity :: TH.Fixity -> Hs.Fixity
+cvtFixity (TH.Fixity prec dir) = Hs.Fixity NoSourceText prec (cvt_dir dir)
+   where
+     cvt_dir TH.InfixL = Hs.InfixL
+     cvt_dir TH.InfixR = Hs.InfixR
+     cvt_dir TH.InfixN = Hs.InfixN
+
+-----------------------------------------------------------
+
+
+-----------------------------------------------------------
+-- some useful things
+
+overloadedLit :: Lit -> Bool
+-- True for literals that Haskell treats as overloaded
+overloadedLit (IntegerL  _) = True
+overloadedLit (RationalL _) = True
+overloadedLit _             = False
+
+-- Checks that are performed when converting unboxed sum expressions and
+-- patterns alike.
+unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()
+unboxedSumChecks alt arity
+    | alt > arity
+    = failWith $ text "Sum alternative"    <+> text (show alt)
+             <+> text "exceeds its arity," <+> text (show arity)
+    | alt <= 0
+    = failWith $ vcat [ text "Illegal sum alternative:" <+> text (show alt)
+                      , nest 2 $ text "Sum alternatives must start from 1" ]
+    | arity < 2
+    = failWith $ vcat [ text "Illegal sum arity:" <+> text (show arity)
+                      , nest 2 $ text "Sums must have an arity of at least 2" ]
+    | otherwise
+    = return ()
+
+-- | If passed an empty list of 'TH.TyVarBndr's, this simply returns the
+-- third argument (an 'LHsType'). Otherwise, return an 'HsForAllTy'
+-- using the provided 'LHsQTyVars' and 'LHsType'.
+mkHsForAllTy :: [TH.TyVarBndr]
+             -- ^ The original Template Haskell type variable binders
+             -> SrcSpan
+             -- ^ The location of the returned 'LHsType' if it needs an
+             --   explicit forall
+             -> ForallVisFlag
+             -- ^ Whether this is @forall@ is visible (e.g., @forall a ->@)
+             --   or invisible (e.g., @forall a.@)
+             -> LHsQTyVars GhcPs
+             -- ^ The converted type variable binders
+             -> LHsType GhcPs
+             -- ^ The converted rho type
+             -> LHsType GhcPs
+             -- ^ The complete type, quantified with a forall if necessary
+mkHsForAllTy tvs loc fvf tvs' rho_ty
+  | null tvs  = rho_ty
+  | otherwise = cL loc $ HsForAllTy { hst_fvf = fvf
+                                    , hst_bndrs = hsQTvExplicit tvs'
+                                    , hst_xforall = noExtField
+                                    , hst_body = rho_ty }
+
+-- | If passed an empty 'TH.Cxt', this simply returns the third argument
+-- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided
+-- 'LHsContext' and 'LHsType'.
+
+-- It's important that we don't build an HsQualTy if the context is empty,
+-- as the pretty-printer for HsType _always_ prints contexts, even if
+-- they're empty. See #13183.
+mkHsQualTy :: TH.Cxt
+           -- ^ The original Template Haskell context
+           -> SrcSpan
+           -- ^ The location of the returned 'LHsType' if it needs an
+           --   explicit context
+           -> LHsContext GhcPs
+           -- ^ The converted context
+           -> LHsType GhcPs
+           -- ^ The converted tau type
+           -> LHsType GhcPs
+           -- ^ The complete type, qualified with a context if necessary
+mkHsQualTy ctxt loc ctxt' ty
+  | null ctxt = ty
+  | otherwise = cL loc $ HsQualTy { hst_xqual = noExtField
+                                  , hst_ctxt  = ctxt'
+                                  , hst_body  = ty }
+
+--------------------------------------------------------------------
+--      Turning Name back into RdrName
+--------------------------------------------------------------------
+
+-- variable names
+vNameL, cNameL, vcNameL, tNameL, tconNameL :: TH.Name -> CvtM (Located RdrName)
+vName,  cName,  vcName,  tName,  tconName  :: TH.Name -> CvtM RdrName
+
+-- Variable names
+vNameL n = wrapL (vName n)
+vName n = cvtName OccName.varName n
+
+-- Constructor function names; this is Haskell source, hence srcDataName
+cNameL n = wrapL (cName n)
+cName n = cvtName OccName.dataName n
+
+-- Variable *or* constructor names; check by looking at the first char
+vcNameL n = wrapL (vcName n)
+vcName n = if isVarName n then vName n else cName n
+
+-- Type variable names
+tNameL n = wrapL (tName n)
+tName n = cvtName OccName.tvName n
+
+-- Type Constructor names
+tconNameL n = wrapL (tconName n)
+tconName n = cvtName OccName.tcClsName n
+
+ipName :: String -> CvtM HsIPName
+ipName n
+  = do { unless (okVarOcc n) (failWith (badOcc OccName.varName n))
+       ; return (HsIPName (fsLit n)) }
+
+cvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName
+cvtName ctxt_ns (TH.Name occ flavour)
+  | not (okOcc ctxt_ns occ_str) = failWith (badOcc ctxt_ns occ_str)
+  | otherwise
+  = do { loc <- getL
+       ; let rdr_name = thRdrName loc ctxt_ns occ_str flavour
+       ; force rdr_name
+       ; return rdr_name }
+  where
+    occ_str = TH.occString occ
+
+okOcc :: OccName.NameSpace -> String -> Bool
+okOcc ns str
+  | OccName.isVarNameSpace ns     = okVarOcc str
+  | OccName.isDataConNameSpace ns = okConOcc str
+  | otherwise                     = okTcOcc  str
+
+-- Determine the name space of a name in a type
+--
+isVarName :: TH.Name -> Bool
+isVarName (TH.Name occ _)
+  = case TH.occString occ of
+      ""    -> False
+      (c:_) -> startsVarId c || startsVarSym c
+
+badOcc :: OccName.NameSpace -> String -> SDoc
+badOcc ctxt_ns occ
+  = text "Illegal" <+> pprNameSpace ctxt_ns
+        <+> text "name:" <+> quotes (text occ)
+
+thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
+-- This turns a TH Name into a RdrName; used for both binders and occurrences
+-- See Note [Binders in Template Haskell]
+-- The passed-in name space tells what the context is expecting;
+--      use it unless the TH name knows what name-space it comes
+--      from, in which case use the latter
+--
+-- We pass in a SrcSpan (gotten from the monad) because this function
+-- is used for *binders* and if we make an Exact Name we want it
+-- to have a binding site inside it.  (cf #5434)
+--
+-- ToDo: we may generate silly RdrNames, by passing a name space
+--       that doesn't match the string, like VarName ":+",
+--       which will give confusing error messages later
+--
+-- The strict applications ensure that any buried exceptions get forced
+thRdrName loc ctxt_ns th_occ th_name
+  = case th_name of
+     TH.NameG th_ns pkg mod -> thOrigRdrName th_occ th_ns pkg mod
+     TH.NameQ mod  -> (mkRdrQual  $! mk_mod mod) $! occ
+     TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq (fromInteger uniq)) $! occ) loc)
+     TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq (fromInteger uniq)) $! occ) loc)
+     TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name
+              | otherwise                           -> mkRdrUnqual $! occ
+              -- We check for built-in syntax here, because the TH
+              -- user might have written a (NameS "(,,)"), for example
+  where
+    occ :: OccName.OccName
+    occ = mk_occ ctxt_ns th_occ
+
+-- Return an unqualified exact RdrName if we're dealing with built-in syntax.
+-- See #13776.
+thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
+thOrigRdrName occ th_ns pkg mod =
+  let occ' = mk_occ (mk_ghc_ns th_ns) occ
+  in case isBuiltInOcc_maybe occ' of
+       Just name -> nameRdrName name
+       Nothing   -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'
+
+thRdrNameGuesses :: TH.Name -> [RdrName]
+thRdrNameGuesses (TH.Name occ flavour)
+  -- This special case for NameG ensures that we don't generate duplicates in the output list
+  | TH.NameG th_ns pkg mod <- flavour = [ thOrigRdrName occ_str th_ns pkg mod]
+  | otherwise                         = [ thRdrName noSrcSpan gns occ_str flavour
+                                        | gns <- guessed_nss]
+  where
+    -- guessed_ns are the name spaces guessed from looking at the TH name
+    guessed_nss
+      | isLexCon (mkFastString occ_str) = [OccName.tcName,  OccName.dataName]
+      | otherwise                       = [OccName.varName, OccName.tvName]
+    occ_str = TH.occString occ
+
+-- The packing and unpacking is rather turgid :-(
+mk_occ :: OccName.NameSpace -> String -> OccName.OccName
+mk_occ ns occ = OccName.mkOccName ns occ
+
+mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
+mk_ghc_ns TH.DataName  = OccName.dataName
+mk_ghc_ns TH.TcClsName = OccName.tcClsName
+mk_ghc_ns TH.VarName   = OccName.varName
+
+mk_mod :: TH.ModName -> ModuleName
+mk_mod mod = mkModuleName (TH.modString mod)
+
+mk_pkg :: TH.PkgName -> UnitId
+mk_pkg pkg = stringToUnitId (TH.pkgString pkg)
+
+mk_uniq :: Int -> Unique
+mk_uniq u = mkUniqueGrimily u
+
+{-
+Note [Binders in Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this TH term construction:
+  do { x1 <- TH.newName "x"   -- newName :: String -> Q TH.Name
+     ; x2 <- TH.newName "x"   -- Builds a NameU
+     ; x3 <- TH.newName "x"
+
+     ; let x = mkName "x"     -- mkName :: String -> TH.Name
+                              -- Builds a NameS
+
+     ; return (LamE (..pattern [x1,x2]..) $
+               LamE (VarPat x3) $
+               ..tuple (x1,x2,x3,x)) }
+
+It represents the term   \[x1,x2]. \x3. (x1,x2,x3,x)
+
+a) We don't want to complain about "x" being bound twice in
+   the pattern [x1,x2]
+b) We don't want x3 to shadow the x1,x2
+c) We *do* want 'x' (dynamically bound with mkName) to bind
+   to the innermost binding of "x", namely x3.
+d) When pretty printing, we want to print a unique with x1,x2
+   etc, else they'll all print as "x" which isn't very helpful
+
+When we convert all this to HsSyn, the TH.Names are converted with
+thRdrName.  To achieve (b) we want the binders to be Exact RdrNames.
+Achieving (a) is a bit awkward, because
+   - We must check for duplicate and shadowed names on Names,
+     not RdrNames, *after* renaming.
+     See Note [Collect binders only after renaming] in GHC.Hs.Utils
+
+   - But to achieve (a) we must distinguish between the Exact
+     RdrNames arising from TH and the Unqual RdrNames that would
+     come from a user writing \[x,x] -> blah
+
+So in Convert.thRdrName we translate
+   TH Name                          RdrName
+   --------------------------------------------------------
+   NameU (arising from newName) --> Exact (Name{ System })
+   NameS (arising from mkName)  --> Unqual
+
+Notice that the NameUs generate *System* Names.  Then, when
+figuring out shadowing and duplicates, we can filter out
+System Names.
+
+This use of System Names fits with other uses of System Names, eg for
+temporary variables "a". Since there are lots of things called "a" we
+usually want to print the name with the unique, and that is indeed
+the way System Names are printed.
+
+There's a small complication of course; see Note [Looking up Exact
+RdrNames] in RnEnv.
+-}
+
+{-
+Note [Pattern synonym type signatures and Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In general, the type signature of a pattern synonym
+
+  pattern P x1 x2 .. xn = <some-pattern>
+
+is of the form
+
+   forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t
+
+with the following parts:
+
+   1) the (possibly empty lists of) universally quantified type
+      variables `univs` and required constraints `reqs` on them.
+   2) the (possibly empty lists of) existentially quantified type
+      variables `exis` and the provided constraints `provs` on them.
+   3) the types `t1`, `t2`, .., `tn` of the pattern synonym's arguments x1,
+      x2, .., xn, respectively
+   4) the type `t` of <some-pattern>, mentioning only universals from `univs`.
+
+Due to the two forall quantifiers and constraint contexts (either of
+which might be empty), pattern synonym type signatures are treated
+specially in `deSugar/DsMeta.hs`, `hsSyn/Convert.hs`, and
+`typecheck/TcSplice.hs`:
+
+   (a) When desugaring a pattern synonym from HsSyn to TH.Dec in
+       `deSugar/DsMeta.hs`, we represent its *full* type signature in TH, i.e.:
+
+           ForallT univs reqs (ForallT exis provs ty)
+              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)
+
+   (b) When converting pattern synonyms from TH.Dec to HsSyn in
+       `hsSyn/Convert.hs`, we convert their TH type signatures back to an
+       appropriate Haskell pattern synonym type of the form
+
+         forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t
+
+       where initial empty `univs` type variables or an empty `reqs`
+       constraint context are represented *explicitly* as `() =>`.
+
+   (c) When reifying a pattern synonym in `typecheck/TcSplice.hs`, we always
+       return its *full* type, i.e.:
+
+           ForallT univs reqs (ForallT exis provs ty)
+              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)
+
+The key point is to always represent a pattern synonym's *full* type
+in cases (a) and (c) to make it clear which of the two forall
+quantifiers and/or constraint contexts are specified, and which are
+not. See GHC's user's guide on pattern synonyms for more information
+about pattern synonym type signatures.
+
+-}