From 1979af97ae9516672f37f5955b974131e2f13436 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Thu, 18 Apr 2024 09:28:57 +0200
Subject: [PATCH] Fix TH dependencies (#22229)

Add a dependency between Syntax and Internal (via module reexport).

(cherry picked from commit 4d78c53c527af05bc1b4944219fa88306449bae0)
---
 compiler/GHC/Builtin/Names/TH.hs              |    2 +-
 hadrian/src/Rules/Dependencies.hs             |   34 -
 .../Language/Haskell/TH/Lib/Internal.hs       |    4 +-
 .../Language/Haskell/TH/Lib/Syntax.hs         | 2998 ++++++++++++++++
 .../Language/Haskell/TH/Syntax.hs             | 3014 +----------------
 .../template-haskell.cabal.in                 |    1 +
 .../deriving/should_compile/T14682.stderr     |   18 +-
 .../should_compile/drv-empty-data.stderr      |    8 +-
 testsuite/tests/plugins/plugins10.stdout      |    2 +-
 testsuite/tests/quotes/TH_localname.stderr    |   24 +-
 testsuite/tests/th/T10796b.stderr             |    2 +-
 testsuite/tests/th/T11452.stderr              |    8 +-
 testsuite/tests/th/T15321.stderr              |    4 +-
 testsuite/tests/th/T7276.stderr               |    6 +-
 .../tests/th/TH_NestedSplicesFail3.stderr     |    5 +-
 .../tests/th/TH_NestedSplicesFail4.stderr     |    7 +-
 16 files changed, 3060 insertions(+), 3077 deletions(-)
 create mode 100644 libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs

diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 0b490c30c39..8929f3c1e8c 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -180,7 +180,7 @@ templateHaskellNames = [
     quoteDecName, quoteTypeName, quoteExpName, quotePatName]
 
 thSyn, thLib, qqLib :: Module
-thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
+thSyn = mkTHModule (fsLit "Language.Haskell.TH.Lib.Syntax")
 thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib.Internal")
 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 
diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
index 68a6c98543c..ad16da31c95 100644
--- a/hadrian/src/Rules/Dependencies.hs
+++ b/hadrian/src/Rules/Dependencies.hs
@@ -14,41 +14,9 @@ import Rules.Generate
 import Settings
 import Target
 import Utilities
-import Packages
-import qualified Data.Map as M
-import qualified Data.Set as S
 
 import qualified Text.Parsec as Parsec
 
--- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but
--- the dependency is implicit. ghc -M should emit this additional dependency but
--- until it does we need to add this dependency ourselves.
-extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)])
-extra_dependencies =
-  M.fromList [(containers, fmap (fmap concat . sequence) (sequence
-    [dep (containers, "Data.IntSet.Internal") th_internal
-    ,dep (containers, "Data.Set.Internal") th_internal
-    ,dep (containers, "Data.Sequence.Internal") th_internal
-    ,dep (containers, "Data.Graph") th_internal
-    ]))
-    ]
-
-  where
-    th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
-    dep (p1, m1) (p2, m2) s =
-      -- We use the boot compiler's `template-haskell` library when building stage0,
-      -- so we don't need to register dependencies.
-      if isStage0 s then pure [] else do
-        let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set")
-        ways <- interpretInContext context getLibraryWays
-        mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways)
-    path stage way p m =
-      let context = Context stage p way Inplace
-      in objectPath context . moduleSource $ m
-
-formatExtra :: (FilePath, FilePath) -> String
-formatExtra (fp1, fp2) = fp1 ++ ":" ++ fp2 ++ "\n"
-
 buildPackageDependencies :: [(Resource, Int)] -> Rules ()
 buildPackageDependencies rs = do
     root <- buildRootRules
@@ -56,7 +24,6 @@ buildPackageDependencies rs = do
         DepMkFile stage pkgpath <- getDepMkFile root mk
         let pkg = unsafeFindPackageByPath pkgpath
             context = Context stage pkg vanilla Inplace
-        extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies
         srcs <- hsSources context
         gens <- interpretInContext context generatedDependencies
         need (srcs ++ gens)
@@ -64,7 +31,6 @@ buildPackageDependencies rs = do
         then writeFileChanged mk ""
         else buildWithResources rs $ target context
             (Ghc FindHsDependencies $ Context.stage context) srcs [mk]
-        liftIO $ mapM_ (appendFile mk . formatExtra) extra
         removeFile $ mk <.> "bak"
 
     root -/- "**/.dependencies" %> \deps -> do
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 2450bbe1bb9..532cef954d2 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -19,8 +19,8 @@
 
 module Language.Haskell.TH.Lib.Internal where
 
-import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
-import qualified Language.Haskell.TH.Syntax as TH
+import Language.Haskell.TH.Lib.Syntax hiding (Role, InjectivityAnn)
+import qualified Language.Haskell.TH.Lib.Syntax as TH
 import Control.Applicative(liftA, Applicative(..))
 import qualified Data.Kind as Kind (Type)
 import Data.Word( Word8 )
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs
new file mode 100644
index 00000000000..64b9655de53
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs
@@ -0,0 +1,2998 @@
+{-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead
+{-# LANGUAGE CPP, DeriveDataTypeable,
+             DeriveGeneric, FlexibleInstances, DefaultSignatures,
+             RankNTypes, RoleAnnotations, ScopedTypeVariables,
+             MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,
+             GADTs, UnboxedTuples, UnboxedSums, TypeOperators,
+             Trustworthy, DeriveFunctor, DeriveTraversable,
+             BangPatterns, RecordWildCards, ImplicitParams #-}
+
+{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+-- | This module is used internally in GHC's integration with Template Haskell
+-- and defines the abstract syntax of Template Haskell.
+--
+-- This is not a part of the public API, and as such, there are no API
+-- guarantees for this module from version to version.
+--
+-- Import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
+module Language.Haskell.TH.Lib.Syntax
+    ( module Language.Haskell.TH.Lib.Syntax
+      -- * Language extensions
+    , module Language.Haskell.TH.LanguageExtensions
+    , ForeignSrcLang(..)
+    -- * Notes
+    -- ** Unresolved Infix
+    -- $infix
+    ) where
+
+import Prelude
+import Data.Data hiding (Fixity(..))
+import Data.IORef
+import System.IO.Unsafe ( unsafePerformIO )
+import System.FilePath
+import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Fix (MonadFix (..))
+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 )
+import Data.List.NonEmpty ( NonEmpty(..) )
+import Data.Word
+import GHC.Generics     ( Generic )
+import qualified Data.Kind as Kind (Type)
+import GHC.Ptr          ( Ptr, plusPtr )
+import GHC.Lexeme       ( startsVarSym, startsVarId )
+import GHC.ForeignSrcLang.Type
+import Language.Haskell.TH.LanguageExtensions
+import Prelude hiding (Applicative(..))
+import Foreign.ForeignPtr
+import Foreign.C.String
+import Foreign.C.Types
+import GHC.Types        (TYPE, RuntimeRep(..), Levity(..))
+
+#ifndef BOOTSTRAP_TH
+import Control.Monad (liftM)
+import Data.Array.Byte (ByteArray(..))
+import Data.Char (ord)
+import Data.Int
+import Data.Ratio
+import Data.Void        ( Void, absurd )
+import GHC.CString      ( unpackCString# )
+import GHC.Exts
+  ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray#
+  , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents#
+  , copyByteArray#, newPinnedByteArray#)
+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))
+import GHC.Prim         ( Int#, Word#, Char#, Double#, Float#, Addr# )
+import GHC.ST (ST(..), runST)
+import GHC.Types        ( Int(..), Word(..), Char(..), Double(..), Float(..))
+import Numeric.Natural
+import qualified Data.Fixed as Fixed
+#endif
+
+-----------------------------------------------------
+--
+--              The Quasi class
+--
+-----------------------------------------------------
+
+class (MonadIO m, MonadFail m) => Quasi m where
+  qNewName :: String -> m Name
+        -- ^ Fresh names
+
+        -- Error reporting and recovery
+  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)
+                                        -- ...but carry on; use 'fail' to stop
+  qRecover :: m a -- ^ the error handler
+           -> m a -- ^ action which may fail
+           -> m a               -- ^ Recover from the monadic 'fail'
+
+        -- Inspect the type-checker's environment
+  qLookupName :: Bool -> String -> m (Maybe Name)
+       -- True <=> type namespace, False <=> value namespace
+  qReify          :: Name -> m Info
+  qReifyFixity    :: Name -> m (Maybe Fixity)
+  qReifyType      :: Name -> m Type
+  qReifyInstances :: Name -> [Type] -> m [Dec]
+       -- Is (n tys) an instance?
+       -- Returns list of matching instance Decs
+       --    (with empty sub-Decs)
+       -- Works for classes and type functions
+  qReifyRoles         :: Name -> m [Role]
+  qReifyAnnotations   :: Data a => AnnLookup -> m [a]
+  qReifyModule        :: Module -> m ModuleInfo
+  qReifyConStrictness :: Name -> m [DecidedStrictness]
+
+  qLocation :: m Loc
+
+  qRunIO :: IO a -> m a
+  qRunIO = liftIO
+  -- ^ Input/output (dangerous)
+  qGetPackageRoot :: m FilePath
+
+  qAddDependentFile :: FilePath -> m ()
+
+  qAddTempFile :: String -> m FilePath
+
+  qAddTopDecls :: [Dec] -> m ()
+
+  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
+
+  qAddModFinalizer :: Q () -> m ()
+
+  qAddCorePlugin :: String -> m ()
+
+  qGetQ :: Typeable a => m (Maybe a)
+
+  qPutQ :: Typeable a => a -> m ()
+
+  qIsExtEnabled :: Extension -> m Bool
+  qExtsEnabled :: m [Extension]
+
+  qPutDoc :: DocLoc -> String -> m ()
+  qGetDoc :: DocLoc -> m (Maybe String)
+
+-----------------------------------------------------
+--      The IO instance of Quasi
+--
+--  This instance is used only when running a Q
+--  computation in the IO monad, usually just to
+--  print the result.  There is no interesting
+--  type environment, so reification isn't going to
+--  work.
+--
+-----------------------------------------------------
+
+instance Quasi IO where
+  qNewName = newNameIO
+
+  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+
+  qLookupName _ _       = badIO "lookupName"
+  qReify _              = badIO "reify"
+  qReifyFixity _        = badIO "reifyFixity"
+  qReifyType _          = badIO "reifyFixity"
+  qReifyInstances _ _   = badIO "reifyInstances"
+  qReifyRoles _         = badIO "reifyRoles"
+  qReifyAnnotations _   = badIO "reifyAnnotations"
+  qReifyModule _        = badIO "reifyModule"
+  qReifyConStrictness _ = badIO "reifyConStrictness"
+  qLocation             = badIO "currentLocation"
+  qRecover _ _          = badIO "recover" -- Maybe we could fix this?
+  qGetPackageRoot       = badIO "getProjectRoot"
+  qAddDependentFile _   = badIO "addDependentFile"
+  qAddTempFile _        = badIO "addTempFile"
+  qAddTopDecls _        = badIO "addTopDecls"
+  qAddForeignFilePath _ _ = badIO "addForeignFilePath"
+  qAddModFinalizer _    = badIO "addModFinalizer"
+  qAddCorePlugin _      = badIO "addCorePlugin"
+  qGetQ                 = badIO "getQ"
+  qPutQ _               = badIO "putQ"
+  qIsExtEnabled _       = badIO "isExtEnabled"
+  qExtsEnabled          = badIO "extsEnabled"
+  qPutDoc _ _           = badIO "putDoc"
+  qGetDoc _             = badIO "getDoc"
+
+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" }
+
+-- Global variable to generate unique symbols
+counter :: IORef Uniq
+{-# NOINLINE counter #-}
+counter = unsafePerformIO (newIORef 0)
+
+
+-----------------------------------------------------
+--
+--              The Q monad
+--
+-----------------------------------------------------
+
+newtype Q a = Q { unQ :: forall m. Quasi m => m a }
+
+-- \"Runs\" the 'Q' monad. Normal users of Template Haskell
+-- should not need this function, as the splice brackets @$( ... )@
+-- are the usual way of running a 'Q' computation.
+--
+-- This function is primarily used in GHC internals, and for debugging
+-- splices by running them in 'IO'.
+--
+-- Note that many functions in 'Q', such as 'reify' and other compiler
+-- queries, are not supported when running 'Q' in 'IO'; these operations
+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
+runQ :: Quasi m => Q a -> m a
+runQ (Q m) = m
+
+instance Monad Q where
+  Q m >>= k  = Q (m >>= \x -> unQ (k x))
+  (>>) = (*>)
+
+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)
+
+instance Applicative Q where
+  pure x = Q (pure x)
+  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
+--
+-----------------------------------------------------
+
+type TExp :: TYPE r -> Kind.Type
+type role TExp nominal   -- See Note [Role of TExp]
+newtype TExp a = TExp
+  { unType :: Exp -- ^ Underlying untyped Template Haskell expression
+  }
+-- ^ Typed wrapper around an 'Exp'.
+--
+-- This is the typed representation of terms produced by typed quotes.
+--
+-- Representation-polymorphic since /template-haskell-2.16.0.0/.
+
+-- | Discard the type annotation and produce a plain Template Haskell
+-- expression
+--
+-- Representation-polymorphic since /template-haskell-2.16.0.0/.
+unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
+unTypeQ m = do { TExp e <- m
+               ; return e }
+
+-- | Annotate the Template Haskell expression with a type
+--
+-- This is unsafe because GHC cannot check for you that the expression
+-- really does have the type you claim it has.
+--
+-- Representation-polymorphic since /template-haskell-2.16.0.0/.
+unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> m (TExp a)
+unsafeTExpCoerce m = do { e <- m
+                        ; return (TExp e) }
+
+{- Note [Role of TExp]
+~~~~~~~~~~~~~~~~~~~~~~
+TExp's argument must have a nominal role, not phantom as would
+be inferred (#8459).  Consider
+
+  e :: Code Q Age
+  e = [|| MkAge 3 ||]
+
+  foo = $(coerce e) + 4::Int
+
+The splice will evaluate to (MkAge 3) and you can't add that to
+4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}
+
+-- Code constructor
+#if __GLASGOW_HASKELL__ >= 909
+type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
+  -- See Note [Foralls to the right in Code]
+#else
+type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
+#endif
+type role Code representational nominal   -- See Note [Role of TExp]
+newtype Code m a = Code
+  { examineCode :: m (TExp a) -- ^ Underlying monadic value
+  }
+-- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed
+-- expressions allow for type-safe splicing via:
+--
+--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
+--     that expression has type @a@, then the quotation has type
+--     @Quote m => Code m a@
+--
+--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@
+--     is an arbitrary expression of type @Quote m => Code m a@
+--
+-- Traditional expression quotes and splices let us construct ill-typed
+-- expressions:
+--
+-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
+-- GHC.Types.True GHC.Classes.== "foo"
+-- >>> GHC.Types.True GHC.Classes.== "foo"
+-- <interactive> error:
+--     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
+--     • In the second argument of ‘(==)’, namely ‘"foo"’
+--       In the expression: True == "foo"
+--       In an equation for ‘it’: it = True == "foo"
+--
+-- With typed expressions, the type error occurs when /constructing/ the
+-- Template Haskell expression:
+--
+-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
+-- <interactive> error:
+--     • Couldn't match type ‘[Char]’ with ‘Bool’
+--       Expected type: Code Q Bool
+--         Actual type: Code Q [Char]
+--     • In the Template Haskell quotation [|| "foo" ||]
+--       In the expression: [|| "foo" ||]
+--       In the Template Haskell splice $$([|| "foo" ||])
+
+
+{- Note [Foralls to the right in Code]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Code has the following type signature:
+   type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
+
+This allows us to write
+   data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)
+
+   tcodeq :: T (Code Q)
+   tcodeq = MkT [||5||] [||5#||]
+
+If we used the slightly more straightforward signature
+   type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
+
+then the example above would become ill-typed.  (See #23592 for some discussion.)
+-}
+
+-- | 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)
+
+-- | 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
+
+-- | 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
+
+-- | 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)
+
+
+-- | 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)
+
+-- | 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)
+
+-- | 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
+
+----------------------------------------------------
+-- Packaged versions for the programmer, hiding the Quasi-ness
+
+
+-- | Report an error (True) or warning (False),
+-- but carry on; use 'fail' to stop.
+report  :: Bool -> String -> Q ()
+report b s = Q (qReport b s)
+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
+
+-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
+reportError :: String -> Q ()
+reportError = report True
+
+-- | Report a warning to the user, and carry on.
+reportWarning :: String -> Q ()
+reportWarning = report False
+
+-- | Recover from errors raised by 'reportError' or 'fail'.
+recover :: Q a -- ^ handler to invoke on failure
+        -> Q a -- ^ computation to run
+        -> Q a
+recover (Q r) (Q m) = Q (qRecover r m)
+
+-- We don't export lookupName; the Bool isn't a great API
+-- Instead we export lookupTypeName, lookupValueName
+lookupName :: Bool -> String -> Q (Maybe Name)
+lookupName ns s = Q (qLookupName ns s)
+
+-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
+lookupTypeName :: String -> Q (Maybe Name)
+lookupTypeName  s = Q (qLookupName True s)
+
+-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
+lookupValueName :: String -> Q (Maybe Name)
+lookupValueName s = Q (qLookupName False s)
+
+{-
+Note [Name lookup]
+~~~~~~~~~~~~~~~~~~
+-}
+{- $namelookup #namelookup#
+The functions 'lookupTypeName' and 'lookupValueName' provide
+a way to query the current splice's context for what names
+are in scope. The function 'lookupTypeName' queries the type
+namespace, whereas 'lookupValueName' queries the value namespace,
+but the functions are otherwise identical.
+
+A call @lookupValueName s@ will check if there is a value
+with name @s@ in scope at the current splice's location. If
+there is, the @Name@ of this value is returned;
+if not, then @Nothing@ is returned.
+
+The returned name cannot be \"captured\".
+For example:
+
+> f = "global"
+> g = $( do
+>          Just nm <- lookupValueName "f"
+>          [| let f = "local" in $( varE nm ) |]
+
+In this case, @g = \"global\"@; the call to @lookupValueName@
+returned the global @f@, and this name was /not/ captured by
+the local definition of @f@.
+
+The lookup is performed in the context of the /top-level/ splice
+being run. For example:
+
+> f = "global"
+> g = $( [| let f = "local" in
+>            $(do
+>                Just nm <- lookupValueName "f"
+>                varE nm
+>             ) |] )
+
+Again in this example, @g = \"global\"@, because the call to
+@lookupValueName@ queries the context of the outer-most @$(...)@.
+
+Operators should be queried without any surrounding parentheses, like so:
+
+> lookupValueName "+"
+
+Qualified names are also supported, like so:
+
+> lookupValueName "Prelude.+"
+> lookupValueName "Prelude.map"
+
+-}
+
+
+{- | 'reify' looks up information about the 'Name'. It will fail with
+a compile error if the 'Name' is not visible. A 'Name' is visible if it is
+imported or defined in a prior top-level declaration group. See the
+documentation for 'newDeclarationGroup' for more details.
+
+It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
+to ensure that we are reifying from the right namespace. For instance, in this context:
+
+> data D = D
+
+which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
+To ensure we get information about @D@-the-value, use 'lookupValueName':
+
+> do
+>   Just nm <- lookupValueName "D"
+>   reify nm
+
+and to get information about @D@-the-type, use 'lookupTypeName'.
+-}
+reify :: Name -> Q Info
+reify v = Q (qReify v)
+
+{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For
+example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then
+@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function
+@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns
+'Nothing', so you may assume @bar@ has 'defaultFixity'.
+-}
+reifyFixity :: Name -> Q (Maybe Fixity)
+reifyFixity nm = Q (qReifyFixity nm)
+
+{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,
+@reifyType 'not@   returns @Bool -> Bool@, and
+@reifyType ''Bool@ returns @Type@.
+This works even if there's no explicit signature and the type or kind is inferred.
+-}
+reifyType :: Name -> Q Type
+reifyType nm = Q (qReifyType nm)
+
+{- | Template Haskell is capable of reifying information about types and
+terms defined in previous declaration groups. Top-level declaration splices break up
+declaration groups.
+
+For an example, consider this  code block. We define a datatype @X@ and
+then try to call 'reify' on the datatype.
+
+@
+module Check where
+
+data X = X
+    deriving Eq
+
+$(do
+    info <- reify ''X
+    runIO $ print info
+ )
+@
+
+This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:
+
+@
+data X = X
+    deriving Eq
+
+$(pure [])
+
+$(do
+    info <- reify ''X
+    runIO $ print info
+ )
+@
+
+We provide 'newDeclarationGroup' as a means of documenting this behavior
+and providing a name for the pattern.
+
+Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:
+
+@
+data X = X
+    deriving Eq
+
+newDeclarationGroup
+
+$(do
+    info <- reify ''X
+    runIO $ print info
+ )
+@
+
+-}
+newDeclarationGroup :: Q [Dec]
+newDeclarationGroup = pure []
+
+{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")
+of @nm tys@. That is,
+if @nm@ is the name of a type class, then all instances of this class at the types @tys@
+are returned. Alternatively, if @nm@ is the name of a data family or type family,
+all instances of this family at the types @tys@ are returned.
+
+Note that this is a \"shallow\" test; the declarations returned merely have
+instance heads which unify with @nm tys@, they need not actually be satisfiable.
+
+  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains
+    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and
+    @B@ themselves implement 'Eq'
+
+  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available
+    instance of 'Show'
+
+There is one edge case: @reifyInstances ''Typeable tys@ currently always
+produces an empty list (no matter what @tys@ are given).
+
+In principle, the *visible* instances are
+* all instances defined in a prior top-level declaration group
+  (see docs on @newDeclarationGroup@), or
+* all instances defined in any module transitively imported by the
+  module being compiled
+
+However, actually searching all modules transitively below the one being
+compiled is unreasonably expensive, so @reifyInstances@ will report only the
+instance for modules that GHC has had some cause to visit during this
+compilation.  This is a shortcoming: @reifyInstances@ might fail to report
+instances for a type that is otherwise unusued, or instances defined in a
+different component.  You can work around this shortcoming by explicitly importing the modules
+whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>
+has some discussion around this.
+
+-}
+reifyInstances :: Name -> [Type] -> Q [InstanceDec]
+reifyInstances cls tys = Q (qReifyInstances cls tys)
+
+{- | @reifyRoles nm@ returns the list of roles associated with the parameters
+(both visible and invisible) of
+the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
+The returned list should never contain 'InferR'.
+
+An invisible parameter to a tycon is often a kind parameter. For example, if
+we have
+
+@
+type Proxy :: forall k. k -> Type
+data Proxy a = MkProxy
+@
+
+and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is
+the role of the invisible @k@ parameter. Kind parameters are always nominal.
+-}
+reifyRoles :: Name -> Q [Role]
+reifyRoles nm = Q (qReifyRoles nm)
+
+-- | @reifyAnnotations target@ returns the list of annotations
+-- associated with @target@.  Only the annotations that are
+-- appropriately typed is returned.  So if you have @Int@ and @String@
+-- annotations for the same target, you have to call this function twice.
+reifyAnnotations :: Data a => AnnLookup -> Q [a]
+reifyAnnotations an = Q (qReifyAnnotations an)
+
+-- | @reifyModule mod@ looks up information about module @mod@.  To
+-- look up the current module, call this function with the return
+-- value of 'Language.Haskell.TH.Lib.thisModule'.
+reifyModule :: Module -> Q ModuleInfo
+reifyModule m = Q (qReifyModule m)
+
+-- | @reifyConStrictness nm@ looks up the strictness information for the fields
+-- of the constructor with the name @nm@. Note that the strictness information
+-- that 'reifyConStrictness' returns may not correspond to what is written in
+-- the source code. For example, in the following data declaration:
+--
+-- @
+-- data Pair a = Pair a a
+-- @
+--
+-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most
+-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
+-- @-XStrictData@ language extension was enabled.
+reifyConStrictness :: Name -> Q [DecidedStrictness]
+reifyConStrictness n = Q (qReifyConStrictness n)
+
+-- | Is the list of instances returned by 'reifyInstances' nonempty?
+--
+-- If you're confused by an instance not being visible despite being
+-- defined in the same module and above the splice in question, see the
+-- docs for 'newDeclarationGroup' for a possible explanation.
+isInstance :: Name -> [Type] -> Q Bool
+isInstance nm tys = do { decs <- reifyInstances nm tys
+                       ; return (not (null decs)) }
+
+-- | The location at which this computation is spliced.
+location :: Q Loc
+location = Q qLocation
+
+-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
+-- Take care: you are guaranteed the ordering of calls to 'runIO' within
+-- a single 'Q' computation, but not about the order in which splices are run.
+--
+-- Note: for various murky reasons, stdout and stderr handles are not
+-- necessarily flushed when the compiler finishes running, so you should
+-- flush them yourself.
+runIO :: IO a -> Q a
+runIO m = Q (qRunIO m)
+
+-- | Get the package root for the current package which is being compiled.
+-- This can be set explicitly with the -package-root flag but is normally
+-- just the current working directory.
+--
+-- The motivation for this flag is to provide a principled means to remove the
+-- assumption from splices that they will be executed in the directory where the
+-- cabal file resides. Projects such as haskell-language-server can't and don't
+-- change directory when compiling files but instead set the -package-root flag
+-- appropriately.
+getPackageRoot :: Q FilePath
+getPackageRoot = Q qGetPackageRoot
+
+-- | The input is a filepath, which if relative is offset by the package root.
+makeRelativeToProject :: FilePath -> Q FilePath
+makeRelativeToProject fp | isRelative fp = do
+  root <- getPackageRoot
+  return (root </> fp)
+makeRelativeToProject fp = return fp
+
+
+
+-- | Record external files that runIO is using (dependent upon).
+-- The compiler can then recognize that it should re-compile the Haskell file
+-- when an external file changes.
+--
+-- Expects an absolute file path.
+--
+-- Notes:
+--
+--   * ghc -M does not know about these dependencies - it does not execute TH.
+--
+--   * The dependency is based on file content, not a modification time
+addDependentFile :: FilePath -> Q ()
+addDependentFile fp = Q (qAddDependentFile fp)
+
+-- | Obtain a temporary file path with the given suffix. The compiler will
+-- delete this file after compilation.
+addTempFile :: String -> Q FilePath
+addTempFile suffix = Q (qAddTempFile suffix)
+
+-- | Add additional top-level declarations. The added declarations will be type
+-- checked along with the current declaration group.
+addTopDecls :: [Dec] -> Q ()
+addTopDecls ds = Q (qAddTopDecls ds)
+
+-- |
+addForeignFile :: ForeignSrcLang -> String -> Q ()
+addForeignFile = addForeignSource
+{-# DEPRECATED addForeignFile
+               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"
+  #-} -- deprecated in 8.6
+
+-- | Emit a foreign file which will be compiled and linked to the object for
+-- the current module. Currently only languages that can be compiled with
+-- the C compiler are supported, and the flags passed as part of -optc will
+-- be also applied to the C compiler invocation that will compile them.
+--
+-- Note that for non-C languages (for example C++) @extern "C"@ directives
+-- must be used to get symbols that we can access from Haskell.
+--
+-- To get better errors, it is recommended to use #line pragmas when
+-- emitting C files, e.g.
+--
+-- > {-# LANGUAGE CPP #-}
+-- > ...
+-- > addForeignSource LangC $ unlines
+-- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
+-- >   , ...
+-- >   ]
+addForeignSource :: ForeignSrcLang -> String -> Q ()
+addForeignSource lang src = do
+  let suffix = case lang of
+                 LangC      -> "c"
+                 LangCxx    -> "cpp"
+                 LangObjc   -> "m"
+                 LangObjcxx -> "mm"
+                 LangAsm    -> "s"
+                 LangJs     -> "js"
+                 RawObject  -> "a"
+  path <- addTempFile suffix
+  runIO $ writeFile path src
+  addForeignFilePath lang path
+
+-- | Same as 'addForeignSource', but expects to receive a path pointing to the
+-- foreign file instead of a 'String' of its contents. Consider using this in
+-- conjunction with 'addTempFile'.
+--
+-- This is a good alternative to 'addForeignSource' when you are trying to
+-- directly link in an object file.
+addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
+addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)
+
+-- | Add a finalizer that will run in the Q monad after the current module has
+-- been type checked. This only makes sense when run within a top-level splice.
+--
+-- The finalizer is given the local type environment at the splice point. Thus
+-- 'reify' is able to find the local definitions when executed inside the
+-- finalizer.
+addModFinalizer :: Q () -> Q ()
+addModFinalizer act = Q (qAddModFinalizer (unQ act))
+
+-- | Adds a core plugin to the compilation pipeline.
+--
+-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc
+-- in the command line. The major difference is that the plugin module @m@
+-- must not belong to the current package. When TH executes, it is too late
+-- to tell the compiler that we needed to compile first a plugin module in the
+-- current package.
+addCorePlugin :: String -> Q ()
+addCorePlugin plugin = Q (qAddCorePlugin plugin)
+
+-- | Get state from the 'Q' monad. Note that the state is local to the
+-- Haskell module in which the Template Haskell expression is executed.
+getQ :: Typeable a => Q (Maybe a)
+getQ = Q qGetQ
+
+-- | Replace the state in the 'Q' monad. Note that the state is local to the
+-- Haskell module in which the Template Haskell expression is executed.
+putQ :: Typeable a => a -> Q ()
+putQ x = Q (qPutQ x)
+
+-- | Determine whether the given language extension is enabled in the 'Q' monad.
+isExtEnabled :: Extension -> Q Bool
+isExtEnabled ext = Q (qIsExtEnabled ext)
+
+-- | List all enabled language extensions.
+extsEnabled :: Q [Extension]
+extsEnabled = Q qExtsEnabled
+
+-- | Add Haddock documentation to the specified location. This will overwrite
+-- any documentation at the location if it already exists. This will reify the
+-- specified name, so it must be in scope when you call it. If you want to add
+-- documentation to something that you are currently splicing, you can use
+-- 'addModFinalizer' e.g.
+--
+-- > do
+-- >   let nm = mkName "x"
+-- >   addModFinalizer $ putDoc (DeclDoc nm) "Hello"
+-- >   [d| $(varP nm) = 42 |]
+--
+-- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as
+-- will the 'funD_doc' and other @_doc@ combinators.
+-- You most likely want to have the @-haddock@ flag turned on when using this.
+-- Adding documentation to anything outside of the current module will cause an
+-- error.
+putDoc :: DocLoc -> String -> Q ()
+putDoc t s = Q (qPutDoc t s)
+
+-- | Retrieves the Haddock documentation at the specified location, if one
+-- exists.
+-- It can be used to read documentation on things defined outside of the current
+-- module, provided that those modules were compiled with the @-haddock@ flag.
+getDoc :: DocLoc -> Q (Maybe String)
+getDoc n = Q (qGetDoc n)
+
+instance MonadIO Q where
+  liftIO = runIO
+
+instance Quasi Q where
+  qNewName            = newName
+  qReport             = report
+  qRecover            = recover
+  qReify              = reify
+  qReifyFixity        = reifyFixity
+  qReifyType          = reifyType
+  qReifyInstances     = reifyInstances
+  qReifyRoles         = reifyRoles
+  qReifyAnnotations   = reifyAnnotations
+  qReifyModule        = reifyModule
+  qReifyConStrictness = reifyConStrictness
+  qLookupName         = lookupName
+  qLocation           = location
+  qGetPackageRoot     = getPackageRoot
+  qAddDependentFile   = addDependentFile
+  qAddTempFile        = addTempFile
+  qAddTopDecls        = addTopDecls
+  qAddForeignFilePath = addForeignFilePath
+  qAddModFinalizer    = addModFinalizer
+  qAddCorePlugin      = addCorePlugin
+  qGetQ               = getQ
+  qPutQ               = putQ
+  qIsExtEnabled       = isExtEnabled
+  qExtsEnabled        = extsEnabled
+  qPutDoc             = putDoc
+  qGetDoc             = getDoc
+
+
+----------------------------------------------------
+-- 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 :: forall m . Monad m => forall a . [m a] -> m [a]
+sequenceQ = sequence
+
+
+-----------------------------------------------------
+--
+--              The Lift class
+--
+-----------------------------------------------------
+
+-- | A 'Lift' instance can have any of its values turned into a Template
+-- Haskell expression. This is needed when a value used within a Template
+-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or
+-- @[|| ... ||]@) but not at the top level. As an example:
+--
+-- > add1 :: Int -> Code Q Int
+-- > add1 x = [|| x + 1 ||]
+--
+-- Template Haskell has no way of knowing what value @x@ will take on at
+-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.
+--
+-- A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@
+-- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices.
+-- It is additionally expected that @'lift' x ≡ 'unTypeCode' ('liftTyped' x)@.
+--
+-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@
+-- GHC language extension:
+--
+-- > {-# LANGUAGE DeriveLift #-}
+-- > module Foo where
+-- >
+-- > import Language.Haskell.TH.Syntax
+-- >
+-- > data Bar a = Bar1 a (Bar a) | Bar2 String
+-- >   deriving Lift
+--
+-- Representation-polymorphic since /template-haskell-2.16.0.0/.
+class Lift (t :: TYPE r) where
+  -- | Turn a value into a Template Haskell expression, suitable for use in
+  -- a splice.
+  lift :: Quote m => t -> m Exp
+  default lift :: (r ~ ('BoxedRep 'Lifted), 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 :: Quote m => t -> Code m t
+
+
+-- See Note [Bootstrapping Template Haskell]
+#ifndef BOOTSTRAP_TH
+-- If you add any instances here, consider updating test th/TH_Lift
+instance Lift Integer where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL x))
+
+instance Lift Int where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+-- | @since 2.16.0.0
+instance Lift Int# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntPrimL (fromIntegral (I# x))))
+
+instance Lift Int8 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int16 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int32 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int64 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+-- | @since 2.16.0.0
+instance Lift Word# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (WordPrimL (fromIntegral (W# x))))
+
+instance Lift Word where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word8 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word16 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word32 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word64 where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Natural where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift (Fixed.Fixed a) where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift (Fixed.MkFixed x) = do
+    ex <- lift x
+    return (ConE mkFixedName `AppE` ex)
+    where
+      mkFixedName = 'Fixed.MkFixed
+
+instance Integral a => Lift (Ratio a) where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (RationalL (toRational x)))
+
+instance Lift Float where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (RationalL (toRational x)))
+
+-- | @since 2.16.0.0
+instance Lift Float# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (FloatPrimL (toRational (F# x))))
+
+instance Lift Double where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (RationalL (toRational x)))
+
+-- | @since 2.16.0.0
+instance Lift Double# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (DoublePrimL (toRational (D# x))))
+
+instance Lift Char where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (CharL x))
+
+-- | @since 2.16.0.0
+instance Lift Char# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x = return (LitE (CharPrimL (C# x)))
+
+instance Lift Bool where
+  liftTyped x = unsafeCodeCoerce (lift x)
+
+  lift True  = return (ConE trueName)
+  lift False = return (ConE falseName)
+
+-- | Produces an 'Addr#' literal from the NUL-terminated C-string starting at
+-- the given memory address.
+--
+-- @since 2.16.0.0
+instance Lift Addr# where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x
+    = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
+
+-- |
+-- @since 2.19.0.0
+instance Lift ByteArray where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift (ByteArray b) = return
+    (AppE (AppE (VarE addrToByteArrayName) (LitE (IntegerL (fromIntegral len))))
+      (LitE (BytesPrimL (Bytes ptr 0 (fromIntegral len)))))
+    where
+      len# = sizeofByteArray# b
+      len = I# len#
+      pb :: ByteArray#
+      !(ByteArray pb)
+        | isTrue# (isByteArrayPinned# b) = ByteArray b
+        | otherwise = runST $ ST $
+          \s -> case newPinnedByteArray# len# s of
+            (# s', mb #) -> case copyByteArray# b 0# mb 0# len# s' of
+              s'' -> case unsafeFreezeByteArray# mb s'' of
+                (# s''', ret #) -> (# s''', ByteArray ret #)
+      ptr :: ForeignPtr Word8
+      ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))
+
+addrToByteArrayName :: Name
+addrToByteArrayName = 'addrToByteArray
+
+addrToByteArray :: Int -> Addr# -> ByteArray
+addrToByteArray (I# len) addr = runST $ ST $
+  \s -> case newByteArray# len s of
+    (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of
+      s'' -> case unsafeFreezeByteArray# mb s'' of
+        (# s''', ret #) -> (# s''', ByteArray ret #)
+
+instance Lift a => Lift (Maybe a) where
+  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 = 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 = unsafeCodeCoerce (lift x)
+  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
+
+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 = unsafeCodeCoerce (lift x)
+
+  lift (x :| xs) = do
+    x' <- lift x
+    xs' <- lift xs
+    return (InfixE (Just x') (ConE nonemptyName) (Just xs'))
+
+-- | @since 2.15.0.0
+instance Lift Void where
+  liftTyped = liftCode . absurd
+  lift = pure . absurd
+
+instance Lift () where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift () = return (ConE (tupleDataName 0))
+
+instance (Lift a, Lift b) => Lift (a, b) where
+  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 = 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 = 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 = 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 = 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 = 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 = unsafeCodeCoerce (lift x)
+  lift (# #) = return (ConE (unboxedTupleTypeName 0))
+
+-- | @since 2.16.0.0
+instance (Lift a) => Lift (# a #) where
+  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 = 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 = 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 = unsafeCodeCoerce (lift x)
+  lift (# a, b, c, d #)
+    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
+                                                     , lift c, lift d ]
+
+-- | @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 = 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 ]
+
+-- | @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 = 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 ]
+
+-- | @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 = 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
+                                                     , lift g ]
+
+-- | @since 2.16.0.0
+instance (Lift a, Lift b) => Lift (# a | b #) where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
+        (# | y #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 2
+
+-- | @since 2.16.0.0
+instance (Lift a, Lift b, Lift c)
+      => Lift (# a | b | c #) where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
+        (# | y | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 3
+        (# | | y #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 3
+
+-- | @since 2.16.0.0
+instance (Lift a, Lift b, Lift c, Lift d)
+      => Lift (# a | b | c | d #) where
+  liftTyped x = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
+        (# | y | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 4
+        (# | | y | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 4
+        (# | | | y #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 4
+
+-- | @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 = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
+        (# | y | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 5
+        (# | | y | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 5
+        (# | | | y | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 5
+        (# | | | | y #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 5
+
+-- | @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 = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
+        (# | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 6
+        (# | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 6
+        (# | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 6
+        (# | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 6
+        (# | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 6
+
+-- | @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 = unsafeCodeCoerce (lift x)
+  lift x
+    = case x of
+        (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7
+        (# | y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 7
+        (# | | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 7
+        (# | | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 7
+        (# | | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 7
+        (# | | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 7
+        (# | | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 7 <*> pure 7
+
+-- TH has a special form for literal strings,
+-- which we should take advantage of.
+-- NB: the lhs of the rule has no args, so that
+--     the rule will apply to a 'lift' all on its own
+--     which happens to be the way the type checker
+--     creates it.
+{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
+
+
+trueName, falseName :: Name
+trueName  = 'True
+falseName = 'False
+
+nothingName, justName :: Name
+nothingName = 'Nothing
+justName    = 'Just
+
+leftName, rightName :: Name
+leftName  = 'Left
+rightName = 'Right
+
+nonemptyName :: Name
+nonemptyName = '(:|)
+#endif
+
+oneName, manyName :: Name
+oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"
+manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"
+
+-----------------------------------------------------
+--
+--              Generic Lift implementations
+--
+-----------------------------------------------------
+
+-- | 'dataToQa' is an internal utility function for constructing generic
+-- conversion functions from types with 'Data' instances to various
+-- quasi-quoting representations.  See the source of 'dataToExpQ' and
+-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@
+-- and @appQ@ are overloadable to account for different syntax for
+-- 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 m a k q. (Quote m, Data a)
+          =>  (Name -> k)
+          ->  (Lit -> m q)
+          ->  (k -> [m q] -> m q)
+          ->  (forall b . Data b => b -> Maybe (m q))
+          ->  a
+          ->  m q
+dataToQa mkCon mkLit appCon antiQ t =
+    case antiQ t of
+      Nothing ->
+          case constrRep constr of
+            AlgConstr _ ->
+                appCon (mkCon funOrConName) conArgs
+              where
+                funOrConName :: Name
+                funOrConName =
+                    case showConstr constr of
+                      "(:)"       -> Name (mkOccName ":")
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Types"))
+                      con@"[]"    -> Name (mkOccName con)
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Types"))
+                      con@('(':_) -> Name (mkOccName con)
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Tuple"))
+
+                      -- Tricky case: see Note [Data for non-algebraic types]
+                      fun@(x:_)   | startsVarSym x || startsVarId x
+                                  -> mkNameG_v tyconPkg tyconMod fun
+                      con         -> mkNameG_d tyconPkg tyconMod con
+
+                  where
+                    tycon :: TyCon
+                    tycon = (typeRepTyCon . typeOf) t
+
+                    tyconPkg, tyconMod :: String
+                    tyconPkg = tyConPackage tycon
+                    tyconMod = tyConModule  tycon
+
+                conArgs :: [m q]
+                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
+            IntConstr n ->
+                mkLit $ IntegerL n
+            FloatConstr n ->
+                mkLit $ RationalL n
+            CharConstr c ->
+                mkLit $ CharL c
+        where
+          constr :: Constr
+          constr = toConstr t
+
+      Just y -> y
+
+
+{- Note [Data for non-algebraic types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Class Data was originally intended for algebraic data types.  But
+it is possible to use it for abstract types too.  For example, in
+package `text` we find
+
+  instance Data Text where
+    ...
+    toConstr _ = packConstr
+
+  packConstr :: Constr
+  packConstr = mkConstr textDataType "pack" [] Prefix
+
+Here `packConstr` isn't a real data constructor, it's an ordinary
+function.  Two complications
+
+* In such a case, we must take care to build the Name using
+  mkNameG_v (for values), not mkNameG_d (for data constructors).
+  See #10796.
+
+* The pseudo-constructor is named only by its string, here "pack".
+  But 'dataToQa' needs the TyCon of its defining module, and has
+  to assume it's defined in the same module as the TyCon itself.
+  But nothing enforces that; #12596 shows what goes wrong if
+  "pack" is defined in a different module than the data type "Text".
+  -}
+
+-- | '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  ::  (Quote m, Data a)
+            =>  (forall b . Data b => b -> Maybe (m Exp))
+            ->  a
+            ->  m Exp
+dataToExpQ = dataToQa varOrConE litE (foldl appE)
+    where
+          -- Make sure that VarE is used if the Constr value relies on a
+          -- function underneath the surface (instead of a constructor).
+          -- See #10796.
+          varOrConE s =
+            case nameSpace s of
+                 Just VarName      -> return (VarE s)
+                 Just (FldName {}) -> return (VarE s)
+                 Just DataName     -> return (ConE 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 :: (Quote m, Data a) => a -> m Exp
+liftData = dataToExpQ (const Nothing)
+
+-- | '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  ::  (Quote m, Data a)
+            =>  (forall b . Data b => b -> Maybe (m Pat))
+            ->  a
+            ->  m Pat
+dataToPatQ = dataToQa id litP conP
+    where litP l = return (LitP l)
+          conP n ps =
+            case nameSpace n of
+                Just DataName -> do
+                    ps' <- sequence ps
+                    return (ConP n [] ps')
+                _ -> error $ "Can't construct a pattern from name "
+                          ++ showName n
+
+-----------------------------------------------------
+--              Names and uniques
+-----------------------------------------------------
+
+newtype ModName = ModName String        -- Module name
+ deriving (Show,Eq,Ord,Data,Generic)
+
+newtype PkgName = PkgName String        -- package name
+ deriving (Show,Eq,Ord,Data,Generic)
+
+-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.
+data Module = Module PkgName ModName -- package qualified module name
+ deriving (Show,Eq,Ord,Data,Generic)
+
+newtype OccName = OccName String
+ deriving (Show,Eq,Ord,Data,Generic)
+
+mkModName :: String -> ModName
+mkModName s = ModName s
+
+modString :: ModName -> String
+modString (ModName m) = m
+
+
+mkPkgName :: String -> PkgName
+mkPkgName s = PkgName s
+
+pkgString :: PkgName -> String
+pkgString (PkgName m) = m
+
+
+-----------------------------------------------------
+--              OccName
+-----------------------------------------------------
+
+mkOccName :: String -> OccName
+mkOccName s = OccName s
+
+occString :: OccName -> String
+occString (OccName occ) = occ
+
+
+-----------------------------------------------------
+--               Names
+-----------------------------------------------------
+--
+-- For "global" names ('NameG') we need a totally unique name,
+-- so we must include the name-space of the thing
+--
+-- For unique-numbered things ('NameU'), we've got a unique reference
+-- anyway, so no need for name space
+--
+-- For dynamically bound thing ('NameS') we probably want them to
+-- in a context-dependent way, so again we don't want the name
+-- space.  For example:
+--
+-- > let v = mkName "T" in [| data $v = $v |]
+--
+-- Here we use the same Name for both type constructor and data constructor
+--
+--
+-- NameL and NameG are bound *outside* the TH syntax tree
+-- either globally (NameG) or locally (NameL). Ex:
+--
+-- > f x = $(h [| (map, x) |])
+--
+-- The 'map' will be a NameG, and 'x' wil be a NameL
+--
+-- These Names should never appear in a binding position in a TH syntax tree
+
+{- $namecapture #namecapture#
+Much of 'Name' API is concerned with the problem of /name capture/, which
+can be seen in the following example.
+
+> f expr = [| let x = 0 in $expr |]
+> ...
+> g x = $( f [| x |] )
+> h y = $( f [| y |] )
+
+A naive desugaring of this would yield:
+
+> g x = let x = 0 in x
+> h y = let x = 0 in y
+
+All of a sudden, @g@ and @h@ have different meanings! In this case,
+we say that the @x@ in the RHS of @g@ has been /captured/
+by the binding of @x@ in @f@.
+
+What we actually want is for the @x@ in @f@ to be distinct from the
+@x@ in @g@, so we get the following desugaring:
+
+> g x = let x' = 0 in x
+> h y = let x' = 0 in y
+
+which avoids name capture as desired.
+
+In the general case, we say that a @Name@ can be captured if
+the thing it refers to can be changed by adding new declarations.
+-}
+
+{- |
+An abstract type representing names in the syntax tree.
+
+'Name's can be constructed in several ways, which come with different
+name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
+an explanation of name capture):
+
+  * the built-in syntax @'f@ and @''T@ can be used to construct names,
+    The expression @'f@ gives a @Name@ which refers to the value @f@
+    currently in scope, and @''T@ gives a @Name@ which refers to the
+    type @T@ currently in scope. These names can never be captured.
+
+  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
+     @''T@ respectively, but the @Name@s are looked up at the point
+     where the current splice is being run. These names can never be
+     captured.
+
+  * 'newName' monadically generates a new name, which can never
+     be captured.
+
+  * 'mkName' generates a capturable name.
+
+Names constructed using @newName@ and @mkName@ may be used in bindings
+(such as @let x = ...@ or @\x -> ...@), but names constructed using
+@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
+-}
+data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)
+
+instance Ord Name where
+    -- check if unique is different before looking at strings
+  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`
+                                        (o1 `compare` o2)
+
+data NameFlavour
+  = NameS           -- ^ An unqualified name; dynamically bound
+  | NameQ ModName   -- ^ A qualified name; dynamically bound
+  | NameU !Uniq     -- ^ A unique local name
+  | NameL !Uniq     -- ^ Local name bound outside of the TH AST
+  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
+                -- An original name (occurrences only, not binders)
+                -- Need the namespace too to be sure which
+                -- thing we are naming
+  deriving ( Data, Eq, Ord, Show, Generic )
+
+data NameSpace = VarName        -- ^ Variables
+               | DataName       -- ^ Data constructors
+               | TcClsName      -- ^ Type constructors and classes; Haskell has them
+                                -- in the same name space for now.
+               | FldName
+                 { fldParent :: !String
+                   -- ^ The textual name of the parent of the field.
+                   --
+                   --   - For a field of a datatype, this is the name of the first constructor
+                   --     of the datatype (regardless of whether this constructor has this field).
+                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.
+                 }
+               deriving( Eq, Ord, Show, Data, Generic )
+
+-- | @Uniq@ is used by GHC to distinguish names from each other.
+type Uniq = Integer
+
+-- | The name without its module prefix.
+--
+-- ==== __Examples__
+--
+-- >>> nameBase ''Data.Either.Either
+-- "Either"
+-- >>> nameBase (mkName "foo")
+-- "foo"
+-- >>> nameBase (mkName "Module.foo")
+-- "foo"
+nameBase :: Name -> String
+nameBase (Name occ _) = occString occ
+
+-- | Module prefix of a name, if it exists.
+--
+-- ==== __Examples__
+--
+-- >>> nameModule ''Data.Either.Either
+-- Just "Data.Either"
+-- >>> nameModule (mkName "foo")
+-- Nothing
+-- >>> nameModule (mkName "Module.foo")
+-- Just "Module"
+nameModule :: Name -> Maybe String
+nameModule (Name _ (NameQ m))     = Just (modString m)
+nameModule (Name _ (NameG _ _ m)) = Just (modString m)
+nameModule _                      = Nothing
+
+-- | A name's package, if it exists.
+--
+-- ==== __Examples__
+--
+-- >>> namePackage ''Data.Either.Either
+-- Just "base"
+-- >>> namePackage (mkName "foo")
+-- Nothing
+-- >>> namePackage (mkName "Module.foo")
+-- Nothing
+namePackage :: Name -> Maybe String
+namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
+namePackage _                      = Nothing
+
+-- | Returns whether a name represents an occurrence of a top-level variable
+-- ('VarName'), data constructor ('DataName'), type constructor, or type class
+-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.
+--
+-- ==== __Examples__
+--
+-- >>> nameSpace 'Prelude.id
+-- Just VarName
+-- >>> nameSpace (mkName "id")
+-- Nothing -- only works for top-level variable names
+-- >>> nameSpace 'Data.Maybe.Just
+-- Just DataName
+-- >>> nameSpace ''Data.Maybe.Maybe
+-- Just TcClsName
+-- >>> nameSpace ''Data.Ord.Ord
+-- Just TcClsName
+nameSpace :: Name -> Maybe NameSpace
+nameSpace (Name _ (NameG ns _ _)) = Just ns
+nameSpace _                       = Nothing
+
+{- |
+Generate a capturable name. Occurrences of such names will be
+resolved according to the Haskell scoping rules at the occurrence
+site.
+
+For example:
+
+> f = [| pi + $(varE (mkName "pi")) |]
+> ...
+> g = let pi = 3 in $f
+
+In this case, @g@ is desugared to
+
+> g = Prelude.pi + 3
+
+Note that @mkName@ may be used with qualified names:
+
+> mkName "Prelude.pi"
+
+See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
+be rewritten using 'Language.Haskell.TH.Lib.dyn' as
+
+> f = [| pi + $(dyn "pi") |]
+-}
+mkName :: String -> Name
+-- The string can have a '.', thus "Foo.baz",
+-- giving a dynamically-bound qualified name,
+-- in which case we want to generate a NameQ
+--
+-- Parse the string to see if it has a "." in it
+-- so we know whether to generate a qualified or unqualified name
+-- It's a bit tricky because we need to parse
+--
+-- > Foo.Baz.x   as    Qual Foo.Baz x
+--
+-- So we parse it from back to front
+mkName str
+  = split [] (reverse str)
+  where
+    split occ []        = Name (mkOccName occ) NameS
+    split occ ('.':rev) | not (null occ)
+                        , is_rev_mod_name rev
+                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
+        -- The 'not (null occ)' guard ensures that
+        --      mkName "&." = Name "&." NameS
+        -- The 'is_rev_mod' guards ensure that
+        --      mkName ".&" = Name ".&" NameS
+        --      mkName "^.." = Name "^.." NameS      -- #8633
+        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
+        -- This rather bizarre case actually happened; (.&.) is in Data.Bits
+    split occ (c:rev)   = split (c:occ) rev
+
+    -- Recognises a reversed module name xA.yB.C,
+    -- with at least one component,
+    -- and each component looks like a module name
+    --   (i.e. non-empty, starts with capital, all alpha)
+    is_rev_mod_name rev_mod_str
+      | (compt, rest) <- break (== '.') rev_mod_str
+      , not (null compt), isUpper (last compt), all is_mod_char compt
+      = case rest of
+          []             -> True
+          (_dot : rest') -> is_rev_mod_name rest'
+      | otherwise
+      = False
+
+    is_mod_char c = isAlphaNum c || c == '_' || c == '\''
+
+-- | Only used internally
+mkNameU :: String -> Uniq -> Name
+mkNameU s u = Name (mkOccName s) (NameU u)
+
+-- | Only used internally
+mkNameL :: String -> Uniq -> Name
+mkNameL s u = Name (mkOccName s) (NameL u)
+
+-- | Only used internally
+mkNameQ :: String -> String -> Name
+mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))
+
+-- | Used for 'x etc, but not available to the programmer
+mkNameG :: NameSpace -> String -> String -> String -> Name
+mkNameG ns pkg modu occ
+  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
+
+mkNameS :: String -> Name
+mkNameS n = Name (mkOccName n) NameS
+
+mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
+mkNameG_v  = mkNameG VarName
+mkNameG_tc = mkNameG TcClsName
+mkNameG_d  = mkNameG DataName
+
+mkNameG_fld :: String -- ^ package
+            -> String -- ^ module
+            -> String -- ^ parent (first constructor of parent type)
+            -> String -- ^ field name
+            -> Name
+mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ
+
+data NameIs = Alone | Applied | Infix
+
+showName :: Name -> String
+showName = showName' Alone
+
+showName' :: NameIs -> Name -> String
+showName' ni nm
+ = case ni of
+       Alone        -> nms
+       Applied
+        | pnam      -> nms
+        | otherwise -> "(" ++ nms ++ ")"
+       Infix
+        | pnam      -> "`" ++ nms ++ "`"
+        | otherwise -> nms
+    where
+        -- For now, we make the NameQ and NameG print the same, even though
+        -- NameQ is a qualified name (so what it means depends on what the
+        -- current scope is), and NameG is an original name (so its meaning
+        -- should be independent of what's in scope.
+        -- We may well want to distinguish them in the end.
+        -- Ditto NameU and NameL
+        nms = case nm of
+          Name occ NameS          -> occString occ
+          Name occ (NameQ m)      -> modString m ++ "." ++ occString occ
+          Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
+          Name occ (NameU u)      -> occString occ ++ "_" ++ show u
+          Name occ (NameL u)      -> occString occ ++ "_" ++ show u
+
+        pnam = classify nms
+
+        -- True if we are function style, e.g. f, [], (,)
+        -- False if we are operator style, e.g. +, :+
+        classify "" = False -- shouldn't happen; . operator is handled below
+        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
+                            case dropWhile (/='.') xs of
+                                  (_:xs') -> classify xs'
+                                  []      -> True
+                        | otherwise = False
+
+instance Show Name where
+  show = showName
+
+-- Tuple data and type constructors
+-- | Tuple data constructor
+tupleDataName :: Int -> Name
+-- | Tuple type constructor
+tupleTypeName :: Int -> Name
+
+tupleDataName n = mk_tup_name n DataName  True
+tupleTypeName n = mk_tup_name n TcClsName True
+
+-- Unboxed tuple data and type constructors
+-- | Unboxed tuple data constructor
+unboxedTupleDataName :: Int -> Name
+-- | Unboxed tuple type constructor
+unboxedTupleTypeName :: Int -> Name
+
+unboxedTupleDataName n = mk_tup_name n DataName  False
+unboxedTupleTypeName n = mk_tup_name n TcClsName False
+
+mk_tup_name :: Int -> NameSpace -> Bool -> Name
+mk_tup_name n space boxed
+  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)
+  where
+    withParens thing
+      | boxed     = "("  ++ thing ++ ")"
+      | otherwise = "(#" ++ thing ++ "#)"
+    tup_occ | n == 0, space == TcClsName = if boxed then "Unit" else "Unit#"
+            | n == 1 = if boxed then solo else unboxed_solo
+            | space == TcClsName = "Tuple" ++ show n ++ if boxed then "" else "#"
+            | otherwise = withParens (replicate n_commas ',')
+    n_commas = n - 1
+    tup_mod  = mkModName (if boxed then "GHC.Tuple" else "GHC.Types")
+    solo
+      | space == DataName = "MkSolo"
+      | otherwise = "Solo"
+
+    unboxed_solo
+      | space == DataName = "(# #)"
+      | otherwise = "Solo#"
+
+-- Unboxed sum data and type constructors
+-- | Unboxed sum data constructor
+unboxedSumDataName :: SumAlt -> SumArity -> Name
+-- | Unboxed sum type constructor
+unboxedSumTypeName :: SumArity -> Name
+
+unboxedSumDataName alt arity
+  | alt > arity
+  = error $ prefix ++ "Index out of bounds." ++ debug_info
+
+  | alt <= 0
+  = error $ prefix ++ "Alt must be > 0." ++ debug_info
+
+  | arity < 2
+  = error $ prefix ++ "Arity must be >= 2." ++ debug_info
+
+  | otherwise
+  = Name (mkOccName sum_occ)
+         (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+
+  where
+    prefix     = "unboxedSumDataName: "
+    debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"
+
+    -- 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
+    nbars_after  = arity - alt
+
+unboxedSumTypeName arity
+  | arity < 2
+  = error $ "unboxedSumTypeName: Arity must be >= 2."
+         ++ " (arity: " ++ show arity ++ ")"
+
+  | otherwise
+  = Name (mkOccName sum_occ)
+         (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+
+  where
+    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types
+    sum_occ = "Sum" ++ show arity ++ "#"
+
+-----------------------------------------------------
+--              Locations
+-----------------------------------------------------
+
+data Loc
+  = Loc { loc_filename :: String
+        , loc_package  :: String
+        , loc_module   :: String
+        , loc_start    :: CharPos
+        , loc_end      :: CharPos }
+   deriving( Show, Eq, Ord, Data, Generic )
+
+type CharPos = (Int, Int)       -- ^ Line and character position
+
+
+-----------------------------------------------------
+--
+--      The Info returned by reification
+--
+-----------------------------------------------------
+
+-- | Obtained from 'reify' in the 'Q' Monad.
+data Info
+  =
+  -- | A class, with a list of its visible instances
+  ClassI
+      Dec
+      [InstanceDec]
+
+  -- | A class method
+  | ClassOpI
+       Name
+       Type
+       ParentName
+
+  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned
+  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified
+  -- declaration will never have derived instances attached to it (if you wish
+  -- to check for an instance, see 'reifyInstances').
+  | TyConI
+        Dec
+
+  -- | A type or data family, with a list of its visible instances. A closed
+  -- type family is returned with 0 instances.
+  | FamilyI
+        Dec
+        [InstanceDec]
+
+  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.
+  -- Examples: @(->)@, @Int#@.
+  | PrimTyConI
+       Name
+       Arity
+       Unlifted
+
+  -- | A data constructor
+  | DataConI
+       Name
+       Type
+       ParentName
+
+  -- | A pattern synonym
+  | PatSynI
+       Name
+       PatSynType
+
+  {- |
+  A \"value\" variable (as opposed to a type variable, see 'TyVarI').
+
+  The @Maybe Dec@ field contains @Just@ the declaration which
+  defined the variable - including the RHS of the declaration -
+  or else @Nothing@, in the case where the RHS is unavailable to
+  the compiler. At present, this value is /always/ @Nothing@:
+  returning the RHS has not yet been implemented because of
+  lack of interest.
+  -}
+  | VarI
+       Name
+       Type
+       (Maybe Dec)
+
+  {- |
+  A type variable.
+
+  The @Type@ field contains the type which underlies the variable.
+  At present, this is always @'VarT' theName@, but future changes
+  may permit refinement of this.
+  -}
+  | TyVarI      -- Scoped type variable
+        Name
+        Type    -- What it is bound to
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | Obtained from 'reifyModule' in the 'Q' Monad.
+data ModuleInfo =
+  -- | Contains the import list of the module.
+  ModuleInfo [Module]
+  deriving( Show, Eq, Ord, Data, Generic )
+
+{- |
+In 'ClassOpI' and 'DataConI', name of the parent class or type
+-}
+type ParentName = Name
+
+-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a
+-- particular data constructor. 'SumAlt's are one-indexed and should never
+-- exceed the value of its corresponding 'SumArity'. For example:
+--
+-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)
+--
+-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)
+type SumAlt = Int
+
+-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of
+-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.
+type SumArity = Int
+
+-- | In 'PrimTyConI', arity of the type constructor
+type Arity = Int
+
+-- | In 'PrimTyConI', is the type constructor unlifted?
+type Unlifted = Bool
+
+-- | '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']@)
+--
+--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
+--
+--   * 'TySynInstD'
+type InstanceDec = Dec
+
+data Fixity          = Fixity Int FixityDirection
+    deriving( Eq, Ord, Show, Data, Generic )
+data FixityDirection = InfixL | InfixR | InfixN
+    deriving( Eq, Ord, Show, Data, Generic )
+
+-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
+maxPrecedence :: Int
+maxPrecedence = (9::Int)
+
+-- | Default fixity: @infixl 9@
+defaultFixity :: Fixity
+defaultFixity = Fixity maxPrecedence InfixL
+
+
+{-
+Note [Unresolved infix]
+~~~~~~~~~~~~~~~~~~~~~~~
+-}
+{- $infix #infix#
+
+When implementing antiquotation for quasiquoters, one often wants
+to parse strings into expressions:
+
+> parse :: String -> Maybe Exp
+
+But how should we parse @a + b * c@? If we don't know the fixities of
+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
++ b) * c@.
+
+In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',
+which stand for \"unresolved infix expression/pattern/type/promoted
+constructor\", respectively. When the compiler is given a splice containing a
+tree of @UInfixE@ applications such as
+
+> UInfixE
+>   (UInfixE e1 op1 e2)
+>   op2
+>   (UInfixE e3 op3 e4)
+
+it will look up and the fixities of the relevant operators and
+reassociate the tree as necessary.
+
+  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',
+    which are of use for parsing expressions like
+
+    > (a + b * c) + d * e
+
+  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never
+    reassociated.
+
+  * The 'UInfixE' constructor doesn't support sections. Sections
+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
+    outer-most section, and use 'UInfixE' constructors for all
+    other operators:
+
+    > InfixE
+    >   Just (UInfixE ...a + b * c...)
+    >   op
+    >   Nothing
+
+    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
+    into 'Exp's differently:
+
+    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)
+    >                    -- will result in a fixity error if (+) is left-infix
+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
+    >                    -- no fixity errors
+
+  * Quoted expressions such as
+
+    > [| a * b + c |] :: Q Exp
+    > [p| a : b : c |] :: Q Pat
+    > [t| T + T |] :: Q Type
+
+    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',
+    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.
+
+-}
+
+-----------------------------------------------------
+--
+--      The main syntax data types
+--
+-----------------------------------------------------
+
+data Lit = CharL Char
+         | StringL String
+         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded
+                                -- literals. We don't have a good way to
+                                -- represent non-overloaded literals at
+                                -- the moment. Maybe that doesn't matter?
+         | RationalL Rational   -- Ditto
+         | IntPrimL Integer
+         | WordPrimL Integer
+         | FloatPrimL Rational
+         | DoublePrimL Rational
+         | StringPrimL [Word8]  -- ^ A primitive C-style string, type 'Addr#'
+         | BytesPrimL Bytes     -- ^ Some raw bytes, type 'Addr#':
+         | CharPrimL Char
+    deriving( Show, Eq, Ord, Data, Generic )
+
+    -- We could add Int, Float, Double etc, as we do in HsLit,
+    -- but that could complicate the
+    -- supposedly-simple TH.Syntax literal type
+
+-- | Raw bytes embedded into the binary.
+--
+-- Avoid using Bytes constructor directly as it is likely to change in the
+-- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.
+data Bytes = Bytes
+   { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data
+   , bytesOffset :: Word             -- ^ Offset from the pointer
+   , bytesSize   :: Word             -- ^ Number of bytes
+
+   -- Maybe someday:
+   -- , bytesAlignement  :: Word -- ^ Alignement constraint
+   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only
+   --                            --   section or not
+   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate
+   --                            --   an uninitialized region
+   }
+   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\' }@
+  | VarP Name                       -- ^ @{ x }@
+  | TupP [Pat]                      -- ^ @{ (p1,p2) }@
+  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@
+  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@
+  | ConP Name [Type] [Pat]          -- ^ @data T1 = C1 t1 t2; {C1 \@ty1 p1 p2} = e@
+  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@
+  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@
+                                    --
+                                    -- See "Language.Haskell.TH.Syntax#infix"
+  | ParensP Pat                     -- ^ @{(p)}@
+                                    --
+                                    -- See "Language.Haskell.TH.Syntax#infix"
+  | TildeP Pat                      -- ^ @{ ~p }@
+  | BangP Pat                       -- ^ @{ !p }@
+  | AsP Name Pat                    -- ^ @{ x \@ p }@
+  | WildP                           -- ^ @{ _ }@
+  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@
+  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@
+  | SigP Pat Type                   -- ^ @{ p :: t }@
+  | ViewP Exp Pat                   -- ^ @{ e -> p }@
+  | TypeP Type                      -- ^ @{ type p }@
+  | InvisP Type                     -- ^ @{ @p }@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+type FieldPat = (Name,Pat)
+
+data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
+    deriving( Show, Eq, Ord, Data, Generic )
+
+data Clause = Clause [Pat] Body [Dec]
+                                  -- ^ @f { p1 p2 = body where decs }@
+    deriving( Show, Eq, Ord, Data, Generic )
+
+data Exp
+  = VarE Name                          -- ^ @{ x }@
+  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @
+  | LitE Lit                           -- ^ @{ 5 or \'c\'}@
+  | AppE Exp Exp                       -- ^ @{ f x }@
+  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@
+
+  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
+
+    -- It's a bit gruesome to use an Exp as the operator when a Name
+    -- would suffice. Historically, Exp was used to make it easier to
+    -- distinguish between infix constructors and non-constructors.
+    -- This is a bit overkill, since one could just as well call
+    -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name.
+    -- Unfortunately, changing this design now would involve lots of
+    -- code churn for consumers of the TH API, so we continue to use
+    -- an Exp as the operator and perform an extra check during conversion
+    -- to ensure that the Exp is a constructor or a variable (#16895).
+
+  | UInfixE Exp Exp Exp                -- ^ @{x + y}@
+                                       --
+                                       -- See "Language.Haskell.TH.Syntax#infix"
+  | ParensE Exp                        -- ^ @{ (e) }@
+                                       --
+                                       -- See "Language.Haskell.TH.Syntax#infix"
+  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@
+  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@
+  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@
+  | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @
+                                       --
+                                       -- The 'Maybe' is necessary for handling
+                                       -- tuple sections.
+                                       --
+                                       -- > (1,)
+                                       --
+                                       -- translates to
+                                       --
+                                       -- > TupE [Just (LitE (IntegerL 1)),Nothing]
+
+  | UnboxedTupE [Maybe Exp]            -- ^ @{ (\# e1,e2 \#) }  @
+                                       --
+                                       -- The 'Maybe' is necessary for handling
+                                       -- tuple sections.
+                                       --
+                                       -- > (# 'c', #)
+                                       --
+                                       -- translates to
+                                       --
+                                       -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing]
+
+  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@
+  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@
+  | 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 (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
+      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
+      --
+      -- E.g. translation:
+      --
+      -- > [ f x | x <- xs ]
+      --
+      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
+
+  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@
+  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@
+  | SigE Exp Type                      -- ^ @{ e :: t }@
+  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@
+  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@
+  | StaticE Exp                        -- ^ @{ static e }@
+  | UnboundVarE Name                   -- ^ @{ _x }@
+                                       --
+                                       -- This is used for holes or unresolved
+                                       -- identifiers in AST quotes. Note that
+                                       -- it could either have a variable name
+                                       -- or constructor name.
+  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )
+  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )
+  | GetFieldE Exp String               -- ^ @{ exp.field }@ ( Overloaded Record Dot )
+  | ProjectionE (NonEmpty String)      -- ^ @(.x)@ or @(.x.y)@ (Record projections)
+  | TypedBracketE Exp                  -- ^ @[|| e ||]@
+  | TypedSpliceE Exp                   -- ^ @$$e@
+  | TypeE Type                         -- ^ @{ type t }@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+type FieldExp = (Name,Exp)
+
+-- Omitted: implicit parameters
+
+data Body
+  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2
+                                 --      | e3 = e4 }
+                                 -- where ds@
+  | NormalB Exp              -- ^ @f p { = e } where ds@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+data Guard
+  = NormalG Exp -- ^ @f x { | odd x } = x@
+  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+data Stmt
+  = BindS Pat Exp -- ^ @p <- e@
+  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@
+  | NoBindS Exp   -- ^ @e@
+  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')
+  | RecS [Stmt]   -- ^ @rec { s1; s2 }@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+data Range = FromR Exp | FromThenR Exp Exp
+           | FromToR Exp Exp | FromThenToR Exp Exp Exp
+          deriving( Show, Eq, Ord, Data, Generic )
+
+data Dec
+  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
+  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
+  | DataD Cxt Name [TyVarBndr BndrVis]
+          (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 BndrVis]
+             (Maybe Kind)         -- Kind signature
+             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)
+                                  --       deriving (Z,W Q)
+                                  --       deriving stock Eq }@
+  | TypeDataD Name [TyVarBndr BndrVis]
+          (Maybe Kind)            -- Kind signature (allowed only for GADTs)
+          [Con]                   -- ^ @{ type data T x = A x | B (T x) }@
+  | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@
+  | ClassD Cxt Name [TyVarBndr BndrVis]
+         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
+  | InstanceD (Maybe Overlap) Cxt Type [Dec]
+                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}
+                                  --        Show w => Show [w] where ds }@
+  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@
+  | KiSigD Name Kind              -- ^ @{ type TypeRep :: k -> Type }@
+  | ForeignD Foreign              -- ^ @{ foreign import ... }
+                                  --{ foreign export ... }@
+
+  | InfixD Fixity NamespaceSpecifier Name
+                                  -- ^ @{ infix 3 data foo }@
+  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@
+
+  -- | pragmas
+  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@
+
+  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
+  | DataFamilyD Name [TyVarBndr BndrVis]
+               (Maybe Kind)
+         -- ^ @{ data family T a b c :: * }@
+
+  | 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
+                 (Maybe Kind)      -- Kind signature
+                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]
+                                   --        = A (B x)
+                                   --        deriving (Z,W)
+                                   --        deriving stock Eq }@
+  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@
+
+  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
+  | OpenTypeFamilyD TypeFamilyHead
+         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@
+
+  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]
+       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@
+
+  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@
+  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type
+       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@
+  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@
+
+  -- | Pattern Synonyms
+  | PatSynD Name PatSynArgs PatSynDir Pat
+      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or
+      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or
+      --   @{ pattern P v1 v2 .. vn <- p
+      --        where P v1 v2 .. vn = e  }@  explicit bidirectional
+      --
+      -- also, besides prefix pattern synonyms, both infix and record
+      -- pattern synonyms are supported. See 'PatSynArgs' for details
+
+  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.
+
+  | ImplicitParamBindD String Exp
+      -- ^ @{ ?x = expr }@
+      --
+      -- Implicit parameter binding declaration. Can only be used in let
+      -- and where clauses which consist entirely of implicit bindings.
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | A way to specify a namespace to look in when GHC needs to find
+--   a name's source
+data NamespaceSpecifier
+  = NoNamespaceSpecifier   -- ^ Name may be everything; If there are two
+                           --   names in different namespaces, then consider both
+  | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a
+                           --   data type, type alias, type family, type class,
+                           --   or type variable
+  | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a
+                           --   function, data constructor, or pattern synonym
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | Varieties of allowed instance overlap.
+data Overlap = Overlappable   -- ^ May be overlapped by more specific instances
+             | Overlapping    -- ^ May overlap a more general instance
+             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'
+             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and
+                              -- pick an arbitrary one if multiple choices are
+                              -- available.
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | A single @deriving@ clause at the end of a datatype.
+data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
+    -- ^ @{ deriving stock (Eq, Ord) }@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | What the user explicitly requests when deriving an instance.
+data DerivStrategy = StockStrategy    -- ^ A \"standard\" derived instance
+                   | AnyclassStrategy -- ^ @-XDeriveAnyClass@
+                   | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@
+                   | ViaStrategy Type -- ^ @-XDerivingVia@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | A pattern synonym's type. Note that a pattern synonym's /fully/
+-- specified type has a peculiar shape coming with two forall
+-- quantifiers and two constraint contexts. For example, consider the
+-- pattern synonym
+--
+-- > pattern P x1 x2 ... xn = <some-pattern>
+--
+-- P's complete type is of the following form
+--
+-- > pattern P :: forall universals.   required constraints
+-- >           => forall existentials. provided constraints
+-- >           => t1 -> t2 -> ... -> tn -> t
+--
+-- consisting of four parts:
+--
+--   1. the (possibly empty lists of) universally quantified type
+--      variables and required constraints on them.
+--   2. the (possibly empty lists of) existentially quantified
+--      type variables and the provided constraints on them.
+--   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively
+--   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.
+--
+-- Pattern synonym types interact with TH when (a) reifying a pattern
+-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's
+-- type signature explicitly:
+--
+--   * Reification always returns a pattern synonym's /fully/ specified
+--     type in abstract syntax.
+--
+--   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates
+--     a pattern synonym's type unambiguously in concrete syntax: The rule of
+--     thumb is to print initial empty universals and the required
+--     context as @() =>@, if existentials and a provided context
+--     follow. If only universals and their required context, but no
+--     existentials are specified, only the universals and their
+--     required context are printed. If both or none are specified, so
+--     both (or none) are printed.
+--
+--   * When specifying a pattern synonym's type explicitly with
+--     'PatSynSigD' either one of the universals, the existentials, or
+--     their contexts may be left empty.
+--
+-- See the GHC user's guide for more information on pattern synonyms
+-- and their types:
+-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.
+type PatSynType = Type
+
+-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By
+-- analogy with "head" for type classes and type class instances as
+-- defined in /Type classes: an exploration of the design space/, the
+-- @TypeFamilyHead@ is defined to be the elements of the declaration
+-- between @type family@ and @where@.
+data TypeFamilyHead =
+  TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | One equation of a type family instance or closed type family. The
+-- arguments are the left-hand-side type and the right-hand-side result.
+--
+-- For instance, if you had the following type family:
+--
+-- @
+-- type family Foo (a :: k) :: k where
+--   forall k (a :: k). Foo \@k a = a
+-- @
+--
+-- The @Foo \@k a = a@ equation would be represented as follows:
+--
+-- @
+-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])
+--            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))
+--            ('VarT' a)
+-- @
+data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type
+  deriving( Show, Eq, Ord, Data, Generic )
+
+data FunDep = FunDep [Name] [Name]
+  deriving( Show, Eq, Ord, Data, Generic )
+
+data Foreign = ImportF Callconv Safety String Name Type
+             | ExportF Callconv        String Name Type
+         deriving( Show, Eq, Ord, Data, Generic )
+
+-- 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 )
+
+data Safety = Unsafe | Safe | Interruptible
+        deriving( Show, Eq, Ord, Data, Generic )
+
+data Pragma = InlineP         Name Inline RuleMatch Phases
+            | OpaqueP         Name
+            | SpecialiseP     Name Type (Maybe Inline) Phases
+            | SpecialiseInstP Type
+            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases
+            | AnnP            AnnTarget Exp
+            | LineP           Int String
+            | CompleteP       [Name] (Maybe Name)
+                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@
+            | SCCP            Name (Maybe String)
+                -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@
+        deriving( Show, Eq, Ord, Data, Generic )
+
+data Inline = NoInline
+            | Inline
+            | Inlinable
+            deriving (Show, Eq, Ord, Data, Generic)
+
+data RuleMatch = ConLike
+               | FunLike
+               deriving (Show, Eq, Ord, Data, Generic)
+
+data Phases = AllPhases
+            | FromPhase Int
+            | BeforePhase Int
+            deriving (Show, Eq, Ord, Data, Generic)
+
+data RuleBndr = RuleVar Name
+              | TypedRuleVar Name Type
+              deriving (Show, Eq, Ord, Data, Generic)
+
+data AnnTarget = ModuleAnnotation
+               | TypeAnnotation Name
+               | ValueAnnotation Name
+              deriving (Show, Eq, Ord, Data, Generic)
+
+type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@
+
+-- | Since the advent of @ConstraintKinds@, constraints are really just types.
+-- Equality constraints use the 'EqualityT' constructor. Constraints may also
+-- be tuples of other constraints.
+type Pred = Type
+
+-- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.
+--
+-- This may not agree with the annotations returned by 'reifyConStrictness'.
+-- See 'reifyConStrictness' for more information.
+data SourceUnpackedness
+  = NoSourceUnpackedness -- ^ @C a@
+  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@
+  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@
+        deriving (Show, Eq, Ord, Data, Generic)
+
+-- | 'SourceStrictness' corresponds to strictness annotations found in the source code.
+--
+-- This may not agree with the annotations returned by 'reifyConStrictness'.
+-- See 'reifyConStrictness' for more information.
+data SourceStrictness = NoSourceStrictness    -- ^ @C a@
+                      | SourceLazy            -- ^ @C {~}a@
+                      | SourceStrict          -- ^ @C {!}a@
+        deriving (Show, Eq, Ord, Data, Generic)
+
+-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'
+-- refers to the strictness annotations that the compiler chooses for a data constructor
+-- field, which may be different from what is written in source code.
+--
+-- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,
+-- such as the field of a newtype constructor and fields that have an unlifted type.
+--
+-- See 'reifyConStrictness' for more information.
+data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.
+                       | DecidedStrict -- ^ Field inferred to have a bang.
+                       | DecidedUnpack -- ^ Field inferred to be unpacked.
+        deriving (Show, Eq, Ord, Data, Generic)
+
+-- | A data constructor.
+--
+-- The constructors for 'Con' can roughly be divided up into two categories:
+-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and
+-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and
+-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type
+-- variables and class contexts, can surround either variety of constructor.
+-- However, the type variables that it quantifies are different depending
+-- on what constructor syntax is used:
+--
+-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the
+--   'ForallC' will only quantify /existential/ type variables. For example:
+--
+--   @
+--   data Foo a = forall b. MkFoo a b
+--   @
+--
+--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.
+--
+-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the
+--   'ForallC' will quantify /all/ type variables used in the constructor.
+--   For example:
+--
+--   @
+--   data Bar a b where
+--     MkBar :: (a ~ b) => c -> MkBar a b
+--   @
+--
+--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.
+--
+-- Multiplicity annotations for data types are currently not supported
+-- in Template Haskell (i.e. all fields represented by Template Haskell
+-- will be linear).
+data Con =
+  -- | @C Int a@
+    NormalC Name [BangType]
+
+  -- | @C { v :: Int, w :: a }@
+  | RecC Name [VarBangType]
+
+  -- | @Int :+ a@
+  | InfixC BangType Name BangType
+
+  -- | @forall a. Eq a => C [a]@
+  | ForallC [TyVarBndr Specificity] Cxt Con
+
+  -- @C :: a -> b -> T b Int@
+  | GadtC [Name]
+            -- ^ The list of constructors, corresponding to the GADT constructor
+            -- syntax @C1, C2 :: a -> T b@.
+            --
+            -- Invariant: the list must be non-empty.
+          [BangType] -- ^ The constructor arguments
+          Type -- ^ See Note [GADT return type]
+
+  -- | @C :: { v :: Int } -> T b Int@
+  | RecGadtC [Name]
+             -- ^ The list of constructors, corresponding to the GADT record
+             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.
+             --
+             -- Invariant: the list must be non-empty.
+             [VarBangType] -- ^ The constructor arguments
+             Type -- ^ See Note [GADT return type]
+        deriving (Show, Eq, Ord, Data, Generic)
+
+-- Note [GADT return type]
+-- ~~~~~~~~~~~~~~~~~~~~~~~
+-- The return type of a GADT constructor does not necessarily match the name of
+-- the data type:
+--
+-- type S = T
+--
+-- data T a where
+--     MkT :: S Int
+--
+--
+-- type S a = T
+--
+-- data T a where
+--     MkT :: S Char Int
+--
+--
+-- type Id a = a
+-- type S a = T
+--
+-- data T a where
+--     MkT :: Id (S Char Int)
+--
+--
+-- That is why we allow the return type stored by a constructor to be an
+-- arbitrary type. See also #11341
+
+data Bang = Bang SourceUnpackedness SourceStrictness
+         -- ^ @C { {\-\# UNPACK \#-\} !}a@
+        deriving (Show, Eq, Ord, Data, Generic)
+
+type BangType    = (Bang, Type)
+type VarBangType = (Name, Bang, Type)
+
+-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.
+type Strict      = Bang
+
+-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by
+-- 'BangType'.
+type StrictType    = BangType
+
+-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by
+-- 'VarBangType'.
+type VarStrictType = VarBangType
+
+-- | A pattern synonym's directionality.
+data PatSynDir
+  = Unidir             -- ^ @pattern P x {<-} p@
+  | ImplBidir          -- ^ @pattern P x {=} p@
+  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | A pattern synonym's argument type.
+data PatSynArgs
+  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@
+  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@
+  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+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@
+          | VarT Name                      -- ^ @a@
+          | ConT Name                      -- ^ @T@
+          | PromotedT Name                 -- ^ @'T@
+          | InfixT Type Name Type          -- ^ @T + T@
+          | UInfixT Type Name Type         -- ^ @T + T@
+                                           --
+                                           -- See "Language.Haskell.TH.Syntax#infix"
+          | PromotedInfixT Type Name Type  -- ^ @T :+: T@
+          | PromotedUInfixT Type Name Type -- ^ @T :+: T@
+                                           --
+                                           -- See "Language.Haskell.TH.Syntax#infix"
+          | ParensT Type                   -- ^ @(T)@
+
+          -- See Note [Representing concrete syntax in types]
+          | TupleT Int                     -- ^ @(,)@, @(,,)@, etc.
+          | UnboxedTupleT Int              -- ^ @(\#,\#)@, @(\#,,\#)@, etc.
+          | UnboxedSumT SumArity           -- ^ @(\#|\#)@, @(\#||\#)@, etc.
+          | ArrowT                         -- ^ @->@
+          | MulArrowT                      -- ^ @%n ->@
+                                           --
+                                           -- Generalised arrow type with multiplicity argument
+          | EqualityT                      -- ^ @~@
+          | ListT                          -- ^ @[]@
+          | PromotedTupleT Int             -- ^ @'()@, @'(,)@, @'(,,)@, etc.
+          | PromotedNilT                   -- ^ @'[]@
+          | PromotedConsT                  -- ^ @'(:)@
+          | StarT                          -- ^ @*@
+          | ConstraintT                    -- ^ @Constraint@
+          | LitT TyLit                     -- ^ @0@, @1@, @2@, etc.
+          | WildCardT                      -- ^ @_@
+          | ImplicitParamT String Type     -- ^ @?x :: t@
+      deriving( Show, Eq, Ord, Data, Generic )
+
+data Specificity = SpecifiedSpec          -- ^ @a@
+                 | InferredSpec           -- ^ @{a}@
+      deriving( Show, Eq, Ord, Data, Generic )
+
+-- | The @flag@ type parameter is instantiated to one of the following types:
+--
+--   * 'Specificity' (examples: 'ForallC', 'ForallT')
+--   * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)
+--   * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'
+--
+data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@
+                    | KindedTV Name flag Kind -- ^ @(a :: k)@
+      deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable )
+
+data BndrVis = BndrReq                    -- ^ @a@
+             | BndrInvis                  -- ^ @\@a@
+      deriving( Show, Eq, Ord, Data, Generic )
+
+-- | Type family result signature
+data FamilyResultSig = NoSig              -- ^ no signature
+                     | KindSig  Kind      -- ^ @k@
+                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@
+      deriving( Show, Eq, Ord, Data, Generic )
+
+-- | Injectivity annotation
+data InjectivityAnn = InjectivityAnn Name [Name]
+  deriving ( Show, Eq, Ord, Data, Generic )
+
+data TyLit = NumTyLit Integer             -- ^ @2@
+           | StrTyLit String              -- ^ @\"Hello\"@
+           | CharTyLit Char               -- ^ @\'C\'@, @since 4.16.0.0
+  deriving ( Show, Eq, Ord, Data, Generic )
+
+-- | Role annotations
+data Role = NominalR            -- ^ @nominal@
+          | RepresentationalR   -- ^ @representational@
+          | PhantomR            -- ^ @phantom@
+          | InferR              -- ^ @_@
+  deriving( Show, Eq, Ord, Data, Generic )
+
+-- | Annotation target for reifyAnnotations
+data AnnLookup = AnnLookupModule Module
+               | AnnLookupName Name
+               deriving( Show, Eq, Ord, Data, Generic )
+
+-- | To avoid duplication between kinds and types, they
+-- are defined to be the same. Naturally, you would never
+-- have a type be 'StarT' and you would never have a kind
+-- be 'SigT', but many of the other constructors are shared.
+-- Note that the kind @Bool@ is denoted with 'ConT', not
+-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
+-- not 'PromotedTupleT'.
+
+type Kind = Type
+
+{- Note [Representing concrete syntax in types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Haskell has a rich concrete syntax for types, including
+  t1 -> t2, (t1,t2), [t], and so on
+In TH we represent all of this using AppT, with a distinguished
+type constructor at the head.  So,
+  Type              TH representation
+  -----------------------------------------------
+  t1 -> t2          ArrowT `AppT` t2 `AppT` t2
+  [t]               ListT `AppT` t
+  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2
+  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2
+
+But if the original HsSyn used prefix application, we won't use
+these special TH constructors.  For example
+  [] t              ConT "[]" `AppT` t
+  (->) t            ConT "->" `AppT` t
+In this way we can faithfully represent in TH whether the original
+HsType used concrete syntax or not.
+
+The one case that doesn't fit this pattern is that of promoted lists
+  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2
+but it's very smelly because there really is no type constructor
+corresponding to PromotedListT. So we encode HsExplicitListTy with
+PromotedConsT and PromotedNilT (which *do* have underlying type
+constructors):
+  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`
+                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)
+-}
+
+-- | A location at which to attach Haddock documentation.
+-- Note that adding documentation to a 'Name' defined oustide of the current
+-- module will cause an error.
+data DocLoc
+  = ModuleDoc         -- ^ At the current module's header.
+  | DeclDoc Name      -- ^ At a declaration, not necessarily top level.
+  | ArgDoc Name Int   -- ^ At a specific argument of a function, indexed by its
+                      -- position.
+  | InstDoc Type      -- ^ At a class or family instance.
+  deriving ( Show, Eq, Ord, Data, Generic )
+
+-----------------------------------------------------
+--              Internal helper functions
+-----------------------------------------------------
+
+cmpEq :: Ordering -> Bool
+cmpEq EQ = True
+cmpEq _  = False
+
+thenCmp :: Ordering -> Ordering -> Ordering
+thenCmp EQ o2 = o2
+thenCmp o1 _  = o1
+
+get_cons_names :: Con -> [Name]
+get_cons_names (NormalC n _)     = [n]
+get_cons_names (RecC n _)        = [n]
+get_cons_names (InfixC _ n _)    = [n]
+get_cons_names (ForallC _ _ con) = get_cons_names con
+-- GadtC can have multiple names, e.g
+-- > data Bar a where
+-- >   MkBar1, MkBar2 :: a -> Bar a
+-- Will have one GadtC with [MkBar1, MkBar2] as names
+get_cons_names (GadtC ns _ _)    = ns
+get_cons_names (RecGadtC ns _ _) = ns
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index a245d319a9c..95aba3e034b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1,3004 +1,20 @@
-{-# LANGUAGE CPP, DeriveDataTypeable,
-             DeriveGeneric, FlexibleInstances, DefaultSignatures,
-             RankNTypes, RoleAnnotations, ScopedTypeVariables,
-             MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,
-             GADTs, UnboxedTuples, UnboxedSums, TypeOperators,
-             Trustworthy, DeriveFunctor, DeriveTraversable,
-             BangPatterns, RecordWildCards, ImplicitParams #-}
-
-{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
-{-# LANGUAGE TemplateHaskellQuotes #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Language.Haskell.Syntax
--- Copyright   :  (c) The University of Glasgow 2003
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- Abstract syntax definitions for Template Haskell.
---
------------------------------------------------------------------------------
-
 module Language.Haskell.TH.Syntax
-    ( module Language.Haskell.TH.Syntax
-      -- * Language extensions
-    , module Language.Haskell.TH.LanguageExtensions
-    , ForeignSrcLang(..)
-    -- * Notes
-    -- ** Unresolved Infix
-    -- $infix
-    ) where
-
-import Prelude
-import Data.Data hiding (Fixity(..))
-import Data.IORef
-import System.IO.Unsafe ( unsafePerformIO )
-import System.FilePath
-import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Fix (MonadFix (..))
-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 )
-import Data.List.NonEmpty ( NonEmpty(..) )
-import Data.Word
-import GHC.Generics     ( Generic )
-import qualified Data.Kind as Kind (Type)
-import GHC.Ptr          ( Ptr, plusPtr )
-import GHC.Lexeme       ( startsVarSym, startsVarId )
-import GHC.ForeignSrcLang.Type
-import Language.Haskell.TH.LanguageExtensions
-import Prelude hiding (Applicative(..))
-import Foreign.ForeignPtr
-import Foreign.C.String
-import Foreign.C.Types
-import GHC.Types        (TYPE, RuntimeRep(..), Levity(..))
-
-#ifndef BOOTSTRAP_TH
-import Control.Monad (liftM)
-import Data.Array.Byte (ByteArray(..))
-import Data.Char (ord)
-import Data.Int
-import Data.Ratio
-import Data.Void        ( Void, absurd )
-import GHC.CString      ( unpackCString# )
-import GHC.Exts
-  ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray#
-  , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents#
-  , copyByteArray#, newPinnedByteArray#)
-import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))
-import GHC.Prim         ( Int#, Word#, Char#, Double#, Float#, Addr# )
-import GHC.ST (ST(..), runST)
-import GHC.Types        ( Int(..), Word(..), Char(..), Double(..), Float(..))
-import Numeric.Natural
-import qualified Data.Fixed as Fixed
-#endif
-
------------------------------------------------------
---
---              The Quasi class
---
------------------------------------------------------
-
-class (MonadIO m, MonadFail m) => Quasi m where
-  qNewName :: String -> m Name
-        -- ^ Fresh names
-
-        -- Error reporting and recovery
-  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)
-                                        -- ...but carry on; use 'fail' to stop
-  qRecover :: m a -- ^ the error handler
-           -> m a -- ^ action which may fail
-           -> m a               -- ^ Recover from the monadic 'fail'
-
-        -- Inspect the type-checker's environment
-  qLookupName :: Bool -> String -> m (Maybe Name)
-       -- True <=> type namespace, False <=> value namespace
-  qReify          :: Name -> m Info
-  qReifyFixity    :: Name -> m (Maybe Fixity)
-  qReifyType      :: Name -> m Type
-  qReifyInstances :: Name -> [Type] -> m [Dec]
-       -- Is (n tys) an instance?
-       -- Returns list of matching instance Decs
-       --    (with empty sub-Decs)
-       -- Works for classes and type functions
-  qReifyRoles         :: Name -> m [Role]
-  qReifyAnnotations   :: Data a => AnnLookup -> m [a]
-  qReifyModule        :: Module -> m ModuleInfo
-  qReifyConStrictness :: Name -> m [DecidedStrictness]
-
-  qLocation :: m Loc
-
-  qRunIO :: IO a -> m a
-  qRunIO = liftIO
-  -- ^ Input/output (dangerous)
-  qGetPackageRoot :: m FilePath
-
-  qAddDependentFile :: FilePath -> m ()
-
-  qAddTempFile :: String -> m FilePath
-
-  qAddTopDecls :: [Dec] -> m ()
-
-  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
-
-  qAddModFinalizer :: Q () -> m ()
-
-  qAddCorePlugin :: String -> m ()
-
-  qGetQ :: Typeable a => m (Maybe a)
-
-  qPutQ :: Typeable a => a -> m ()
-
-  qIsExtEnabled :: Extension -> m Bool
-  qExtsEnabled :: m [Extension]
-
-  qPutDoc :: DocLoc -> String -> m ()
-  qGetDoc :: DocLoc -> m (Maybe String)
-
------------------------------------------------------
---      The IO instance of Quasi
---
---  This instance is used only when running a Q
---  computation in the IO monad, usually just to
---  print the result.  There is no interesting
---  type environment, so reification isn't going to
---  work.
---
------------------------------------------------------
-
-instance Quasi IO where
-  qNewName = newNameIO
-
-  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
-  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
-
-  qLookupName _ _       = badIO "lookupName"
-  qReify _              = badIO "reify"
-  qReifyFixity _        = badIO "reifyFixity"
-  qReifyType _          = badIO "reifyFixity"
-  qReifyInstances _ _   = badIO "reifyInstances"
-  qReifyRoles _         = badIO "reifyRoles"
-  qReifyAnnotations _   = badIO "reifyAnnotations"
-  qReifyModule _        = badIO "reifyModule"
-  qReifyConStrictness _ = badIO "reifyConStrictness"
-  qLocation             = badIO "currentLocation"
-  qRecover _ _          = badIO "recover" -- Maybe we could fix this?
-  qGetPackageRoot       = badIO "getProjectRoot"
-  qAddDependentFile _   = badIO "addDependentFile"
-  qAddTempFile _        = badIO "addTempFile"
-  qAddTopDecls _        = badIO "addTopDecls"
-  qAddForeignFilePath _ _ = badIO "addForeignFilePath"
-  qAddModFinalizer _    = badIO "addModFinalizer"
-  qAddCorePlugin _      = badIO "addCorePlugin"
-  qGetQ                 = badIO "getQ"
-  qPutQ _               = badIO "putQ"
-  qIsExtEnabled _       = badIO "isExtEnabled"
-  qExtsEnabled          = badIO "extsEnabled"
-  qPutDoc _ _           = badIO "putDoc"
-  qGetDoc _             = badIO "getDoc"
-
-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" }
-
--- Global variable to generate unique symbols
-counter :: IORef Uniq
-{-# NOINLINE counter #-}
-counter = unsafePerformIO (newIORef 0)
-
-
------------------------------------------------------
---
---              The Q monad
---
------------------------------------------------------
-
-newtype Q a = Q { unQ :: forall m. Quasi m => m a }
-
--- \"Runs\" the 'Q' monad. Normal users of Template Haskell
--- should not need this function, as the splice brackets @$( ... )@
--- are the usual way of running a 'Q' computation.
---
--- This function is primarily used in GHC internals, and for debugging
--- splices by running them in 'IO'.
---
--- Note that many functions in 'Q', such as 'reify' and other compiler
--- queries, are not supported when running 'Q' in 'IO'; these operations
--- simply fail at runtime. Indeed, the only operations guaranteed to succeed
--- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
-runQ :: Quasi m => Q a -> m a
-runQ (Q m) = m
-
-instance Monad Q where
-  Q m >>= k  = Q (m >>= \x -> unQ (k x))
-  (>>) = (*>)
-
-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)
-
-instance Applicative Q where
-  pure x = Q (pure x)
-  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
---
------------------------------------------------------
-
-type TExp :: TYPE r -> Kind.Type
-type role TExp nominal   -- See Note [Role of TExp]
-newtype TExp a = TExp
-  { unType :: Exp -- ^ Underlying untyped Template Haskell expression
-  }
--- ^ Typed wrapper around an 'Exp'.
---
--- This is the typed representation of terms produced by typed quotes.
---
--- Representation-polymorphic since /template-haskell-2.16.0.0/.
-
--- | Discard the type annotation and produce a plain Template Haskell
--- expression
---
--- Representation-polymorphic since /template-haskell-2.16.0.0/.
-unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
-unTypeQ m = do { TExp e <- m
-               ; return e }
-
--- | Annotate the Template Haskell expression with a type
---
--- This is unsafe because GHC cannot check for you that the expression
--- really does have the type you claim it has.
---
--- Representation-polymorphic since /template-haskell-2.16.0.0/.
-unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
-                      Quote m => m Exp -> m (TExp a)
-unsafeTExpCoerce m = do { e <- m
-                        ; return (TExp e) }
-
-{- Note [Role of TExp]
-~~~~~~~~~~~~~~~~~~~~~~
-TExp's argument must have a nominal role, not phantom as would
-be inferred (#8459).  Consider
-
-  e :: Code Q Age
-  e = [|| MkAge 3 ||]
-
-  foo = $(coerce e) + 4::Int
-
-The splice will evaluate to (MkAge 3) and you can't add that to
-4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}
-
--- Code constructor
-#if __GLASGOW_HASKELL__ >= 909
-type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
-  -- See Note [Foralls to the right in Code]
-#else
-type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
-#endif
-type role Code representational nominal   -- See Note [Role of TExp]
-newtype Code m a = Code
-  { examineCode :: m (TExp a) -- ^ Underlying monadic value
-  }
--- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed
--- expressions allow for type-safe splicing via:
---
---   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
---     that expression has type @a@, then the quotation has type
---     @Quote m => Code m a@
---
---   - typed splices inside of typed quotes, written as @$$(...)@ where @...@
---     is an arbitrary expression of type @Quote m => Code m a@
---
--- Traditional expression quotes and splices let us construct ill-typed
--- expressions:
---
--- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
--- GHC.Types.True GHC.Classes.== "foo"
--- >>> GHC.Types.True GHC.Classes.== "foo"
--- <interactive> error:
---     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
---     • In the second argument of ‘(==)’, namely ‘"foo"’
---       In the expression: True == "foo"
---       In an equation for ‘it’: it = True == "foo"
---
--- With typed expressions, the type error occurs when /constructing/ the
--- Template Haskell expression:
---
--- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
--- <interactive> error:
---     • Couldn't match type ‘[Char]’ with ‘Bool’
---       Expected type: Code Q Bool
---         Actual type: Code Q [Char]
---     • In the Template Haskell quotation [|| "foo" ||]
---       In the expression: [|| "foo" ||]
---       In the Template Haskell splice $$([|| "foo" ||])
-
-
-{- Note [Foralls to the right in Code]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Code has the following type signature:
-   type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
-
-This allows us to write
-   data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)
-
-   tcodeq :: T (Code Q)
-   tcodeq = MkT [||5||] [||5#||]
-
-If we used the slightly more straightforward signature
-   type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
-
-then the example above would become ill-typed.  (See #23592 for some discussion.)
--}
-
--- | 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)
-
--- | 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
-
--- | 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
-
--- | 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)
-
-
--- | 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)
-
--- | 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)
-
--- | 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
-
-----------------------------------------------------
--- Packaged versions for the programmer, hiding the Quasi-ness
-
-
--- | Report an error (True) or warning (False),
--- but carry on; use 'fail' to stop.
-report  :: Bool -> String -> Q ()
-report b s = Q (qReport b s)
-{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
-
--- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
-reportError :: String -> Q ()
-reportError = report True
-
--- | Report a warning to the user, and carry on.
-reportWarning :: String -> Q ()
-reportWarning = report False
-
--- | Recover from errors raised by 'reportError' or 'fail'.
-recover :: Q a -- ^ handler to invoke on failure
-        -> Q a -- ^ computation to run
-        -> Q a
-recover (Q r) (Q m) = Q (qRecover r m)
-
--- We don't export lookupName; the Bool isn't a great API
--- Instead we export lookupTypeName, lookupValueName
-lookupName :: Bool -> String -> Q (Maybe Name)
-lookupName ns s = Q (qLookupName ns s)
-
--- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
-lookupTypeName :: String -> Q (Maybe Name)
-lookupTypeName  s = Q (qLookupName True s)
-
--- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
-lookupValueName :: String -> Q (Maybe Name)
-lookupValueName s = Q (qLookupName False s)
-
-{-
-Note [Name lookup]
-~~~~~~~~~~~~~~~~~~
--}
-{- $namelookup #namelookup#
-The functions 'lookupTypeName' and 'lookupValueName' provide
-a way to query the current splice's context for what names
-are in scope. The function 'lookupTypeName' queries the type
-namespace, whereas 'lookupValueName' queries the value namespace,
-but the functions are otherwise identical.
-
-A call @lookupValueName s@ will check if there is a value
-with name @s@ in scope at the current splice's location. If
-there is, the @Name@ of this value is returned;
-if not, then @Nothing@ is returned.
-
-The returned name cannot be \"captured\".
-For example:
-
-> f = "global"
-> g = $( do
->          Just nm <- lookupValueName "f"
->          [| let f = "local" in $( varE nm ) |]
-
-In this case, @g = \"global\"@; the call to @lookupValueName@
-returned the global @f@, and this name was /not/ captured by
-the local definition of @f@.
-
-The lookup is performed in the context of the /top-level/ splice
-being run. For example:
-
-> f = "global"
-> g = $( [| let f = "local" in
->            $(do
->                Just nm <- lookupValueName "f"
->                varE nm
->             ) |] )
-
-Again in this example, @g = \"global\"@, because the call to
-@lookupValueName@ queries the context of the outer-most @$(...)@.
-
-Operators should be queried without any surrounding parentheses, like so:
-
-> lookupValueName "+"
+  ( module Language.Haskell.TH.Lib.Syntax
+  )
+where
 
-Qualified names are also supported, like so:
+import Language.Haskell.TH.Lib.Syntax
 
-> lookupValueName "Prelude.+"
-> lookupValueName "Prelude.map"
-
--}
-
-
-{- | 'reify' looks up information about the 'Name'. It will fail with
-a compile error if the 'Name' is not visible. A 'Name' is visible if it is
-imported or defined in a prior top-level declaration group. See the
-documentation for 'newDeclarationGroup' for more details.
-
-It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
-to ensure that we are reifying from the right namespace. For instance, in this context:
-
-> data D = D
-
-which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
-To ensure we get information about @D@-the-value, use 'lookupValueName':
-
-> do
->   Just nm <- lookupValueName "D"
->   reify nm
-
-and to get information about @D@-the-type, use 'lookupTypeName'.
--}
-reify :: Name -> Q Info
-reify v = Q (qReify v)
-
-{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For
-example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then
-@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function
-@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns
-'Nothing', so you may assume @bar@ has 'defaultFixity'.
--}
-reifyFixity :: Name -> Q (Maybe Fixity)
-reifyFixity nm = Q (qReifyFixity nm)
-
-{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,
-@reifyType 'not@   returns @Bool -> Bool@, and
-@reifyType ''Bool@ returns @Type@.
-This works even if there's no explicit signature and the type or kind is inferred.
--}
-reifyType :: Name -> Q Type
-reifyType nm = Q (qReifyType nm)
-
-{- | Template Haskell is capable of reifying information about types and
-terms defined in previous declaration groups. Top-level declaration splices break up
-declaration groups.
-
-For an example, consider this  code block. We define a datatype @X@ and
-then try to call 'reify' on the datatype.
-
-@
-module Check where
-
-data X = X
-    deriving Eq
-
-$(do
-    info <- reify ''X
-    runIO $ print info
- )
-@
-
-This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:
-
-@
-data X = X
-    deriving Eq
-
-$(pure [])
-
-$(do
-    info <- reify ''X
-    runIO $ print info
- )
-@
-
-We provide 'newDeclarationGroup' as a means of documenting this behavior
-and providing a name for the pattern.
-
-Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:
-
-@
-data X = X
-    deriving Eq
-
-newDeclarationGroup
-
-$(do
-    info <- reify ''X
-    runIO $ print info
- )
-@
-
--}
-newDeclarationGroup :: Q [Dec]
-newDeclarationGroup = pure []
-
-{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")
-of @nm tys@. That is,
-if @nm@ is the name of a type class, then all instances of this class at the types @tys@
-are returned. Alternatively, if @nm@ is the name of a data family or type family,
-all instances of this family at the types @tys@ are returned.
-
-Note that this is a \"shallow\" test; the declarations returned merely have
-instance heads which unify with @nm tys@, they need not actually be satisfiable.
-
-  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains
-    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and
-    @B@ themselves implement 'Eq'
-
-  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available
-    instance of 'Show'
-
-There is one edge case: @reifyInstances ''Typeable tys@ currently always
-produces an empty list (no matter what @tys@ are given).
-
-In principle, the *visible* instances are
-* all instances defined in a prior top-level declaration group
-  (see docs on @newDeclarationGroup@), or
-* all instances defined in any module transitively imported by the
-  module being compiled
-
-However, actually searching all modules transitively below the one being
-compiled is unreasonably expensive, so @reifyInstances@ will report only the
-instance for modules that GHC has had some cause to visit during this
-compilation.  This is a shortcoming: @reifyInstances@ might fail to report
-instances for a type that is otherwise unusued, or instances defined in a
-different component.  You can work around this shortcoming by explicitly importing the modules
-whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>
-has some discussion around this.
-
--}
-reifyInstances :: Name -> [Type] -> Q [InstanceDec]
-reifyInstances cls tys = Q (qReifyInstances cls tys)
-
-{- | @reifyRoles nm@ returns the list of roles associated with the parameters
-(both visible and invisible) of
-the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
-The returned list should never contain 'InferR'.
-
-An invisible parameter to a tycon is often a kind parameter. For example, if
-we have
-
-@
-type Proxy :: forall k. k -> Type
-data Proxy a = MkProxy
-@
-
-and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is
-the role of the invisible @k@ parameter. Kind parameters are always nominal.
--}
-reifyRoles :: Name -> Q [Role]
-reifyRoles nm = Q (qReifyRoles nm)
-
--- | @reifyAnnotations target@ returns the list of annotations
--- associated with @target@.  Only the annotations that are
--- appropriately typed is returned.  So if you have @Int@ and @String@
--- annotations for the same target, you have to call this function twice.
-reifyAnnotations :: Data a => AnnLookup -> Q [a]
-reifyAnnotations an = Q (qReifyAnnotations an)
-
--- | @reifyModule mod@ looks up information about module @mod@.  To
--- look up the current module, call this function with the return
--- value of 'Language.Haskell.TH.Lib.thisModule'.
-reifyModule :: Module -> Q ModuleInfo
-reifyModule m = Q (qReifyModule m)
-
--- | @reifyConStrictness nm@ looks up the strictness information for the fields
--- of the constructor with the name @nm@. Note that the strictness information
--- that 'reifyConStrictness' returns may not correspond to what is written in
--- the source code. For example, in the following data declaration:
---
--- @
--- data Pair a = Pair a a
--- @
---
--- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most
--- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
--- @-XStrictData@ language extension was enabled.
-reifyConStrictness :: Name -> Q [DecidedStrictness]
-reifyConStrictness n = Q (qReifyConStrictness n)
-
--- | Is the list of instances returned by 'reifyInstances' nonempty?
---
--- If you're confused by an instance not being visible despite being
--- defined in the same module and above the splice in question, see the
--- docs for 'newDeclarationGroup' for a possible explanation.
-isInstance :: Name -> [Type] -> Q Bool
-isInstance nm tys = do { decs <- reifyInstances nm tys
-                       ; return (not (null decs)) }
-
--- | The location at which this computation is spliced.
-location :: Q Loc
-location = Q qLocation
-
--- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
--- Take care: you are guaranteed the ordering of calls to 'runIO' within
--- a single 'Q' computation, but not about the order in which splices are run.
---
--- Note: for various murky reasons, stdout and stderr handles are not
--- necessarily flushed when the compiler finishes running, so you should
--- flush them yourself.
-runIO :: IO a -> Q a
-runIO m = Q (qRunIO m)
-
--- | Get the package root for the current package which is being compiled.
--- This can be set explicitly with the -package-root flag but is normally
--- just the current working directory.
---
--- The motivation for this flag is to provide a principled means to remove the
--- assumption from splices that they will be executed in the directory where the
--- cabal file resides. Projects such as haskell-language-server can't and don't
--- change directory when compiling files but instead set the -package-root flag
--- appropriately.
-getPackageRoot :: Q FilePath
-getPackageRoot = Q qGetPackageRoot
-
--- | The input is a filepath, which if relative is offset by the package root.
-makeRelativeToProject :: FilePath -> Q FilePath
-makeRelativeToProject fp | isRelative fp = do
-  root <- getPackageRoot
-  return (root </> fp)
-makeRelativeToProject fp = return fp
-
-
-
--- | Record external files that runIO is using (dependent upon).
--- The compiler can then recognize that it should re-compile the Haskell file
--- when an external file changes.
---
--- Expects an absolute file path.
---
--- Notes:
---
---   * ghc -M does not know about these dependencies - it does not execute TH.
---
---   * The dependency is based on file content, not a modification time
-addDependentFile :: FilePath -> Q ()
-addDependentFile fp = Q (qAddDependentFile fp)
-
--- | Obtain a temporary file path with the given suffix. The compiler will
--- delete this file after compilation.
-addTempFile :: String -> Q FilePath
-addTempFile suffix = Q (qAddTempFile suffix)
-
--- | Add additional top-level declarations. The added declarations will be type
--- checked along with the current declaration group.
-addTopDecls :: [Dec] -> Q ()
-addTopDecls ds = Q (qAddTopDecls ds)
-
--- |
-addForeignFile :: ForeignSrcLang -> String -> Q ()
-addForeignFile = addForeignSource
-{-# DEPRECATED addForeignFile
-               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"
-  #-} -- deprecated in 8.6
-
--- | Emit a foreign file which will be compiled and linked to the object for
--- the current module. Currently only languages that can be compiled with
--- the C compiler are supported, and the flags passed as part of -optc will
--- be also applied to the C compiler invocation that will compile them.
---
--- Note that for non-C languages (for example C++) @extern "C"@ directives
--- must be used to get symbols that we can access from Haskell.
---
--- To get better errors, it is recommended to use #line pragmas when
--- emitting C files, e.g.
---
--- > {-# LANGUAGE CPP #-}
--- > ...
--- > addForeignSource LangC $ unlines
--- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
--- >   , ...
--- >   ]
-addForeignSource :: ForeignSrcLang -> String -> Q ()
-addForeignSource lang src = do
-  let suffix = case lang of
-                 LangC      -> "c"
-                 LangCxx    -> "cpp"
-                 LangObjc   -> "m"
-                 LangObjcxx -> "mm"
-                 LangAsm    -> "s"
-                 LangJs     -> "js"
-                 RawObject  -> "a"
-  path <- addTempFile suffix
-  runIO $ writeFile path src
-  addForeignFilePath lang path
-
--- | Same as 'addForeignSource', but expects to receive a path pointing to the
--- foreign file instead of a 'String' of its contents. Consider using this in
--- conjunction with 'addTempFile'.
---
--- This is a good alternative to 'addForeignSource' when you are trying to
--- directly link in an object file.
-addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
-addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)
-
--- | Add a finalizer that will run in the Q monad after the current module has
--- been type checked. This only makes sense when run within a top-level splice.
---
--- The finalizer is given the local type environment at the splice point. Thus
--- 'reify' is able to find the local definitions when executed inside the
--- finalizer.
-addModFinalizer :: Q () -> Q ()
-addModFinalizer act = Q (qAddModFinalizer (unQ act))
-
--- | Adds a core plugin to the compilation pipeline.
---
--- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc
--- in the command line. The major difference is that the plugin module @m@
--- must not belong to the current package. When TH executes, it is too late
--- to tell the compiler that we needed to compile first a plugin module in the
--- current package.
-addCorePlugin :: String -> Q ()
-addCorePlugin plugin = Q (qAddCorePlugin plugin)
-
--- | Get state from the 'Q' monad. Note that the state is local to the
--- Haskell module in which the Template Haskell expression is executed.
-getQ :: Typeable a => Q (Maybe a)
-getQ = Q qGetQ
-
--- | Replace the state in the 'Q' monad. Note that the state is local to the
--- Haskell module in which the Template Haskell expression is executed.
-putQ :: Typeable a => a -> Q ()
-putQ x = Q (qPutQ x)
-
--- | Determine whether the given language extension is enabled in the 'Q' monad.
-isExtEnabled :: Extension -> Q Bool
-isExtEnabled ext = Q (qIsExtEnabled ext)
-
--- | List all enabled language extensions.
-extsEnabled :: Q [Extension]
-extsEnabled = Q qExtsEnabled
-
--- | Add Haddock documentation to the specified location. This will overwrite
--- any documentation at the location if it already exists. This will reify the
--- specified name, so it must be in scope when you call it. If you want to add
--- documentation to something that you are currently splicing, you can use
--- 'addModFinalizer' e.g.
---
--- > do
--- >   let nm = mkName "x"
--- >   addModFinalizer $ putDoc (DeclDoc nm) "Hello"
--- >   [d| $(varP nm) = 42 |]
---
--- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as
--- will the 'funD_doc' and other @_doc@ combinators.
--- You most likely want to have the @-haddock@ flag turned on when using this.
--- Adding documentation to anything outside of the current module will cause an
--- error.
-putDoc :: DocLoc -> String -> Q ()
-putDoc t s = Q (qPutDoc t s)
-
--- | Retrieves the Haddock documentation at the specified location, if one
--- exists.
--- It can be used to read documentation on things defined outside of the current
--- module, provided that those modules were compiled with the @-haddock@ flag.
-getDoc :: DocLoc -> Q (Maybe String)
-getDoc n = Q (qGetDoc n)
-
-instance MonadIO Q where
-  liftIO = runIO
-
-instance Quasi Q where
-  qNewName            = newName
-  qReport             = report
-  qRecover            = recover
-  qReify              = reify
-  qReifyFixity        = reifyFixity
-  qReifyType          = reifyType
-  qReifyInstances     = reifyInstances
-  qReifyRoles         = reifyRoles
-  qReifyAnnotations   = reifyAnnotations
-  qReifyModule        = reifyModule
-  qReifyConStrictness = reifyConStrictness
-  qLookupName         = lookupName
-  qLocation           = location
-  qGetPackageRoot     = getPackageRoot
-  qAddDependentFile   = addDependentFile
-  qAddTempFile        = addTempFile
-  qAddTopDecls        = addTopDecls
-  qAddForeignFilePath = addForeignFilePath
-  qAddModFinalizer    = addModFinalizer
-  qAddCorePlugin      = addCorePlugin
-  qGetQ               = getQ
-  qPutQ               = putQ
-  qIsExtEnabled       = isExtEnabled
-  qExtsEnabled        = extsEnabled
-  qPutDoc             = putDoc
-  qGetDoc             = getDoc
-
-
-----------------------------------------------------
--- 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 :: forall m . Monad m => forall a . [m a] -> m [a]
-sequenceQ = sequence
-
-
------------------------------------------------------
---
---              The Lift class
---
------------------------------------------------------
-
--- | A 'Lift' instance can have any of its values turned into a Template
--- Haskell expression. This is needed when a value used within a Template
--- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or
--- @[|| ... ||]@) but not at the top level. As an example:
+-- The only difference between this module and Language.Haskell.TH.Lib.Syntax
+-- (which it reexports fully) is that this module depends on the Internal
+-- module.
 --
--- > add1 :: Int -> Code Q Int
--- > add1 x = [|| x + 1 ||]
---
--- Template Haskell has no way of knowing what value @x@ will take on at
--- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.
---
--- A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@
--- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices.
--- It is additionally expected that @'lift' x ≡ 'unTypeCode' ('liftTyped' x)@.
---
--- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@
--- GHC language extension:
---
--- > {-# LANGUAGE DeriveLift #-}
--- > module Foo where
--- >
--- > import Language.Haskell.TH.Syntax
--- >
--- > data Bar a = Bar1 a (Bar a) | Bar2 String
--- >   deriving Lift
---
--- Representation-polymorphic since /template-haskell-2.16.0.0/.
-class Lift (t :: TYPE r) where
-  -- | Turn a value into a Template Haskell expression, suitable for use in
-  -- a splice.
-  lift :: Quote m => t -> m Exp
-  default lift :: (r ~ ('BoxedRep 'Lifted), 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 :: Quote m => t -> Code m t
-
-
--- See Note [Bootstrapping Template Haskell]
-#ifndef BOOTSTRAP_TH
--- If you add any instances here, consider updating test th/TH_Lift
-instance Lift Integer where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL x))
-
-instance Lift Int where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
--- | @since 2.16.0.0
-instance Lift Int# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntPrimL (fromIntegral (I# x))))
-
-instance Lift Int8 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Int16 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Int32 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Int64 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
--- | @since 2.16.0.0
-instance Lift Word# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (WordPrimL (fromIntegral (W# x))))
-
-instance Lift Word where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Word8 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Word16 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Word32 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Word64 where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift Natural where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (IntegerL (fromIntegral x)))
-
-instance Lift (Fixed.Fixed a) where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift (Fixed.MkFixed x) = do
-    ex <- lift x
-    return (ConE mkFixedName `AppE` ex)
-    where
-      mkFixedName = 'Fixed.MkFixed
-
-instance Integral a => Lift (Ratio a) where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (RationalL (toRational x)))
-
-instance Lift Float where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (RationalL (toRational x)))
-
--- | @since 2.16.0.0
-instance Lift Float# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (FloatPrimL (toRational (F# x))))
-
-instance Lift Double where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (RationalL (toRational x)))
-
--- | @since 2.16.0.0
-instance Lift Double# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (DoublePrimL (toRational (D# x))))
-
-instance Lift Char where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (CharL x))
-
--- | @since 2.16.0.0
-instance Lift Char# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x = return (LitE (CharPrimL (C# x)))
-
-instance Lift Bool where
-  liftTyped x = unsafeCodeCoerce (lift x)
-
-  lift True  = return (ConE trueName)
-  lift False = return (ConE falseName)
-
--- | Produces an 'Addr#' literal from the NUL-terminated C-string starting at
--- the given memory address.
+-- We did this to fix #22229: a module importing the Syntax module to use
+-- DeriveLift (Lift is defined there) would lead GHC to load the
+-- interface file for the Internal module (where wired-in TH things live),
+-- but the Internal module might not be built yet at this point. Adding an
+-- explicit dependency from Syntax to Internal fixes this. We do this with a
+-- module reexport because Internal actually depends on Syntax.
 --
--- @since 2.16.0.0
-instance Lift Addr# where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x
-    = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
-
--- |
--- @since 2.19.0.0
-instance Lift ByteArray where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift (ByteArray b) = return
-    (AppE (AppE (VarE addrToByteArrayName) (LitE (IntegerL (fromIntegral len))))
-      (LitE (BytesPrimL (Bytes ptr 0 (fromIntegral len)))))
-    where
-      len# = sizeofByteArray# b
-      len = I# len#
-      pb :: ByteArray#
-      !(ByteArray pb)
-        | isTrue# (isByteArrayPinned# b) = ByteArray b
-        | otherwise = runST $ ST $
-          \s -> case newPinnedByteArray# len# s of
-            (# s', mb #) -> case copyByteArray# b 0# mb 0# len# s' of
-              s'' -> case unsafeFreezeByteArray# mb s'' of
-                (# s''', ret #) -> (# s''', ByteArray ret #)
-      ptr :: ForeignPtr Word8
-      ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))
-
-addrToByteArrayName :: Name
-addrToByteArrayName = 'addrToByteArray
-
-addrToByteArray :: Int -> Addr# -> ByteArray
-addrToByteArray (I# len) addr = runST $ ST $
-  \s -> case newByteArray# len s of
-    (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of
-      s'' -> case unsafeFreezeByteArray# mb s'' of
-        (# s''', ret #) -> (# s''', ByteArray ret #)
-
-instance Lift a => Lift (Maybe a) where
-  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 = 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 = unsafeCodeCoerce (lift x)
-  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
-
-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 = unsafeCodeCoerce (lift x)
-
-  lift (x :| xs) = do
-    x' <- lift x
-    xs' <- lift xs
-    return (InfixE (Just x') (ConE nonemptyName) (Just xs'))
-
--- | @since 2.15.0.0
-instance Lift Void where
-  liftTyped = liftCode . absurd
-  lift = pure . absurd
-
-instance Lift () where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift () = return (ConE (tupleDataName 0))
-
-instance (Lift a, Lift b) => Lift (a, b) where
-  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 = 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 = 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 = 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 = 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 = 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 = unsafeCodeCoerce (lift x)
-  lift (# #) = return (ConE (unboxedTupleTypeName 0))
-
--- | @since 2.16.0.0
-instance (Lift a) => Lift (# a #) where
-  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 = 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 = 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 = unsafeCodeCoerce (lift x)
-  lift (# a, b, c, d #)
-    = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
-                                                     , lift c, lift d ]
-
--- | @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 = 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 ]
-
--- | @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 = 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 ]
-
--- | @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 = 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
-                                                     , lift g ]
-
--- | @since 2.16.0.0
-instance (Lift a, Lift b) => Lift (# a | b #) where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
-        (# | y #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 2
-
--- | @since 2.16.0.0
-instance (Lift a, Lift b, Lift c)
-      => Lift (# a | b | c #) where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
-        (# | y | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 3
-        (# | | y #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 3
-
--- | @since 2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d)
-      => Lift (# a | b | c | d #) where
-  liftTyped x = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
-        (# | y | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 4
-        (# | | y | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 4
-        (# | | | y #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 4
-
--- | @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 = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
-        (# | y | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 5
-        (# | | y | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 5
-        (# | | | y | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 5
-        (# | | | | y #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 5
-
--- | @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 = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
-        (# | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 6
-        (# | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 6
-        (# | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 6
-        (# | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 6
-        (# | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 6
-
--- | @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 = unsafeCodeCoerce (lift x)
-  lift x
-    = case x of
-        (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7
-        (# | y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 7
-        (# | | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 7
-        (# | | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 7
-        (# | | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 7
-        (# | | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 7
-        (# | | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 7 <*> pure 7
-
--- TH has a special form for literal strings,
--- which we should take advantage of.
--- NB: the lhs of the rule has no args, so that
---     the rule will apply to a 'lift' all on its own
---     which happens to be the way the type checker
---     creates it.
-{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
-
-
-trueName, falseName :: Name
-trueName  = 'True
-falseName = 'False
-
-nothingName, justName :: Name
-nothingName = 'Nothing
-justName    = 'Just
-
-leftName, rightName :: Name
-leftName  = 'Left
-rightName = 'Right
-
-nonemptyName :: Name
-nonemptyName = '(:|)
-#endif
-
-oneName, manyName :: Name
-oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"
-manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"
-
------------------------------------------------------
---
---              Generic Lift implementations
---
------------------------------------------------------
-
--- | 'dataToQa' is an internal utility function for constructing generic
--- conversion functions from types with 'Data' instances to various
--- quasi-quoting representations.  See the source of 'dataToExpQ' and
--- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@
--- and @appQ@ are overloadable to account for different syntax for
--- 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 m a k q. (Quote m, Data a)
-          =>  (Name -> k)
-          ->  (Lit -> m q)
-          ->  (k -> [m q] -> m q)
-          ->  (forall b . Data b => b -> Maybe (m q))
-          ->  a
-          ->  m q
-dataToQa mkCon mkLit appCon antiQ t =
-    case antiQ t of
-      Nothing ->
-          case constrRep constr of
-            AlgConstr _ ->
-                appCon (mkCon funOrConName) conArgs
-              where
-                funOrConName :: Name
-                funOrConName =
-                    case showConstr constr of
-                      "(:)"       -> Name (mkOccName ":")
-                                          (NameG DataName
-                                                (mkPkgName "ghc-prim")
-                                                (mkModName "GHC.Types"))
-                      con@"[]"    -> Name (mkOccName con)
-                                          (NameG DataName
-                                                (mkPkgName "ghc-prim")
-                                                (mkModName "GHC.Types"))
-                      con@('(':_) -> Name (mkOccName con)
-                                          (NameG DataName
-                                                (mkPkgName "ghc-prim")
-                                                (mkModName "GHC.Tuple"))
-
-                      -- Tricky case: see Note [Data for non-algebraic types]
-                      fun@(x:_)   | startsVarSym x || startsVarId x
-                                  -> mkNameG_v tyconPkg tyconMod fun
-                      con         -> mkNameG_d tyconPkg tyconMod con
-
-                  where
-                    tycon :: TyCon
-                    tycon = (typeRepTyCon . typeOf) t
-
-                    tyconPkg, tyconMod :: String
-                    tyconPkg = tyConPackage tycon
-                    tyconMod = tyConModule  tycon
-
-                conArgs :: [m q]
-                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
-            IntConstr n ->
-                mkLit $ IntegerL n
-            FloatConstr n ->
-                mkLit $ RationalL n
-            CharConstr c ->
-                mkLit $ CharL c
-        where
-          constr :: Constr
-          constr = toConstr t
-
-      Just y -> y
-
-
-{- Note [Data for non-algebraic types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Class Data was originally intended for algebraic data types.  But
-it is possible to use it for abstract types too.  For example, in
-package `text` we find
-
-  instance Data Text where
-    ...
-    toConstr _ = packConstr
-
-  packConstr :: Constr
-  packConstr = mkConstr textDataType "pack" [] Prefix
-
-Here `packConstr` isn't a real data constructor, it's an ordinary
-function.  Two complications
-
-* In such a case, we must take care to build the Name using
-  mkNameG_v (for values), not mkNameG_d (for data constructors).
-  See #10796.
-
-* The pseudo-constructor is named only by its string, here "pack".
-  But 'dataToQa' needs the TyCon of its defining module, and has
-  to assume it's defined in the same module as the TyCon itself.
-  But nothing enforces that; #12596 shows what goes wrong if
-  "pack" is defined in a different module than the data type "Text".
-  -}
-
--- | '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  ::  (Quote m, Data a)
-            =>  (forall b . Data b => b -> Maybe (m Exp))
-            ->  a
-            ->  m Exp
-dataToExpQ = dataToQa varOrConE litE (foldl appE)
-    where
-          -- Make sure that VarE is used if the Constr value relies on a
-          -- function underneath the surface (instead of a constructor).
-          -- See #10796.
-          varOrConE s =
-            case nameSpace s of
-                 Just VarName      -> return (VarE s)
-                 Just (FldName {}) -> return (VarE s)
-                 Just DataName     -> return (ConE 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 :: (Quote m, Data a) => a -> m Exp
-liftData = dataToExpQ (const Nothing)
-
--- | '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  ::  (Quote m, Data a)
-            =>  (forall b . Data b => b -> Maybe (m Pat))
-            ->  a
-            ->  m Pat
-dataToPatQ = dataToQa id litP conP
-    where litP l = return (LitP l)
-          conP n ps =
-            case nameSpace n of
-                Just DataName -> do
-                    ps' <- sequence ps
-                    return (ConP n [] ps')
-                _ -> error $ "Can't construct a pattern from name "
-                          ++ showName n
-
------------------------------------------------------
---              Names and uniques
------------------------------------------------------
-
-newtype ModName = ModName String        -- Module name
- deriving (Show,Eq,Ord,Data,Generic)
-
-newtype PkgName = PkgName String        -- package name
- deriving (Show,Eq,Ord,Data,Generic)
-
--- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.
-data Module = Module PkgName ModName -- package qualified module name
- deriving (Show,Eq,Ord,Data,Generic)
-
-newtype OccName = OccName String
- deriving (Show,Eq,Ord,Data,Generic)
-
-mkModName :: String -> ModName
-mkModName s = ModName s
-
-modString :: ModName -> String
-modString (ModName m) = m
-
-
-mkPkgName :: String -> PkgName
-mkPkgName s = PkgName s
-
-pkgString :: PkgName -> String
-pkgString (PkgName m) = m
-
-
------------------------------------------------------
---              OccName
------------------------------------------------------
-
-mkOccName :: String -> OccName
-mkOccName s = OccName s
-
-occString :: OccName -> String
-occString (OccName occ) = occ
-
-
------------------------------------------------------
---               Names
------------------------------------------------------
---
--- For "global" names ('NameG') we need a totally unique name,
--- so we must include the name-space of the thing
---
--- For unique-numbered things ('NameU'), we've got a unique reference
--- anyway, so no need for name space
---
--- For dynamically bound thing ('NameS') we probably want them to
--- in a context-dependent way, so again we don't want the name
--- space.  For example:
---
--- > let v = mkName "T" in [| data $v = $v |]
---
--- Here we use the same Name for both type constructor and data constructor
---
---
--- NameL and NameG are bound *outside* the TH syntax tree
--- either globally (NameG) or locally (NameL). Ex:
---
--- > f x = $(h [| (map, x) |])
---
--- The 'map' will be a NameG, and 'x' wil be a NameL
---
--- These Names should never appear in a binding position in a TH syntax tree
-
-{- $namecapture #namecapture#
-Much of 'Name' API is concerned with the problem of /name capture/, which
-can be seen in the following example.
-
-> f expr = [| let x = 0 in $expr |]
-> ...
-> g x = $( f [| x |] )
-> h y = $( f [| y |] )
-
-A naive desugaring of this would yield:
-
-> g x = let x = 0 in x
-> h y = let x = 0 in y
-
-All of a sudden, @g@ and @h@ have different meanings! In this case,
-we say that the @x@ in the RHS of @g@ has been /captured/
-by the binding of @x@ in @f@.
-
-What we actually want is for the @x@ in @f@ to be distinct from the
-@x@ in @g@, so we get the following desugaring:
-
-> g x = let x' = 0 in x
-> h y = let x' = 0 in y
-
-which avoids name capture as desired.
-
-In the general case, we say that a @Name@ can be captured if
-the thing it refers to can be changed by adding new declarations.
--}
-
-{- |
-An abstract type representing names in the syntax tree.
-
-'Name's can be constructed in several ways, which come with different
-name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
-an explanation of name capture):
-
-  * the built-in syntax @'f@ and @''T@ can be used to construct names,
-    The expression @'f@ gives a @Name@ which refers to the value @f@
-    currently in scope, and @''T@ gives a @Name@ which refers to the
-    type @T@ currently in scope. These names can never be captured.
-
-  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
-     @''T@ respectively, but the @Name@s are looked up at the point
-     where the current splice is being run. These names can never be
-     captured.
-
-  * 'newName' monadically generates a new name, which can never
-     be captured.
-
-  * 'mkName' generates a capturable name.
-
-Names constructed using @newName@ and @mkName@ may be used in bindings
-(such as @let x = ...@ or @\x -> ...@), but names constructed using
-@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
--}
-data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)
-
-instance Ord Name where
-    -- check if unique is different before looking at strings
-  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`
-                                        (o1 `compare` o2)
-
-data NameFlavour
-  = NameS           -- ^ An unqualified name; dynamically bound
-  | NameQ ModName   -- ^ A qualified name; dynamically bound
-  | NameU !Uniq     -- ^ A unique local name
-  | NameL !Uniq     -- ^ Local name bound outside of the TH AST
-  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
-                -- An original name (occurrences only, not binders)
-                -- Need the namespace too to be sure which
-                -- thing we are naming
-  deriving ( Data, Eq, Ord, Show, Generic )
-
-data NameSpace = VarName        -- ^ Variables
-               | DataName       -- ^ Data constructors
-               | TcClsName      -- ^ Type constructors and classes; Haskell has them
-                                -- in the same name space for now.
-               | FldName
-                 { fldParent :: !String
-                   -- ^ The textual name of the parent of the field.
-                   --
-                   --   - For a field of a datatype, this is the name of the first constructor
-                   --     of the datatype (regardless of whether this constructor has this field).
-                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.
-                 }
-               deriving( Eq, Ord, Show, Data, Generic )
-
--- | @Uniq@ is used by GHC to distinguish names from each other.
-type Uniq = Integer
-
--- | The name without its module prefix.
---
--- ==== __Examples__
---
--- >>> nameBase ''Data.Either.Either
--- "Either"
--- >>> nameBase (mkName "foo")
--- "foo"
--- >>> nameBase (mkName "Module.foo")
--- "foo"
-nameBase :: Name -> String
-nameBase (Name occ _) = occString occ
-
--- | Module prefix of a name, if it exists.
---
--- ==== __Examples__
---
--- >>> nameModule ''Data.Either.Either
--- Just "Data.Either"
--- >>> nameModule (mkName "foo")
--- Nothing
--- >>> nameModule (mkName "Module.foo")
--- Just "Module"
-nameModule :: Name -> Maybe String
-nameModule (Name _ (NameQ m))     = Just (modString m)
-nameModule (Name _ (NameG _ _ m)) = Just (modString m)
-nameModule _                      = Nothing
-
--- | A name's package, if it exists.
---
--- ==== __Examples__
---
--- >>> namePackage ''Data.Either.Either
--- Just "base"
--- >>> namePackage (mkName "foo")
--- Nothing
--- >>> namePackage (mkName "Module.foo")
--- Nothing
-namePackage :: Name -> Maybe String
-namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
-namePackage _                      = Nothing
-
--- | Returns whether a name represents an occurrence of a top-level variable
--- ('VarName'), data constructor ('DataName'), type constructor, or type class
--- ('TcClsName'). If we can't be sure, it returns 'Nothing'.
---
--- ==== __Examples__
---
--- >>> nameSpace 'Prelude.id
--- Just VarName
--- >>> nameSpace (mkName "id")
--- Nothing -- only works for top-level variable names
--- >>> nameSpace 'Data.Maybe.Just
--- Just DataName
--- >>> nameSpace ''Data.Maybe.Maybe
--- Just TcClsName
--- >>> nameSpace ''Data.Ord.Ord
--- Just TcClsName
-nameSpace :: Name -> Maybe NameSpace
-nameSpace (Name _ (NameG ns _ _)) = Just ns
-nameSpace _                       = Nothing
-
-{- |
-Generate a capturable name. Occurrences of such names will be
-resolved according to the Haskell scoping rules at the occurrence
-site.
-
-For example:
-
-> f = [| pi + $(varE (mkName "pi")) |]
-> ...
-> g = let pi = 3 in $f
-
-In this case, @g@ is desugared to
-
-> g = Prelude.pi + 3
-
-Note that @mkName@ may be used with qualified names:
-
-> mkName "Prelude.pi"
-
-See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
-be rewritten using 'Language.Haskell.TH.Lib.dyn' as
-
-> f = [| pi + $(dyn "pi") |]
--}
-mkName :: String -> Name
--- The string can have a '.', thus "Foo.baz",
--- giving a dynamically-bound qualified name,
--- in which case we want to generate a NameQ
---
--- Parse the string to see if it has a "." in it
--- so we know whether to generate a qualified or unqualified name
--- It's a bit tricky because we need to parse
---
--- > Foo.Baz.x   as    Qual Foo.Baz x
---
--- So we parse it from back to front
-mkName str
-  = split [] (reverse str)
-  where
-    split occ []        = Name (mkOccName occ) NameS
-    split occ ('.':rev) | not (null occ)
-                        , is_rev_mod_name rev
-                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
-        -- The 'not (null occ)' guard ensures that
-        --      mkName "&." = Name "&." NameS
-        -- The 'is_rev_mod' guards ensure that
-        --      mkName ".&" = Name ".&" NameS
-        --      mkName "^.." = Name "^.." NameS      -- #8633
-        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
-        -- This rather bizarre case actually happened; (.&.) is in Data.Bits
-    split occ (c:rev)   = split (c:occ) rev
-
-    -- Recognises a reversed module name xA.yB.C,
-    -- with at least one component,
-    -- and each component looks like a module name
-    --   (i.e. non-empty, starts with capital, all alpha)
-    is_rev_mod_name rev_mod_str
-      | (compt, rest) <- break (== '.') rev_mod_str
-      , not (null compt), isUpper (last compt), all is_mod_char compt
-      = case rest of
-          []             -> True
-          (_dot : rest') -> is_rev_mod_name rest'
-      | otherwise
-      = False
-
-    is_mod_char c = isAlphaNum c || c == '_' || c == '\''
-
--- | Only used internally
-mkNameU :: String -> Uniq -> Name
-mkNameU s u = Name (mkOccName s) (NameU u)
-
--- | Only used internally
-mkNameL :: String -> Uniq -> Name
-mkNameL s u = Name (mkOccName s) (NameL u)
-
--- | Only used internally
-mkNameQ :: String -> String -> Name
-mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))
-
--- | Used for 'x etc, but not available to the programmer
-mkNameG :: NameSpace -> String -> String -> String -> Name
-mkNameG ns pkg modu occ
-  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
-
-mkNameS :: String -> Name
-mkNameS n = Name (mkOccName n) NameS
-
-mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
-mkNameG_v  = mkNameG VarName
-mkNameG_tc = mkNameG TcClsName
-mkNameG_d  = mkNameG DataName
-
-mkNameG_fld :: String -- ^ package
-            -> String -- ^ module
-            -> String -- ^ parent (first constructor of parent type)
-            -> String -- ^ field name
-            -> Name
-mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ
-
-data NameIs = Alone | Applied | Infix
-
-showName :: Name -> String
-showName = showName' Alone
-
-showName' :: NameIs -> Name -> String
-showName' ni nm
- = case ni of
-       Alone        -> nms
-       Applied
-        | pnam      -> nms
-        | otherwise -> "(" ++ nms ++ ")"
-       Infix
-        | pnam      -> "`" ++ nms ++ "`"
-        | otherwise -> nms
-    where
-        -- For now, we make the NameQ and NameG print the same, even though
-        -- NameQ is a qualified name (so what it means depends on what the
-        -- current scope is), and NameG is an original name (so its meaning
-        -- should be independent of what's in scope.
-        -- We may well want to distinguish them in the end.
-        -- Ditto NameU and NameL
-        nms = case nm of
-          Name occ NameS          -> occString occ
-          Name occ (NameQ m)      -> modString m ++ "." ++ occString occ
-          Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
-          Name occ (NameU u)      -> occString occ ++ "_" ++ show u
-          Name occ (NameL u)      -> occString occ ++ "_" ++ show u
-
-        pnam = classify nms
-
-        -- True if we are function style, e.g. f, [], (,)
-        -- False if we are operator style, e.g. +, :+
-        classify "" = False -- shouldn't happen; . operator is handled below
-        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
-                            case dropWhile (/='.') xs of
-                                  (_:xs') -> classify xs'
-                                  []      -> True
-                        | otherwise = False
-
-instance Show Name where
-  show = showName
-
--- Tuple data and type constructors
--- | Tuple data constructor
-tupleDataName :: Int -> Name
--- | Tuple type constructor
-tupleTypeName :: Int -> Name
-
-tupleDataName n = mk_tup_name n DataName  True
-tupleTypeName n = mk_tup_name n TcClsName True
-
--- Unboxed tuple data and type constructors
--- | Unboxed tuple data constructor
-unboxedTupleDataName :: Int -> Name
--- | Unboxed tuple type constructor
-unboxedTupleTypeName :: Int -> Name
-
-unboxedTupleDataName n = mk_tup_name n DataName  False
-unboxedTupleTypeName n = mk_tup_name n TcClsName False
-
-mk_tup_name :: Int -> NameSpace -> Bool -> Name
-mk_tup_name n space boxed
-  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)
-  where
-    withParens thing
-      | boxed     = "("  ++ thing ++ ")"
-      | otherwise = "(#" ++ thing ++ "#)"
-    tup_occ | n == 0, space == TcClsName = if boxed then "Unit" else "Unit#"
-            | n == 1 = if boxed then solo else unboxed_solo
-            | space == TcClsName = "Tuple" ++ show n ++ if boxed then "" else "#"
-            | otherwise = withParens (replicate n_commas ',')
-    n_commas = n - 1
-    tup_mod  = mkModName (if boxed then "GHC.Tuple" else "GHC.Types")
-    solo
-      | space == DataName = "MkSolo"
-      | otherwise = "Solo"
-
-    unboxed_solo
-      | space == DataName = "(# #)"
-      | otherwise = "Solo#"
-
--- Unboxed sum data and type constructors
--- | Unboxed sum data constructor
-unboxedSumDataName :: SumAlt -> SumArity -> Name
--- | Unboxed sum type constructor
-unboxedSumTypeName :: SumArity -> Name
-
-unboxedSumDataName alt arity
-  | alt > arity
-  = error $ prefix ++ "Index out of bounds." ++ debug_info
-
-  | alt <= 0
-  = error $ prefix ++ "Alt must be > 0." ++ debug_info
-
-  | arity < 2
-  = error $ prefix ++ "Arity must be >= 2." ++ debug_info
-
-  | otherwise
-  = Name (mkOccName sum_occ)
-         (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
-
-  where
-    prefix     = "unboxedSumDataName: "
-    debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"
-
-    -- 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
-    nbars_after  = arity - alt
-
-unboxedSumTypeName arity
-  | arity < 2
-  = error $ "unboxedSumTypeName: Arity must be >= 2."
-         ++ " (arity: " ++ show arity ++ ")"
-
-  | otherwise
-  = Name (mkOccName sum_occ)
-         (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
-
-  where
-    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types
-    sum_occ = "Sum" ++ show arity ++ "#"
-
------------------------------------------------------
---              Locations
------------------------------------------------------
-
-data Loc
-  = Loc { loc_filename :: String
-        , loc_package  :: String
-        , loc_module   :: String
-        , loc_start    :: CharPos
-        , loc_end      :: CharPos }
-   deriving( Show, Eq, Ord, Data, Generic )
-
-type CharPos = (Int, Int)       -- ^ Line and character position
-
-
------------------------------------------------------
---
---      The Info returned by reification
---
------------------------------------------------------
-
--- | Obtained from 'reify' in the 'Q' Monad.
-data Info
-  =
-  -- | A class, with a list of its visible instances
-  ClassI
-      Dec
-      [InstanceDec]
-
-  -- | A class method
-  | ClassOpI
-       Name
-       Type
-       ParentName
-
-  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned
-  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified
-  -- declaration will never have derived instances attached to it (if you wish
-  -- to check for an instance, see 'reifyInstances').
-  | TyConI
-        Dec
-
-  -- | A type or data family, with a list of its visible instances. A closed
-  -- type family is returned with 0 instances.
-  | FamilyI
-        Dec
-        [InstanceDec]
-
-  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.
-  -- Examples: @(->)@, @Int#@.
-  | PrimTyConI
-       Name
-       Arity
-       Unlifted
-
-  -- | A data constructor
-  | DataConI
-       Name
-       Type
-       ParentName
-
-  -- | A pattern synonym
-  | PatSynI
-       Name
-       PatSynType
-
-  {- |
-  A \"value\" variable (as opposed to a type variable, see 'TyVarI').
-
-  The @Maybe Dec@ field contains @Just@ the declaration which
-  defined the variable - including the RHS of the declaration -
-  or else @Nothing@, in the case where the RHS is unavailable to
-  the compiler. At present, this value is /always/ @Nothing@:
-  returning the RHS has not yet been implemented because of
-  lack of interest.
-  -}
-  | VarI
-       Name
-       Type
-       (Maybe Dec)
-
-  {- |
-  A type variable.
-
-  The @Type@ field contains the type which underlies the variable.
-  At present, this is always @'VarT' theName@, but future changes
-  may permit refinement of this.
-  -}
-  | TyVarI      -- Scoped type variable
-        Name
-        Type    -- What it is bound to
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | Obtained from 'reifyModule' in the 'Q' Monad.
-data ModuleInfo =
-  -- | Contains the import list of the module.
-  ModuleInfo [Module]
-  deriving( Show, Eq, Ord, Data, Generic )
-
-{- |
-In 'ClassOpI' and 'DataConI', name of the parent class or type
--}
-type ParentName = Name
-
--- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a
--- particular data constructor. 'SumAlt's are one-indexed and should never
--- exceed the value of its corresponding 'SumArity'. For example:
---
--- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)
---
--- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)
-type SumAlt = Int
-
--- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of
--- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.
-type SumArity = Int
-
--- | In 'PrimTyConI', arity of the type constructor
-type Arity = Int
-
--- | In 'PrimTyConI', is the type constructor unlifted?
-type Unlifted = Bool
-
--- | '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']@)
---
---   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
---
---   * 'TySynInstD'
-type InstanceDec = Dec
-
-data Fixity          = Fixity Int FixityDirection
-    deriving( Eq, Ord, Show, Data, Generic )
-data FixityDirection = InfixL | InfixR | InfixN
-    deriving( Eq, Ord, Show, Data, Generic )
-
--- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
-maxPrecedence :: Int
-maxPrecedence = (9::Int)
-
--- | Default fixity: @infixl 9@
-defaultFixity :: Fixity
-defaultFixity = Fixity maxPrecedence InfixL
-
-
-{-
-Note [Unresolved infix]
-~~~~~~~~~~~~~~~~~~~~~~~
--}
-{- $infix #infix#
-
-When implementing antiquotation for quasiquoters, one often wants
-to parse strings into expressions:
-
-> parse :: String -> Maybe Exp
-
-But how should we parse @a + b * c@? If we don't know the fixities of
-@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
-+ b) * c@.
-
-In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',
-which stand for \"unresolved infix expression/pattern/type/promoted
-constructor\", respectively. When the compiler is given a splice containing a
-tree of @UInfixE@ applications such as
-
-> UInfixE
->   (UInfixE e1 op1 e2)
->   op2
->   (UInfixE e3 op3 e4)
-
-it will look up and the fixities of the relevant operators and
-reassociate the tree as necessary.
-
-  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',
-    which are of use for parsing expressions like
-
-    > (a + b * c) + d * e
-
-  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never
-    reassociated.
-
-  * The 'UInfixE' constructor doesn't support sections. Sections
-    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
-    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
-    outer-most section, and use 'UInfixE' constructors for all
-    other operators:
-
-    > InfixE
-    >   Just (UInfixE ...a + b * c...)
-    >   op
-    >   Nothing
-
-    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
-    into 'Exp's differently:
-
-    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)
-    >                    -- will result in a fixity error if (+) is left-infix
-    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
-    >                    -- no fixity errors
-
-  * Quoted expressions such as
-
-    > [| a * b + c |] :: Q Exp
-    > [p| a : b : c |] :: Q Pat
-    > [t| T + T |] :: Q Type
-
-    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',
-    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.
-
--}
-
------------------------------------------------------
---
---      The main syntax data types
---
------------------------------------------------------
-
-data Lit = CharL Char
-         | StringL String
-         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded
-                                -- literals. We don't have a good way to
-                                -- represent non-overloaded literals at
-                                -- the moment. Maybe that doesn't matter?
-         | RationalL Rational   -- Ditto
-         | IntPrimL Integer
-         | WordPrimL Integer
-         | FloatPrimL Rational
-         | DoublePrimL Rational
-         | StringPrimL [Word8]  -- ^ A primitive C-style string, type 'Addr#'
-         | BytesPrimL Bytes     -- ^ Some raw bytes, type 'Addr#':
-         | CharPrimL Char
-    deriving( Show, Eq, Ord, Data, Generic )
-
-    -- We could add Int, Float, Double etc, as we do in HsLit,
-    -- but that could complicate the
-    -- supposedly-simple TH.Syntax literal type
-
--- | Raw bytes embedded into the binary.
---
--- Avoid using Bytes constructor directly as it is likely to change in the
--- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.
-data Bytes = Bytes
-   { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data
-   , bytesOffset :: Word             -- ^ Offset from the pointer
-   , bytesSize   :: Word             -- ^ Number of bytes
-
-   -- Maybe someday:
-   -- , bytesAlignement  :: Word -- ^ Alignement constraint
-   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only
-   --                            --   section or not
-   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate
-   --                            --   an uninitialized region
-   }
-   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\' }@
-  | VarP Name                       -- ^ @{ x }@
-  | TupP [Pat]                      -- ^ @{ (p1,p2) }@
-  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@
-  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@
-  | ConP Name [Type] [Pat]          -- ^ @data T1 = C1 t1 t2; {C1 \@ty1 p1 p2} = e@
-  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@
-  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@
-                                    --
-                                    -- See "Language.Haskell.TH.Syntax#infix"
-  | ParensP Pat                     -- ^ @{(p)}@
-                                    --
-                                    -- See "Language.Haskell.TH.Syntax#infix"
-  | TildeP Pat                      -- ^ @{ ~p }@
-  | BangP Pat                       -- ^ @{ !p }@
-  | AsP Name Pat                    -- ^ @{ x \@ p }@
-  | WildP                           -- ^ @{ _ }@
-  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@
-  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@
-  | SigP Pat Type                   -- ^ @{ p :: t }@
-  | ViewP Exp Pat                   -- ^ @{ e -> p }@
-  | TypeP Type                      -- ^ @{ type p }@
-  | InvisP Type                     -- ^ @{ @p }@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-type FieldPat = (Name,Pat)
-
-data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
-    deriving( Show, Eq, Ord, Data, Generic )
-
-data Clause = Clause [Pat] Body [Dec]
-                                  -- ^ @f { p1 p2 = body where decs }@
-    deriving( Show, Eq, Ord, Data, Generic )
-
-data Exp
-  = VarE Name                          -- ^ @{ x }@
-  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @
-  | LitE Lit                           -- ^ @{ 5 or \'c\'}@
-  | AppE Exp Exp                       -- ^ @{ f x }@
-  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@
-
-  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
-
-    -- It's a bit gruesome to use an Exp as the operator when a Name
-    -- would suffice. Historically, Exp was used to make it easier to
-    -- distinguish between infix constructors and non-constructors.
-    -- This is a bit overkill, since one could just as well call
-    -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name.
-    -- Unfortunately, changing this design now would involve lots of
-    -- code churn for consumers of the TH API, so we continue to use
-    -- an Exp as the operator and perform an extra check during conversion
-    -- to ensure that the Exp is a constructor or a variable (#16895).
-
-  | UInfixE Exp Exp Exp                -- ^ @{x + y}@
-                                       --
-                                       -- See "Language.Haskell.TH.Syntax#infix"
-  | ParensE Exp                        -- ^ @{ (e) }@
-                                       --
-                                       -- See "Language.Haskell.TH.Syntax#infix"
-  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@
-  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@
-  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@
-  | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @
-                                       --
-                                       -- The 'Maybe' is necessary for handling
-                                       -- tuple sections.
-                                       --
-                                       -- > (1,)
-                                       --
-                                       -- translates to
-                                       --
-                                       -- > TupE [Just (LitE (IntegerL 1)),Nothing]
-
-  | UnboxedTupE [Maybe Exp]            -- ^ @{ (\# e1,e2 \#) }  @
-                                       --
-                                       -- The 'Maybe' is necessary for handling
-                                       -- tuple sections.
-                                       --
-                                       -- > (# 'c', #)
-                                       --
-                                       -- translates to
-                                       --
-                                       -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing]
-
-  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@
-  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@
-  | 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 (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
-      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
-      --
-      -- E.g. translation:
-      --
-      -- > [ f x | x <- xs ]
-      --
-      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
-
-  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@
-  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@
-  | SigE Exp Type                      -- ^ @{ e :: t }@
-  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@
-  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@
-  | StaticE Exp                        -- ^ @{ static e }@
-  | UnboundVarE Name                   -- ^ @{ _x }@
-                                       --
-                                       -- This is used for holes or unresolved
-                                       -- identifiers in AST quotes. Note that
-                                       -- it could either have a variable name
-                                       -- or constructor name.
-  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )
-  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )
-  | GetFieldE Exp String               -- ^ @{ exp.field }@ ( Overloaded Record Dot )
-  | ProjectionE (NonEmpty String)      -- ^ @(.x)@ or @(.x.y)@ (Record projections)
-  | TypedBracketE Exp                  -- ^ @[|| e ||]@
-  | TypedSpliceE Exp                   -- ^ @$$e@
-  | TypeE Type                         -- ^ @{ type t }@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-type FieldExp = (Name,Exp)
-
--- Omitted: implicit parameters
-
-data Body
-  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2
-                                 --      | e3 = e4 }
-                                 -- where ds@
-  | NormalB Exp              -- ^ @f p { = e } where ds@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-data Guard
-  = NormalG Exp -- ^ @f x { | odd x } = x@
-  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-data Stmt
-  = BindS Pat Exp -- ^ @p <- e@
-  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@
-  | NoBindS Exp   -- ^ @e@
-  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')
-  | RecS [Stmt]   -- ^ @rec { s1; s2 }@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-data Range = FromR Exp | FromThenR Exp Exp
-           | FromToR Exp Exp | FromThenToR Exp Exp Exp
-          deriving( Show, Eq, Ord, Data, Generic )
-
-data Dec
-  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
-  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
-  | DataD Cxt Name [TyVarBndr BndrVis]
-          (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 BndrVis]
-             (Maybe Kind)         -- Kind signature
-             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)
-                                  --       deriving (Z,W Q)
-                                  --       deriving stock Eq }@
-  | TypeDataD Name [TyVarBndr BndrVis]
-          (Maybe Kind)            -- Kind signature (allowed only for GADTs)
-          [Con]                   -- ^ @{ type data T x = A x | B (T x) }@
-  | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@
-  | ClassD Cxt Name [TyVarBndr BndrVis]
-         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
-  | InstanceD (Maybe Overlap) Cxt Type [Dec]
-                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}
-                                  --        Show w => Show [w] where ds }@
-  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@
-  | KiSigD Name Kind              -- ^ @{ type TypeRep :: k -> Type }@
-  | ForeignD Foreign              -- ^ @{ foreign import ... }
-                                  --{ foreign export ... }@
-
-  | InfixD Fixity NamespaceSpecifier Name
-                                  -- ^ @{ infix 3 data foo }@
-  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@
-
-  -- | pragmas
-  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@
-
-  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
-  | DataFamilyD Name [TyVarBndr BndrVis]
-               (Maybe Kind)
-         -- ^ @{ data family T a b c :: * }@
-
-  | 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
-                 (Maybe Kind)      -- Kind signature
-                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]
-                                   --        = A (B x)
-                                   --        deriving (Z,W)
-                                   --        deriving stock Eq }@
-  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@
-
-  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
-  | OpenTypeFamilyD TypeFamilyHead
-         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@
-
-  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]
-       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@
-
-  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@
-  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type
-       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@
-  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@
-
-  -- | Pattern Synonyms
-  | PatSynD Name PatSynArgs PatSynDir Pat
-      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or
-      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or
-      --   @{ pattern P v1 v2 .. vn <- p
-      --        where P v1 v2 .. vn = e  }@  explicit bidirectional
-      --
-      -- also, besides prefix pattern synonyms, both infix and record
-      -- pattern synonyms are supported. See 'PatSynArgs' for details
-
-  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.
-
-  | ImplicitParamBindD String Exp
-      -- ^ @{ ?x = expr }@
-      --
-      -- Implicit parameter binding declaration. Can only be used in let
-      -- and where clauses which consist entirely of implicit bindings.
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | A way to specify a namespace to look in when GHC needs to find
---   a name's source
-data NamespaceSpecifier
-  = NoNamespaceSpecifier   -- ^ Name may be everything; If there are two
-                           --   names in different namespaces, then consider both
-  | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a
-                           --   data type, type alias, type family, type class,
-                           --   or type variable
-  | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a
-                           --   function, data constructor, or pattern synonym
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | Varieties of allowed instance overlap.
-data Overlap = Overlappable   -- ^ May be overlapped by more specific instances
-             | Overlapping    -- ^ May overlap a more general instance
-             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'
-             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and
-                              -- pick an arbitrary one if multiple choices are
-                              -- available.
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | A single @deriving@ clause at the end of a datatype.
-data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
-    -- ^ @{ deriving stock (Eq, Ord) }@
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | What the user explicitly requests when deriving an instance.
-data DerivStrategy = StockStrategy    -- ^ A \"standard\" derived instance
-                   | AnyclassStrategy -- ^ @-XDeriveAnyClass@
-                   | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@
-                   | ViaStrategy Type -- ^ @-XDerivingVia@
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | A pattern synonym's type. Note that a pattern synonym's /fully/
--- specified type has a peculiar shape coming with two forall
--- quantifiers and two constraint contexts. For example, consider the
--- pattern synonym
---
--- > pattern P x1 x2 ... xn = <some-pattern>
---
--- P's complete type is of the following form
---
--- > pattern P :: forall universals.   required constraints
--- >           => forall existentials. provided constraints
--- >           => t1 -> t2 -> ... -> tn -> t
---
--- consisting of four parts:
---
---   1. the (possibly empty lists of) universally quantified type
---      variables and required constraints on them.
---   2. the (possibly empty lists of) existentially quantified
---      type variables and the provided constraints on them.
---   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively
---   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.
---
--- Pattern synonym types interact with TH when (a) reifying a pattern
--- synonym, (b) pretty printing, or (c) specifying a pattern synonym's
--- type signature explicitly:
---
---   * Reification always returns a pattern synonym's /fully/ specified
---     type in abstract syntax.
---
---   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates
---     a pattern synonym's type unambiguously in concrete syntax: The rule of
---     thumb is to print initial empty universals and the required
---     context as @() =>@, if existentials and a provided context
---     follow. If only universals and their required context, but no
---     existentials are specified, only the universals and their
---     required context are printed. If both or none are specified, so
---     both (or none) are printed.
---
---   * When specifying a pattern synonym's type explicitly with
---     'PatSynSigD' either one of the universals, the existentials, or
---     their contexts may be left empty.
---
--- See the GHC user's guide for more information on pattern synonyms
--- and their types:
--- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.
-type PatSynType = Type
-
--- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By
--- analogy with "head" for type classes and type class instances as
--- defined in /Type classes: an exploration of the design space/, the
--- @TypeFamilyHead@ is defined to be the elements of the declaration
--- between @type family@ and @where@.
-data TypeFamilyHead =
-  TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | One equation of a type family instance or closed type family. The
--- arguments are the left-hand-side type and the right-hand-side result.
---
--- For instance, if you had the following type family:
---
--- @
--- type family Foo (a :: k) :: k where
---   forall k (a :: k). Foo \@k a = a
--- @
---
--- The @Foo \@k a = a@ equation would be represented as follows:
---
--- @
--- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])
---            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))
---            ('VarT' a)
--- @
-data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type
-  deriving( Show, Eq, Ord, Data, Generic )
-
-data FunDep = FunDep [Name] [Name]
-  deriving( Show, Eq, Ord, Data, Generic )
-
-data Foreign = ImportF Callconv Safety String Name Type
-             | ExportF Callconv        String Name Type
-         deriving( Show, Eq, Ord, Data, Generic )
-
--- 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 )
-
-data Safety = Unsafe | Safe | Interruptible
-        deriving( Show, Eq, Ord, Data, Generic )
-
-data Pragma = InlineP         Name Inline RuleMatch Phases
-            | OpaqueP         Name
-            | SpecialiseP     Name Type (Maybe Inline) Phases
-            | SpecialiseInstP Type
-            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases
-            | AnnP            AnnTarget Exp
-            | LineP           Int String
-            | CompleteP       [Name] (Maybe Name)
-                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@
-            | SCCP            Name (Maybe String)
-                -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@
-        deriving( Show, Eq, Ord, Data, Generic )
-
-data Inline = NoInline
-            | Inline
-            | Inlinable
-            deriving (Show, Eq, Ord, Data, Generic)
-
-data RuleMatch = ConLike
-               | FunLike
-               deriving (Show, Eq, Ord, Data, Generic)
-
-data Phases = AllPhases
-            | FromPhase Int
-            | BeforePhase Int
-            deriving (Show, Eq, Ord, Data, Generic)
-
-data RuleBndr = RuleVar Name
-              | TypedRuleVar Name Type
-              deriving (Show, Eq, Ord, Data, Generic)
-
-data AnnTarget = ModuleAnnotation
-               | TypeAnnotation Name
-               | ValueAnnotation Name
-              deriving (Show, Eq, Ord, Data, Generic)
-
-type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@
-
--- | Since the advent of @ConstraintKinds@, constraints are really just types.
--- Equality constraints use the 'EqualityT' constructor. Constraints may also
--- be tuples of other constraints.
-type Pred = Type
-
--- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.
---
--- This may not agree with the annotations returned by 'reifyConStrictness'.
--- See 'reifyConStrictness' for more information.
-data SourceUnpackedness
-  = NoSourceUnpackedness -- ^ @C a@
-  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@
-  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@
-        deriving (Show, Eq, Ord, Data, Generic)
-
--- | 'SourceStrictness' corresponds to strictness annotations found in the source code.
---
--- This may not agree with the annotations returned by 'reifyConStrictness'.
--- See 'reifyConStrictness' for more information.
-data SourceStrictness = NoSourceStrictness    -- ^ @C a@
-                      | SourceLazy            -- ^ @C {~}a@
-                      | SourceStrict          -- ^ @C {!}a@
-        deriving (Show, Eq, Ord, Data, Generic)
-
--- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'
--- refers to the strictness annotations that the compiler chooses for a data constructor
--- field, which may be different from what is written in source code.
---
--- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,
--- such as the field of a newtype constructor and fields that have an unlifted type.
---
--- See 'reifyConStrictness' for more information.
-data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.
-                       | DecidedStrict -- ^ Field inferred to have a bang.
-                       | DecidedUnpack -- ^ Field inferred to be unpacked.
-        deriving (Show, Eq, Ord, Data, Generic)
-
--- | A data constructor.
---
--- The constructors for 'Con' can roughly be divided up into two categories:
--- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and
--- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and
--- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type
--- variables and class contexts, can surround either variety of constructor.
--- However, the type variables that it quantifies are different depending
--- on what constructor syntax is used:
---
--- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the
---   'ForallC' will only quantify /existential/ type variables. For example:
---
---   @
---   data Foo a = forall b. MkFoo a b
---   @
---
---   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.
---
--- * If a 'ForallC' surrounds a constructor with GADT syntax, then the
---   'ForallC' will quantify /all/ type variables used in the constructor.
---   For example:
---
---   @
---   data Bar a b where
---     MkBar :: (a ~ b) => c -> MkBar a b
---   @
---
---   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.
---
--- Multiplicity annotations for data types are currently not supported
--- in Template Haskell (i.e. all fields represented by Template Haskell
--- will be linear).
-data Con =
-  -- | @C Int a@
-    NormalC Name [BangType]
-
-  -- | @C { v :: Int, w :: a }@
-  | RecC Name [VarBangType]
-
-  -- | @Int :+ a@
-  | InfixC BangType Name BangType
-
-  -- | @forall a. Eq a => C [a]@
-  | ForallC [TyVarBndr Specificity] Cxt Con
-
-  -- @C :: a -> b -> T b Int@
-  | GadtC [Name]
-            -- ^ The list of constructors, corresponding to the GADT constructor
-            -- syntax @C1, C2 :: a -> T b@.
-            --
-            -- Invariant: the list must be non-empty.
-          [BangType] -- ^ The constructor arguments
-          Type -- ^ See Note [GADT return type]
-
-  -- | @C :: { v :: Int } -> T b Int@
-  | RecGadtC [Name]
-             -- ^ The list of constructors, corresponding to the GADT record
-             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.
-             --
-             -- Invariant: the list must be non-empty.
-             [VarBangType] -- ^ The constructor arguments
-             Type -- ^ See Note [GADT return type]
-        deriving (Show, Eq, Ord, Data, Generic)
-
--- Note [GADT return type]
--- ~~~~~~~~~~~~~~~~~~~~~~~
--- The return type of a GADT constructor does not necessarily match the name of
--- the data type:
---
--- type S = T
---
--- data T a where
---     MkT :: S Int
---
---
--- type S a = T
---
--- data T a where
---     MkT :: S Char Int
---
---
--- type Id a = a
--- type S a = T
---
--- data T a where
---     MkT :: Id (S Char Int)
---
---
--- That is why we allow the return type stored by a constructor to be an
--- arbitrary type. See also #11341
-
-data Bang = Bang SourceUnpackedness SourceStrictness
-         -- ^ @C { {\-\# UNPACK \#-\} !}a@
-        deriving (Show, Eq, Ord, Data, Generic)
-
-type BangType    = (Bang, Type)
-type VarBangType = (Name, Bang, Type)
-
--- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.
-type Strict      = Bang
-
--- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by
--- 'BangType'.
-type StrictType    = BangType
-
--- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by
--- 'VarBangType'.
-type VarStrictType = VarBangType
-
--- | A pattern synonym's directionality.
-data PatSynDir
-  = Unidir             -- ^ @pattern P x {<-} p@
-  | ImplBidir          -- ^ @pattern P x {=} p@
-  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | A pattern synonym's argument type.
-data PatSynArgs
-  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@
-  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@
-  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@
-  deriving( Show, Eq, Ord, Data, Generic )
-
-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@
-          | VarT Name                      -- ^ @a@
-          | ConT Name                      -- ^ @T@
-          | PromotedT Name                 -- ^ @'T@
-          | InfixT Type Name Type          -- ^ @T + T@
-          | UInfixT Type Name Type         -- ^ @T + T@
-                                           --
-                                           -- See "Language.Haskell.TH.Syntax#infix"
-          | PromotedInfixT Type Name Type  -- ^ @T :+: T@
-          | PromotedUInfixT Type Name Type -- ^ @T :+: T@
-                                           --
-                                           -- See "Language.Haskell.TH.Syntax#infix"
-          | ParensT Type                   -- ^ @(T)@
-
-          -- See Note [Representing concrete syntax in types]
-          | TupleT Int                     -- ^ @(,)@, @(,,)@, etc.
-          | UnboxedTupleT Int              -- ^ @(\#,\#)@, @(\#,,\#)@, etc.
-          | UnboxedSumT SumArity           -- ^ @(\#|\#)@, @(\#||\#)@, etc.
-          | ArrowT                         -- ^ @->@
-          | MulArrowT                      -- ^ @%n ->@
-                                           --
-                                           -- Generalised arrow type with multiplicity argument
-          | EqualityT                      -- ^ @~@
-          | ListT                          -- ^ @[]@
-          | PromotedTupleT Int             -- ^ @'()@, @'(,)@, @'(,,)@, etc.
-          | PromotedNilT                   -- ^ @'[]@
-          | PromotedConsT                  -- ^ @'(:)@
-          | StarT                          -- ^ @*@
-          | ConstraintT                    -- ^ @Constraint@
-          | LitT TyLit                     -- ^ @0@, @1@, @2@, etc.
-          | WildCardT                      -- ^ @_@
-          | ImplicitParamT String Type     -- ^ @?x :: t@
-      deriving( Show, Eq, Ord, Data, Generic )
-
-data Specificity = SpecifiedSpec          -- ^ @a@
-                 | InferredSpec           -- ^ @{a}@
-      deriving( Show, Eq, Ord, Data, Generic )
-
--- | The @flag@ type parameter is instantiated to one of the following types:
---
---   * 'Specificity' (examples: 'ForallC', 'ForallT')
---   * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)
---   * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'
---
-data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@
-                    | KindedTV Name flag Kind -- ^ @(a :: k)@
-      deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable )
-
-data BndrVis = BndrReq                    -- ^ @a@
-             | BndrInvis                  -- ^ @\@a@
-      deriving( Show, Eq, Ord, Data, Generic )
-
--- | Type family result signature
-data FamilyResultSig = NoSig              -- ^ no signature
-                     | KindSig  Kind      -- ^ @k@
-                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@
-      deriving( Show, Eq, Ord, Data, Generic )
-
--- | Injectivity annotation
-data InjectivityAnn = InjectivityAnn Name [Name]
-  deriving ( Show, Eq, Ord, Data, Generic )
-
-data TyLit = NumTyLit Integer             -- ^ @2@
-           | StrTyLit String              -- ^ @\"Hello\"@
-           | CharTyLit Char               -- ^ @\'C\'@, @since 4.16.0.0
-  deriving ( Show, Eq, Ord, Data, Generic )
-
--- | Role annotations
-data Role = NominalR            -- ^ @nominal@
-          | RepresentationalR   -- ^ @representational@
-          | PhantomR            -- ^ @phantom@
-          | InferR              -- ^ @_@
-  deriving( Show, Eq, Ord, Data, Generic )
-
--- | Annotation target for reifyAnnotations
-data AnnLookup = AnnLookupModule Module
-               | AnnLookupName Name
-               deriving( Show, Eq, Ord, Data, Generic )
-
--- | To avoid duplication between kinds and types, they
--- are defined to be the same. Naturally, you would never
--- have a type be 'StarT' and you would never have a kind
--- be 'SigT', but many of the other constructors are shared.
--- Note that the kind @Bool@ is denoted with 'ConT', not
--- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
--- not 'PromotedTupleT'.
-
-type Kind = Type
-
-{- Note [Representing concrete syntax in types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Haskell has a rich concrete syntax for types, including
-  t1 -> t2, (t1,t2), [t], and so on
-In TH we represent all of this using AppT, with a distinguished
-type constructor at the head.  So,
-  Type              TH representation
-  -----------------------------------------------
-  t1 -> t2          ArrowT `AppT` t2 `AppT` t2
-  [t]               ListT `AppT` t
-  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2
-  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2
-
-But if the original HsSyn used prefix application, we won't use
-these special TH constructors.  For example
-  [] t              ConT "[]" `AppT` t
-  (->) t            ConT "->" `AppT` t
-In this way we can faithfully represent in TH whether the original
-HsType used concrete syntax or not.
-
-The one case that doesn't fit this pattern is that of promoted lists
-  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2
-but it's very smelly because there really is no type constructor
-corresponding to PromotedListT. So we encode HsExplicitListTy with
-PromotedConsT and PromotedNilT (which *do* have underlying type
-constructors):
-  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`
-                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)
--}
-
--- | A location at which to attach Haddock documentation.
--- Note that adding documentation to a 'Name' defined oustide of the current
--- module will cause an error.
-data DocLoc
-  = ModuleDoc         -- ^ At the current module's header.
-  | DeclDoc Name      -- ^ At a declaration, not necessarily top level.
-  | ArgDoc Name Int   -- ^ At a specific argument of a function, indexed by its
-                      -- position.
-  | InstDoc Type      -- ^ At a class or family instance.
-  deriving ( Show, Eq, Ord, Data, Generic )
-
------------------------------------------------------
---              Internal helper functions
------------------------------------------------------
-
-cmpEq :: Ordering -> Bool
-cmpEq EQ = True
-cmpEq _  = False
-
-thenCmp :: Ordering -> Ordering -> Ordering
-thenCmp EQ o2 = o2
-thenCmp o1 _  = o1
-
-get_cons_names :: Con -> [Name]
-get_cons_names (NormalC n _)     = [n]
-get_cons_names (RecC n _)        = [n]
-get_cons_names (InfixC _ n _)    = [n]
-get_cons_names (ForallC _ _ con) = get_cons_names con
--- GadtC can have multiple names, e.g
--- > data Bar a where
--- >   MkBar1, MkBar2 :: a -> Bar a
--- Will have one GadtC with [MkBar1, MkBar2] as names
-get_cons_names (GadtC ns _ _)    = ns
-get_cons_names (RecGadtC ns _ _) = ns
+-- See Note [Tracking dependencies on primitives] in GHC.Internal.Base, wrinkle W4.
+import Language.Haskell.TH.Lib.Internal ()
diff --git a/libraries/template-haskell/template-haskell.cabal.in b/libraries/template-haskell/template-haskell.cabal.in
index aa0d1988e3f..6b2061c12f8 100644
--- a/libraries/template-haskell/template-haskell.cabal.in
+++ b/libraries/template-haskell/template-haskell.cabal.in
@@ -59,6 +59,7 @@ Library
         Language.Haskell.TH.LanguageExtensions
         Language.Haskell.TH.CodeDo
         Language.Haskell.TH.Lib.Internal
+        Language.Haskell.TH.Lib.Syntax
 
     other-modules:
         Language.Haskell.TH.Lib.Map
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index aaf1981868f..6ca6b90f76c 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -12,17 +12,17 @@ Derived class instances:
                 ((GHC.Internal.Base..)
                    GHC.Internal.Show.showSpace (GHC.Internal.Show.showsPrec 11 b2))))
   
-  instance Language.Haskell.TH.Syntax.Lift T14682.Foo where
-    Language.Haskell.TH.Syntax.lift (T14682.Foo a1 a2)
+  instance Language.Haskell.TH.Lib.Syntax.Lift T14682.Foo where
+    Language.Haskell.TH.Lib.Syntax.lift (T14682.Foo a1 a2)
       = [| T14682.Foo
-             $(Language.Haskell.TH.Syntax.lift a1)
-             $(Language.Haskell.TH.Syntax.lift a2) |]
-        pending(rn) [<spn, Language.Haskell.TH.Syntax.lift a2>,
-                     <spn, Language.Haskell.TH.Syntax.lift a1>]
-    Language.Haskell.TH.Syntax.liftTyped (T14682.Foo a1 a2)
+             $(Language.Haskell.TH.Lib.Syntax.lift a1)
+             $(Language.Haskell.TH.Lib.Syntax.lift a2) |]
+        pending(rn) [<spn, Language.Haskell.TH.Lib.Syntax.lift a2>,
+                     <spn, Language.Haskell.TH.Lib.Syntax.lift a1>]
+    Language.Haskell.TH.Lib.Syntax.liftTyped (T14682.Foo a1 a2)
       = [|| T14682.Foo
-              $$(Language.Haskell.TH.Syntax.liftTyped a1)
-              $$(Language.Haskell.TH.Syntax.liftTyped a2) ||]
+              $$(Language.Haskell.TH.Lib.Syntax.liftTyped a1)
+              $$(Language.Haskell.TH.Lib.Syntax.liftTyped a2) ||]
   
   instance GHC.Internal.Data.Data.Data T14682.Foo where
     GHC.Internal.Data.Data.gfoldl k z (T14682.Foo a1 a2)
diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
index a736bc12f7c..0fb0d6a6c41 100644
--- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
+++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
@@ -52,12 +52,12 @@ Derived class instances:
     GHC.Internal.Generics.to1 (GHC.Internal.Generics.M1 x)
       = case x of x -> case x of {}
   
-  instance Language.Haskell.TH.Syntax.Lift
+  instance Language.Haskell.TH.Lib.Syntax.Lift
              (DrvEmptyData.Void a) where
-    Language.Haskell.TH.Syntax.lift z
+    Language.Haskell.TH.Lib.Syntax.lift z
       = GHC.Internal.Base.pure (case z of {})
-    Language.Haskell.TH.Syntax.liftTyped z
-      = Language.Haskell.TH.Syntax.unsafeCodeCoerce
+    Language.Haskell.TH.Lib.Syntax.liftTyped z
+      = Language.Haskell.TH.Lib.Syntax.unsafeCodeCoerce
           (GHC.Internal.Base.pure (case z of {}))
   
   $tVoid :: GHC.Internal.Data.Data.DataType
diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout
index d2780dcd46e..23baf4990ed 100644
--- a/testsuite/tests/plugins/plugins10.stdout
+++ b/testsuite/tests/plugins/plugins10.stdout
@@ -5,7 +5,7 @@ interfacePlugin: Language.Haskell.TH.Quote
 interfacePlugin: GHC.Internal.Base
 interfacePlugin: GHC.Internal.Float
 interfacePlugin: GHC.Prim.Ext
-interfacePlugin: Language.Haskell.TH.Syntax
+interfacePlugin: Language.Haskell.TH.Lib.Syntax
 typeCheckPlugin (rn)
 typeCheckPlugin (tc)
 interfacePlugin: GHC.Num.BigNat
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
index 3b6672bbf1e..c5a38b4b6d7 100644
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ b/testsuite/tests/quotes/TH_localname.stderr
@@ -1,28 +1,28 @@
 
 TH_localname.hs:3:11: error: [GHC-39999]
-    • Ambiguous type variable ‘t0’ arising from a use of ‘Language.Haskell.TH.Syntax.lift’
-      prevents the constraint ‘(Language.Haskell.TH.Syntax.Lift
+    • Ambiguous type variable ‘t0’ arising from a use of ‘Language.Haskell.TH.Lib.Syntax.lift’
+      prevents the constraint ‘(Language.Haskell.TH.Lib.Syntax.Lift
                                   t0)’ from being solved.
       Relevant bindings include
         y :: t0 (bound at TH_localname.hs:3:6)
-        x :: t0 -> m0 Language.Haskell.TH.Syntax.Exp
+        x :: t0 -> m0 Language.Haskell.TH.Lib.Syntax.Exp
           (bound at TH_localname.hs:3:1)
       Probable fix: use a type annotation to specify what ‘t0’ should be.
       Potentially matching instances:
-        instance (Language.Haskell.TH.Syntax.Lift a,
-                  Language.Haskell.TH.Syntax.Lift b) =>
-                 Language.Haskell.TH.Syntax.Lift (Either a b)
-          -- Defined in ‘Language.Haskell.TH.Syntax’
-        instance Language.Haskell.TH.Syntax.Lift Integer
-          -- Defined in ‘Language.Haskell.TH.Syntax’
+        instance (Language.Haskell.TH.Lib.Syntax.Lift a,
+                  Language.Haskell.TH.Lib.Syntax.Lift b) =>
+                 Language.Haskell.TH.Lib.Syntax.Lift (Either a b)
+          -- Defined in ‘Language.Haskell.TH.Lib.Syntax’
+        instance Language.Haskell.TH.Lib.Syntax.Lift Integer
+          -- Defined in ‘Language.Haskell.TH.Lib.Syntax’
         ...plus 15 others
         ...plus 14 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
-    • In the expression: Language.Haskell.TH.Syntax.lift y
+    • In the expression: Language.Haskell.TH.Lib.Syntax.lift y
       In the expression:
         [| y |]
-        pending(rn) [<y, Language.Haskell.TH.Syntax.lift y>]
+        pending(rn) [<y, Language.Haskell.TH.Lib.Syntax.lift y>]
       In the expression:
         \ y
           -> [| y |]
-             pending(rn) [<y, Language.Haskell.TH.Syntax.lift y>]
+             pending(rn) [<y, Language.Haskell.TH.Lib.Syntax.lift y>]
diff --git a/testsuite/tests/th/T10796b.stderr b/testsuite/tests/th/T10796b.stderr
index fb0dce6a8cc..7c82db6b23d 100644
--- a/testsuite/tests/th/T10796b.stderr
+++ b/testsuite/tests/th/T10796b.stderr
@@ -3,7 +3,7 @@ T10796b.hs:8:15: error: [GHC-87897]
     • Exception when trying to run compile-time code:
         Can't construct a pattern from name Data.Set.Internal.fromList
 CallStack (from HasCallStack):
-  error, called at libraries/template-haskell/Language/Haskell/TH/Syntax.hs:1203:22 in template-haskell:Language.Haskell.TH.Syntax
+  error, called at libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs:1539:22 in template-haskell:Language.Haskell.TH.Lib.Syntax
       Code: (dataToPatQ (const Nothing) (fromList "test"))
     • In the untyped splice:
         $(dataToPatQ (const Nothing) (fromList "test"))
diff --git a/testsuite/tests/th/T11452.stderr b/testsuite/tests/th/T11452.stderr
index 28d0df48947..bb6d196b604 100644
--- a/testsuite/tests/th/T11452.stderr
+++ b/testsuite/tests/th/T11452.stderr
@@ -8,10 +8,10 @@ T11452.hs:6:12: error: [GHC-94642]
 
 T11452.hs:6:14: error: [GHC-91028]
     • Couldn't match type ‘p0’ with ‘forall a. a -> a’
-      Expected: Language.Haskell.TH.Syntax.Code
-                  Language.Haskell.TH.Syntax.Q ((forall a. a -> a) -> ())
-        Actual: Language.Haskell.TH.Syntax.Code
-                  Language.Haskell.TH.Syntax.Q (p0 -> ())
+      Expected: Language.Haskell.TH.Lib.Syntax.Code
+                  Language.Haskell.TH.Lib.Syntax.Q ((forall a. a -> a) -> ())
+        Actual: Language.Haskell.TH.Lib.Syntax.Code
+                  Language.Haskell.TH.Lib.Syntax.Q (p0 -> ())
       Cannot instantiate unification variable ‘p0’
       with a type involving polytypes: forall a. a -> a
     • In the Template Haskell quotation [|| \ _ -> () ||]
diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr
index d729f456b00..3ca708ec946 100644
--- a/testsuite/tests/th/T15321.stderr
+++ b/testsuite/tests/th/T15321.stderr
@@ -5,7 +5,7 @@ T15321.hs:9:9: error: [GHC-88464]
       In the untyped splice: $(_ "baz")
     • Valid hole fits include
         fail :: forall (m :: * -> *) a. MonadFail m => String -> m a
-          with fail @Language.Haskell.TH.Syntax.Q
-                    @Language.Haskell.TH.Syntax.Exp
+          with fail @Language.Haskell.TH.Lib.Syntax.Q
+                    @Language.Haskell.TH.Lib.Syntax.Exp
           (imported from ‘Prelude’ at T15321.hs:3:8-13
            (and originally defined in ‘GHC.Internal.Control.Monad.Fail’))
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index a17f7b3f358..111f858eb0c 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -2,10 +2,10 @@
 T7276.hs:6:5: error: [GHC-87897]
     • Exception when trying to run compile-time code:
         T7276.hs:6:8: error: [GHC-83865]
-    • Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
-                     with ‘Language.Haskell.TH.Syntax.Exp’
+    • Couldn't match type ‘[Language.Haskell.TH.Lib.Syntax.Dec]’
+                     with ‘Language.Haskell.TH.Lib.Syntax.Exp’
       Expected: Language.Haskell.TH.Lib.Internal.ExpQ
-        Actual: Language.Haskell.TH.Syntax.Q
+        Actual: Language.Haskell.TH.Lib.Syntax.Q
                   Language.Haskell.TH.Lib.Internal.Decs
     • In the expression: [d| y = 3 |]
       In the untyped splice: $([d| y = 3 |])
diff --git a/testsuite/tests/th/TH_NestedSplicesFail3.stderr b/testsuite/tests/th/TH_NestedSplicesFail3.stderr
index fe433256051..caf4b5abb6e 100644
--- a/testsuite/tests/th/TH_NestedSplicesFail3.stderr
+++ b/testsuite/tests/th/TH_NestedSplicesFail3.stderr
@@ -1,7 +1,8 @@
 
 TH_NestedSplicesFail3.hs:4:12: error: [GHC-39999]
-    • No instance for ‘Language.Haskell.TH.Syntax.Quote
-                         (Language.Haskell.TH.Syntax.Code Language.Haskell.TH.Syntax.Q)’
+    • No instance for ‘Language.Haskell.TH.Lib.Syntax.Quote
+                         (Language.Haskell.TH.Lib.Syntax.Code
+                            Language.Haskell.TH.Lib.Syntax.Q)’
         arising from a quotation bracket
     • In the expression: [| 'x' |]
       In the Template Haskell splice $$([| 'x' |])
diff --git a/testsuite/tests/th/TH_NestedSplicesFail4.stderr b/testsuite/tests/th/TH_NestedSplicesFail4.stderr
index e5adec5df1b..1c62b5aec7f 100644
--- a/testsuite/tests/th/TH_NestedSplicesFail4.stderr
+++ b/testsuite/tests/th/TH_NestedSplicesFail4.stderr
@@ -1,9 +1,10 @@
 
 TH_NestedSplicesFail4.hs:4:11: error: [GHC-83865]
-    • Couldn't match type: Language.Haskell.TH.Syntax.Code m0 Char
-                     with: Language.Haskell.TH.Syntax.Q Language.Haskell.TH.Syntax.Exp
+    • Couldn't match type: Language.Haskell.TH.Lib.Syntax.Code m0 Char
+                     with: Language.Haskell.TH.Lib.Syntax.Q
+                             Language.Haskell.TH.Lib.Syntax.Exp
       Expected: Language.Haskell.TH.Lib.Internal.ExpQ
-        Actual: Language.Haskell.TH.Syntax.Code m0 Char
+        Actual: Language.Haskell.TH.Lib.Syntax.Code m0 Char
     • In the Template Haskell quotation [|| 'y' ||]
       In the expression: [|| 'y' ||]
       In the untyped splice: $([|| 'y' ||])
-- 
GitLab