Merge types and kinds in DsMeta

Summary:
Types and kinds are now the same in GHC... well, except in the code
that involves Template Haskell, where types and kinds are given separate
treatment. This aims to unify that treatment in the `DsMeta` module.

The gist of this patch is replacing all uses of `repLKind` with `repLTy`.
This is isn't quite as simple as one might imagine, since `repLTy` returns a
`Core (Q Type)` (a monadic expression), whereas `repLKind` returns a
`Core Kind` (a pure expression). This causes many awkward impedance mismatches.

One option would be to change every combinator in `Language.Haskell.TH.Lib` to
take `KindQ` as an argument instead of `Kind`. But this would be a breaking
change of colossal proportions.

Instead, this patch takes a somewhat different approach. This migrates the
existing `Language.Haskell.TH.Lib` module to
`Language.Haskell.TH.Lib.Internal`, and changes all `Kind`-related combinators
in `Language.Haskell.TH.Lib.Internal` to live in `Q`. The new
`Language.Haskell.TH.Lib` module then re-exports most of
`Language.Haskell.TH.Lib.Internal` with the exception of the `Kind`-related
combinators, for which it redefines them to be their current definitions (which
don't live in `Q`). This allows us to retain backwards compatibility with
previous `template-haskell` releases, but more importantly, it allows GHC to
make as many changes to the `Internal` code as it wants for its purposes
without fear of disrupting the public API.

This solves half of #11785 (the other half being `TcSplice`).

Test Plan: ./validate

Reviewers: goldfire, austin, bgamari

Reviewed By: goldfire

Subscribers: rwbarton, thomie

GHC Trac Issues: #11785

Differential Revision: https://phabricator.haskell.org/D3751

4 files changed, 994 insertions, 788 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 78fbc41d6f..9ad36f8586 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -1,8 +1,13 @@
 -- |
--- TH.Lib contains lots of useful helper functions for
+-- Language.Haskell.TH.Lib contains lots of useful helper functions for
 -- generating and manipulating Template Haskell terms
 
-{-# LANGUAGE CPP #-}
+-- Note: this module mostly re-exports functions from
+-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template
+-- Haskell which requires breaking the API offered in this module, we opt to
+-- copy the old definition here, and make the changes in
+-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards
+-- compatibility while still allowing GHC to make changes as it needs.
 
 module Language.Haskell.TH.Lib (
     -- All of the exports from this module should
@@ -11,11 +16,12 @@ module Language.Haskell.TH.Lib (
 
     -- * Library functions
     -- ** Abbreviations
-        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ,
-        DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ,
-        SourceStrictnessQ, SourceUnpackednessQ, BangQ, BangTypeQ, VarBangTypeQ,
-        StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ,
-        TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,
+        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
+        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
+        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
+        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+        FamilyResultSigQ,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -111,358 +117,45 @@ module Language.Haskell.TH.Lib (
 
    ) where
 
-import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
-import qualified Language.Haskell.TH.Syntax as TH
-import Control.Monad( liftM, liftM2 )
-import Data.Word( Word8 )
-
-----------------------------------------------------------
--- * Type synonyms
-----------------------------------------------------------
-
-type InfoQ               = Q Info
-type PatQ                = Q Pat
-type FieldPatQ           = Q FieldPat
-type ExpQ                = Q Exp
-type TExpQ a             = Q (TExp a)
-type DecQ                = Q Dec
-type DecsQ               = Q [Dec]
-type ConQ                = Q Con
-type TypeQ               = Q Type
-type TyLitQ              = Q TyLit
-type CxtQ                = Q Cxt
-type PredQ               = Q Pred
-type DerivClauseQ        = Q DerivClause
-type MatchQ              = Q Match
-type ClauseQ             = Q Clause
-type BodyQ               = Q Body
-type GuardQ              = Q Guard
-type StmtQ               = Q Stmt
-type RangeQ              = Q Range
-type SourceStrictnessQ   = Q SourceStrictness
-type SourceUnpackednessQ = Q SourceUnpackedness
-type BangQ               = Q Bang
-type BangTypeQ           = Q BangType
-type VarBangTypeQ        = Q VarBangType
-type StrictTypeQ         = Q StrictType
-type VarStrictTypeQ      = Q VarStrictType
-type FieldExpQ           = Q FieldExp
-type RuleBndrQ           = Q RuleBndr
-type TySynEqnQ           = Q TySynEqn
-type PatSynDirQ          = Q PatSynDir
-type PatSynArgsQ         = Q PatSynArgs
-
--- must be defined here for DsMeta to find it
-type Role                = TH.Role
-type InjectivityAnn      = TH.InjectivityAnn
-
-----------------------------------------------------------
--- * Lowercase pattern syntax functions
-----------------------------------------------------------
-
-intPrimL    :: Integer -> Lit
-intPrimL    = IntPrimL
-wordPrimL    :: Integer -> Lit
-wordPrimL    = WordPrimL
-floatPrimL  :: Rational -> Lit
-floatPrimL  = FloatPrimL
-doublePrimL :: Rational -> Lit
-doublePrimL = DoublePrimL
-integerL    :: Integer -> Lit
-integerL    = IntegerL
-charL       :: Char -> Lit
-charL       = CharL
-charPrimL   :: Char -> Lit
-charPrimL   = CharPrimL
-stringL     :: String -> Lit
-stringL     = StringL
-stringPrimL :: [Word8] -> Lit
-stringPrimL = StringPrimL
-rationalL   :: Rational -> Lit
-rationalL   = RationalL
-
-litP :: Lit -> PatQ
-litP l = return (LitP l)
-
-varP :: Name -> PatQ
-varP v = return (VarP v)
-
-tupP :: [PatQ] -> PatQ
-tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
-
-unboxedTupP :: [PatQ] -> PatQ
-unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
-
-unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
-unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
-
-conP :: Name -> [PatQ] -> PatQ
-conP n ps = do ps' <- sequence ps
-               return (ConP n ps')
-infixP :: PatQ -> Name -> PatQ -> PatQ
-infixP p1 n p2 = do p1' <- p1
-                    p2' <- p2
-                    return (InfixP p1' n p2')
-uInfixP :: PatQ -> Name -> PatQ -> PatQ
-uInfixP p1 n p2 = do p1' <- p1
-                     p2' <- p2
-                     return (UInfixP p1' n p2')
-parensP :: PatQ -> PatQ
-parensP p = do p' <- p
-               return (ParensP p')
-
-tildeP :: PatQ -> PatQ
-tildeP p = do p' <- p
-              return (TildeP p')
-bangP :: PatQ -> PatQ
-bangP p = do p' <- p
-             return (BangP p')
-asP :: Name -> PatQ -> PatQ
-asP n p = do p' <- p
-             return (AsP n p')
-wildP :: PatQ
-wildP = return WildP
-recP :: Name -> [FieldPatQ] -> PatQ
-recP n fps = do fps' <- sequence fps
-                return (RecP n fps')
-listP :: [PatQ] -> PatQ
-listP ps = do ps' <- sequence ps
-              return (ListP ps')
-sigP :: PatQ -> TypeQ -> PatQ
-sigP p t = do p' <- p
-              t' <- t
-              return (SigP p' t')
-viewP :: ExpQ -> PatQ -> PatQ
-viewP e p = do e' <- e
-               p' <- p
-               return (ViewP e' p')
-
-fieldPat :: Name -> PatQ -> FieldPatQ
-fieldPat n p = do p' <- p
-                  return (n, p')
-
-
--------------------------------------------------------------------------------
--- *   Stmt
-
-bindS :: PatQ -> ExpQ -> StmtQ
-bindS p e = liftM2 BindS p e
-
-letS :: [DecQ] -> StmtQ
-letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
-
-noBindS :: ExpQ -> StmtQ
-noBindS e = do { e1 <- e; return (NoBindS e1) }
-
-parS :: [[StmtQ]] -> StmtQ
-parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
-
--------------------------------------------------------------------------------
--- *   Range
-
-fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }
-
-fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
-
-fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
-
-fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
-fromThenToR x y z = do { a <- x; b <- y; c <- z;
-                         return (FromThenToR a b c) }
--------------------------------------------------------------------------------
--- *   Body
-
-normalB :: ExpQ -> BodyQ
-normalB e = do { e1 <- e; return (NormalB e1) }
-
-guardedB :: [Q (Guard,Exp)] -> BodyQ
-guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
-
--------------------------------------------------------------------------------
--- *   Guard
-
-normalG :: ExpQ -> GuardQ
-normalG e = do { e1 <- e; return (NormalG e1) }
-
-normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
-normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
-
-patG :: [StmtQ] -> GuardQ
-patG ss = do { ss' <- sequence ss; return (PatG ss') }
-
-patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
-patGE ss e = do { ss' <- sequence ss;
-                  e'  <- e;
-                  return (PatG ss', e') }
-
--------------------------------------------------------------------------------
--- *   Match and Clause
-
--- | Use with 'caseE'
-match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
-match p rhs ds = do { p' <- p;
-                      r' <- rhs;
-                      ds' <- sequence ds;
-                      return (Match p' r' ds') }
-
--- | Use with 'funD'
-clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
-clause ps r ds = do { ps' <- sequence ps;
-                      r' <- r;
-                      ds' <- sequence ds;
-                      return (Clause ps' r' ds') }
-
-
----------------------------------------------------------------------------
--- *   Exp
-
--- | Dynamically binding a variable (unhygenic)
-dyn :: String -> ExpQ
-dyn s = return (VarE (mkName s))
-
-varE :: Name -> ExpQ
-varE s = return (VarE s)
-
-conE :: Name -> ExpQ
-conE s =  return (ConE s)
-
-litE :: Lit -> ExpQ
-litE c = return (LitE c)
-
-appE :: ExpQ -> ExpQ -> ExpQ
-appE x y = do { a <- x; b <- y; return (AppE a b)}
-
-appTypeE :: ExpQ -> TypeQ -> ExpQ
-appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
-
-parensE :: ExpQ -> ExpQ
-parensE x = do { x' <- x; return (ParensE x') }
-
-uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
-                     return (UInfixE x' s' y') }
-
-infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
-infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
-                                  return (InfixE (Just a) s' (Just b))}
-infixE Nothing  s (Just y) = do { s' <- s; b <- y;
-                                  return (InfixE Nothing s' (Just b))}
-infixE (Just x) s Nothing  = do { a <- x; s' <- s;
-                                  return (InfixE (Just a) s' Nothing)}
-infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }
-
-infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-infixApp x y z = infixE (Just x) y (Just z)
-sectionL :: ExpQ -> ExpQ -> ExpQ
-sectionL x y = infixE (Just x) y Nothing
-sectionR :: ExpQ -> ExpQ -> ExpQ
-sectionR x y = infixE Nothing x (Just y)
-
-lamE :: [PatQ] -> ExpQ -> ExpQ
-lamE ps e = do ps' <- sequence ps
-               e' <- e
-               return (LamE ps' e')
-
--- | Single-arg lambda
-lam1E :: PatQ -> ExpQ -> ExpQ
-lam1E p e = lamE [p] e
-
-lamCaseE :: [MatchQ] -> ExpQ
-lamCaseE ms = sequence ms >>= return . LamCaseE
-
-tupE :: [ExpQ] -> ExpQ
-tupE es = do { es1 <- sequence es; return (TupE es1)}
-
-unboxedTupE :: [ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
-
-unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
-unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
-
-condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
-
-multiIfE :: [Q (Guard, Exp)] -> ExpQ
-multiIfE alts = sequence alts >>= return . MultiIfE
-
-letE :: [DecQ] -> ExpQ -> ExpQ
-letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
-
-caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
-
-doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
-
-compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
-
-arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }
-
-listE :: [ExpQ] -> ExpQ
-listE es = do { es1 <- sequence es; return (ListE es1) }
-
-sigE :: ExpQ -> TypeQ -> ExpQ
-sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
-
-recConE :: Name -> [Q (Name,Exp)] -> ExpQ
-recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
-
-recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
-recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
-
-stringE :: String -> ExpQ
-stringE = litE . stringL
-
-fieldExp :: Name -> ExpQ -> Q (Name, Exp)
-fieldExp s e = do { e' <- e; return (s,e') }
-
--- | @staticE x = [| static x |]@
-staticE :: ExpQ -> ExpQ
-staticE = fmap StaticE
-
-unboundVarE :: Name -> ExpQ
-unboundVarE s = return (UnboundVarE s)
-
-labelE :: String -> ExpQ
-labelE s = return (LabelE s)
-
--- ** 'arithSeqE' Shortcuts
-fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
-
-fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
-
-fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
-
-fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-fromThenToE x y z = do { a <- x; b <- y; c <- z;
-                         return (ArithSeqE (FromThenToR a b c)) }
-
+import Language.Haskell.TH.Lib.Internal hiding
+  ( tySynD
+  , dataD
+  , newtypeD
+  , classD
+  , dataInstD
+  , newtypeInstD
+  , dataFamilyD
+  , openTypeFamilyD
+  , closedTypeFamilyD
+  , forallC
+
+  , forallT
+  , sigT
+
+  , plainTV
+  , kindedTV
+  , starK
+  , constraintK
+
+  , noSig
+  , kindSig
+  , tyVarSig
+
+  , Role
+  , InjectivityAnn
+  )
+import Language.Haskell.TH.Syntax
+
+import Control.Monad (liftM2)
+
+-- All definitions below represent the "old" API, since their definitions are
+-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before
+-- deciding to change the APIs of the functions below, as they represent the
+-- public API (as opposed to the Internal module, which has no API promises.)
 
 -------------------------------------------------------------------------------
 -- *   Dec
 
-valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
-valD p b ds =
-  do { p' <- p
-     ; ds' <- sequence ds
-     ; b' <- b
-     ; return (ValD p' b' ds')
-     }
-
-funD :: Name -> [ClauseQ] -> DecQ
-funD nm cs =
- do { cs1 <- sequence cs
-    ; return (FunD nm cs1)
-    }
-
 tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
 tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
 
@@ -491,78 +184,6 @@ classD ctxt cls tvs fds decs =
     ctxt1 <- ctxt
     return $ ClassD ctxt1 cls tvs fds decs1
 
-instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceD = instanceWithOverlapD Nothing
-
-instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceWithOverlapD o ctxt ty decs =
-  do
-    ctxt1 <- ctxt
-    decs1 <- sequence decs
-    ty1   <- ty
-    return $ InstanceD o ctxt1 ty1 decs1
-
-
-
-sigD :: Name -> TypeQ -> DecQ
-sigD fun ty = liftM (SigD fun) $ ty
-
-forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
-forImpD cc s str n ty
- = do ty' <- ty
-      return $ ForeignD (ImportF cc s str n ty')
-
-infixLD :: Int -> Name -> DecQ
-infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
-
-infixRD :: Int -> Name -> DecQ
-infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
-
-infixND :: Int -> Name -> DecQ
-infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
-
-pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
-pragInlD name inline rm phases
-  = return $ PragmaD $ InlineP name inline rm phases
-
-pragSpecD :: Name -> TypeQ -> Phases -> DecQ
-pragSpecD n ty phases
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
-
-pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
-pragSpecInlD n ty inline phases
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
-
-pragSpecInstD :: TypeQ -> DecQ
-pragSpecInstD ty
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseInstP ty1
-
-pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
-pragRuleD n bndrs lhs rhs phases
-  = do
-      bndrs1 <- sequence bndrs
-      lhs1   <- lhs
-      rhs1   <- rhs
-      return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
-
-pragAnnD :: AnnTarget -> ExpQ -> DecQ
-pragAnnD target expr
-  = do
-      exp1 <- expr
-      return $ PragmaD $ AnnP target exp1
-
-pragLineD :: Int -> String -> DecQ
-pragLineD line file = return $ PragmaD $ LineP line file
-
-pragCompleteD :: [Name] -> Maybe Name -> DecQ
-pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
-
 dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
           -> DecQ
 dataInstD ctxt tc tys ksig cons derivs =
@@ -583,12 +204,6 @@ newtypeInstD ctxt tc tys ksig con derivs =
     derivs1 <- sequence derivs
     return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1)
 
-tySynInstD :: Name -> TySynEqnQ -> DecQ
-tySynInstD tc eqn =
-  do
-    eqn1 <- eqn
-    return (TySynInstD tc eqn1)
-
 dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
 dataFamilyD tc tvs kind
     = return $ DataFamilyD tc tvs kind
@@ -604,112 +219,9 @@ closedTypeFamilyD tc tvs result injectivity eqns =
   do eqns1 <- sequence eqns
      return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
 
--- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you
--- remove this check please also:
---   1. remove deprecated functions
---   2. remove CPP language extension from top of this module
---   3. remove the FamFlavour data type from Syntax module
---   4. make sure that all references to FamFlavour are gone from DsMeta,
---      Convert, TcSplice (follows from 3)
-#if __GLASGOW_HASKELL__ >= 804
-#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
-#endif
-
-{-# DEPRECATED familyNoKindD, familyKindD
-               "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
-familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
-familyNoKindD flav tc tvs =
-    case flav of
-      TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
-      DataFam -> return $ DataFamilyD tc tvs Nothing
-
-familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
-familyKindD flav tc tvs k =
-    case flav of
-      TypeFam ->
-        return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
-      DataFam -> return $ DataFamilyD tc tvs (Just k)
-
-{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
-               "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
-closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
-closedTypeFamilyNoKindD tc tvs eqns =
- do eqns1 <- sequence eqns
-    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
-
-closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
-closedTypeFamilyKindD tc tvs kind eqns =
- do eqns1 <- sequence eqns
-    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
-            eqns1)
-
-roleAnnotD :: Name -> [Role] -> DecQ
-roleAnnotD name roles = return $ RoleAnnotD name roles
-
-standaloneDerivD :: CxtQ -> TypeQ -> DecQ
-standaloneDerivD = standaloneDerivWithStrategyD Nothing
-
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
-standaloneDerivWithStrategyD ds ctxtq tyq =
-  do
-    ctxt <- ctxtq
-    ty   <- tyq
-    return $ StandaloneDerivD ds ctxt ty
-
-defaultSigD :: Name -> TypeQ -> DecQ
-defaultSigD n tyq =
-  do
-    ty <- tyq
-    return $ DefaultSigD n ty
-
--- | Pattern synonym declaration
-patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
-patSynD name args dir pat = do
-  args'    <- args
-  dir'     <- dir
-  pat'     <- pat
-  return (PatSynD name args' dir' pat')
-
--- | Pattern synonym type signature
-patSynSigD :: Name -> TypeQ -> DecQ
-patSynSigD nm ty =
-  do ty' <- ty
-     return $ PatSynSigD nm ty'
-
-tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
-tySynEqn lhs rhs =
-  do
-    lhs1 <- sequence lhs
-    rhs1 <- rhs
-    return (TySynEqn lhs1 rhs1)
-
-cxt :: [PredQ] -> CxtQ
-cxt = sequence
-
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
-derivClause ds p = do p' <- cxt p
-                      return $ DerivClause ds p'
-
-normalC :: Name -> [BangTypeQ] -> ConQ
-normalC con strtys = liftM (NormalC con) $ sequence strtys
-
-recC :: Name -> [VarBangTypeQ] -> ConQ
-recC con varstrtys = liftM (RecC con) $ sequence varstrtys
-
-infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
-infixC st1 con st2 = do st1' <- st1
-                        st2' <- st2
-                        return $ InfixC st1' con st2'
-
 forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
 forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
 
-gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ
-gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty
-
-recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
-recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
-
 -------------------------------------------------------------------------------
 -- *   Type
 
@@ -719,145 +231,12 @@ forallT tvars ctxt ty = do
     ty1   <- ty
     return $ ForallT tvars ctxt1 ty1
 
-varT :: Name -> TypeQ
-varT = return . VarT
-
-conT :: Name -> TypeQ
-conT = return . ConT
-
-infixT :: TypeQ -> Name -> TypeQ -> TypeQ
-infixT t1 n t2 = do t1' <- t1
-                    t2' <- t2
-                    return (InfixT t1' n t2')
-
-uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
-uInfixT t1 n t2 = do t1' <- t1
-                     t2' <- t2
-                     return (UInfixT t1' n t2')
-
-parensT :: TypeQ -> TypeQ
-parensT t = do t' <- t
-               return (ParensT t')
-
-appT :: TypeQ -> TypeQ -> TypeQ
-appT t1 t2 = do
-           t1' <- t1
-           t2' <- t2
-           return $ AppT t1' t2'
-
-arrowT :: TypeQ
-arrowT = return ArrowT
-
-listT :: TypeQ
-listT = return ListT
-
-litT :: TyLitQ -> TypeQ
-litT l = fmap LitT l
-
-tupleT :: Int -> TypeQ
-tupleT i = return (TupleT i)
-
-unboxedTupleT :: Int -> TypeQ
-unboxedTupleT i = return (UnboxedTupleT i)
-
-unboxedSumT :: SumArity -> TypeQ
-unboxedSumT arity = return (UnboxedSumT arity)
-
 sigT :: TypeQ -> Kind -> TypeQ
 sigT t k
   = do
       t' <- t
       return $ SigT t' k
 
-equalityT :: TypeQ
-equalityT = return EqualityT
-
-wildCardT :: TypeQ
-wildCardT = return WildCardT
-
-{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
-classP :: Name -> [Q Type] -> Q Pred
-classP cla tys
-  = do
-      tysl <- sequence tys
-      return (foldl AppT (ConT cla) tysl)
-
-{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
-equalP :: TypeQ -> TypeQ -> PredQ
-equalP tleft tright
-  = do
-      tleft1  <- tleft
-      tright1 <- tright
-      eqT <- equalityT
-      return (foldl AppT eqT [tleft1, tright1])
-
-promotedT :: Name -> TypeQ
-promotedT = return . PromotedT
-
-promotedTupleT :: Int -> TypeQ
-promotedTupleT i = return (PromotedTupleT i)
-
-promotedNilT :: TypeQ
-promotedNilT = return PromotedNilT
-
-promotedConsT :: TypeQ
-promotedConsT = return PromotedConsT
-
-noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
-noSourceUnpackedness = return NoSourceUnpackedness
-sourceNoUnpack       = return SourceNoUnpack
-sourceUnpack         = return SourceUnpack
-
-noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
-noSourceStrictness = return NoSourceStrictness
-sourceLazy         = return SourceLazy
-sourceStrict       = return SourceStrict
-
-{-# DEPRECATED isStrict
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
-{-# DEPRECATED notStrict
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
-{-# DEPRECATED unpacked
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
-isStrict, notStrict, unpacked :: Q Strict
-isStrict = bang noSourceUnpackedness sourceStrict
-notStrict = bang noSourceUnpackedness noSourceStrictness
-unpacked = bang sourceUnpack sourceStrict
-
-bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
-bang u s = do u' <- u
-              s' <- s
-              return (Bang u' s')
-
-bangType :: BangQ -> TypeQ -> BangTypeQ
-bangType = liftM2 (,)
-
-varBangType :: Name -> BangTypeQ -> VarBangTypeQ
-varBangType v bt = do (b, t) <- bt
-                      return (v, b, t)
-
-{-# DEPRECATED strictType
-               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
-strictType :: Q Strict -> TypeQ -> StrictTypeQ
-strictType = bangType
-
-{-# DEPRECATED varStrictType
-               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
-varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
-varStrictType = varBangType
-
--- * Type Literals
-
-numTyLit :: Integer -> TyLitQ
-numTyLit n = if n >= 0 then return (NumTyLit n)
-                       else fail ("Negative type-level number: " ++ show n)
-
-strTyLit :: String -> TyLitQ
-strTyLit s = return (StrTyLit s)
-
 -------------------------------------------------------------------------------
 -- *   Kind
 
@@ -867,24 +246,6 @@ plainTV = PlainTV
 kindedTV :: Name -> Kind -> TyVarBndr
 kindedTV = KindedTV
 
-varK :: Name -> Kind
-varK = VarT
-
-conK :: Name -> Kind
-conK = ConT
-
-tupleK :: Int -> Kind
-tupleK = TupleT
-
-arrowK :: Kind
-arrowK = ArrowT
-
-listK :: Kind
-listK = ListT
-
-appK :: Kind -> Kind -> Kind
-appK = AppT
-
 starK :: Kind
 starK = StarT
 
@@ -902,104 +263,3 @@ kindSig = KindSig
 
 tyVarSig :: TyVarBndr -> FamilyResultSig
 tyVarSig = TyVarSig
-
--------------------------------------------------------------------------------
--- *   Injectivity annotation
-
-injectivityAnn :: Name -> [Name] -> InjectivityAnn
-injectivityAnn = TH.InjectivityAnn
-
--------------------------------------------------------------------------------
--- *   Role
-
-nominalR, representationalR, phantomR, inferR :: Role
-nominalR          = NominalR
-representationalR = RepresentationalR
-phantomR          = PhantomR
-inferR            = InferR
-
--------------------------------------------------------------------------------
--- *   Callconv
-
-cCall, stdCall, cApi, prim, javaScript :: Callconv
-cCall      = CCall
-stdCall    = StdCall
-cApi       = CApi
-prim       = Prim
-javaScript = JavaScript
-
--------------------------------------------------------------------------------
--- *   Safety
-
-unsafe, safe, interruptible :: Safety
-unsafe = Unsafe
-safe = Safe
-interruptible = Interruptible
-
--------------------------------------------------------------------------------
--- *   FunDep
-
-funDep :: [Name] -> [Name] -> FunDep
-funDep = FunDep
-
--------------------------------------------------------------------------------
--- *   FamFlavour
-
-typeFam, dataFam :: FamFlavour
-typeFam = TypeFam
-dataFam = DataFam
-
--------------------------------------------------------------------------------
--- *   RuleBndr
-ruleVar :: Name -> RuleBndrQ
-ruleVar = return . RuleVar
-
-typedRuleVar :: Name -> TypeQ -> RuleBndrQ
-typedRuleVar n ty = ty >>= return . TypedRuleVar n
-
--------------------------------------------------------------------------------
--- *   AnnTarget
-valueAnnotation :: Name -> AnnTarget
-valueAnnotation = ValueAnnotation
-
-typeAnnotation :: Name -> AnnTarget
-typeAnnotation = TypeAnnotation
-
-moduleAnnotation :: AnnTarget
-moduleAnnotation = ModuleAnnotation
-
--------------------------------------------------------------------------------
--- * Pattern Synonyms (sub constructs)
-
-unidir, implBidir :: PatSynDirQ
-unidir    = return Unidir
-implBidir = return ImplBidir
-
-explBidir :: [ClauseQ] -> PatSynDirQ
-explBidir cls = do
-  cls' <- sequence cls
-  return (ExplBidir cls')
-
-prefixPatSyn :: [Name] -> PatSynArgsQ
-prefixPatSyn args = return $ PrefixPatSyn args
-
-recordPatSyn :: [Name] -> PatSynArgsQ
-recordPatSyn sels = return $ RecordPatSyn sels
-
-infixPatSyn :: Name -> Name -> PatSynArgsQ
-infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
-
---------------------------------------------------------------
--- * Useful helper function
-
-appsE :: [ExpQ] -> ExpQ
-appsE [] = error "appsE []"
-appsE [x] = x
-appsE (x:y:zs) = appsE ( (appE x y) : zs )
-
--- | Return the Module at the place of splicing.  Can be used as an
--- input for 'reifyModule'.
-thisModule :: Q Module
-thisModule = do
-  loc <- location
-  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
new file mode 100644
index 0000000000..d58ce84f99
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -0,0 +1,936 @@
+-- |
+-- Language.Haskell.TH.Lib.Internal exposes some additional functionality that
+-- is used internally in GHC's integration with Template Haskell. This is not a
+-- part of the public API, and as such, there are no API guarantees for this
+-- module from version to version.
+
+-- Why do we have both Language.Haskell.TH.Lib.Internal and
+-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
+-- former (which are tailored for GHC's use) need different type signatures
+-- than the ones in the latter. Syncing up the Internal type signatures would
+-- involve a massive amount of breaking changes, so for the time being, we
+-- relegate as many changes as we can to just the Internal module, where it
+-- is safe to break things.
+
+{-# LANGUAGE CPP #-}
+
+module Language.Haskell.TH.Lib.Internal where
+
+import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
+import qualified Language.Haskell.TH.Syntax as TH
+import Control.Monad( liftM, liftM2 )
+import Data.Word( Word8 )
+
+----------------------------------------------------------
+-- * Type synonyms
+----------------------------------------------------------
+
+type InfoQ               = Q Info
+type PatQ                = Q Pat
+type FieldPatQ           = Q FieldPat
+type ExpQ                = Q Exp
+type TExpQ a             = Q (TExp a)
+type DecQ                = Q Dec
+type DecsQ               = Q [Dec]
+type ConQ                = Q Con
+type TypeQ               = Q Type
+type KindQ               = Q Kind
+type TyVarBndrQ          = Q TyVarBndr
+type TyLitQ              = Q TyLit
+type CxtQ                = Q Cxt
+type PredQ               = Q Pred
+type DerivClauseQ        = Q DerivClause
+type MatchQ              = Q Match
+type ClauseQ             = Q Clause
+type BodyQ               = Q Body
+type GuardQ              = Q Guard
+type StmtQ               = Q Stmt
+type RangeQ              = Q Range
+type SourceStrictnessQ   = Q SourceStrictness
+type SourceUnpackednessQ = Q SourceUnpackedness
+type BangQ               = Q Bang
+type BangTypeQ           = Q BangType
+type VarBangTypeQ        = Q VarBangType
+type StrictTypeQ         = Q StrictType
+type VarStrictTypeQ      = Q VarStrictType
+type FieldExpQ           = Q FieldExp
+type RuleBndrQ           = Q RuleBndr
+type TySynEqnQ           = Q TySynEqn
+type PatSynDirQ          = Q PatSynDir
+type PatSynArgsQ         = Q PatSynArgs
+type FamilyResultSigQ    = Q FamilyResultSig
+
+-- must be defined here for DsMeta to find it
+type Role                = TH.Role
+type InjectivityAnn      = TH.InjectivityAnn
+
+----------------------------------------------------------
+-- * Lowercase pattern syntax functions
+----------------------------------------------------------
+
+intPrimL    :: Integer -> Lit
+intPrimL    = IntPrimL
+wordPrimL    :: Integer -> Lit
+wordPrimL    = WordPrimL
+floatPrimL  :: Rational -> Lit
+floatPrimL  = FloatPrimL
+doublePrimL :: Rational -> Lit
+doublePrimL = DoublePrimL
+integerL    :: Integer -> Lit
+integerL    = IntegerL
+charL       :: Char -> Lit
+charL       = CharL
+charPrimL   :: Char -> Lit
+charPrimL   = CharPrimL
+stringL     :: String -> Lit
+stringL     = StringL
+stringPrimL :: [Word8] -> Lit
+stringPrimL = StringPrimL
+rationalL   :: Rational -> Lit
+rationalL   = RationalL
+
+litP :: Lit -> PatQ
+litP l = return (LitP l)
+
+varP :: Name -> PatQ
+varP v = return (VarP v)
+
+tupP :: [PatQ] -> PatQ
+tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
+
+unboxedTupP :: [PatQ] -> PatQ
+unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
+
+unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
+unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
+
+conP :: Name -> [PatQ] -> PatQ
+conP n ps = do ps' <- sequence ps
+               return (ConP n ps')
+infixP :: PatQ -> Name -> PatQ -> PatQ
+infixP p1 n p2 = do p1' <- p1
+                    p2' <- p2
+                    return (InfixP p1' n p2')
+uInfixP :: PatQ -> Name -> PatQ -> PatQ
+uInfixP p1 n p2 = do p1' <- p1
+                     p2' <- p2
+                     return (UInfixP p1' n p2')
+parensP :: PatQ -> PatQ
+parensP p = do p' <- p
+               return (ParensP p')
+
+tildeP :: PatQ -> PatQ
+tildeP p = do p' <- p
+              return (TildeP p')
+bangP :: PatQ -> PatQ
+bangP p = do p' <- p
+             return (BangP p')
+asP :: Name -> PatQ -> PatQ
+asP n p = do p' <- p
+             return (AsP n p')
+wildP :: PatQ
+wildP = return WildP
+recP :: Name -> [FieldPatQ] -> PatQ
+recP n fps = do fps' <- sequence fps
+                return (RecP n fps')
+listP :: [PatQ] -> PatQ
+listP ps = do ps' <- sequence ps
+              return (ListP ps')
+sigP :: PatQ -> TypeQ -> PatQ
+sigP p t = do p' <- p
+              t' <- t
+              return (SigP p' t')
+viewP :: ExpQ -> PatQ -> PatQ
+viewP e p = do e' <- e
+               p' <- p
+               return (ViewP e' p')
+
+fieldPat :: Name -> PatQ -> FieldPatQ
+fieldPat n p = do p' <- p
+                  return (n, p')
+
+
+-------------------------------------------------------------------------------
+-- *   Stmt
+
+bindS :: PatQ -> ExpQ -> StmtQ
+bindS p e = liftM2 BindS p e
+
+letS :: [DecQ] -> StmtQ
+letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
+
+noBindS :: ExpQ -> StmtQ
+noBindS e = do { e1 <- e; return (NoBindS e1) }
+
+parS :: [[StmtQ]] -> StmtQ
+parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
+
+-------------------------------------------------------------------------------
+-- *   Range
+
+fromR :: ExpQ -> RangeQ
+fromR x = do { a <- x; return (FromR a) }
+
+fromThenR :: ExpQ -> ExpQ -> RangeQ
+fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
+
+fromToR :: ExpQ -> ExpQ -> RangeQ
+fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
+
+fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
+fromThenToR x y z = do { a <- x; b <- y; c <- z;
+                         return (FromThenToR a b c) }
+-------------------------------------------------------------------------------
+-- *   Body
+
+normalB :: ExpQ -> BodyQ
+normalB e = do { e1 <- e; return (NormalB e1) }
+
+guardedB :: [Q (Guard,Exp)] -> BodyQ
+guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
+
+-------------------------------------------------------------------------------
+-- *   Guard
+
+normalG :: ExpQ -> GuardQ
+normalG e = do { e1 <- e; return (NormalG e1) }
+
+normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
+normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
+
+patG :: [StmtQ] -> GuardQ
+patG ss = do { ss' <- sequence ss; return (PatG ss') }
+
+patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
+patGE ss e = do { ss' <- sequence ss;
+                  e'  <- e;
+                  return (PatG ss', e') }
+
+-------------------------------------------------------------------------------
+-- *   Match and Clause
+
+-- | Use with 'caseE'
+match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
+match p rhs ds = do { p' <- p;
+                      r' <- rhs;
+                      ds' <- sequence ds;
+                      return (Match p' r' ds') }
+
+-- | Use with 'funD'
+clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
+clause ps r ds = do { ps' <- sequence ps;
+                      r' <- r;
+                      ds' <- sequence ds;
+                      return (Clause ps' r' ds') }
+
+
+---------------------------------------------------------------------------
+-- *   Exp
+
+-- | Dynamically binding a variable (unhygenic)
+dyn :: String -> ExpQ
+dyn s = return (VarE (mkName s))
+
+varE :: Name -> ExpQ
+varE s = return (VarE s)
+
+conE :: Name -> ExpQ
+conE s =  return (ConE s)
+
+litE :: Lit -> ExpQ
+litE c = return (LitE c)
+
+appE :: ExpQ -> ExpQ -> ExpQ
+appE x y = do { a <- x; b <- y; return (AppE a b)}
+
+appTypeE :: ExpQ -> TypeQ -> ExpQ
+appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
+
+parensE :: ExpQ -> ExpQ
+parensE x = do { x' <- x; return (ParensE x') }
+
+uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
+                     return (UInfixE x' s' y') }
+
+infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
+infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
+                                  return (InfixE (Just a) s' (Just b))}
+infixE Nothing  s (Just y) = do { s' <- s; b <- y;
+                                  return (InfixE Nothing s' (Just b))}
+infixE (Just x) s Nothing  = do { a <- x; s' <- s;
+                                  return (InfixE (Just a) s' Nothing)}
+infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }
+
+infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+infixApp x y z = infixE (Just x) y (Just z)
+sectionL :: ExpQ -> ExpQ -> ExpQ
+sectionL x y = infixE (Just x) y Nothing
+sectionR :: ExpQ -> ExpQ -> ExpQ
+sectionR x y = infixE Nothing x (Just y)
+
+lamE :: [PatQ] -> ExpQ -> ExpQ
+lamE ps e = do ps' <- sequence ps
+               e' <- e
+               return (LamE ps' e')
+
+-- | Single-arg lambda
+lam1E :: PatQ -> ExpQ -> ExpQ
+lam1E p e = lamE [p] e
+
+lamCaseE :: [MatchQ] -> ExpQ
+lamCaseE ms = sequence ms >>= return . LamCaseE
+
+tupE :: [ExpQ] -> ExpQ
+tupE es = do { es1 <- sequence es; return (TupE es1)}
+
+unboxedTupE :: [ExpQ] -> ExpQ
+unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
+
+unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
+unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
+
+condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
+
+multiIfE :: [Q (Guard, Exp)] -> ExpQ
+multiIfE alts = sequence alts >>= return . MultiIfE
+
+letE :: [DecQ] -> ExpQ -> ExpQ
+letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
+
+caseE :: ExpQ -> [MatchQ] -> ExpQ
+caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
+
+doE :: [StmtQ] -> ExpQ
+doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
+
+compE :: [StmtQ] -> ExpQ
+compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
+
+arithSeqE :: RangeQ -> ExpQ
+arithSeqE r = do { r' <- r; return (ArithSeqE r') }
+
+listE :: [ExpQ] -> ExpQ
+listE es = do { es1 <- sequence es; return (ListE es1) }
+
+sigE :: ExpQ -> TypeQ -> ExpQ
+sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
+
+recConE :: Name -> [Q (Name,Exp)] -> ExpQ
+recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
+
+recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
+recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
+
+stringE :: String -> ExpQ
+stringE = litE . stringL
+
+fieldExp :: Name -> ExpQ -> Q (Name, Exp)
+fieldExp s e = do { e' <- e; return (s,e') }
+
+-- | @staticE x = [| static x |]@
+staticE :: ExpQ -> ExpQ
+staticE = fmap StaticE
+
+unboundVarE :: Name -> ExpQ
+unboundVarE s = return (UnboundVarE s)
+
+labelE :: String -> ExpQ
+labelE s = return (LabelE s)
+
+-- ** 'arithSeqE' Shortcuts
+fromE :: ExpQ -> ExpQ
+fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
+
+fromThenE :: ExpQ -> ExpQ -> ExpQ
+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
+
+fromToE :: ExpQ -> ExpQ -> ExpQ
+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
+
+fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+fromThenToE x y z = do { a <- x; b <- y; c <- z;
+                         return (ArithSeqE (FromThenToR a b c)) }
+
+
+-------------------------------------------------------------------------------
+-- *   Dec
+
+valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
+valD p b ds =
+  do { p' <- p
+     ; ds' <- sequence ds
+     ; b' <- b
+     ; return (ValD p' b' ds')
+     }
+
+funD :: Name -> [ClauseQ] -> DecQ
+funD nm cs =
+ do { cs1 <- sequence cs
+    ; return (FunD nm cs1)
+    }
+
+tySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ
+tySynD tc tvs rhs =
+  do { tvs1 <- sequenceA tvs
+     ; rhs1 <- rhs
+     ; return (TySynD tc tvs1 rhs1)
+     }
+
+dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]
+      -> [DerivClauseQ] -> DecQ
+dataD ctxt tc tvs ksig cons derivs =
+  do
+    ctxt1   <- ctxt
+    tvs1    <- sequenceA tvs
+    ksig1   <- sequenceA ksig
+    cons1   <- sequence cons
+    derivs1 <- sequence derivs
+    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
+
+newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ
+         -> [DerivClauseQ] -> DecQ
+newtypeD ctxt tc tvs ksig con derivs =
+  do
+    ctxt1   <- ctxt
+    tvs1    <- sequenceA tvs
+    ksig1   <- sequenceA ksig
+    con1    <- con
+    derivs1 <- sequence derivs
+    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
+
+classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ
+classD ctxt cls tvs fds decs =
+  do
+    tvs1  <- sequenceA tvs
+    decs1 <- sequenceA decs
+    ctxt1 <- ctxt
+    return $ ClassD ctxt1 cls tvs1 fds decs1
+
+instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceD = instanceWithOverlapD Nothing
+
+instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceWithOverlapD o ctxt ty decs =
+  do
+    ctxt1 <- ctxt
+    decs1 <- sequence decs
+    ty1   <- ty
+    return $ InstanceD o ctxt1 ty1 decs1
+
+
+
+sigD :: Name -> TypeQ -> DecQ
+sigD fun ty = liftM (SigD fun) $ ty
+
+forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
+forImpD cc s str n ty
+ = do ty' <- ty
+      return $ ForeignD (ImportF cc s str n ty')
+
+infixLD :: Int -> Name -> DecQ
+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+
+infixRD :: Int -> Name -> DecQ
+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+
+infixND :: Int -> Name -> DecQ
+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+
+pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
+pragInlD name inline rm phases
+  = return $ PragmaD $ InlineP name inline rm phases
+
+pragSpecD :: Name -> TypeQ -> Phases -> DecQ
+pragSpecD n ty phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
+
+pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
+pragSpecInlD n ty inline phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
+
+pragSpecInstD :: TypeQ -> DecQ
+pragSpecInstD ty
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseInstP ty1
+
+pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
+pragRuleD n bndrs lhs rhs phases
+  = do
+      bndrs1 <- sequence bndrs
+      lhs1   <- lhs
+      rhs1   <- rhs
+      return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
+
+pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD target expr
+  = do
+      exp1 <- expr
+      return $ PragmaD $ AnnP target exp1
+
+pragLineD :: Int -> String -> DecQ
+pragLineD line file = return $ PragmaD $ LineP line file
+
+pragCompleteD :: [Name] -> Maybe Name -> DecQ
+pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
+
+dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> [ConQ]
+          -> [DerivClauseQ] -> DecQ
+dataInstD ctxt tc tys ksig cons derivs =
+  do
+    ctxt1   <- ctxt
+    tys1    <- sequenceA tys
+    ksig1   <- sequenceA ksig
+    cons1   <- sequenceA cons
+    derivs1 <- sequenceA derivs
+    return (DataInstD ctxt1 tc tys1 ksig1 cons1 derivs1)
+
+newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> ConQ
+             -> [DerivClauseQ] -> DecQ
+newtypeInstD ctxt tc tys ksig con derivs =
+  do
+    ctxt1   <- ctxt
+    tys1    <- sequenceA tys
+    ksig1   <- sequenceA ksig
+    con1    <- con
+    derivs1 <- sequence derivs
+    return (NewtypeInstD ctxt1 tc tys1 ksig1 con1 derivs1)
+
+tySynInstD :: Name -> TySynEqnQ -> DecQ
+tySynInstD tc eqn =
+  do
+    eqn1 <- eqn
+    return (TySynInstD tc eqn1)
+
+dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ
+dataFamilyD tc tvs kind =
+  do tvs'  <- sequenceA tvs
+     kind' <- sequenceA kind
+     return $ DataFamilyD tc tvs' kind'
+
+openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
+                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD tc tvs res inj =
+  do tvs' <- sequenceA tvs
+     res' <- res
+     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
+
+closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
+                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD tc tvs result injectivity eqns =
+  do tvs1    <- sequenceA tvs
+     result1 <- result
+     eqns1   <- sequenceA eqns
+     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
+
+-- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you
+-- remove this check please also:
+--   1. remove deprecated functions
+--   2. remove CPP language extension from top of this module
+--   3. remove the FamFlavour data type from Syntax module
+--   4. make sure that all references to FamFlavour are gone from DsMeta,
+--      Convert, TcSplice (follows from 3)
+#if __GLASGOW_HASKELL__ >= 804
+#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
+#endif
+
+{-# DEPRECATED familyNoKindD, familyKindD
+               "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
+familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
+familyNoKindD flav tc tvs =
+    case flav of
+      TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
+      DataFam -> return $ DataFamilyD tc tvs Nothing
+
+familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
+familyKindD flav tc tvs k =
+    case flav of
+      TypeFam ->
+        return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
+      DataFam -> return $ DataFamilyD tc tvs (Just k)
+
+{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
+               "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
+closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
+closedTypeFamilyNoKindD tc tvs eqns =
+ do eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
+
+closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
+closedTypeFamilyKindD tc tvs kind eqns =
+ do eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
+            eqns1)
+
+roleAnnotD :: Name -> [Role] -> DecQ
+roleAnnotD name roles = return $ RoleAnnotD name roles
+
+standaloneDerivD :: CxtQ -> TypeQ -> DecQ
+standaloneDerivD = standaloneDerivWithStrategyD Nothing
+
+standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD ds ctxtq tyq =
+  do
+    ctxt <- ctxtq
+    ty   <- tyq
+    return $ StandaloneDerivD ds ctxt ty
+
+defaultSigD :: Name -> TypeQ -> DecQ
+defaultSigD n tyq =
+  do
+    ty <- tyq
+    return $ DefaultSigD n ty
+
+-- | Pattern synonym declaration
+patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
+patSynD name args dir pat = do
+  args'    <- args
+  dir'     <- dir
+  pat'     <- pat
+  return (PatSynD name args' dir' pat')
+
+-- | Pattern synonym type signature
+patSynSigD :: Name -> TypeQ -> DecQ
+patSynSigD nm ty =
+  do ty' <- ty
+     return $ PatSynSigD nm ty'
+
+tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
+tySynEqn lhs rhs =
+  do
+    lhs1 <- sequence lhs
+    rhs1 <- rhs
+    return (TySynEqn lhs1 rhs1)
+
+cxt :: [PredQ] -> CxtQ
+cxt = sequence
+
+derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause ds p = do p' <- cxt p
+                      return $ DerivClause ds p'
+
+normalC :: Name -> [BangTypeQ] -> ConQ
+normalC con strtys = liftM (NormalC con) $ sequence strtys
+
+recC :: Name -> [VarBangTypeQ] -> ConQ
+recC con varstrtys = liftM (RecC con) $ sequence varstrtys
+
+infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
+infixC st1 con st2 = do st1' <- st1
+                        st2' <- st2
+                        return $ InfixC st1' con st2'
+
+forallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ
+forallC ns ctxt con = do
+  ns'   <- sequenceA ns
+  ctxt' <- ctxt
+  con'  <- con
+  pure $ ForallC ns' ctxt' con'
+
+gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ
+gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty
+
+recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
+recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
+
+-------------------------------------------------------------------------------
+-- *   Type
+
+forallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ
+forallT tvars ctxt ty = do
+    tvars1 <- sequenceA tvars
+    ctxt1  <- ctxt
+    ty1    <- ty
+    return $ ForallT tvars1 ctxt1 ty1
+
+varT :: Name -> TypeQ
+varT = return . VarT
+
+conT :: Name -> TypeQ
+conT = return . ConT
+
+infixT :: TypeQ -> Name -> TypeQ -> TypeQ
+infixT t1 n t2 = do t1' <- t1
+                    t2' <- t2
+                    return (InfixT t1' n t2')
+
+uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
+uInfixT t1 n t2 = do t1' <- t1
+                     t2' <- t2
+                     return (UInfixT t1' n t2')
+
+parensT :: TypeQ -> TypeQ
+parensT t = do t' <- t
+               return (ParensT t')
+
+appT :: TypeQ -> TypeQ -> TypeQ
+appT t1 t2 = do
+           t1' <- t1
+           t2' <- t2
+           return $ AppT t1' t2'
+
+arrowT :: TypeQ
+arrowT = return ArrowT
+
+listT :: TypeQ
+listT = return ListT
+
+litT :: TyLitQ -> TypeQ
+litT l = fmap LitT l
+
+tupleT :: Int -> TypeQ
+tupleT i = return (TupleT i)
+
+unboxedTupleT :: Int -> TypeQ
+unboxedTupleT i = return (UnboxedTupleT i)
+
+unboxedSumT :: SumArity -> TypeQ
+unboxedSumT arity = return (UnboxedSumT arity)
+
+sigT :: TypeQ -> KindQ -> TypeQ
+sigT t k
+  = do
+      t' <- t
+      k' <- k
+      return $ SigT t' k'
+
+equalityT :: TypeQ
+equalityT = return EqualityT
+
+wildCardT :: TypeQ
+wildCardT = return WildCardT
+
+{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
+classP :: Name -> [Q Type] -> Q Pred
+classP cla tys
+  = do
+      tysl <- sequence tys
+      return (foldl AppT (ConT cla) tysl)
+
+{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
+equalP :: TypeQ -> TypeQ -> PredQ
+equalP tleft tright
+  = do
+      tleft1  <- tleft
+      tright1 <- tright
+      eqT <- equalityT
+      return (foldl AppT eqT [tleft1, tright1])
+
+promotedT :: Name -> TypeQ
+promotedT = return . PromotedT
+
+promotedTupleT :: Int -> TypeQ
+promotedTupleT i = return (PromotedTupleT i)
+
+promotedNilT :: TypeQ
+promotedNilT = return PromotedNilT
+
+promotedConsT :: TypeQ
+promotedConsT = return PromotedConsT
+
+noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
+noSourceUnpackedness = return NoSourceUnpackedness
+sourceNoUnpack       = return SourceNoUnpack
+sourceUnpack         = return SourceUnpack
+
+noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
+noSourceStrictness = return NoSourceStrictness
+sourceLazy         = return SourceLazy
+sourceStrict       = return SourceStrict
+
+{-# DEPRECATED isStrict
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
+{-# DEPRECATED notStrict
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
+{-# DEPRECATED unpacked
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
+isStrict, notStrict, unpacked :: Q Strict
+isStrict = bang noSourceUnpackedness sourceStrict
+notStrict = bang noSourceUnpackedness noSourceStrictness
+unpacked = bang sourceUnpack sourceStrict
+
+bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
+bang u s = do u' <- u
+              s' <- s
+              return (Bang u' s')
+
+bangType :: BangQ -> TypeQ -> BangTypeQ
+bangType = liftM2 (,)
+
+varBangType :: Name -> BangTypeQ -> VarBangTypeQ
+varBangType v bt = do (b, t) <- bt
+                      return (v, b, t)
+
+{-# DEPRECATED strictType
+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
+strictType :: Q Strict -> TypeQ -> StrictTypeQ
+strictType = bangType
+
+{-# DEPRECATED varStrictType
+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
+varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
+varStrictType = varBangType
+
+-- * Type Literals
+
+numTyLit :: Integer -> TyLitQ
+numTyLit n = if n >= 0 then return (NumTyLit n)
+                       else fail ("Negative type-level number: " ++ show n)
+
+strTyLit :: String -> TyLitQ
+strTyLit s = return (StrTyLit s)
+
+-------------------------------------------------------------------------------
+-- *   Kind
+
+plainTV :: Name -> TyVarBndrQ
+plainTV = pure . PlainTV
+
+kindedTV :: Name -> KindQ -> TyVarBndrQ
+kindedTV n = fmap (KindedTV n)
+
+varK :: Name -> Kind
+varK = VarT
+
+conK :: Name -> Kind
+conK = ConT
+
+tupleK :: Int -> Kind
+tupleK = TupleT
+
+arrowK :: Kind
+arrowK = ArrowT
+
+listK :: Kind
+listK = ListT
+
+appK :: Kind -> Kind -> Kind
+appK = AppT
+
+starK :: KindQ
+starK = pure StarT
+
+constraintK :: KindQ
+constraintK = pure ConstraintT
+
+-------------------------------------------------------------------------------
+-- *   Type family result
+
+noSig :: FamilyResultSigQ
+noSig = pure NoSig
+
+kindSig :: KindQ -> FamilyResultSigQ
+kindSig = fmap KindSig
+
+tyVarSig :: TyVarBndrQ -> FamilyResultSigQ
+tyVarSig = fmap TyVarSig
+
+-------------------------------------------------------------------------------
+-- *   Injectivity annotation
+
+injectivityAnn :: Name -> [Name] -> InjectivityAnn
+injectivityAnn = TH.InjectivityAnn
+
+-------------------------------------------------------------------------------
+-- *   Role
+
+nominalR, representationalR, phantomR, inferR :: Role
+nominalR          = NominalR
+representationalR = RepresentationalR
+phantomR          = PhantomR
+inferR            = InferR
+
+-------------------------------------------------------------------------------
+-- *   Callconv
+
+cCall, stdCall, cApi, prim, javaScript :: Callconv
+cCall      = CCall
+stdCall    = StdCall
+cApi       = CApi
+prim       = Prim
+javaScript = JavaScript
+
+-------------------------------------------------------------------------------
+-- *   Safety
+
+unsafe, safe, interruptible :: Safety
+unsafe = Unsafe
+safe = Safe
+interruptible = Interruptible
+
+-------------------------------------------------------------------------------
+-- *   FunDep
+
+funDep :: [Name] -> [Name] -> FunDep
+funDep = FunDep
+
+-------------------------------------------------------------------------------
+-- *   FamFlavour
+
+typeFam, dataFam :: FamFlavour
+typeFam = TypeFam
+dataFam = DataFam
+
+-------------------------------------------------------------------------------
+-- *   RuleBndr
+ruleVar :: Name -> RuleBndrQ
+ruleVar = return . RuleVar
+
+typedRuleVar :: Name -> TypeQ -> RuleBndrQ
+typedRuleVar n ty = ty >>= return . TypedRuleVar n
+
+-------------------------------------------------------------------------------
+-- *   AnnTarget
+valueAnnotation :: Name -> AnnTarget
+valueAnnotation = ValueAnnotation
+
+typeAnnotation :: Name -> AnnTarget
+typeAnnotation = TypeAnnotation
+
+moduleAnnotation :: AnnTarget
+moduleAnnotation = ModuleAnnotation
+
+-------------------------------------------------------------------------------
+-- * Pattern Synonyms (sub constructs)
+
+unidir, implBidir :: PatSynDirQ
+unidir    = return Unidir
+implBidir = return ImplBidir
+
+explBidir :: [ClauseQ] -> PatSynDirQ
+explBidir cls = do
+  cls' <- sequence cls
+  return (ExplBidir cls')
+
+prefixPatSyn :: [Name] -> PatSynArgsQ
+prefixPatSyn args = return $ PrefixPatSyn args
+
+recordPatSyn :: [Name] -> PatSynArgsQ
+recordPatSyn sels = return $ RecordPatSyn sels
+
+infixPatSyn :: Name -> Name -> PatSynArgsQ
+infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
+
+--------------------------------------------------------------
+-- * Useful helper function
+
+appsE :: [ExpQ] -> ExpQ
+appsE [] = error "appsE []"
+appsE [x] = x
+appsE (x:y:zs) = appsE ( (appE x y) : zs )
+
+-- | Return the Module at the place of splicing.  Can be used as an
+-- input for 'reifyModule'.
+thisModule :: Q Module
+thisModule = do
+  loc <- location
+  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 8eddedce3d..0e3429caa9 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -6,6 +6,14 @@
 
   * Add support for overloaded labels. Introduces `labelE :: String -> ExpQ`.
 
+  * Add `KindQ`, `TyVarBndrQ`, and `FamilyResultSigQ` aliases to
+    `Language.Haskell.TH.Lib`.
+
+  * Add `Language.Haskell.TH.Lib.Internal` module, which exposes some
+    additional functionality that is used internally in GHC's integration
+    with Template Haskell. This is not a part of the public API, and as
+    such, there are no API guarantees for this module from version to version.
+
 ## 2.12.0.0 *TBA*
 
   * Bundled with GHC *TBA*
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index dfb3b079b3..fcfa448b91 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -45,6 +45,8 @@ Library
         Language.Haskell.TH.Syntax
         Language.Haskell.TH.LanguageExtensions
 
+        Language.Haskell.TH.Lib.Internal
+
     other-modules:
         Language.Haskell.TH.Lib.Map