diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -9,6 +9,7 @@
         -- * The monad and its operations
         Q,
         runQ,
+        Quote(..),
         -- ** Administration: errors, locations and IO
         reportError,              -- :: String -> Q ()
         reportWarning,            -- :: String -> Q ()
@@ -49,12 +50,13 @@
 
         -- * Typed expressions
         TExp, unType,
+        Code(..), unTypeCode, unsafeCodeCoerce, hoistCode, bindCode,
+        bindCode_, joinCode, liftCode,
 
         -- * Names
         Name, NameSpace,        -- Abstract
         -- ** Constructing names
         mkName,         -- :: String -> Name
-        newName,        -- :: String -> Q Name
         -- ** Deconstructing names
         nameBase,       -- :: Name -> String
         nameModule,     -- :: Name -> Maybe String
@@ -85,7 +87,8 @@
         Pat(..), FieldExp, FieldPat,
     -- ** Types
         Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
-        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType,
+        Syntax.Specificity(..),
+        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, BangType, VarBangType,
 
     -- * Library functions
     module Language.Haskell.TH.Lib,
diff --git a/Language/Haskell/TH/CodeDo.hs b/Language/Haskell/TH/CodeDo.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/TH/CodeDo.hs
@@ -0,0 +1,20 @@
+-- | This module exists to work nicely with the QualifiedDo
+-- extension.
+-- @
+-- import qualified Language.Haskell.TH.CodeDo as Code
+-- myExample :: Monad m => Code m a -> Code m a -> Code m a
+-- myExample opt1 opt2 =
+--   Code.do
+--    x <- someSideEffect               -- This one is of type `M Bool`
+--    if x then opt1 else opt2
+-- @
+module Language.Haskell.TH.CodeDo((>>=), (>>)) where
+
+import Language.Haskell.TH.Syntax
+import Prelude(Monad)
+
+-- | Module over monad operator for 'Code'
+(>>=) :: Monad m => m a -> (a -> Code m b) -> Code m b
+(>>=) = bindCode
+(>>) :: Monad m => m a -> Code m b -> Code m b
+(>>)  = bindCode_
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -18,12 +18,13 @@
 
     -- * Library functions
     -- ** Abbreviations
-        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,
+        InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
         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, DerivStrategyQ,
+        TyVarBndrUnit, TyVarBndrSpec,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -55,6 +56,7 @@
 
     -- *** Types
         forallT, forallVisT, varT, conT, appT, appKindT, arrowT, infixT,
+        mulArrowT,
         uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,
         sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,
         promotedConsT, implicitParamT,
@@ -75,6 +77,8 @@
 
     -- *** Type variable binders
     plainTV, kindedTV,
+    plainInvisTV, kindedInvisTV,
+    specifiedSpec, inferredSpec,
 
     -- *** Roles
     nominalR, representationalR, phantomR, inferR,
@@ -153,15 +157,18 @@
   , derivClause
   , standaloneDerivWithStrategyD
 
+  , doE
+  , mdoE
   , tupE
   , unboxedTupE
 
   , Role
   , InjectivityAnn
   )
+import qualified Language.Haskell.TH.Lib.Internal as Internal
 import Language.Haskell.TH.Syntax
 
-import Control.Monad (liftM2)
+import Control.Applicative ( liftA2 )
 import Foreign.ForeignPtr
 import Data.Word
 import Prelude
@@ -174,97 +181,97 @@
 -------------------------------------------------------------------------------
 -- *   Dec
 
-tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
+tySynD :: Quote m => Name -> [TyVarBndr ()] -> m Type -> m Dec
 tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
 
-dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-      -> DecQ
+dataD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> [m Con] -> [m DerivClause]
+      -> m Dec
 dataD ctxt tc tvs ksig cons derivs =
   do
     ctxt1 <- ctxt
-    cons1 <- sequence cons
-    derivs1 <- sequence derivs
+    cons1 <- sequenceA cons
+    derivs1 <- sequenceA derivs
     return (DataD ctxt1 tc tvs ksig cons1 derivs1)
 
-newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-         -> DecQ
+newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> m Con -> [m DerivClause]
+         -> m Dec
 newtypeD ctxt tc tvs ksig con derivs =
   do
     ctxt1 <- ctxt
     con1 <- con
-    derivs1 <- sequence derivs
+    derivs1 <- sequenceA derivs
     return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
 
-classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
+classD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec
 classD ctxt cls tvs fds decs =
   do
-    decs1 <- sequence decs
+    decs1 <- sequenceA decs
     ctxt1 <- ctxt
     return $ ClassD ctxt1 cls tvs fds decs1
 
-pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
+pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
 pragRuleD n bndrs lhs rhs phases
   = do
-      bndrs1 <- sequence bndrs
+      bndrs1 <- sequenceA bndrs
       lhs1   <- lhs
       rhs1   <- rhs
       return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases
 
-dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-          -> DecQ
+dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]
+          -> m Dec
 dataInstD ctxt tc tys ksig cons derivs =
   do
     ctxt1 <- ctxt
     ty1 <- foldl appT (conT tc) tys
-    cons1 <- sequence cons
-    derivs1 <- sequence derivs
+    cons1 <- sequenceA cons
+    derivs1 <- sequenceA derivs
     return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)
 
-newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-             -> DecQ
+newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]
+             -> m Dec
 newtypeInstD ctxt tc tys ksig con derivs =
   do
     ctxt1 <- ctxt
     ty1 <- foldl appT (conT tc) tys
     con1  <- con
-    derivs1 <- sequence derivs
+    derivs1 <- sequenceA derivs
     return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)
 
-dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
+dataFamilyD :: Quote m => Name -> [TyVarBndr ()] -> Maybe Kind -> m Dec
 dataFamilyD tc tvs kind
-    = return $ DataFamilyD tc tvs kind
+    = pure $ DataFamilyD tc tvs kind
 
-openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig
+                -> Maybe InjectivityAnn -> m Dec
 openTypeFamilyD tc tvs res inj
-    = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
+    = pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
 
-closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig
+                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
 closedTypeFamilyD tc tvs result injectivity eqns =
-  do eqns1 <- sequence eqns
+  do eqns1 <- sequenceA eqns
      return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
 
-tySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ
+tySynEqn :: Quote m => (Maybe [TyVarBndr ()]) -> m Type -> m Type -> m TySynEqn
 tySynEqn tvs lhs rhs =
   do
     lhs1 <- lhs
     rhs1 <- rhs
     return (TySynEqn tvs lhs1 rhs1)
 
-forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
-forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
+forallC :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Con -> m Con
+forallC ns ctxt con = liftA2 (ForallC ns) ctxt con
 
 -------------------------------------------------------------------------------
 -- *   Type
 
-forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ
+forallT :: Quote m => [TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
 forallT tvars ctxt ty = do
     ctxt1 <- ctxt
     ty1   <- ty
     return $ ForallT tvars ctxt1 ty1
 
-sigT :: TypeQ -> Kind -> TypeQ
+sigT :: Quote m => m Type -> Kind -> m Type
 sigT t k
   = do
       t' <- t
@@ -273,11 +280,11 @@
 -------------------------------------------------------------------------------
 -- *   Kind
 
-plainTV :: Name -> TyVarBndr
-plainTV = PlainTV
+plainTV :: Name -> TyVarBndr ()
+plainTV n = PlainTV n ()
 
-kindedTV :: Name -> Kind -> TyVarBndr
-kindedTV = KindedTV
+kindedTV :: Name -> Kind -> TyVarBndr ()
+kindedTV n k = KindedTV n () k
 
 starK :: Kind
 starK = StarT
@@ -294,18 +301,18 @@
 kindSig :: Kind -> FamilyResultSig
 kindSig = KindSig
 
-tyVarSig :: TyVarBndr -> FamilyResultSig
+tyVarSig :: TyVarBndr () -> FamilyResultSig
 tyVarSig = TyVarSig
 
 -------------------------------------------------------------------------------
 -- * Top Level Declarations
 
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
 derivClause mds p = do
   p' <- cxt p
   return $ DerivClause mds p'
 
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
 standaloneDerivWithStrategyD mds ctxt ty = do
   ctxt' <- ctxt
   ty'   <- ty
@@ -328,8 +335,17 @@
 -------------------------------------------------------------------------------
 -- * Tuple expressions
 
-tupE :: [ExpQ] -> ExpQ
-tupE es = do { es1 <- sequence es; return (TupE $ map Just es1)}
+tupE :: Quote m => [m Exp] -> m Exp
+tupE es = do { es1 <- sequenceA es; return (TupE $ map Just es1)}
 
-unboxedTupE :: [ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE $ map Just es1)}
+unboxedTupE :: Quote m => [m Exp] -> m Exp
+unboxedTupE es = do { es1 <- sequenceA es; return (UnboxedTupE $ map Just es1)}
+
+-------------------------------------------------------------------------------
+-- * Do expressions
+
+doE :: Quote m => [m Stmt] -> m Exp
+doE = Internal.doE Nothing
+
+mdoE :: Quote m => [m Stmt] -> m Exp
+mdoE = Internal.mdoE Nothing
diff --git a/Language/Haskell/TH/Lib/Internal.hs b/Language/Haskell/TH/Lib/Internal.hs
--- a/Language/Haskell/TH/Lib/Internal.hs
+++ b/Language/Haskell/TH/Lib/Internal.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE Trustworthy #-}
 
 -- |
 -- Language.Haskell.TH.Lib.Internal exposes some additional functionality that
@@ -18,25 +19,38 @@
 
 import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
 import qualified Language.Haskell.TH.Syntax as TH
-import Control.Monad( liftM, liftM2 )
+import Control.Applicative(liftA, liftA2)
+import qualified Data.Kind as Kind (Type)
 import Data.Word( Word8 )
+import GHC.Exts (TYPE)
 import Prelude
 
 ----------------------------------------------------------
 -- * Type synonyms
 ----------------------------------------------------------
 
+-- Since GHC 8.8 is currently the minimum boot compiler version that we must
+-- support, we must use inline kind signatures to make TExpQ and CodeQ
+-- levity polymorphic. When we drop support for GHC 8.8, we can instead use
+-- standalone kind signatures, which are provided as comments.
+
+-- | Levity-polymorphic since /template-haskell-2.17.0.0/.
+-- type TExpQ :: TYPE r -> Kind.Type
+type TExpQ (a :: TYPE r) = Q (TExp a)
+
+-- type CodeQ :: TYPE r -> Kind.Type
+type CodeQ = Code Q :: (TYPE r -> Kind.Type)
+
 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 Decs                = [Dec] -- Defined as it is more convenient to wire-in
 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
@@ -66,6 +80,9 @@
 type Role                = TH.Role
 type InjectivityAnn      = TH.InjectivityAnn
 
+type TyVarBndrUnit       = TyVarBndr ()
+type TyVarBndrSpec       = TyVarBndr Specificity
+
 ----------------------------------------------------------
 -- * Lowercase pattern syntax functions
 ----------------------------------------------------------
@@ -93,675 +110,678 @@
 rationalL   :: Rational -> Lit
 rationalL   = RationalL
 
-litP :: Lit -> PatQ
-litP l = return (LitP l)
+litP :: Quote m => Lit -> m Pat
+litP l = pure (LitP l)
 
-varP :: Name -> PatQ
-varP v = return (VarP v)
+varP :: Quote m => Name -> m Pat
+varP v = pure (VarP v)
 
-tupP :: [PatQ] -> PatQ
-tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
+tupP :: Quote m => [m Pat] -> m Pat
+tupP ps = do { ps1 <- sequenceA ps; pure (TupP ps1)}
 
-unboxedTupP :: [PatQ] -> PatQ
-unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
+unboxedTupP :: Quote m => [m Pat] -> m Pat
+unboxedTupP ps = do { ps1 <- sequenceA ps; pure (UnboxedTupP ps1)}
 
-unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
-unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
+unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
+unboxedSumP p alt arity = do { p1 <- p; pure (UnboxedSumP p1 alt arity) }
 
-conP :: Name -> [PatQ] -> PatQ
-conP n ps = do ps' <- sequence ps
-               return (ConP n ps')
-infixP :: PatQ -> Name -> PatQ -> PatQ
+conP :: Quote m => Name -> [m Pat] -> m Pat
+conP n ps = do ps' <- sequenceA ps
+               pure (ConP n ps')
+infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
 infixP p1 n p2 = do p1' <- p1
                     p2' <- p2
-                    return (InfixP p1' n p2')
-uInfixP :: PatQ -> Name -> PatQ -> PatQ
+                    pure (InfixP p1' n p2')
+uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
 uInfixP p1 n p2 = do p1' <- p1
                      p2' <- p2
-                     return (UInfixP p1' n p2')
-parensP :: PatQ -> PatQ
+                     pure (UInfixP p1' n p2')
+parensP :: Quote m => m Pat -> m Pat
 parensP p = do p' <- p
-               return (ParensP p')
+               pure (ParensP p')
 
-tildeP :: PatQ -> PatQ
+tildeP :: Quote m => m Pat -> m Pat
 tildeP p = do p' <- p
-              return (TildeP p')
-bangP :: PatQ -> PatQ
+              pure (TildeP p')
+bangP :: Quote m => m Pat -> m Pat
 bangP p = do p' <- p
-             return (BangP p')
-asP :: Name -> PatQ -> PatQ
+             pure (BangP p')
+asP :: Quote m => Name -> m Pat -> m Pat
 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
+             pure (AsP n p')
+wildP :: Quote m => m Pat
+wildP = pure WildP
+recP :: Quote m => Name -> [m FieldPat] -> m Pat
+recP n fps = do fps' <- sequenceA fps
+                pure (RecP n fps')
+listP :: Quote m => [m Pat] -> m Pat
+listP ps = do ps' <- sequenceA ps
+              pure (ListP ps')
+sigP :: Quote m => m Pat -> m Type -> m Pat
 sigP p t = do p' <- p
               t' <- t
-              return (SigP p' t')
-viewP :: ExpQ -> PatQ -> PatQ
+              pure (SigP p' t')
+viewP :: Quote m => m Exp -> m Pat -> m Pat
 viewP e p = do e' <- e
                p' <- p
-               return (ViewP e' p')
+               pure (ViewP e' p')
 
-fieldPat :: Name -> PatQ -> FieldPatQ
+fieldPat :: Quote m => Name -> m Pat -> m FieldPat
 fieldPat n p = do p' <- p
-                  return (n, p')
+                  pure (n, p')
 
 
 -------------------------------------------------------------------------------
 -- *   Stmt
 
-bindS :: PatQ -> ExpQ -> StmtQ
-bindS p e = liftM2 BindS p e
+bindS :: Quote m => m Pat -> m Exp -> m Stmt
+bindS p e = liftA2 BindS p e
 
-letS :: [DecQ] -> StmtQ
-letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
+letS :: Quote m => [m Dec] -> m Stmt
+letS ds = do { ds1 <- sequenceA ds; pure (LetS ds1) }
 
-noBindS :: ExpQ -> StmtQ
-noBindS e = do { e1 <- e; return (NoBindS e1) }
+noBindS :: Quote m => m Exp -> m Stmt
+noBindS e = do { e1 <- e; pure (NoBindS e1) }
 
-parS :: [[StmtQ]] -> StmtQ
-parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
+parS :: Quote m => [[m Stmt]] -> m Stmt
+parS sss = do { sss1 <- traverse sequenceA sss; pure (ParS sss1) }
 
-recS :: [StmtQ] -> StmtQ
-recS ss = do { ss1 <- sequence ss; return (RecS ss1) }
+recS :: Quote m => [m Stmt] -> m Stmt
+recS ss = do { ss1 <- sequenceA ss; pure (RecS ss1) }
 
 -------------------------------------------------------------------------------
 -- *   Range
 
-fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }
+fromR :: Quote m => m Exp -> m Range
+fromR x = do { a <- x; pure (FromR a) }
 
-fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
+fromThenR :: Quote m => m Exp -> m Exp -> m Range
+fromThenR x y = do { a <- x; b <- y; pure (FromThenR a b) }
 
-fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
+fromToR :: Quote m => m Exp -> m Exp -> m Range
+fromToR x y = do { a <- x; b <- y; pure (FromToR a b) }
 
-fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
+fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
 fromThenToR x y z = do { a <- x; b <- y; c <- z;
-                         return (FromThenToR a b c) }
+                         pure (FromThenToR a b c) }
 -------------------------------------------------------------------------------
 -- *   Body
 
-normalB :: ExpQ -> BodyQ
-normalB e = do { e1 <- e; return (NormalB e1) }
+normalB :: Quote m => m Exp -> m Body
+normalB e = do { e1 <- e; pure (NormalB e1) }
 
-guardedB :: [Q (Guard,Exp)] -> BodyQ
-guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
+guardedB :: Quote m => [m (Guard,Exp)] -> m Body
+guardedB ges = do { ges' <- sequenceA ges; pure (GuardedB ges') }
 
 -------------------------------------------------------------------------------
 -- *   Guard
 
-normalG :: ExpQ -> GuardQ
-normalG e = do { e1 <- e; return (NormalG e1) }
+normalG :: Quote m => m Exp -> m Guard
+normalG e = do { e1 <- e; pure (NormalG e1) }
 
-normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
-normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
+normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
+normalGE g e = do { g1 <- g; e1 <- e; pure (NormalG g1, e1) }
 
-patG :: [StmtQ] -> GuardQ
-patG ss = do { ss' <- sequence ss; return (PatG ss') }
+patG :: Quote m => [m Stmt] -> m Guard
+patG ss = do { ss' <- sequenceA ss; pure (PatG ss') }
 
-patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
-patGE ss e = do { ss' <- sequence ss;
+patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
+patGE ss e = do { ss' <- sequenceA ss;
                   e'  <- e;
-                  return (PatG ss', e') }
+                  pure (PatG ss', e') }
 
 -------------------------------------------------------------------------------
 -- *   Match and Clause
 
 -- | Use with 'caseE'
-match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
+match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
 match p rhs ds = do { p' <- p;
                       r' <- rhs;
-                      ds' <- sequence ds;
-                      return (Match p' r' ds') }
+                      ds' <- sequenceA ds;
+                      pure (Match p' r' ds') }
 
 -- | Use with 'funD'
-clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
-clause ps r ds = do { ps' <- sequence ps;
+clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
+clause ps r ds = do { ps' <- sequenceA ps;
                       r' <- r;
-                      ds' <- sequence ds;
-                      return (Clause ps' r' ds') }
+                      ds' <- sequenceA ds;
+                      pure (Clause ps' r' ds') }
 
 
 ---------------------------------------------------------------------------
 -- *   Exp
 
 -- | Dynamically binding a variable (unhygenic)
-dyn :: String -> ExpQ
-dyn s = return (VarE (mkName s))
+dyn :: Quote m => String -> m Exp
+dyn s = pure (VarE (mkName s))
 
-varE :: Name -> ExpQ
-varE s = return (VarE s)
+varE :: Quote m => Name -> m Exp
+varE s = pure (VarE s)
 
-conE :: Name -> ExpQ
-conE s =  return (ConE s)
+conE :: Quote m => Name -> m Exp
+conE s =  pure (ConE s)
 
-litE :: Lit -> ExpQ
-litE c = return (LitE c)
+litE :: Quote m => Lit -> m Exp
+litE c = pure (LitE c)
 
-appE :: ExpQ -> ExpQ -> ExpQ
-appE x y = do { a <- x; b <- y; return (AppE a b)}
+appE :: Quote m => m Exp -> m Exp -> m Exp
+appE x y = do { a <- x; b <- y; pure (AppE a b)}
 
-appTypeE :: ExpQ -> TypeQ -> ExpQ
-appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
+appTypeE :: Quote m => m Exp -> m Type -> m Exp
+appTypeE x t = do { a <- x; s <- t; pure (AppTypeE a s) }
 
-parensE :: ExpQ -> ExpQ
-parensE x = do { x' <- x; return (ParensE x') }
+parensE :: Quote m => m Exp -> m Exp
+parensE x = do { x' <- x; pure (ParensE x') }
 
-uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
-                     return (UInfixE x' s' y') }
+                     pure (UInfixE x' s' y') }
 
-infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
+infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
 infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
-                                  return (InfixE (Just a) s' (Just b))}
+                                  pure (InfixE (Just a) s' (Just b))}
 infixE Nothing  s (Just y) = do { s' <- s; b <- y;
-                                  return (InfixE Nothing s' (Just b))}
+                                  pure (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) }
+                                  pure (InfixE (Just a) s' Nothing)}
+infixE Nothing  s Nothing  = do { s' <- s; pure (InfixE Nothing s' Nothing) }
 
-infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 infixApp x y z = infixE (Just x) y (Just z)
-sectionL :: ExpQ -> ExpQ -> ExpQ
+sectionL :: Quote m => m Exp -> m Exp -> m Exp
 sectionL x y = infixE (Just x) y Nothing
-sectionR :: ExpQ -> ExpQ -> ExpQ
+sectionR :: Quote m => m Exp -> m Exp -> m Exp
 sectionR x y = infixE Nothing x (Just y)
 
-lamE :: [PatQ] -> ExpQ -> ExpQ
-lamE ps e = do ps' <- sequence ps
+lamE :: Quote m => [m Pat] -> m Exp -> m Exp
+lamE ps e = do ps' <- sequenceA ps
                e' <- e
-               return (LamE ps' e')
+               pure (LamE ps' e')
 
 -- | Single-arg lambda
-lam1E :: PatQ -> ExpQ -> ExpQ
+lam1E :: Quote m => m Pat -> m Exp -> m Exp
 lam1E p e = lamE [p] e
 
-lamCaseE :: [MatchQ] -> ExpQ
-lamCaseE ms = sequence ms >>= return . LamCaseE
+lamCaseE :: Quote m => [m Match] -> m Exp
+lamCaseE ms = LamCaseE <$> sequenceA ms
 
-tupE :: [Maybe ExpQ] -> ExpQ
-tupE es = do { es1 <- traverse sequence es; return (TupE es1)}
+tupE :: Quote m => [Maybe (m Exp)] -> m Exp
+tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)}
 
-unboxedTupE :: [Maybe ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- traverse sequence es; return (UnboxedTupE es1)}
+unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp
+unboxedTupE es = do { es1 <- traverse sequenceA es; pure (UnboxedTupE es1)}
 
-unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
-unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
+unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
+unboxedSumE e alt arity = do { e1 <- e; pure (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)}
+condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
+condE x y z =  do { a <- x; b <- y; c <- z; pure (CondE a b c)}
 
-multiIfE :: [Q (Guard, Exp)] -> ExpQ
-multiIfE alts = sequence alts >>= return . MultiIfE
+multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
+multiIfE alts = MultiIfE <$> sequenceA alts
 
-letE :: [DecQ] -> ExpQ -> ExpQ
-letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
+letE :: Quote m => [m Dec] -> m Exp -> m Exp
+letE ds e = do { ds2 <- sequenceA ds; e2 <- e; pure (LetE ds2 e2) }
 
-caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
+caseE :: Quote m => m Exp -> [m Match] -> m Exp
+caseE e ms = do { e1 <- e; ms1 <- sequenceA ms; pure (CaseE e1 ms1) }
 
-doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
+doE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
+doE m ss = do { ss1 <- sequenceA ss; pure (DoE m ss1) }
 
-mdoE :: [StmtQ] -> ExpQ
-mdoE ss = do { ss1 <- sequence ss; return (MDoE ss1) }
+mdoE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
+mdoE m ss = do { ss1 <- sequenceA ss; pure (MDoE m ss1) }
 
-compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
+compE :: Quote m => [m Stmt] -> m Exp
+compE ss = do { ss1 <- sequenceA ss; pure (CompE ss1) }
 
-arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }
+arithSeqE :: Quote m => m Range -> m Exp
+arithSeqE r = do { r' <- r; pure (ArithSeqE r') }
 
-listE :: [ExpQ] -> ExpQ
-listE es = do { es1 <- sequence es; return (ListE es1) }
+listE :: Quote m => [m Exp] -> m Exp
+listE es = do { es1 <- sequenceA es; pure (ListE es1) }
 
-sigE :: ExpQ -> TypeQ -> ExpQ
-sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
+sigE :: Quote m => m Exp -> m Type -> m Exp
+sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) }
 
-recConE :: Name -> [Q (Name,Exp)] -> ExpQ
-recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
+recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp
+recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) }
 
-recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
-recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
+recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp
+recUpdE e fs = do { e1 <- e; flds <- sequenceA fs; pure (RecUpdE e1 flds) }
 
-stringE :: String -> ExpQ
+stringE :: Quote m => String -> m Exp
 stringE = litE . stringL
 
-fieldExp :: Name -> ExpQ -> Q (Name, Exp)
-fieldExp s e = do { e' <- e; return (s,e') }
+fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
+fieldExp s e = do { e' <- e; pure (s,e') }
 
 -- | @staticE x = [| static x |]@
-staticE :: ExpQ -> ExpQ
+staticE :: Quote m => m Exp -> m Exp
 staticE = fmap StaticE
 
-unboundVarE :: Name -> ExpQ
-unboundVarE s = return (UnboundVarE s)
+unboundVarE :: Quote m => Name -> m Exp
+unboundVarE s = pure (UnboundVarE s)
 
-labelE :: String -> ExpQ
-labelE s = return (LabelE s)
+labelE :: Quote m => String -> m Exp
+labelE s = pure (LabelE s)
 
-implicitParamVarE :: String -> ExpQ
-implicitParamVarE n = return (ImplicitParamVarE n)
+implicitParamVarE :: Quote m => String -> m Exp
+implicitParamVarE n = pure (ImplicitParamVarE n)
 
 -- ** 'arithSeqE' Shortcuts
-fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
+fromE :: Quote m => m Exp -> m Exp
+fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }
 
-fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
+fromThenE :: Quote m => m Exp -> m Exp -> m Exp
+fromThenE x y = do { a <- x; b <- y; pure (ArithSeqE (FromThenR a b)) }
 
-fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
+fromToE :: Quote m => m Exp -> m Exp -> m Exp
+fromToE x y = do { a <- x; b <- y; pure (ArithSeqE (FromToR a b)) }
 
-fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
 fromThenToE x y z = do { a <- x; b <- y; c <- z;
-                         return (ArithSeqE (FromThenToR a b c)) }
+                         pure (ArithSeqE (FromThenToR a b c)) }
 
 
 -------------------------------------------------------------------------------
 -- *   Dec
 
-valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
+valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
 valD p b ds =
   do { p' <- p
-     ; ds' <- sequence ds
+     ; ds' <- sequenceA ds
      ; b' <- b
-     ; return (ValD p' b' ds')
+     ; pure (ValD p' b' ds')
      }
 
-funD :: Name -> [ClauseQ] -> DecQ
+funD :: Quote m => Name -> [m Clause] -> m Dec
 funD nm cs =
- do { cs1 <- sequence cs
-    ; return (FunD nm cs1)
+ do { cs1 <- sequenceA cs
+    ; pure (FunD nm cs1)
     }
 
-tySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ
+tySynD :: Quote m => Name -> [m (TyVarBndr ())] -> m Type -> m Dec
 tySynD tc tvs rhs =
   do { tvs1 <- sequenceA tvs
      ; rhs1 <- rhs
-     ; return (TySynD tc tvs1 rhs1)
+     ; pure (TySynD tc tvs1 rhs1)
      }
 
-dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]
-      -> [DerivClauseQ] -> DecQ
+dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> [m Con]
+      -> [m DerivClause] -> m Dec
 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)
+    cons1   <- sequenceA cons
+    derivs1 <- sequenceA derivs
+    pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
 
-newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ
-         -> [DerivClauseQ] -> DecQ
+newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Con
+         -> [m DerivClause] -> m Dec
 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)
+    derivs1 <- sequenceA derivs
+    pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
 
-classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ
+classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> [FunDep] -> [m Dec] -> m Dec
 classD ctxt cls tvs fds decs =
   do
     tvs1  <- sequenceA tvs
     decs1 <- sequenceA decs
     ctxt1 <- ctxt
-    return $ ClassD ctxt1 cls tvs1 fds decs1
+    pure $ ClassD ctxt1 cls tvs1 fds decs1
 
-instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
 instanceD = instanceWithOverlapD Nothing
 
-instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
 instanceWithOverlapD o ctxt ty decs =
   do
     ctxt1 <- ctxt
-    decs1 <- sequence decs
+    decs1 <- sequenceA decs
     ty1   <- ty
-    return $ InstanceD o ctxt1 ty1 decs1
+    pure $ InstanceD o ctxt1 ty1 decs1
 
 
 
-sigD :: Name -> TypeQ -> DecQ
-sigD fun ty = liftM (SigD fun) $ ty
+sigD :: Quote m => Name -> m Type -> m Dec
+sigD fun ty = liftA (SigD fun) $ ty
 
-kiSigD :: Name -> KindQ -> DecQ
-kiSigD fun ki = liftM (KiSigD fun) $ ki
+kiSigD :: Quote m => Name -> m Kind -> m Dec
+kiSigD fun ki = liftA (KiSigD fun) $ ki
 
-forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
+forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
 forImpD cc s str n ty
  = do ty' <- ty
-      return $ ForeignD (ImportF cc s str n ty')
+      pure $ ForeignD (ImportF cc s str n ty')
 
-infixLD :: Int -> Name -> DecQ
-infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+infixLD :: Quote m => Int -> Name -> m Dec
+infixLD prec nm = pure (InfixD (Fixity prec InfixL) nm)
 
-infixRD :: Int -> Name -> DecQ
-infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+infixRD :: Quote m => Int -> Name -> m Dec
+infixRD prec nm = pure (InfixD (Fixity prec InfixR) nm)
 
-infixND :: Int -> Name -> DecQ
-infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+infixND :: Quote m => Int -> Name -> m Dec
+infixND prec nm = pure (InfixD (Fixity prec InfixN) nm)
 
-pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
+pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
 pragInlD name inline rm phases
-  = return $ PragmaD $ InlineP name inline rm phases
+  = pure $ PragmaD $ InlineP name inline rm phases
 
-pragSpecD :: Name -> TypeQ -> Phases -> DecQ
+pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
 pragSpecD n ty phases
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
+      pure $ PragmaD $ SpecialiseP n ty1 Nothing phases
 
-pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
+pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
 pragSpecInlD n ty inline phases
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
+      pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
 
-pragSpecInstD :: TypeQ -> DecQ
+pragSpecInstD :: Quote m => m Type -> m Dec
 pragSpecInstD ty
   = do
       ty1    <- ty
-      return $ PragmaD $ SpecialiseInstP ty1
+      pure $ PragmaD $ SpecialiseInstP ty1
 
-pragRuleD :: String -> Maybe [TyVarBndrQ] -> [RuleBndrQ] -> ExpQ -> ExpQ
-          -> Phases -> DecQ
+pragRuleD :: Quote m => String -> Maybe [m (TyVarBndr ())] -> [m RuleBndr] -> m Exp -> m Exp
+          -> Phases -> m Dec
 pragRuleD n ty_bndrs tm_bndrs lhs rhs phases
   = do
-      ty_bndrs1 <- traverse sequence ty_bndrs
-      tm_bndrs1 <- sequence tm_bndrs
+      ty_bndrs1 <- traverse sequenceA ty_bndrs
+      tm_bndrs1 <- sequenceA tm_bndrs
       lhs1   <- lhs
       rhs1   <- rhs
-      return $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases
+      pure $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases
 
-pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
 pragAnnD target expr
   = do
       exp1 <- expr
-      return $ PragmaD $ AnnP target exp1
+      pure $ PragmaD $ AnnP target exp1
 
-pragLineD :: Int -> String -> DecQ
-pragLineD line file = return $ PragmaD $ LineP line file
+pragLineD :: Quote m => Int -> String -> m Dec
+pragLineD line file = pure $ PragmaD $ LineP line file
 
-pragCompleteD :: [Name] -> Maybe Name -> DecQ
-pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
+pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
+pragCompleteD cls mty = pure $ PragmaD $ CompleteP cls mty
 
-dataInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> [ConQ]
-          -> [DerivClauseQ] -> DecQ
+dataInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> [m Con]
+          -> [m DerivClause] -> m Dec
 dataInstD ctxt mb_bndrs ty ksig cons derivs =
   do
     ctxt1   <- ctxt
-    mb_bndrs1 <- traverse sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     ty1    <- ty
     ksig1   <- sequenceA ksig
     cons1   <- sequenceA cons
     derivs1 <- sequenceA derivs
-    return (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)
+    pure (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)
 
-newtypeInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> ConQ
-             -> [DerivClauseQ] -> DecQ
+newtypeInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> m Con
+             -> [m DerivClause] -> m Dec
 newtypeInstD ctxt mb_bndrs ty ksig con derivs =
   do
     ctxt1   <- ctxt
-    mb_bndrs1 <- traverse sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     ty1    <- ty
     ksig1   <- sequenceA ksig
     con1    <- con
-    derivs1 <- sequence derivs
-    return (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)
+    derivs1 <- sequenceA derivs
+    pure (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)
 
-tySynInstD :: TySynEqnQ -> DecQ
+tySynInstD :: Quote m => m TySynEqn -> m Dec
 tySynInstD eqn =
   do
     eqn1 <- eqn
-    return (TySynInstD eqn1)
+    pure (TySynInstD eqn1)
 
-dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ
+dataFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Dec
 dataFamilyD tc tvs kind =
   do tvs'  <- sequenceA tvs
      kind' <- sequenceA kind
-     return $ DataFamilyD tc tvs' kind'
+     pure $ DataFamilyD tc tvs' kind'
 
-openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
-                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig
+                -> Maybe InjectivityAnn -> m Dec
 openTypeFamilyD tc tvs res inj =
   do tvs' <- sequenceA tvs
      res' <- res
-     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
+     pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
 
-closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
-                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig
+                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
 closedTypeFamilyD tc tvs result injectivity eqns =
   do tvs1    <- sequenceA tvs
      result1 <- result
      eqns1   <- sequenceA eqns
-     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
+     pure (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
 
-roleAnnotD :: Name -> [Role] -> DecQ
-roleAnnotD name roles = return $ RoleAnnotD name roles
+roleAnnotD :: Quote m => Name -> [Role] -> m Dec
+roleAnnotD name roles = pure $ RoleAnnotD name roles
 
-standaloneDerivD :: CxtQ -> TypeQ -> DecQ
+standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
 standaloneDerivD = standaloneDerivWithStrategyD Nothing
 
-standaloneDerivWithStrategyD :: Maybe DerivStrategyQ -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec
 standaloneDerivWithStrategyD mdsq ctxtq tyq =
   do
     mds  <- sequenceA mdsq
     ctxt <- ctxtq
     ty   <- tyq
-    return $ StandaloneDerivD mds ctxt ty
+    pure $ StandaloneDerivD mds ctxt ty
 
-defaultSigD :: Name -> TypeQ -> DecQ
+defaultSigD :: Quote m => Name -> m Type -> m Dec
 defaultSigD n tyq =
   do
     ty <- tyq
-    return $ DefaultSigD n ty
+    pure $ DefaultSigD n ty
 
 -- | Pattern synonym declaration
-patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
+patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
 patSynD name args dir pat = do
   args'    <- args
   dir'     <- dir
   pat'     <- pat
-  return (PatSynD name args' dir' pat')
+  pure (PatSynD name args' dir' pat')
 
 -- | Pattern synonym type signature
-patSynSigD :: Name -> TypeQ -> DecQ
+patSynSigD :: Quote m => Name -> m Type -> m Dec
 patSynSigD nm ty =
   do ty' <- ty
-     return $ PatSynSigD nm ty'
+     pure $ PatSynSigD nm ty'
 
 -- | Implicit parameter binding declaration. Can only be used in let
 -- and where clauses which consist entirely of implicit bindings.
-implicitParamBindD :: String -> ExpQ -> DecQ
+implicitParamBindD :: Quote m => String -> m Exp -> m Dec
 implicitParamBindD n e =
   do
     e' <- e
-    return $ ImplicitParamBindD n e'
+    pure $ ImplicitParamBindD n e'
 
-tySynEqn :: (Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ
+tySynEqn :: Quote m => (Maybe [m (TyVarBndr ())]) -> m Type -> m Type -> m TySynEqn
 tySynEqn mb_bndrs lhs rhs =
   do
-    mb_bndrs1 <- traverse sequence mb_bndrs
+    mb_bndrs1 <- traverse sequenceA mb_bndrs
     lhs1 <- lhs
     rhs1 <- rhs
-    return (TySynEqn mb_bndrs1 lhs1 rhs1)
+    pure (TySynEqn mb_bndrs1 lhs1 rhs1)
 
-cxt :: [PredQ] -> CxtQ
-cxt = sequence
+cxt :: Quote m => [m Pred] -> m Cxt
+cxt = sequenceA
 
-derivClause :: Maybe DerivStrategyQ -> [PredQ] -> DerivClauseQ
+derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause
 derivClause mds p = do mds' <- sequenceA mds
                        p'   <- cxt p
-                       return $ DerivClause mds' p'
+                       pure $ DerivClause mds' p'
 
-stockStrategy :: DerivStrategyQ
+stockStrategy :: Quote m => m DerivStrategy
 stockStrategy = pure StockStrategy
 
-anyclassStrategy :: DerivStrategyQ
+anyclassStrategy :: Quote m => m DerivStrategy
 anyclassStrategy = pure AnyclassStrategy
 
-newtypeStrategy :: DerivStrategyQ
+newtypeStrategy :: Quote m => m DerivStrategy
 newtypeStrategy = pure NewtypeStrategy
 
-viaStrategy :: TypeQ -> DerivStrategyQ
+viaStrategy :: Quote m => m Type -> m DerivStrategy
 viaStrategy = fmap ViaStrategy
 
-normalC :: Name -> [BangTypeQ] -> ConQ
-normalC con strtys = liftM (NormalC con) $ sequence strtys
+normalC :: Quote m => Name -> [m BangType] -> m Con
+normalC con strtys = liftA (NormalC con) $ sequenceA strtys
 
-recC :: Name -> [VarBangTypeQ] -> ConQ
-recC con varstrtys = liftM (RecC con) $ sequence varstrtys
+recC :: Quote m => Name -> [m VarBangType] -> m Con
+recC con varstrtys = liftA (RecC con) $ sequenceA varstrtys
 
-infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
+infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
 infixC st1 con st2 = do st1' <- st1
                         st2' <- st2
-                        return $ InfixC st1' con st2'
+                        pure $ InfixC st1' con st2'
 
-forallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ
+forallC :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Con -> m Con
 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
+gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
+gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty
 
-recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
-recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
+recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
+recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty
 
 -------------------------------------------------------------------------------
 -- *   Type
 
-forallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ
+forallT :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Type -> m Type
 forallT tvars ctxt ty = do
     tvars1 <- sequenceA tvars
     ctxt1  <- ctxt
     ty1    <- ty
-    return $ ForallT tvars1 ctxt1 ty1
+    pure $ ForallT tvars1 ctxt1 ty1
 
-forallVisT :: [TyVarBndrQ] -> TypeQ -> TypeQ
+forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type
 forallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty
 
-varT :: Name -> TypeQ
-varT = return . VarT
+varT :: Quote m => Name -> m Type
+varT = pure . VarT
 
-conT :: Name -> TypeQ
-conT = return . ConT
+conT :: Quote m => Name -> m Type
+conT = pure . ConT
 
-infixT :: TypeQ -> Name -> TypeQ -> TypeQ
+infixT :: Quote m => m Type -> Name -> m Type -> m Type
 infixT t1 n t2 = do t1' <- t1
                     t2' <- t2
-                    return (InfixT t1' n t2')
+                    pure (InfixT t1' n t2')
 
-uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
+uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
 uInfixT t1 n t2 = do t1' <- t1
                      t2' <- t2
-                     return (UInfixT t1' n t2')
+                     pure (UInfixT t1' n t2')
 
-parensT :: TypeQ -> TypeQ
+parensT :: Quote m => m Type -> m Type
 parensT t = do t' <- t
-               return (ParensT t')
+               pure (ParensT t')
 
-appT :: TypeQ -> TypeQ -> TypeQ
+appT :: Quote m => m Type -> m Type -> m Type
 appT t1 t2 = do
            t1' <- t1
            t2' <- t2
-           return $ AppT t1' t2'
+           pure $ AppT t1' t2'
 
-appKindT :: TypeQ -> KindQ -> TypeQ
+appKindT :: Quote m => m Type -> m Kind -> m Type
 appKindT ty ki = do
                ty' <- ty
                ki' <- ki
-               return $ AppKindT ty' ki'
+               pure $ AppKindT ty' ki'
 
-arrowT :: TypeQ
-arrowT = return ArrowT
+arrowT :: Quote m => m Type
+arrowT = pure ArrowT
 
-listT :: TypeQ
-listT = return ListT
+mulArrowT :: Quote m => m Type
+mulArrowT = pure MulArrowT
 
-litT :: TyLitQ -> TypeQ
+listT :: Quote m => m Type
+listT = pure ListT
+
+litT :: Quote m => m TyLit -> m Type
 litT l = fmap LitT l
 
-tupleT :: Int -> TypeQ
-tupleT i = return (TupleT i)
+tupleT :: Quote m => Int -> m Type
+tupleT i = pure (TupleT i)
 
-unboxedTupleT :: Int -> TypeQ
-unboxedTupleT i = return (UnboxedTupleT i)
+unboxedTupleT :: Quote m => Int -> m Type
+unboxedTupleT i = pure (UnboxedTupleT i)
 
-unboxedSumT :: SumArity -> TypeQ
-unboxedSumT arity = return (UnboxedSumT arity)
+unboxedSumT :: Quote m => SumArity -> m Type
+unboxedSumT arity = pure (UnboxedSumT arity)
 
-sigT :: TypeQ -> KindQ -> TypeQ
+sigT :: Quote m => m Type -> m Kind -> m Type
 sigT t k
   = do
       t' <- t
       k' <- k
-      return $ SigT t' k'
+      pure $ SigT t' k'
 
-equalityT :: TypeQ
-equalityT = return EqualityT
+equalityT :: Quote m => m Type
+equalityT = pure EqualityT
 
-wildCardT :: TypeQ
-wildCardT = return WildCardT
+wildCardT :: Quote m => m Type
+wildCardT = pure WildCardT
 
-implicitParamT :: String -> TypeQ -> TypeQ
+implicitParamT :: Quote m => String -> m Type -> m Type
 implicitParamT n t
   = do
       t' <- t
-      return $ ImplicitParamT n t'
+      pure $ ImplicitParamT n t'
 
 {-# 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 :: Quote m => Name -> [m Type] -> m Pred
 classP cla tys
   = do
-      tysl <- sequence tys
-      return (foldl AppT (ConT cla) tysl)
+      tysl <- sequenceA tys
+      pure (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 :: Quote m => m Type -> m Type -> m Pred
 equalP tleft tright
   = do
       tleft1  <- tleft
       tright1 <- tright
       eqT <- equalityT
-      return (foldl AppT eqT [tleft1, tright1])
+      pure (foldl AppT eqT [tleft1, tright1])
 
-promotedT :: Name -> TypeQ
-promotedT = return . PromotedT
+promotedT :: Quote m => Name -> m Type
+promotedT = pure . PromotedT
 
-promotedTupleT :: Int -> TypeQ
-promotedTupleT i = return (PromotedTupleT i)
+promotedTupleT :: Quote m => Int -> m Type
+promotedTupleT i = pure (PromotedTupleT i)
 
-promotedNilT :: TypeQ
-promotedNilT = return PromotedNilT
+promotedNilT :: Quote m => m Type
+promotedNilT = pure PromotedNilT
 
-promotedConsT :: TypeQ
-promotedConsT = return PromotedConsT
+promotedConsT :: Quote m => m Type
+promotedConsT = pure PromotedConsT
 
-noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
-noSourceUnpackedness = return NoSourceUnpackedness
-sourceNoUnpack       = return SourceNoUnpack
-sourceUnpack         = return SourceUnpack
+noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: Quote m => m SourceUnpackedness
+noSourceUnpackedness = pure NoSourceUnpackedness
+sourceNoUnpack       = pure SourceNoUnpack
+sourceUnpack         = pure SourceUnpack
 
-noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
-noSourceStrictness = return NoSourceStrictness
-sourceLazy         = return SourceLazy
-sourceStrict       = return SourceStrict
+noSourceStrictness, sourceLazy, sourceStrict :: Quote m => m SourceStrictness
+noSourceStrictness = pure NoSourceStrictness
+sourceLazy         = pure SourceLazy
+sourceStrict       = pure SourceStrict
 
 {-# DEPRECATED isStrict
     ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
@@ -772,51 +792,66 @@
 {-# DEPRECATED unpacked
     ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
      "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
-isStrict, notStrict, unpacked :: Q Strict
+isStrict, notStrict, unpacked :: Quote m => m Strict
 isStrict = bang noSourceUnpackedness sourceStrict
 notStrict = bang noSourceUnpackedness noSourceStrictness
 unpacked = bang sourceUnpack sourceStrict
 
-bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
+bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
 bang u s = do u' <- u
               s' <- s
-              return (Bang u' s')
+              pure (Bang u' s')
 
-bangType :: BangQ -> TypeQ -> BangTypeQ
-bangType = liftM2 (,)
+bangType :: Quote m => m Bang -> m Type -> m BangType
+bangType = liftA2 (,)
 
-varBangType :: Name -> BangTypeQ -> VarBangTypeQ
-varBangType v bt = do (b, t) <- bt
-                      return (v, b, t)
+varBangType :: Quote m => Name -> m BangType -> m VarBangType
+varBangType v bt = (\(b, t) -> (v, b, t)) <$> bt
 
 {-# 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 :: Quote m => m Strict -> m Type -> m StrictType
 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 :: Quote m => Name -> m StrictType -> m VarStrictType
 varStrictType = varBangType
 
 -- * Type Literals
 
-numTyLit :: Integer -> TyLitQ
-numTyLit n = if n >= 0 then return (NumTyLit n)
-                       else fail ("Negative type-level number: " ++ show n)
+-- MonadFail here complicates things (a lot) because it would mean we would
+-- have to emit a MonadFail constraint during typechecking if there was any
+-- chance the desugaring would use numTyLit, which in general is hard to
+-- predict.
+numTyLit :: Quote m => Integer -> m TyLit
+numTyLit n = if n >= 0 then pure (NumTyLit n)
+                       else error ("Negative type-level number: " ++ show n)
 
-strTyLit :: String -> TyLitQ
-strTyLit s = return (StrTyLit s)
+strTyLit :: Quote m => String -> m TyLit
+strTyLit s = pure (StrTyLit s)
 
 -------------------------------------------------------------------------------
 -- *   Kind
 
-plainTV :: Name -> TyVarBndrQ
-plainTV = pure . PlainTV
+plainTV :: Quote m => Name -> m (TyVarBndr ())
+plainTV n = pure $ PlainTV n ()
 
-kindedTV :: Name -> KindQ -> TyVarBndrQ
-kindedTV n = fmap (KindedTV n)
+plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)
+plainInvisTV n s = pure $ PlainTV n s
 
+kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ())
+kindedTV n = fmap (KindedTV n ())
+
+kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)
+kindedInvisTV n s = fmap (KindedTV n s)
+
+specifiedSpec :: Specificity
+specifiedSpec = SpecifiedSpec
+
+inferredSpec :: Specificity
+inferredSpec = InferredSpec
+
 varK :: Name -> Kind
 varK = VarT
 
@@ -826,31 +861,31 @@
 tupleK :: Int -> Kind
 tupleK = TupleT
 
-arrowK :: Kind
+arrowK ::  Kind
 arrowK = ArrowT
 
-listK :: Kind
+listK ::  Kind
 listK = ListT
 
 appK :: Kind -> Kind -> Kind
 appK = AppT
 
-starK :: KindQ
+starK :: Quote m => m Kind
 starK = pure StarT
 
-constraintK :: KindQ
+constraintK :: Quote m => m Kind
 constraintK = pure ConstraintT
 
 -------------------------------------------------------------------------------
 -- *   Type family result
 
-noSig :: FamilyResultSigQ
+noSig :: Quote m => m FamilyResultSig
 noSig = pure NoSig
 
-kindSig :: KindQ -> FamilyResultSigQ
+kindSig :: Quote m => m Kind -> m FamilyResultSig
 kindSig = fmap KindSig
 
-tyVarSig :: TyVarBndrQ -> FamilyResultSigQ
+tyVarSig :: Quote m => m (TyVarBndr ()) -> m FamilyResultSig
 tyVarSig = fmap TyVarSig
 
 -------------------------------------------------------------------------------
@@ -889,23 +924,23 @@
 -------------------------------------------------------------------------------
 -- *   FunDep
 
-funDep :: [Name] -> [Name] -> FunDep
+funDep ::  [Name] -> [Name] -> FunDep
 funDep = FunDep
 
 -------------------------------------------------------------------------------
 -- *   RuleBndr
-ruleVar :: Name -> RuleBndrQ
-ruleVar = return . RuleVar
+ruleVar :: Quote m => Name -> m RuleBndr
+ruleVar = pure . RuleVar
 
-typedRuleVar :: Name -> TypeQ -> RuleBndrQ
-typedRuleVar n ty = ty >>= return . TypedRuleVar n
+typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
+typedRuleVar n ty = TypedRuleVar n <$> ty
 
 -------------------------------------------------------------------------------
 -- *   AnnTarget
-valueAnnotation :: Name -> AnnTarget
+valueAnnotation ::  Name -> AnnTarget
 valueAnnotation = ValueAnnotation
 
-typeAnnotation :: Name -> AnnTarget
+typeAnnotation ::  Name -> AnnTarget
 typeAnnotation = TypeAnnotation
 
 moduleAnnotation :: AnnTarget
@@ -914,35 +949,35 @@
 -------------------------------------------------------------------------------
 -- * Pattern Synonyms (sub constructs)
 
-unidir, implBidir :: PatSynDirQ
-unidir    = return Unidir
-implBidir = return ImplBidir
+unidir, implBidir :: Quote m => m PatSynDir
+unidir    = pure Unidir
+implBidir = pure ImplBidir
 
-explBidir :: [ClauseQ] -> PatSynDirQ
+explBidir :: Quote m => [m Clause] -> m PatSynDir
 explBidir cls = do
-  cls' <- sequence cls
-  return (ExplBidir cls')
+  cls' <- sequenceA cls
+  pure (ExplBidir cls')
 
-prefixPatSyn :: [Name] -> PatSynArgsQ
-prefixPatSyn args = return $ PrefixPatSyn args
+prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
+prefixPatSyn args = pure $ PrefixPatSyn args
 
-recordPatSyn :: [Name] -> PatSynArgsQ
-recordPatSyn sels = return $ RecordPatSyn sels
+recordPatSyn :: Quote m => [Name] -> m PatSynArgs
+recordPatSyn sels = pure $ RecordPatSyn sels
 
-infixPatSyn :: Name -> Name -> PatSynArgsQ
-infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
+infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
+infixPatSyn arg1 arg2 = pure $ InfixPatSyn arg1 arg2
 
 --------------------------------------------------------------
 -- * Useful helper function
 
-appsE :: [ExpQ] -> ExpQ
+appsE :: Quote m => [m Exp] -> m Exp
 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
+-- | pure 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)
+  pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -182,13 +182,19 @@
 pprExp i (CaseE e ms)
  = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"
                         $$ nest nestDepth (ppr ms)
-pprExp i (DoE ss_) = parensIf (i > noPrec) $ text "do" <+> pprStms ss_
+pprExp i (DoE m ss_) = parensIf (i > noPrec) $
+    pprQualifier m <> text "do" <+> pprStms ss_
   where
+    pprQualifier Nothing = empty
+    pprQualifier (Just modName) = text (modString modName) <> char '.'
     pprStms []  = empty
     pprStms [s] = ppr s
     pprStms ss  = braces (semiSep ss)
-pprExp i (MDoE ss_) = parensIf (i > noPrec) $ text "mdo" <+> pprStms ss_
+pprExp i (MDoE m ss_) = parensIf (i > noPrec) $
+    pprQualifier m <> text "mdo" <+> pprStms ss_
   where
+    pprQualifier Nothing = empty
+    pprQualifier (Just modName) = text (modString modName) <> char '.'
     pprStms []  = empty
     pprStms [s] = ppr s
     pprStms ss  = braces (semiSep ss)
@@ -511,7 +517,7 @@
     maybeInj | (Just inj') <- inj = ppr inj'
              | otherwise          = empty
 
-ppr_bndrs :: Maybe [TyVarBndr] -> Doc
+ppr_bndrs :: PprFlag flag => Maybe [TyVarBndr flag] -> Doc
 ppr_bndrs (Just bndrs) = text "forall" <+> sep (map ppr bndrs) <> text "."
 ppr_bndrs Nothing = empty
 
@@ -660,13 +666,13 @@
 commaSepApplied :: [Name] -> Doc
 commaSepApplied = commaSepWith (pprName' Applied)
 
-pprForall :: [TyVarBndr] -> Cxt -> Doc
+pprForall :: [TyVarBndr Specificity] -> Cxt -> Doc
 pprForall = pprForall' ForallInvis
 
-pprForallVis :: [TyVarBndr] -> Cxt -> Doc
+pprForallVis :: [TyVarBndr ()] -> Cxt -> Doc
 pprForallVis = pprForall' ForallVis
 
-pprForall' :: ForallVisFlag -> [TyVarBndr] -> Cxt -> Doc
+pprForall' :: PprFlag flag => ForallVisFlag -> [TyVarBndr flag] -> Cxt -> Doc
 pprForall' fvf tvs cxt
   -- even in the case without any tvs, there could be a non-empty
   -- context cxt (e.g., in the case of pattern synonyms, where there
@@ -756,6 +762,7 @@
 pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma
 pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar
 pprParendType ArrowT              = parens (text "->")
+pprParendType MulArrowT           = text "FUN"
 pprParendType ListT               = text "[]"
 pprParendType (LitT l)            = pprTyLit l
 pprParendType (PromotedT c)       = text "'" <> pprName' Applied c
@@ -789,15 +796,20 @@
     ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty]
     ppr (ForallVisT tvars ty)   = sep [pprForallVis tvars [], ppr ty]
     ppr ty = pprTyApp (split ty)
-       -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind)
+       -- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind)
        -- See Note [Pretty-printing kind signatures]
 instance Ppr TypeArg where
-    ppr (TANormal ty) = ppr ty
-    ppr (TyArg ki) = char '@' <> ppr ki
+    ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty)
+    ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki)
 
 pprParendTypeArg :: TypeArg -> Doc
-pprParendTypeArg (TANormal ty) = pprParendType ty
-pprParendTypeArg (TyArg ki) = char '@' <> pprParendType ki
+pprParendTypeArg (TANormal ty) = parensIf (isStarT ty) (pprParendType ty)
+pprParendTypeArg (TyArg ki) = char '@' <> parensIf (isStarT ki) (pprParendType ki)
+
+isStarT :: Type -> Bool
+isStarT StarT = True
+isStarT _ = False
+
 {- Note [Pretty-printing kind signatures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 GHC's parser only recognises a kind signature in a type when there are
@@ -807,26 +819,34 @@
 So we always print a SigT with parens (see #10050). -}
 
 pprTyApp :: (Type, [TypeArg]) -> Doc
+pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2])
+  | c == oneName  = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2]
+  | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2]
+pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) =
+                     sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2]
 pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]
 pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =
     sep [pprFunArgType arg1 <+> text "~", ppr arg2]
 pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)
+pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args)
+pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args)
 pprTyApp (TupleT n, args)
- | length args == n
- = if n == 1
-   then pprTyApp (ConT (tupleTypeName 1), args)
-   else parens (commaSep args)
+ | length args == n, Just args' <- traverse fromTANormal args
+ = parens (commaSep args')
 pprTyApp (PromotedTupleT n, args)
- | length args == n
- = if n == 1
-   then pprTyApp (PromotedT (tupleDataName 1), args)
-   else quoteParens (commaSep args)
+ | length args == n, Just args' <- traverse fromTANormal args
+ = quoteParens (commaSep args')
 pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)
 
+fromTANormal :: TypeArg -> Maybe Type
+fromTANormal (TANormal arg) = Just arg
+fromTANormal (TyArg _) = Nothing
+
 pprFunArgType :: Type -> Doc    -- Should really use a precedence argument
 -- Everything except forall and (->) binds more tightly than (->)
 pprFunArgType ty@(ForallT {})                 = parens (ppr ty)
 pprFunArgType ty@(ForallVisT {})              = parens (ppr ty)
+pprFunArgType ty@(((MulArrowT `AppT` _) `AppT` _) `AppT` _)  = parens (ppr ty)
 pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty)
 pprFunArgType ty@(SigT _ _)                   = parens (ppr ty)
 pprFunArgType ty                              = ppr ty
@@ -852,9 +872,21 @@
   ppr = pprTyLit
 
 ------------------------------
-instance Ppr TyVarBndr where
-    ppr (PlainTV nm)    = ppr nm
-    ppr (KindedTV nm k) = parens (ppr nm <+> dcolon <+> ppr k)
+class PprFlag flag where
+    pprTyVarBndr :: (TyVarBndr flag) -> Doc
+
+instance PprFlag () where
+    pprTyVarBndr (PlainTV nm ())    = ppr nm
+    pprTyVarBndr (KindedTV nm () k) = parens (ppr nm <+> dcolon <+> ppr k)
+
+instance PprFlag Specificity where
+    pprTyVarBndr (PlainTV nm SpecifiedSpec)    = ppr nm
+    pprTyVarBndr (PlainTV nm InferredSpec)     = braces (ppr nm)
+    pprTyVarBndr (KindedTV nm SpecifiedSpec k) = parens (ppr nm <+> dcolon <+> ppr k)
+    pprTyVarBndr (KindedTV nm InferredSpec  k) = braces (ppr nm <+> dcolon <+> ppr k)
+
+instance PprFlag flag => Ppr (TyVarBndr flag) where
+    ppr bndr = pprTyVarBndr bndr
 
 instance Ppr Role where
     ppr NominalR          = text "nominal"
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -3,7 +3,7 @@
              RankNTypes, RoleAnnotations, ScopedTypeVariables,
              MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,
              GADTs, UnboxedTuples, UnboxedSums, TypeInType,
-             Trustworthy #-}
+             Trustworthy, DeriveFunctor #-}
 
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
 
@@ -31,8 +31,14 @@
 import Data.Data hiding (Fixity(..))
 import Data.IORef
 import System.IO.Unsafe ( unsafePerformIO )
+import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )
 import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Fix (MonadFix (..))
+import Control.Applicative (liftA2)
+import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)
+import Control.Exception.Base (FixIOException (..))
+import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)
 import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper, ord )
 import Data.Int
@@ -45,14 +51,15 @@
 import GHC.Types        ( Int(..), Word(..), Char(..), Double(..), Float(..),
                           TYPE, RuntimeRep(..) )
 import GHC.Prim         ( Int#, Word#, Char#, Double#, Float#, Addr# )
+import GHC.Ptr          ( Ptr, plusPtr )
 import GHC.Lexeme       ( startsVarSym, startsVarId )
 import GHC.ForeignSrcLang.Type
 import Language.Haskell.TH.LanguageExtensions
 import Numeric.Natural
 import Prelude
 import Foreign.ForeignPtr
-
-import qualified Control.Monad.Fail as Fail
+import Foreign.C.String
+import Foreign.C.Types
 
 -----------------------------------------------------
 --
@@ -60,7 +67,7 @@
 --
 -----------------------------------------------------
 
-class (MonadIO m, Fail.MonadFail m) => Quasi m where
+class (MonadIO m, MonadFail m) => Quasi m where
   qNewName :: String -> m Name
         -- ^ Fresh names
 
@@ -124,8 +131,7 @@
 -----------------------------------------------------
 
 instance Quasi IO where
-  qNewName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
-                  ; pure (mkNameU s n) }
+  qNewName = newNameIO
 
   qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
   qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
@@ -152,6 +158,13 @@
   qIsExtEnabled _       = badIO "isExtEnabled"
   qExtsEnabled          = badIO "extsEnabled"
 
+instance Quote IO where
+  newName = newNameIO
+
+newNameIO :: String -> IO Name
+newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
+                 ; pure (mkNameU s n) }
+
 badIO :: String -> IO a
 badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
                 ; fail "Template Haskell failure" }
@@ -187,12 +200,9 @@
 instance Monad Q where
   Q m >>= k  = Q (m >>= \x -> unQ (k x))
   (>>) = (*>)
-#if !MIN_VERSION_base(4,13,0)
-  fail       = Fail.fail
-#endif
 
-instance Fail.MonadFail Q where
-  fail s     = report True s >> Q (Fail.fail "Q monad failure")
+instance MonadFail Q where
+  fail s     = report True s >> Q (fail "Q monad failure")
 
 instance Functor Q where
   fmap f (Q x) = Q (fmap f x)
@@ -202,8 +212,94 @@
   Q f <*> Q x = Q (f <*> x)
   Q m *> Q n = Q (m *> n)
 
+-- | @since 2.17.0.0
+instance Semigroup a => Semigroup (Q a) where
+  (<>) = liftA2 (<>)
+
+-- | @since 2.17.0.0
+instance Monoid a => Monoid (Q a) where
+  mempty = pure mempty
+
+-- | If the function passed to 'mfix' inspects its argument,
+-- the resulting action will throw a 'FixIOException'.
+--
+-- @since 2.17.0.0
+instance MonadFix Q where
+  -- We use the same blackholing approach as in fixIO.
+  -- See Note [Blackholing in fixIO] in System.IO in base.
+  mfix k = do
+    m <- runIO newEmptyMVar
+    ans <- runIO (unsafeDupableInterleaveIO
+             (readMVar m `catch` \BlockedIndefinitelyOnMVar ->
+                                    throwIO FixIOException))
+    result <- k ans
+    runIO (putMVar m result)
+    return result
+
+
 -----------------------------------------------------
 --
+--              The Quote class
+--
+-----------------------------------------------------
+
+
+
+-- | The 'Quote' class implements the minimal interface which is necessary for
+-- desugaring quotations.
+--
+-- * The @Monad m@ superclass is needed to stitch together the different
+-- AST fragments.
+-- * 'newName' is used when desugaring binding structures such as lambdas
+-- to generate fresh names.
+--
+-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
+--
+-- For many years the type of a quotation was fixed to be `Q Exp` but by
+-- more precisely specifying the minimal interface it enables the `Exp` to
+-- be extracted purely from the quotation without interacting with `Q`.
+class Monad m => Quote m where
+  {- |
+  Generate a fresh name, which cannot be captured.
+
+  For example, this:
+
+  @f = $(do
+    nm1 <- newName \"x\"
+    let nm2 = 'mkName' \"x\"
+    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
+   )@
+
+  will produce the splice
+
+  >f = \x0 -> \x -> x0
+
+  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
+  and is not captured by the binding @VarP nm2@.
+
+  Although names generated by @newName@ cannot /be captured/, they can
+  /capture/ other names. For example, this:
+
+  >g = $(do
+  >  nm1 <- newName "x"
+  >  let nm2 = mkName "x"
+  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
+  > )
+
+  will produce the splice
+
+  >g = \x -> \x0 -> x0
+
+  since the occurrence @VarE nm2@ is captured by the innermost binding
+  of @x@, namely @VarP nm1@.
+  -}
+  newName :: String -> m Name
+
+instance Quote Q where
+  newName s = Q (qNewName s)
+
+-----------------------------------------------------
+--
 --              The TExp type
 --
 -----------------------------------------------------
@@ -245,12 +341,14 @@
 --     • In the Template Haskell quotation [|| "foo" ||]
 --       In the expression: [|| "foo" ||]
 --       In the Template Haskell splice $$([|| "foo" ||])
+--
+-- Levity-polymorphic since /template-haskell-2.16.0.0/.
 
 -- | Discard the type annotation and produce a plain Template Haskell
 -- expression
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r). Q (TExp a) -> Q Exp
+unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
 unTypeQ m = do { TExp e <- m
                ; return e }
 
@@ -260,7 +358,8 @@
 -- really does have the type you claim it has.
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r). Q Exp -> Q (TExp a)
+unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> m (TExp a)
 unsafeTExpCoerce m = do { e <- m
                         ; return (TExp e) }
 
@@ -277,45 +376,66 @@
 The splice will evaluate to (MkAge 3) and you can't add that to
 4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
 
-----------------------------------------------------
--- Packaged versions for the programmer, hiding the Quasi-ness
+-- Code constructor
 
-{- |
-Generate a fresh name, which cannot be captured.
+type role Code representational nominal   -- See Note [Role of TExp]
+newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code
+  { examineCode :: m (TExp a) -- ^ Underlying monadic value
+  }
 
-For example, this:
+-- | Unsafely convert an untyped code representation into a typed code
+-- representation.
+unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> Code m a
+unsafeCodeCoerce m = Code (unsafeTExpCoerce m)
 
-@f = $(do
-  nm1 <- newName \"x\"
-  let nm2 = 'mkName' \"x\"
-  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
- )@
+-- | Lift a monadic action producing code into the typed 'Code'
+-- representation
+liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
+liftCode = Code
 
-will produce the splice
+-- | Extract the untyped representation from the typed representation
+unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
+           => Code m a -> m Exp
+unTypeCode = unTypeQ . examineCode
 
->f = \x0 -> \x -> x0
+-- | Modify the ambient monad used during code generation. For example, you
+-- can use `hoistCode` to handle a state effect:
+-- @
+--  handleState :: Code (StateT Int Q) a -> Code Q a
+--  handleState = hoistCode (flip runState 0)
+-- @
+hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
+          => (forall x . m x -> n x) -> Code m a -> Code n a
+hoistCode f (Code a) = Code (f a)
 
-In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
-and is not captured by the binding @VarP nm2@.
 
-Although names generated by @newName@ cannot /be captured/, they can
-/capture/ other names. For example, this:
+-- | Variant of (>>=) which allows effectful computations to be injected
+-- into code generation.
+bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+         => m a -> (a -> Code m b) -> Code m b
+bindCode q k = liftCode (q >>= examineCode . k)
 
->g = $(do
->  nm1 <- newName "x"
->  let nm2 = mkName "x"
->  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
-> )
+-- | Variant of (>>) which allows effectful computations to be injected
+-- into code generation.
+bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+          => m a -> Code m b -> Code m b
+bindCode_ q c = liftCode ( q >> examineCode c)
 
-will produce the splice
+-- | A useful combinator for embedding monadic actions into 'Code'
+-- @
+-- myCode :: ... => Code m a
+-- myCode = joinCode $ do
+--   x <- someSideEffect
+--   return (makeCodeWith x)
+-- @
+joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
+         => m (Code m a) -> Code m a
+joinCode = flip bindCode id
 
->g = \x -> \x0 -> x0
+----------------------------------------------------
+-- Packaged versions for the programmer, hiding the Quasi-ness
 
-since the occurrence @VarE nm2@ is captured by the innermost binding
-of @x@, namely @VarP nm1@.
--}
-newName :: String -> Q Name
-newName s = Q (qNewName s)
 
 -- | Report an error (True) or warning (False),
 -- but carry on; use 'fail' to stop.
@@ -651,16 +771,11 @@
 
 
 ----------------------------------------------------
--- The following operations are used solely in DsMeta when desugaring brackets
--- They are not necessary for the user, who can use ordinary return and (>>=) etc
-
-returnQ :: a -> Q a
-returnQ = return
-
-bindQ :: Q a -> (a -> Q b) -> Q b
-bindQ = (>>=)
+-- The following operations are used solely in GHC.HsToCore.Quote when
+-- desugaring brackets. They are not necessary for the user, who can use
+-- ordinary return and (>>=) etc
 
-sequenceQ :: [Q a] -> Q [a]
+sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
 sequenceQ = sequence
 
 
@@ -700,109 +815,109 @@
 class Lift (t :: TYPE r) where
   -- | Turn a value into a Template Haskell expression, suitable for use in
   -- a splice.
-  lift :: t -> Q Exp
-  default lift :: (r ~ 'LiftedRep) => t -> Q Exp
-  lift = unTypeQ . liftTyped
+  lift :: Quote m => t -> m Exp
+  default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
+  lift = unTypeCode . liftTyped
 
   -- | Turn a value into a Template Haskell typed expression, suitable for use
   -- in a typed splice.
   --
   -- @since 2.16.0.0
-  liftTyped :: t -> Q (TExp t)
+  liftTyped :: Quote m => t -> Code m t
 
 
 -- If you add any instances here, consider updating test th/TH_Lift
 instance Lift Integer where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL x))
 
 instance Lift Int where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 -- | @since 2.16.0.0
 instance Lift Int# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntPrimL (fromIntegral (I# x))))
 
 instance Lift Int8 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int16 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int32 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Int64 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 -- | @since 2.16.0.0
 instance Lift Word# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (WordPrimL (fromIntegral (W# x))))
 
 instance Lift Word where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word8 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word16 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word32 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Word64 where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Lift Natural where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
 instance Integral a => Lift (Ratio a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 instance Lift Float where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 -- | @since 2.16.0.0
 instance Lift Float# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (FloatPrimL (toRational (F# x))))
 
 instance Lift Double where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (RationalL (toRational x)))
 
 -- | @since 2.16.0.0
 instance Lift Double# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (DoublePrimL (toRational (D# x))))
 
 instance Lift Char where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (CharL x))
 
 -- | @since 2.16.0.0
 instance Lift Char# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x = return (LitE (CharPrimL (C# x)))
 
 instance Lift Bool where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift True  = return (ConE trueName)
   lift False = return (ConE falseName)
@@ -812,33 +927,33 @@
 --
 -- @since 2.16.0.0
 instance Lift Addr# where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
 
 instance Lift a => Lift (Maybe a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift Nothing  = return (ConE nothingName)
   lift (Just x) = liftM (ConE justName `AppE`) (lift x)
 
 instance (Lift a, Lift b) => Lift (Either a b) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)
   lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
 
 instance Lift a => Lift [a] where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
 
-liftString :: String -> Q Exp
--- Used in TcExpr to short-circuit the lifting for strings
+liftString :: Quote m => String -> m Exp
+-- Used in GHC.Tc.Gen.Expr to short-circuit the lifting for strings
 liftString s = return (LitE (StringL s))
 
 -- | @since 2.15.0.0
 instance Lift a => Lift (NonEmpty a) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
 
   lift (x :| xs) = do
     x' <- lift x
@@ -847,77 +962,77 @@
 
 -- | @since 2.15.0.0
 instance Lift Void where
-  liftTyped = pure . absurd
+  liftTyped = liftCode . absurd
   lift = pure . absurd
 
 instance Lift () where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift () = return (ConE (tupleDataName 0))
 
 instance (Lift a, Lift b) => Lift (a, b) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b]
 
 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
 
 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d)
     = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (a, b, c, d, e) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b
                                               , lift c, lift d, lift e ]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (a, b, c, d, e, f) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e, f)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                               , lift d, lift e, lift f ]
 
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (a, b, c, d, e, f, g) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (a, b, c, d, e, f, g)
     = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                               , lift d, lift e, lift f, lift g ]
 
 -- | @since 2.16.0.0
 instance Lift (# #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# #) = return (ConE (unboxedTupleTypeName 0))
 
 -- | @since 2.16.0.0
 instance (Lift a) => Lift (# a #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b) => Lift (# a, b #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c)
       => Lift (# a, b, c #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d)
       => Lift (# a, b, c, d #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
                                                      , lift c, lift d ]
@@ -925,7 +1040,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (# a, b, c, d, e #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
                                                      , lift c, lift d, lift e ]
@@ -933,7 +1048,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (# a, b, c, d, e, f #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e, f #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                                      , lift d, lift e, lift f ]
@@ -941,7 +1056,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (# a, b, c, d, e, f, g #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift (# a, b, c, d, e, f, g #)
     = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
                                                      , lift d, lift e, lift f
@@ -949,7 +1064,7 @@
 
 -- | @since 2.16.0.0
 instance (Lift a, Lift b) => Lift (# a | b #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
@@ -958,7 +1073,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c)
       => Lift (# a | b | c #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
@@ -968,7 +1083,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d)
       => Lift (# a | b | c | d #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
@@ -979,7 +1094,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
       => Lift (# a | b | c | d | e #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
@@ -991,7 +1106,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
       => Lift (# a | b | c | d | e | f #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
@@ -1004,7 +1119,7 @@
 -- | @since 2.16.0.0
 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
       => Lift (# a | b | c | d | e | f | g #) where
-  liftTyped x = unsafeTExpCoerce (lift x)
+  liftTyped x = unsafeCodeCoerce (lift x)
   lift x
     = case x of
         (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7
@@ -1039,6 +1154,9 @@
 nonemptyName :: Name
 nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"
 
+oneName, manyName :: Name
+oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"
+manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"
 -----------------------------------------------------
 --
 --              Generic Lift implementations
@@ -1053,13 +1171,13 @@
 -- expressions and patterns; @antiQ@ allows you to override type-specific
 -- cases, a common usage is just @const Nothing@, which results in
 -- no overloading.
-dataToQa  ::  forall a k q. Data a
+dataToQa  ::  forall m a k q. (Quote m, Data a)
           =>  (Name -> k)
-          ->  (Lit -> Q q)
-          ->  (k -> [Q q] -> Q q)
-          ->  (forall b . Data b => b -> Maybe (Q q))
+          ->  (Lit -> m q)
+          ->  (k -> [m q] -> m q)
+          ->  (forall b . Data b => b -> Maybe (m q))
           ->  a
-          ->  Q q
+          ->  m q
 dataToQa mkCon mkLit appCon antiQ t =
     case antiQ t of
       Nothing ->
@@ -1096,7 +1214,7 @@
                     tyconPkg = tyConPackage tycon
                     tyconMod = tyConModule  tycon
 
-                conArgs :: [Q q]
+                conArgs :: [m q]
                 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
             IntConstr n ->
                 mkLit $ IntegerL n
@@ -1138,14 +1256,14 @@
   "pack" is defined in a different module than the data type "Text".
   -}
 
--- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
+-- | 'dataToExpQ' converts a value to a 'Exp' representation of the
 -- same value, in the SYB style. It is generalized to take a function
 -- override type-specific cases; see 'liftData' for a more commonly
 -- used variant.
-dataToExpQ  ::  Data a
-            =>  (forall b . Data b => b -> Maybe (Q Exp))
+dataToExpQ  ::  (Quote m, Data a)
+            =>  (forall b . Data b => b -> Maybe (m Exp))
             ->  a
-            ->  Q Exp
+            ->  m Exp
 dataToExpQ = dataToQa varOrConE litE (foldl appE)
     where
           -- Make sure that VarE is used if the Constr value relies on a
@@ -1155,23 +1273,23 @@
             case nameSpace s of
                  Just VarName  -> return (VarE s)
                  Just DataName -> return (ConE s)
-                 _ -> fail $ "Can't construct an expression from name "
-                          ++ showName s
+                 _ -> error $ "Can't construct an expression from name "
+                           ++ showName s
           appE x y = do { a <- x; b <- y; return (AppE a b)}
           litE c = return (LitE c)
 
 -- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
 -- works for any type with a 'Data' instance.
-liftData :: Data a => a -> Q Exp
+liftData :: (Quote m, Data a) => a -> m Exp
 liftData = dataToExpQ (const Nothing)
 
--- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
+-- | 'dataToPatQ' converts a value to a 'Pat' representation of the same
 -- value, in the SYB style. It takes a function to handle type-specific cases,
 -- alternatively, pass @const Nothing@ to get default behavior.
-dataToPatQ  ::  Data a
-            =>  (forall b . Data b => b -> Maybe (Q Pat))
+dataToPatQ  ::  (Quote m, Data a)
+            =>  (forall b . Data b => b -> Maybe (m Pat))
             ->  a
-            ->  Q Pat
+            ->  m Pat
 dataToPatQ = dataToQa id litP conP
     where litP l = return (LitP l)
           conP n ps =
@@ -1179,8 +1297,8 @@
                 Just DataName -> do
                     ps' <- sequence ps
                     return (ConP n ps')
-                _ -> fail $ "Can't construct a pattern from name "
-                         ++ showName n
+                _ -> error $ "Can't construct a pattern from name "
+                          ++ showName n
 
 -----------------------------------------------------
 --              Names and uniques
@@ -1553,7 +1671,7 @@
     withParens thing
       | boxed     = "("  ++ thing ++ ")"
       | otherwise = "(#" ++ thing ++ "#)"
-    tup_occ | n == 1    = if boxed then "Unit" else "Unit#"
+    tup_occ | n == 1    = if boxed then "Solo" else "Solo#"
             | otherwise = withParens (replicate n_commas ',')
     n_commas = n - 1
     tup_mod  = mkModName "GHC.Tuple"
@@ -1582,7 +1700,7 @@
     prefix     = "unboxedSumDataName: "
     debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"
 
-    -- Synced with the definition of mkSumDataConOcc in TysWiredIn
+    -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types
     sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)"
     bars i = replicate i '|'
     nbars_before = alt - 1
@@ -1598,7 +1716,7 @@
          (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))
 
   where
-    -- Synced with the definition of mkSumTyConOcc in TysWiredIn
+    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types
     sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)"
 
 -----------------------------------------------------
@@ -1724,7 +1842,7 @@
 -- | In 'PrimTyConI', is the type constructor unlifted?
 type Unlifted = Bool
 
--- | 'InstanceDec' desribes a single instance of a class or type function.
+-- | 'InstanceDec' describes a single instance of a class or type function.
 -- It is just a 'Dec', but guaranteed to be one of the following:
 --
 --   * 'InstanceD' (with empty @['Dec']@)
@@ -1852,9 +1970,47 @@
    -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate
    --                            --   an uninitialized region
    }
-   deriving (Eq,Ord,Data,Generic,Show)
+   deriving (Data,Generic)
 
+-- We can't derive Show instance for Bytes because we don't want to show the
+-- pointer value but the actual bytes (similarly to what ByteString does). See
+-- #16457.
+instance Show Bytes where
+   show b = unsafePerformIO $ withForeignPtr (bytesPtr b) $ \ptr ->
+               peekCStringLen ( ptr `plusPtr` fromIntegral (bytesOffset b)
+                              , fromIntegral (bytesSize b)
+                              )
 
+-- We can't derive Eq and Ord instances for Bytes because we don't want to
+-- compare pointer values but the actual bytes (similarly to what ByteString
+-- does).  See #16457
+instance Eq Bytes where
+   (==) = eqBytes
+
+instance Ord Bytes where
+   compare = compareBytes
+
+eqBytes :: Bytes -> Bytes -> Bool
+eqBytes a@(Bytes fp off len) b@(Bytes fp' off' len')
+  | len /= len'              = False    -- short cut on length
+  | fp == fp' && off == off' = True     -- short cut for the same bytes
+  | otherwise                = compareBytes a b == EQ
+
+compareBytes :: Bytes -> Bytes -> Ordering
+compareBytes (Bytes _   _    0)    (Bytes _   _    0)    = EQ  -- short cut for empty Bytes
+compareBytes (Bytes fp1 off1 len1) (Bytes fp2 off2 len2) =
+    unsafePerformIO $
+      withForeignPtr fp1 $ \p1 ->
+      withForeignPtr fp2 $ \p2 -> do
+        i <- memcmp (p1 `plusPtr` fromIntegral off1)
+                    (p2 `plusPtr` fromIntegral off2)
+                    (fromIntegral (min len1 len2))
+        return $! (i `compare` 0) <> (len1 `compare` len2)
+
+foreign import ccall unsafe "memcmp"
+  memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt
+
+
 -- | Pattern in Haskell given in @{}@
 data Pat
   = LitP Lit                        -- ^ @{ 5 or \'c\' }@
@@ -1942,8 +2098,10 @@
   | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
   | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@
   | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@
-  | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@
-  | MDoE [Stmt]                        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@
+  | DoE (Maybe ModName) [Stmt]         -- ^ @{ do { p <- e1; e2 }  }@ or a qualified do if
+                                       -- the module name is present
+  | MDoE (Maybe ModName) [Stmt]        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ or a qualified
+                                       -- mdo if the module name is present
   | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
       --
       -- The result expression of the comprehension is
@@ -2002,19 +2160,19 @@
 data Dec
   = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
   | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
-  | DataD Cxt Name [TyVarBndr]
+  | DataD Cxt Name [TyVarBndr ()]
           (Maybe Kind)            -- Kind signature (allowed only for GADTs)
           [Con] [DerivClause]
                                   -- ^ @{ data Cxt x => T x = A x | B (T x)
                                   --       deriving (Z,W)
                                   --       deriving stock Eq }@
-  | NewtypeD Cxt Name [TyVarBndr]
+  | NewtypeD Cxt Name [TyVarBndr ()]
              (Maybe Kind)         -- Kind signature
              Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)
                                   --       deriving (Z,W Q)
                                   --       deriving stock Eq }@
-  | TySynD Name [TyVarBndr] Type  -- ^ @{ type T x = (x,x) }@
-  | ClassD Cxt Name [TyVarBndr]
+  | TySynD Name [TyVarBndr ()] Type -- ^ @{ type T x = (x,x) }@
+  | ClassD Cxt Name [TyVarBndr ()]
          [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
   | InstanceD (Maybe Overlap) Cxt Type [Dec]
                                   -- ^ @{ instance {\-\# OVERLAPS \#-\}
@@ -2030,18 +2188,18 @@
   | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@
 
   -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
-  | DataFamilyD Name [TyVarBndr]
+  | DataFamilyD Name [TyVarBndr ()]
                (Maybe Kind)
          -- ^ @{ data family T a b c :: * }@
 
-  | DataInstD Cxt (Maybe [TyVarBndr]) Type
+  | DataInstD Cxt (Maybe [TyVarBndr ()]) Type
              (Maybe Kind)         -- Kind signature
              [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]
                                   --       = A x | B (T x)
                                   --       deriving (Z,W)
                                   --       deriving stock Eq }@
 
-  | NewtypeInstD Cxt (Maybe [TyVarBndr]) Type -- Quantified type vars
+  | NewtypeInstD Cxt (Maybe [TyVarBndr ()]) Type -- Quantified type vars
                  (Maybe Kind)      -- Kind signature
                  Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]
                                    --        = A (B x)
@@ -2154,7 +2312,7 @@
 -- @TypeFamilyHead@ is defined to be the elements of the declaration
 -- between @type family@ and @where@.
 data TypeFamilyHead =
-  TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn)
+  TypeFamilyHead Name [TyVarBndr ()] FamilyResultSig (Maybe InjectivityAnn)
   deriving( Show, Eq, Ord, Data, Generic )
 
 -- | One equation of a type family instance or closed type family. The
@@ -2174,7 +2332,7 @@
 --            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))
 --            ('VarT' a)
 -- @
-data TySynEqn = TySynEqn (Maybe [TyVarBndr]) Type Type
+data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type
   deriving( Show, Eq, Ord, Data, Generic )
 
 data FunDep = FunDep [Name] [Name]
@@ -2184,7 +2342,7 @@
              | ExportF Callconv        String Name Type
          deriving( Show, Eq, Ord, Data, Generic )
 
--- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs
+-- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs
 data Callconv = CCall | StdCall | CApi | Prim | JavaScript
           deriving( Show, Eq, Ord, Data, Generic )
 
@@ -2194,7 +2352,7 @@
 data Pragma = InlineP         Name Inline RuleMatch Phases
             | SpecialiseP     Name Type (Maybe Inline) Phases
             | SpecialiseInstP Type
-            | RuleP           String (Maybe [TyVarBndr]) [RuleBndr] Exp Exp Phases
+            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases
             | AnnP            AnnTarget Exp
             | LineP           Int String
             | CompleteP       [Name] (Maybe Name)
@@ -2283,7 +2441,7 @@
 data Con = NormalC Name [BangType]       -- ^ @C Int a@
          | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@
          | InfixC BangType Name BangType -- ^ @Int :+ a@
-         | ForallC [TyVarBndr] Cxt Con   -- ^ @forall a. Eq a => C [a]@
+         | ForallC [TyVarBndr Specificity] Cxt Con -- ^ @forall a. Eq a => C [a]@
          | GadtC [Name] [BangType]
                  Type                    -- See Note [GADT return type]
                                          -- ^ @C :: a -> b -> T b Int@
@@ -2352,8 +2510,8 @@
   | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@
   deriving( Show, Eq, Ord, Data, Generic )
 
-data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@
-          | ForallVisT [TyVarBndr] Type   -- ^ @forall \<vars\> -> \<type\>@
+data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@
+          | ForallVisT [TyVarBndr ()] Type  -- ^ @forall \<vars\> -> \<type\>@
           | AppT Type Type                -- ^ @T a b@
           | AppKindT Type Kind            -- ^ @T \@k t@
           | SigT Type Kind                -- ^ @t :: k@
@@ -2371,6 +2529,7 @@
           | UnboxedTupleT Int             -- ^ @(\#,\#), (\#,,\#), etc.@
           | UnboxedSumT SumArity          -- ^ @(\#|\#), (\#||\#), etc.@
           | ArrowT                        -- ^ @->@
+          | MulArrowT                     -- ^ @FUN@
           | EqualityT                     -- ^ @~@
           | ListT                         -- ^ @[]@
           | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@
@@ -2383,14 +2542,18 @@
           | ImplicitParamT String Type    -- ^ @?x :: t@
       deriving( Show, Eq, Ord, Data, Generic )
 
-data TyVarBndr = PlainTV  Name            -- ^ @a@
-               | KindedTV Name Kind       -- ^ @(a :: k)@
+data Specificity = SpecifiedSpec          -- ^ @a@
+                 | InferredSpec           -- ^ @{a}@
       deriving( Show, Eq, Ord, Data, Generic )
 
+data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@
+                    | KindedTV Name flag Kind -- ^ @(a :: k)@
+      deriving( Show, Eq, Ord, Data, Generic, Functor )
+
 -- | Type family result signature
 data FamilyResultSig = NoSig              -- ^ no signature
                      | KindSig  Kind      -- ^ @k@
-                     | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@
+                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@
       deriving( Show, Eq, Ord, Data, Generic )
 
 -- | Injectivity annotation
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,39 @@
 # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
 
+## 2.17.0.0
+  * Typed Quotations now return a value of type `Code m a` (GHC Proposal #195).
+    The main motiviation is to make writing instances easier and make it easier to
+    store `Code` values in type-indexed maps.
+
+  * Implement Overloaded Quotations (GHC Proposal #246). This patch modifies a
+    few fundamental things in the API. All the library combinators are generalised
+    to be in terms of a new minimal class `Quote`. The types of `lift`, `liftTyped`,
+    and `liftData` are modified to return `m Exp` rather than `Q Exp`. Instances
+    written in terms of `Q` are now disallowed. The types of `unsafeTExpCoerce`
+    and `unTypeQ` are also generalised in terms of `Quote` rather than specific
+    to `Q`.
+
+  * Implement Explicit specificity in type variable binders (GHC Proposal #99).
+    In `Language.Haskell.TH.Syntax`, `TyVarBndr` is now annotated with a `flag`,
+    denoting the additional argument to its constructors `PlainTV` and `KindedTV`.
+    `flag` is either the `Specificity` of the type variable (`SpecifiedSpec` or
+    `InferredSpec`) or `()`.
+
+  * Fix Eq/Ord instances for `Bytes`: we were comparing pointers while we should
+    compare the actual bytes (#16457).
+
+  * Fix Show instance for `Bytes`: we were showing the pointer value while we
+    want to show the contents (#16457).
+
+  * Add `Semigroup` and `Monoid` instances for `Q` (#18123).
+
+  * Add `MonadFix` instance for `Q` (#12073).
+
+  * Add support for QualifiedDo. The data constructors `DoE` and `MDoE` got a new
+    `Maybe ModName` argument to describe the qualifier of do blocks.
+
+  * The argument to `TExpQ` can now be levity polymorphic.
+
 ## 2.16.0.0 *Jan 2020*
 
   * Bundled with GHC 8.10.1
diff --git a/template-haskell.cabal b/template-haskell.cabal
--- a/template-haskell.cabal
+++ b/template-haskell.cabal
@@ -1,7 +1,9 @@
-cabal-version:  >=1.10
-name:           template-haskell
-version:        2.16.0.0
+-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by
+-- ../../configure.  Make sure you are editing template-haskell.cabal.in, not
+-- template-haskell.cabal.
 
+name:           template-haskell
+version:        2.17.0.0
 -- NOTE: Don't forget to update ./changelog.md
 license:        BSD3
 license-file:   LICENSE
@@ -10,6 +12,7 @@
 bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues/new
 synopsis:       Support library for Template Haskell
 build-type:     Simple
+Cabal-Version:  >= 1.10
 description:
     This package provides modules containing facilities for manipulating
     Haskell source code using Template Haskell.
@@ -45,15 +48,15 @@
         Language.Haskell.TH.Quote
         Language.Haskell.TH.Syntax
         Language.Haskell.TH.LanguageExtensions
-
+        Language.Haskell.TH.CodeDo
         Language.Haskell.TH.Lib.Internal
 
     other-modules:
         Language.Haskell.TH.Lib.Map
 
     build-depends:
-        base        >= 4.11 && < 4.15,
-        ghc-boot-th == 8.10.1,
+        base        >= 4.11 && < 4.16,
+        ghc-boot-th == 9.0.1,
         ghc-prim,
         pretty      == 1.1.*