Modules (#13009)

* SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001
author: Sylvain Henry <sylvain@haskus.fr> 2020-04-05 17:39:13 +0200
committer: Sylvain Henry <sylvain@haskus.fr> 2020-04-18 20:04:46 +0200
commit: 15312bbb53f247c9ed2c5cf75100a9f44c1c7227 (patch)
tree: 8306dcc04a5b7c82464f903044dfdd589e7fdcd7 /compiler/GHC
parent: 3ca52151881451ce5b3a7740d003e811b586140d (diff)
download: haskell-15312bbb53f247c9ed2c5cf75100a9f44c1c7227.tar.gz
200 files changed, 28419 insertions, 615 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
new file mode 100644
index 0000000000..1b1bfdf7fe
--- /dev/null
+++ b/compiler/GHC/Builtin/Names.hs
@@ -0,0 +1,2490 @@
+{-
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[GHC.Builtin.Names]{Definitions of prelude modules and names}
+
+
+Nota Bene: all Names defined in here should come from the base package
+
+ - ModuleNames for prelude modules,
+        e.g.    pREL_BASE_Name :: ModuleName
+
+ - Modules for prelude modules
+        e.g.    pREL_Base :: Module
+
+ - Uniques for Ids, DataCons, TyCons and Classes that the compiler
+   "knows about" in some way
+        e.g.    intTyConKey :: Unique
+                minusClassOpKey :: Unique
+
+ - Names for Ids, DataCons, TyCons and Classes that the compiler
+   "knows about" in some way
+        e.g.    intTyConName :: Name
+                minusName    :: Name
+   One of these Names contains
+        (a) the module and occurrence name of the thing
+        (b) its Unique
+   The way the compiler "knows about" one of these things is
+   where the type checker or desugarer needs to look it up. For
+   example, when desugaring list comprehensions the desugarer
+   needs to conjure up 'foldr'.  It does this by looking up
+   foldrName in the environment.
+
+ - RdrNames for Ids, DataCons etc that the compiler may emit into
+   generated code (e.g. for deriving).  It's not necessary to know
+   the uniques for these guys, only their names
+
+
+Note [Known-key names]
+~~~~~~~~~~~~~~~~~~~~~~
+It is *very* important that the compiler gives wired-in things and
+things with "known-key" names the correct Uniques wherever they
+occur. We have to be careful about this in exactly two places:
+
+  1. When we parse some source code, renaming the AST better yield an
+     AST whose Names have the correct uniques
+
+  2. When we read an interface file, the read-in gubbins better have
+     the right uniques
+
+This is accomplished through a combination of mechanisms:
+
+  1. When parsing source code, the RdrName-decorated AST has some
+     RdrNames which are Exact. These are wired-in RdrNames where the
+     we could directly tell from the parsed syntax what Name to
+     use. For example, when we parse a [] in a type we can just insert
+     an Exact RdrName Name with the listTyConKey.
+
+     Currently, I believe this is just an optimisation: it would be
+     equally valid to just output Orig RdrNames that correctly record
+     the module etc we expect the final Name to come from. However,
+     were we to eliminate isBuiltInOcc_maybe it would become essential
+     (see point 3).
+
+  2. The knownKeyNames (which consist of the basicKnownKeyNames from
+     the module, and those names reachable via the wired-in stuff from
+     GHC.Builtin.Types) are used to initialise the "OrigNameCache" in
+     GHC.Iface.Env.  This initialization ensures that when the type checker
+     or renamer (both of which use GHC.Iface.Env) look up an original name
+     (i.e. a pair of a Module and an OccName) for a known-key name
+     they get the correct Unique.
+
+     This is the most important mechanism for ensuring that known-key
+     stuff gets the right Unique, and is why it is so important to
+     place your known-key names in the appropriate lists.
+
+  3. For "infinite families" of known-key names (i.e. tuples and sums), we
+     have to be extra careful. Because there are an infinite number of
+     these things, we cannot add them to the list of known-key names
+     used to initialise the OrigNameCache. Instead, we have to
+     rely on never having to look them up in that cache. See
+     Note [Infinite families of known-key names] for details.
+
+
+Note [Infinite families of known-key names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Infinite families of known-key things (e.g. tuples and sums) pose a tricky
+problem: we can't add them to the knownKeyNames finite map which we use to
+ensure that, e.g., a reference to (,) gets assigned the right unique (if this
+doesn't sound familiar see Note [Known-key names] above).
+
+We instead handle tuples and sums separately from the "vanilla" known-key
+things,
+
+  a) The parser recognises them specially and generates an Exact Name (hence not
+     looked up in the orig-name cache)
+
+  b) The known infinite families of names are specially serialised by
+     GHC.Iface.Binary.putName, with that special treatment detected when we read
+     back to ensure that we get back to the correct uniques. See Note [Symbol
+     table representation of names] in GHC.Iface.Binary and Note [How tuples
+     work] in GHC.Builtin.Types.
+
+Most of the infinite families cannot occur in source code, so mechanisms (a) and (b)
+suffice to ensure that they always have the right Unique. In particular,
+implicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned
+by the user. For those things that *can* appear in source programs,
+
+  c) GHC.Iface.Env.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax
+     directly onto the corresponding name, rather than trying to find it in the
+     original-name cache.
+
+     See also Note [Built-in syntax and the OrigNameCache]
+
+
+Note [The integer library]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Clearly, we need to know the names of various definitions of the integer
+library, e.g. the type itself, `mkInteger` etc. But there are two possible
+implementations of the integer library:
+
+ * integer-gmp (fast, but uses libgmp, which may not be available on all
+   targets and is GPL licensed)
+ * integer-simple (slow, but pure Haskell and BSD-licensed)
+
+We want the compiler to work with either one. The way we achieve this is:
+
+ * When compiling the integer-{gmp,simple} library, we pass
+     -this-unit-id  integer-wired-in
+   to GHC (see the cabal file libraries/integer-{gmp,simple}.
+ * This way, GHC can use just this UnitID (see Module.integerUnitId) when
+   generating code, and the linker will succeed.
+
+Unfortuately, the abstraction is not complete: When using integer-gmp, we
+really want to use the S# constructor directly. This is controlled by
+the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use
+this constructor directly (see  CorePrep.lookupIntegerSDataConName)
+
+When GHC reads the package data base, it (internally only) pretends it has UnitId
+`integer-wired-in` instead of the actual UnitId (which includes the version
+number); just like for `base` and other packages, as described in
+Note [Wired-in packages] in GHC.Types.Module. This is done in Packages.findWiredInPackages.
+-}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
+
+module GHC.Builtin.Names
+   ( Unique, Uniquable(..), hasKey,  -- Re-exported for convenience
+
+   -----------------------------------------------------------
+   module GHC.Builtin.Names, -- A huge bunch of (a) Names,  e.g. intTyConName
+                             --                 (b) Uniques e.g. intTyConKey
+                             --                 (c) Groups of classes and types
+                             --                 (d) miscellaneous things
+                             -- So many that we export them all
+   )
+where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Types.Module
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
+import GHC.Types.Unique
+import GHC.Types.Name
+import GHC.Types.SrcLoc
+import FastString
+
+{-
+************************************************************************
+*                                                                      *
+     allNameStrings
+*                                                                      *
+************************************************************************
+-}
+
+allNameStrings :: [String]
+-- Infinite list of a,b,c...z, aa, ab, ac, ... etc
+allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Local Names}
+*                                                                      *
+************************************************************************
+
+This *local* name is used by the interactive stuff
+-}
+
+itName :: Unique -> SrcSpan -> Name
+itName uniq loc = mkInternalName uniq (mkOccNameFS varName (fsLit "it")) loc
+
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: OccName -> Name
+mkUnboundName occ = mkInternalName unboundKey occ noSrcSpan
+
+isUnboundName :: Name -> Bool
+isUnboundName name = name `hasKey` unboundKey
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Known key Names}
+*                                                                      *
+************************************************************************
+
+This section tells what the compiler knows about the association of
+names with uniques.  These ones are the *non* wired-in ones.  The
+wired in ones are defined in GHC.Builtin.Types etc.
+-}
+
+basicKnownKeyNames :: [Name]  -- See Note [Known-key names]
+basicKnownKeyNames
+ = genericTyConNames
+ ++ [   --  Classes.  *Must* include:
+        --      classes that are grabbed by key (e.g., eqClassKey)
+        --      classes in "Class.standardClassKeys" (quite a few)
+        eqClassName,                    -- mentioned, derivable
+        ordClassName,                   -- derivable
+        boundedClassName,               -- derivable
+        numClassName,                   -- mentioned, numeric
+        enumClassName,                  -- derivable
+        monadClassName,
+        functorClassName,
+        realClassName,                  -- numeric
+        integralClassName,              -- numeric
+        fractionalClassName,            -- numeric
+        floatingClassName,              -- numeric
+        realFracClassName,              -- numeric
+        realFloatClassName,             -- numeric
+        dataClassName,
+        isStringClassName,
+        applicativeClassName,
+        alternativeClassName,
+        foldableClassName,
+        traversableClassName,
+        semigroupClassName, sappendName,
+        monoidClassName, memptyName, mappendName, mconcatName,
+
+        -- The IO type
+        -- See Note [TyConRepNames for non-wired-in TyCons]
+        ioTyConName, ioDataConName,
+        runMainIOName,
+        runRWName,
+
+        -- Type representation types
+        trModuleTyConName, trModuleDataConName,
+        trNameTyConName, trNameSDataConName, trNameDDataConName,
+        trTyConTyConName, trTyConDataConName,
+
+        -- Typeable
+        typeableClassName,
+        typeRepTyConName,
+        someTypeRepTyConName,
+        someTypeRepDataConName,
+        kindRepTyConName,
+        kindRepTyConAppDataConName,
+        kindRepVarDataConName,
+        kindRepAppDataConName,
+        kindRepFunDataConName,
+        kindRepTYPEDataConName,
+        kindRepTypeLitSDataConName,
+        kindRepTypeLitDDataConName,
+        typeLitSortTyConName,
+        typeLitSymbolDataConName,
+        typeLitNatDataConName,
+        typeRepIdName,
+        mkTrTypeName,
+        mkTrConName,
+        mkTrAppName,
+        mkTrFunName,
+        typeSymbolTypeRepName, typeNatTypeRepName,
+        trGhcPrimModuleName,
+
+        -- KindReps for common cases
+        starKindRepName,
+        starArrStarKindRepName,
+        starArrStarArrStarKindRepName,
+
+        -- Dynamic
+        toDynName,
+
+        -- Numeric stuff
+        negateName, minusName, geName, eqName,
+
+        -- Conversion functions
+        rationalTyConName,
+        ratioTyConName, ratioDataConName,
+        fromRationalName, fromIntegerName,
+        toIntegerName, toRationalName,
+        fromIntegralName, realToFracName,
+
+        -- Int# stuff
+        divIntName, modIntName,
+
+        -- String stuff
+        fromStringName,
+
+        -- Enum stuff
+        enumFromName, enumFromThenName,
+        enumFromThenToName, enumFromToName,
+
+        -- Applicative stuff
+        pureAName, apAName, thenAName,
+
+        -- Functor stuff
+        fmapName,
+
+        -- Monad stuff
+        thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
+        returnMName, joinMName,
+
+        -- MonadFail
+        monadFailClassName, failMName,
+
+        -- MonadFix
+        monadFixClassName, mfixName,
+
+        -- Arrow stuff
+        arrAName, composeAName, firstAName,
+        appAName, choiceAName, loopAName,
+
+        -- Ix stuff
+        ixClassName,
+
+        -- Show stuff
+        showClassName,
+
+        -- Read stuff
+        readClassName,
+
+        -- Stable pointers
+        newStablePtrName,
+
+        -- GHC Extensions
+        groupWithName,
+
+        -- Strings and lists
+        unpackCStringName,
+        unpackCStringFoldrName, unpackCStringUtf8Name,
+
+        -- Overloaded lists
+        isListClassName,
+        fromListName,
+        fromListNName,
+        toListName,
+
+        -- List operations
+        concatName, filterName, mapName,
+        zipName, foldrName, buildName, augmentName, appendName,
+
+        -- FFI primitive types that are not wired-in.
+        stablePtrTyConName, ptrTyConName, funPtrTyConName,
+        int8TyConName, int16TyConName, int32TyConName, int64TyConName,
+        word16TyConName, word32TyConName, word64TyConName,
+
+        -- Others
+        otherwiseIdName, inlineIdName,
+        eqStringName, assertName, breakpointName, breakpointCondName,
+        opaqueTyConName,
+        assertErrorName, traceName,
+        printName, fstName, sndName,
+        dollarName,
+
+        -- Integer
+        integerTyConName, mkIntegerName,
+        integerToWord64Name, integerToInt64Name,
+        word64ToIntegerName, int64ToIntegerName,
+        plusIntegerName, timesIntegerName, smallIntegerName,
+        wordToIntegerName,
+        integerToWordName, integerToIntName, minusIntegerName,
+        negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
+        absIntegerName, signumIntegerName,
+        leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
+        compareIntegerName, quotRemIntegerName, divModIntegerName,
+        quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
+        floatFromIntegerName, doubleFromIntegerName,
+        encodeFloatIntegerName, encodeDoubleIntegerName,
+        decodeDoubleIntegerName,
+        gcdIntegerName, lcmIntegerName,
+        andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
+        shiftLIntegerName, shiftRIntegerName, bitIntegerName,
+        integerSDataConName,naturalSDataConName,
+
+        -- Natural
+        naturalTyConName,
+        naturalFromIntegerName, naturalToIntegerName,
+        plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName,
+        wordToNaturalName,
+
+        -- Float/Double
+        rationalToFloatName,
+        rationalToDoubleName,
+
+        -- Other classes
+        randomClassName, randomGenClassName, monadPlusClassName,
+
+        -- Type-level naturals
+        knownNatClassName, knownSymbolClassName,
+
+        -- Overloaded labels
+        isLabelClassName,
+
+        -- Implicit Parameters
+        ipClassName,
+
+        -- Overloaded record fields
+        hasFieldClassName,
+
+        -- Call Stacks
+        callStackTyConName,
+        emptyCallStackName, pushCallStackName,
+
+        -- Source Locations
+        srcLocDataConName,
+
+        -- Annotation type checking
+        toAnnotationWrapperName
+
+        -- The Ordering type
+        , orderingTyConName
+        , ordLTDataConName, ordEQDataConName, ordGTDataConName
+
+        -- The SPEC type for SpecConstr
+        , specTyConName
+
+        -- The Either type
+        , eitherTyConName, leftDataConName, rightDataConName
+
+        -- Plugins
+        , pluginTyConName
+        , frontendPluginTyConName
+
+        -- Generics
+        , genClassName, gen1ClassName
+        , datatypeClassName, constructorClassName, selectorClassName
+
+        -- Monad comprehensions
+        , guardMName
+        , liftMName
+        , mzipName
+
+        -- GHCi Sandbox
+        , ghciIoClassName, ghciStepIoMName
+
+        -- StaticPtr
+        , makeStaticName
+        , staticPtrTyConName
+        , staticPtrDataConName, staticPtrInfoDataConName
+        , fromStaticPtrName
+
+        -- Fingerprint
+        , fingerprintDataConName
+
+        -- Custom type errors
+        , errorMessageTypeErrorFamName
+        , typeErrorTextDataConName
+        , typeErrorAppendDataConName
+        , typeErrorVAppendDataConName
+        , typeErrorShowTypeDataConName
+
+        -- Unsafe coercion proofs
+        , unsafeEqualityProofName
+        , unsafeEqualityTyConName
+        , unsafeReflDataConName
+        , unsafeCoercePrimName
+        , unsafeCoerceName
+    ]
+
+genericTyConNames :: [Name]
+genericTyConNames = [
+    v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
+    k1TyConName, m1TyConName, sumTyConName, prodTyConName,
+    compTyConName, rTyConName, dTyConName,
+    cTyConName, sTyConName, rec0TyConName,
+    d1TyConName, c1TyConName, s1TyConName, noSelTyConName,
+    repTyConName, rep1TyConName, uRecTyConName,
+    uAddrTyConName, uCharTyConName, uDoubleTyConName,
+    uFloatTyConName, uIntTyConName, uWordTyConName,
+    prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
+    rightAssociativeDataConName, notAssociativeDataConName,
+    sourceUnpackDataConName, sourceNoUnpackDataConName,
+    noSourceUnpackednessDataConName, sourceLazyDataConName,
+    sourceStrictDataConName, noSourceStrictnessDataConName,
+    decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,
+    metaDataDataConName, metaConsDataConName, metaSelDataConName
+  ]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Module names}
+*                                                                      *
+************************************************************************
+
+
+--MetaHaskell Extension Add a new module here
+-}
+
+pRELUDE :: Module
+pRELUDE         = mkBaseModule_ pRELUDE_NAME
+
+gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
+    gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
+    gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
+    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
+    gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING,
+    dATA_FOLDABLE, dATA_TRAVERSABLE,
+    gHC_CONC, gHC_IO, gHC_IO_Exception,
+    gHC_ST, gHC_IX, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,
+    gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC,
+    tYPEABLE, tYPEABLE_INTERNAL, gENERICS,
+    rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL,
+    aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS,
+    cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPENATS, dATA_TYPE_EQUALITY,
+    dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module
+
+gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
+gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
+gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
+gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")
+gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")
+gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers")
+
+gHC_BASE        = mkBaseModule (fsLit "GHC.Base")
+gHC_ENUM        = mkBaseModule (fsLit "GHC.Enum")
+gHC_GHCI        = mkBaseModule (fsLit "GHC.GHCi")
+gHC_GHCI_HELPERS= mkBaseModule (fsLit "GHC.GHCi.Helpers")
+gHC_SHOW        = mkBaseModule (fsLit "GHC.Show")
+gHC_READ        = mkBaseModule (fsLit "GHC.Read")
+gHC_NUM         = mkBaseModule (fsLit "GHC.Num")
+gHC_MAYBE       = mkBaseModule (fsLit "GHC.Maybe")
+gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type")
+gHC_NATURAL     = mkBaseModule (fsLit "GHC.Natural")
+gHC_LIST        = mkBaseModule (fsLit "GHC.List")
+gHC_TUPLE       = mkPrimModule (fsLit "GHC.Tuple")
+dATA_TUPLE      = mkBaseModule (fsLit "Data.Tuple")
+dATA_EITHER     = mkBaseModule (fsLit "Data.Either")
+dATA_LIST       = mkBaseModule (fsLit "Data.List")
+dATA_STRING     = mkBaseModule (fsLit "Data.String")
+dATA_FOLDABLE   = mkBaseModule (fsLit "Data.Foldable")
+dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable")
+gHC_CONC        = mkBaseModule (fsLit "GHC.Conc")
+gHC_IO          = mkBaseModule (fsLit "GHC.IO")
+gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception")
+gHC_ST          = mkBaseModule (fsLit "GHC.ST")
+gHC_IX          = mkBaseModule (fsLit "GHC.Ix")
+gHC_STABLE      = mkBaseModule (fsLit "GHC.Stable")
+gHC_PTR         = mkBaseModule (fsLit "GHC.Ptr")
+gHC_ERR         = mkBaseModule (fsLit "GHC.Err")
+gHC_REAL        = mkBaseModule (fsLit "GHC.Real")
+gHC_FLOAT       = mkBaseModule (fsLit "GHC.Float")
+gHC_TOP_HANDLER = mkBaseModule (fsLit "GHC.TopHandler")
+sYSTEM_IO       = mkBaseModule (fsLit "System.IO")
+dYNAMIC         = mkBaseModule (fsLit "Data.Dynamic")
+tYPEABLE        = mkBaseModule (fsLit "Data.Typeable")
+tYPEABLE_INTERNAL = mkBaseModule (fsLit "Data.Typeable.Internal")
+gENERICS        = mkBaseModule (fsLit "Data.Data")
+rEAD_PREC       = mkBaseModule (fsLit "Text.ParserCombinators.ReadPrec")
+lEX             = mkBaseModule (fsLit "Text.Read.Lex")
+gHC_INT         = mkBaseModule (fsLit "GHC.Int")
+gHC_WORD        = mkBaseModule (fsLit "GHC.Word")
+mONAD           = mkBaseModule (fsLit "Control.Monad")
+mONAD_FIX       = mkBaseModule (fsLit "Control.Monad.Fix")
+mONAD_ZIP       = mkBaseModule (fsLit "Control.Monad.Zip")
+mONAD_FAIL      = mkBaseModule (fsLit "Control.Monad.Fail")
+aRROW           = mkBaseModule (fsLit "Control.Arrow")
+cONTROL_APPLICATIVE = mkBaseModule (fsLit "Control.Applicative")
+gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar")
+rANDOM          = mkBaseModule (fsLit "System.Random")
+gHC_EXTS        = mkBaseModule (fsLit "GHC.Exts")
+cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
+gHC_GENERICS    = mkBaseModule (fsLit "GHC.Generics")
+gHC_TYPELITS    = mkBaseModule (fsLit "GHC.TypeLits")
+gHC_TYPENATS    = mkBaseModule (fsLit "GHC.TypeNats")
+dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality")
+dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")
+dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")
+uNSAFE_COERCE   = mkBaseModule (fsLit "Unsafe.Coerce")
+
+gHC_SRCLOC :: Module
+gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
+
+gHC_STACK, gHC_STACK_TYPES :: Module
+gHC_STACK = mkBaseModule (fsLit "GHC.Stack")
+gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types")
+
+gHC_STATICPTR :: Module
+gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr")
+
+gHC_STATICPTR_INTERNAL :: Module
+gHC_STATICPTR_INTERNAL = mkBaseModule (fsLit "GHC.StaticPtr.Internal")
+
+gHC_FINGERPRINT_TYPE :: Module
+gHC_FINGERPRINT_TYPE = mkBaseModule (fsLit "GHC.Fingerprint.Type")
+
+gHC_OVER_LABELS :: Module
+gHC_OVER_LABELS = mkBaseModule (fsLit "GHC.OverloadedLabels")
+
+gHC_RECORDS :: Module
+gHC_RECORDS = mkBaseModule (fsLit "GHC.Records")
+
+mAIN, rOOT_MAIN :: Module
+mAIN            = mkMainModule_ mAIN_NAME
+rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
+
+mkInteractiveModule :: Int -> Module
+-- (mkInteractiveMoudule 9) makes module 'interactive:M9'
+mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n))
+
+pRELUDE_NAME, mAIN_NAME :: ModuleName
+pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
+mAIN_NAME      = mkModuleNameFS (fsLit "Main")
+
+dATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName
+dATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit "Data.Array.Parallel")
+dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim")
+
+mkPrimModule :: FastString -> Module
+mkPrimModule m = mkModule primUnitId (mkModuleNameFS m)
+
+mkIntegerModule :: FastString -> Module
+mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m)
+
+mkBaseModule :: FastString -> Module
+mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m)
+
+mkBaseModule_ :: ModuleName -> Module
+mkBaseModule_ m = mkModule baseUnitId m
+
+mkThisGhcModule :: FastString -> Module
+mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m)
+
+mkThisGhcModule_ :: ModuleName -> Module
+mkThisGhcModule_ m = mkModule thisGhcUnitId m
+
+mkMainModule :: FastString -> Module
+mkMainModule m = mkModule mainUnitId (mkModuleNameFS m)
+
+mkMainModule_ :: ModuleName -> Module
+mkMainModule_ m = mkModule mainUnitId m
+
+{-
+************************************************************************
+*                                                                      *
+                        RdrNames
+*                                                                      *
+************************************************************************
+-}
+
+main_RDR_Unqual    :: RdrName
+main_RDR_Unqual = mkUnqual varName (fsLit "main")
+        -- We definitely don't want an Orig RdrName, because
+        -- main might, in principle, be imported into module Main
+
+eq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR,
+    ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName
+eq_RDR                  = nameRdrName eqName
+ge_RDR                  = nameRdrName geName
+le_RDR                  = varQual_RDR  gHC_CLASSES (fsLit "<=")
+lt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit "<")
+gt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit ">")
+compare_RDR             = varQual_RDR  gHC_CLASSES (fsLit "compare")
+ltTag_RDR               = nameRdrName  ordLTDataConName
+eqTag_RDR               = nameRdrName  ordEQDataConName
+gtTag_RDR               = nameRdrName  ordGTDataConName
+
+eqClass_RDR, numClass_RDR, ordClass_RDR, enumClass_RDR, monadClass_RDR
+    :: RdrName
+eqClass_RDR             = nameRdrName eqClassName
+numClass_RDR            = nameRdrName numClassName
+ordClass_RDR            = nameRdrName ordClassName
+enumClass_RDR           = nameRdrName enumClassName
+monadClass_RDR          = nameRdrName monadClassName
+
+map_RDR, append_RDR :: RdrName
+map_RDR                 = nameRdrName mapName
+append_RDR              = nameRdrName appendName
+
+foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR
+    :: RdrName
+foldr_RDR               = nameRdrName foldrName
+build_RDR               = nameRdrName buildName
+returnM_RDR             = nameRdrName returnMName
+bindM_RDR               = nameRdrName bindMName
+failM_RDR               = nameRdrName failMName
+
+left_RDR, right_RDR :: RdrName
+left_RDR                = nameRdrName leftDataConName
+right_RDR               = nameRdrName rightDataConName
+
+fromEnum_RDR, toEnum_RDR :: RdrName
+fromEnum_RDR            = varQual_RDR gHC_ENUM (fsLit "fromEnum")
+toEnum_RDR              = varQual_RDR gHC_ENUM (fsLit "toEnum")
+
+enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName
+enumFrom_RDR            = nameRdrName enumFromName
+enumFromTo_RDR          = nameRdrName enumFromToName
+enumFromThen_RDR        = nameRdrName enumFromThenName
+enumFromThenTo_RDR      = nameRdrName enumFromThenToName
+
+ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName
+ratioDataCon_RDR        = nameRdrName ratioDataConName
+plusInteger_RDR         = nameRdrName plusIntegerName
+timesInteger_RDR        = nameRdrName timesIntegerName
+
+ioDataCon_RDR :: RdrName
+ioDataCon_RDR           = nameRdrName ioDataConName
+
+eqString_RDR, unpackCString_RDR, unpackCStringFoldr_RDR,
+    unpackCStringUtf8_RDR :: RdrName
+eqString_RDR            = nameRdrName eqStringName
+unpackCString_RDR       = nameRdrName unpackCStringName
+unpackCStringFoldr_RDR  = nameRdrName unpackCStringFoldrName
+unpackCStringUtf8_RDR   = nameRdrName unpackCStringUtf8Name
+
+newStablePtr_RDR :: RdrName
+newStablePtr_RDR        = nameRdrName newStablePtrName
+
+bindIO_RDR, returnIO_RDR :: RdrName
+bindIO_RDR              = nameRdrName bindIOName
+returnIO_RDR            = nameRdrName returnIOName
+
+fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName
+fromInteger_RDR         = nameRdrName fromIntegerName
+fromRational_RDR        = nameRdrName fromRationalName
+minus_RDR               = nameRdrName minusName
+times_RDR               = varQual_RDR  gHC_NUM (fsLit "*")
+plus_RDR                = varQual_RDR gHC_NUM (fsLit "+")
+
+toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName
+toInteger_RDR           = nameRdrName toIntegerName
+toRational_RDR          = nameRdrName toRationalName
+fromIntegral_RDR        = nameRdrName fromIntegralName
+
+stringTy_RDR, fromString_RDR :: RdrName
+stringTy_RDR            = tcQual_RDR gHC_BASE (fsLit "String")
+fromString_RDR          = nameRdrName fromStringName
+
+fromList_RDR, fromListN_RDR, toList_RDR :: RdrName
+fromList_RDR = nameRdrName fromListName
+fromListN_RDR = nameRdrName fromListNName
+toList_RDR = nameRdrName toListName
+
+compose_RDR :: RdrName
+compose_RDR             = varQual_RDR gHC_BASE (fsLit ".")
+
+not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
+    and_RDR, range_RDR, inRange_RDR, index_RDR,
+    unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName
+and_RDR                 = varQual_RDR gHC_CLASSES (fsLit "&&")
+not_RDR                 = varQual_RDR gHC_CLASSES (fsLit "not")
+getTag_RDR              = varQual_RDR gHC_BASE (fsLit "getTag")
+succ_RDR                = varQual_RDR gHC_ENUM (fsLit "succ")
+pred_RDR                = varQual_RDR gHC_ENUM (fsLit "pred")
+minBound_RDR            = varQual_RDR gHC_ENUM (fsLit "minBound")
+maxBound_RDR            = varQual_RDR gHC_ENUM (fsLit "maxBound")
+range_RDR               = varQual_RDR gHC_IX (fsLit "range")
+inRange_RDR             = varQual_RDR gHC_IX (fsLit "inRange")
+index_RDR               = varQual_RDR gHC_IX (fsLit "index")
+unsafeIndex_RDR         = varQual_RDR gHC_IX (fsLit "unsafeIndex")
+unsafeRangeSize_RDR     = varQual_RDR gHC_IX (fsLit "unsafeRangeSize")
+
+readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR,
+    readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName
+readList_RDR            = varQual_RDR gHC_READ (fsLit "readList")
+readListDefault_RDR     = varQual_RDR gHC_READ (fsLit "readListDefault")
+readListPrec_RDR        = varQual_RDR gHC_READ (fsLit "readListPrec")
+readListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit "readListPrecDefault")
+readPrec_RDR            = varQual_RDR gHC_READ (fsLit "readPrec")
+parens_RDR              = varQual_RDR gHC_READ (fsLit "parens")
+choose_RDR              = varQual_RDR gHC_READ (fsLit "choose")
+lexP_RDR                = varQual_RDR gHC_READ (fsLit "lexP")
+expectP_RDR             = varQual_RDR gHC_READ (fsLit "expectP")
+
+readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName
+readField_RDR           = varQual_RDR gHC_READ (fsLit "readField")
+readFieldHash_RDR       = varQual_RDR gHC_READ (fsLit "readFieldHash")
+readSymField_RDR        = varQual_RDR gHC_READ (fsLit "readSymField")
+
+punc_RDR, ident_RDR, symbol_RDR :: RdrName
+punc_RDR                = dataQual_RDR lEX (fsLit "Punc")
+ident_RDR               = dataQual_RDR lEX (fsLit "Ident")
+symbol_RDR              = dataQual_RDR lEX (fsLit "Symbol")
+
+step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName
+step_RDR                = varQual_RDR  rEAD_PREC (fsLit "step")
+alt_RDR                 = varQual_RDR  rEAD_PREC (fsLit "+++")
+reset_RDR               = varQual_RDR  rEAD_PREC (fsLit "reset")
+prec_RDR                = varQual_RDR  rEAD_PREC (fsLit "prec")
+pfail_RDR               = varQual_RDR  rEAD_PREC (fsLit "pfail")
+
+showsPrec_RDR, shows_RDR, showString_RDR,
+    showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName
+showsPrec_RDR           = varQual_RDR gHC_SHOW (fsLit "showsPrec")
+shows_RDR               = varQual_RDR gHC_SHOW (fsLit "shows")
+showString_RDR          = varQual_RDR gHC_SHOW (fsLit "showString")
+showSpace_RDR           = varQual_RDR gHC_SHOW (fsLit "showSpace")
+showCommaSpace_RDR      = varQual_RDR gHC_SHOW (fsLit "showCommaSpace")
+showParen_RDR           = varQual_RDR gHC_SHOW (fsLit "showParen")
+
+error_RDR :: RdrName
+error_RDR = varQual_RDR gHC_ERR (fsLit "error")
+
+-- Generics (constructors and functions)
+u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
+  k1DataCon_RDR, m1DataCon_RDR, l1DataCon_RDR, r1DataCon_RDR,
+  prodDataCon_RDR, comp1DataCon_RDR,
+  unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR,
+  from_RDR, from1_RDR, to_RDR, to1_RDR,
+  datatypeName_RDR, moduleName_RDR, packageName_RDR, isNewtypeName_RDR,
+  conName_RDR, conFixity_RDR, conIsRecord_RDR, selName_RDR,
+  prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,
+  rightAssocDataCon_RDR, notAssocDataCon_RDR,
+  uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR,
+  uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR,
+  uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR,
+  uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName
+
+u1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "U1")
+par1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Par1")
+rec1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Rec1")
+k1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "K1")
+m1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "M1")
+
+l1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "L1")
+r1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "R1")
+
+prodDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit ":*:")
+comp1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Comp1")
+
+unPar1_RDR  = varQual_RDR gHC_GENERICS (fsLit "unPar1")
+unRec1_RDR  = varQual_RDR gHC_GENERICS (fsLit "unRec1")
+unK1_RDR    = varQual_RDR gHC_GENERICS (fsLit "unK1")
+unComp1_RDR = varQual_RDR gHC_GENERICS (fsLit "unComp1")
+
+from_RDR  = varQual_RDR gHC_GENERICS (fsLit "from")
+from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1")
+to_RDR    = varQual_RDR gHC_GENERICS (fsLit "to")
+to1_RDR   = varQual_RDR gHC_GENERICS (fsLit "to1")
+
+datatypeName_RDR  = varQual_RDR gHC_GENERICS (fsLit "datatypeName")
+moduleName_RDR    = varQual_RDR gHC_GENERICS (fsLit "moduleName")
+packageName_RDR   = varQual_RDR gHC_GENERICS (fsLit "packageName")
+isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")
+selName_RDR       = varQual_RDR gHC_GENERICS (fsLit "selName")
+conName_RDR       = varQual_RDR gHC_GENERICS (fsLit "conName")
+conFixity_RDR     = varQual_RDR gHC_GENERICS (fsLit "conFixity")
+conIsRecord_RDR   = varQual_RDR gHC_GENERICS (fsLit "conIsRecord")
+
+prefixDataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "Prefix")
+infixDataCon_RDR      = dataQual_RDR gHC_GENERICS (fsLit "Infix")
+leftAssocDataCon_RDR  = nameRdrName leftAssociativeDataConName
+rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName
+notAssocDataCon_RDR   = nameRdrName notAssociativeDataConName
+
+uAddrDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UAddr")
+uCharDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UChar")
+uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble")
+uFloatDataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "UFloat")
+uIntDataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "UInt")
+uWordDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UWord")
+
+uAddrHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uAddr#")
+uCharHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uChar#")
+uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#")
+uFloatHash_RDR  = varQual_RDR gHC_GENERICS (fsLit "uFloat#")
+uIntHash_RDR    = varQual_RDR gHC_GENERICS (fsLit "uInt#")
+uWordHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uWord#")
+
+fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,
+    foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,
+    mappend_RDR :: RdrName
+fmap_RDR                = nameRdrName fmapName
+replace_RDR             = varQual_RDR gHC_BASE (fsLit "<$")
+pure_RDR                = nameRdrName pureAName
+ap_RDR                  = nameRdrName apAName
+liftA2_RDR              = varQual_RDR gHC_BASE (fsLit "liftA2")
+foldable_foldr_RDR      = varQual_RDR dATA_FOLDABLE       (fsLit "foldr")
+foldMap_RDR             = varQual_RDR dATA_FOLDABLE       (fsLit "foldMap")
+null_RDR                = varQual_RDR dATA_FOLDABLE       (fsLit "null")
+all_RDR                 = varQual_RDR dATA_FOLDABLE       (fsLit "all")
+traverse_RDR            = varQual_RDR dATA_TRAVERSABLE    (fsLit "traverse")
+mempty_RDR              = nameRdrName memptyName
+mappend_RDR             = nameRdrName mappendName
+
+----------------------
+varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR
+    :: Module -> FastString -> RdrName
+varQual_RDR  mod str = mkOrig mod (mkOccNameFS varName str)
+tcQual_RDR   mod str = mkOrig mod (mkOccNameFS tcName str)
+clsQual_RDR  mod str = mkOrig mod (mkOccNameFS clsName str)
+dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Known-key names}
+*                                                                      *
+************************************************************************
+
+Many of these Names are not really "built in", but some parts of the
+compiler (notably the deriving mechanism) need to mention their names,
+and it's convenient to write them all down in one place.
+-}
+
+wildCardName :: Name
+wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
+
+runMainIOName, runRWName :: Name
+runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
+runRWName     = varQual gHC_MAGIC       (fsLit "runRW#")    runRWKey
+
+orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
+orderingTyConName = tcQual  gHC_TYPES (fsLit "Ordering") orderingTyConKey
+ordLTDataConName     = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey
+ordEQDataConName     = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey
+ordGTDataConName     = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey
+
+specTyConName :: Name
+specTyConName     = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey
+
+eitherTyConName, leftDataConName, rightDataConName :: Name
+eitherTyConName   = tcQual  dATA_EITHER (fsLit "Either") eitherTyConKey
+leftDataConName   = dcQual dATA_EITHER (fsLit "Left")   leftDataConKey
+rightDataConName  = dcQual dATA_EITHER (fsLit "Right")  rightDataConKey
+
+-- Generics (types)
+v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
+  k1TyConName, m1TyConName, sumTyConName, prodTyConName,
+  compTyConName, rTyConName, dTyConName,
+  cTyConName, sTyConName, rec0TyConName,
+  d1TyConName, c1TyConName, s1TyConName, noSelTyConName,
+  repTyConName, rep1TyConName, uRecTyConName,
+  uAddrTyConName, uCharTyConName, uDoubleTyConName,
+  uFloatTyConName, uIntTyConName, uWordTyConName,
+  prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
+  rightAssociativeDataConName, notAssociativeDataConName,
+  sourceUnpackDataConName, sourceNoUnpackDataConName,
+  noSourceUnpackednessDataConName, sourceLazyDataConName,
+  sourceStrictDataConName, noSourceStrictnessDataConName,
+  decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,
+  metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name
+
+v1TyConName  = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey
+u1TyConName  = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey
+par1TyConName  = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey
+rec1TyConName  = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey
+k1TyConName  = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey
+m1TyConName  = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey
+
+sumTyConName    = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey
+prodTyConName   = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey
+compTyConName   = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey
+
+rTyConName  = tcQual gHC_GENERICS (fsLit "R") rTyConKey
+dTyConName  = tcQual gHC_GENERICS (fsLit "D") dTyConKey
+cTyConName  = tcQual gHC_GENERICS (fsLit "C") cTyConKey
+sTyConName  = tcQual gHC_GENERICS (fsLit "S") sTyConKey
+
+rec0TyConName  = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey
+d1TyConName  = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey
+c1TyConName  = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey
+s1TyConName  = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey
+noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey
+
+repTyConName  = tcQual gHC_GENERICS (fsLit "Rep")  repTyConKey
+rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey
+
+uRecTyConName      = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey
+uAddrTyConName     = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey
+uCharTyConName     = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey
+uDoubleTyConName   = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey
+uFloatTyConName    = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey
+uIntTyConName      = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey
+uWordTyConName     = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey
+
+prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI")  prefixIDataConKey
+infixIDataConName  = dcQual gHC_GENERICS (fsLit "InfixI")   infixIDataConKey
+leftAssociativeDataConName  = dcQual gHC_GENERICS (fsLit "LeftAssociative")   leftAssociativeDataConKey
+rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative")  rightAssociativeDataConKey
+notAssociativeDataConName   = dcQual gHC_GENERICS (fsLit "NotAssociative")    notAssociativeDataConKey
+
+sourceUnpackDataConName         = dcQual gHC_GENERICS (fsLit "SourceUnpack")         sourceUnpackDataConKey
+sourceNoUnpackDataConName       = dcQual gHC_GENERICS (fsLit "SourceNoUnpack")       sourceNoUnpackDataConKey
+noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey
+sourceLazyDataConName           = dcQual gHC_GENERICS (fsLit "SourceLazy")           sourceLazyDataConKey
+sourceStrictDataConName         = dcQual gHC_GENERICS (fsLit "SourceStrict")         sourceStrictDataConKey
+noSourceStrictnessDataConName   = dcQual gHC_GENERICS (fsLit "NoSourceStrictness")   noSourceStrictnessDataConKey
+decidedLazyDataConName          = dcQual gHC_GENERICS (fsLit "DecidedLazy")          decidedLazyDataConKey
+decidedStrictDataConName        = dcQual gHC_GENERICS (fsLit "DecidedStrict")        decidedStrictDataConKey
+decidedUnpackDataConName        = dcQual gHC_GENERICS (fsLit "DecidedUnpack")        decidedUnpackDataConKey
+
+metaDataDataConName  = dcQual gHC_GENERICS (fsLit "MetaData")  metaDataDataConKey
+metaConsDataConName  = dcQual gHC_GENERICS (fsLit "MetaCons")  metaConsDataConKey
+metaSelDataConName   = dcQual gHC_GENERICS (fsLit "MetaSel")   metaSelDataConKey
+
+-- Primitive Int
+divIntName, modIntName :: Name
+divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey
+modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey
+
+-- Base strings Strings
+unpackCStringName, unpackCStringFoldrName,
+    unpackCStringUtf8Name, eqStringName :: Name
+unpackCStringName       = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
+unpackCStringFoldrName  = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey
+unpackCStringUtf8Name   = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey
+eqStringName            = varQual gHC_BASE (fsLit "eqString")  eqStringIdKey
+
+-- The 'inline' function
+inlineIdName :: Name
+inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
+
+-- Base classes (Eq, Ord, Functor)
+fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
+eqClassName       = clsQual gHC_CLASSES (fsLit "Eq")      eqClassKey
+eqName            = varQual gHC_CLASSES (fsLit "==")      eqClassOpKey
+ordClassName      = clsQual gHC_CLASSES (fsLit "Ord")     ordClassKey
+geName            = varQual gHC_CLASSES (fsLit ">=")      geClassOpKey
+functorClassName  = clsQual gHC_BASE    (fsLit "Functor") functorClassKey
+fmapName          = varQual gHC_BASE    (fsLit "fmap")    fmapClassOpKey
+
+-- Class Monad
+monadClassName, thenMName, bindMName, returnMName :: Name
+monadClassName     = clsQual gHC_BASE (fsLit "Monad")  monadClassKey
+thenMName          = varQual gHC_BASE (fsLit ">>")     thenMClassOpKey
+bindMName          = varQual gHC_BASE (fsLit ">>=")    bindMClassOpKey
+returnMName        = varQual gHC_BASE (fsLit "return") returnMClassOpKey
+
+-- Class MonadFail
+monadFailClassName, failMName :: Name
+monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey
+failMName          = varQual mONAD_FAIL (fsLit "fail")      failMClassOpKey
+
+-- Class Applicative
+applicativeClassName, pureAName, apAName, thenAName :: Name
+applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey
+apAName              = varQual gHC_BASE (fsLit "<*>")         apAClassOpKey
+pureAName            = varQual gHC_BASE (fsLit "pure")        pureAClassOpKey
+thenAName            = varQual gHC_BASE (fsLit "*>")          thenAClassOpKey
+
+-- Classes (Foldable, Traversable)
+foldableClassName, traversableClassName :: Name
+foldableClassName     = clsQual  dATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey
+traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey
+
+-- Classes (Semigroup, Monoid)
+semigroupClassName, sappendName :: Name
+semigroupClassName = clsQual gHC_BASE       (fsLit "Semigroup") semigroupClassKey
+sappendName        = varQual gHC_BASE       (fsLit "<>")        sappendClassOpKey
+monoidClassName, memptyName, mappendName, mconcatName :: Name
+monoidClassName    = clsQual gHC_BASE       (fsLit "Monoid")    monoidClassKey
+memptyName         = varQual gHC_BASE       (fsLit "mempty")    memptyClassOpKey
+mappendName        = varQual gHC_BASE       (fsLit "mappend")   mappendClassOpKey
+mconcatName        = varQual gHC_BASE       (fsLit "mconcat")   mconcatClassOpKey
+
+
+
+-- AMP additions
+
+joinMName, alternativeClassName :: Name
+joinMName            = varQual gHC_BASE (fsLit "join")        joinMIdKey
+alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey
+
+--
+joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey,
+    alternativeClassKey :: Unique
+joinMIdKey          = mkPreludeMiscIdUnique 750
+apAClassOpKey       = mkPreludeMiscIdUnique 751 -- <*>
+pureAClassOpKey     = mkPreludeMiscIdUnique 752
+thenAClassOpKey     = mkPreludeMiscIdUnique 753
+alternativeClassKey = mkPreludeMiscIdUnique 754
+
+
+-- Functions for GHC extensions
+groupWithName :: Name
+groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey
+
+-- Random PrelBase functions
+fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
+    mapName, appendName, assertName,
+    breakpointName, breakpointCondName,
+    opaqueTyConName, dollarName :: Name
+dollarName        = varQual gHC_BASE (fsLit "$")          dollarIdKey
+otherwiseIdName   = varQual gHC_BASE (fsLit "otherwise")  otherwiseIdKey
+foldrName         = varQual gHC_BASE (fsLit "foldr")      foldrIdKey
+buildName         = varQual gHC_BASE (fsLit "build")      buildIdKey
+augmentName       = varQual gHC_BASE (fsLit "augment")    augmentIdKey
+mapName           = varQual gHC_BASE (fsLit "map")        mapIdKey
+appendName        = varQual gHC_BASE (fsLit "++")         appendIdKey
+assertName        = varQual gHC_BASE (fsLit "assert")     assertIdKey
+breakpointName    = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey
+breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey
+opaqueTyConName   = tcQual  gHC_BASE (fsLit "Opaque")     opaqueTyConKey
+fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey
+
+-- PrelTup
+fstName, sndName :: Name
+fstName           = varQual dATA_TUPLE (fsLit "fst") fstIdKey
+sndName           = varQual dATA_TUPLE (fsLit "snd") sndIdKey
+
+-- Module GHC.Num
+numClassName, fromIntegerName, minusName, negateName :: Name
+numClassName      = clsQual gHC_NUM (fsLit "Num")         numClassKey
+fromIntegerName   = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
+minusName         = varQual gHC_NUM (fsLit "-")           minusClassOpKey
+negateName        = varQual gHC_NUM (fsLit "negate")      negateClassOpKey
+
+integerTyConName, mkIntegerName, integerSDataConName,
+    integerToWord64Name, integerToInt64Name,
+    word64ToIntegerName, int64ToIntegerName,
+    plusIntegerName, timesIntegerName, smallIntegerName,
+    wordToIntegerName,
+    integerToWordName, integerToIntName, minusIntegerName,
+    negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
+    absIntegerName, signumIntegerName,
+    leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
+    compareIntegerName, quotRemIntegerName, divModIntegerName,
+    quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
+    floatFromIntegerName, doubleFromIntegerName,
+    encodeFloatIntegerName, encodeDoubleIntegerName,
+    decodeDoubleIntegerName,
+    gcdIntegerName, lcmIntegerName,
+    andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
+    shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name
+integerTyConName      = tcQual gHC_INTEGER_TYPE (fsLit "Integer")           integerTyConKey
+integerSDataConName   = dcQual gHC_INTEGER_TYPE (fsLit "S#")                integerSDataConKey
+mkIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "mkInteger")         mkIntegerIdKey
+integerToWord64Name   = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64")   integerToWord64IdKey
+integerToInt64Name    = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64")    integerToInt64IdKey
+word64ToIntegerName   = varQual gHC_INTEGER_TYPE (fsLit "word64ToInteger")   word64ToIntegerIdKey
+int64ToIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "int64ToInteger")    int64ToIntegerIdKey
+plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey
+timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey
+smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey
+wordToIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger")     wordToIntegerIdKey
+integerToWordName     = varQual gHC_INTEGER_TYPE (fsLit "integerToWord")     integerToWordIdKey
+integerToIntName      = varQual gHC_INTEGER_TYPE (fsLit "integerToInt")      integerToIntIdKey
+minusIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "minusInteger")      minusIntegerIdKey
+negateIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "negateInteger")     negateIntegerIdKey
+eqIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "eqInteger#")        eqIntegerPrimIdKey
+neqIntegerPrimName    = varQual gHC_INTEGER_TYPE (fsLit "neqInteger#")       neqIntegerPrimIdKey
+absIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "absInteger")        absIntegerIdKey
+signumIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "signumInteger")     signumIntegerIdKey
+leIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "leInteger#")        leIntegerPrimIdKey
+gtIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "gtInteger#")        gtIntegerPrimIdKey
+ltIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "ltInteger#")        ltIntegerPrimIdKey
+geIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "geInteger#")        geIntegerPrimIdKey
+compareIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "compareInteger")    compareIntegerIdKey
+quotRemIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger")    quotRemIntegerIdKey
+divModIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "divModInteger")     divModIntegerIdKey
+quotIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "quotInteger")       quotIntegerIdKey
+remIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "remInteger")        remIntegerIdKey
+divIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "divInteger")        divIntegerIdKey
+modIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "modInteger")        modIntegerIdKey
+floatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger")      floatFromIntegerIdKey
+doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger")     doubleFromIntegerIdKey
+encodeFloatIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger")  encodeFloatIntegerIdKey
+encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey
+decodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "decodeDoubleInteger") decodeDoubleIntegerIdKey
+gcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger")        gcdIntegerIdKey
+lcmIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger")        lcmIntegerIdKey
+andIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "andInteger")        andIntegerIdKey
+orIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "orInteger")         orIntegerIdKey
+xorIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "xorInteger")        xorIntegerIdKey
+complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey
+shiftLIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger")     shiftLIntegerIdKey
+shiftRIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger")     shiftRIntegerIdKey
+bitIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "bitInteger")        bitIntegerIdKey
+
+-- GHC.Natural types
+naturalTyConName, naturalSDataConName :: Name
+naturalTyConName     = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey
+naturalSDataConName  = dcQual gHC_NATURAL (fsLit "NatS#")   naturalSDataConKey
+
+naturalFromIntegerName :: Name
+naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey
+
+naturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName,
+   mkNaturalName, wordToNaturalName :: Name
+naturalToIntegerName  = varQual gHC_NATURAL (fsLit "naturalToInteger")  naturalToIntegerIdKey
+plusNaturalName       = varQual gHC_NATURAL (fsLit "plusNatural")       plusNaturalIdKey
+minusNaturalName      = varQual gHC_NATURAL (fsLit "minusNatural")      minusNaturalIdKey
+timesNaturalName      = varQual gHC_NATURAL (fsLit "timesNatural")      timesNaturalIdKey
+mkNaturalName         = varQual gHC_NATURAL (fsLit "mkNatural")         mkNaturalIdKey
+wordToNaturalName     = varQual gHC_NATURAL (fsLit "wordToNatural#")    wordToNaturalIdKey
+
+-- GHC.Real types and classes
+rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
+    integralClassName, realFracClassName, fractionalClassName,
+    fromRationalName, toIntegerName, toRationalName, fromIntegralName,
+    realToFracName :: Name
+rationalTyConName   = tcQual  gHC_REAL (fsLit "Rational")     rationalTyConKey
+ratioTyConName      = tcQual  gHC_REAL (fsLit "Ratio")        ratioTyConKey
+ratioDataConName    = dcQual  gHC_REAL (fsLit ":%")           ratioDataConKey
+realClassName       = clsQual gHC_REAL (fsLit "Real")         realClassKey
+integralClassName   = clsQual gHC_REAL (fsLit "Integral")     integralClassKey
+realFracClassName   = clsQual gHC_REAL (fsLit "RealFrac")     realFracClassKey
+fractionalClassName = clsQual gHC_REAL (fsLit "Fractional")   fractionalClassKey
+fromRationalName    = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey
+toIntegerName       = varQual gHC_REAL (fsLit "toInteger")    toIntegerClassOpKey
+toRationalName      = varQual gHC_REAL (fsLit "toRational")   toRationalClassOpKey
+fromIntegralName    = varQual  gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey
+realToFracName      = varQual  gHC_REAL (fsLit "realToFrac")  realToFracIdKey
+
+-- PrelFloat classes
+floatingClassName, realFloatClassName :: Name
+floatingClassName  = clsQual gHC_FLOAT (fsLit "Floating")  floatingClassKey
+realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
+
+-- other GHC.Float functions
+rationalToFloatName, rationalToDoubleName :: Name
+rationalToFloatName  = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
+rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
+
+-- Class Ix
+ixClassName :: Name
+ixClassName = clsQual gHC_IX (fsLit "Ix") ixClassKey
+
+-- Typeable representation types
+trModuleTyConName
+  , trModuleDataConName
+  , trNameTyConName
+  , trNameSDataConName
+  , trNameDDataConName
+  , trTyConTyConName
+  , trTyConDataConName
+  :: Name
+trModuleTyConName     = tcQual gHC_TYPES          (fsLit "Module")         trModuleTyConKey
+trModuleDataConName   = dcQual gHC_TYPES          (fsLit "Module")         trModuleDataConKey
+trNameTyConName       = tcQual gHC_TYPES          (fsLit "TrName")         trNameTyConKey
+trNameSDataConName    = dcQual gHC_TYPES          (fsLit "TrNameS")        trNameSDataConKey
+trNameDDataConName    = dcQual gHC_TYPES          (fsLit "TrNameD")        trNameDDataConKey
+trTyConTyConName      = tcQual gHC_TYPES          (fsLit "TyCon")          trTyConTyConKey
+trTyConDataConName    = dcQual gHC_TYPES          (fsLit "TyCon")          trTyConDataConKey
+
+kindRepTyConName
+  , kindRepTyConAppDataConName
+  , kindRepVarDataConName
+  , kindRepAppDataConName
+  , kindRepFunDataConName
+  , kindRepTYPEDataConName
+  , kindRepTypeLitSDataConName
+  , kindRepTypeLitDDataConName
+  :: Name
+kindRepTyConName      = tcQual gHC_TYPES          (fsLit "KindRep")        kindRepTyConKey
+kindRepTyConAppDataConName = dcQual gHC_TYPES     (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
+kindRepVarDataConName = dcQual gHC_TYPES          (fsLit "KindRepVar")     kindRepVarDataConKey
+kindRepAppDataConName = dcQual gHC_TYPES          (fsLit "KindRepApp")     kindRepAppDataConKey
+kindRepFunDataConName = dcQual gHC_TYPES          (fsLit "KindRepFun")     kindRepFunDataConKey
+kindRepTYPEDataConName = dcQual gHC_TYPES         (fsLit "KindRepTYPE")    kindRepTYPEDataConKey
+kindRepTypeLitSDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
+kindRepTypeLitDDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey
+
+typeLitSortTyConName
+  , typeLitSymbolDataConName
+  , typeLitNatDataConName
+  :: Name
+typeLitSortTyConName     = tcQual gHC_TYPES       (fsLit "TypeLitSort")    typeLitSortTyConKey
+typeLitSymbolDataConName = dcQual gHC_TYPES       (fsLit "TypeLitSymbol")  typeLitSymbolDataConKey
+typeLitNatDataConName    = dcQual gHC_TYPES       (fsLit "TypeLitNat")     typeLitNatDataConKey
+
+-- Class Typeable, and functions for constructing `Typeable` dictionaries
+typeableClassName
+  , typeRepTyConName
+  , someTypeRepTyConName
+  , someTypeRepDataConName
+  , mkTrTypeName
+  , mkTrConName
+  , mkTrAppName
+  , mkTrFunName
+  , typeRepIdName
+  , typeNatTypeRepName
+  , typeSymbolTypeRepName
+  , trGhcPrimModuleName
+  :: Name
+typeableClassName     = clsQual tYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey
+typeRepTyConName      = tcQual  tYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey
+someTypeRepTyConName   = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepTyConKey
+someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepDataConKey
+typeRepIdName         = varQual tYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey
+mkTrTypeName          = varQual tYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey
+mkTrConName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey
+mkTrAppName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp")        mkTrAppKey
+mkTrFunName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey
+typeNatTypeRepName    = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
+typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
+-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
+-- See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable.
+trGhcPrimModuleName   = varQual gHC_TYPES         (fsLit "tr$ModuleGHCPrim")  trGhcPrimModuleKey
+
+-- Typeable KindReps for some common cases
+starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name
+starKindRepName        = varQual gHC_TYPES         (fsLit "krep$*")         starKindRepKey
+starArrStarKindRepName = varQual gHC_TYPES         (fsLit "krep$*Arr*")     starArrStarKindRepKey
+starArrStarArrStarKindRepName = varQual gHC_TYPES  (fsLit "krep$*->*->*")   starArrStarArrStarKindRepKey
+
+-- Custom type errors
+errorMessageTypeErrorFamName
+  , typeErrorTextDataConName
+  , typeErrorAppendDataConName
+  , typeErrorVAppendDataConName
+  , typeErrorShowTypeDataConName
+  :: Name
+
+errorMessageTypeErrorFamName =
+  tcQual gHC_TYPELITS (fsLit "TypeError") errorMessageTypeErrorFamKey
+
+typeErrorTextDataConName =
+  dcQual gHC_TYPELITS (fsLit "Text") typeErrorTextDataConKey
+
+typeErrorAppendDataConName =
+  dcQual gHC_TYPELITS (fsLit ":<>:") typeErrorAppendDataConKey
+
+typeErrorVAppendDataConName =
+  dcQual gHC_TYPELITS (fsLit ":$$:") typeErrorVAppendDataConKey
+
+typeErrorShowTypeDataConName =
+  dcQual gHC_TYPELITS (fsLit "ShowType") typeErrorShowTypeDataConKey
+
+-- Unsafe coercion proofs
+unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName,
+  unsafeCoerceName, unsafeReflDataConName :: Name
+unsafeEqualityProofName = varQual uNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey
+unsafeEqualityTyConName = tcQual uNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey
+unsafeReflDataConName   = dcQual uNSAFE_COERCE (fsLit "UnsafeRefl")     unsafeReflDataConKey
+unsafeCoercePrimName    = varQual uNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
+unsafeCoerceName        = varQual uNSAFE_COERCE (fsLit "unsafeCoerce")  unsafeCoerceIdKey
+
+-- Dynamic
+toDynName :: Name
+toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey
+
+-- Class Data
+dataClassName :: Name
+dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey
+
+-- Error module
+assertErrorName    :: Name
+assertErrorName   = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey
+
+-- Debug.Trace
+traceName          :: Name
+traceName         = varQual dEBUG_TRACE (fsLit "trace") traceKey
+
+-- Enum module (Enum, Bounded)
+enumClassName, enumFromName, enumFromToName, enumFromThenName,
+    enumFromThenToName, boundedClassName :: Name
+enumClassName      = clsQual gHC_ENUM (fsLit "Enum")           enumClassKey
+enumFromName       = varQual gHC_ENUM (fsLit "enumFrom")       enumFromClassOpKey
+enumFromToName     = varQual gHC_ENUM (fsLit "enumFromTo")     enumFromToClassOpKey
+enumFromThenName   = varQual gHC_ENUM (fsLit "enumFromThen")   enumFromThenClassOpKey
+enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
+boundedClassName   = clsQual gHC_ENUM (fsLit "Bounded")        boundedClassKey
+
+-- List functions
+concatName, filterName, zipName :: Name
+concatName        = varQual gHC_LIST (fsLit "concat") concatIdKey
+filterName        = varQual gHC_LIST (fsLit "filter") filterIdKey
+zipName           = varQual gHC_LIST (fsLit "zip")    zipIdKey
+
+-- Overloaded lists
+isListClassName, fromListName, fromListNName, toListName :: Name
+isListClassName = clsQual gHC_EXTS (fsLit "IsList")    isListClassKey
+fromListName    = varQual gHC_EXTS (fsLit "fromList")  fromListClassOpKey
+fromListNName   = varQual gHC_EXTS (fsLit "fromListN") fromListNClassOpKey
+toListName      = varQual gHC_EXTS (fsLit "toList")    toListClassOpKey
+
+-- Class Show
+showClassName :: Name
+showClassName   = clsQual gHC_SHOW (fsLit "Show")      showClassKey
+
+-- Class Read
+readClassName :: Name
+readClassName   = clsQual gHC_READ (fsLit "Read")      readClassKey
+
+-- Classes Generic and Generic1, Datatype, Constructor and Selector
+genClassName, gen1ClassName, datatypeClassName, constructorClassName,
+  selectorClassName :: Name
+genClassName  = clsQual gHC_GENERICS (fsLit "Generic")  genClassKey
+gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey
+
+datatypeClassName    = clsQual gHC_GENERICS (fsLit "Datatype")    datatypeClassKey
+constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
+selectorClassName    = clsQual gHC_GENERICS (fsLit "Selector")    selectorClassKey
+
+genericClassNames :: [Name]
+genericClassNames = [genClassName, gen1ClassName]
+
+-- GHCi things
+ghciIoClassName, ghciStepIoMName :: Name
+ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
+ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey
+
+-- IO things
+ioTyConName, ioDataConName,
+  thenIOName, bindIOName, returnIOName, failIOName :: Name
+ioTyConName       = tcQual  gHC_TYPES (fsLit "IO")       ioTyConKey
+ioDataConName     = dcQual  gHC_TYPES (fsLit "IO")       ioDataConKey
+thenIOName        = varQual gHC_BASE  (fsLit "thenIO")   thenIOIdKey
+bindIOName        = varQual gHC_BASE  (fsLit "bindIO")   bindIOIdKey
+returnIOName      = varQual gHC_BASE  (fsLit "returnIO") returnIOIdKey
+failIOName        = varQual gHC_IO    (fsLit "failIO")   failIOIdKey
+
+-- IO things
+printName :: Name
+printName         = varQual sYSTEM_IO (fsLit "print") printIdKey
+
+-- Int, Word, and Addr things
+int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name
+int8TyConName     = tcQual gHC_INT  (fsLit "Int8")  int8TyConKey
+int16TyConName    = tcQual gHC_INT  (fsLit "Int16") int16TyConKey
+int32TyConName    = tcQual gHC_INT  (fsLit "Int32") int32TyConKey
+int64TyConName    = tcQual gHC_INT  (fsLit "Int64") int64TyConKey
+
+-- Word module
+word16TyConName, word32TyConName, word64TyConName :: Name
+word16TyConName   = tcQual  gHC_WORD (fsLit "Word16") word16TyConKey
+word32TyConName   = tcQual  gHC_WORD (fsLit "Word32") word32TyConKey
+word64TyConName   = tcQual  gHC_WORD (fsLit "Word64") word64TyConKey
+
+-- PrelPtr module
+ptrTyConName, funPtrTyConName :: Name
+ptrTyConName      = tcQual   gHC_PTR (fsLit "Ptr")    ptrTyConKey
+funPtrTyConName   = tcQual   gHC_PTR (fsLit "FunPtr") funPtrTyConKey
+
+-- Foreign objects and weak pointers
+stablePtrTyConName, newStablePtrName :: Name
+stablePtrTyConName    = tcQual   gHC_STABLE (fsLit "StablePtr")    stablePtrTyConKey
+newStablePtrName      = varQual  gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey
+
+-- Recursive-do notation
+monadFixClassName, mfixName :: Name
+monadFixClassName  = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey
+mfixName           = varQual mONAD_FIX (fsLit "mfix")     mfixIdKey
+
+-- Arrow notation
+arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name
+arrAName           = varQual aRROW (fsLit "arr")       arrAIdKey
+composeAName       = varQual gHC_DESUGAR (fsLit ">>>") composeAIdKey
+firstAName         = varQual aRROW (fsLit "first")     firstAIdKey
+appAName           = varQual aRROW (fsLit "app")       appAIdKey
+choiceAName        = varQual aRROW (fsLit "|||")       choiceAIdKey
+loopAName          = varQual aRROW (fsLit "loop")      loopAIdKey
+
+-- Monad comprehensions
+guardMName, liftMName, mzipName :: Name
+guardMName         = varQual mONAD (fsLit "guard")    guardMIdKey
+liftMName          = varQual mONAD (fsLit "liftM")    liftMIdKey
+mzipName           = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey
+
+
+-- Annotation type checking
+toAnnotationWrapperName :: Name
+toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey
+
+-- Other classes, needed for type defaulting
+monadPlusClassName, randomClassName, randomGenClassName,
+    isStringClassName :: Name
+monadPlusClassName  = clsQual mONAD (fsLit "MonadPlus")      monadPlusClassKey
+randomClassName     = clsQual rANDOM (fsLit "Random")        randomClassKey
+randomGenClassName  = clsQual rANDOM (fsLit "RandomGen")     randomGenClassKey
+isStringClassName   = clsQual dATA_STRING (fsLit "IsString") isStringClassKey
+
+-- Type-level naturals
+knownNatClassName :: Name
+knownNatClassName     = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey
+knownSymbolClassName :: Name
+knownSymbolClassName  = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey
+
+-- Overloaded labels
+isLabelClassName :: Name
+isLabelClassName
+ = clsQual gHC_OVER_LABELS (fsLit "IsLabel") isLabelClassNameKey
+
+-- Implicit Parameters
+ipClassName :: Name
+ipClassName
+  = clsQual gHC_CLASSES (fsLit "IP") ipClassKey
+
+-- Overloaded record fields
+hasFieldClassName :: Name
+hasFieldClassName
+ = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey
+
+-- Source Locations
+callStackTyConName, emptyCallStackName, pushCallStackName,
+  srcLocDataConName :: Name
+callStackTyConName
+  = tcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackTyConKey
+emptyCallStackName
+  = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey
+pushCallStackName
+  = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey
+srcLocDataConName
+  = dcQual gHC_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey
+
+-- plugins
+pLUGINS :: Module
+pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins")
+pluginTyConName :: Name
+pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey
+frontendPluginTyConName :: Name
+frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey
+
+-- Static pointers
+makeStaticName :: Name
+makeStaticName =
+    varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey
+
+staticPtrInfoTyConName :: Name
+staticPtrInfoTyConName =
+    tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey
+
+staticPtrInfoDataConName :: Name
+staticPtrInfoDataConName =
+    dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey
+
+staticPtrTyConName :: Name
+staticPtrTyConName =
+    tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey
+
+staticPtrDataConName :: Name
+staticPtrDataConName =
+    dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey
+
+fromStaticPtrName :: Name
+fromStaticPtrName =
+    varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
+
+fingerprintDataConName :: Name
+fingerprintDataConName =
+    dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Local helpers}
+*                                                                      *
+************************************************************************
+
+All these are original names; hence mkOrig
+-}
+
+varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name
+varQual  = mk_known_key_name varName
+tcQual   = mk_known_key_name tcName
+clsQual  = mk_known_key_name clsName
+dcQual   = mk_known_key_name dataName
+
+mk_known_key_name :: NameSpace -> Module -> FastString -> Unique -> Name
+mk_known_key_name space modu str unique
+  = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan
+
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
+*                                                                      *
+************************************************************************
+--MetaHaskell extension hand allocate keys here
+-}
+
+boundedClassKey, enumClassKey, eqClassKey, floatingClassKey,
+    fractionalClassKey, integralClassKey, monadClassKey, dataClassKey,
+    functorClassKey, numClassKey, ordClassKey, readClassKey, realClassKey,
+    realFloatClassKey, realFracClassKey, showClassKey, ixClassKey :: Unique
+boundedClassKey         = mkPreludeClassUnique 1
+enumClassKey            = mkPreludeClassUnique 2
+eqClassKey              = mkPreludeClassUnique 3
+floatingClassKey        = mkPreludeClassUnique 5
+fractionalClassKey      = mkPreludeClassUnique 6
+integralClassKey        = mkPreludeClassUnique 7
+monadClassKey           = mkPreludeClassUnique 8
+dataClassKey            = mkPreludeClassUnique 9
+functorClassKey         = mkPreludeClassUnique 10
+numClassKey             = mkPreludeClassUnique 11
+ordClassKey             = mkPreludeClassUnique 12
+readClassKey            = mkPreludeClassUnique 13
+realClassKey            = mkPreludeClassUnique 14
+realFloatClassKey       = mkPreludeClassUnique 15
+realFracClassKey        = mkPreludeClassUnique 16
+showClassKey            = mkPreludeClassUnique 17
+ixClassKey              = mkPreludeClassUnique 18
+
+typeableClassKey :: Unique
+typeableClassKey        = mkPreludeClassUnique 20
+
+monadFixClassKey :: Unique
+monadFixClassKey        = mkPreludeClassUnique 28
+
+monadFailClassKey :: Unique
+monadFailClassKey       = mkPreludeClassUnique 29
+
+monadPlusClassKey, randomClassKey, randomGenClassKey :: Unique
+monadPlusClassKey       = mkPreludeClassUnique 30
+randomClassKey          = mkPreludeClassUnique 31
+randomGenClassKey       = mkPreludeClassUnique 32
+
+isStringClassKey :: Unique
+isStringClassKey        = mkPreludeClassUnique 33
+
+applicativeClassKey, foldableClassKey, traversableClassKey :: Unique
+applicativeClassKey     = mkPreludeClassUnique 34
+foldableClassKey        = mkPreludeClassUnique 35
+traversableClassKey     = mkPreludeClassUnique 36
+
+genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,
+  selectorClassKey :: Unique
+genClassKey   = mkPreludeClassUnique 37
+gen1ClassKey  = mkPreludeClassUnique 38
+
+datatypeClassKey    = mkPreludeClassUnique 39
+constructorClassKey = mkPreludeClassUnique 40
+selectorClassKey    = mkPreludeClassUnique 41
+
+-- KnownNat: see Note [KnowNat & KnownSymbol and EvLit] in GHC.Tc.Types.Evidence
+knownNatClassNameKey :: Unique
+knownNatClassNameKey = mkPreludeClassUnique 42
+
+-- KnownSymbol: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Types.Evidence
+knownSymbolClassNameKey :: Unique
+knownSymbolClassNameKey = mkPreludeClassUnique 43
+
+ghciIoClassKey :: Unique
+ghciIoClassKey = mkPreludeClassUnique 44
+
+isLabelClassNameKey :: Unique
+isLabelClassNameKey = mkPreludeClassUnique 45
+
+semigroupClassKey, monoidClassKey :: Unique
+semigroupClassKey = mkPreludeClassUnique 46
+monoidClassKey    = mkPreludeClassUnique 47
+
+-- Implicit Parameters
+ipClassKey :: Unique
+ipClassKey = mkPreludeClassUnique 48
+
+-- Overloaded record fields
+hasFieldClassNameKey :: Unique
+hasFieldClassNameKey = mkPreludeClassUnique 49
+
+
+---------------- Template Haskell -------------------
+--      GHC.Builtin.Names.TH: USES ClassUniques 200-299
+-----------------------------------------------------
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
+*                                                                      *
+************************************************************************
+-}
+
+addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,
+    byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey,
+    doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey,
+    intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey,
+    int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey,
+    int64PrimTyConKey, int64TyConKey,
+    integerTyConKey, naturalTyConKey,
+    listTyConKey, foreignObjPrimTyConKey, maybeTyConKey,
+    weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey,
+    mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey,
+    ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey,
+    stablePtrTyConKey, eqTyConKey, heqTyConKey,
+    smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique
+addrPrimTyConKey                        = mkPreludeTyConUnique  1
+arrayPrimTyConKey                       = mkPreludeTyConUnique  3
+boolTyConKey                            = mkPreludeTyConUnique  4
+byteArrayPrimTyConKey                   = mkPreludeTyConUnique  5
+charPrimTyConKey                        = mkPreludeTyConUnique  7
+charTyConKey                            = mkPreludeTyConUnique  8
+doublePrimTyConKey                      = mkPreludeTyConUnique  9
+doubleTyConKey                          = mkPreludeTyConUnique 10
+floatPrimTyConKey                       = mkPreludeTyConUnique 11
+floatTyConKey                           = mkPreludeTyConUnique 12
+funTyConKey                             = mkPreludeTyConUnique 13
+intPrimTyConKey                         = mkPreludeTyConUnique 14
+intTyConKey                             = mkPreludeTyConUnique 15
+int8PrimTyConKey                        = mkPreludeTyConUnique 16
+int8TyConKey                            = mkPreludeTyConUnique 17
+int16PrimTyConKey                       = mkPreludeTyConUnique 18
+int16TyConKey                           = mkPreludeTyConUnique 19
+int32PrimTyConKey                       = mkPreludeTyConUnique 20
+int32TyConKey                           = mkPreludeTyConUnique 21
+int64PrimTyConKey                       = mkPreludeTyConUnique 22
+int64TyConKey                           = mkPreludeTyConUnique 23
+integerTyConKey                         = mkPreludeTyConUnique 24
+naturalTyConKey                         = mkPreludeTyConUnique 25
+
+listTyConKey                            = mkPreludeTyConUnique 26
+foreignObjPrimTyConKey                  = mkPreludeTyConUnique 27
+maybeTyConKey                           = mkPreludeTyConUnique 28
+weakPrimTyConKey                        = mkPreludeTyConUnique 29
+mutableArrayPrimTyConKey                = mkPreludeTyConUnique 30
+mutableByteArrayPrimTyConKey            = mkPreludeTyConUnique 31
+orderingTyConKey                        = mkPreludeTyConUnique 32
+mVarPrimTyConKey                        = mkPreludeTyConUnique 33
+ratioTyConKey                           = mkPreludeTyConUnique 34
+rationalTyConKey                        = mkPreludeTyConUnique 35
+realWorldTyConKey                       = mkPreludeTyConUnique 36
+stablePtrPrimTyConKey                   = mkPreludeTyConUnique 37
+stablePtrTyConKey                       = mkPreludeTyConUnique 38
+eqTyConKey                              = mkPreludeTyConUnique 40
+heqTyConKey                             = mkPreludeTyConUnique 41
+arrayArrayPrimTyConKey                  = mkPreludeTyConUnique 42
+mutableArrayArrayPrimTyConKey           = mkPreludeTyConUnique 43
+
+statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
+    mutVarPrimTyConKey, ioTyConKey,
+    wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey,
+    word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey,
+    word64PrimTyConKey, word64TyConKey,
+    liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,
+    typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,
+    funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
+    eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey,
+    compactPrimTyConKey :: Unique
+statePrimTyConKey                       = mkPreludeTyConUnique 50
+stableNamePrimTyConKey                  = mkPreludeTyConUnique 51
+stableNameTyConKey                      = mkPreludeTyConUnique 52
+eqPrimTyConKey                          = mkPreludeTyConUnique 53
+eqReprPrimTyConKey                      = mkPreludeTyConUnique 54
+eqPhantPrimTyConKey                     = mkPreludeTyConUnique 55
+mutVarPrimTyConKey                      = mkPreludeTyConUnique 56
+ioTyConKey                              = mkPreludeTyConUnique 57
+voidPrimTyConKey                        = mkPreludeTyConUnique 58
+wordPrimTyConKey                        = mkPreludeTyConUnique 59
+wordTyConKey                            = mkPreludeTyConUnique 60
+word8PrimTyConKey                       = mkPreludeTyConUnique 61
+word8TyConKey                           = mkPreludeTyConUnique 62
+word16PrimTyConKey                      = mkPreludeTyConUnique 63
+word16TyConKey                          = mkPreludeTyConUnique 64
+word32PrimTyConKey                      = mkPreludeTyConUnique 65
+word32TyConKey                          = mkPreludeTyConUnique 66
+word64PrimTyConKey                      = mkPreludeTyConUnique 67
+word64TyConKey                          = mkPreludeTyConUnique 68
+liftedConKey                            = mkPreludeTyConUnique 69
+unliftedConKey                          = mkPreludeTyConUnique 70
+anyBoxConKey                            = mkPreludeTyConUnique 71
+kindConKey                              = mkPreludeTyConUnique 72
+boxityConKey                            = mkPreludeTyConUnique 73
+typeConKey                              = mkPreludeTyConUnique 74
+threadIdPrimTyConKey                    = mkPreludeTyConUnique 75
+bcoPrimTyConKey                         = mkPreludeTyConUnique 76
+ptrTyConKey                             = mkPreludeTyConUnique 77
+funPtrTyConKey                          = mkPreludeTyConUnique 78
+tVarPrimTyConKey                        = mkPreludeTyConUnique 79
+compactPrimTyConKey                     = mkPreludeTyConUnique 80
+
+eitherTyConKey :: Unique
+eitherTyConKey                          = mkPreludeTyConUnique 84
+
+-- Kind constructors
+liftedTypeKindTyConKey, tYPETyConKey,
+  constraintKindTyConKey, runtimeRepTyConKey,
+  vecCountTyConKey, vecElemTyConKey :: Unique
+liftedTypeKindTyConKey                  = mkPreludeTyConUnique 87
+tYPETyConKey                            = mkPreludeTyConUnique 88
+constraintKindTyConKey                  = mkPreludeTyConUnique 92
+runtimeRepTyConKey                      = mkPreludeTyConUnique 95
+vecCountTyConKey                        = mkPreludeTyConUnique 96
+vecElemTyConKey                         = mkPreludeTyConUnique 97
+
+pluginTyConKey, frontendPluginTyConKey :: Unique
+pluginTyConKey                          = mkPreludeTyConUnique 102
+frontendPluginTyConKey                  = mkPreludeTyConUnique 103
+
+unknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey,
+    opaqueTyConKey :: Unique
+unknownTyConKey                         = mkPreludeTyConUnique 129
+unknown1TyConKey                        = mkPreludeTyConUnique 130
+unknown2TyConKey                        = mkPreludeTyConUnique 131
+unknown3TyConKey                        = mkPreludeTyConUnique 132
+opaqueTyConKey                          = mkPreludeTyConUnique 133
+
+-- Generics (Unique keys)
+v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
+  k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,
+  compTyConKey, rTyConKey, dTyConKey,
+  cTyConKey, sTyConKey, rec0TyConKey,
+  d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey,
+  repTyConKey, rep1TyConKey, uRecTyConKey,
+  uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,
+  uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique
+
+v1TyConKey    = mkPreludeTyConUnique 135
+u1TyConKey    = mkPreludeTyConUnique 136
+par1TyConKey  = mkPreludeTyConUnique 137
+rec1TyConKey  = mkPreludeTyConUnique 138
+k1TyConKey    = mkPreludeTyConUnique 139
+m1TyConKey    = mkPreludeTyConUnique 140
+
+sumTyConKey   = mkPreludeTyConUnique 141
+prodTyConKey  = mkPreludeTyConUnique 142
+compTyConKey  = mkPreludeTyConUnique 143
+
+rTyConKey = mkPreludeTyConUnique 144
+dTyConKey = mkPreludeTyConUnique 146
+cTyConKey = mkPreludeTyConUnique 147
+sTyConKey = mkPreludeTyConUnique 148
+
+rec0TyConKey  = mkPreludeTyConUnique 149
+d1TyConKey    = mkPreludeTyConUnique 151
+c1TyConKey    = mkPreludeTyConUnique 152
+s1TyConKey    = mkPreludeTyConUnique 153
+noSelTyConKey = mkPreludeTyConUnique 154
+
+repTyConKey  = mkPreludeTyConUnique 155
+rep1TyConKey = mkPreludeTyConUnique 156
+
+uRecTyConKey    = mkPreludeTyConUnique 157
+uAddrTyConKey   = mkPreludeTyConUnique 158
+uCharTyConKey   = mkPreludeTyConUnique 159
+uDoubleTyConKey = mkPreludeTyConUnique 160
+uFloatTyConKey  = mkPreludeTyConUnique 161
+uIntTyConKey    = mkPreludeTyConUnique 162
+uWordTyConKey   = mkPreludeTyConUnique 163
+
+-- Type-level naturals
+typeNatKindConNameKey, typeSymbolKindConNameKey,
+  typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey,
+  typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey
+  , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey
+  , typeNatDivTyFamNameKey
+  , typeNatModTyFamNameKey
+  , typeNatLogTyFamNameKey
+  :: Unique
+typeNatKindConNameKey     = mkPreludeTyConUnique 164
+typeSymbolKindConNameKey  = mkPreludeTyConUnique 165
+typeNatAddTyFamNameKey    = mkPreludeTyConUnique 166
+typeNatMulTyFamNameKey    = mkPreludeTyConUnique 167
+typeNatExpTyFamNameKey    = mkPreludeTyConUnique 168
+typeNatLeqTyFamNameKey    = mkPreludeTyConUnique 169
+typeNatSubTyFamNameKey    = mkPreludeTyConUnique 170
+typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 171
+typeNatCmpTyFamNameKey    = mkPreludeTyConUnique 172
+typeNatDivTyFamNameKey  = mkPreludeTyConUnique 173
+typeNatModTyFamNameKey  = mkPreludeTyConUnique 174
+typeNatLogTyFamNameKey  = mkPreludeTyConUnique 175
+
+-- Custom user type-errors
+errorMessageTypeErrorFamKey :: Unique
+errorMessageTypeErrorFamKey =  mkPreludeTyConUnique 176
+
+
+
+ntTyConKey:: Unique
+ntTyConKey = mkPreludeTyConUnique 177
+coercibleTyConKey :: Unique
+coercibleTyConKey = mkPreludeTyConUnique 178
+
+proxyPrimTyConKey :: Unique
+proxyPrimTyConKey = mkPreludeTyConUnique 179
+
+specTyConKey :: Unique
+specTyConKey = mkPreludeTyConUnique 180
+
+anyTyConKey :: Unique
+anyTyConKey = mkPreludeTyConUnique 181
+
+smallArrayPrimTyConKey        = mkPreludeTyConUnique  182
+smallMutableArrayPrimTyConKey = mkPreludeTyConUnique  183
+
+staticPtrTyConKey  :: Unique
+staticPtrTyConKey  = mkPreludeTyConUnique 184
+
+staticPtrInfoTyConKey :: Unique
+staticPtrInfoTyConKey = mkPreludeTyConUnique 185
+
+callStackTyConKey :: Unique
+callStackTyConKey = mkPreludeTyConUnique 186
+
+-- Typeables
+typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique
+typeRepTyConKey       = mkPreludeTyConUnique 187
+someTypeRepTyConKey   = mkPreludeTyConUnique 188
+someTypeRepDataConKey = mkPreludeTyConUnique 189
+
+
+typeSymbolAppendFamNameKey :: Unique
+typeSymbolAppendFamNameKey = mkPreludeTyConUnique 190
+
+-- Unsafe equality
+unsafeEqualityTyConKey :: Unique
+unsafeEqualityTyConKey = mkPreludeTyConUnique 191
+
+
+---------------- Template Haskell -------------------
+--      GHC.Builtin.Names.TH: USES TyConUniques 200-299
+-----------------------------------------------------
+
+----------------------- SIMD ------------------------
+--      USES TyConUniques 300-399
+-----------------------------------------------------
+
+#include "primop-vector-uniques.hs-incl"
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
+*                                                                      *
+************************************************************************
+-}
+
+charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,
+    floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,
+    ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,
+    word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,
+    coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique
+
+charDataConKey                          = mkPreludeDataConUnique  1
+consDataConKey                          = mkPreludeDataConUnique  2
+doubleDataConKey                        = mkPreludeDataConUnique  3
+falseDataConKey                         = mkPreludeDataConUnique  4
+floatDataConKey                         = mkPreludeDataConUnique  5
+intDataConKey                           = mkPreludeDataConUnique  6
+integerSDataConKey                      = mkPreludeDataConUnique  7
+nothingDataConKey                       = mkPreludeDataConUnique  8
+justDataConKey                          = mkPreludeDataConUnique  9
+eqDataConKey                            = mkPreludeDataConUnique 10
+nilDataConKey                           = mkPreludeDataConUnique 11
+ratioDataConKey                         = mkPreludeDataConUnique 12
+word8DataConKey                         = mkPreludeDataConUnique 13
+stableNameDataConKey                    = mkPreludeDataConUnique 14
+trueDataConKey                          = mkPreludeDataConUnique 15
+wordDataConKey                          = mkPreludeDataConUnique 16
+ioDataConKey                            = mkPreludeDataConUnique 17
+integerDataConKey                       = mkPreludeDataConUnique 18
+heqDataConKey                           = mkPreludeDataConUnique 19
+
+-- Generic data constructors
+crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique
+crossDataConKey                         = mkPreludeDataConUnique 20
+inlDataConKey                           = mkPreludeDataConUnique 21
+inrDataConKey                           = mkPreludeDataConUnique 22
+genUnitDataConKey                       = mkPreludeDataConUnique 23
+
+leftDataConKey, rightDataConKey :: Unique
+leftDataConKey                          = mkPreludeDataConUnique 25
+rightDataConKey                         = mkPreludeDataConUnique 26
+
+ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique
+ordLTDataConKey                         = mkPreludeDataConUnique 27
+ordEQDataConKey                         = mkPreludeDataConUnique 28
+ordGTDataConKey                         = mkPreludeDataConUnique 29
+
+
+coercibleDataConKey                     = mkPreludeDataConUnique 32
+
+staticPtrDataConKey :: Unique
+staticPtrDataConKey                     = mkPreludeDataConUnique 33
+
+staticPtrInfoDataConKey :: Unique
+staticPtrInfoDataConKey                 = mkPreludeDataConUnique 34
+
+fingerprintDataConKey :: Unique
+fingerprintDataConKey                   = mkPreludeDataConUnique 35
+
+srcLocDataConKey :: Unique
+srcLocDataConKey                        = mkPreludeDataConUnique 37
+
+trTyConTyConKey, trTyConDataConKey,
+  trModuleTyConKey, trModuleDataConKey,
+  trNameTyConKey, trNameSDataConKey, trNameDDataConKey,
+  trGhcPrimModuleKey, kindRepTyConKey,
+  typeLitSortTyConKey :: Unique
+trTyConTyConKey                         = mkPreludeDataConUnique 40
+trTyConDataConKey                       = mkPreludeDataConUnique 41
+trModuleTyConKey                        = mkPreludeDataConUnique 42
+trModuleDataConKey                      = mkPreludeDataConUnique 43
+trNameTyConKey                          = mkPreludeDataConUnique 44
+trNameSDataConKey                       = mkPreludeDataConUnique 45
+trNameDDataConKey                       = mkPreludeDataConUnique 46
+trGhcPrimModuleKey                      = mkPreludeDataConUnique 47
+kindRepTyConKey                         = mkPreludeDataConUnique 48
+typeLitSortTyConKey                     = mkPreludeDataConUnique 49
+
+typeErrorTextDataConKey,
+  typeErrorAppendDataConKey,
+  typeErrorVAppendDataConKey,
+  typeErrorShowTypeDataConKey
+  :: Unique
+typeErrorTextDataConKey                 = mkPreludeDataConUnique 50
+typeErrorAppendDataConKey               = mkPreludeDataConUnique 51
+typeErrorVAppendDataConKey              = mkPreludeDataConUnique 52
+typeErrorShowTypeDataConKey             = mkPreludeDataConUnique 53
+
+prefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey,
+    rightAssociativeDataConKey, notAssociativeDataConKey,
+    sourceUnpackDataConKey, sourceNoUnpackDataConKey,
+    noSourceUnpackednessDataConKey, sourceLazyDataConKey,
+    sourceStrictDataConKey, noSourceStrictnessDataConKey,
+    decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey,
+    metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: Unique
+prefixIDataConKey                       = mkPreludeDataConUnique 54
+infixIDataConKey                        = mkPreludeDataConUnique 55
+leftAssociativeDataConKey               = mkPreludeDataConUnique 56
+rightAssociativeDataConKey              = mkPreludeDataConUnique 57
+notAssociativeDataConKey                = mkPreludeDataConUnique 58
+sourceUnpackDataConKey                  = mkPreludeDataConUnique 59
+sourceNoUnpackDataConKey                = mkPreludeDataConUnique 60
+noSourceUnpackednessDataConKey          = mkPreludeDataConUnique 61
+sourceLazyDataConKey                    = mkPreludeDataConUnique 62
+sourceStrictDataConKey                  = mkPreludeDataConUnique 63
+noSourceStrictnessDataConKey            = mkPreludeDataConUnique 64
+decidedLazyDataConKey                   = mkPreludeDataConUnique 65
+decidedStrictDataConKey                 = mkPreludeDataConUnique 66
+decidedUnpackDataConKey                 = mkPreludeDataConUnique 67
+metaDataDataConKey                      = mkPreludeDataConUnique 68
+metaConsDataConKey                      = mkPreludeDataConUnique 69
+metaSelDataConKey                       = mkPreludeDataConUnique 70
+
+vecRepDataConKey, tupleRepDataConKey, sumRepDataConKey :: Unique
+vecRepDataConKey                        = mkPreludeDataConUnique 71
+tupleRepDataConKey                      = mkPreludeDataConUnique 72
+sumRepDataConKey                        = mkPreludeDataConUnique 73
+
+-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
+runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique]
+liftedRepDataConKey :: Unique
+runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)
+  = map mkPreludeDataConUnique [74..88]
+
+unliftedRepDataConKeys = vecRepDataConKey :
+                         tupleRepDataConKey :
+                         sumRepDataConKey :
+                         unliftedSimpleRepDataConKeys
+
+-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
+-- VecCount
+vecCountDataConKeys :: [Unique]
+vecCountDataConKeys = map mkPreludeDataConUnique [89..94]
+
+-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
+-- VecElem
+vecElemDataConKeys :: [Unique]
+vecElemDataConKeys = map mkPreludeDataConUnique [95..104]
+
+-- Typeable things
+kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,
+    kindRepFunDataConKey, kindRepTYPEDataConKey,
+    kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey
+    :: Unique
+kindRepTyConAppDataConKey = mkPreludeDataConUnique 105
+kindRepVarDataConKey      = mkPreludeDataConUnique 106
+kindRepAppDataConKey      = mkPreludeDataConUnique 107
+kindRepFunDataConKey      = mkPreludeDataConUnique 108
+kindRepTYPEDataConKey     = mkPreludeDataConUnique 109
+kindRepTypeLitSDataConKey = mkPreludeDataConUnique 110
+kindRepTypeLitDDataConKey = mkPreludeDataConUnique 111
+
+typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique
+typeLitSymbolDataConKey   = mkPreludeDataConUnique 112
+typeLitNatDataConKey      = mkPreludeDataConUnique 113
+
+-- Unsafe equality
+unsafeReflDataConKey :: Unique
+unsafeReflDataConKey      = mkPreludeDataConUnique 114
+
+---------------- Template Haskell -------------------
+--      GHC.Builtin.Names.TH: USES DataUniques 200-250
+-----------------------------------------------------
+
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
+*                                                                      *
+************************************************************************
+-}
+
+wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,
+    buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey,
+    seqIdKey, eqStringIdKey,
+    noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,
+    runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey,
+    realWorldPrimIdKey, recConErrorIdKey,
+    unpackCStringUtf8IdKey, unpackCStringAppendIdKey,
+    unpackCStringFoldrIdKey, unpackCStringIdKey,
+    typeErrorIdKey, divIntIdKey, modIntIdKey,
+    absentSumFieldErrorIdKey :: Unique
+
+wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]
+absentErrorIdKey              = mkPreludeMiscIdUnique  1
+augmentIdKey                  = mkPreludeMiscIdUnique  2
+appendIdKey                   = mkPreludeMiscIdUnique  3
+buildIdKey                    = mkPreludeMiscIdUnique  4
+errorIdKey                    = mkPreludeMiscIdUnique  5
+foldrIdKey                    = mkPreludeMiscIdUnique  6
+recSelErrorIdKey              = mkPreludeMiscIdUnique  7
+seqIdKey                      = mkPreludeMiscIdUnique  8
+absentSumFieldErrorIdKey      = mkPreludeMiscIdUnique  9
+eqStringIdKey                 = mkPreludeMiscIdUnique 10
+noMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 11
+nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 12
+runtimeErrorIdKey             = mkPreludeMiscIdUnique 13
+patErrorIdKey                 = mkPreludeMiscIdUnique 14
+realWorldPrimIdKey            = mkPreludeMiscIdUnique 15
+recConErrorIdKey              = mkPreludeMiscIdUnique 16
+unpackCStringUtf8IdKey        = mkPreludeMiscIdUnique 17
+unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 18
+unpackCStringFoldrIdKey       = mkPreludeMiscIdUnique 19
+unpackCStringIdKey            = mkPreludeMiscIdUnique 20
+voidPrimIdKey                 = mkPreludeMiscIdUnique 21
+typeErrorIdKey                = mkPreludeMiscIdUnique 22
+divIntIdKey                   = mkPreludeMiscIdUnique 23
+modIntIdKey                   = mkPreludeMiscIdUnique 24
+
+concatIdKey, filterIdKey, zipIdKey,
+    bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
+    printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey,
+    fstIdKey, sndIdKey, otherwiseIdKey, assertIdKey :: Unique
+concatIdKey                   = mkPreludeMiscIdUnique 31
+filterIdKey                   = mkPreludeMiscIdUnique 32
+zipIdKey                      = mkPreludeMiscIdUnique 33
+bindIOIdKey                   = mkPreludeMiscIdUnique 34
+returnIOIdKey                 = mkPreludeMiscIdUnique 35
+newStablePtrIdKey             = mkPreludeMiscIdUnique 36
+printIdKey                    = mkPreludeMiscIdUnique 37
+failIOIdKey                   = mkPreludeMiscIdUnique 38
+nullAddrIdKey                 = mkPreludeMiscIdUnique 39
+voidArgIdKey                  = mkPreludeMiscIdUnique 40
+fstIdKey                      = mkPreludeMiscIdUnique 41
+sndIdKey                      = mkPreludeMiscIdUnique 42
+otherwiseIdKey                = mkPreludeMiscIdUnique 43
+assertIdKey                   = mkPreludeMiscIdUnique 44
+
+mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,
+    integerToWordIdKey, integerToIntIdKey,
+    integerToWord64IdKey, integerToInt64IdKey,
+    word64ToIntegerIdKey, int64ToIntegerIdKey,
+    plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,
+    negateIntegerIdKey,
+    eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey,
+    leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey,
+    compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
+    quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey,
+    floatFromIntegerIdKey, doubleFromIntegerIdKey,
+    encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,
+    decodeDoubleIntegerIdKey,
+    gcdIntegerIdKey, lcmIntegerIdKey,
+    andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
+    shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
+mkIntegerIdKey                = mkPreludeMiscIdUnique 60
+smallIntegerIdKey             = mkPreludeMiscIdUnique 61
+integerToWordIdKey            = mkPreludeMiscIdUnique 62
+integerToIntIdKey             = mkPreludeMiscIdUnique 63
+integerToWord64IdKey          = mkPreludeMiscIdUnique 64
+integerToInt64IdKey           = mkPreludeMiscIdUnique 65
+plusIntegerIdKey              = mkPreludeMiscIdUnique 66
+timesIntegerIdKey             = mkPreludeMiscIdUnique 67
+minusIntegerIdKey             = mkPreludeMiscIdUnique 68
+negateIntegerIdKey            = mkPreludeMiscIdUnique 69
+eqIntegerPrimIdKey            = mkPreludeMiscIdUnique 70
+neqIntegerPrimIdKey           = mkPreludeMiscIdUnique 71
+absIntegerIdKey               = mkPreludeMiscIdUnique 72
+signumIntegerIdKey            = mkPreludeMiscIdUnique 73
+leIntegerPrimIdKey            = mkPreludeMiscIdUnique 74
+gtIntegerPrimIdKey            = mkPreludeMiscIdUnique 75
+ltIntegerPrimIdKey            = mkPreludeMiscIdUnique 76
+geIntegerPrimIdKey            = mkPreludeMiscIdUnique 77
+compareIntegerIdKey           = mkPreludeMiscIdUnique 78
+quotIntegerIdKey              = mkPreludeMiscIdUnique 79
+remIntegerIdKey               = mkPreludeMiscIdUnique 80
+divIntegerIdKey               = mkPreludeMiscIdUnique 81
+modIntegerIdKey               = mkPreludeMiscIdUnique 82
+divModIntegerIdKey            = mkPreludeMiscIdUnique 83
+quotRemIntegerIdKey           = mkPreludeMiscIdUnique 84
+floatFromIntegerIdKey         = mkPreludeMiscIdUnique 85
+doubleFromIntegerIdKey        = mkPreludeMiscIdUnique 86
+encodeFloatIntegerIdKey       = mkPreludeMiscIdUnique 87
+encodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 88
+gcdIntegerIdKey               = mkPreludeMiscIdUnique 89
+lcmIntegerIdKey               = mkPreludeMiscIdUnique 90
+andIntegerIdKey               = mkPreludeMiscIdUnique 91
+orIntegerIdKey                = mkPreludeMiscIdUnique 92
+xorIntegerIdKey               = mkPreludeMiscIdUnique 93
+complementIntegerIdKey        = mkPreludeMiscIdUnique 94
+shiftLIntegerIdKey            = mkPreludeMiscIdUnique 95
+shiftRIntegerIdKey            = mkPreludeMiscIdUnique 96
+wordToIntegerIdKey            = mkPreludeMiscIdUnique 97
+word64ToIntegerIdKey          = mkPreludeMiscIdUnique 98
+int64ToIntegerIdKey           = mkPreludeMiscIdUnique 99
+decodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 100
+
+rootMainKey, runMainKey :: Unique
+rootMainKey                   = mkPreludeMiscIdUnique 101
+runMainKey                    = mkPreludeMiscIdUnique 102
+
+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique
+thenIOIdKey                   = mkPreludeMiscIdUnique 103
+lazyIdKey                     = mkPreludeMiscIdUnique 104
+assertErrorIdKey              = mkPreludeMiscIdUnique 105
+oneShotKey                    = mkPreludeMiscIdUnique 106
+runRWKey                      = mkPreludeMiscIdUnique 107
+
+traceKey :: Unique
+traceKey                      = mkPreludeMiscIdUnique 108
+
+breakpointIdKey, breakpointCondIdKey :: Unique
+breakpointIdKey               = mkPreludeMiscIdUnique 110
+breakpointCondIdKey           = mkPreludeMiscIdUnique 111
+
+inlineIdKey, noinlineIdKey :: Unique
+inlineIdKey                   = mkPreludeMiscIdUnique 120
+-- see below
+
+mapIdKey, groupWithIdKey, dollarIdKey :: Unique
+mapIdKey              = mkPreludeMiscIdUnique 121
+groupWithIdKey        = mkPreludeMiscIdUnique 122
+dollarIdKey           = mkPreludeMiscIdUnique 123
+
+coercionTokenIdKey :: Unique
+coercionTokenIdKey    = mkPreludeMiscIdUnique 124
+
+noinlineIdKey                 = mkPreludeMiscIdUnique 125
+
+rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
+rationalToFloatIdKey   = mkPreludeMiscIdUnique 130
+rationalToDoubleIdKey  = mkPreludeMiscIdUnique 131
+
+magicDictKey :: Unique
+magicDictKey                  = mkPreludeMiscIdUnique 156
+
+coerceKey :: Unique
+coerceKey                     = mkPreludeMiscIdUnique 157
+
+{-
+Certain class operations from Prelude classes.  They get their own
+uniques so we can look them up easily when we want to conjure them up
+during type checking.
+-}
+
+-- Just a placeholder for unbound variables produced by the renamer:
+unboundKey :: Unique
+unboundKey                    = mkPreludeMiscIdUnique 158
+
+fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,
+    enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,
+    enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,
+    bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey
+    :: Unique
+fromIntegerClassOpKey         = mkPreludeMiscIdUnique 160
+minusClassOpKey               = mkPreludeMiscIdUnique 161
+fromRationalClassOpKey        = mkPreludeMiscIdUnique 162
+enumFromClassOpKey            = mkPreludeMiscIdUnique 163
+enumFromThenClassOpKey        = mkPreludeMiscIdUnique 164
+enumFromToClassOpKey          = mkPreludeMiscIdUnique 165
+enumFromThenToClassOpKey      = mkPreludeMiscIdUnique 166
+eqClassOpKey                  = mkPreludeMiscIdUnique 167
+geClassOpKey                  = mkPreludeMiscIdUnique 168
+negateClassOpKey              = mkPreludeMiscIdUnique 169
+bindMClassOpKey               = mkPreludeMiscIdUnique 171 -- (>>=)
+thenMClassOpKey               = mkPreludeMiscIdUnique 172 -- (>>)
+fmapClassOpKey                = mkPreludeMiscIdUnique 173
+returnMClassOpKey             = mkPreludeMiscIdUnique 174
+
+-- Recursive do notation
+mfixIdKey :: Unique
+mfixIdKey       = mkPreludeMiscIdUnique 175
+
+-- MonadFail operations
+failMClassOpKey :: Unique
+failMClassOpKey = mkPreludeMiscIdUnique 176
+
+-- Arrow notation
+arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey,
+    loopAIdKey :: Unique
+arrAIdKey       = mkPreludeMiscIdUnique 180
+composeAIdKey   = mkPreludeMiscIdUnique 181 -- >>>
+firstAIdKey     = mkPreludeMiscIdUnique 182
+appAIdKey       = mkPreludeMiscIdUnique 183
+choiceAIdKey    = mkPreludeMiscIdUnique 184 --  |||
+loopAIdKey      = mkPreludeMiscIdUnique 185
+
+fromStringClassOpKey :: Unique
+fromStringClassOpKey          = mkPreludeMiscIdUnique 186
+
+-- Annotation type checking
+toAnnotationWrapperIdKey :: Unique
+toAnnotationWrapperIdKey      = mkPreludeMiscIdUnique 187
+
+-- Conversion functions
+fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: Unique
+fromIntegralIdKey    = mkPreludeMiscIdUnique 190
+realToFracIdKey      = mkPreludeMiscIdUnique 191
+toIntegerClassOpKey  = mkPreludeMiscIdUnique 192
+toRationalClassOpKey = mkPreludeMiscIdUnique 193
+
+-- Monad comprehensions
+guardMIdKey, liftMIdKey, mzipIdKey :: Unique
+guardMIdKey     = mkPreludeMiscIdUnique 194
+liftMIdKey      = mkPreludeMiscIdUnique 195
+mzipIdKey       = mkPreludeMiscIdUnique 196
+
+-- GHCi
+ghciStepIoMClassOpKey :: Unique
+ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197
+
+-- Overloaded lists
+isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: Unique
+isListClassKey = mkPreludeMiscIdUnique 198
+fromListClassOpKey = mkPreludeMiscIdUnique 199
+fromListNClassOpKey = mkPreludeMiscIdUnique 500
+toListClassOpKey = mkPreludeMiscIdUnique 501
+
+proxyHashKey :: Unique
+proxyHashKey = mkPreludeMiscIdUnique 502
+
+---------------- Template Haskell -------------------
+--      GHC.Builtin.Names.TH: USES IdUniques 200-499
+-----------------------------------------------------
+
+-- Used to make `Typeable` dictionaries
+mkTyConKey
+  , mkTrTypeKey
+  , mkTrConKey
+  , mkTrAppKey
+  , mkTrFunKey
+  , typeNatTypeRepKey
+  , typeSymbolTypeRepKey
+  , typeRepIdKey
+  :: Unique
+mkTyConKey            = mkPreludeMiscIdUnique 503
+mkTrTypeKey           = mkPreludeMiscIdUnique 504
+mkTrConKey            = mkPreludeMiscIdUnique 505
+mkTrAppKey            = mkPreludeMiscIdUnique 506
+typeNatTypeRepKey     = mkPreludeMiscIdUnique 507
+typeSymbolTypeRepKey  = mkPreludeMiscIdUnique 508
+typeRepIdKey          = mkPreludeMiscIdUnique 509
+mkTrFunKey            = mkPreludeMiscIdUnique 510
+
+-- Representations for primitive types
+trTYPEKey
+  ,trTYPE'PtrRepLiftedKey
+  , trRuntimeRepKey
+  , tr'PtrRepLiftedKey
+  :: Unique
+trTYPEKey              = mkPreludeMiscIdUnique 511
+trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512
+trRuntimeRepKey        = mkPreludeMiscIdUnique 513
+tr'PtrRepLiftedKey     = mkPreludeMiscIdUnique 514
+
+-- KindReps for common cases
+starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique
+starKindRepKey        = mkPreludeMiscIdUnique 520
+starArrStarKindRepKey = mkPreludeMiscIdUnique 521
+starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522
+
+-- Dynamic
+toDynIdKey :: Unique
+toDynIdKey            = mkPreludeMiscIdUnique 523
+
+
+bitIntegerIdKey :: Unique
+bitIntegerIdKey       = mkPreludeMiscIdUnique 550
+
+heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique
+eqSCSelIdKey        = mkPreludeMiscIdUnique 551
+heqSCSelIdKey       = mkPreludeMiscIdUnique 552
+coercibleSCSelIdKey = mkPreludeMiscIdUnique 553
+
+sappendClassOpKey :: Unique
+sappendClassOpKey = mkPreludeMiscIdUnique 554
+
+memptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: Unique
+memptyClassOpKey  = mkPreludeMiscIdUnique 555
+mappendClassOpKey = mkPreludeMiscIdUnique 556
+mconcatClassOpKey = mkPreludeMiscIdUnique 557
+
+emptyCallStackKey, pushCallStackKey :: Unique
+emptyCallStackKey = mkPreludeMiscIdUnique 558
+pushCallStackKey  = mkPreludeMiscIdUnique 559
+
+fromStaticPtrClassOpKey :: Unique
+fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560
+
+makeStaticKey :: Unique
+makeStaticKey = mkPreludeMiscIdUnique 561
+
+-- Natural
+naturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey,
+   minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey,
+   naturalSDataConKey, wordToNaturalIdKey :: Unique
+naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562
+naturalToIntegerIdKey   = mkPreludeMiscIdUnique 563
+plusNaturalIdKey        = mkPreludeMiscIdUnique 564
+minusNaturalIdKey       = mkPreludeMiscIdUnique 565
+timesNaturalIdKey       = mkPreludeMiscIdUnique 566
+mkNaturalIdKey          = mkPreludeMiscIdUnique 567
+naturalSDataConKey      = mkPreludeMiscIdUnique 568
+wordToNaturalIdKey      = mkPreludeMiscIdUnique 569
+
+-- Unsafe coercion proofs
+unsafeEqualityProofIdKey, unsafeCoercePrimIdKey, unsafeCoerceIdKey :: Unique
+unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
+unsafeCoercePrimIdKey    = mkPreludeMiscIdUnique 571
+unsafeCoerceIdKey        = mkPreludeMiscIdUnique 572
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Class-std-groups]{Standard groups of Prelude classes}
+*                                                                      *
+************************************************************************
+
+NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
+even though every numeric class has these two as a superclass,
+because the list of ambiguous dictionaries hasn't been simplified.
+-}
+
+numericClassKeys :: [Unique]
+numericClassKeys =
+        [ numClassKey
+        , realClassKey
+        , integralClassKey
+        ]
+        ++ fractionalClassKeys
+
+fractionalClassKeys :: [Unique]
+fractionalClassKeys =
+        [ fractionalClassKey
+        , floatingClassKey
+        , realFracClassKey
+        , realFloatClassKey
+        ]
+
+-- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),
+-- and are: "classes defined in the Prelude or a standard library"
+standardClassKeys :: [Unique]
+standardClassKeys = derivableClassKeys ++ numericClassKeys
+                  ++ [randomClassKey, randomGenClassKey,
+                      functorClassKey,
+                      monadClassKey, monadPlusClassKey, monadFailClassKey,
+                      semigroupClassKey, monoidClassKey,
+                      isStringClassKey,
+                      applicativeClassKey, foldableClassKey,
+                      traversableClassKey, alternativeClassKey
+                     ]
+
+{-
+@derivableClassKeys@ is also used in checking \tr{deriving} constructs
+(@GHC.Tc.Deriv@).
+-}
+
+derivableClassKeys :: [Unique]
+derivableClassKeys
+  = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,
+      boundedClassKey, showClassKey, readClassKey ]
+
+
+-- These are the "interactive classes" that are consulted when doing
+-- defaulting. Does not include Num or IsString, which have special
+-- handling.
+interactiveClassNames :: [Name]
+interactiveClassNames
+  = [ showClassName, eqClassName, ordClassName, foldableClassName
+    , traversableClassName ]
+
+interactiveClassKeys :: [Unique]
+interactiveClassKeys = map getUnique interactiveClassNames
+
+{-
+************************************************************************
+*                                                                      *
+   Semi-builtin names
+*                                                                      *
+************************************************************************
+
+The following names should be considered by GHCi to be in scope always.
+
+-}
+
+pretendNameIsInScope :: Name -> Bool
+pretendNameIsInScope n
+  = any (n `hasKey`)
+    [ liftedTypeKindTyConKey, tYPETyConKey
+    , runtimeRepTyConKey, liftedRepDataConKey ]
diff --git a/compiler/GHC/Builtin/Names.hs-boot b/compiler/GHC/Builtin/Names.hs-boot
new file mode 100644
index 0000000000..8dcd62e716
--- /dev/null
+++ b/compiler/GHC/Builtin/Names.hs-boot
@@ -0,0 +1,7 @@
+module GHC.Builtin.Names where
+
+import GHC.Types.Module
+import GHC.Types.Unique
+
+mAIN :: Module
+liftedTypeKindTyConKey :: Unique
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
new file mode 100644
index 0000000000..7f83cd7521
--- /dev/null
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -0,0 +1,1093 @@
+-- %************************************************************************
+-- %*                                                                   *
+--              The known-key names for Template Haskell
+-- %*                                                                   *
+-- %************************************************************************
+
+module GHC.Builtin.Names.TH where
+
+import GhcPrelude ()
+
+import GHC.Builtin.Names( mk_known_key_name )
+import GHC.Types.Module( Module, mkModuleNameFS, mkModule, thUnitId )
+import GHC.Types.Name( Name )
+import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName )
+import GHC.Types.Name.Reader( RdrName, nameRdrName )
+import GHC.Types.Unique
+import FastString
+
+-- To add a name, do three things
+--
+--  1) Allocate a key
+--  2) Make a "Name"
+--  3) Add the name to templateHaskellNames
+
+templateHaskellNames :: [Name]
+-- The names that are implicitly mentioned by ``bracket''
+-- Should stay in sync with the import list of GHC.HsToCore.Quote
+
+templateHaskellNames = [
+    returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName,
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
+    mkNameSName,
+    liftStringName,
+    unTypeName,
+    unTypeQName,
+    unsafeTExpCoerceName,
+
+    -- Lit
+    charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
+    floatPrimLName, doublePrimLName, rationalLName, stringPrimLName,
+    charPrimLName,
+    -- Pat
+    litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName,
+    conPName, tildePName, bangPName, infixPName,
+    asPName, wildPName, recPName, listPName, sigPName, viewPName,
+    -- FieldPat
+    fieldPatName,
+    -- Match
+    matchName,
+    -- Clause
+    clauseName,
+    -- Exp
+    varEName, conEName, litEName, appEName, appTypeEName, infixEName,
+    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
+    tupEName, unboxedTupEName, unboxedSumEName,
+    condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName,
+    fromEName, fromThenEName, fromToEName, fromThenToEName,
+    listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,
+    labelEName, implicitParamVarEName,
+    -- FieldExp
+    fieldExpName,
+    -- Body
+    guardedBName, normalBName,
+    -- Guard
+    normalGEName, patGEName,
+    -- Stmt
+    bindSName, letSName, noBindSName, parSName, recSName,
+    -- Dec
+    funDName, valDName, dataDName, newtypeDName, tySynDName,
+    classDName, instanceWithOverlapDName,
+    standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName,
+    pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
+    pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName,
+    dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,
+    dataInstDName, newtypeInstDName, tySynInstDName,
+    infixLDName, infixRDName, infixNDName,
+    roleAnnotDName, patSynDName, patSynSigDName,
+    implicitParamBindDName,
+    -- Cxt
+    cxtName,
+
+    -- SourceUnpackedness
+    noSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName,
+    -- SourceStrictness
+    noSourceStrictnessName, sourceLazyName, sourceStrictName,
+    -- Con
+    normalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName,
+    -- Bang
+    bangName,
+    -- BangType
+    bangTypeName,
+    -- VarBangType
+    varBangTypeName,
+    -- PatSynDir (for pattern synonyms)
+    unidirPatSynName, implBidirPatSynName, explBidirPatSynName,
+    -- PatSynArgs (for pattern synonyms)
+    prefixPatSynName, infixPatSynName, recordPatSynName,
+    -- Type
+    forallTName, forallVisTName, varTName, conTName, infixTName, appTName,
+    appKindTName, equalityTName, tupleTName, unboxedTupleTName,
+    unboxedSumTName, arrowTName, listTName, sigTName, litTName,
+    promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
+    wildCardTName, implicitParamTName,
+    -- TyLit
+    numTyLitName, strTyLitName,
+    -- TyVarBndr
+    plainTVName, kindedTVName,
+    -- Role
+    nominalRName, representationalRName, phantomRName, inferRName,
+    -- Kind
+    starKName, constraintKName,
+    -- FamilyResultSig
+    noSigName, kindSigName, tyVarSigName,
+    -- InjectivityAnn
+    injectivityAnnName,
+    -- Callconv
+    cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName,
+    -- Safety
+    unsafeName,
+    safeName,
+    interruptibleName,
+    -- Inline
+    noInlineDataConName, inlineDataConName, inlinableDataConName,
+    -- RuleMatch
+    conLikeDataConName, funLikeDataConName,
+    -- Phases
+    allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,
+    -- Overlap
+    overlappableDataConName, overlappingDataConName, overlapsDataConName,
+    incoherentDataConName,
+    -- DerivStrategy
+    stockStrategyName, anyclassStrategyName,
+    newtypeStrategyName, viaStrategyName,
+    -- TExp
+    tExpDataConName,
+    -- RuleBndr
+    ruleVarName, typedRuleVarName,
+    -- FunDep
+    funDepName,
+    -- TySynEqn
+    tySynEqnName,
+    -- AnnTarget
+    valueAnnotationName, typeAnnotationName, moduleAnnotationName,
+    -- DerivClause
+    derivClauseName,
+
+    -- The type classes
+    liftClassName, quoteClassName,
+
+    -- And the tycons
+    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchTyConName,
+    expQTyConName, fieldExpTyConName, predTyConName,
+    stmtTyConName,  decsTyConName, conTyConName, bangTypeTyConName,
+    varBangTypeTyConName, typeQTyConName, expTyConName, decTyConName,
+    typeTyConName, tyVarBndrTyConName, clauseTyConName,
+    patQTyConName, funDepTyConName, decsQTyConName,
+    ruleBndrTyConName, tySynEqnTyConName,
+    roleTyConName, tExpTyConName, injAnnTyConName, kindTyConName,
+    overlapTyConName, derivClauseTyConName, derivStrategyTyConName,
+
+    -- Quasiquoting
+    quoteDecName, quoteTypeName, quoteExpName, quotePatName]
+
+thSyn, thLib, qqLib :: Module
+thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
+thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib.Internal")
+qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
+
+mkTHModule :: FastString -> Module
+mkTHModule m = mkModule thUnitId (mkModuleNameFS m)
+
+libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name
+libFun = mk_known_key_name varName  thLib
+libTc  = mk_known_key_name tcName   thLib
+thFun  = mk_known_key_name varName  thSyn
+thTc   = mk_known_key_name tcName   thSyn
+thCls  = mk_known_key_name clsName  thSyn
+thCon  = mk_known_key_name dataName thSyn
+qqFun  = mk_known_key_name varName  qqLib
+
+-------------------- TH.Syntax -----------------------
+liftClassName :: Name
+liftClassName = thCls (fsLit "Lift") liftClassKey
+
+quoteClassName :: Name
+quoteClassName = thCls (fsLit "Quote") quoteClassKey
+
+qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
+    fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
+    matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
+    tExpTyConName, injAnnTyConName, overlapTyConName, decsTyConName :: Name
+qTyConName             = thTc (fsLit "Q")              qTyConKey
+nameTyConName          = thTc (fsLit "Name")           nameTyConKey
+fieldExpTyConName      = thTc (fsLit "FieldExp")       fieldExpTyConKey
+patTyConName           = thTc (fsLit "Pat")            patTyConKey
+fieldPatTyConName      = thTc (fsLit "FieldPat")       fieldPatTyConKey
+expTyConName           = thTc (fsLit "Exp")            expTyConKey
+decTyConName           = thTc (fsLit "Dec")            decTyConKey
+decsTyConName          = libTc (fsLit "Decs")           decsTyConKey
+typeTyConName          = thTc (fsLit "Type")           typeTyConKey
+matchTyConName         = thTc (fsLit "Match")          matchTyConKey
+clauseTyConName        = thTc (fsLit "Clause")         clauseTyConKey
+funDepTyConName        = thTc (fsLit "FunDep")         funDepTyConKey
+predTyConName          = thTc (fsLit "Pred")           predTyConKey
+tExpTyConName          = thTc (fsLit "TExp")           tExpTyConKey
+injAnnTyConName        = thTc (fsLit "InjectivityAnn") injAnnTyConKey
+overlapTyConName       = thTc (fsLit "Overlap")        overlapTyConKey
+
+returnQName, bindQName, sequenceQName, newNameName, liftName,
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
+    mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,
+    unsafeTExpCoerceName, liftTypedName :: Name
+returnQName    = thFun (fsLit "returnQ")   returnQIdKey
+bindQName      = thFun (fsLit "bindQ")     bindQIdKey
+sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey
+newNameName    = thFun (fsLit "newName")   newNameIdKey
+liftName       = thFun (fsLit "lift")      liftIdKey
+liftStringName = thFun (fsLit "liftString")  liftStringIdKey
+mkNameName     = thFun (fsLit "mkName")     mkNameIdKey
+mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey
+mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
+mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
+mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
+mkNameSName    = thFun (fsLit "mkNameS")    mkNameSIdKey
+unTypeName     = thFun (fsLit "unType")     unTypeIdKey
+unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
+unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
+liftTypedName = thFun (fsLit "liftTyped") liftTypedIdKey
+
+
+-------------------- TH.Lib -----------------------
+-- data Lit = ...
+charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
+    floatPrimLName, doublePrimLName, rationalLName, stringPrimLName,
+    charPrimLName :: Name
+charLName       = libFun (fsLit "charL")       charLIdKey
+stringLName     = libFun (fsLit "stringL")     stringLIdKey
+integerLName    = libFun (fsLit "integerL")    integerLIdKey
+intPrimLName    = libFun (fsLit "intPrimL")    intPrimLIdKey
+wordPrimLName   = libFun (fsLit "wordPrimL")   wordPrimLIdKey
+floatPrimLName  = libFun (fsLit "floatPrimL")  floatPrimLIdKey
+doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
+rationalLName   = libFun (fsLit "rationalL")     rationalLIdKey
+stringPrimLName = libFun (fsLit "stringPrimL") stringPrimLIdKey
+charPrimLName   = libFun (fsLit "charPrimL")   charPrimLIdKey
+
+-- data Pat = ...
+litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName,
+    infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName,
+    sigPName, viewPName :: Name
+litPName   = libFun (fsLit "litP")   litPIdKey
+varPName   = libFun (fsLit "varP")   varPIdKey
+tupPName   = libFun (fsLit "tupP")   tupPIdKey
+unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey
+unboxedSumPName = libFun (fsLit "unboxedSumP") unboxedSumPIdKey
+conPName   = libFun (fsLit "conP")   conPIdKey
+infixPName = libFun (fsLit "infixP") infixPIdKey
+tildePName = libFun (fsLit "tildeP") tildePIdKey
+bangPName  = libFun (fsLit "bangP")  bangPIdKey
+asPName    = libFun (fsLit "asP")    asPIdKey
+wildPName  = libFun (fsLit "wildP")  wildPIdKey
+recPName   = libFun (fsLit "recP")   recPIdKey
+listPName  = libFun (fsLit "listP")  listPIdKey
+sigPName   = libFun (fsLit "sigP")   sigPIdKey
+viewPName  = libFun (fsLit "viewP")  viewPIdKey
+
+-- type FieldPat = ...
+fieldPatName :: Name
+fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
+
+-- data Match = ...
+matchName :: Name
+matchName = libFun (fsLit "match") matchIdKey
+
+-- data Clause = ...
+clauseName :: Name
+clauseName = libFun (fsLit "clause") clauseIdKey
+
+-- data Exp = ...
+varEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName,
+    sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
+    unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,
+    caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName,
+    labelEName, implicitParamVarEName :: Name
+varEName              = libFun (fsLit "varE")              varEIdKey
+conEName              = libFun (fsLit "conE")              conEIdKey
+litEName              = libFun (fsLit "litE")              litEIdKey
+appEName              = libFun (fsLit "appE")              appEIdKey
+appTypeEName          = libFun (fsLit "appTypeE")          appTypeEIdKey
+infixEName            = libFun (fsLit "infixE")            infixEIdKey
+infixAppName          = libFun (fsLit "infixApp")          infixAppIdKey
+sectionLName          = libFun (fsLit "sectionL")          sectionLIdKey
+sectionRName          = libFun (fsLit "sectionR")          sectionRIdKey
+lamEName              = libFun (fsLit "lamE")              lamEIdKey
+lamCaseEName          = libFun (fsLit "lamCaseE")          lamCaseEIdKey
+tupEName              = libFun (fsLit "tupE")              tupEIdKey
+unboxedTupEName       = libFun (fsLit "unboxedTupE")       unboxedTupEIdKey
+unboxedSumEName       = libFun (fsLit "unboxedSumE")       unboxedSumEIdKey
+condEName             = libFun (fsLit "condE")             condEIdKey
+multiIfEName          = libFun (fsLit "multiIfE")          multiIfEIdKey
+letEName              = libFun (fsLit "letE")              letEIdKey
+caseEName             = libFun (fsLit "caseE")             caseEIdKey
+doEName               = libFun (fsLit "doE")               doEIdKey
+mdoEName              = libFun (fsLit "mdoE")              mdoEIdKey
+compEName             = libFun (fsLit "compE")             compEIdKey
+-- ArithSeq skips a level
+fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
+fromEName             = libFun (fsLit "fromE")             fromEIdKey
+fromThenEName         = libFun (fsLit "fromThenE")         fromThenEIdKey
+fromToEName           = libFun (fsLit "fromToE")           fromToEIdKey
+fromThenToEName       = libFun (fsLit "fromThenToE")       fromThenToEIdKey
+-- end ArithSeq
+listEName, sigEName, recConEName, recUpdEName :: Name
+listEName             = libFun (fsLit "listE")             listEIdKey
+sigEName              = libFun (fsLit "sigE")              sigEIdKey
+recConEName           = libFun (fsLit "recConE")           recConEIdKey
+recUpdEName           = libFun (fsLit "recUpdE")           recUpdEIdKey
+staticEName           = libFun (fsLit "staticE")           staticEIdKey
+unboundVarEName       = libFun (fsLit "unboundVarE")       unboundVarEIdKey
+labelEName            = libFun (fsLit "labelE")            labelEIdKey
+implicitParamVarEName = libFun (fsLit "implicitParamVarE") implicitParamVarEIdKey
+
+-- type FieldExp = ...
+fieldExpName :: Name
+fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
+
+-- data Body = ...
+guardedBName, normalBName :: Name
+guardedBName = libFun (fsLit "guardedB") guardedBIdKey
+normalBName  = libFun (fsLit "normalB")  normalBIdKey
+
+-- data Guard = ...
+normalGEName, patGEName :: Name
+normalGEName = libFun (fsLit "normalGE") normalGEIdKey
+patGEName    = libFun (fsLit "patGE")    patGEIdKey
+
+-- data Stmt = ...
+bindSName, letSName, noBindSName, parSName, recSName :: Name
+bindSName   = libFun (fsLit "bindS")   bindSIdKey
+letSName    = libFun (fsLit "letS")    letSIdKey
+noBindSName = libFun (fsLit "noBindS") noBindSIdKey
+parSName    = libFun (fsLit "parS")    parSIdKey
+recSName    = libFun (fsLit "recS")    recSIdKey
+
+-- data Dec = ...
+funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
+    instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName,
+    pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,
+    pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName,
+    dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,
+    openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,
+    infixNDName, roleAnnotDName, patSynDName, patSynSigDName,
+    pragCompleteDName, implicitParamBindDName :: Name
+funDName                         = libFun (fsLit "funD")                         funDIdKey
+valDName                         = libFun (fsLit "valD")                         valDIdKey
+dataDName                        = libFun (fsLit "dataD")                        dataDIdKey
+newtypeDName                     = libFun (fsLit "newtypeD")                     newtypeDIdKey
+tySynDName                       = libFun (fsLit "tySynD")                       tySynDIdKey
+classDName                       = libFun (fsLit "classD")                       classDIdKey
+instanceWithOverlapDName         = libFun (fsLit "instanceWithOverlapD")         instanceWithOverlapDIdKey
+standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey
+sigDName                         = libFun (fsLit "sigD")                         sigDIdKey
+kiSigDName                       = libFun (fsLit "kiSigD")                       kiSigDIdKey
+defaultSigDName                  = libFun (fsLit "defaultSigD")                  defaultSigDIdKey
+forImpDName                      = libFun (fsLit "forImpD")                      forImpDIdKey
+pragInlDName                     = libFun (fsLit "pragInlD")                     pragInlDIdKey
+pragSpecDName                    = libFun (fsLit "pragSpecD")                    pragSpecDIdKey
+pragSpecInlDName                 = libFun (fsLit "pragSpecInlD")                 pragSpecInlDIdKey
+pragSpecInstDName                = libFun (fsLit "pragSpecInstD")                pragSpecInstDIdKey
+pragRuleDName                    = libFun (fsLit "pragRuleD")                    pragRuleDIdKey
+pragCompleteDName                = libFun (fsLit "pragCompleteD")                pragCompleteDIdKey
+pragAnnDName                     = libFun (fsLit "pragAnnD")                     pragAnnDIdKey
+dataInstDName                    = libFun (fsLit "dataInstD")                    dataInstDIdKey
+newtypeInstDName                 = libFun (fsLit "newtypeInstD")                 newtypeInstDIdKey
+tySynInstDName                   = libFun (fsLit "tySynInstD")                   tySynInstDIdKey
+openTypeFamilyDName              = libFun (fsLit "openTypeFamilyD")              openTypeFamilyDIdKey
+closedTypeFamilyDName            = libFun (fsLit "closedTypeFamilyD")            closedTypeFamilyDIdKey
+dataFamilyDName                  = libFun (fsLit "dataFamilyD")                  dataFamilyDIdKey
+infixLDName                      = libFun (fsLit "infixLD")                      infixLDIdKey
+infixRDName                      = libFun (fsLit "infixRD")                      infixRDIdKey
+infixNDName                      = libFun (fsLit "infixND")                      infixNDIdKey
+roleAnnotDName                   = libFun (fsLit "roleAnnotD")                   roleAnnotDIdKey
+patSynDName                      = libFun (fsLit "patSynD")                      patSynDIdKey
+patSynSigDName                   = libFun (fsLit "patSynSigD")                   patSynSigDIdKey
+implicitParamBindDName           = libFun (fsLit "implicitParamBindD")           implicitParamBindDIdKey
+
+-- type Ctxt = ...
+cxtName :: Name
+cxtName = libFun (fsLit "cxt") cxtIdKey
+
+-- data SourceUnpackedness = ...
+noSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName :: Name
+noSourceUnpackednessName = libFun (fsLit "noSourceUnpackedness") noSourceUnpackednessKey
+sourceNoUnpackName       = libFun (fsLit "sourceNoUnpack")       sourceNoUnpackKey
+sourceUnpackName         = libFun (fsLit "sourceUnpack")         sourceUnpackKey
+
+-- data SourceStrictness = ...
+noSourceStrictnessName, sourceLazyName, sourceStrictName :: Name
+noSourceStrictnessName = libFun (fsLit "noSourceStrictness") noSourceStrictnessKey
+sourceLazyName         = libFun (fsLit "sourceLazy")         sourceLazyKey
+sourceStrictName       = libFun (fsLit "sourceStrict")       sourceStrictKey
+
+-- data Con = ...
+normalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName :: Name
+normalCName  = libFun (fsLit "normalC" ) normalCIdKey
+recCName     = libFun (fsLit "recC"    ) recCIdKey
+infixCName   = libFun (fsLit "infixC"  ) infixCIdKey
+forallCName  = libFun (fsLit "forallC" ) forallCIdKey
+gadtCName    = libFun (fsLit "gadtC"   ) gadtCIdKey
+recGadtCName = libFun (fsLit "recGadtC") recGadtCIdKey
+
+-- data Bang = ...
+bangName :: Name
+bangName = libFun (fsLit "bang") bangIdKey
+
+-- type BangType = ...
+bangTypeName :: Name
+bangTypeName = libFun (fsLit "bangType") bangTKey
+
+-- type VarBangType = ...
+varBangTypeName :: Name
+varBangTypeName = libFun (fsLit "varBangType") varBangTKey
+
+-- data PatSynDir = ...
+unidirPatSynName, implBidirPatSynName, explBidirPatSynName :: Name
+unidirPatSynName    = libFun (fsLit "unidir")    unidirPatSynIdKey
+implBidirPatSynName = libFun (fsLit "implBidir") implBidirPatSynIdKey
+explBidirPatSynName = libFun (fsLit "explBidir") explBidirPatSynIdKey
+
+-- data PatSynArgs = ...
+prefixPatSynName, infixPatSynName, recordPatSynName :: Name
+prefixPatSynName = libFun (fsLit "prefixPatSyn") prefixPatSynIdKey
+infixPatSynName  = libFun (fsLit "infixPatSyn")  infixPatSynIdKey
+recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
+
+-- data Type = ...
+forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
+    unboxedTupleTName, unboxedSumTName, arrowTName, listTName, appTName,
+    appKindTName, sigTName, equalityTName, litTName, promotedTName,
+    promotedTupleTName, promotedNilTName, promotedConsTName,
+    wildCardTName, implicitParamTName :: Name
+forallTName         = libFun (fsLit "forallT")        forallTIdKey
+forallVisTName      = libFun (fsLit "forallVisT")     forallVisTIdKey
+varTName            = libFun (fsLit "varT")           varTIdKey
+conTName            = libFun (fsLit "conT")           conTIdKey
+tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
+unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
+unboxedSumTName     = libFun (fsLit "unboxedSumT")    unboxedSumTIdKey
+arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
+listTName           = libFun (fsLit "listT")          listTIdKey
+appTName            = libFun (fsLit "appT")           appTIdKey
+appKindTName        = libFun (fsLit "appKindT")       appKindTIdKey
+sigTName            = libFun (fsLit "sigT")           sigTIdKey
+equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
+litTName            = libFun (fsLit "litT")           litTIdKey
+promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
+promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
+promotedNilTName    = libFun (fsLit "promotedNilT")   promotedNilTIdKey
+promotedConsTName   = libFun (fsLit "promotedConsT")  promotedConsTIdKey
+wildCardTName       = libFun (fsLit "wildCardT")      wildCardTIdKey
+infixTName          = libFun (fsLit "infixT")         infixTIdKey
+implicitParamTName  = libFun (fsLit "implicitParamT") implicitParamTIdKey
+
+-- data TyLit = ...
+numTyLitName, strTyLitName :: Name
+numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
+strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
+
+-- data TyVarBndr = ...
+plainTVName, kindedTVName :: Name
+plainTVName  = libFun (fsLit "plainTV")  plainTVIdKey
+kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
+
+-- data Role = ...
+nominalRName, representationalRName, phantomRName, inferRName :: Name
+nominalRName          = libFun (fsLit "nominalR")          nominalRIdKey
+representationalRName = libFun (fsLit "representationalR") representationalRIdKey
+phantomRName          = libFun (fsLit "phantomR")          phantomRIdKey
+inferRName            = libFun (fsLit "inferR")            inferRIdKey
+
+-- data Kind = ...
+starKName, constraintKName :: Name
+starKName       = libFun (fsLit "starK")        starKIdKey
+constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
+
+-- data FamilyResultSig = ...
+noSigName, kindSigName, tyVarSigName :: Name
+noSigName    = libFun (fsLit "noSig")    noSigIdKey
+kindSigName  = libFun (fsLit "kindSig")  kindSigIdKey
+tyVarSigName = libFun (fsLit "tyVarSig") tyVarSigIdKey
+
+-- data InjectivityAnn = ...
+injectivityAnnName :: Name
+injectivityAnnName = libFun (fsLit "injectivityAnn") injectivityAnnIdKey
+
+-- data Callconv = ...
+cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: Name
+cCallName = libFun (fsLit "cCall") cCallIdKey
+stdCallName = libFun (fsLit "stdCall") stdCallIdKey
+cApiCallName = libFun (fsLit "cApi") cApiCallIdKey
+primCallName = libFun (fsLit "prim") primCallIdKey
+javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey
+
+-- data Safety = ...
+unsafeName, safeName, interruptibleName :: Name
+unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
+safeName       = libFun (fsLit "safe") safeIdKey
+interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
+
+-- newtype TExp a = ...
+tExpDataConName :: Name
+tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
+
+-- data RuleBndr = ...
+ruleVarName, typedRuleVarName :: Name
+ruleVarName      = libFun (fsLit ("ruleVar"))      ruleVarIdKey
+typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
+
+-- data FunDep = ...
+funDepName :: Name
+funDepName     = libFun (fsLit "funDep") funDepIdKey
+
+-- data TySynEqn = ...
+tySynEqnName :: Name
+tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
+
+-- data AnnTarget = ...
+valueAnnotationName, typeAnnotationName, moduleAnnotationName :: Name
+valueAnnotationName  = libFun (fsLit "valueAnnotation")  valueAnnotationIdKey
+typeAnnotationName   = libFun (fsLit "typeAnnotation")   typeAnnotationIdKey
+moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey
+
+-- type DerivClause = ...
+derivClauseName :: Name
+derivClauseName = libFun (fsLit "derivClause") derivClauseIdKey
+
+-- data DerivStrategy = ...
+stockStrategyName, anyclassStrategyName, newtypeStrategyName,
+  viaStrategyName :: Name
+stockStrategyName    = libFun (fsLit "stockStrategy")    stockStrategyIdKey
+anyclassStrategyName = libFun (fsLit "anyclassStrategy") anyclassStrategyIdKey
+newtypeStrategyName  = libFun (fsLit "newtypeStrategy")  newtypeStrategyIdKey
+viaStrategyName      = libFun (fsLit "viaStrategy")      viaStrategyIdKey
+
+patQTyConName, expQTyConName, stmtTyConName,
+    conTyConName, bangTypeTyConName,
+    varBangTypeTyConName, typeQTyConName,
+    decsQTyConName, ruleBndrTyConName, tySynEqnTyConName, roleTyConName,
+    derivClauseTyConName, kindTyConName, tyVarBndrTyConName,
+    derivStrategyTyConName :: Name
+-- These are only used for the types of top-level splices
+expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
+decsQTyConName          = libTc (fsLit "DecsQ")          decsQTyConKey  -- Q [Dec]
+typeQTyConName          = libTc (fsLit "TypeQ")          typeQTyConKey
+patQTyConName           = libTc (fsLit "PatQ")           patQTyConKey
+
+-- These are used in GHC.HsToCore.Quote but always wrapped in a type variable
+stmtTyConName           = thTc (fsLit "Stmt")            stmtTyConKey
+conTyConName            = thTc (fsLit "Con")             conTyConKey
+bangTypeTyConName       = thTc (fsLit "BangType")      bangTypeTyConKey
+varBangTypeTyConName    = thTc (fsLit "VarBangType")     varBangTypeTyConKey
+ruleBndrTyConName      = thTc (fsLit "RuleBndr")      ruleBndrTyConKey
+tySynEqnTyConName       = thTc  (fsLit "TySynEqn")       tySynEqnTyConKey
+roleTyConName           = libTc (fsLit "Role")           roleTyConKey
+derivClauseTyConName   = thTc (fsLit "DerivClause")   derivClauseTyConKey
+kindTyConName          = thTc (fsLit "Kind")          kindTyConKey
+tyVarBndrTyConName      = thTc (fsLit "TyVarBndr")     tyVarBndrTyConKey
+derivStrategyTyConName = thTc (fsLit "DerivStrategy") derivStrategyTyConKey
+
+-- quasiquoting
+quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
+quoteExpName        = qqFun (fsLit "quoteExp")  quoteExpKey
+quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
+quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
+quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
+
+-- data Inline = ...
+noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
+inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
+inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+
+-- data RuleMatch = ...
+conLikeDataConName, funLikeDataConName :: Name
+conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
+funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+
+-- data Phases = ...
+allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
+allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
+fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
+beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
+
+-- data Overlap = ...
+overlappableDataConName,
+  overlappingDataConName,
+  overlapsDataConName,
+  incoherentDataConName :: Name
+overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey
+overlappingDataConName  = thCon (fsLit "Overlapping")  overlappingDataConKey
+overlapsDataConName     = thCon (fsLit "Overlaps")     overlapsDataConKey
+incoherentDataConName   = thCon (fsLit "Incoherent")   incoherentDataConKey
+
+{- *********************************************************************
+*                                                                      *
+                     Class keys
+*                                                                      *
+********************************************************************* -}
+
+-- ClassUniques available: 200-299
+-- Check in GHC.Builtin.Names if you want to change this
+
+liftClassKey :: Unique
+liftClassKey = mkPreludeClassUnique 200
+
+quoteClassKey :: Unique
+quoteClassKey = mkPreludeClassUnique 201
+
+{- *********************************************************************
+*                                                                      *
+                     TyCon keys
+*                                                                      *
+********************************************************************* -}
+
+-- TyConUniques available: 200-299
+-- Check in GHC.Builtin.Names if you want to change this
+
+expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
+    patTyConKey,
+    stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey,
+    tyVarBndrTyConKey, decTyConKey, bangTypeTyConKey, varBangTypeTyConKey,
+    fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
+    funDepTyConKey, predTyConKey,
+    predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey,
+    roleTyConKey, tExpTyConKey, injAnnTyConKey, kindTyConKey,
+    overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey
+      :: Unique
+expTyConKey             = mkPreludeTyConUnique 200
+matchTyConKey           = mkPreludeTyConUnique 201
+clauseTyConKey          = mkPreludeTyConUnique 202
+qTyConKey               = mkPreludeTyConUnique 203
+expQTyConKey            = mkPreludeTyConUnique 204
+patTyConKey             = mkPreludeTyConUnique 206
+stmtTyConKey            = mkPreludeTyConUnique 209
+conTyConKey             = mkPreludeTyConUnique 210
+typeQTyConKey           = mkPreludeTyConUnique 211
+typeTyConKey            = mkPreludeTyConUnique 212
+decTyConKey             = mkPreludeTyConUnique 213
+bangTypeTyConKey       = mkPreludeTyConUnique 214
+varBangTypeTyConKey     = mkPreludeTyConUnique 215
+fieldExpTyConKey        = mkPreludeTyConUnique 216
+fieldPatTyConKey        = mkPreludeTyConUnique 217
+nameTyConKey            = mkPreludeTyConUnique 218
+patQTyConKey            = mkPreludeTyConUnique 219
+funDepTyConKey          = mkPreludeTyConUnique 222
+predTyConKey            = mkPreludeTyConUnique 223
+predQTyConKey           = mkPreludeTyConUnique 224
+tyVarBndrTyConKey      = mkPreludeTyConUnique 225
+decsQTyConKey           = mkPreludeTyConUnique 226
+ruleBndrTyConKey       = mkPreludeTyConUnique 227
+tySynEqnTyConKey        = mkPreludeTyConUnique 228
+roleTyConKey            = mkPreludeTyConUnique 229
+tExpTyConKey            = mkPreludeTyConUnique 230
+injAnnTyConKey          = mkPreludeTyConUnique 231
+kindTyConKey           = mkPreludeTyConUnique 232
+overlapTyConKey         = mkPreludeTyConUnique 233
+derivClauseTyConKey    = mkPreludeTyConUnique 234
+derivStrategyTyConKey  = mkPreludeTyConUnique 235
+decsTyConKey            = mkPreludeTyConUnique 236
+
+{- *********************************************************************
+*                                                                      *
+                     DataCon keys
+*                                                                      *
+********************************************************************* -}
+
+-- DataConUniques available: 100-150
+-- If you want to change this, make sure you check in GHC.Builtin.Names
+
+-- data Inline = ...
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey  = mkPreludeDataConUnique 200
+inlineDataConKey    = mkPreludeDataConUnique 201
+inlinableDataConKey = mkPreludeDataConUnique 202
+
+-- data RuleMatch = ...
+conLikeDataConKey, funLikeDataConKey :: Unique
+conLikeDataConKey = mkPreludeDataConUnique 203
+funLikeDataConKey = mkPreludeDataConUnique 204
+
+-- data Phases = ...
+allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
+allPhasesDataConKey   = mkPreludeDataConUnique 205
+fromPhaseDataConKey   = mkPreludeDataConUnique 206
+beforePhaseDataConKey = mkPreludeDataConUnique 207
+
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 208
+
+-- data Overlap = ..
+overlappableDataConKey,
+  overlappingDataConKey,
+  overlapsDataConKey,
+  incoherentDataConKey :: Unique
+overlappableDataConKey = mkPreludeDataConUnique 209
+overlappingDataConKey  = mkPreludeDataConUnique 210
+overlapsDataConKey     = mkPreludeDataConUnique 211
+incoherentDataConKey   = mkPreludeDataConUnique 212
+
+{- *********************************************************************
+*                                                                      *
+                     Id keys
+*                                                                      *
+********************************************************************* -}
+
+-- IdUniques available: 200-499
+-- If you want to change this, make sure you check in GHC.Builtin.Names
+
+returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
+    mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
+    mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,
+    unsafeTExpCoerceIdKey, liftTypedIdKey :: Unique
+returnQIdKey        = mkPreludeMiscIdUnique 200
+bindQIdKey          = mkPreludeMiscIdUnique 201
+sequenceQIdKey      = mkPreludeMiscIdUnique 202
+liftIdKey           = mkPreludeMiscIdUnique 203
+newNameIdKey         = mkPreludeMiscIdUnique 204
+mkNameIdKey          = mkPreludeMiscIdUnique 205
+mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
+mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
+mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
+mkNameLIdKey         = mkPreludeMiscIdUnique 209
+mkNameSIdKey         = mkPreludeMiscIdUnique 210
+unTypeIdKey          = mkPreludeMiscIdUnique 211
+unTypeQIdKey         = mkPreludeMiscIdUnique 212
+unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213
+liftTypedIdKey        = mkPreludeMiscIdUnique 214
+
+
+-- data Lit = ...
+charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
+    floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey, stringPrimLIdKey,
+    charPrimLIdKey:: Unique
+charLIdKey        = mkPreludeMiscIdUnique 220
+stringLIdKey      = mkPreludeMiscIdUnique 221
+integerLIdKey     = mkPreludeMiscIdUnique 222
+intPrimLIdKey     = mkPreludeMiscIdUnique 223
+wordPrimLIdKey    = mkPreludeMiscIdUnique 224
+floatPrimLIdKey   = mkPreludeMiscIdUnique 225
+doublePrimLIdKey  = mkPreludeMiscIdUnique 226
+rationalLIdKey    = mkPreludeMiscIdUnique 227
+stringPrimLIdKey  = mkPreludeMiscIdUnique 228
+charPrimLIdKey    = mkPreludeMiscIdUnique 229
+
+liftStringIdKey :: Unique
+liftStringIdKey     = mkPreludeMiscIdUnique 230
+
+-- data Pat = ...
+litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey,
+  infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey,
+  listPIdKey, sigPIdKey, viewPIdKey :: Unique
+litPIdKey         = mkPreludeMiscIdUnique 240
+varPIdKey         = mkPreludeMiscIdUnique 241
+tupPIdKey         = mkPreludeMiscIdUnique 242
+unboxedTupPIdKey  = mkPreludeMiscIdUnique 243
+unboxedSumPIdKey  = mkPreludeMiscIdUnique 244
+conPIdKey         = mkPreludeMiscIdUnique 245
+infixPIdKey       = mkPreludeMiscIdUnique 246
+tildePIdKey       = mkPreludeMiscIdUnique 247
+bangPIdKey        = mkPreludeMiscIdUnique 248
+asPIdKey          = mkPreludeMiscIdUnique 249
+wildPIdKey        = mkPreludeMiscIdUnique 250
+recPIdKey         = mkPreludeMiscIdUnique 251
+listPIdKey        = mkPreludeMiscIdUnique 252
+sigPIdKey         = mkPreludeMiscIdUnique 253
+viewPIdKey        = mkPreludeMiscIdUnique 254
+
+-- type FieldPat = ...
+fieldPatIdKey :: Unique
+fieldPatIdKey       = mkPreludeMiscIdUnique 260
+
+-- data Match = ...
+matchIdKey :: Unique
+matchIdKey          = mkPreludeMiscIdUnique 261
+
+-- data Clause = ...
+clauseIdKey :: Unique
+clauseIdKey         = mkPreludeMiscIdUnique 262
+
+
+-- data Exp = ...
+varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey,
+    infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey,
+    tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, multiIfEIdKey,
+    letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
+    fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
+    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,
+    unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey :: Unique
+varEIdKey              = mkPreludeMiscIdUnique 270
+conEIdKey              = mkPreludeMiscIdUnique 271
+litEIdKey              = mkPreludeMiscIdUnique 272
+appEIdKey              = mkPreludeMiscIdUnique 273
+appTypeEIdKey          = mkPreludeMiscIdUnique 274
+infixEIdKey            = mkPreludeMiscIdUnique 275
+infixAppIdKey          = mkPreludeMiscIdUnique 276
+sectionLIdKey          = mkPreludeMiscIdUnique 277
+sectionRIdKey          = mkPreludeMiscIdUnique 278
+lamEIdKey              = mkPreludeMiscIdUnique 279
+lamCaseEIdKey          = mkPreludeMiscIdUnique 280
+tupEIdKey              = mkPreludeMiscIdUnique 281
+unboxedTupEIdKey       = mkPreludeMiscIdUnique 282
+unboxedSumEIdKey       = mkPreludeMiscIdUnique 283
+condEIdKey             = mkPreludeMiscIdUnique 284
+multiIfEIdKey          = mkPreludeMiscIdUnique 285
+letEIdKey              = mkPreludeMiscIdUnique 286
+caseEIdKey             = mkPreludeMiscIdUnique 287
+doEIdKey               = mkPreludeMiscIdUnique 288
+compEIdKey             = mkPreludeMiscIdUnique 289
+fromEIdKey             = mkPreludeMiscIdUnique 290
+fromThenEIdKey         = mkPreludeMiscIdUnique 291
+fromToEIdKey           = mkPreludeMiscIdUnique 292
+fromThenToEIdKey       = mkPreludeMiscIdUnique 293
+listEIdKey             = mkPreludeMiscIdUnique 294
+sigEIdKey              = mkPreludeMiscIdUnique 295
+recConEIdKey           = mkPreludeMiscIdUnique 296
+recUpdEIdKey           = mkPreludeMiscIdUnique 297
+staticEIdKey           = mkPreludeMiscIdUnique 298
+unboundVarEIdKey       = mkPreludeMiscIdUnique 299
+labelEIdKey            = mkPreludeMiscIdUnique 300
+implicitParamVarEIdKey = mkPreludeMiscIdUnique 301
+mdoEIdKey              = mkPreludeMiscIdUnique 302
+
+-- type FieldExp = ...
+fieldExpIdKey :: Unique
+fieldExpIdKey       = mkPreludeMiscIdUnique 305
+
+-- data Body = ...
+guardedBIdKey, normalBIdKey :: Unique
+guardedBIdKey     = mkPreludeMiscIdUnique 306
+normalBIdKey      = mkPreludeMiscIdUnique 307
+
+-- data Guard = ...
+normalGEIdKey, patGEIdKey :: Unique
+normalGEIdKey     = mkPreludeMiscIdUnique 308
+patGEIdKey        = mkPreludeMiscIdUnique 309
+
+-- data Stmt = ...
+bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey, recSIdKey :: Unique
+bindSIdKey       = mkPreludeMiscIdUnique 310
+letSIdKey        = mkPreludeMiscIdUnique 311
+noBindSIdKey     = mkPreludeMiscIdUnique 312
+parSIdKey        = mkPreludeMiscIdUnique 313
+recSIdKey        = mkPreludeMiscIdUnique 314
+
+-- data Dec = ...
+funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,
+    instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey,
+    pragInlDIdKey, pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey,
+    pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey,
+    openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey,
+    newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,
+    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,
+    patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,
+    kiSigDIdKey :: Unique
+funDIdKey                         = mkPreludeMiscIdUnique 320
+valDIdKey                         = mkPreludeMiscIdUnique 321
+dataDIdKey                        = mkPreludeMiscIdUnique 322
+newtypeDIdKey                     = mkPreludeMiscIdUnique 323
+tySynDIdKey                       = mkPreludeMiscIdUnique 324
+classDIdKey                       = mkPreludeMiscIdUnique 325
+instanceWithOverlapDIdKey         = mkPreludeMiscIdUnique 326
+instanceDIdKey                    = mkPreludeMiscIdUnique 327
+sigDIdKey                         = mkPreludeMiscIdUnique 328
+forImpDIdKey                      = mkPreludeMiscIdUnique 329
+pragInlDIdKey                     = mkPreludeMiscIdUnique 330
+pragSpecDIdKey                    = mkPreludeMiscIdUnique 331
+pragSpecInlDIdKey                 = mkPreludeMiscIdUnique 332
+pragSpecInstDIdKey                = mkPreludeMiscIdUnique 333
+pragRuleDIdKey                    = mkPreludeMiscIdUnique 334
+pragAnnDIdKey                     = mkPreludeMiscIdUnique 335
+dataFamilyDIdKey                  = mkPreludeMiscIdUnique 336
+openTypeFamilyDIdKey              = mkPreludeMiscIdUnique 337
+dataInstDIdKey                    = mkPreludeMiscIdUnique 338
+newtypeInstDIdKey                 = mkPreludeMiscIdUnique 339
+tySynInstDIdKey                   = mkPreludeMiscIdUnique 340
+closedTypeFamilyDIdKey            = mkPreludeMiscIdUnique 341
+infixLDIdKey                      = mkPreludeMiscIdUnique 342
+infixRDIdKey                      = mkPreludeMiscIdUnique 343
+infixNDIdKey                      = mkPreludeMiscIdUnique 344
+roleAnnotDIdKey                   = mkPreludeMiscIdUnique 345
+standaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346
+defaultSigDIdKey                  = mkPreludeMiscIdUnique 347
+patSynDIdKey                      = mkPreludeMiscIdUnique 348
+patSynSigDIdKey                   = mkPreludeMiscIdUnique 349
+pragCompleteDIdKey                = mkPreludeMiscIdUnique 350
+implicitParamBindDIdKey           = mkPreludeMiscIdUnique 351
+kiSigDIdKey                       = mkPreludeMiscIdUnique 352
+
+-- type Cxt = ...
+cxtIdKey :: Unique
+cxtIdKey               = mkPreludeMiscIdUnique 361
+
+-- data SourceUnpackedness = ...
+noSourceUnpackednessKey, sourceNoUnpackKey, sourceUnpackKey :: Unique
+noSourceUnpackednessKey = mkPreludeMiscIdUnique 362
+sourceNoUnpackKey       = mkPreludeMiscIdUnique 363
+sourceUnpackKey         = mkPreludeMiscIdUnique 364
+
+-- data SourceStrictness = ...
+noSourceStrictnessKey, sourceLazyKey, sourceStrictKey :: Unique
+noSourceStrictnessKey   = mkPreludeMiscIdUnique 365
+sourceLazyKey           = mkPreludeMiscIdUnique 366
+sourceStrictKey         = mkPreludeMiscIdUnique 367
+
+-- data Con = ...
+normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey, gadtCIdKey,
+  recGadtCIdKey :: Unique
+normalCIdKey      = mkPreludeMiscIdUnique 368
+recCIdKey         = mkPreludeMiscIdUnique 369
+infixCIdKey       = mkPreludeMiscIdUnique 370
+forallCIdKey      = mkPreludeMiscIdUnique 371
+gadtCIdKey        = mkPreludeMiscIdUnique 372
+recGadtCIdKey     = mkPreludeMiscIdUnique 373
+
+-- data Bang = ...
+bangIdKey :: Unique
+bangIdKey         = mkPreludeMiscIdUnique 374
+
+-- type BangType = ...
+bangTKey :: Unique
+bangTKey          = mkPreludeMiscIdUnique 375
+
+-- type VarBangType = ...
+varBangTKey :: Unique
+varBangTKey       = mkPreludeMiscIdUnique 376
+
+-- data PatSynDir = ...
+unidirPatSynIdKey, implBidirPatSynIdKey, explBidirPatSynIdKey :: Unique
+unidirPatSynIdKey    = mkPreludeMiscIdUnique 377
+implBidirPatSynIdKey = mkPreludeMiscIdUnique 378
+explBidirPatSynIdKey = mkPreludeMiscIdUnique 379
+
+-- data PatSynArgs = ...
+prefixPatSynIdKey, infixPatSynIdKey, recordPatSynIdKey :: Unique
+prefixPatSynIdKey = mkPreludeMiscIdUnique 380
+infixPatSynIdKey  = mkPreludeMiscIdUnique 381
+recordPatSynIdKey = mkPreludeMiscIdUnique 382
+
+-- data Type = ...
+forallTIdKey, forallVisTIdKey, varTIdKey, conTIdKey, tupleTIdKey,
+    unboxedTupleTIdKey, unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey,
+    appKindTIdKey, sigTIdKey, equalityTIdKey, litTIdKey, promotedTIdKey,
+    promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey,
+    wildCardTIdKey, implicitParamTIdKey, infixTIdKey :: Unique
+forallTIdKey        = mkPreludeMiscIdUnique 390
+forallVisTIdKey     = mkPreludeMiscIdUnique 391
+varTIdKey           = mkPreludeMiscIdUnique 392
+conTIdKey           = mkPreludeMiscIdUnique 393
+tupleTIdKey         = mkPreludeMiscIdUnique 394
+unboxedTupleTIdKey  = mkPreludeMiscIdUnique 395
+unboxedSumTIdKey    = mkPreludeMiscIdUnique 396
+arrowTIdKey         = mkPreludeMiscIdUnique 397
+listTIdKey          = mkPreludeMiscIdUnique 398
+appTIdKey           = mkPreludeMiscIdUnique 399
+appKindTIdKey       = mkPreludeMiscIdUnique 400
+sigTIdKey           = mkPreludeMiscIdUnique 401
+equalityTIdKey      = mkPreludeMiscIdUnique 402
+litTIdKey           = mkPreludeMiscIdUnique 403
+promotedTIdKey      = mkPreludeMiscIdUnique 404
+promotedTupleTIdKey = mkPreludeMiscIdUnique 405
+promotedNilTIdKey   = mkPreludeMiscIdUnique 406
+promotedConsTIdKey  = mkPreludeMiscIdUnique 407
+wildCardTIdKey      = mkPreludeMiscIdUnique 408
+implicitParamTIdKey = mkPreludeMiscIdUnique 409
+infixTIdKey         = mkPreludeMiscIdUnique 410
+
+-- data TyLit = ...
+numTyLitIdKey, strTyLitIdKey :: Unique
+numTyLitIdKey = mkPreludeMiscIdUnique 411
+strTyLitIdKey = mkPreludeMiscIdUnique 412
+
+-- data TyVarBndr = ...
+plainTVIdKey, kindedTVIdKey :: Unique
+plainTVIdKey       = mkPreludeMiscIdUnique 413
+kindedTVIdKey      = mkPreludeMiscIdUnique 414
+
+-- data Role = ...
+nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
+nominalRIdKey          = mkPreludeMiscIdUnique 415
+representationalRIdKey = mkPreludeMiscIdUnique 416
+phantomRIdKey          = mkPreludeMiscIdUnique 417
+inferRIdKey            = mkPreludeMiscIdUnique 418
+
+-- data Kind = ...
+starKIdKey, constraintKIdKey :: Unique
+starKIdKey        = mkPreludeMiscIdUnique 425
+constraintKIdKey  = mkPreludeMiscIdUnique 426
+
+-- data FamilyResultSig = ...
+noSigIdKey, kindSigIdKey, tyVarSigIdKey :: Unique
+noSigIdKey        = mkPreludeMiscIdUnique 427
+kindSigIdKey      = mkPreludeMiscIdUnique 428
+tyVarSigIdKey     = mkPreludeMiscIdUnique 429
+
+-- data InjectivityAnn = ...
+injectivityAnnIdKey :: Unique
+injectivityAnnIdKey = mkPreludeMiscIdUnique 430
+
+-- data Callconv = ...
+cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
+  javaScriptCallIdKey :: Unique
+cCallIdKey          = mkPreludeMiscIdUnique 431
+stdCallIdKey        = mkPreludeMiscIdUnique 432
+cApiCallIdKey       = mkPreludeMiscIdUnique 433
+primCallIdKey       = mkPreludeMiscIdUnique 434
+javaScriptCallIdKey = mkPreludeMiscIdUnique 435
+
+-- data Safety = ...
+unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
+unsafeIdKey        = mkPreludeMiscIdUnique 440
+safeIdKey          = mkPreludeMiscIdUnique 441
+interruptibleIdKey = mkPreludeMiscIdUnique 442
+
+-- data FunDep = ...
+funDepIdKey :: Unique
+funDepIdKey = mkPreludeMiscIdUnique 445
+
+-- data TySynEqn = ...
+tySynEqnIdKey :: Unique
+tySynEqnIdKey = mkPreludeMiscIdUnique 460
+
+-- quasiquoting
+quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
+quoteExpKey  = mkPreludeMiscIdUnique 470
+quotePatKey  = mkPreludeMiscIdUnique 471
+quoteDecKey  = mkPreludeMiscIdUnique 472
+quoteTypeKey = mkPreludeMiscIdUnique 473
+
+-- data RuleBndr = ...
+ruleVarIdKey, typedRuleVarIdKey :: Unique
+ruleVarIdKey      = mkPreludeMiscIdUnique 480
+typedRuleVarIdKey = mkPreludeMiscIdUnique 481
+
+-- data AnnTarget = ...
+valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
+valueAnnotationIdKey  = mkPreludeMiscIdUnique 490
+typeAnnotationIdKey   = mkPreludeMiscIdUnique 491
+moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
+
+-- type DerivPred = ...
+derivClauseIdKey :: Unique
+derivClauseIdKey = mkPreludeMiscIdUnique 493
+
+-- data DerivStrategy = ...
+stockStrategyIdKey, anyclassStrategyIdKey, newtypeStrategyIdKey,
+  viaStrategyIdKey :: Unique
+stockStrategyIdKey    = mkPreludeDataConUnique 494
+anyclassStrategyIdKey = mkPreludeDataConUnique 495
+newtypeStrategyIdKey  = mkPreludeDataConUnique 496
+viaStrategyIdKey      = mkPreludeDataConUnique 497
+
+{-
+************************************************************************
+*                                                                      *
+                        RdrNames
+*                                                                      *
+************************************************************************
+-}
+
+lift_RDR, liftTyped_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName
+lift_RDR     = nameRdrName liftName
+liftTyped_RDR = nameRdrName liftTypedName
+mkNameG_dRDR = nameRdrName mkNameG_dName
+mkNameG_vRDR = nameRdrName mkNameG_vName
+
+-- data Exp = ...
+conE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName
+conE_RDR     = nameRdrName conEName
+litE_RDR     = nameRdrName litEName
+appE_RDR     = nameRdrName appEName
+infixApp_RDR = nameRdrName infixAppName
+
+-- data Lit = ...
+stringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR,
+    doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName
+stringL_RDR     = nameRdrName stringLName
+intPrimL_RDR    = nameRdrName intPrimLName
+wordPrimL_RDR   = nameRdrName wordPrimLName
+floatPrimL_RDR  = nameRdrName floatPrimLName
+doublePrimL_RDR = nameRdrName doublePrimLName
+stringPrimL_RDR = nameRdrName stringPrimLName
+charPrimL_RDR   = nameRdrName charPrimLName
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
new file mode 100644
index 0000000000..e85c12a55d
--- /dev/null
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -0,0 +1,698 @@
+{-
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[PrimOp]{Primitive operations (machine-level)}
+-}
+
+{-# LANGUAGE CPP #-}
+
+module GHC.Builtin.PrimOps (
+        PrimOp(..), PrimOpVecCat(..), allThePrimOps,
+        primOpType, primOpSig,
+        primOpTag, maxPrimOpTag, primOpOcc,
+        primOpWrapperId,
+
+        tagToEnumKey,
+
+        primOpOutOfLine, primOpCodeSize,
+        primOpOkForSpeculation, primOpOkForSideEffects,
+        primOpIsCheap, primOpFixity,
+
+        getPrimOpResultInfo,  isComparisonPrimOp, PrimOpResultInfo(..),
+
+        PrimCall(..)
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
+
+import GHC.Cmm.Type
+import GHC.Types.Demand
+import GHC.Types.Id      ( Id, mkVanillaGlobalWithInfo )
+import GHC.Types.Id.Info ( vanillaIdInfo, setCafInfo, CafInfo(NoCafRefs) )
+import GHC.Types.Name
+import GHC.Builtin.Names ( gHC_PRIMOPWRAPPERS )
+import GHC.Core.TyCon    ( TyCon, isPrimTyCon, PrimRep(..) )
+import GHC.Core.Type
+import GHC.Types.RepType ( typePrimRep1, tyConPrimRep1 )
+import GHC.Types.Basic   ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
+                           SourceText(..) )
+import GHC.Types.SrcLoc  ( wiredInSrcSpan )
+import GHC.Types.ForeignCall ( CLabelString )
+import GHC.Types.Unique  ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
+import GHC.Types.Module  ( UnitId )
+import Outputable
+import FastString
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
+*                                                                      *
+************************************************************************
+
+These are in \tr{state-interface.verb} order.
+-}
+
+-- supplies:
+-- data PrimOp = ...
+#include "primop-data-decl.hs-incl"
+
+-- supplies
+-- primOpTag :: PrimOp -> Int
+#include "primop-tag.hs-incl"
+primOpTag _ = error "primOpTag: unknown primop"
+
+
+instance Eq PrimOp where
+    op1 == op2 = primOpTag op1 == primOpTag op2
+
+instance Ord PrimOp where
+    op1 <  op2 =  primOpTag op1 < primOpTag op2
+    op1 <= op2 =  primOpTag op1 <= primOpTag op2
+    op1 >= op2 =  primOpTag op1 >= primOpTag op2
+    op1 >  op2 =  primOpTag op1 > primOpTag op2
+    op1 `compare` op2 | op1 < op2  = LT
+                      | op1 == op2 = EQ
+                      | otherwise  = GT
+
+instance Outputable PrimOp where
+    ppr op = pprPrimOp op
+
+data PrimOpVecCat = IntVec
+                  | WordVec
+                  | FloatVec
+
+-- An @Enum@-derived list would be better; meanwhile... (ToDo)
+
+allThePrimOps :: [PrimOp]
+allThePrimOps =
+#include "primop-list.hs-incl"
+
+tagToEnumKey :: Unique
+tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[PrimOp-info]{The essential info about each @PrimOp@}
+*                                                                      *
+************************************************************************
+
+The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
+refer to the primitive operation.  The conventional \tr{#}-for-
+unboxed ops is added on later.
+
+The reason for the funny characters in the names is so we do not
+interfere with the programmer's Haskell name spaces.
+
+We use @PrimKinds@ for the ``type'' information, because they're
+(slightly) more convenient to use than @TyCons@.
+-}
+
+data PrimOpInfo
+  = Dyadic      OccName         -- string :: T -> T -> T
+                Type
+  | Monadic     OccName         -- string :: T -> T
+                Type
+  | Compare     OccName         -- string :: T -> T -> Int#
+                Type
+  | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T
+                [TyVar]
+                [Type]
+                Type
+
+mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo
+mkDyadic str  ty = Dyadic  (mkVarOccFS str) ty
+mkMonadic str ty = Monadic (mkVarOccFS str) ty
+mkCompare str ty = Compare (mkVarOccFS str) ty
+
+mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo
+mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Strictness}
+*                                                                      *
+************************************************************************
+
+Not all primops are strict!
+-}
+
+primOpStrictness :: PrimOp -> Arity -> StrictSig
+        -- See Demand.StrictnessInfo for discussion of what the results
+        -- The arity should be the arity of the primop; that's why
+        -- this function isn't exported.
+#include "primop-strictness.hs-incl"
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Fixity}
+*                                                                      *
+************************************************************************
+-}
+
+primOpFixity :: PrimOp -> Maybe Fixity
+#include "primop-fixity.hs-incl"
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
+*                                                                      *
+************************************************************************
+
+@primOpInfo@ gives all essential information (from which everything
+else, notably a type, can be constructed) for each @PrimOp@.
+-}
+
+primOpInfo :: PrimOp -> PrimOpInfo
+#include "primop-primop-info.hs-incl"
+primOpInfo _ = error "primOpInfo: unknown primop"
+
+{-
+Here are a load of comments from the old primOp info:
+
+A @Word#@ is an unsigned @Int#@.
+
+@decodeFloat#@ is given w/ Integer-stuff (it's similar).
+
+@decodeDouble#@ is given w/ Integer-stuff (it's similar).
+
+Decoding of floating-point numbers is sorta Integer-related.  Encoding
+is done with plain ccalls now (see PrelNumExtra.hs).
+
+A @Weak@ Pointer is created by the @mkWeak#@ primitive:
+
+        mkWeak# :: k -> v -> f -> State# RealWorld
+                        -> (# State# RealWorld, Weak# v #)
+
+In practice, you'll use the higher-level
+
+        data Weak v = Weak# v
+        mkWeak :: k -> v -> IO () -> IO (Weak v)
+
+The following operation dereferences a weak pointer.  The weak pointer
+may have been finalized, so the operation returns a result code which
+must be inspected before looking at the dereferenced value.
+
+        deRefWeak# :: Weak# v -> State# RealWorld ->
+                        (# State# RealWorld, v, Int# #)
+
+Only look at v if the Int# returned is /= 0 !!
+
+The higher-level op is
+
+        deRefWeak :: Weak v -> IO (Maybe v)
+
+Weak pointers can be finalized early by using the finalize# operation:
+
+        finalizeWeak# :: Weak# v -> State# RealWorld ->
+                           (# State# RealWorld, Int#, IO () #)
+
+The Int# returned is either
+
+        0 if the weak pointer has already been finalized, or it has no
+          finalizer (the third component is then invalid).
+
+        1 if the weak pointer is still alive, with the finalizer returned
+          as the third component.
+
+A {\em stable name/pointer} is an index into a table of stable name
+entries.  Since the garbage collector is told about stable pointers,
+it is safe to pass a stable pointer to external systems such as C
+routines.
+
+\begin{verbatim}
+makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld
+deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
+eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#
+\end{verbatim}
+
+It may seem a bit surprising that @makeStablePtr#@ is a @IO@
+operation since it doesn't (directly) involve IO operations.  The
+reason is that if some optimisation pass decided to duplicate calls to
+@makeStablePtr#@ and we only pass one of the stable pointers over, a
+massive space leak can result.  Putting it into the IO monad
+prevents this.  (Another reason for putting them in a monad is to
+ensure correct sequencing wrt the side-effecting @freeStablePtr@
+operation.)
+
+An important property of stable pointers is that if you call
+makeStablePtr# twice on the same object you get the same stable
+pointer back.
+
+Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
+besides, it's not likely to be used from Haskell) so it's not a
+primop.
+
+Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
+
+Stable Names
+~~~~~~~~~~~~
+
+A stable name is like a stable pointer, but with three important differences:
+
+        (a) You can't deRef one to get back to the original object.
+        (b) You can convert one to an Int.
+        (c) You don't need to 'freeStableName'
+
+The existence of a stable name doesn't guarantee to keep the object it
+points to alive (unlike a stable pointer), hence (a).
+
+Invariants:
+
+        (a) makeStableName always returns the same value for a given
+            object (same as stable pointers).
+
+        (b) if two stable names are equal, it implies that the objects
+            from which they were created were the same.
+
+        (c) stableNameToInt always returns the same Int for a given
+            stable name.
+
+
+These primops are pretty weird.
+
+        tagToEnum# :: Int -> a    (result type must be an enumerated type)
+
+The constraints aren't currently checked by the front end, but the
+code generator will fall over if they aren't satisfied.
+
+************************************************************************
+*                                                                      *
+            Which PrimOps are out-of-line
+*                                                                      *
+************************************************************************
+
+Some PrimOps need to be called out-of-line because they either need to
+perform a heap check or they block.
+-}
+
+primOpOutOfLine :: PrimOp -> Bool
+#include "primop-out-of-line.hs-incl"
+
+{-
+************************************************************************
+*                                                                      *
+            Failure and side effects
+*                                                                      *
+************************************************************************
+
+Note [Checking versus non-checking primops]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  In GHC primops break down into two classes:
+
+   a. Checking primops behave, for instance, like division. In this
+      case the primop may throw an exception (e.g. division-by-zero)
+      and is consequently is marked with the can_fail flag described below.
+      The ability to fail comes at the expense of precluding some optimizations.
+
+   b. Non-checking primops behavior, for instance, like addition. While
+      addition can overflow it does not produce an exception. So can_fail is
+      set to False, and we get more optimisation opportunities.  But we must
+      never throw an exception, so we cannot rewrite to a call to error.
+
+  It is important that a non-checking primop never be transformed in a way that
+  would cause it to bottom. Doing so would violate Core's let/app invariant
+  (see Note [Core let/app invariant] in GHC.Core) which is critical to
+  the simplifier's ability to float without fear of changing program meaning.
+
+
+Note [PrimOp can_fail and has_side_effects]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Both can_fail and has_side_effects mean that the primop has
+some effect that is not captured entirely by its result value.
+
+----------  has_side_effects ---------------------
+A primop "has_side_effects" if it has some *write* effect, visible
+elsewhere
+    - writing to the world (I/O)
+    - writing to a mutable data structure (writeIORef)
+    - throwing a synchronous Haskell exception
+
+Often such primops have a type like
+   State -> input -> (State, output)
+so the state token guarantees ordering.  In general we rely *only* on
+data dependencies of the state token to enforce write-effect ordering
+
+ * NB1: if you inline unsafePerformIO, you may end up with
+   side-effecting ops whose 'state' output is discarded.
+   And programmers may do that by hand; see #9390.
+   That is why we (conservatively) do not discard write-effecting
+   primops even if both their state and result is discarded.
+
+ * NB2: We consider primops, such as raiseIO#, that can raise a
+   (Haskell) synchronous exception to "have_side_effects" but not
+   "can_fail".  We must be careful about not discarding such things;
+   see the paper "A semantics for imprecise exceptions".
+
+ * NB3: *Read* effects (like reading an IORef) don't count here,
+   because it doesn't matter if we don't do them, or do them more than
+   once.  *Sequencing* is maintained by the data dependency of the state
+   token.
+
+----------  can_fail ----------------------------
+A primop "can_fail" if it can fail with an *unchecked* exception on
+some elements of its input domain. Main examples:
+   division (fails on zero denominator)
+   array indexing (fails if the index is out of bounds)
+
+An "unchecked exception" is one that is an outright error, (not
+turned into a Haskell exception,) such as seg-fault or
+divide-by-zero error.  Such can_fail primops are ALWAYS surrounded
+with a test that checks for the bad cases, but we need to be
+very careful about code motion that might move it out of
+the scope of the test.
+
+Note [Transformations affected by can_fail and has_side_effects]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The can_fail and has_side_effects properties have the following effect
+on program transformations.  Summary table is followed by details.
+
+            can_fail     has_side_effects
+Discard        YES           NO
+Float in       YES           YES
+Float out      NO            NO
+Duplicate      YES           NO
+
+* Discarding.   case (a `op` b) of _ -> rhs  ===>   rhs
+  You should not discard a has_side_effects primop; e.g.
+     case (writeIntArray# a i v s of (# _, _ #) -> True
+  Arguably you should be able to discard this, since the
+  returned stat token is not used, but that relies on NEVER
+  inlining unsafePerformIO, and programmers sometimes write
+  this kind of stuff by hand (#9390).  So we (conservatively)
+  never discard a has_side_effects primop.
+
+  However, it's fine to discard a can_fail primop.  For example
+     case (indexIntArray# a i) of _ -> True
+  We can discard indexIntArray#; it has can_fail, but not
+  has_side_effects; see #5658 which was all about this.
+  Notice that indexIntArray# is (in a more general handling of
+  effects) read effect, but we don't care about that here, and
+  treat read effects as *not* has_side_effects.
+
+  Similarly (a `/#` b) can be discarded.  It can seg-fault or
+  cause a hardware exception, but not a synchronous Haskell
+  exception.
+
+
+
+  Synchronous Haskell exceptions, e.g. from raiseIO#, are treated
+  as has_side_effects and hence are not discarded.
+
+* Float in.  You can float a can_fail or has_side_effects primop
+  *inwards*, but not inside a lambda (see Duplication below).
+
+* Float out.  You must not float a can_fail primop *outwards* lest
+  you escape the dynamic scope of the test.  Example:
+      case d ># 0# of
+        True  -> case x /# d of r -> r +# 1
+        False -> 0
+  Here we must not float the case outwards to give
+      case x/# d of r ->
+      case d ># 0# of
+        True  -> r +# 1
+        False -> 0
+
+  Nor can you float out a has_side_effects primop.  For example:
+       if blah then case writeMutVar# v True s0 of (# s1 #) -> s1
+               else s0
+  Notice that s0 is mentioned in both branches of the 'if', but
+  only one of these two will actually be consumed.  But if we
+  float out to
+      case writeMutVar# v True s0 of (# s1 #) ->
+      if blah then s1 else s0
+  the writeMutVar will be performed in both branches, which is
+  utterly wrong.
+
+* Duplication.  You cannot duplicate a has_side_effect primop.  You
+  might wonder how this can occur given the state token threading, but
+  just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get
+  something like this
+        p = case readMutVar# s v of
+              (# s', r #) -> (S# s', r)
+        s' = case p of (s', r) -> s'
+        r  = case p of (s', r) -> r
+
+  (All these bindings are boxed.)  If we inline p at its two call
+  sites, we get a catastrophe: because the read is performed once when
+  s' is demanded, and once when 'r' is demanded, which may be much
+  later.  Utterly wrong.  #3207 is real example of this happening.
+
+  However, it's fine to duplicate a can_fail primop.  That is really
+  the only difference between can_fail and has_side_effects.
+
+Note [Implementation: how can_fail/has_side_effects affect transformations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+How do we ensure that that floating/duplication/discarding are done right
+in the simplifier?
+
+Two main predicates on primpops test these flags:
+  primOpOkForSideEffects <=> not has_side_effects
+  primOpOkForSpeculation <=> not (has_side_effects || can_fail)
+
+  * The "no-float-out" thing is achieved by ensuring that we never
+    let-bind a can_fail or has_side_effects primop.  The RHS of a
+    let-binding (which can float in and out freely) satisfies
+    exprOkForSpeculation; this is the let/app invariant.  And
+    exprOkForSpeculation is false of can_fail and has_side_effects.
+
+  * So can_fail and has_side_effects primops will appear only as the
+    scrutinees of cases, and that's why the FloatIn pass is capable
+    of floating case bindings inwards.
+
+  * The no-duplicate thing is done via primOpIsCheap, by making
+    has_side_effects things (very very very) not-cheap!
+-}
+
+primOpHasSideEffects :: PrimOp -> Bool
+#include "primop-has-side-effects.hs-incl"
+
+primOpCanFail :: PrimOp -> Bool
+#include "primop-can-fail.hs-incl"
+
+primOpOkForSpeculation :: PrimOp -> Bool
+  -- See Note [PrimOp can_fail and has_side_effects]
+  -- See comments with GHC.Core.Utils.exprOkForSpeculation
+  -- primOpOkForSpeculation => primOpOkForSideEffects
+primOpOkForSpeculation op
+  =  primOpOkForSideEffects op
+  && not (primOpOutOfLine op || primOpCanFail op)
+    -- I think the "out of line" test is because out of line things can
+    -- be expensive (eg sine, cosine), and so we may not want to speculate them
+
+primOpOkForSideEffects :: PrimOp -> Bool
+primOpOkForSideEffects op
+  = not (primOpHasSideEffects op)
+
+{-
+Note [primOpIsCheap]
+~~~~~~~~~~~~~~~~~~~~
+
+@primOpIsCheap@, as used in GHC.Core.Opt.Simplify.Utils.  For now (HACK
+WARNING), we just borrow some other predicates for a
+what-should-be-good-enough test.  "Cheap" means willing to call it more
+than once, and/or push it inside a lambda.  The latter could change the
+behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
+-}
+
+primOpIsCheap :: PrimOp -> Bool
+-- See Note [PrimOp can_fail and has_side_effects]
+primOpIsCheap op = primOpOkForSpeculation op
+-- In March 2001, we changed this to
+--      primOpIsCheap op = False
+-- thereby making *no* primops seem cheap.  But this killed eta
+-- expansion on case (x ==# y) of True -> \s -> ...
+-- which is bad.  In particular a loop like
+--      doLoop n = loop 0
+--     where
+--         loop i | i == n    = return ()
+--                | otherwise = bar i >> loop (i+1)
+-- allocated a closure every time round because it doesn't eta expand.
+--
+-- The problem that originally gave rise to the change was
+--      let x = a +# b *# c in x +# x
+-- were we don't want to inline x. But primopIsCheap doesn't control
+-- that (it's exprIsDupable that does) so the problem doesn't occur
+-- even if primOpIsCheap sometimes says 'True'.
+
+{-
+************************************************************************
+*                                                                      *
+               PrimOp code size
+*                                                                      *
+************************************************************************
+
+primOpCodeSize
+~~~~~~~~~~~~~~
+Gives an indication of the code size of a primop, for the purposes of
+calculating unfolding sizes; see GHC.Core.Unfold.sizeExpr.
+-}
+
+primOpCodeSize :: PrimOp -> Int
+#include "primop-code-size.hs-incl"
+
+primOpCodeSizeDefault :: Int
+primOpCodeSizeDefault = 1
+  -- GHC.Core.Unfold.primOpSize already takes into account primOpOutOfLine
+  -- and adds some further costs for the args in that case.
+
+primOpCodeSizeForeignCall :: Int
+primOpCodeSizeForeignCall = 4
+
+{-
+************************************************************************
+*                                                                      *
+               PrimOp types
+*                                                                      *
+************************************************************************
+-}
+
+primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead
+primOpType op
+  = case primOpInfo op of
+    Dyadic  _occ ty -> dyadic_fun_ty ty
+    Monadic _occ ty -> monadic_fun_ty ty
+    Compare _occ ty -> compare_fun_ty ty
+
+    GenPrimOp _occ tyvars arg_tys res_ty ->
+        mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)
+
+primOpOcc :: PrimOp -> OccName
+primOpOcc op = case primOpInfo op of
+               Dyadic    occ _     -> occ
+               Monadic   occ _     -> occ
+               Compare   occ _     -> occ
+               GenPrimOp occ _ _ _ -> occ
+
+{- Note [Primop wrappers]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Previously hasNoBinding would claim that PrimOpIds didn't have a curried
+function definition. This caused quite some trouble as we would be forced to
+eta expand unsaturated primop applications very late in the Core pipeline. Not
+only would this produce unnecessary thunks, but it would also result in nasty
+inconsistencies in CAFfy-ness determinations (see #16846 and
+Note [CAFfyness inconsistencies due to late eta expansion] in GHC.Iface.Tidy).
+
+However, it was quite unnecessary for hasNoBinding to claim this; primops in
+fact *do* have curried definitions which are found in GHC.PrimopWrappers, which
+is auto-generated by utils/genprimops from prelude/primops.txt.pp. These wrappers
+are standard Haskell functions mirroring the types of the primops they wrap.
+For instance, in the case of plusInt# we would have:
+
+    module GHC.PrimopWrappers where
+    import GHC.Prim as P
+    plusInt# a b = P.plusInt# a b
+
+We now take advantage of these curried definitions by letting hasNoBinding
+claim that PrimOpIds have a curried definition and then rewrite any unsaturated
+PrimOpId applications that we find during CoreToStg as applications of the
+associated wrapper (e.g. `GHC.Prim.plusInt# 3#` will get rewritten to
+`GHC.PrimopWrappers.plusInt# 3#`).` The Id of the wrapper for a primop can be
+found using 'PrimOp.primOpWrapperId'.
+
+Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
+used by GHCi, which does not implement primops direct at all.
+
+-}
+
+-- | Returns the 'Id' of the wrapper associated with the given 'PrimOp'.
+-- See Note [Primop wrappers].
+primOpWrapperId :: PrimOp -> Id
+primOpWrapperId op = mkVanillaGlobalWithInfo name ty info
+  where
+    info = setCafInfo vanillaIdInfo NoCafRefs
+    name = mkExternalName uniq gHC_PRIMOPWRAPPERS (primOpOcc op) wiredInSrcSpan
+    uniq = mkPrimOpWrapperUnique (primOpTag op)
+    ty   = primOpType op
+
+isComparisonPrimOp :: PrimOp -> Bool
+isComparisonPrimOp op = case primOpInfo op of
+                          Compare {} -> True
+                          _          -> False
+
+-- primOpSig is like primOpType but gives the result split apart:
+-- (type variables, argument types, result type)
+-- It also gives arity, strictness info
+
+primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
+primOpSig op
+  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
+  where
+    arity = length arg_tys
+    (tyvars, arg_tys, res_ty)
+      = case (primOpInfo op) of
+        Monadic   _occ ty                    -> ([],     [ty],    ty       )
+        Dyadic    _occ ty                    -> ([],     [ty,ty], ty       )
+        Compare   _occ ty                    -> ([],     [ty,ty], intPrimTy)
+        GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty   )
+
+data PrimOpResultInfo
+  = ReturnsPrim     PrimRep
+  | ReturnsAlg      TyCon
+
+-- Some PrimOps need not return a manifest primitive or algebraic value
+-- (i.e. they might return a polymorphic value).  These PrimOps *must*
+-- be out of line, or the code generator won't work.
+
+getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
+getPrimOpResultInfo op
+  = case (primOpInfo op) of
+      Dyadic  _ ty                        -> ReturnsPrim (typePrimRep1 ty)
+      Monadic _ ty                        -> ReturnsPrim (typePrimRep1 ty)
+      Compare _ _                         -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)
+      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)
+                         | otherwise      -> ReturnsAlg tc
+                         where
+                           tc = tyConAppTyCon ty
+                        -- All primops return a tycon-app result
+                        -- The tycon can be an unboxed tuple or sum, though,
+                        -- which gives rise to a ReturnAlg
+
+{-
+We do not currently make use of whether primops are commutable.
+
+We used to try to move constants to the right hand side for strength
+reduction.
+-}
+
+{-
+commutableOp :: PrimOp -> Bool
+#include "primop-commutable.hs-incl"
+-}
+
+-- Utils:
+
+dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
+dyadic_fun_ty  ty = mkVisFunTys [ty, ty] ty
+monadic_fun_ty ty = mkVisFunTy  ty ty
+compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy
+
+-- Output stuff:
+
+pprPrimOp  :: PrimOp -> SDoc
+pprPrimOp other_op = pprOccName (primOpOcc other_op)
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[PrimCall]{User-imported primitive calls}
+*                                                                      *
+************************************************************************
+-}
+
+data PrimCall = PrimCall CLabelString UnitId
+
+instance Outputable PrimCall where
+  ppr (PrimCall lbl pkgId)
+        = text "__primcall" <+> ppr pkgId <+> ppr lbl
diff --git a/compiler/GHC/Builtin/PrimOps.hs-boot b/compiler/GHC/Builtin/PrimOps.hs-boot
new file mode 100644
index 0000000000..e9f913f602
--- /dev/null
+++ b/compiler/GHC/Builtin/PrimOps.hs-boot
@@ -0,0 +1,5 @@
+module GHC.Builtin.PrimOps where
+
+import GhcPrelude ()
+
+data PrimOp
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
new file mode 100644
index 0000000000..2e4ba28b6a
--- /dev/null
+++ b/compiler/GHC/Builtin/Types.hs
@@ -0,0 +1,1690 @@
+{-
+(c) The GRASP Project, Glasgow University, 1994-1998
+
+Wired-in knowledge about {\em non-primitive} types
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- | This module is about types that can be defined in Haskell, but which
+--   must be wired into the compiler nonetheless.  C.f module GHC.Builtin.Types.Prim
+module GHC.Builtin.Types (
+        -- * Helper functions defined here
+        mkWiredInTyConName, -- This is used in GHC.Builtin.Types.Literals to define the
+                            -- built-in functions for evaluation.
+
+        mkWiredInIdName,    -- used in GHC.Types.Id.Make
+
+        -- * All wired in things
+        wiredInTyCons, isBuiltInOcc_maybe,
+
+        -- * Bool
+        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
+        trueDataCon,  trueDataConId,  true_RDR,
+        falseDataCon, falseDataConId, false_RDR,
+        promotedFalseDataCon, promotedTrueDataCon,
+
+        -- * Ordering
+        orderingTyCon,
+        ordLTDataCon, ordLTDataConId,
+        ordEQDataCon, ordEQDataConId,
+        ordGTDataCon, ordGTDataConId,
+        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
+
+        -- * Boxing primitive types
+        boxingDataCon_maybe,
+
+        -- * Char
+        charTyCon, charDataCon, charTyCon_RDR,
+        charTy, stringTy, charTyConName,
+
+        -- * Double
+        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
+
+        -- * Float
+        floatTyCon, floatDataCon, floatTy, floatTyConName,
+
+        -- * Int
+        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
+        intTy,
+
+        -- * Word
+        wordTyCon, wordDataCon, wordTyConName, wordTy,
+
+        -- * Word8
+        word8TyCon, word8DataCon, word8TyConName, word8Ty,
+
+        -- * List
+        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
+        nilDataCon, nilDataConName, nilDataConKey,
+        consDataCon_RDR, consDataCon, consDataConName,
+        promotedNilDataCon, promotedConsDataCon,
+        mkListTy, mkPromotedListTy,
+
+        -- * Maybe
+        maybeTyCon, maybeTyConName,
+        nothingDataCon, nothingDataConName, promotedNothingDataCon,
+        justDataCon, justDataConName, promotedJustDataCon,
+
+        -- * Tuples
+        mkTupleTy, mkTupleTy1, mkBoxedTupleTy, mkTupleStr,
+        tupleTyCon, tupleDataCon, tupleTyConName,
+        promotedTupleDataCon,
+        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
+        pairTyCon,
+        unboxedUnitTyCon, unboxedUnitDataCon,
+        unboxedTupleKind, unboxedSumKind,
+
+        -- ** Constraint tuples
+        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
+        cTupleTyConNameArity_maybe,
+        cTupleDataConName, cTupleDataConNames,
+
+        -- * Any
+        anyTyCon, anyTy, anyTypeOfKind,
+
+        -- * Recovery TyCon
+        makeRecoveryTyCon,
+
+        -- * Sums
+        mkSumTy, sumTyCon, sumDataCon,
+
+        -- * Kinds
+        typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
+        isLiftedTypeKindTyConName, liftedTypeKind,
+        typeToTypeKind, constraintKind,
+        liftedTypeKindTyCon, constraintKindTyCon,  constraintKindTyConName,
+        liftedTypeKindTyConName,
+
+        -- * Equality predicates
+        heqTyCon, heqTyConName, heqClass, heqDataCon,
+        eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,
+        coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
+
+        -- * RuntimeRep and friends
+        runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
+
+        runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,
+
+        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,
+
+        liftedRepDataConTy, unliftedRepDataConTy,
+        intRepDataConTy,
+        int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
+        wordRepDataConTy,
+        word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
+        addrRepDataConTy,
+        floatRepDataConTy, doubleRepDataConTy,
+
+        vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+        vec64DataConTy,
+
+        int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+        int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+        word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+        doubleElemRepDataConTy
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId )
+
+-- friends:
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim
+import {-# SOURCE #-} GHC.Builtin.Uniques
+
+-- others:
+import GHC.Core.Coercion.Axiom
+import GHC.Types.Id
+import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
+import GHC.Types.Module ( Module )
+import GHC.Core.Type
+import GHC.Types.RepType
+import GHC.Core.DataCon
+import {-# SOURCE #-} GHC.Core.ConLike
+import GHC.Core.TyCon
+import GHC.Core.Class     ( Class, mkClass )
+import GHC.Types.Name.Reader
+import GHC.Types.Name as Name
+import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )
+import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet )
+import GHC.Types.Basic
+import GHC.Types.ForeignCall
+import GHC.Types.SrcLoc   ( noSrcSpan )
+import GHC.Types.Unique
+import Data.Array
+import FastString
+import Outputable
+import Util
+import BooleanFormula   ( mkAnd )
+
+import qualified Data.ByteString.Char8 as BS
+
+import Data.List        ( elemIndex )
+
+alpha_tyvar :: [TyVar]
+alpha_tyvar = [alphaTyVar]
+
+alpha_ty :: [Type]
+alpha_ty = [alphaTy]
+
+{-
+Note [Wiring in RuntimeRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,
+making it a pain to wire in. To ease the pain somewhat, we use lists of
+the different bits, like Uniques, Names, DataCons. These lists must be
+kept in sync with each other. The rule is this: use the order as declared
+in GHC.Types. All places where such lists exist should contain a reference
+to this Note, so a search for this Note's name should find all the lists.
+
+See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType.
+
+************************************************************************
+*                                                                      *
+\subsection{Wired in type constructors}
+*                                                                      *
+************************************************************************
+
+If you change which things are wired in, make sure you change their
+names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc
+-}
+
+-- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn
+-- is used to initialise the name environment carried around by the renamer.
+-- This means that if we look up the name of a TyCon (or its implicit binders)
+-- that occurs in this list that name will be assigned the wired-in key we
+-- define here.
+--
+-- Because of their infinite nature, this list excludes tuples, Any and implicit
+-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
+--
+-- See also Note [Known-key names]
+wiredInTyCons :: [TyCon]
+
+wiredInTyCons = [ -- Units are not treated like other tuples, because they
+                  -- are defined in GHC.Base, and there's only a few of them. We
+                  -- put them in wiredInTyCons so that they will pre-populate
+                  -- the name cache, so the parser in isBuiltInOcc_maybe doesn't
+                  -- need to look out for them.
+                  unitTyCon
+                , unboxedUnitTyCon
+                , anyTyCon
+                , boolTyCon
+                , charTyCon
+                , doubleTyCon
+                , floatTyCon
+                , intTyCon
+                , wordTyCon
+                , word8TyCon
+                , listTyCon
+                , maybeTyCon
+                , heqTyCon
+                , eqTyCon
+                , coercibleTyCon
+                , typeNatKindCon
+                , typeSymbolKindCon
+                , runtimeRepTyCon
+                , vecCountTyCon
+                , vecElemTyCon
+                , constraintKindTyCon
+                , liftedTypeKindTyCon
+                ]
+
+mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
+mkWiredInTyConName built_in modu fs unique tycon
+  = mkWiredInName modu (mkTcOccFS fs) unique
+                  (ATyCon tycon)        -- Relevant TyCon
+                  built_in
+
+mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
+mkWiredInDataConName built_in modu fs unique datacon
+  = mkWiredInName modu (mkDataOccFS fs) unique
+                  (AConLike (RealDataCon datacon))    -- Relevant DataCon
+                  built_in
+
+mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
+mkWiredInIdName mod fs uniq id
+ = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax
+
+-- See Note [Kind-changing of (~) and Coercible]
+-- in libraries/ghc-prim/GHC/Types.hs
+eqTyConName, eqDataConName, eqSCSelIdName :: Name
+eqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "~")   eqTyConKey   eqTyCon
+eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon
+eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId
+
+{- Note [eqTyCon (~) is built-in syntax]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The (~) type operator used in equality constraints (a~b) is considered built-in
+syntax. This has a few consequences:
+
+* The user is not allowed to define their own type constructors with this name:
+
+    ghci> class a ~ b
+    <interactive>:1:1: error: Illegal binding of built-in syntax: ~
+
+* Writing (a ~ b) does not require enabling -XTypeOperators. It does, however,
+  require -XGADTs or -XTypeFamilies.
+
+* The (~) type operator is always in scope. It doesn't need to be be imported,
+  and it cannot be hidden.
+
+* We have a bunch of special cases in the compiler to arrange all of the above.
+
+There's no particular reason for (~) to be special, but fixing this would be a
+breaking change.
+-}
+eqTyCon_RDR :: RdrName
+eqTyCon_RDR = nameRdrName eqTyConName
+
+-- See Note [Kind-changing of (~) and Coercible]
+-- in libraries/ghc-prim/GHC/Types.hs
+heqTyConName, heqDataConName, heqSCSelIdName :: Name
+heqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "~~")   heqTyConKey      heqTyCon
+heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "HEq#") heqDataConKey heqDataCon
+heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId
+
+-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs
+coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
+coercibleTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Coercible")  coercibleTyConKey   coercibleTyCon
+coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
+coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId
+
+charTyConName, charDataConName, intTyConName, intDataConName :: Name
+charTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
+charDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
+intTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int") intTyConKey   intTyCon
+intDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey  intDataCon
+
+boolTyConName, falseDataConName, trueDataConName :: Name
+boolTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
+falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon
+trueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon
+
+listTyConName, nilDataConName, consDataConName :: Name
+listTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
+nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
+consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
+
+maybeTyConName, nothingDataConName, justDataConName :: Name
+maybeTyConName     = mkWiredInTyConName   UserSyntax gHC_MAYBE (fsLit "Maybe")
+                                          maybeTyConKey maybeTyCon
+nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
+                                          nothingDataConKey nothingDataCon
+justDataConName    = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
+                                          justDataConKey justDataCon
+
+wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
+wordTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Word")   wordTyConKey     wordTyCon
+wordDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#")     wordDataConKey   wordDataCon
+word8TyConName     = mkWiredInTyConName   UserSyntax gHC_WORD  (fsLit "Word8")  word8TyConKey    word8TyCon
+word8DataConName   = mkWiredInDataConName UserSyntax gHC_WORD  (fsLit "W8#")    word8DataConKey  word8DataCon
+
+floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
+floatTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Float")  floatTyConKey    floatTyCon
+floatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#")     floatDataConKey  floatDataCon
+doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey   doubleTyCon
+doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")     doubleDataConKey doubleDataCon
+
+-- Any
+
+{-
+Note [Any types]
+~~~~~~~~~~~~~~~~
+The type constructor Any,
+
+    type family Any :: k where { }
+
+It has these properties:
+
+  * Note that 'Any' is kind polymorphic since in some program we may
+    need to use Any to fill in a type variable of some kind other than *
+    (see #959 for examples).  Its kind is thus `forall k. k``.
+
+  * It is defined in module GHC.Types, and exported so that it is
+    available to users.  For this reason it's treated like any other
+    wired-in type:
+      - has a fixed unique, anyTyConKey,
+      - lives in the global name cache
+
+  * It is a *closed* type family, with no instances.  This means that
+    if   ty :: '(k1, k2)  we add a given coercion
+             g :: ty ~ (Fst ty, Snd ty)
+    If Any was a *data* type, then we'd get inconsistency because 'ty'
+    could be (Any '(k1,k2)) and then we'd have an equality with Any on
+    one side and '(,) on the other. See also #9097 and #9636.
+
+  * When instantiated at a lifted type it is inhabited by at least one value,
+    namely bottom
+
+  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.
+
+  * It does not claim to be a *data* type, and that's important for
+    the code generator, because the code gen may *enter* a data value
+    but never enters a function value.
+
+  * It is wired-in so we can easily refer to it where we don't have a name
+    environment (e.g. see Rules.matchRule for one example)
+
+  * If (Any k) is the type of a value, it must be a /lifted/ value. So
+    if we have (Any @(TYPE rr)) then rr must be 'LiftedRep.  See
+    Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.  This is a convenient
+    invariant, and makes isUnliftedTyCon well-defined; otherwise what
+    would (isUnliftedTyCon Any) be?
+
+It's used to instantiate un-constrained type variables after type checking. For
+example, 'length' has type
+
+  length :: forall a. [a] -> Int
+
+and the list datacon for the empty list has type
+
+  [] :: forall a. [a]
+
+In order to compose these two terms as @length []@ a type
+application is required, but there is no constraint on the
+choice.  In this situation GHC uses 'Any',
+
+> length (Any *) ([] (Any *))
+
+Above, we print kinds explicitly, as if with --fprint-explicit-kinds.
+
+The Any tycon used to be quite magic, but we have since been able to
+implement it merely with an empty kind polymorphic type family. See #10886 for a
+bit of history.
+-}
+
+
+anyTyConName :: Name
+anyTyConName =
+    mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon
+
+anyTyCon :: TyCon
+anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing
+                         (ClosedSynFamilyTyCon Nothing)
+                         Nothing
+                         NotInjective
+  where
+    binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind]
+    res_kind = mkTyVarTy (binderVar kv)
+
+anyTy :: Type
+anyTy = mkTyConTy anyTyCon
+
+anyTypeOfKind :: Kind -> Type
+anyTypeOfKind kind = mkTyConApp anyTyCon [kind]
+
+-- | Make a fake, recovery 'TyCon' from an existing one.
+-- Used when recovering from errors in type declarations
+makeRecoveryTyCon :: TyCon -> TyCon
+makeRecoveryTyCon tc
+  = mkTcTyCon (tyConName tc)
+              bndrs res_kind
+              noTcTyConScopedTyVars
+              True             -- Fully generalised
+              flavour          -- Keep old flavour
+  where
+    flavour = tyConFlavour tc
+    [kv] = mkTemplateKindVars [liftedTypeKind]
+    (bndrs, res_kind)
+       = case flavour of
+           PromotedDataConFlavour -> ([mkNamedTyConBinder Inferred kv], mkTyVarTy kv)
+           _ -> (tyConBinders tc, tyConResKind tc)
+        -- For data types we have already validated their kind, so it
+        -- makes sense to keep it. For promoted data constructors we haven't,
+        -- so we recover with kind (forall k. k).  Otherwise consider
+        --     data T a where { MkT :: Show a => T a }
+        -- If T is for some reason invalid, we don't want to fall over
+        -- at (promoted) use-sites of MkT.
+
+-- Kinds
+typeNatKindConName, typeSymbolKindConName :: Name
+typeNatKindConName    = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat")    typeNatKindConNameKey    typeNatKindCon
+typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
+
+constraintKindTyConName :: Name
+constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey   constraintKindTyCon
+
+liftedTypeKindTyConName :: Name
+liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
+
+runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
+runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
+vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
+tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep") tupleRepDataConKey tupleRepDataCon
+sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon
+
+-- See Note [Wiring in RuntimeRep]
+runtimeRepSimpleDataConNames :: [Name]
+runtimeRepSimpleDataConNames
+  = zipWith3Lazy mk_special_dc_name
+      [ fsLit "LiftedRep", fsLit "UnliftedRep"
+      , fsLit "IntRep"
+      , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep"
+      , fsLit "WordRep"
+      , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep"
+      , fsLit "AddrRep"
+      , fsLit "FloatRep", fsLit "DoubleRep"
+      ]
+      runtimeRepSimpleDataConKeys
+      runtimeRepSimpleDataCons
+
+vecCountTyConName :: Name
+vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon
+
+-- See Note [Wiring in RuntimeRep]
+vecCountDataConNames :: [Name]
+vecCountDataConNames = zipWith3Lazy mk_special_dc_name
+                         [ fsLit "Vec2", fsLit "Vec4", fsLit "Vec8"
+                         , fsLit "Vec16", fsLit "Vec32", fsLit "Vec64" ]
+                         vecCountDataConKeys
+                         vecCountDataCons
+
+vecElemTyConName :: Name
+vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon
+
+-- See Note [Wiring in RuntimeRep]
+vecElemDataConNames :: [Name]
+vecElemDataConNames = zipWith3Lazy mk_special_dc_name
+                        [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep"
+                        , fsLit "Int64ElemRep", fsLit "Word8ElemRep", fsLit "Word16ElemRep"
+                        , fsLit "Word32ElemRep", fsLit "Word64ElemRep"
+                        , fsLit "FloatElemRep", fsLit "DoubleElemRep" ]
+                        vecElemDataConKeys
+                        vecElemDataCons
+
+mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
+mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
+
+boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
+boolTyCon_RDR   = nameRdrName boolTyConName
+false_RDR       = nameRdrName falseDataConName
+true_RDR        = nameRdrName trueDataConName
+intTyCon_RDR    = nameRdrName intTyConName
+charTyCon_RDR   = nameRdrName charTyConName
+intDataCon_RDR  = nameRdrName intDataConName
+listTyCon_RDR   = nameRdrName listTyConName
+consDataCon_RDR = nameRdrName consDataConName
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{mkWiredInTyCon}
+*                                                                      *
+************************************************************************
+-}
+
+-- This function assumes that the types it creates have all parameters at
+-- Representational role, and that there is no kind polymorphism.
+pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
+pcTyCon name cType tyvars cons
+  = mkAlgTyCon name
+                (mkAnonTyConBinders VisArg tyvars)
+                liftedTypeKind
+                (map (const Representational) tyvars)
+                cType
+                []              -- No stupid theta
+                (mkDataTyConRhs cons)
+                (VanillaAlgTyCon (mkPrelTyConRepName name))
+                False           -- Not in GADT syntax
+
+pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
+pcDataCon n univs = pcDataConWithFixity False n univs
+                      []    -- no ex_tvs
+                      univs -- the univs are precisely the user-written tyvars
+
+pcDataConWithFixity :: Bool      -- ^ declared infix?
+                    -> Name      -- ^ datacon name
+                    -> [TyVar]   -- ^ univ tyvars
+                    -> [TyCoVar] -- ^ ex tycovars
+                    -> [TyCoVar] -- ^ user-written tycovars
+                    -> [Type]    -- ^ args
+                    -> TyCon
+                    -> DataCon
+pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))
+                                                  NoRRI
+-- The Name's unique is the first of two free uniques;
+-- the first is used for the datacon itself,
+-- the second is used for the "worker name"
+--
+-- To support this the mkPreludeDataConUnique function "allocates"
+-- one DataCon unique per pair of Ints.
+
+pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
+                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]
+                     -> [Type] -> TyCon -> DataCon
+-- The Name should be in the DataName name space; it's the name
+-- of the DataCon itself.
+--
+-- IMPORTANT NOTE:
+--    if you try to wire-in a /GADT/ data constructor you will
+--    find it hard (we did).  You will need wrapper and worker
+--    Names, a DataConBoxer, DataConRep, EqSpec, etc.
+--    Try hard not to wire-in GADT data types. You will live
+--    to regret doing so (we do).
+
+pcDataConWithFixity' declared_infix dc_name wrk_key rri
+                     tyvars ex_tyvars user_tyvars arg_tys tycon
+  = data_con
+  where
+    tag_map = mkTyConTagMap tycon
+    -- This constructs the constructor Name to ConTag map once per
+    -- constructor, which is quadratic. It's OK here, because it's
+    -- only called for wired in data types that don't have a lot of
+    -- constructors. It's also likely that GHC will lift tag_map, since
+    -- we call pcDataConWithFixity' with static TyCons in the same module.
+    -- See Note [Constructor tag allocation] and #14657
+    data_con = mkDataCon dc_name declared_infix prom_info
+                (map (const no_bang) arg_tys)
+                []      -- No labelled fields
+                tyvars ex_tyvars
+                (mkTyCoVarBinders Specified user_tyvars)
+                []      -- No equality spec
+                []      -- No theta
+                arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
+                rri
+                tycon
+                (lookupNameEnv_NF tag_map dc_name)
+                []      -- No stupid theta
+                (mkDataConWorkId wrk_name data_con)
+                NoDataConRep    -- Wired-in types are too simple to need wrappers
+
+    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict
+
+    wrk_name = mkDataConWorkerName data_con wrk_key
+
+    prom_info = mkPrelTyConRepName dc_name
+
+mkDataConWorkerName :: DataCon -> Unique -> Name
+mkDataConWorkerName data_con wrk_key =
+    mkWiredInName modu wrk_occ wrk_key
+                  (AnId (dataConWorkId data_con)) UserSyntax
+  where
+    modu     = ASSERT( isExternalName dc_name )
+               nameModule dc_name
+    dc_name = dataConName data_con
+    dc_occ  = nameOccName dc_name
+    wrk_occ = mkDataConWorkerOcc dc_occ
+
+-- used for RuntimeRep and friends
+pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
+pcSpecialDataCon dc_name arg_tys tycon rri
+  = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri
+                         [] [] [] arg_tys tycon
+
+{-
+************************************************************************
+*                                                                      *
+      Kinds
+*                                                                      *
+************************************************************************
+-}
+
+typeNatKindCon, typeSymbolKindCon :: TyCon
+-- data Nat
+-- data Symbol
+typeNatKindCon    = pcTyCon typeNatKindConName    Nothing [] []
+typeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] []
+
+typeNatKind, typeSymbolKind :: Kind
+typeNatKind    = mkTyConTy typeNatKindCon
+typeSymbolKind = mkTyConTy typeSymbolKindCon
+
+constraintKindTyCon :: TyCon
+-- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon!
+constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
+
+liftedTypeKind, typeToTypeKind, constraintKind :: Kind
+liftedTypeKind   = tYPE liftedRepTy
+typeToTypeKind   = liftedTypeKind `mkVisFunTy` liftedTypeKind
+constraintKind   = mkTyConApp constraintKindTyCon []
+
+{-
+************************************************************************
+*                                                                      *
+                Stuff for dealing with tuples
+*                                                                      *
+************************************************************************
+
+Note [How tuples work]  See also Note [Known-key names] in GHC.Builtin.Names
+~~~~~~~~~~~~~~~~~~~~~~
+* There are three families of tuple TyCons and corresponding
+  DataCons, expressed by the type BasicTypes.TupleSort:
+    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple
+
+* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon
+
+* BoxedTuples
+    - A wired-in type
+    - Data type declarations in GHC.Tuple
+    - The data constructors really have an info table
+
+* UnboxedTuples
+    - A wired-in type
+    - Have a pretend DataCon, defined in GHC.Prim,
+      but no actual declaration and no info table
+
+* ConstraintTuples
+    - Are known-key rather than wired-in. Reason: it's awkward to
+      have all the superclass selectors wired-in.
+    - Declared as classes in GHC.Classes, e.g.
+         class (c1,c2) => (c1,c2)
+    - Given constraints: the superclasses automatically become available
+    - Wanted constraints: there is a built-in instance
+         instance (c1,c2) => (c1,c2)
+      See GHC.Tc.Solver.Interact.matchCTuple
+    - Currently just go up to 62; beyond that
+      you have to use manual nesting
+    - Their OccNames look like (%,,,%), so they can easily be
+      distinguished from term tuples.  But (following Haskell) we
+      pretty-print saturated constraint tuples with round parens;
+      see BasicTypes.tupleParens.
+
+* In quite a lot of places things are restricted just to
+  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
+  E.g. tupleTyCon has a Boxity argument
+
+* When looking up an OccName in the original-name cache
+  (GHC.Iface.Env.lookupOrigNameCache), we spot the tuple OccName to make sure
+  we get the right wired-in name.  This guy can't tell the difference
+  between BoxedTuple and ConstraintTuple (same OccName!), so tuples
+  are not serialised into interface files using OccNames at all.
+
+* Serialization to interface files works via the usual mechanism for known-key
+  things: instead of serializing the OccName we just serialize the key. During
+  deserialization we lookup the Name associated with the unique with the logic
+  in GHC.Builtin.Uniques. See Note [Symbol table representation of names] for details.
+
+Note [One-tuples]
+~~~~~~~~~~~~~~~~~
+GHC supports both boxed and unboxed one-tuples:
+ - Unboxed one-tuples are sometimes useful when returning a
+   single value after CPR analysis
+ - A boxed one-tuple is used by GHC.HsToCore.Utils.mkSelectorBinds, when
+   there is just one binder
+Basically it keeps everything uniform.
+
+However the /naming/ of the type/data constructors for one-tuples is a
+bit odd:
+  3-tuples:  (,,)   (,,)#
+  2-tuples:  (,)    (,)#
+  1-tuples:  ??
+  0-tuples:  ()     ()#
+
+Zero-tuples have used up the logical name. So we use 'Unit' and 'Unit#'
+for one-tuples.  So in ghc-prim:GHC.Tuple we see the declarations:
+  data ()     = ()
+  data Unit a = Unit a
+  data (a,b)  = (a,b)
+
+There is no way to write a boxed one-tuple in Haskell, but it can be
+created in Template Haskell or in, e.g., `deriving` code. There is
+nothing special about one-tuples in Core; in particular, they have no
+custom pretty-printing, just using `Unit`.
+
+Note that there is *not* a unary constraint tuple, unlike for other forms of
+tuples. See [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType for more
+details.
+
+See also Note [Flattening one-tuples] in GHC.Core.Make and
+Note [Don't flatten tuples from HsSyn] in GHC.Core.Make.
+
+-}
+
+-- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names
+-- with BuiltInSyntax. However, this should only be necessary while resolving
+-- names produced by Template Haskell splices since we take care to encode
+-- built-in syntax names specially in interface files. See
+-- Note [Symbol table representation of names].
+--
+-- Moreover, there is no need to include names of things that the user can't
+-- write (e.g. type representation bindings like $tc(,,,)).
+isBuiltInOcc_maybe :: OccName -> Maybe Name
+isBuiltInOcc_maybe occ =
+    case name of
+      "[]" -> Just $ choose_ns listTyConName nilDataConName
+      ":"    -> Just consDataConName
+
+      -- equality tycon
+      "~"    -> Just eqTyConName
+
+      -- function tycon
+      "->"   -> Just funTyConName
+
+      -- boxed tuple data/tycon
+      "()"    -> Just $ tup_name Boxed 0
+      _ | Just rest <- "(" `BS.stripPrefix` name
+        , (commas, rest') <- BS.span (==',') rest
+        , ")" <- rest'
+             -> Just $ tup_name Boxed (1+BS.length commas)
+
+      -- unboxed tuple data/tycon
+      "(##)"  -> Just $ tup_name Unboxed 0
+      "Unit#" -> Just $ tup_name Unboxed 1
+      _ | Just rest <- "(#" `BS.stripPrefix` name
+        , (commas, rest') <- BS.span (==',') rest
+        , "#)" <- rest'
+             -> Just $ tup_name Unboxed (1+BS.length commas)
+
+      -- unboxed sum tycon
+      _ | Just rest <- "(#" `BS.stripPrefix` name
+        , (pipes, rest') <- BS.span (=='|') rest
+        , "#)" <- rest'
+             -> Just $ tyConName $ sumTyCon (1+BS.length pipes)
+
+      -- unboxed sum datacon
+      _ | Just rest <- "(#" `BS.stripPrefix` name
+        , (pipes1, rest') <- BS.span (=='|') rest
+        , Just rest'' <- "_" `BS.stripPrefix` rest'
+        , (pipes2, rest''') <- BS.span (=='|') rest''
+        , "#)" <- rest'''
+             -> let arity = BS.length pipes1 + BS.length pipes2 + 1
+                    alt = BS.length pipes1 + 1
+                in Just $ dataConName $ sumDataCon alt arity
+      _ -> Nothing
+  where
+    name = bytesFS $ occNameFS occ
+
+    choose_ns :: Name -> Name -> Name
+    choose_ns tc dc
+      | isTcClsNameSpace ns   = tc
+      | isDataConNameSpace ns = dc
+      | otherwise             = pprPanic "tup_name" (ppr occ)
+      where ns = occNameSpace occ
+
+    tup_name boxity arity
+      = choose_ns (getName (tupleTyCon   boxity arity))
+                  (getName (tupleDataCon boxity arity))
+
+mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
+-- No need to cache these, the caching is done in mk_tuple
+mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)
+mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar)
+
+mkCTupleOcc :: NameSpace -> Arity -> OccName
+mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)
+
+mkTupleStr :: Boxity -> Arity -> String
+mkTupleStr Boxed   = mkBoxedTupleStr
+mkTupleStr Unboxed = mkUnboxedTupleStr
+
+mkBoxedTupleStr :: Arity -> String
+mkBoxedTupleStr 0  = "()"
+mkBoxedTupleStr 1  = "Unit"   -- See Note [One-tuples]
+mkBoxedTupleStr ar = '(' : commas ar ++ ")"
+
+mkUnboxedTupleStr :: Arity -> String
+mkUnboxedTupleStr 0  = "(##)"
+mkUnboxedTupleStr 1  = "Unit#"  -- See Note [One-tuples]
+mkUnboxedTupleStr ar = "(#" ++ commas ar ++ "#)"
+
+mkConstraintTupleStr :: Arity -> String
+mkConstraintTupleStr 0  = "(%%)"
+mkConstraintTupleStr 1  = "Unit%"   -- See Note [One-tuples]
+mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"
+
+commas :: Arity -> String
+commas ar = take (ar-1) (repeat ',')
+
+cTupleTyConName :: Arity -> Name
+cTupleTyConName arity
+  = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
+                   (mkCTupleOcc tcName arity) noSrcSpan
+
+cTupleTyConNames :: [Name]
+cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
+
+cTupleTyConNameSet :: NameSet
+cTupleTyConNameSet = mkNameSet cTupleTyConNames
+
+isCTupleTyConName :: Name -> Bool
+-- Use Type.isCTupleClass where possible
+isCTupleTyConName n
+ = ASSERT2( isExternalName n, ppr n )
+   nameModule n == gHC_CLASSES
+   && n `elemNameSet` cTupleTyConNameSet
+
+-- | If the given name is that of a constraint tuple, return its arity.
+-- Note that this is inefficient.
+cTupleTyConNameArity_maybe :: Name -> Maybe Arity
+cTupleTyConNameArity_maybe n
+  | not (isCTupleTyConName n) = Nothing
+  | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames)
+  where
+    -- Since `cTupleTyConNames` jumps straight from the `0` to the `2`
+    -- case, we have to adjust accordingly our calculated arity.
+    adjustArity a = if a > 0 then a + 1 else a
+
+cTupleDataConName :: Arity -> Name
+cTupleDataConName arity
+  = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES
+                   (mkCTupleOcc dataName arity) noSrcSpan
+
+cTupleDataConNames :: [Name]
+cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])
+
+tupleTyCon :: Boxity -> Arity -> TyCon
+tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
+tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)
+tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
+
+tupleTyConName :: TupleSort -> Arity -> Name
+tupleTyConName ConstraintTuple a = cTupleTyConName a
+tupleTyConName BoxedTuple      a = tyConName (tupleTyCon Boxed a)
+tupleTyConName UnboxedTuple    a = tyConName (tupleTyCon Unboxed a)
+
+promotedTupleDataCon :: Boxity -> Arity -> TyCon
+promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
+
+tupleDataCon :: Boxity -> Arity -> DataCon
+tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially
+tupleDataCon Boxed   i = snd (boxedTupleArr   ! i)
+tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)
+
+boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
+boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mAX_TUPLE_SIZE]]
+unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
+
+-- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed
+-- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type
+-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep
+-- [IntRep, LiftedRep])@
+unboxedTupleSumKind :: TyCon -> [Type] -> Kind
+unboxedTupleSumKind tc rr_tys
+  = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys])
+
+-- | Specialization of 'unboxedTupleSumKind' for tuples
+unboxedTupleKind :: [Type] -> Kind
+unboxedTupleKind = unboxedTupleSumKind tupleRepDataConTyCon
+
+mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
+mk_tuple Boxed arity = (tycon, tuple_con)
+  where
+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
+                         BoxedTuple flavour
+
+    tc_binders  = mkTemplateAnonTyConBinders (replicate arity liftedTypeKind)
+    tc_res_kind = liftedTypeKind
+    tc_arity    = arity
+    flavour     = VanillaAlgTyCon (mkPrelTyConRepName tc_name)
+
+    dc_tvs     = binderVars tc_binders
+    dc_arg_tys = mkTyVarTys dc_tvs
+    tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon
+
+    boxity  = Boxed
+    modu    = gHC_TUPLE
+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
+                         (ATyCon tycon) BuiltInSyntax
+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_uniq = mkTupleTyConUnique   boxity arity
+    dc_uniq = mkTupleDataConUnique boxity arity
+
+mk_tuple Unboxed arity = (tycon, tuple_con)
+  where
+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
+                         UnboxedTuple flavour
+
+    -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
+    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #
+    tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
+                                        (\ks -> map tYPE ks)
+
+    tc_res_kind = unboxedTupleKind rr_tys
+
+    tc_arity    = arity * 2
+    flavour     = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name)
+
+    dc_tvs               = binderVars tc_binders
+    (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)
+    tuple_con            = pcDataCon dc_name dc_tvs dc_arg_tys tycon
+
+    boxity  = Unboxed
+    modu    = gHC_PRIM
+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
+                         (ATyCon tycon) BuiltInSyntax
+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_uniq = mkTupleTyConUnique   boxity arity
+    dc_uniq = mkTupleDataConUnique boxity arity
+
+unitTyCon :: TyCon
+unitTyCon = tupleTyCon Boxed 0
+
+unitTyConKey :: Unique
+unitTyConKey = getUnique unitTyCon
+
+unitDataCon :: DataCon
+unitDataCon   = head (tyConDataCons unitTyCon)
+
+unitDataConId :: Id
+unitDataConId = dataConWorkId unitDataCon
+
+pairTyCon :: TyCon
+pairTyCon = tupleTyCon Boxed 2
+
+unboxedUnitTyCon :: TyCon
+unboxedUnitTyCon = tupleTyCon Unboxed 0
+
+unboxedUnitDataCon :: DataCon
+unboxedUnitDataCon = tupleDataCon   Unboxed 0
+
+
+{- *********************************************************************
+*                                                                      *
+      Unboxed sums
+*                                                                      *
+********************************************************************* -}
+
+-- | OccName for n-ary unboxed sum type constructor.
+mkSumTyConOcc :: Arity -> OccName
+mkSumTyConOcc n = mkOccName tcName str
+  where
+    -- No need to cache these, the caching is done in mk_sum
+    str = '(' : '#' : bars ++ "#)"
+    bars = replicate (n-1) '|'
+
+-- | OccName for i-th alternative of n-ary unboxed sum data constructor.
+mkSumDataConOcc :: ConTag -> Arity -> OccName
+mkSumDataConOcc alt n = mkOccName dataName str
+  where
+    -- No need to cache these, the caching is done in mk_sum
+    str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ "#)"
+    bars i = replicate i '|'
+
+-- | Type constructor for n-ary unboxed sum.
+sumTyCon :: Arity -> TyCon
+sumTyCon arity
+  | arity > mAX_SUM_SIZE
+  = fst (mk_sum arity)  -- Build one specially
+
+  | arity < 2
+  = panic ("sumTyCon: Arity starts from 2. (arity: " ++ show arity ++ ")")
+
+  | otherwise
+  = fst (unboxedSumArr ! arity)
+
+-- | Data constructor for i-th alternative of a n-ary unboxed sum.
+sumDataCon :: ConTag -- Alternative
+           -> Arity  -- Arity
+           -> DataCon
+sumDataCon alt arity
+  | alt > arity
+  = panic ("sumDataCon: index out of bounds: alt: "
+           ++ show alt ++ " > arity " ++ show arity)
+
+  | alt <= 0
+  = panic ("sumDataCon: Alts start from 1. (alt: " ++ show alt
+           ++ ", arity: " ++ show arity ++ ")")
+
+  | arity < 2
+  = panic ("sumDataCon: Arity starts from 2. (alt: " ++ show alt
+           ++ ", arity: " ++ show arity ++ ")")
+
+  | arity > mAX_SUM_SIZE
+  = snd (mk_sum arity) ! (alt - 1)  -- Build one specially
+
+  | otherwise
+  = snd (unboxedSumArr ! arity) ! (alt - 1)
+
+-- | Cached type and data constructors for sums. The outer array is
+-- indexed by the arity of the sum and the inner array is indexed by
+-- the alternative.
+unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
+unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]]
+
+-- | Specialization of 'unboxedTupleSumKind' for sums
+unboxedSumKind :: [Type] -> Kind
+unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon
+
+-- | Create type constructor and data constructors for n-ary unboxed sum.
+mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)
+mk_sum arity = (tycon, sum_cons)
+  where
+    tycon   = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)
+                         (UnboxedAlgTyCon rep_name)
+
+    -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.
+    rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name
+
+    tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
+                                        (\ks -> map tYPE ks)
+
+    tyvars = binderVars tc_binders
+
+    tc_res_kind = unboxedSumKind rr_tys
+
+    (rr_tys, tyvar_tys) = splitAt arity (mkTyVarTys tyvars)
+
+    tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq
+                            (ATyCon tycon) BuiltInSyntax
+
+    sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]]
+    sum_con i = let dc = pcDataCon dc_name
+                                   tyvars -- univ tyvars
+                                   [tyvar_tys !! i] -- arg types
+                                   tycon
+
+                    dc_name = mkWiredInName gHC_PRIM
+                                            (mkSumDataConOcc i arity)
+                                            (dc_uniq i)
+                                            (AConLike (RealDataCon dc))
+                                            BuiltInSyntax
+                in dc
+
+    tc_uniq   = mkSumTyConUnique   arity
+    dc_uniq i = mkSumDataConUnique i arity
+
+{-
+************************************************************************
+*                                                                      *
+              Equality types and classes
+*                                                                      *
+********************************************************************* -}
+
+-- See Note [The equality types story] in GHC.Builtin.Types.Prim
+-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)
+--
+-- It's tempting to put functional dependencies on (~~), but it's not
+-- necessary because the functional-dependency coverage check looks
+-- through superclasses, and (~#) is handled in that check.
+
+eqTyCon,   heqTyCon,   coercibleTyCon   :: TyCon
+eqClass,   heqClass,   coercibleClass   :: Class
+eqDataCon, heqDataCon, coercibleDataCon :: DataCon
+eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
+
+(eqTyCon, eqClass, eqDataCon, eqSCSelId)
+  = (tycon, klass, datacon, sc_sel_id)
+  where
+    tycon     = mkClassTyCon eqTyConName binders roles
+                             rhs klass
+                             (mkPrelTyConRepName eqTyConName)
+    klass     = mk_class tycon sc_pred sc_sel_id
+    datacon   = pcDataCon eqDataConName tvs [sc_pred] tycon
+
+    -- Kind: forall k. k -> k -> Constraint
+    binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
+    roles     = [Nominal, Nominal, Nominal]
+    rhs       = mkDataTyConRhs [datacon]
+
+    tvs@[k,a,b] = binderVars binders
+    sc_pred     = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b])
+    sc_sel_id   = mkDictSelId eqSCSelIdName klass
+
+(heqTyCon, heqClass, heqDataCon, heqSCSelId)
+  = (tycon, klass, datacon, sc_sel_id)
+  where
+    tycon     = mkClassTyCon heqTyConName binders roles
+                             rhs klass
+                             (mkPrelTyConRepName heqTyConName)
+    klass     = mk_class tycon sc_pred sc_sel_id
+    datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon
+
+    -- Kind: forall k1 k2. k1 -> k2 -> Constraint
+    binders   = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
+    roles     = [Nominal, Nominal, Nominal, Nominal]
+    rhs       = mkDataTyConRhs [datacon]
+
+    tvs       = binderVars binders
+    sc_pred   = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
+    sc_sel_id = mkDictSelId heqSCSelIdName klass
+
+(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
+  = (tycon, klass, datacon, sc_sel_id)
+  where
+    tycon     = mkClassTyCon coercibleTyConName binders roles
+                             rhs klass
+                             (mkPrelTyConRepName coercibleTyConName)
+    klass     = mk_class tycon sc_pred sc_sel_id
+    datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon
+
+    -- Kind: forall k. k -> k -> Constraint
+    binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
+    roles     = [Nominal, Representational, Representational]
+    rhs       = mkDataTyConRhs [datacon]
+
+    tvs@[k,a,b] = binderVars binders
+    sc_pred     = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])
+    sc_sel_id   = mkDictSelId coercibleSCSelIdName klass
+
+mk_class :: TyCon -> PredType -> Id -> Class
+mk_class tycon sc_pred sc_sel_id
+  = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]
+            [] [] (mkAnd []) tycon
+
+
+
+{- *********************************************************************
+*                                                                      *
+                Kinds and RuntimeRep
+*                                                                      *
+********************************************************************* -}
+
+-- For information about the usage of the following type,
+-- see Note [TYPE and RuntimeRep] in module GHC.Builtin.Types.Prim
+runtimeRepTy :: Type
+runtimeRepTy = mkTyConTy runtimeRepTyCon
+
+-- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim
+-- type Type = tYPE 'LiftedRep
+liftedTypeKindTyCon :: TyCon
+liftedTypeKindTyCon   = buildSynTyCon liftedTypeKindTyConName
+                                       [] liftedTypeKind []
+                                       (tYPE liftedRepTy)
+
+runtimeRepTyCon :: TyCon
+runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
+                          (vecRepDataCon : tupleRepDataCon :
+                           sumRepDataCon : runtimeRepSimpleDataCons)
+
+vecRepDataCon :: DataCon
+vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
+                                                   , mkTyConTy vecElemTyCon ]
+                                 runtimeRepTyCon
+                                 (RuntimeRep prim_rep_fun)
+  where
+    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
+    prim_rep_fun [count, elem]
+      | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)
+      , VecElem  e <- tyConRuntimeRepInfo (tyConAppTyCon elem)
+      = [VecRep n e]
+    prim_rep_fun args
+      = pprPanic "vecRepDataCon" (ppr args)
+
+vecRepDataConTyCon :: TyCon
+vecRepDataConTyCon = promoteDataCon vecRepDataCon
+
+tupleRepDataCon :: DataCon
+tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]
+                                   runtimeRepTyCon (RuntimeRep prim_rep_fun)
+  where
+    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
+    prim_rep_fun [rr_ty_list]
+      = concatMap (runtimeRepPrimRep doc) rr_tys
+      where
+        rr_tys = extractPromotedList rr_ty_list
+        doc    = text "tupleRepDataCon" <+> ppr rr_tys
+    prim_rep_fun args
+      = pprPanic "tupleRepDataCon" (ppr args)
+
+tupleRepDataConTyCon :: TyCon
+tupleRepDataConTyCon = promoteDataCon tupleRepDataCon
+
+sumRepDataCon :: DataCon
+sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]
+                                 runtimeRepTyCon (RuntimeRep prim_rep_fun)
+  where
+    -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
+    prim_rep_fun [rr_ty_list]
+      = map slotPrimRep (ubxSumRepType prim_repss)
+      where
+        rr_tys     = extractPromotedList rr_ty_list
+        doc        = text "sumRepDataCon" <+> ppr rr_tys
+        prim_repss = map (runtimeRepPrimRep doc) rr_tys
+    prim_rep_fun args
+      = pprPanic "sumRepDataCon" (ppr args)
+
+sumRepDataConTyCon :: TyCon
+sumRepDataConTyCon = promoteDataCon sumRepDataCon
+
+-- See Note [Wiring in RuntimeRep]
+-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
+runtimeRepSimpleDataCons :: [DataCon]
+liftedRepDataCon :: DataCon
+runtimeRepSimpleDataCons@(liftedRepDataCon : _)
+  = zipWithLazy mk_runtime_rep_dc
+    [ LiftedRep, UnliftedRep
+    , IntRep
+    , Int8Rep, Int16Rep, Int32Rep, Int64Rep
+    , WordRep
+    , Word8Rep, Word16Rep, Word32Rep, Word64Rep
+    , AddrRep
+    , FloatRep, DoubleRep
+    ]
+    runtimeRepSimpleDataConNames
+  where
+    mk_runtime_rep_dc primrep name
+      = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))
+
+-- See Note [Wiring in RuntimeRep]
+liftedRepDataConTy, unliftedRepDataConTy,
+  intRepDataConTy,
+  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
+  wordRepDataConTy,
+  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
+  addrRepDataConTy,
+  floatRepDataConTy, doubleRepDataConTy :: Type
+[liftedRepDataConTy, unliftedRepDataConTy,
+   intRepDataConTy,
+   int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
+   wordRepDataConTy,
+   word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
+   addrRepDataConTy,
+   floatRepDataConTy, doubleRepDataConTy
+   ]
+  = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons
+
+vecCountTyCon :: TyCon
+vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons
+
+-- See Note [Wiring in RuntimeRep]
+vecCountDataCons :: [DataCon]
+vecCountDataCons = zipWithLazy mk_vec_count_dc
+                     [ 2, 4, 8, 16, 32, 64 ]
+                     vecCountDataConNames
+  where
+    mk_vec_count_dc n name
+      = pcSpecialDataCon name [] vecCountTyCon (VecCount n)
+
+-- See Note [Wiring in RuntimeRep]
+vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+  vec64DataConTy :: Type
+[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+  vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
+
+vecElemTyCon :: TyCon
+vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons
+
+-- See Note [Wiring in RuntimeRep]
+vecElemDataCons :: [DataCon]
+vecElemDataCons = zipWithLazy mk_vec_elem_dc
+                    [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep
+                    , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep
+                    , FloatElemRep, DoubleElemRep ]
+                    vecElemDataConNames
+  where
+    mk_vec_elem_dc elem name
+      = pcSpecialDataCon name [] vecElemTyCon (VecElem elem)
+
+-- See Note [Wiring in RuntimeRep]
+int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+  doubleElemRepDataConTy :: Type
+[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+  doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)
+                                vecElemDataCons
+
+liftedRepDataConTyCon :: TyCon
+liftedRepDataConTyCon = promoteDataCon liftedRepDataCon
+
+-- The type ('LiftedRep)
+liftedRepTy :: Type
+liftedRepTy = liftedRepDataConTy
+
+{- *********************************************************************
+*                                                                      *
+     The boxed primitive types: Char, Int, etc
+*                                                                      *
+********************************************************************* -}
+
+boxingDataCon_maybe :: TyCon -> Maybe DataCon
+--    boxingDataCon_maybe Char# = C#
+--    boxingDataCon_maybe Int#  = I#
+--    ... etc ...
+-- See Note [Boxing primitive types]
+boxingDataCon_maybe tc
+  = lookupNameEnv boxing_constr_env (tyConName tc)
+
+boxing_constr_env :: NameEnv DataCon
+boxing_constr_env
+  = mkNameEnv [(charPrimTyConName  , charDataCon  )
+              ,(intPrimTyConName   , intDataCon   )
+              ,(wordPrimTyConName  , wordDataCon  )
+              ,(floatPrimTyConName , floatDataCon )
+              ,(doublePrimTyConName, doubleDataCon) ]
+
+{- Note [Boxing primitive types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For a handful of primitive types (Int, Char, Word, Float, Double),
+we can readily box and an unboxed version (Int#, Char# etc) using
+the corresponding data constructor.  This is useful in a couple
+of places, notably let-floating -}
+
+
+charTy :: Type
+charTy = mkTyConTy charTyCon
+
+charTyCon :: TyCon
+charTyCon   = pcTyCon charTyConName
+                   (Just (CType NoSourceText Nothing
+                                  (NoSourceText,fsLit "HsChar")))
+                   [] [charDataCon]
+charDataCon :: DataCon
+charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
+
+stringTy :: Type
+stringTy = mkListTy charTy -- convenience only
+
+intTy :: Type
+intTy = mkTyConTy intTyCon
+
+intTyCon :: TyCon
+intTyCon = pcTyCon intTyConName
+               (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt")))
+                 [] [intDataCon]
+intDataCon :: DataCon
+intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
+
+wordTy :: Type
+wordTy = mkTyConTy wordTyCon
+
+wordTyCon :: TyCon
+wordTyCon = pcTyCon wordTyConName
+            (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord")))
+               [] [wordDataCon]
+wordDataCon :: DataCon
+wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
+
+word8Ty :: Type
+word8Ty = mkTyConTy word8TyCon
+
+word8TyCon :: TyCon
+word8TyCon = pcTyCon word8TyConName
+                     (Just (CType NoSourceText Nothing
+                            (NoSourceText, fsLit "HsWord8"))) []
+                     [word8DataCon]
+word8DataCon :: DataCon
+word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
+
+floatTy :: Type
+floatTy = mkTyConTy floatTyCon
+
+floatTyCon :: TyCon
+floatTyCon   = pcTyCon floatTyConName
+                      (Just (CType NoSourceText Nothing
+                             (NoSourceText, fsLit "HsFloat"))) []
+                      [floatDataCon]
+floatDataCon :: DataCon
+floatDataCon = pcDataCon         floatDataConName [] [floatPrimTy] floatTyCon
+
+doubleTy :: Type
+doubleTy = mkTyConTy doubleTyCon
+
+doubleTyCon :: TyCon
+doubleTyCon = pcTyCon doubleTyConName
+                      (Just (CType NoSourceText Nothing
+                             (NoSourceText,fsLit "HsDouble"))) []
+                      [doubleDataCon]
+
+doubleDataCon :: DataCon
+doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
+
+{-
+************************************************************************
+*                                                                      *
+              The Bool type
+*                                                                      *
+************************************************************************
+
+An ordinary enumeration type, but deeply wired in.  There are no
+magical operations on @Bool@ (just the regular Prelude code).
+
+{\em BEGIN IDLE SPECULATION BY SIMON}
+
+This is not the only way to encode @Bool@.  A more obvious coding makes
+@Bool@ just a boxed up version of @Bool#@, like this:
+\begin{verbatim}
+type Bool# = Int#
+data Bool = MkBool Bool#
+\end{verbatim}
+
+Unfortunately, this doesn't correspond to what the Report says @Bool@
+looks like!  Furthermore, we get slightly less efficient code (I
+think) with this coding. @gtInt@ would look like this:
+
+\begin{verbatim}
+gtInt :: Int -> Int -> Bool
+gtInt x y = case x of I# x# ->
+            case y of I# y# ->
+            case (gtIntPrim x# y#) of
+                b# -> MkBool b#
+\end{verbatim}
+
+Notice that the result of the @gtIntPrim@ comparison has to be turned
+into an integer (here called @b#@), and returned in a @MkBool@ box.
+
+The @if@ expression would compile to this:
+\begin{verbatim}
+case (gtInt x y) of
+  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
+\end{verbatim}
+
+I think this code is a little less efficient than the previous code,
+but I'm not certain.  At all events, corresponding with the Report is
+important.  The interesting thing is that the language is expressive
+enough to describe more than one alternative; and that a type doesn't
+necessarily need to be a straightforwardly boxed version of its
+primitive counterpart.
+
+{\em END IDLE SPECULATION BY SIMON}
+-}
+
+boolTy :: Type
+boolTy = mkTyConTy boolTyCon
+
+boolTyCon :: TyCon
+boolTyCon = pcTyCon boolTyConName
+                    (Just (CType NoSourceText Nothing
+                           (NoSourceText, fsLit "HsBool")))
+                    [] [falseDataCon, trueDataCon]
+
+falseDataCon, trueDataCon :: DataCon
+falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
+trueDataCon  = pcDataCon trueDataConName  [] [] boolTyCon
+
+falseDataConId, trueDataConId :: Id
+falseDataConId = dataConWorkId falseDataCon
+trueDataConId  = dataConWorkId trueDataCon
+
+orderingTyCon :: TyCon
+orderingTyCon = pcTyCon orderingTyConName Nothing
+                        [] [ordLTDataCon, ordEQDataCon, ordGTDataCon]
+
+ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon
+ordLTDataCon = pcDataCon ordLTDataConName  [] [] orderingTyCon
+ordEQDataCon = pcDataCon ordEQDataConName  [] [] orderingTyCon
+ordGTDataCon = pcDataCon ordGTDataConName  [] [] orderingTyCon
+
+ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id
+ordLTDataConId = dataConWorkId ordLTDataCon
+ordEQDataConId = dataConWorkId ordEQDataCon
+ordGTDataConId = dataConWorkId ordGTDataCon
+
+{-
+************************************************************************
+*                                                                      *
+            The List type
+   Special syntax, deeply wired in,
+   but otherwise an ordinary algebraic data type
+*                                                                      *
+************************************************************************
+
+       data [] a = [] | a : (List a)
+-}
+
+mkListTy :: Type -> Type
+mkListTy ty = mkTyConApp listTyCon [ty]
+
+listTyCon :: TyCon
+listTyCon = pcTyCon listTyConName Nothing [alphaTyVar] [nilDataCon, consDataCon]
+
+-- See also Note [Empty lists] in GHC.Hs.Expr.
+nilDataCon :: DataCon
+nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon
+
+consDataCon :: DataCon
+consDataCon = pcDataConWithFixity True {- Declared infix -}
+               consDataConName
+               alpha_tyvar [] alpha_tyvar
+               [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
+-- Interesting: polymorphic recursion would help here.
+-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
+-- gets the over-specific type (Type -> Type)
+
+-- Wired-in type Maybe
+
+maybeTyCon :: TyCon
+maybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar
+                     [nothingDataCon, justDataCon]
+
+nothingDataCon :: DataCon
+nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon
+
+justDataCon :: DataCon
+justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon
+
+{-
+** *********************************************************************
+*                                                                      *
+            The tuple types
+*                                                                      *
+************************************************************************
+
+The tuple types are definitely magic, because they form an infinite
+family.
+
+\begin{itemize}
+\item
+They have a special family of type constructors, of type @TyCon@
+These contain the tycon arity, but don't require a Unique.
+
+\item
+They have a special family of constructors, of type
+@Id@. Again these contain their arity but don't need a Unique.
+
+\item
+There should be a magic way of generating the info tables and
+entry code for all tuples.
+
+But at the moment we just compile a Haskell source
+file\srcloc{lib/prelude/...} containing declarations like:
+\begin{verbatim}
+data Tuple0             = Tup0
+data Tuple2  a b        = Tup2  a b
+data Tuple3  a b c      = Tup3  a b c
+data Tuple4  a b c d    = Tup4  a b c d
+...
+\end{verbatim}
+The print-names associated with the magic @Id@s for tuple constructors
+``just happen'' to be the same as those generated by these
+declarations.
+
+\item
+The instance environment should have a magic way to know
+that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
+so on. \ToDo{Not implemented yet.}
+
+\item
+There should also be a way to generate the appropriate code for each
+of these instances, but (like the info tables and entry code) it is
+done by enumeration\srcloc{lib/prelude/InTup?.hs}.
+\end{itemize}
+-}
+
+-- | Make a tuple type. The list of types should /not/ include any
+-- RuntimeRep specifications. Boxed 1-tuples are flattened.
+-- See Note [One-tuples]
+mkTupleTy :: Boxity -> [Type] -> Type
+-- Special case for *boxed* 1-tuples, which are represented by the type itself
+mkTupleTy Boxed   [ty] = ty
+mkTupleTy boxity  tys  = mkTupleTy1 boxity tys
+
+-- | Make a tuple type. The list of types should /not/ include any
+-- RuntimeRep specifications. Boxed 1-tuples are *not* flattened.
+-- See Note [One-tuples] and Note [Don't flatten tuples from HsSyn]
+-- in GHC.Core.Make
+mkTupleTy1 :: Boxity -> [Type] -> Type
+mkTupleTy1 Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys
+mkTupleTy1 Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))
+                                         (map getRuntimeRep tys ++ tys)
+
+-- | Build the type of a small tuple that holds the specified type of thing
+-- Flattens 1-tuples. See Note [One-tuples].
+mkBoxedTupleTy :: [Type] -> Type
+mkBoxedTupleTy tys = mkTupleTy Boxed tys
+
+unitTy :: Type
+unitTy = mkTupleTy Boxed []
+
+{- *********************************************************************
+*                                                                      *
+            The sum types
+*                                                                      *
+************************************************************************
+-}
+
+mkSumTy :: [Type] -> Type
+mkSumTy tys = mkTyConApp (sumTyCon (length tys))
+                         (map getRuntimeRep tys ++ tys)
+
+-- Promoted Booleans
+
+promotedFalseDataCon, promotedTrueDataCon :: TyCon
+promotedTrueDataCon   = promoteDataCon trueDataCon
+promotedFalseDataCon  = promoteDataCon falseDataCon
+
+-- Promoted Maybe
+promotedNothingDataCon, promotedJustDataCon :: TyCon
+promotedNothingDataCon = promoteDataCon nothingDataCon
+promotedJustDataCon    = promoteDataCon justDataCon
+
+-- Promoted Ordering
+
+promotedLTDataCon
+  , promotedEQDataCon
+  , promotedGTDataCon
+  :: TyCon
+promotedLTDataCon     = promoteDataCon ordLTDataCon
+promotedEQDataCon     = promoteDataCon ordEQDataCon
+promotedGTDataCon     = promoteDataCon ordGTDataCon
+
+-- Promoted List
+promotedConsDataCon, promotedNilDataCon :: TyCon
+promotedConsDataCon   = promoteDataCon consDataCon
+promotedNilDataCon    = promoteDataCon nilDataCon
+
+-- | Make a *promoted* list.
+mkPromotedListTy :: Kind   -- ^ of the elements of the list
+                 -> [Type] -- ^ elements
+                 -> Type
+mkPromotedListTy k tys
+  = foldr cons nil tys
+  where
+    cons :: Type  -- element
+         -> Type  -- list
+         -> Type
+    cons elt list = mkTyConApp promotedConsDataCon [k, elt, list]
+
+    nil :: Type
+    nil = mkTyConApp promotedNilDataCon [k]
+
+-- | Extract the elements of a promoted list. Panics if the type is not a
+-- promoted list
+extractPromotedList :: Type    -- ^ The promoted list
+                    -> [Type]
+extractPromotedList tys = go tys
+  where
+    go list_ty
+      | Just (tc, [_k, t, ts]) <- splitTyConApp_maybe list_ty
+      = ASSERT( tc `hasKey` consDataConKey )
+        t : go ts
+
+      | Just (tc, [_k]) <- splitTyConApp_maybe list_ty
+      = ASSERT( tc `hasKey` nilDataConKey )
+        []
+
+      | otherwise
+      = pprPanic "extractPromotedList" (ppr tys)
diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot
new file mode 100644
index 0000000000..b575fd2de3
--- /dev/null
+++ b/compiler/GHC/Builtin/Types.hs-boot
@@ -0,0 +1,47 @@
+module GHC.Builtin.Types where
+
+import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
+import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind)
+
+import GHC.Types.Basic (Arity, TupleSort)
+import GHC.Types.Name (Name)
+
+listTyCon :: TyCon
+typeNatKind, typeSymbolKind :: Type
+mkBoxedTupleTy :: [Type] -> Type
+
+coercibleTyCon, heqTyCon :: TyCon
+
+unitTy :: Type
+
+liftedTypeKind :: Kind
+liftedTypeKindTyCon :: TyCon
+
+constraintKind :: Kind
+
+runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
+runtimeRepTy :: Type
+
+liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon
+
+liftedRepDataConTy, unliftedRepDataConTy,
+  intRepDataConTy,
+  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
+  wordRepDataConTy,
+  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
+  addrRepDataConTy,
+  floatRepDataConTy, doubleRepDataConTy :: Type
+
+vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+  vec64DataConTy :: Type
+
+int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+  doubleElemRepDataConTy :: Type
+
+anyTypeOfKind :: Kind -> Type
+unboxedTupleKind :: [Type] -> Type
+mkPromotedListTy :: Type -> [Type] -> Type
+
+tupleTyConName :: TupleSort -> Arity -> Name
diff --git a/compiler/GHC/Builtin/Types/Literals.hs b/compiler/GHC/Builtin/Types/Literals.hs
new file mode 100644
index 0000000000..d5c1d209c6
--- /dev/null
+++ b/compiler/GHC/Builtin/Types/Literals.hs
@@ -0,0 +1,993 @@
+{-# LANGUAGE LambdaCase #-}
+
+module GHC.Builtin.Types.Literals
+  ( typeNatTyCons
+  , typeNatCoAxiomRules
+  , BuiltInSynFamily(..)
+
+    -- If you define a new built-in type family, make sure to export its TyCon
+    -- from here as well.
+    -- See Note [Adding built-in type families]
+  , typeNatAddTyCon
+  , typeNatMulTyCon
+  , typeNatExpTyCon
+  , typeNatLeqTyCon
+  , typeNatSubTyCon
+  , typeNatDivTyCon
+  , typeNatModTyCon
+  , typeNatLogTyCon
+  , typeNatCmpTyCon
+  , typeSymbolCmpTyCon
+  , typeSymbolAppendTyCon
+  ) where
+
+import GhcPrelude
+
+import GHC.Core.Type
+import Pair
+import GHC.Tc.Utils.TcType ( TcType, tcEqType )
+import GHC.Core.TyCon    ( TyCon, FamTyConFlav(..), mkFamilyTyCon
+                         , Injectivity(..) )
+import GHC.Core.Coercion ( Role(..) )
+import GHC.Tc.Types.Constraint ( Xi )
+import GHC.Core.Coercion.Axiom ( CoAxiomRule(..), BuiltInSynFamily(..), TypeEqn )
+import GHC.Types.Name          ( Name, BuiltInSyntax(..) )
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim    ( mkTemplateAnonTyConBinders )
+import GHC.Builtin.Names
+                  ( gHC_TYPELITS
+                  , gHC_TYPENATS
+                  , typeNatAddTyFamNameKey
+                  , typeNatMulTyFamNameKey
+                  , typeNatExpTyFamNameKey
+                  , typeNatLeqTyFamNameKey
+                  , typeNatSubTyFamNameKey
+                  , typeNatDivTyFamNameKey
+                  , typeNatModTyFamNameKey
+                  , typeNatLogTyFamNameKey
+                  , typeNatCmpTyFamNameKey
+                  , typeSymbolCmpTyFamNameKey
+                  , typeSymbolAppendFamNameKey
+                  )
+import FastString ( FastString
+                  , fsLit, nilFS, nullFS, unpackFS, mkFastString, appendFS
+                  )
+import qualified Data.Map as Map
+import Data.Maybe ( isJust )
+import Control.Monad ( guard )
+import Data.List  ( isPrefixOf, isSuffixOf )
+
+{-
+Note [Type-level literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are currently two forms of type-level literals: natural numbers, and
+symbols (even though this module is named GHC.Builtin.Types.Literals, it covers both).
+
+Type-level literals are supported by CoAxiomRules (conditional axioms), which
+power the built-in type families (see Note [Adding built-in type families]).
+Currently, all built-in type families are for the express purpose of supporting
+type-level literals.
+
+See also the Wiki page:
+
+    https://gitlab.haskell.org/ghc/ghc/wikis/type-nats
+
+Note [Adding built-in type families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are a few steps to adding a built-in type family:
+
+* Adding a unique for the type family TyCon
+
+  These go in GHC.Builtin.Names. It will likely be of the form
+  @myTyFamNameKey = mkPreludeTyConUnique xyz@, where @xyz@ is a number that
+  has not been chosen before in GHC.Builtin.Names. There are several examples already
+  in GHC.Builtin.Names—see, for instance, typeNatAddTyFamNameKey.
+
+* Adding the type family TyCon itself
+
+  This goes in GHC.Builtin.Types.Literals. There are plenty of examples of how to define
+  these—see, for instance, typeNatAddTyCon.
+
+  Once your TyCon has been defined, be sure to:
+
+  - Export it from GHC.Builtin.Types.Literals. (Not doing so caused #14632.)
+  - Include it in the typeNatTyCons list, defined in GHC.Builtin.Types.Literals.
+
+* Exposing associated type family axioms
+
+  When defining the type family TyCon, you will need to define an axiom for
+  the type family in general (see, for instance, axAddDef), and perhaps other
+  auxiliary axioms for special cases of the type family (see, for instance,
+  axAdd0L and axAdd0R).
+
+  After you have defined all of these axioms, be sure to include them in the
+  typeNatCoAxiomRules list, defined in GHC.Builtin.Types.Literals.
+  (Not doing so caused #14934.)
+
+* Define the type family somewhere
+
+  Finally, you will need to define the type family somewhere, likely in @base@.
+  Currently, all of the built-in type families are defined in GHC.TypeLits or
+  GHC.TypeNats, so those are likely candidates.
+
+  Since the behavior of your built-in type family is specified in GHC.Builtin.Types.Literals,
+  you should give an open type family definition with no instances, like so:
+
+    type family MyTypeFam (m :: Nat) (n :: Nat) :: Nat
+
+  Changing the argument and result kinds as appropriate.
+
+* Update the relevant test cases
+
+  The GHC test suite will likely need to be updated after you add your built-in
+  type family. For instance:
+
+  - The T9181 test prints the :browse contents of GHC.TypeLits, so if you added
+    a test there, the expected output of T9181 will need to change.
+  - The TcTypeNatSimple and TcTypeSymbolSimple tests have compile-time unit
+    tests, as well as TcTypeNatSimpleRun and TcTypeSymbolSimpleRun, which have
+    runtime unit tests. Consider adding further unit tests to those if your
+    built-in type family deals with Nats or Symbols, respectively.
+-}
+
+{-------------------------------------------------------------------------------
+Built-in type constructors for functions on type-level nats
+-}
+
+-- The list of built-in type family TyCons that GHC uses.
+-- If you define a built-in type family, make sure to add it to this list.
+-- See Note [Adding built-in type families]
+typeNatTyCons :: [TyCon]
+typeNatTyCons =
+  [ typeNatAddTyCon
+  , typeNatMulTyCon
+  , typeNatExpTyCon
+  , typeNatLeqTyCon
+  , typeNatSubTyCon
+  , typeNatDivTyCon
+  , typeNatModTyCon
+  , typeNatLogTyCon
+  , typeNatCmpTyCon
+  , typeSymbolCmpTyCon
+  , typeSymbolAppendTyCon
+  ]
+
+typeNatAddTyCon :: TyCon
+typeNatAddTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamAdd
+    , sfInteractTop   = interactTopAdd
+    , sfInteractInert = interactInertAdd
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "+")
+            typeNatAddTyFamNameKey typeNatAddTyCon
+
+typeNatSubTyCon :: TyCon
+typeNatSubTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamSub
+    , sfInteractTop   = interactTopSub
+    , sfInteractInert = interactInertSub
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "-")
+            typeNatSubTyFamNameKey typeNatSubTyCon
+
+typeNatMulTyCon :: TyCon
+typeNatMulTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamMul
+    , sfInteractTop   = interactTopMul
+    , sfInteractInert = interactInertMul
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "*")
+            typeNatMulTyFamNameKey typeNatMulTyCon
+
+typeNatDivTyCon :: TyCon
+typeNatDivTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamDiv
+    , sfInteractTop   = interactTopDiv
+    , sfInteractInert = interactInertDiv
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Div")
+            typeNatDivTyFamNameKey typeNatDivTyCon
+
+typeNatModTyCon :: TyCon
+typeNatModTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamMod
+    , sfInteractTop   = interactTopMod
+    , sfInteractInert = interactInertMod
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Mod")
+            typeNatModTyFamNameKey typeNatModTyCon
+
+
+
+
+
+typeNatExpTyCon :: TyCon
+typeNatExpTyCon = mkTypeNatFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamExp
+    , sfInteractTop   = interactTopExp
+    , sfInteractInert = interactInertExp
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "^")
+                typeNatExpTyFamNameKey typeNatExpTyCon
+
+typeNatLogTyCon :: TyCon
+typeNatLogTyCon = mkTypeNatFunTyCon1 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamLog
+    , sfInteractTop   = interactTopLog
+    , sfInteractInert = interactInertLog
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Log2")
+            typeNatLogTyFamNameKey typeNatLogTyCon
+
+
+
+typeNatLeqTyCon :: TyCon
+typeNatLeqTyCon =
+  mkFamilyTyCon name
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
+    boolTy
+    Nothing
+    (BuiltInSynFamTyCon ops)
+    Nothing
+    NotInjective
+
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "<=?")
+                typeNatLeqTyFamNameKey typeNatLeqTyCon
+  ops = BuiltInSynFamily
+    { sfMatchFam      = matchFamLeq
+    , sfInteractTop   = interactTopLeq
+    , sfInteractInert = interactInertLeq
+    }
+
+typeNatCmpTyCon :: TyCon
+typeNatCmpTyCon =
+  mkFamilyTyCon name
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
+    orderingKind
+    Nothing
+    (BuiltInSynFamTyCon ops)
+    Nothing
+    NotInjective
+
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "CmpNat")
+                typeNatCmpTyFamNameKey typeNatCmpTyCon
+  ops = BuiltInSynFamily
+    { sfMatchFam      = matchFamCmpNat
+    , sfInteractTop   = interactTopCmpNat
+    , sfInteractInert = \_ _ _ _ -> []
+    }
+
+typeSymbolCmpTyCon :: TyCon
+typeSymbolCmpTyCon =
+  mkFamilyTyCon name
+    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])
+    orderingKind
+    Nothing
+    (BuiltInSynFamTyCon ops)
+    Nothing
+    NotInjective
+
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "CmpSymbol")
+                typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon
+  ops = BuiltInSynFamily
+    { sfMatchFam      = matchFamCmpSymbol
+    , sfInteractTop   = interactTopCmpSymbol
+    , sfInteractInert = \_ _ _ _ -> []
+    }
+
+typeSymbolAppendTyCon :: TyCon
+typeSymbolAppendTyCon = mkTypeSymbolFunTyCon2 name
+  BuiltInSynFamily
+    { sfMatchFam      = matchFamAppendSymbol
+    , sfInteractTop   = interactTopAppendSymbol
+    , sfInteractInert = interactInertAppendSymbol
+    }
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "AppendSymbol")
+                typeSymbolAppendFamNameKey typeSymbolAppendTyCon
+
+
+
+-- Make a unary built-in constructor of kind: Nat -> Nat
+mkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon
+mkTypeNatFunTyCon1 op tcb =
+  mkFamilyTyCon op
+    (mkTemplateAnonTyConBinders [ typeNatKind ])
+    typeNatKind
+    Nothing
+    (BuiltInSynFamTyCon tcb)
+    Nothing
+    NotInjective
+
+
+-- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
+mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
+mkTypeNatFunTyCon2 op tcb =
+  mkFamilyTyCon op
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
+    typeNatKind
+    Nothing
+    (BuiltInSynFamTyCon tcb)
+    Nothing
+    NotInjective
+
+-- Make a binary built-in constructor of kind: Symbol -> Symbol -> Symbol
+mkTypeSymbolFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
+mkTypeSymbolFunTyCon2 op tcb =
+  mkFamilyTyCon op
+    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])
+    typeSymbolKind
+    Nothing
+    (BuiltInSynFamTyCon tcb)
+    Nothing
+    NotInjective
+
+
+{-------------------------------------------------------------------------------
+Built-in rules axioms
+-------------------------------------------------------------------------------}
+
+-- If you add additional rules, please remember to add them to
+-- `typeNatCoAxiomRules` also.
+-- See Note [Adding built-in type families]
+axAddDef
+  , axMulDef
+  , axExpDef
+  , axLeqDef
+  , axCmpNatDef
+  , axCmpSymbolDef
+  , axAppendSymbolDef
+  , axAdd0L
+  , axAdd0R
+  , axMul0L
+  , axMul0R
+  , axMul1L
+  , axMul1R
+  , axExp1L
+  , axExp0R
+  , axExp1R
+  , axLeqRefl
+  , axCmpNatRefl
+  , axCmpSymbolRefl
+  , axLeq0L
+  , axSubDef
+  , axSub0R
+  , axAppendSymbol0R
+  , axAppendSymbol0L
+  , axDivDef
+  , axDiv1
+  , axModDef
+  , axMod1
+  , axLogDef
+  :: CoAxiomRule
+
+axAddDef = mkBinAxiom "AddDef" typeNatAddTyCon $
+              \x y -> Just $ num (x + y)
+
+axMulDef = mkBinAxiom "MulDef" typeNatMulTyCon $
+              \x y -> Just $ num (x * y)
+
+axExpDef = mkBinAxiom "ExpDef" typeNatExpTyCon $
+              \x y -> Just $ num (x ^ y)
+
+axLeqDef = mkBinAxiom "LeqDef" typeNatLeqTyCon $
+              \x y -> Just $ bool (x <= y)
+
+axCmpNatDef   = mkBinAxiom "CmpNatDef" typeNatCmpTyCon
+              $ \x y -> Just $ ordering (compare x y)
+
+axCmpSymbolDef =
+  CoAxiomRule
+    { coaxrName      = fsLit "CmpSymbolDef"
+    , coaxrAsmpRoles = [Nominal, Nominal]
+    , coaxrRole      = Nominal
+    , coaxrProves    = \cs ->
+        do [Pair s1 s2, Pair t1 t2] <- return cs
+           s2' <- isStrLitTy s2
+           t2' <- isStrLitTy t2
+           return (mkTyConApp typeSymbolCmpTyCon [s1,t1] ===
+                   ordering (compare s2' t2')) }
+
+axAppendSymbolDef = CoAxiomRule
+    { coaxrName      = fsLit "AppendSymbolDef"
+    , coaxrAsmpRoles = [Nominal, Nominal]
+    , coaxrRole      = Nominal
+    , coaxrProves    = \cs ->
+        do [Pair s1 s2, Pair t1 t2] <- return cs
+           s2' <- isStrLitTy s2
+           t2' <- isStrLitTy t2
+           let z = mkStrLitTy (appendFS s2' t2')
+           return (mkTyConApp typeSymbolAppendTyCon [s1, t1] === z)
+    }
+
+axSubDef = mkBinAxiom "SubDef" typeNatSubTyCon $
+              \x y -> fmap num (minus x y)
+
+axDivDef = mkBinAxiom "DivDef" typeNatDivTyCon $
+              \x y -> do guard (y /= 0)
+                         return (num (div x y))
+
+axModDef = mkBinAxiom "ModDef" typeNatModTyCon $
+              \x y -> do guard (y /= 0)
+                         return (num (mod x y))
+
+axLogDef = mkUnAxiom "LogDef" typeNatLogTyCon $
+              \x -> do (a,_) <- genLog x 2
+                       return (num a)
+
+axAdd0L     = mkAxiom1 "Add0L"    $ \(Pair s t) -> (num 0 .+. s) === t
+axAdd0R     = mkAxiom1 "Add0R"    $ \(Pair s t) -> (s .+. num 0) === t
+axSub0R     = mkAxiom1 "Sub0R"    $ \(Pair s t) -> (s .-. num 0) === t
+axMul0L     = mkAxiom1 "Mul0L"    $ \(Pair s _) -> (num 0 .*. s) === num 0
+axMul0R     = mkAxiom1 "Mul0R"    $ \(Pair s _) -> (s .*. num 0) === num 0
+axMul1L     = mkAxiom1 "Mul1L"    $ \(Pair s t) -> (num 1 .*. s) === t
+axMul1R     = mkAxiom1 "Mul1R"    $ \(Pair s t) -> (s .*. num 1) === t
+axDiv1      = mkAxiom1 "Div1"     $ \(Pair s t) -> (tDiv s (num 1) === t)
+axMod1      = mkAxiom1 "Mod1"     $ \(Pair s _) -> (tMod s (num 1) === num 0)
+                                    -- XXX: Shouldn't we check that _ is 0?
+axExp1L     = mkAxiom1 "Exp1L"    $ \(Pair s _) -> (num 1 .^. s) === num 1
+axExp0R     = mkAxiom1 "Exp0R"    $ \(Pair s _) -> (s .^. num 0) === num 1
+axExp1R     = mkAxiom1 "Exp1R"    $ \(Pair s t) -> (s .^. num 1) === t
+axLeqRefl   = mkAxiom1 "LeqRefl"  $ \(Pair s _) -> (s <== s) === bool True
+axCmpNatRefl    = mkAxiom1 "CmpNatRefl"
+                $ \(Pair s _) -> (cmpNat s s) === ordering EQ
+axCmpSymbolRefl = mkAxiom1 "CmpSymbolRefl"
+                $ \(Pair s _) -> (cmpSymbol s s) === ordering EQ
+axLeq0L     = mkAxiom1 "Leq0L"    $ \(Pair s _) -> (num 0 <== s) === bool True
+axAppendSymbol0R  = mkAxiom1 "Concat0R"
+            $ \(Pair s t) -> (mkStrLitTy nilFS `appendSymbol` s) === t
+axAppendSymbol0L  = mkAxiom1 "Concat0L"
+            $ \(Pair s t) -> (s `appendSymbol` mkStrLitTy nilFS) === t
+
+-- The list of built-in type family axioms that GHC uses.
+-- If you define new axioms, make sure to include them in this list.
+-- See Note [Adding built-in type families]
+typeNatCoAxiomRules :: Map.Map FastString CoAxiomRule
+typeNatCoAxiomRules = Map.fromList $ map (\x -> (coaxrName x, x))
+  [ axAddDef
+  , axMulDef
+  , axExpDef
+  , axLeqDef
+  , axCmpNatDef
+  , axCmpSymbolDef
+  , axAppendSymbolDef
+  , axAdd0L
+  , axAdd0R
+  , axMul0L
+  , axMul0R
+  , axMul1L
+  , axMul1R
+  , axExp1L
+  , axExp0R
+  , axExp1R
+  , axLeqRefl
+  , axCmpNatRefl
+  , axCmpSymbolRefl
+  , axLeq0L
+  , axSubDef
+  , axSub0R
+  , axAppendSymbol0R
+  , axAppendSymbol0L
+  , axDivDef
+  , axDiv1
+  , axModDef
+  , axMod1
+  , axLogDef
+  ]
+
+
+
+{-------------------------------------------------------------------------------
+Various utilities for making axioms and types
+-------------------------------------------------------------------------------}
+
+(.+.) :: Type -> Type -> Type
+s .+. t = mkTyConApp typeNatAddTyCon [s,t]
+
+(.-.) :: Type -> Type -> Type
+s .-. t = mkTyConApp typeNatSubTyCon [s,t]
+
+(.*.) :: Type -> Type -> Type
+s .*. t = mkTyConApp typeNatMulTyCon [s,t]
+
+tDiv :: Type -> Type -> Type
+tDiv s t = mkTyConApp typeNatDivTyCon [s,t]
+
+tMod :: Type -> Type -> Type
+tMod s t = mkTyConApp typeNatModTyCon [s,t]
+
+(.^.) :: Type -> Type -> Type
+s .^. t = mkTyConApp typeNatExpTyCon [s,t]
+
+(<==) :: Type -> Type -> Type
+s <== t = mkTyConApp typeNatLeqTyCon [s,t]
+
+cmpNat :: Type -> Type -> Type
+cmpNat s t = mkTyConApp typeNatCmpTyCon [s,t]
+
+cmpSymbol :: Type -> Type -> Type
+cmpSymbol s t = mkTyConApp typeSymbolCmpTyCon [s,t]
+
+appendSymbol :: Type -> Type -> Type
+appendSymbol s t = mkTyConApp typeSymbolAppendTyCon [s, t]
+
+(===) :: Type -> Type -> Pair Type
+x === y = Pair x y
+
+num :: Integer -> Type
+num = mkNumLitTy
+
+bool :: Bool -> Type
+bool b = if b then mkTyConApp promotedTrueDataCon []
+              else mkTyConApp promotedFalseDataCon []
+
+isBoolLitTy :: Type -> Maybe Bool
+isBoolLitTy tc =
+  do (tc,[]) <- splitTyConApp_maybe tc
+     case () of
+       _ | tc == promotedFalseDataCon -> return False
+         | tc == promotedTrueDataCon  -> return True
+         | otherwise                   -> Nothing
+
+orderingKind :: Kind
+orderingKind = mkTyConApp orderingTyCon []
+
+ordering :: Ordering -> Type
+ordering o =
+  case o of
+    LT -> mkTyConApp promotedLTDataCon []
+    EQ -> mkTyConApp promotedEQDataCon []
+    GT -> mkTyConApp promotedGTDataCon []
+
+isOrderingLitTy :: Type -> Maybe Ordering
+isOrderingLitTy tc =
+  do (tc1,[]) <- splitTyConApp_maybe tc
+     case () of
+       _ | tc1 == promotedLTDataCon -> return LT
+         | tc1 == promotedEQDataCon -> return EQ
+         | tc1 == promotedGTDataCon -> return GT
+         | otherwise                -> Nothing
+
+known :: (Integer -> Bool) -> TcType -> Bool
+known p x = case isNumLitTy x of
+              Just a  -> p a
+              Nothing -> False
+
+
+mkUnAxiom :: String -> TyCon -> (Integer -> Maybe Type) -> CoAxiomRule
+mkUnAxiom str tc f =
+  CoAxiomRule
+    { coaxrName      = fsLit str
+    , coaxrAsmpRoles = [Nominal]
+    , coaxrRole      = Nominal
+    , coaxrProves    = \cs ->
+        do [Pair s1 s2] <- return cs
+           s2' <- isNumLitTy s2
+           z   <- f s2'
+           return (mkTyConApp tc [s1] === z)
+    }
+
+
+
+-- For the definitional axioms
+mkBinAxiom :: String -> TyCon ->
+              (Integer -> Integer -> Maybe Type) -> CoAxiomRule
+mkBinAxiom str tc f =
+  CoAxiomRule
+    { coaxrName      = fsLit str
+    , coaxrAsmpRoles = [Nominal, Nominal]
+    , coaxrRole      = Nominal
+    , coaxrProves    = \cs ->
+        do [Pair s1 s2, Pair t1 t2] <- return cs
+           s2' <- isNumLitTy s2
+           t2' <- isNumLitTy t2
+           z   <- f s2' t2'
+           return (mkTyConApp tc [s1,t1] === z)
+    }
+
+
+
+mkAxiom1 :: String -> (TypeEqn -> TypeEqn) -> CoAxiomRule
+mkAxiom1 str f =
+  CoAxiomRule
+    { coaxrName      = fsLit str
+    , coaxrAsmpRoles = [Nominal]
+    , coaxrRole      = Nominal
+    , coaxrProves    = \case [eqn] -> Just (f eqn)
+                             _     -> Nothing
+    }
+
+
+{-------------------------------------------------------------------------------
+Evaluation
+-------------------------------------------------------------------------------}
+
+matchFamAdd :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamAdd [s,t]
+  | Just 0 <- mbX = Just (axAdd0L, [t], t)
+  | Just 0 <- mbY = Just (axAdd0R, [s], s)
+  | Just x <- mbX, Just y <- mbY =
+    Just (axAddDef, [s,t], num (x + y))
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamAdd _ = Nothing
+
+matchFamSub :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamSub [s,t]
+  | Just 0 <- mbY = Just (axSub0R, [s], s)
+  | Just x <- mbX, Just y <- mbY, Just z <- minus x y =
+    Just (axSubDef, [s,t], num z)
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamSub _ = Nothing
+
+matchFamMul :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamMul [s,t]
+  | Just 0 <- mbX = Just (axMul0L, [t], num 0)
+  | Just 0 <- mbY = Just (axMul0R, [s], num 0)
+  | Just 1 <- mbX = Just (axMul1L, [t], t)
+  | Just 1 <- mbY = Just (axMul1R, [s], s)
+  | Just x <- mbX, Just y <- mbY =
+    Just (axMulDef, [s,t], num (x * y))
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamMul _ = Nothing
+
+matchFamDiv :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamDiv [s,t]
+  | Just 1 <- mbY = Just (axDiv1, [s], s)
+  | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axDivDef, [s,t], num (div x y))
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamDiv _ = Nothing
+
+matchFamMod :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamMod [s,t]
+  | Just 1 <- mbY = Just (axMod1, [s], num 0)
+  | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axModDef, [s,t], num (mod x y))
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamMod _ = Nothing
+
+
+
+matchFamExp :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamExp [s,t]
+  | Just 0 <- mbY = Just (axExp0R, [s], num 1)
+  | Just 1 <- mbX = Just (axExp1L, [t], num 1)
+  | Just 1 <- mbY = Just (axExp1R, [s], s)
+  | Just x <- mbX, Just y <- mbY =
+    Just (axExpDef, [s,t], num (x ^ y))
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamExp _ = Nothing
+
+matchFamLog :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamLog [s]
+  | Just x <- mbX, Just (n,_) <- genLog x 2 = Just (axLogDef, [s], num n)
+  where mbX = isNumLitTy s
+matchFamLog _ = Nothing
+
+
+matchFamLeq :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamLeq [s,t]
+  | Just 0 <- mbX = Just (axLeq0L, [t], bool True)
+  | Just x <- mbX, Just y <- mbY =
+    Just (axLeqDef, [s,t], bool (x <= y))
+  | tcEqType s t  = Just (axLeqRefl, [s], bool True)
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamLeq _ = Nothing
+
+matchFamCmpNat :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamCmpNat [s,t]
+  | Just x <- mbX, Just y <- mbY =
+    Just (axCmpNatDef, [s,t], ordering (compare x y))
+  | tcEqType s t = Just (axCmpNatRefl, [s], ordering EQ)
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamCmpNat _ = Nothing
+
+matchFamCmpSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamCmpSymbol [s,t]
+  | Just x <- mbX, Just y <- mbY =
+    Just (axCmpSymbolDef, [s,t], ordering (compare x y))
+  | tcEqType s t = Just (axCmpSymbolRefl, [s], ordering EQ)
+  where mbX = isStrLitTy s
+        mbY = isStrLitTy t
+matchFamCmpSymbol _ = Nothing
+
+matchFamAppendSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamAppendSymbol [s,t]
+  | Just x <- mbX, nullFS x = Just (axAppendSymbol0R, [t], t)
+  | Just y <- mbY, nullFS y = Just (axAppendSymbol0L, [s], s)
+  | Just x <- mbX, Just y <- mbY =
+    Just (axAppendSymbolDef, [s,t], mkStrLitTy (appendFS x y))
+  where
+  mbX = isStrLitTy s
+  mbY = isStrLitTy t
+matchFamAppendSymbol _ = Nothing
+
+{-------------------------------------------------------------------------------
+Interact with axioms
+-------------------------------------------------------------------------------}
+
+interactTopAdd :: [Xi] -> Xi -> [Pair Type]
+interactTopAdd [s,t] r
+  | Just 0 <- mbZ = [ s === num 0, t === num 0 ]                          -- (s + t ~ 0) => (s ~ 0, t ~ 0)
+  | Just x <- mbX, Just z <- mbZ, Just y <- minus z x = [t === num y]     -- (5 + t ~ 8) => (t ~ 3)
+  | Just y <- mbY, Just z <- mbZ, Just x <- minus z y = [s === num x]     -- (s + 5 ~ 8) => (s ~ 3)
+  where
+  mbX = isNumLitTy s
+  mbY = isNumLitTy t
+  mbZ = isNumLitTy r
+interactTopAdd _ _ = []
+
+{-
+Note [Weakened interaction rule for subtraction]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A simpler interaction here might be:
+
+  `s - t ~ r` --> `t + r ~ s`
+
+This would enable us to reuse all the code for addition.
+Unfortunately, this works a little too well at the moment.
+Consider the following example:
+
+    0 - 5 ~ r --> 5 + r ~ 0 --> (5 = 0, r = 0)
+
+This (correctly) spots that the constraint cannot be solved.
+
+However, this may be a problem if the constraint did not
+need to be solved in the first place!  Consider the following example:
+
+f :: Proxy (If (5 <=? 0) (0 - 5) (5 - 0)) -> Proxy 5
+f = id
+
+Currently, GHC is strict while evaluating functions, so this does not
+work, because even though the `If` should evaluate to `5 - 0`, we
+also evaluate the "then" branch which generates the constraint `0 - 5 ~ r`,
+which fails.
+
+So, for the time being, we only add an improvement when the RHS is a constant,
+which happens to work OK for the moment, although clearly we need to do
+something more general.
+-}
+interactTopSub :: [Xi] -> Xi -> [Pair Type]
+interactTopSub [s,t] r
+  | Just z <- mbZ = [ s === (num z .+. t) ]         -- (s - t ~ 5) => (5 + t ~ s)
+  where
+  mbZ = isNumLitTy r
+interactTopSub _ _ = []
+
+
+
+
+
+interactTopMul :: [Xi] -> Xi -> [Pair Type]
+interactTopMul [s,t] r
+  | Just 1 <- mbZ = [ s === num 1, t === num 1 ]                        -- (s * t ~ 1)  => (s ~ 1, t ~ 1)
+  | Just x <- mbX, Just z <- mbZ, Just y <- divide z x = [t === num y]  -- (3 * t ~ 15) => (t ~ 5)
+  | Just y <- mbY, Just z <- mbZ, Just x <- divide z y = [s === num x]  -- (s * 3 ~ 15) => (s ~ 5)
+  where
+  mbX = isNumLitTy s
+  mbY = isNumLitTy t
+  mbZ = isNumLitTy r
+interactTopMul _ _ = []
+
+interactTopDiv :: [Xi] -> Xi -> [Pair Type]
+interactTopDiv _ _ = []   -- I can't think of anything...
+
+interactTopMod :: [Xi] -> Xi -> [Pair Type]
+interactTopMod _ _ = []   -- I can't think of anything...
+
+interactTopExp :: [Xi] -> Xi -> [Pair Type]
+interactTopExp [s,t] r
+  | Just 0 <- mbZ = [ s === num 0 ]                                       -- (s ^ t ~ 0) => (s ~ 0)
+  | Just x <- mbX, Just z <- mbZ, Just y <- logExact  z x = [t === num y] -- (2 ^ t ~ 8) => (t ~ 3)
+  | Just y <- mbY, Just z <- mbZ, Just x <- rootExact z y = [s === num x] -- (s ^ 2 ~ 9) => (s ~ 3)
+  where
+  mbX = isNumLitTy s
+  mbY = isNumLitTy t
+  mbZ = isNumLitTy r
+interactTopExp _ _ = []
+
+interactTopLog :: [Xi] -> Xi -> [Pair Type]
+interactTopLog _ _ = []   -- I can't think of anything...
+
+
+
+interactTopLeq :: [Xi] -> Xi -> [Pair Type]
+interactTopLeq [s,t] r
+  | Just 0 <- mbY, Just True <- mbZ = [ s === num 0 ]                     -- (s <= 0) => (s ~ 0)
+  where
+  mbY = isNumLitTy t
+  mbZ = isBoolLitTy r
+interactTopLeq _ _ = []
+
+interactTopCmpNat :: [Xi] -> Xi -> [Pair Type]
+interactTopCmpNat [s,t] r
+  | Just EQ <- isOrderingLitTy r = [ s === t ]
+interactTopCmpNat _ _ = []
+
+interactTopCmpSymbol :: [Xi] -> Xi -> [Pair Type]
+interactTopCmpSymbol [s,t] r
+  | Just EQ <- isOrderingLitTy r = [ s === t ]
+interactTopCmpSymbol _ _ = []
+
+interactTopAppendSymbol :: [Xi] -> Xi -> [Pair Type]
+interactTopAppendSymbol [s,t] r
+  -- (AppendSymbol a b ~ "") => (a ~ "", b ~ "")
+  | Just z <- mbZ, nullFS z =
+    [s === mkStrLitTy nilFS, t === mkStrLitTy nilFS ]
+
+  -- (AppendSymbol "foo" b ~ "foobar") => (b ~ "bar")
+  | Just x <- fmap unpackFS mbX, Just z <- fmap unpackFS mbZ, x `isPrefixOf` z =
+    [ t === mkStrLitTy (mkFastString $ drop (length x) z) ]
+
+  -- (AppendSymbol f "bar" ~ "foobar") => (f ~ "foo")
+  | Just y <- fmap unpackFS mbY, Just z <- fmap unpackFS mbZ, y `isSuffixOf` z =
+    [ t === mkStrLitTy (mkFastString $ take (length z - length y) z) ]
+
+  where
+  mbX = isStrLitTy s
+  mbY = isStrLitTy t
+  mbZ = isStrLitTy r
+
+interactTopAppendSymbol _ _ = []
+
+{-------------------------------------------------------------------------------
+Interaction with inerts
+-------------------------------------------------------------------------------}
+
+interactInertAdd :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertAdd [x1,y1] z1 [x2,y2] z2
+  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]
+  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]
+  where sameZ = tcEqType z1 z2
+interactInertAdd _ _ _ _ = []
+
+interactInertSub :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertSub [x1,y1] z1 [x2,y2] z2
+  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]
+  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]
+  where sameZ = tcEqType z1 z2
+interactInertSub _ _ _ _ = []
+
+interactInertMul :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertMul [x1,y1] z1 [x2,y2] z2
+  | sameZ && known (/= 0) x1 && tcEqType x1 x2 = [ y1 === y2 ]
+  | sameZ && known (/= 0) y1 && tcEqType y1 y2 = [ x1 === x2 ]
+  where sameZ   = tcEqType z1 z2
+
+interactInertMul _ _ _ _ = []
+
+interactInertDiv :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertDiv _ _ _ _ = []
+
+interactInertMod :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertMod _ _ _ _ = []
+
+interactInertExp :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertExp [x1,y1] z1 [x2,y2] z2
+  | sameZ && known (> 1) x1 && tcEqType x1 x2 = [ y1 === y2 ]
+  | sameZ && known (> 0) y1 && tcEqType y1 y2 = [ x1 === x2 ]
+  where sameZ = tcEqType z1 z2
+
+interactInertExp _ _ _ _ = []
+
+interactInertLog :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertLog _ _ _ _ = []
+
+
+interactInertLeq :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertLeq [x1,y1] z1 [x2,y2] z2
+  | bothTrue && tcEqType x1 y2 && tcEqType y1 x2 = [ x1 === y1 ]
+  | bothTrue && tcEqType y1 x2                 = [ (x1 <== y2) === bool True ]
+  | bothTrue && tcEqType y2 x1                 = [ (x2 <== y1) === bool True ]
+  where bothTrue = isJust $ do True <- isBoolLitTy z1
+                               True <- isBoolLitTy z2
+                               return ()
+
+interactInertLeq _ _ _ _ = []
+
+
+interactInertAppendSymbol :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
+interactInertAppendSymbol [x1,y1] z1 [x2,y2] z2
+  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]
+  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]
+  where sameZ = tcEqType z1 z2
+interactInertAppendSymbol _ _ _ _ = []
+
+
+
+{- -----------------------------------------------------------------------------
+These inverse functions are used for simplifying propositions using
+concrete natural numbers.
+----------------------------------------------------------------------------- -}
+
+-- | Subtract two natural numbers.
+minus :: Integer -> Integer -> Maybe Integer
+minus x y = if x >= y then Just (x - y) else Nothing
+
+-- | Compute the exact logarithm of a natural number.
+-- The logarithm base is the second argument.
+logExact :: Integer -> Integer -> Maybe Integer
+logExact x y = do (z,True) <- genLog x y
+                  return z
+
+
+-- | Divide two natural numbers.
+divide :: Integer -> Integer -> Maybe Integer
+divide _ 0  = Nothing
+divide x y  = case divMod x y of
+                (a,0) -> Just a
+                _     -> Nothing
+
+-- | Compute the exact root of a natural number.
+-- The second argument specifies which root we are computing.
+rootExact :: Integer -> Integer -> Maybe Integer
+rootExact x y = do (z,True) <- genRoot x y
+                   return z
+
+
+
+{- | Compute the n-th root of a natural number, rounded down to
+the closest natural number.  The boolean indicates if the result
+is exact (i.e., True means no rounding was done, False means rounded down).
+The second argument specifies which root we are computing. -}
+genRoot :: Integer -> Integer -> Maybe (Integer, Bool)
+genRoot _  0    = Nothing
+genRoot x0 1    = Just (x0, True)
+genRoot x0 root = Just (search 0 (x0+1))
+  where
+  search from to = let x = from + div (to - from) 2
+                       a = x ^ root
+                   in case compare a x0 of
+                        EQ              -> (x, True)
+                        LT | x /= from  -> search x to
+                           | otherwise  -> (from, False)
+                        GT | x /= to    -> search from x
+                           | otherwise  -> (from, False)
+
+{- | Compute the logarithm of a number in the given base, rounded down to the
+closest integer.  The boolean indicates if we the result is exact
+(i.e., True means no rounding happened, False means we rounded down).
+The logarithm base is the second argument. -}
+genLog :: Integer -> Integer -> Maybe (Integer, Bool)
+genLog x 0    = if x == 1 then Just (0, True) else Nothing
+genLog _ 1    = Nothing
+genLog 0 _    = Nothing
+genLog x base = Just (exactLoop 0 x)
+  where
+  exactLoop s i
+    | i == 1     = (s,True)
+    | i < base   = (s,False)
+    | otherwise  =
+        let s1 = s + 1
+        in s1 `seq` case divMod i base of
+                      (j,r)
+                        | r == 0    -> exactLoop s1 j
+                        | otherwise -> (underLoop s1 j, False)
+
+  underLoop s i
+    | i < base  = s
+    | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
new file mode 100644
index 0000000000..4bee18b964
--- /dev/null
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -0,0 +1,1110 @@
+{-
+(c) The AQUA Project, Glasgow University, 1994-1998
+
+
+Wired-in knowledge about primitive types
+-}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- | This module defines TyCons that can't be expressed in Haskell.
+--   They are all, therefore, wired-in TyCons.  C.f module GHC.Builtin.Types
+module GHC.Builtin.Types.Prim(
+        mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
+
+        mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom,
+        mkTemplateKiTyVars, mkTemplateKiTyVar,
+
+        mkTemplateTyConBinders, mkTemplateKindTyConBinders,
+        mkTemplateAnonTyConBinders,
+
+        alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
+        alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
+        alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,
+        alphaTysUnliftedRep, alphaTyUnliftedRep,
+        runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
+        openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
+
+        -- Kind constructors...
+        tYPETyCon, tYPETyConName,
+
+        -- Kinds
+        tYPE, primRepToRuntimeRep,
+
+        funTyCon, funTyConName,
+        unexposedPrimTyCons, exposedPrimTyCons, primTyCons,
+
+        charPrimTyCon,          charPrimTy, charPrimTyConName,
+        intPrimTyCon,           intPrimTy, intPrimTyConName,
+        wordPrimTyCon,          wordPrimTy, wordPrimTyConName,
+        addrPrimTyCon,          addrPrimTy, addrPrimTyConName,
+        floatPrimTyCon,         floatPrimTy, floatPrimTyConName,
+        doublePrimTyCon,        doublePrimTy, doublePrimTyConName,
+
+        voidPrimTyCon,          voidPrimTy,
+        statePrimTyCon,         mkStatePrimTy,
+        realWorldTyCon,         realWorldTy, realWorldStatePrimTy,
+
+        proxyPrimTyCon,         mkProxyPrimTy,
+
+        arrayPrimTyCon, mkArrayPrimTy,
+        byteArrayPrimTyCon,     byteArrayPrimTy,
+        arrayArrayPrimTyCon, mkArrayArrayPrimTy,
+        smallArrayPrimTyCon, mkSmallArrayPrimTy,
+        mutableArrayPrimTyCon, mkMutableArrayPrimTy,
+        mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
+        mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
+        smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
+        mutVarPrimTyCon, mkMutVarPrimTy,
+
+        mVarPrimTyCon,                  mkMVarPrimTy,
+        tVarPrimTyCon,                  mkTVarPrimTy,
+        stablePtrPrimTyCon,             mkStablePtrPrimTy,
+        stableNamePrimTyCon,            mkStableNamePrimTy,
+        compactPrimTyCon,               compactPrimTy,
+        bcoPrimTyCon,                   bcoPrimTy,
+        weakPrimTyCon,                  mkWeakPrimTy,
+        threadIdPrimTyCon,              threadIdPrimTy,
+
+        int8PrimTyCon,          int8PrimTy, int8PrimTyConName,
+        word8PrimTyCon,         word8PrimTy, word8PrimTyConName,
+
+        int16PrimTyCon,         int16PrimTy, int16PrimTyConName,
+        word16PrimTyCon,        word16PrimTy, word16PrimTyConName,
+
+        int32PrimTyCon,         int32PrimTy, int32PrimTyConName,
+        word32PrimTyCon,        word32PrimTy, word32PrimTyConName,
+
+        int64PrimTyCon,         int64PrimTy, int64PrimTyConName,
+        word64PrimTyCon,        word64PrimTy, word64PrimTyConName,
+
+        eqPrimTyCon,            -- ty1 ~# ty2
+        eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)
+        eqPhantPrimTyCon,       -- ty1 ~P# ty2  (at role Phantom)
+        equalityTyCon,
+
+        -- * SIMD
+#include "primop-vector-tys-exports.hs-incl"
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Builtin.Types
+  ( runtimeRepTy, unboxedTupleKind, liftedTypeKind
+  , vecRepDataConTyCon, tupleRepDataConTyCon
+  , liftedRepDataConTy, unliftedRepDataConTy
+  , intRepDataConTy
+  , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
+  , wordRepDataConTy
+  , word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy
+  , addrRepDataConTy
+  , floatRepDataConTy, doubleRepDataConTy
+  , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
+  , vec64DataConTy
+  , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
+  , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
+  , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
+  , doubleElemRepDataConTy
+  , mkPromotedListTy )
+
+import GHC.Types.Var    ( TyVar, mkTyVar )
+import GHC.Types.Name
+import GHC.Core.TyCon
+import GHC.Types.SrcLoc
+import GHC.Types.Unique
+import GHC.Builtin.Names
+import FastString
+import Outputable
+import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
+                         -- import loops which show up if you import Type instead
+
+import Data.Char
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Primitive type constructors}
+*                                                                      *
+************************************************************************
+-}
+
+primTyCons :: [TyCon]
+primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons
+
+-- | Primitive 'TyCon's that are defined in "GHC.Prim" but not exposed.
+-- It's important to keep these separate as we don't want users to be able to
+-- write them (see #15209) or see them in GHCi's @:browse@ output
+-- (see #12023).
+unexposedPrimTyCons :: [TyCon]
+unexposedPrimTyCons
+  = [ eqPrimTyCon
+    , eqReprPrimTyCon
+    , eqPhantPrimTyCon
+    ]
+
+-- | Primitive 'TyCon's that are defined in, and exported from, "GHC.Prim".
+exposedPrimTyCons :: [TyCon]
+exposedPrimTyCons
+  = [ addrPrimTyCon
+    , arrayPrimTyCon
+    , byteArrayPrimTyCon
+    , arrayArrayPrimTyCon
+    , smallArrayPrimTyCon
+    , charPrimTyCon
+    , doublePrimTyCon
+    , floatPrimTyCon
+    , intPrimTyCon
+    , int8PrimTyCon
+    , int16PrimTyCon
+    , int32PrimTyCon
+    , int64PrimTyCon
+    , bcoPrimTyCon
+    , weakPrimTyCon
+    , mutableArrayPrimTyCon
+    , mutableByteArrayPrimTyCon
+    , mutableArrayArrayPrimTyCon
+    , smallMutableArrayPrimTyCon
+    , mVarPrimTyCon
+    , tVarPrimTyCon
+    , mutVarPrimTyCon
+    , realWorldTyCon
+    , stablePtrPrimTyCon
+    , stableNamePrimTyCon
+    , compactPrimTyCon
+    , statePrimTyCon
+    , voidPrimTyCon
+    , proxyPrimTyCon
+    , threadIdPrimTyCon
+    , wordPrimTyCon
+    , word8PrimTyCon
+    , word16PrimTyCon
+    , word32PrimTyCon
+    , word64PrimTyCon
+
+    , tYPETyCon
+
+#include "primop-vector-tycons.hs-incl"
+    ]
+
+mkPrimTc :: FastString -> Unique -> TyCon -> Name
+mkPrimTc fs unique tycon
+  = mkWiredInName gHC_PRIM (mkTcOccFS fs)
+                  unique
+                  (ATyCon tycon)        -- Relevant TyCon
+                  UserSyntax
+
+mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name
+mkBuiltInPrimTc fs unique tycon
+  = mkWiredInName gHC_PRIM (mkTcOccFS fs)
+                  unique
+                  (ATyCon tycon)        -- Relevant TyCon
+                  BuiltInSyntax
+
+
+charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name
+charPrimTyConName             = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
+intPrimTyConName              = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
+int8PrimTyConName             = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon
+int16PrimTyConName            = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon
+int32PrimTyConName            = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
+int64PrimTyConName            = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon
+wordPrimTyConName             = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon
+word8PrimTyConName            = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon
+word16PrimTyConName           = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon
+word32PrimTyConName           = mkPrimTc (fsLit "Word32#") word32PrimTyConKey word32PrimTyCon
+word64PrimTyConName           = mkPrimTc (fsLit "Word64#") word64PrimTyConKey word64PrimTyCon
+addrPrimTyConName             = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrimTyCon
+floatPrimTyConName            = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon
+doublePrimTyConName           = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon
+statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon
+voidPrimTyConName             = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon
+proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
+eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
+eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
+eqPhantPrimTyConName          = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKey eqPhantPrimTyCon
+realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
+arrayPrimTyConName            = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
+byteArrayPrimTyConName        = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
+arrayArrayPrimTyConName           = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
+smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
+mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
+mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
+mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
+smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
+mutVarPrimTyConName           = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
+mVarPrimTyConName             = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
+tVarPrimTyConName             = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
+stablePtrPrimTyConName        = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
+stableNamePrimTyConName       = mkPrimTc (fsLit "StableName#") stableNamePrimTyConKey stableNamePrimTyCon
+compactPrimTyConName          = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon
+bcoPrimTyConName              = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon
+weakPrimTyConName             = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon
+threadIdPrimTyConName         = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Support code}
+*                                                                      *
+************************************************************************
+
+alphaTyVars is a list of type variables for use in templates:
+        ["a", "b", ..., "z", "t1", "t2", ... ]
+-}
+
+mkTemplateKindVar :: Kind -> TyVar
+mkTemplateKindVar = mkTyVar (mk_tv_name 0 "k")
+
+mkTemplateKindVars :: [Kind] -> [TyVar]
+-- k0  with unique (mkAlphaTyVarUnique 0)
+-- k1  with unique (mkAlphaTyVarUnique 1)
+-- ... etc
+mkTemplateKindVars [kind] = [mkTemplateKindVar kind]
+  -- Special case for one kind: just "k"
+mkTemplateKindVars kinds
+  = [ mkTyVar (mk_tv_name u ('k' : show u)) kind
+    | (kind, u) <- kinds `zip` [0..] ]
+mk_tv_name :: Int -> String -> Name
+mk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u)
+                                (mkTyVarOccFS (mkFastString s))
+                                noSrcSpan
+
+mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]
+-- a  with unique (mkAlphaTyVarUnique n)
+-- b  with unique (mkAlphaTyVarUnique n+1)
+-- ... etc
+-- Typically called as
+--   mkTemplateTyVarsFrom (length kv_bndrs) kinds
+-- where kv_bndrs are the kind-level binders of a TyCon
+mkTemplateTyVarsFrom n kinds
+  = [ mkTyVar name kind
+    | (kind, index) <- zip kinds [0..],
+      let ch_ord = index + ord 'a'
+          name_str | ch_ord <= ord 'z' = [chr ch_ord]
+                   | otherwise         = 't':show index
+          name = mk_tv_name (index + n) name_str
+    ]
+
+mkTemplateTyVars :: [Kind] -> [TyVar]
+mkTemplateTyVars = mkTemplateTyVarsFrom 1
+
+mkTemplateTyConBinders
+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
+                             --     same length as first arg
+                             -- Result is anon arg kinds
+    -> [TyConBinder]
+mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds
+  = kv_bndrs ++ tv_bndrs
+  where
+    kv_bndrs   = mkTemplateKindTyConBinders kind_var_kinds
+    anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))
+    tv_bndrs   = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds
+
+mkTemplateKiTyVars
+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
+                             --     same length as first arg
+                             -- Result is anon arg kinds [ak1, .., akm]
+    -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
+-- Example: if you want the tyvars for
+--   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
+-- call mkTemplateKiTyVars [RuntimeRep] (\[r] -> [TYPE r, *])
+mkTemplateKiTyVars kind_var_kinds mk_arg_kinds
+  = kv_bndrs ++ tv_bndrs
+  where
+    kv_bndrs   = mkTemplateKindVars kind_var_kinds
+    anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)
+    tv_bndrs   = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds
+
+mkTemplateKiTyVar
+    :: Kind                  -- [k1, .., kn]   Kind of kind-forall'd var
+    -> (Kind -> [Kind])      -- Arg is kv1:k1
+                             -- Result is anon arg kinds [ak1, .., akm]
+    -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
+-- Example: if you want the tyvars for
+--   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
+-- call mkTemplateKiTyVar RuntimeRep (\r -> [TYPE r, *])
+mkTemplateKiTyVar kind mk_arg_kinds
+  = kv_bndr : tv_bndrs
+  where
+    kv_bndr    = mkTemplateKindVar kind
+    anon_kinds = mk_arg_kinds (mkTyVarTy kv_bndr)
+    tv_bndrs   = mkTemplateTyVarsFrom 1 anon_kinds
+
+mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]
+-- Makes named, Specified binders
+mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]
+
+mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]
+mkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds)
+
+mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]
+mkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds)
+
+alphaTyVars :: [TyVar]
+alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind
+
+alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar
+(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
+
+alphaTys :: [Type]
+alphaTys = mkTyVarTys alphaTyVars
+alphaTy, betaTy, gammaTy, deltaTy :: Type
+(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
+
+alphaTyVarsUnliftedRep :: [TyVar]
+alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepDataConTy)
+
+alphaTyVarUnliftedRep :: TyVar
+(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep
+
+alphaTysUnliftedRep :: [Type]
+alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep
+alphaTyUnliftedRep :: Type
+(alphaTyUnliftedRep:_) = alphaTysUnliftedRep
+
+runtimeRep1TyVar, runtimeRep2TyVar :: TyVar
+(runtimeRep1TyVar : runtimeRep2TyVar : _)
+  = drop 16 (mkTemplateTyVars (repeat runtimeRepTy))  -- selects 'q','r'
+
+runtimeRep1Ty, runtimeRep2Ty :: Type
+runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
+runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
+
+openAlphaTyVar, openBetaTyVar :: TyVar
+-- alpha :: TYPE r1
+-- beta  :: TYPE r2
+[openAlphaTyVar,openBetaTyVar]
+  = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]
+
+openAlphaTy, openBetaTy :: Type
+openAlphaTy = mkTyVarTy openAlphaTyVar
+openBetaTy  = mkTyVarTy openBetaTyVar
+
+{-
+************************************************************************
+*                                                                      *
+                FunTyCon
+*                                                                      *
+************************************************************************
+-}
+
+funTyConName :: Name
+funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
+
+-- | The @(->)@ type constructor.
+--
+-- @
+-- (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
+--         TYPE rep1 -> TYPE rep2 -> *
+-- @
+funTyCon :: TyCon
+funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
+  where
+    tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
+               , mkNamedTyConBinder Inferred runtimeRep2TyVar ]
+               ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
+                                             , tYPE runtimeRep2Ty
+                                             ]
+    tc_rep_nm = mkPrelTyConRepName funTyConName
+
+{-
+************************************************************************
+*                                                                      *
+                Kinds
+*                                                                      *
+************************************************************************
+
+Note [TYPE and RuntimeRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+All types that classify values have a kind of the form (TYPE rr), where
+
+    data RuntimeRep     -- Defined in ghc-prim:GHC.Types
+      = LiftedRep
+      | UnliftedRep
+      | IntRep
+      | FloatRep
+      .. etc ..
+
+    rr :: RuntimeRep
+
+    TYPE :: RuntimeRep -> TYPE 'LiftedRep  -- Built in
+
+So for example:
+    Int        :: TYPE 'LiftedRep
+    Array# Int :: TYPE 'UnliftedRep
+    Int#       :: TYPE 'IntRep
+    Float#     :: TYPE 'FloatRep
+    Maybe      :: TYPE 'LiftedRep -> TYPE 'LiftedRep
+    (# , #)    :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])
+
+We abbreviate '*' specially:
+    type * = TYPE 'LiftedRep
+
+The 'rr' parameter tells us how the value is represented at runtime.
+
+Generally speaking, you can't be polymorphic in 'rr'.  E.g
+   f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]
+   f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ...
+This is no good: we could not generate code code for 'f', because the
+calling convention for 'f' varies depending on whether the argument is
+a a Int, Int#, or Float#.  (You could imagine generating specialised
+code, one for each instantiation of 'rr', but we don't do that.)
+
+Certain functions CAN be runtime-rep-polymorphic, because the code
+generator never has to manipulate a value of type 'a :: TYPE rr'.
+
+* error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a
+  Code generator never has to manipulate the return value.
+
+* unsafeCoerce#, defined in Desugar.mkUnsafeCoercePair:
+  Always inlined to be a no-op
+     unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
+                             (a :: TYPE r1) (b :: TYPE r2).
+                             a -> b
+
+* Unboxed tuples, and unboxed sums, defined in GHC.Builtin.Types
+  Always inlined, and hence specialised to the call site
+     (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
+                     (a :: TYPE r1) (b :: TYPE r2).
+                     a -> b -> TYPE ('TupleRep '[r1, r2])
+
+Note [PrimRep and kindPrimRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As part of its source code, in GHC.Core.TyCon, GHC has
+  data PrimRep = LiftedRep | UnliftedRep | IntRep | FloatRep | ...etc...
+
+Notice that
+ * RuntimeRep is part of the syntax tree of the program being compiled
+     (defined in a library: ghc-prim:GHC.Types)
+ * PrimRep is part of GHC's source code.
+     (defined in GHC.Core.TyCon)
+
+We need to get from one to the other; that is what kindPrimRep does.
+Suppose we have a value
+   (v :: t) where (t :: k)
+Given this kind
+    k = TyConApp "TYPE" [rep]
+GHC needs to be able to figure out how 'v' is represented at runtime.
+It expects 'rep' to be form
+    TyConApp rr_dc args
+where 'rr_dc' is a promoteed data constructor from RuntimeRep. So
+now we need to go from 'dc' to the corresponding PrimRep.  We store this
+PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.
+
+-}
+
+tYPETyCon :: TyCon
+tYPETyConName :: Name
+
+tYPETyCon = mkKindTyCon tYPETyConName
+                        (mkTemplateAnonTyConBinders [runtimeRepTy])
+                        liftedTypeKind
+                        [Nominal]
+                        (mkPrelTyConRepName tYPETyConName)
+
+--------------------------
+-- ... and now their names
+
+-- If you edit these, you may need to update the GHC formalism
+-- See Note [GHC Formalism] in GHC.Core.Lint
+tYPETyConName             = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
+
+mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
+mkPrimTyConName = mkPrimTcName BuiltInSyntax
+  -- All of the super kinds and kinds are defined in Prim,
+  -- and use BuiltInSyntax, because they are never in scope in the source
+
+mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name
+mkPrimTcName built_in_syntax occ key tycon
+  = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax
+
+-----------------------------
+-- | Given a RuntimeRep, applies TYPE to it.
+-- see Note [TYPE and RuntimeRep]
+tYPE :: Type -> Type
+tYPE rr = TyConApp tYPETyCon [rr]
+
+{-
+************************************************************************
+*                                                                      *
+   Basic primitive types (@Char#@, @Int#@, etc.)
+*                                                                      *
+************************************************************************
+-}
+
+-- only used herein
+pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
+pcPrimTyCon name roles rep
+  = mkPrimTyCon name binders result_kind roles
+  where
+    binders     = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
+    result_kind = tYPE (primRepToRuntimeRep rep)
+
+-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
+-- Defined here to avoid (more) module loops
+primRepToRuntimeRep :: PrimRep -> Type
+primRepToRuntimeRep rep = case rep of
+  VoidRep       -> TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []]
+  LiftedRep     -> liftedRepDataConTy
+  UnliftedRep   -> unliftedRepDataConTy
+  IntRep        -> intRepDataConTy
+  Int8Rep       -> int8RepDataConTy
+  Int16Rep      -> int16RepDataConTy
+  Int32Rep      -> int32RepDataConTy
+  Int64Rep      -> int64RepDataConTy
+  WordRep       -> wordRepDataConTy
+  Word8Rep      -> word8RepDataConTy
+  Word16Rep     -> word16RepDataConTy
+  Word32Rep     -> word32RepDataConTy
+  Word64Rep     -> word64RepDataConTy
+  AddrRep       -> addrRepDataConTy
+  FloatRep      -> floatRepDataConTy
+  DoubleRep     -> doubleRepDataConTy
+  VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']
+    where
+      n' = case n of
+        2  -> vec2DataConTy
+        4  -> vec4DataConTy
+        8  -> vec8DataConTy
+        16 -> vec16DataConTy
+        32 -> vec32DataConTy
+        64 -> vec64DataConTy
+        _  -> pprPanic "Disallowed VecCount" (ppr n)
+
+      elem' = case elem of
+        Int8ElemRep   -> int8ElemRepDataConTy
+        Int16ElemRep  -> int16ElemRepDataConTy
+        Int32ElemRep  -> int32ElemRepDataConTy
+        Int64ElemRep  -> int64ElemRepDataConTy
+        Word8ElemRep  -> word8ElemRepDataConTy
+        Word16ElemRep -> word16ElemRepDataConTy
+        Word32ElemRep -> word32ElemRepDataConTy
+        Word64ElemRep -> word64ElemRepDataConTy
+        FloatElemRep  -> floatElemRepDataConTy
+        DoubleElemRep -> doubleElemRepDataConTy
+
+pcPrimTyCon0 :: Name -> PrimRep -> TyCon
+pcPrimTyCon0 name rep
+  = pcPrimTyCon name [] rep
+
+charPrimTy :: Type
+charPrimTy      = mkTyConTy charPrimTyCon
+charPrimTyCon :: TyCon
+charPrimTyCon   = pcPrimTyCon0 charPrimTyConName WordRep
+
+intPrimTy :: Type
+intPrimTy       = mkTyConTy intPrimTyCon
+intPrimTyCon :: TyCon
+intPrimTyCon    = pcPrimTyCon0 intPrimTyConName IntRep
+
+int8PrimTy :: Type
+int8PrimTy     = mkTyConTy int8PrimTyCon
+int8PrimTyCon :: TyCon
+int8PrimTyCon  = pcPrimTyCon0 int8PrimTyConName Int8Rep
+
+int16PrimTy :: Type
+int16PrimTy    = mkTyConTy int16PrimTyCon
+int16PrimTyCon :: TyCon
+int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep
+
+int32PrimTy :: Type
+int32PrimTy     = mkTyConTy int32PrimTyCon
+int32PrimTyCon :: TyCon
+int32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName Int32Rep
+
+int64PrimTy :: Type
+int64PrimTy     = mkTyConTy int64PrimTyCon
+int64PrimTyCon :: TyCon
+int64PrimTyCon  = pcPrimTyCon0 int64PrimTyConName Int64Rep
+
+wordPrimTy :: Type
+wordPrimTy      = mkTyConTy wordPrimTyCon
+wordPrimTyCon :: TyCon
+wordPrimTyCon   = pcPrimTyCon0 wordPrimTyConName WordRep
+
+word8PrimTy :: Type
+word8PrimTy     = mkTyConTy word8PrimTyCon
+word8PrimTyCon :: TyCon
+word8PrimTyCon  = pcPrimTyCon0 word8PrimTyConName Word8Rep
+
+word16PrimTy :: Type
+word16PrimTy    = mkTyConTy word16PrimTyCon
+word16PrimTyCon :: TyCon
+word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep
+
+word32PrimTy :: Type
+word32PrimTy    = mkTyConTy word32PrimTyCon
+word32PrimTyCon :: TyCon
+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep
+
+word64PrimTy :: Type
+word64PrimTy    = mkTyConTy word64PrimTyCon
+word64PrimTyCon :: TyCon
+word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
+
+addrPrimTy :: Type
+addrPrimTy      = mkTyConTy addrPrimTyCon
+addrPrimTyCon :: TyCon
+addrPrimTyCon   = pcPrimTyCon0 addrPrimTyConName AddrRep
+
+floatPrimTy     :: Type
+floatPrimTy     = mkTyConTy floatPrimTyCon
+floatPrimTyCon :: TyCon
+floatPrimTyCon  = pcPrimTyCon0 floatPrimTyConName FloatRep
+
+doublePrimTy :: Type
+doublePrimTy    = mkTyConTy doublePrimTyCon
+doublePrimTyCon :: TyCon
+doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep
+
+{-
+************************************************************************
+*                                                                      *
+   The @State#@ type (and @_RealWorld@ types)
+*                                                                      *
+************************************************************************
+
+Note [The equality types story]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHC sports a veritable menagerie of equality types:
+
+         Type or  Lifted?  Hetero?  Role      Built in         Defining module
+         class?    L/U                        TyCon
+-----------------------------------------------------------------------------------------
+~#         T        U      hetero   nominal   eqPrimTyCon      GHC.Prim
+~~         C        L      hetero   nominal   heqTyCon         GHC.Types
+~          C        L      homo     nominal   eqTyCon          GHC.Types
+:~:        T        L      homo     nominal   (not built-in)   Data.Type.Equality
+:~~:       T        L      hetero   nominal   (not built-in)   Data.Type.Equality
+
+~R#        T        U      hetero   repr      eqReprPrimTy     GHC.Prim
+Coercible  C        L      homo     repr      coercibleTyCon   GHC.Types
+Coercion   T        L      homo     repr      (not built-in)   Data.Type.Coercion
+~P#        T        U      hetero   phantom   eqPhantPrimTyCon GHC.Prim
+
+Recall that "hetero" means the equality can related types of different
+kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2)
+also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2).
+
+To produce less confusion for end users, when not dumping and without
+-fprint-equality-relations, each of these groups is printed as the bottommost
+listed equality. That is, (~#) and (~~) are both rendered as (~) in
+error messages, and (~R#) is rendered as Coercible.
+
+Let's take these one at a time:
+
+    --------------------------
+    (~#) :: forall k1 k2. k1 -> k2 -> #
+    --------------------------
+This is The Type Of Equality in GHC. It classifies nominal coercions.
+This type is used in the solver for recording equality constraints.
+It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in
+Type.classifyPredType.
+
+All wanted constraints of this type are built with coercion holes.
+(See Note [Coercion holes] in GHC.Core.TyCo.Rep.) But see also
+Note [Deferred errors for coercion holes] in GHC.Tc.Errors to see how
+equality constraints are deferred.
+
+Within GHC, ~# is called eqPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
+
+
+    --------------------------
+    (~~) :: forall k1 k2. k1 -> k2 -> Constraint
+    --------------------------
+This is (almost) an ordinary class, defined as if by
+  class a ~# b => a ~~ b
+  instance a ~# b => a ~~ b
+Here's what's unusual about it:
+
+ * We can't actually declare it that way because we don't have syntax for ~#.
+   And ~# isn't a constraint, so even if we could write it, it wouldn't kind
+   check.
+
+ * Users cannot write instances of it.
+
+ * It is "naturally coherent". This means that the solver won't hesitate to
+   solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the
+   context. (Normally, it waits to learn more, just in case the given
+   influences what happens next.) See Note [Naturally coherent classes]
+   in GHC.Tc.Solver.Interact.
+
+ * It always terminates. That is, in the UndecidableInstances checks, we
+   don't worry if a (~~) constraint is too big, as we know that solving
+   equality terminates.
+
+On the other hand, this behaves just like any class w.r.t. eager superclass
+unpacking in the solver. So a lifted equality given quickly becomes an unlifted
+equality given. This is good, because the solver knows all about unlifted
+equalities. There is some special-casing in GHC.Tc.Solver.Interact.matchClassInst to
+pretend that there is an instance of this class, as we can't write the instance
+in Haskell.
+
+Within GHC, ~~ is called heqTyCon, and it is defined in GHC.Builtin.Types.
+
+
+    --------------------------
+    (~) :: forall k. k -> k -> Constraint
+    --------------------------
+This is /exactly/ like (~~), except with a homogeneous kind.
+It is an almost-ordinary class defined as if by
+  class a ~# b => (a :: k) ~ (b :: k)
+  instance a ~# b => a ~ b
+
+ * All the bullets for (~~) apply
+
+ * In addition (~) is magical syntax, as ~ is a reserved symbol.
+   It cannot be exported or imported.
+
+Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types.
+
+Historical note: prior to July 18 (~) was defined as a
+  more-ordinary class with (~~) as a superclass.  But that made it
+  special in different ways; and the extra superclass selections to
+  get from (~) to (~#) via (~~) were tiresome.  Now it's defined
+  uniformly with (~~) and Coercible; much nicer.)
+
+
+    --------------------------
+    (:~:) :: forall k. k -> k -> *
+    (:~~:) :: forall k1 k2. k1 -> k2 -> *
+    --------------------------
+These are perfectly ordinary GADTs, wrapping (~) and (~~) resp.
+They are not defined within GHC at all.
+
+
+    --------------------------
+    (~R#) :: forall k1 k2. k1 -> k2 -> #
+    --------------------------
+The is the representational analogue of ~#. This is the type of representational
+equalities that the solver works on. All wanted constraints of this type are
+built with coercion holes.
+
+Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in GHC.Builtin.Types.Prim.
+
+
+    --------------------------
+    Coercible :: forall k. k -> k -> Constraint
+    --------------------------
+This is quite like (~~) in the way it's defined and treated within GHC, but
+it's homogeneous. Homogeneity helps with type inference (as GHC can solve one
+kind from the other) and, in my (Richard's) estimation, will be more intuitive
+for users.
+
+An alternative design included HCoercible (like (~~)) and Coercible (like (~)).
+One annoyance was that we want `coerce :: Coercible a b => a -> b`, and
+we need the type of coerce to be fully wired-in. So the HCoercible/Coercible
+split required that both types be fully wired-in. Instead of doing this,
+I just got rid of HCoercible, as I'm not sure who would use it, anyway.
+
+Within GHC, Coercible is called coercibleTyCon, and it is defined in
+GHC.Builtin.Types.
+
+
+    --------------------------
+    Coercion :: forall k. k -> k -> *
+    --------------------------
+This is a perfectly ordinary GADT, wrapping Coercible. It is not defined
+within GHC at all.
+
+
+    --------------------------
+    (~P#) :: forall k1 k2. k1 -> k2 -> #
+    --------------------------
+This is the phantom analogue of ~# and it is barely used at all.
+(The solver has no idea about this one.) Here is the motivation:
+
+    data Phant a = MkPhant
+    type role Phant phantom
+
+    Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool
+
+We just need to have something to put on that last line. You probably
+don't need to worry about it.
+
+
+
+Note [The State# TyCon]
+~~~~~~~~~~~~~~~~~~~~~~~
+State# is the primitive, unlifted type of states.  It has one type parameter,
+thus
+        State# RealWorld
+or
+        State# s
+
+where s is a type variable. The only purpose of the type parameter is to
+keep different state threads separate.  It is represented by nothing at all.
+
+The type parameter to State# is intended to keep separate threads separate.
+Even though this parameter is not used in the definition of State#, it is
+given role Nominal to enforce its intended use.
+-}
+
+mkStatePrimTy :: Type -> Type
+mkStatePrimTy ty = TyConApp statePrimTyCon [ty]
+
+statePrimTyCon :: TyCon   -- See Note [The State# TyCon]
+statePrimTyCon   = pcPrimTyCon statePrimTyConName [Nominal] VoidRep
+
+{-
+RealWorld is deeply magical.  It is *primitive*, but it is not
+*unlifted* (hence ptrArg).  We never manipulate values of type
+RealWorld; it's only used in the type system, to parameterise State#.
+-}
+
+realWorldTyCon :: TyCon
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []
+realWorldTy :: Type
+realWorldTy          = mkTyConTy realWorldTyCon
+realWorldStatePrimTy :: Type
+realWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld
+
+-- Note: the ``state-pairing'' types are not truly primitive,
+-- so they are defined in \tr{GHC.Builtin.Types}, not here.
+
+
+voidPrimTy :: Type
+voidPrimTy = TyConApp voidPrimTyCon []
+
+voidPrimTyCon :: TyCon
+voidPrimTyCon    = pcPrimTyCon voidPrimTyConName [] VoidRep
+
+mkProxyPrimTy :: Type -> Type -> Type
+mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
+
+proxyPrimTyCon :: TyCon
+proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom]
+  where
+     -- Kind: forall k. k -> TYPE (Tuple '[])
+     binders = mkTemplateTyConBinders [liftedTypeKind] id
+     res_kind = unboxedTupleKind []
+
+
+{- *********************************************************************
+*                                                                      *
+                Primitive equality constraints
+    See Note [The equality types story]
+*                                                                      *
+********************************************************************* -}
+
+eqPrimTyCon :: TyCon  -- The representation type for equality predicates
+                      -- See Note [The equality types story]
+eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
+    res_kind = unboxedTupleKind []
+    roles    = [Nominal, Nominal, Nominal, Nominal]
+
+-- like eqPrimTyCon, but the type for *Representational* coercions
+-- this should only ever appear as the type of a covar. Its role is
+-- interpreted in coercionRole
+eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]
+eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
+    res_kind = unboxedTupleKind []
+    roles    = [Nominal, Nominal, Representational, Representational]
+
+-- like eqPrimTyCon, but the type for *Phantom* coercions.
+-- This is only used to make higher-order equalities. Nothing
+-- should ever actually have this type!
+eqPhantPrimTyCon :: TyCon
+eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
+    res_kind = unboxedTupleKind []
+    roles    = [Nominal, Nominal, Phantom, Phantom]
+
+-- | Given a Role, what TyCon is the type of equality predicates at that role?
+equalityTyCon :: Role -> TyCon
+equalityTyCon Nominal          = eqPrimTyCon
+equalityTyCon Representational = eqReprPrimTyCon
+equalityTyCon Phantom          = eqPhantPrimTyCon
+
+{- *********************************************************************
+*                                                                      *
+             The primitive array types
+*                                                                      *
+********************************************************************* -}
+
+arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
+    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
+    smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
+arrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] UnliftedRep
+mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] UnliftedRep
+mutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] UnliftedRep
+byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        UnliftedRep
+arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       UnliftedRep
+mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep
+smallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] UnliftedRep
+smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
+
+mkArrayPrimTy :: Type -> Type
+mkArrayPrimTy elt           = TyConApp arrayPrimTyCon [elt]
+byteArrayPrimTy :: Type
+byteArrayPrimTy             = mkTyConTy byteArrayPrimTyCon
+mkArrayArrayPrimTy :: Type
+mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
+mkSmallArrayPrimTy :: Type -> Type
+mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
+mkMutableArrayPrimTy :: Type -> Type -> Type
+mkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]
+mkMutableByteArrayPrimTy :: Type -> Type
+mkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]
+mkMutableArrayArrayPrimTy :: Type -> Type
+mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
+mkSmallMutableArrayPrimTy :: Type -> Type -> Type
+mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
+
+
+{- *********************************************************************
+*                                                                      *
+                The mutable variable type
+*                                                                      *
+********************************************************************* -}
+
+mutVarPrimTyCon :: TyCon
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep
+
+mkMutVarPrimTy :: Type -> Type -> Type
+mkMutVarPrimTy s elt        = TyConApp mutVarPrimTyCon [s, elt]
+
+{-
+************************************************************************
+*                                                                      *
+   The synchronizing variable type
+*                                                                      *
+************************************************************************
+-}
+
+mVarPrimTyCon :: TyCon
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep
+
+mkMVarPrimTy :: Type -> Type -> Type
+mkMVarPrimTy s elt          = TyConApp mVarPrimTyCon [s, elt]
+
+{-
+************************************************************************
+*                                                                      *
+   The transactional variable type
+*                                                                      *
+************************************************************************
+-}
+
+tVarPrimTyCon :: TyCon
+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep
+
+mkTVarPrimTy :: Type -> Type -> Type
+mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]
+
+{-
+************************************************************************
+*                                                                      *
+   The stable-pointer type
+*                                                                      *
+************************************************************************
+-}
+
+stablePtrPrimTyCon :: TyCon
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep
+
+mkStablePtrPrimTy :: Type -> Type
+mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]
+
+{-
+************************************************************************
+*                                                                      *
+   The stable-name type
+*                                                                      *
+************************************************************************
+-}
+
+stableNamePrimTyCon :: TyCon
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep
+
+mkStableNamePrimTy :: Type -> Type
+mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]
+
+{-
+************************************************************************
+*                                                                      *
+   The Compact NFData (CNF) type
+*                                                                      *
+************************************************************************
+-}
+
+compactPrimTyCon :: TyCon
+compactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep
+
+compactPrimTy :: Type
+compactPrimTy = mkTyConTy compactPrimTyCon
+
+{-
+************************************************************************
+*                                                                      *
+   The ``bytecode object'' type
+*                                                                      *
+************************************************************************
+-}
+
+-- Unlike most other primitive types, BCO is lifted. This is because in
+-- general a BCO may be a thunk for the reasons given in Note [Updatable CAF
+-- BCOs] in GHCi.CreateBCO.
+bcoPrimTy    :: Type
+bcoPrimTy    = mkTyConTy bcoPrimTyCon
+bcoPrimTyCon :: TyCon
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep
+
+{-
+************************************************************************
+*                                                                      *
+   The ``weak pointer'' type
+*                                                                      *
+************************************************************************
+-}
+
+weakPrimTyCon :: TyCon
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep
+
+mkWeakPrimTy :: Type -> Type
+mkWeakPrimTy v = TyConApp weakPrimTyCon [v]
+
+{-
+************************************************************************
+*                                                                      *
+   The ``thread id'' type
+*                                                                      *
+************************************************************************
+
+A thread id is represented by a pointer to the TSO itself, to ensure
+that they are always unique and we can always find the TSO for a given
+thread id.  However, this has the unfortunate consequence that a
+ThreadId# for a given thread is treated as a root by the garbage
+collector and can keep TSOs around for too long.
+
+Hence the programmer API for thread manipulation uses a weak pointer
+to the thread id internally.
+-}
+
+threadIdPrimTy :: Type
+threadIdPrimTy    = mkTyConTy threadIdPrimTyCon
+threadIdPrimTyCon :: TyCon
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{SIMD vector types}
+*                                                                      *
+************************************************************************
+-}
+
+#include "primop-vector-tys.hs-incl"
diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs
new file mode 100644
index 0000000000..d73544378b
--- /dev/null
+++ b/compiler/GHC/Builtin/Uniques.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE CPP #-}
+
+-- | This is where we define a mapping from Uniques to their associated
+-- known-key Names for things associated with tuples and sums. We use this
+-- mapping while deserializing known-key Names in interface file symbol tables,
+-- which are encoded as their Unique. See Note [Symbol table representation of
+-- names] for details.
+--
+
+module GHC.Builtin.Uniques
+    ( -- * Looking up known-key names
+      knownUniqueName
+
+      -- * Getting the 'Unique's of 'Name's
+      -- ** Anonymous sums
+    , mkSumTyConUnique
+    , mkSumDataConUnique
+      -- ** Tuples
+      -- *** Vanilla
+    , mkTupleTyConUnique
+    , mkTupleDataConUnique
+      -- *** Constraint
+    , mkCTupleTyConUnique
+    , mkCTupleDataConUnique
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Builtin.Types
+import GHC.Core.TyCon
+import GHC.Core.DataCon
+import GHC.Types.Id
+import GHC.Types.Basic
+import Outputable
+import GHC.Types.Unique
+import GHC.Types.Name
+import Util
+
+import Data.Bits
+import Data.Maybe
+
+-- | Get the 'Name' associated with a known-key 'Unique'.
+knownUniqueName :: Unique -> Maybe Name
+knownUniqueName u =
+    case tag of
+      'z' -> Just $ getUnboxedSumName n
+      '4' -> Just $ getTupleTyConName Boxed n
+      '5' -> Just $ getTupleTyConName Unboxed n
+      '7' -> Just $ getTupleDataConName Boxed n
+      '8' -> Just $ getTupleDataConName Unboxed n
+      'k' -> Just $ getCTupleTyConName n
+      'm' -> Just $ getCTupleDataConUnique n
+      _   -> Nothing
+  where
+    (tag, n) = unpkUnique u
+
+--------------------------------------------------
+-- Anonymous sums
+--
+-- Sum arities start from 2. The encoding is a bit funny: we break up the
+-- integral part into bitfields for the arity, an alternative index (which is
+-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a
+-- tag (used to identify the sum's TypeRep binding).
+--
+-- This layout is chosen to remain compatible with the usual unique allocation
+-- for wired-in data constructors described in GHC.Types.Unique
+--
+-- TyCon for sum of arity k:
+--   00000000 kkkkkkkk 11111100
+
+-- TypeRep of TyCon for sum of arity k:
+--   00000000 kkkkkkkk 11111101
+--
+-- DataCon for sum of arity k and alternative n (zero-based):
+--   00000000 kkkkkkkk nnnnnn00
+--
+-- TypeRep for sum DataCon of arity k and alternative n (zero-based):
+--   00000000 kkkkkkkk nnnnnn10
+
+mkSumTyConUnique :: Arity -> Unique
+mkSumTyConUnique arity =
+    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
+                         -- alternative
+    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
+
+mkSumDataConUnique :: ConTagZ -> Arity -> Unique
+mkSumDataConUnique alt arity
+  | alt >= arity
+  = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
+  | otherwise
+  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
+
+getUnboxedSumName :: Int -> Name
+getUnboxedSumName n
+  | n .&. 0xfc == 0xfc
+  = case tag of
+      0x0 -> tyConName $ sumTyCon arity
+      0x1 -> getRep $ sumTyCon arity
+      _   -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
+  | tag == 0x0
+  = dataConName $ sumDataCon (alt + 1) arity
+  | tag == 0x1
+  = getName $ dataConWrapId $ sumDataCon (alt + 1) arity
+  | tag == 0x2
+  = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
+  | otherwise
+  = pprPanic "getUnboxedSumName" (ppr n)
+  where
+    arity = n `shiftR` 8
+    alt = (n .&. 0xfc) `shiftR` 2
+    tag = 0x3 .&. n
+    getRep tycon =
+        fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))
+        $ tyConRepName_maybe tycon
+
+-- Note [Uniques for tuple type and data constructors]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Wired-in type constructor keys occupy *two* slots:
+--    * u: the TyCon itself
+--    * u+1: the TyConRepName of the TyCon
+--
+-- Wired-in tuple data constructor keys occupy *three* slots:
+--    * u: the DataCon itself
+--    * u+1: its worker Id
+--    * u+2: the TyConRepName of the promoted TyCon
+
+--------------------------------------------------
+-- Constraint tuples
+
+mkCTupleTyConUnique :: Arity -> Unique
+mkCTupleTyConUnique a = mkUnique 'k' (2*a)
+
+mkCTupleDataConUnique :: Arity -> Unique
+mkCTupleDataConUnique a = mkUnique 'm' (3*a)
+
+getCTupleTyConName :: Int -> Name
+getCTupleTyConName n =
+    case n `divMod` 2 of
+      (arity, 0) -> cTupleTyConName arity
+      (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
+      _          -> panic "getCTupleTyConName: impossible"
+
+getCTupleDataConUnique :: Int -> Name
+getCTupleDataConUnique n =
+    case n `divMod` 3 of
+      (arity,  0) -> cTupleDataConName arity
+      (_arity, 1) -> panic "getCTupleDataConName: no worker"
+      (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity
+      _           -> panic "getCTupleDataConName: impossible"
+
+--------------------------------------------------
+-- Normal tuples
+
+mkTupleDataConUnique :: Boxity -> Arity -> Unique
+mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels
+mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
+
+mkTupleTyConUnique :: Boxity -> Arity -> Unique
+mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
+mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
+
+getTupleTyConName :: Boxity -> Int -> Name
+getTupleTyConName boxity n =
+    case n `divMod` 2 of
+      (arity, 0) -> tyConName $ tupleTyCon boxity arity
+      (arity, 1) -> fromMaybe (panic "getTupleTyConName")
+                    $ tyConRepName_maybe $ tupleTyCon boxity arity
+      _          -> panic "getTupleTyConName: impossible"
+
+getTupleDataConName :: Boxity -> Int -> Name
+getTupleDataConName boxity n =
+    case n `divMod` 3 of
+      (arity, 0) -> dataConName $ tupleDataCon boxity arity
+      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity
+      (arity, 2) -> fromMaybe (panic "getTupleDataCon")
+                    $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
+      _          -> panic "getTupleDataConName: impossible"
diff --git a/compiler/GHC/Builtin/Uniques.hs-boot b/compiler/GHC/Builtin/Uniques.hs-boot
new file mode 100644
index 0000000000..f00490b538
--- /dev/null
+++ b/compiler/GHC/Builtin/Uniques.hs-boot
@@ -0,0 +1,18 @@
+module GHC.Builtin.Uniques where
+
+import GhcPrelude
+import GHC.Types.Unique
+import GHC.Types.Name
+import GHC.Types.Basic
+
+-- Needed by GHC.Builtin.Types
+knownUniqueName :: Unique -> Maybe Name
+
+mkSumTyConUnique :: Arity -> Unique
+mkSumDataConUnique :: ConTagZ -> Arity -> Unique
+
+mkCTupleTyConUnique :: Arity -> Unique
+mkCTupleDataConUnique :: Arity -> Unique
+
+mkTupleTyConUnique :: Boxity -> Arity -> Unique
+mkTupleDataConUnique :: Boxity -> Arity -> Unique
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
new file mode 100644
index 0000000000..0725ee85fa
--- /dev/null
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -0,0 +1,287 @@
+{-
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+-}
+
+{-# LANGUAGE CPP #-}
+
+-- | The @GHC.Builtin.Utils@ interface to the compiler's prelude knowledge.
+--
+-- This module serves as the central gathering point for names which the
+-- compiler knows something about. This includes functions for,
+--
+--  * discerning whether a 'Name' is known-key
+--
+--  * given a 'Unique', looking up its corresponding known-key 'Name'
+--
+-- See Note [Known-key names] and Note [About wired-in things] for information
+-- about the two types of prelude things in GHC.
+--
+module GHC.Builtin.Utils (
+        -- * Known-key names
+        isKnownKeyName,
+        lookupKnownKeyName,
+        lookupKnownNameInfo,
+
+        -- ** Internal use
+        -- | 'knownKeyNames' is exported to seed the original name cache only;
+        -- if you find yourself wanting to look at it you might consider using
+        -- 'lookupKnownKeyName' or 'isKnownKeyName'.
+        knownKeyNames,
+
+        -- * Miscellaneous
+        wiredInIds, ghcPrimIds,
+        primOpRules, builtinRules,
+
+        ghcPrimExports,
+        primOpId,
+
+        -- * Random other things
+        maybeCharLikeCon, maybeIntLikeCon,
+
+        -- * Class categories
+        isNumericClass, isStandardClass
+
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Builtin.Uniques
+import GHC.Types.Unique ( isValidKnownKeyUnique )
+
+import GHC.Core.ConLike ( ConLike(..) )
+import GHC.Builtin.Names.TH ( templateHaskellNames )
+import GHC.Builtin.Names
+import GHC.Core.Opt.ConstantFold
+import GHC.Types.Avail
+import GHC.Builtin.PrimOps
+import GHC.Core.DataCon
+import GHC.Types.Id
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Id.Make
+import Outputable
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
+import GHC.Driver.Types
+import GHC.Core.Class
+import GHC.Core.TyCon
+import GHC.Types.Unique.FM
+import Util
+import GHC.Builtin.Types.Literals ( typeNatTyCons )
+
+import Control.Applicative ((<|>))
+import Data.List        ( intercalate )
+import Data.Array
+import Data.Maybe
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[builtinNameInfo]{Lookup built-in names}
+*                                                                      *
+************************************************************************
+
+Note [About wired-in things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* Wired-in things are Ids\/TyCons that are completely known to the compiler.
+  They are global values in GHC, (e.g.  listTyCon :: TyCon).
+
+* A wired-in Name contains the thing itself inside the Name:
+        see Name.wiredInNameTyThing_maybe
+  (E.g. listTyConName contains listTyCon.
+
+* The name cache is initialised with (the names of) all wired-in things
+  (except tuples and sums; see Note [Infinite families of known-key names])
+
+* The type environment itself contains no wired in things. The type
+  checker sees if the Name is wired in before looking up the name in
+  the type environment.
+
+* GHC.Iface.Make prunes out wired-in things before putting them in an interface file.
+  So interface files never contain wired-in things.
+-}
+
+
+-- | This list is used to ensure that when you say "Prelude.map" in your source
+-- code, or in an interface file, you get a Name with the correct known key (See
+-- Note [Known-key names] in GHC.Builtin.Names)
+knownKeyNames :: [Name]
+knownKeyNames
+  | debugIsOn
+  , Just badNamesStr <- knownKeyNamesOkay all_names
+  = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
+       -- NB: We can't use ppr here, because this is sometimes evaluated in a
+       -- context where there are no DynFlags available, leading to a cryptic
+       -- "<<details unavailable>>" error. (This seems to happen only in the
+       -- stage 2 compiler, for reasons I [Richard] have no clue of.)
+  | otherwise
+  = all_names
+  where
+    all_names =
+      concat [ wired_tycon_kk_names funTyCon
+             , concatMap wired_tycon_kk_names primTyCons
+
+             , concatMap wired_tycon_kk_names wiredInTyCons
+               -- Does not include tuples
+
+             , concatMap wired_tycon_kk_names typeNatTyCons
+
+             , map idName wiredInIds
+             , map (idName . primOpId) allThePrimOps
+             , map (idName . primOpWrapperId) allThePrimOps
+             , basicKnownKeyNames
+             , templateHaskellNames
+             ]
+    -- All of the names associated with a wired-in TyCon.
+    -- This includes the TyCon itself, its DataCons and promoted TyCons.
+    wired_tycon_kk_names :: TyCon -> [Name]
+    wired_tycon_kk_names tc =
+        tyConName tc : (rep_names tc ++ implicits)
+      where implicits = concatMap thing_kk_names (implicitTyConThings tc)
+
+    wired_datacon_kk_names :: DataCon -> [Name]
+    wired_datacon_kk_names dc =
+      dataConName dc : rep_names (promoteDataCon dc)
+
+    thing_kk_names :: TyThing -> [Name]
+    thing_kk_names (ATyCon tc)                 = wired_tycon_kk_names tc
+    thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc
+    thing_kk_names thing                       = [getName thing]
+
+    -- The TyConRepName for a known-key TyCon has a known key,
+    -- but isn't itself an implicit thing.  Yurgh.
+    -- NB: if any of the wired-in TyCons had record fields, the record
+    --     field names would be in a similar situation.  Ditto class ops.
+    --     But it happens that there aren't any
+    rep_names tc = case tyConRepName_maybe tc of
+                        Just n  -> [n]
+                        Nothing -> []
+
+-- | Check the known-key names list of consistency.
+knownKeyNamesOkay :: [Name] -> Maybe String
+knownKeyNamesOkay all_names
+  | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
+  = Just $ "    Out-of-range known-key uniques: ["
+        ++ intercalate ", " (map (occNameString . nameOccName) ns) ++
+         "]"
+  | null badNamesPairs
+  = Nothing
+  | otherwise
+  = Just badNamesStr
+  where
+    namesEnv      = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n)
+                           emptyUFM all_names
+    badNamesEnv   = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv
+    badNamesPairs = nonDetUFMToList badNamesEnv
+      -- It's OK to use nonDetUFMToList here because the ordering only affects
+      -- the message when we get a panic
+    badNamesStrs  = map pairToStr badNamesPairs
+    badNamesStr   = unlines badNamesStrs
+
+    pairToStr (uniq, ns) = "        " ++
+                           show uniq ++
+                           ": [" ++
+                           intercalate ", " (map (occNameString . nameOccName) ns) ++
+                           "]"
+
+-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
+-- known-key thing.
+lookupKnownKeyName :: Unique -> Maybe Name
+lookupKnownKeyName u =
+    knownUniqueName u <|> lookupUFM knownKeysMap u
+
+-- | Is a 'Name' known-key?
+isKnownKeyName :: Name -> Bool
+isKnownKeyName n =
+    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
+
+knownKeysMap :: UniqFM Name
+knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]
+
+-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
+-- GHCi's ':info' command.
+lookupKnownNameInfo :: Name -> SDoc
+lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
+    -- If we do find a doc, we add comment delimiters to make the output
+    -- of ':info' valid Haskell.
+    Nothing  -> empty
+    Just doc -> vcat [text "{-", doc, text "-}"]
+
+-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
+knownNamesInfo :: NameEnv SDoc
+knownNamesInfo = unitNameEnv coercibleTyConName $
+    vcat [ text "Coercible is a special constraint with custom solving rules."
+         , text "It is not a class."
+         , text "Please see section `The Coercible constraint`"
+         , text "of the user's guide for details." ]
+
+{-
+We let a lot of "non-standard" values be visible, so that we can make
+sense of them in interface pragmas. It's cool, though they all have
+"non-standard" names, so they won't get past the parser in user code.
+
+************************************************************************
+*                                                                      *
+                PrimOpIds
+*                                                                      *
+************************************************************************
+-}
+
+primOpIds :: Array Int Id
+-- A cache of the PrimOp Ids, indexed by PrimOp tag
+primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
+                                   | op <- allThePrimOps ]
+
+primOpId :: PrimOp -> Id
+primOpId op = primOpIds ! primOpTag op
+
+{-
+************************************************************************
+*                                                                      *
+            Export lists for pseudo-modules (GHC.Prim)
+*                                                                      *
+************************************************************************
+
+GHC.Prim "exports" all the primops and primitive types, some
+wired-in Ids.
+-}
+
+ghcPrimExports :: [IfaceExport]
+ghcPrimExports
+ = map (avail . idName) ghcPrimIds ++
+   map (avail . idName . primOpId) allThePrimOps ++
+   [ AvailTC n [n] []
+   | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc  ]
+
+{-
+************************************************************************
+*                                                                      *
+            Built-in keys
+*                                                                      *
+************************************************************************
+
+ToDo: make it do the ``like'' part properly (as in 0.26 and before).
+-}
+
+maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
+maybeCharLikeCon con = con `hasKey` charDataConKey
+maybeIntLikeCon  con = con `hasKey` intDataConKey
+
+{-
+************************************************************************
+*                                                                      *
+            Class predicates
+*                                                                      *
+************************************************************************
+-}
+
+isNumericClass, isStandardClass :: Class -> Bool
+
+isNumericClass     clas = classKey clas `is_elem` numericClassKeys
+isStandardClass    clas = classKey clas `is_elem` standardClassKeys
+
+is_elem :: Eq a => a -> [a] -> Bool
+is_elem = isIn "is_X_Class"
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
new file mode 100644
index 0000000000..a29fbf48d7
--- /dev/null
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -0,0 +1,3841 @@
+-----------------------------------------------------------------------
+--
+-- (c) 2010 The University of Glasgow
+--
+-- Primitive Operations and Types
+--
+-- For more information on PrimOps, see
+--   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/prim-ops
+--
+-----------------------------------------------------------------------
+
+-- This file is processed by the utility program genprimopcode to produce
+-- a number of include files within the compiler and optionally to produce
+-- human-readable documentation.
+--
+-- It should first be preprocessed.
+--
+-- Information on how PrimOps are implemented and the steps necessary to
+-- add a new one can be found in the Commentary:
+--
+--  https://gitlab.haskell.org/ghc/ghc/wikis/commentary/prim-ops
+--
+-- Note in particular that Haskell block-style comments are not recognized
+-- here, so stick to '--' (even for Notes spanning multiple lines).
+
+-- This file is divided into named sections, each containing or more
+-- primop entries. Section headers have the format:
+--
+--      section "section-name" {description}
+--
+-- This information is used solely when producing documentation; it is
+-- otherwise ignored.  The description is optional.
+--
+-- The format of each primop entry is as follows:
+--
+--      primop internal-name "name-in-program-text" category type {description} attributes
+
+-- The default attribute values which apply if you don't specify
+-- other ones.  Attribute values can be True, False, or arbitrary
+-- text between curly brackets.  This is a kludge to enable
+-- processors of this file to easily get hold of simple info
+-- (eg, out_of_line), whilst avoiding parsing complex expressions
+-- needed for strictness info.
+--
+-- type refers to the general category of the primop. Valid settings include,
+--
+--  * Compare:   A comparison operation of the shape a -> a -> Int#
+--  * Monadic:   A unary operation of shape a -> a
+--  * Dyadic:    A binary operation of shape a -> a -> a
+--  * GenPrimOp: Any other sort of primop
+--
+
+-- The vector attribute is rather special. It takes a list of 3-tuples, each of
+-- which is of the form <ELEM_TYPE,SCALAR_TYPE,LENGTH>. ELEM_TYPE is the type of
+-- the elements in the vector; LENGTH is the length of the vector; and
+-- SCALAR_TYPE is the scalar type used to inject to/project from vector
+-- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example,
+-- to broadcast a scalar value to a vector whose elements are of type Int8, we
+-- use an Int#.
+
+-- When a primtype or primop has a vector attribute, it is instantiated at each
+-- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to
+-- define a family of types or primops. Vector support also adds three new
+-- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types
+-- derived from the 3-tuple. For the 3-tuple <Int64,INT64,2>, VECTOR expands to
+-- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64
+-- #).
+
+defaults
+   has_side_effects = False
+   out_of_line      = False   -- See Note [When do out-of-line primops go in primops.txt.pp]
+   can_fail         = False   -- See Note [PrimOp can_fail and has_side_effects] in PrimOp
+   commutable       = False
+   code_size        = { primOpCodeSizeDefault }
+   strictness       = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topDiv }
+   fixity           = Nothing
+   llvm_only        = False
+   vector           = []
+   deprecated_msg   = {}      -- A non-empty message indicates deprecation
+
+
+-- Note [When do out-of-line primops go in primops.txt.pp]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Out of line primops are those with a C-- implementation. But that
+-- doesn't mean they *just* have an C-- implementation. As mentioned in
+-- Note [Inlining out-of-line primops and heap checks], some out-of-line
+-- primops also have additional internal implementations under certain
+-- conditions. Now that `foreign import prim` exists, only those primops
+-- which have both internal and external implementations ought to be
+-- this file. The rest aren't really primops, since they don't need
+-- bespoke compiler support but just a general way to interface with
+-- C--. They are just foreign calls.
+--
+-- Unfortunately, for the time being most of the primops which should be
+-- moved according to the previous paragraph can't yet. There are some
+-- superficial restrictions in `foreign import prim` which mus be fixed
+-- first. Specifically, `foreign import prim` always requires:
+--
+--   - No polymorphism in type
+--   - `strictness       = <default>`
+--   - `can_fail         = False`
+--   - `has_side_effects = True`
+--
+-- https://gitlab.haskell.org/ghc/ghc/issues/16929 tracks this issue,
+-- and has a table of which external-only primops are blocked by which
+-- of these. Hopefully those restrictions are relaxed so the rest of
+-- those can be moved over.
+--
+-- 'module GHC.Prim.Ext is a temporarily "holding ground" for primops
+-- that were formally in here, until they can be given a better home.
+-- Likewise, their underlying C-- implementation need not live in the
+-- RTS either. Best case (in my view), both the C-- and `foreign import
+-- prim` can be moved to a small library tailured to the features being
+-- implemented and dependencies of those features.
+
+-- Currently, documentation is produced using latex, so contents of
+-- description fields should be legal latex. Descriptions can contain
+-- matched pairs of embedded curly brackets.
+
+#include "MachDeps.h"
+
+section "The word size story."
+        {Haskell98 specifies that signed integers (type {\tt Int})
+         must contain at least 30 bits. GHC always implements {\tt
+         Int} using the primitive type {\tt Int\#}, whose size equals
+         the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}.
+         This is normally set based on the {\tt config.h} parameter
+         {\tt SIZEOF\_HSWORD}, i.e., 32 bits on 32-bit machines, 64
+         bits on 64-bit machines.  However, it can also be explicitly
+         set to a smaller number than 64, e.g., 62 bits, to allow the
+         possibility of using tag bits. Currently GHC itself has only
+         32-bit and 64-bit variants, but 61, 62, or 63-bit code can be
+         exported as an external core file for use in other back ends.
+         30 and 31-bit code is no longer supported.
+
+         GHC also implements a primitive unsigned integer type {\tt
+         Word\#} which always has the same number of bits as {\tt
+         Int\#}.
+
+         In addition, GHC supports families of explicit-sized integers
+         and words at 8, 16, 32, and 64 bits, with the usual
+         arithmetic operations, comparisons, and a range of
+         conversions.  The 8-bit and 16-bit sizes are always
+         represented as {\tt Int\#} and {\tt Word\#}, and the
+         operations implemented in terms of the primops on these
+         types, with suitable range restrictions on the results (using
+         the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families
+         of primops.  The 32-bit sizes are represented using {\tt
+         Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS}
+         $\geq$ 32; otherwise, these are represented using distinct
+         primitive types {\tt Int32\#} and {\tt Word32\#}. These (when
+         needed) have a complete set of corresponding operations;
+         however, nearly all of these are implemented as external C
+         functions rather than as primops.  Exactly the same story
+         applies to the 64-bit sizes.  All of these details are hidden
+         under the {\tt PrelInt} and {\tt PrelWord} modules, which use
+         {\tt \#if}-defs to invoke the appropriate types and
+         operators.
+
+         Word size also matters for the families of primops for
+         indexing/reading/writing fixed-size quantities at offsets
+         from an array base, address, or foreign pointer.  Here, a
+         slightly different approach is taken.  The names of these
+         primops are fixed, but their {\it types} vary according to
+         the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if word
+         size is at least 32 bits then an operator like
+         \texttt{indexInt32Array\#} has type {\tt ByteArray\# -> Int\#
+         -> Int\#}; otherwise it has type {\tt ByteArray\# -> Int\# ->
+         Int32\#}.  This approach confines the necessary {\tt
+         \#if}-defs to this file; no conditional compilation is needed
+         in the files that expose these primops.
+
+         Finally, there are strongly deprecated primops for coercing
+         between {\tt Addr\#}, the primitive type of machine
+         addresses, and {\tt Int\#}.  These are pretty bogus anyway,
+         but will work on existing 32-bit and 64-bit GHC targets; they
+         are completely bogus when tag bits are used in {\tt Int\#},
+         so are not available in this case.  }
+
+-- Define synonyms for indexing ops.
+
+#define INT32 Int#
+#define WORD32 Word#
+
+#if WORD_SIZE_IN_BITS < 64
+#define INT64 Int64#
+#define WORD64 Word64#
+#else
+#define INT64 Int#
+#define WORD64 Word#
+#endif
+
+-- This type won't be exported directly (since there is no concrete
+-- syntax for this sort of export) so we'll have to manually patch
+-- export lists in both GHC and Haddock.
+primtype (->) a b
+  {The builtin function type, written in infix form as {\tt a -> b} and
+   in prefix form as {\tt (->) a b}. Values of this type are functions
+   taking inputs of type {\tt a} and producing outputs of type {\tt b}.
+
+   Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and
+   {\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded.
+  }
+  with fixity = infixr -1
+         -- This fixity is only the one picked up by Haddock. If you
+         -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'.
+
+------------------------------------------------------------------------
+section "Char#"
+        {Operations on 31-bit characters.}
+------------------------------------------------------------------------
+
+primtype Char#
+
+primop   CharGtOp  "gtChar#"   Compare   Char# -> Char# -> Int#
+primop   CharGeOp  "geChar#"   Compare   Char# -> Char# -> Int#
+
+primop   CharEqOp  "eqChar#"   Compare
+   Char# -> Char# -> Int#
+   with commutable = True
+
+primop   CharNeOp  "neChar#"   Compare
+   Char# -> Char# -> Int#
+   with commutable = True
+
+primop   CharLtOp  "ltChar#"   Compare   Char# -> Char# -> Int#
+primop   CharLeOp  "leChar#"   Compare   Char# -> Char# -> Int#
+
+primop   OrdOp   "ord#"  GenPrimOp   Char# -> Int#
+   with code_size = 0
+
+------------------------------------------------------------------------
+section "Int8#"
+        {Operations on 8-bit integers.}
+------------------------------------------------------------------------
+
+primtype Int8#
+
+primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
+primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
+
+primop Int8NegOp "negateInt8#" Monadic Int8# -> Int8#
+
+primop Int8AddOp "plusInt8#" Dyadic Int8# -> Int8# -> Int8#
+  with
+    commutable = True
+
+primop Int8SubOp "subInt8#" Dyadic Int8# -> Int8# -> Int8#
+
+primop Int8MulOp "timesInt8#" Dyadic Int8# -> Int8# -> Int8#
+  with
+    commutable = True
+
+primop Int8QuotOp "quotInt8#" Dyadic Int8# -> Int8# -> Int8#
+  with
+    can_fail = True
+
+primop Int8RemOp "remInt8#" Dyadic Int8# -> Int8# -> Int8#
+  with
+    can_fail = True
+
+primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8# #)
+  with
+    can_fail = True
+
+primop Int8EqOp "eqInt8#" Compare Int8# -> Int8# -> Int#
+primop Int8GeOp "geInt8#" Compare Int8# -> Int8# -> Int#
+primop Int8GtOp "gtInt8#" Compare Int8# -> Int8# -> Int#
+primop Int8LeOp "leInt8#" Compare Int8# -> Int8# -> Int#
+primop Int8LtOp "ltInt8#" Compare Int8# -> Int8# -> Int#
+primop Int8NeOp "neInt8#" Compare Int8# -> Int8# -> Int#
+
+------------------------------------------------------------------------
+section "Word8#"
+        {Operations on 8-bit unsigned integers.}
+------------------------------------------------------------------------
+
+primtype Word8#
+
+primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
+primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
+
+primop Word8NotOp "notWord8#" Monadic Word8# -> Word8#
+
+primop Word8AddOp "plusWord8#" Dyadic Word8# -> Word8# -> Word8#
+  with
+    commutable = True
+
+primop Word8SubOp "subWord8#" Dyadic Word8# -> Word8# -> Word8#
+
+primop Word8MulOp "timesWord8#" Dyadic Word8# -> Word8# -> Word8#
+  with
+    commutable = True
+
+primop Word8QuotOp "quotWord8#" Dyadic Word8# -> Word8# -> Word8#
+  with
+    can_fail = True
+
+primop Word8RemOp "remWord8#" Dyadic Word8# -> Word8# -> Word8#
+  with
+    can_fail = True
+
+primop Word8QuotRemOp "quotRemWord8#" GenPrimOp Word8# -> Word8# -> (# Word8#, Word8# #)
+  with
+    can_fail = True
+
+primop Word8EqOp "eqWord8#" Compare Word8# -> Word8# -> Int#
+primop Word8GeOp "geWord8#" Compare Word8# -> Word8# -> Int#
+primop Word8GtOp "gtWord8#" Compare Word8# -> Word8# -> Int#
+primop Word8LeOp "leWord8#" Compare Word8# -> Word8# -> Int#
+primop Word8LtOp "ltWord8#" Compare Word8# -> Word8# -> Int#
+primop Word8NeOp "neWord8#" Compare Word8# -> Word8# -> Int#
+
+------------------------------------------------------------------------
+section "Int16#"
+        {Operations on 16-bit integers.}
+------------------------------------------------------------------------
+
+primtype Int16#
+
+primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int#
+primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16#
+
+primop Int16NegOp "negateInt16#" Monadic Int16# -> Int16#
+
+primop Int16AddOp "plusInt16#" Dyadic Int16# -> Int16# -> Int16#
+  with
+    commutable = True
+
+primop Int16SubOp "subInt16#" Dyadic Int16# -> Int16# -> Int16#
+
+primop Int16MulOp "timesInt16#" Dyadic Int16# -> Int16# -> Int16#
+  with
+    commutable = True
+
+primop Int16QuotOp "quotInt16#" Dyadic Int16# -> Int16# -> Int16#
+  with
+    can_fail = True
+
+primop Int16RemOp "remInt16#" Dyadic Int16# -> Int16# -> Int16#
+  with
+    can_fail = True
+
+primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, Int16# #)
+  with
+    can_fail = True
+
+primop Int16EqOp "eqInt16#" Compare Int16# -> Int16# -> Int#
+primop Int16GeOp "geInt16#" Compare Int16# -> Int16# -> Int#
+primop Int16GtOp "gtInt16#" Compare Int16# -> Int16# -> Int#
+primop Int16LeOp "leInt16#" Compare Int16# -> Int16# -> Int#
+primop Int16LtOp "ltInt16#" Compare Int16# -> Int16# -> Int#
+primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int#
+
+------------------------------------------------------------------------
+section "Word16#"
+        {Operations on 16-bit unsigned integers.}
+------------------------------------------------------------------------
+
+primtype Word16#
+
+primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
+primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
+
+primop Word16NotOp "notWord16#" Monadic Word16# -> Word16#
+
+primop Word16AddOp "plusWord16#" Dyadic Word16# -> Word16# -> Word16#
+  with
+    commutable = True
+
+primop Word16SubOp "subWord16#" Dyadic Word16# -> Word16# -> Word16#
+
+primop Word16MulOp "timesWord16#" Dyadic Word16# -> Word16# -> Word16#
+  with
+    commutable = True
+
+primop Word16QuotOp "quotWord16#" Dyadic Word16# -> Word16# -> Word16#
+  with
+    can_fail = True
+
+primop Word16RemOp "remWord16#" Dyadic Word16# -> Word16# -> Word16#
+  with
+    can_fail = True
+
+primop Word16QuotRemOp "quotRemWord16#" GenPrimOp Word16# -> Word16# -> (# Word16#, Word16# #)
+  with
+    can_fail = True
+
+primop Word16EqOp "eqWord16#" Compare Word16# -> Word16# -> Int#
+primop Word16GeOp "geWord16#" Compare Word16# -> Word16# -> Int#
+primop Word16GtOp "gtWord16#" Compare Word16# -> Word16# -> Int#
+primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int#
+primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int#
+primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int#
+
+#if WORD_SIZE_IN_BITS < 64
+------------------------------------------------------------------------
+section "Int64#"
+        {Operations on 64-bit unsigned words. This type is only used
+         if plain {\tt Int\#} has less than 64 bits. In any case, the operations
+         are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primtype Int64#
+
+------------------------------------------------------------------------
+section "Word64#"
+        {Operations on 64-bit unsigned words. This type is only used
+         if plain {\tt Word\#} has less than 64 bits. In any case, the operations
+         are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primtype Word64#
+
+#endif
+
+------------------------------------------------------------------------
+section "Int#"
+        {Operations on native-size integers (32+ bits).}
+------------------------------------------------------------------------
+
+primtype Int#
+
+primop   IntAddOp    "+#"    Dyadic
+   Int# -> Int# -> Int#
+   with commutable = True
+        fixity = infixl 6
+
+primop   IntSubOp    "-#"    Dyadic   Int# -> Int# -> Int#
+   with fixity = infixl 6
+
+primop   IntMulOp    "*#"
+   Dyadic   Int# -> Int# -> Int#
+   {Low word of signed integer multiply.}
+   with commutable = True
+        fixity = infixl 7
+
+primop   IntMul2Op    "timesInt2#" GenPrimOp
+   Int# -> Int# -> (# Int#, Int#, Int# #)
+   {Return a triple (isHighNeeded,high,low) where high and low are respectively
+   the high and low bits of the double-word result. isHighNeeded is a cheap way
+   to test if the high word is a sign-extension of the low word (isHighNeeded =
+   0#) or not (isHighNeeded = 1#).}
+
+primop   IntMulMayOfloOp  "mulIntMayOflo#"
+   Dyadic   Int# -> Int# -> Int#
+   {Return non-zero if there is any possibility that the upper word of a
+    signed integer multiply might contain useful information.  Return
+    zero only if you are completely sure that no overflow can occur.
+    On a 32-bit platform, the recommended implementation is to do a
+    32 x 32 -> 64 signed multiply, and subtract result[63:32] from
+    (result[31] >>signed 31).  If this is zero, meaning that the
+    upper word is merely a sign extension of the lower one, no
+    overflow can occur.
+
+    On a 64-bit platform it is not always possible to
+    acquire the top 64 bits of the result.  Therefore, a recommended
+    implementation is to take the absolute value of both operands, and
+    return 0 iff bits[63:31] of them are zero, since that means that their
+    magnitudes fit within 31 bits, so the magnitude of the product must fit
+    into 62 bits.
+
+    If in doubt, return non-zero, but do make an effort to create the
+    correct answer for small args, since otherwise the performance of
+    \texttt{(*) :: Integer -> Integer -> Integer} will be poor.
+   }
+   with commutable = True
+
+primop   IntQuotOp    "quotInt#"    Dyadic
+   Int# -> Int# -> Int#
+   {Rounds towards zero. The behavior is undefined if the second argument is
+    zero.
+   }
+   with can_fail = True
+
+primop   IntRemOp    "remInt#"    Dyadic
+   Int# -> Int# -> Int#
+   {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}. The
+    behavior is undefined if the second argument is zero.
+   }
+   with can_fail = True
+
+primop   IntQuotRemOp "quotRemInt#"    GenPrimOp
+   Int# -> Int# -> (# Int#, Int# #)
+   {Rounds towards zero.}
+   with can_fail = True
+
+primop   AndIOp   "andI#"   Dyadic    Int# -> Int# -> Int#
+   {Bitwise "and".}
+   with commutable = True
+
+primop   OrIOp   "orI#"     Dyadic    Int# -> Int# -> Int#
+   {Bitwise "or".}
+   with commutable = True
+
+primop   XorIOp   "xorI#"   Dyadic    Int# -> Int# -> Int#
+   {Bitwise "xor".}
+   with commutable = True
+
+primop   NotIOp   "notI#"   Monadic   Int# -> Int#
+   {Bitwise "not", also known as the binary complement.}
+
+primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
+   {Unary negation.
+    Since the negative {\tt Int#} range extends one further than the
+    positive range, {\tt negateInt#} of the most negative number is an
+    identity operation. This way, {\tt negateInt#} is always its own inverse.}
+
+primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
+         {Add signed integers reporting overflow.
+          First member of result is the sum truncated to an {\tt Int#};
+          second member is zero if the true sum fits in an {\tt Int#},
+          nonzero if overflow occurred (the sum is either too large
+          or too small to fit in an {\tt Int#}).}
+   with code_size = 2
+        commutable = True
+
+primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
+         {Subtract signed integers reporting overflow.
+          First member of result is the difference truncated to an {\tt Int#};
+          second member is zero if the true difference fits in an {\tt Int#},
+          nonzero if overflow occurred (the difference is either too large
+          or too small to fit in an {\tt Int#}).}
+   with code_size = 2
+
+primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Int#
+   with fixity = infix 4
+
+primop   IntGeOp  ">=#"   Compare   Int# -> Int# -> Int#
+   with fixity = infix 4
+
+primop   IntEqOp  "==#"   Compare
+   Int# -> Int# -> Int#
+   with commutable = True
+        fixity = infix 4
+
+primop   IntNeOp  "/=#"   Compare
+   Int# -> Int# -> Int#
+   with commutable = True
+        fixity = infix 4
+
+primop   IntLtOp  "<#"   Compare   Int# -> Int# -> Int#
+   with fixity = infix 4
+
+primop   IntLeOp  "<=#"   Compare   Int# -> Int# -> Int#
+   with fixity = infix 4
+
+primop   ChrOp   "chr#"   GenPrimOp   Int# -> Char#
+   with code_size = 0
+
+primop   Int2WordOp "int2Word#" GenPrimOp Int# -> Word#
+   with code_size = 0
+
+primop   Int2FloatOp   "int2Float#"      GenPrimOp  Int# -> Float#
+primop   Int2DoubleOp   "int2Double#"          GenPrimOp  Int# -> Double#
+
+primop   Word2FloatOp   "word2Float#"      GenPrimOp  Word# -> Float#
+primop   Word2DoubleOp   "word2Double#"          GenPrimOp  Word# -> Double#
+
+primop   ISllOp   "uncheckedIShiftL#" GenPrimOp  Int# -> Int# -> Int#
+         {Shift left.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
+primop   ISraOp   "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
+         {Shift right arithmetic.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
+primop   ISrlOp   "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
+         {Shift right logical.  Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
+
+------------------------------------------------------------------------
+section "Word#"
+        {Operations on native-sized unsigned words (32+ bits).}
+------------------------------------------------------------------------
+
+primtype Word#
+
+primop   WordAddOp   "plusWord#"   Dyadic   Word# -> Word# -> Word#
+   with commutable = True
+
+primop   WordAddCOp   "addWordC#"   GenPrimOp   Word# -> Word# -> (# Word#, Int# #)
+         {Add unsigned integers reporting overflow.
+          The first element of the pair is the result.  The second element is
+          the carry flag, which is nonzero on overflow. See also {\tt plusWord2#}.}
+   with code_size = 2
+        commutable = True
+
+primop   WordSubCOp   "subWordC#"   GenPrimOp   Word# -> Word# -> (# Word#, Int# #)
+         {Subtract unsigned integers reporting overflow.
+          The first element of the pair is the result.  The second element is
+          the carry flag, which is nonzero on overflow.}
+   with code_size = 2
+
+primop   WordAdd2Op   "plusWord2#"   GenPrimOp   Word# -> Word# -> (# Word#, Word# #)
+         {Add unsigned integers, with the high part (carry) in the first
+          component of the returned pair and the low part in the second
+          component of the pair. See also {\tt addWordC#}.}
+   with code_size = 2
+        commutable = True
+
+primop   WordSubOp   "minusWord#"   Dyadic   Word# -> Word# -> Word#
+
+primop   WordMulOp   "timesWord#"   Dyadic   Word# -> Word# -> Word#
+   with commutable = True
+
+-- Returns (# high, low #)
+primop   WordMul2Op  "timesWord2#"   GenPrimOp
+   Word# -> Word# -> (# Word#, Word# #)
+   with commutable = True
+
+primop   WordQuotOp   "quotWord#"   Dyadic   Word# -> Word# -> Word#
+   with can_fail = True
+
+primop   WordRemOp   "remWord#"   Dyadic   Word# -> Word# -> Word#
+   with can_fail = True
+
+primop   WordQuotRemOp "quotRemWord#" GenPrimOp
+   Word# -> Word# -> (# Word#, Word# #)
+   with can_fail = True
+
+primop   WordQuotRem2Op "quotRemWord2#" GenPrimOp
+   Word# -> Word# -> Word# -> (# Word#, Word# #)
+         { Takes high word of dividend, then low word of dividend, then divisor.
+           Requires that high word < divisor.}
+   with can_fail = True
+
+primop   AndOp   "and#"   Dyadic   Word# -> Word# -> Word#
+   with commutable = True
+
+primop   OrOp   "or#"   Dyadic   Word# -> Word# -> Word#
+   with commutable = True
+
+primop   XorOp   "xor#"   Dyadic   Word# -> Word# -> Word#
+   with commutable = True
+
+primop   NotOp   "not#"   Monadic   Word# -> Word#
+
+primop   SllOp   "uncheckedShiftL#"   GenPrimOp   Word# -> Int# -> Word#
+         {Shift left logical.   Result undefined if shift amount is not
+          in the range 0 to word size - 1 inclusive.}
+primop   SrlOp   "uncheckedShiftRL#"   GenPrimOp   Word# -> Int# -> Word#
+         {Shift right logical.   Result undefined if shift  amount is not
+          in the range 0 to word size - 1 inclusive.}
+
+primop   Word2IntOp   "word2Int#"   GenPrimOp   Word# -> Int#
+   with code_size = 0
+
+primop   WordGtOp   "gtWord#"   Compare   Word# -> Word# -> Int#
+primop   WordGeOp   "geWord#"   Compare   Word# -> Word# -> Int#
+primop   WordEqOp   "eqWord#"   Compare   Word# -> Word# -> Int#
+primop   WordNeOp   "neWord#"   Compare   Word# -> Word# -> Int#
+primop   WordLtOp   "ltWord#"   Compare   Word# -> Word# -> Int#
+primop   WordLeOp   "leWord#"   Compare   Word# -> Word# -> Int#
+
+primop   PopCnt8Op   "popCnt8#"   Monadic   Word# -> Word#
+    {Count the number of set bits in the lower 8 bits of a word.}
+primop   PopCnt16Op   "popCnt16#"   Monadic   Word# -> Word#
+    {Count the number of set bits in the lower 16 bits of a word.}
+primop   PopCnt32Op   "popCnt32#"   Monadic   Word# -> Word#
+    {Count the number of set bits in the lower 32 bits of a word.}
+primop   PopCnt64Op   "popCnt64#"   GenPrimOp   WORD64 -> Word#
+    {Count the number of set bits in a 64-bit word.}
+primop   PopCntOp   "popCnt#"   Monadic   Word# -> Word#
+    {Count the number of set bits in a word.}
+
+primop   Pdep8Op   "pdep8#"   Dyadic   Word# -> Word# -> Word#
+    {Deposit bits to lower 8 bits of a word at locations specified by a mask.}
+primop   Pdep16Op   "pdep16#"   Dyadic   Word# -> Word# -> Word#
+    {Deposit bits to lower 16 bits of a word at locations specified by a mask.}
+primop   Pdep32Op   "pdep32#"   Dyadic   Word# -> Word# -> Word#
+    {Deposit bits to lower 32 bits of a word at locations specified by a mask.}
+primop   Pdep64Op   "pdep64#"   GenPrimOp   WORD64 -> WORD64 -> WORD64
+    {Deposit bits to a word at locations specified by a mask.}
+primop   PdepOp   "pdep#"   Dyadic   Word# -> Word# -> Word#
+    {Deposit bits to a word at locations specified by a mask.}
+
+primop   Pext8Op   "pext8#"   Dyadic   Word# -> Word# -> Word#
+    {Extract bits from lower 8 bits of a word at locations specified by a mask.}
+primop   Pext16Op   "pext16#"   Dyadic   Word# -> Word# -> Word#
+    {Extract bits from lower 16 bits of a word at locations specified by a mask.}
+primop   Pext32Op   "pext32#"   Dyadic   Word# -> Word# -> Word#
+    {Extract bits from lower 32 bits of a word at locations specified by a mask.}
+primop   Pext64Op   "pext64#"   GenPrimOp   WORD64 -> WORD64 -> WORD64
+    {Extract bits from a word at locations specified by a mask.}
+primop   PextOp   "pext#"   Dyadic   Word# -> Word# -> Word#
+    {Extract bits from a word at locations specified by a mask.}
+
+primop   Clz8Op   "clz8#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 8 bits of a word.}
+primop   Clz16Op   "clz16#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 16 bits of a word.}
+primop   Clz32Op   "clz32#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 32 bits of a word.}
+primop   Clz64Op   "clz64#" GenPrimOp WORD64 -> Word#
+    {Count leading zeros in a 64-bit word.}
+primop   ClzOp     "clz#"   Monadic   Word# -> Word#
+    {Count leading zeros in a word.}
+
+primop   Ctz8Op   "ctz8#"  Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 8 bits of a word.}
+primop   Ctz16Op   "ctz16#" Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 16 bits of a word.}
+primop   Ctz32Op   "ctz32#" Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 32 bits of a word.}
+primop   Ctz64Op   "ctz64#" GenPrimOp WORD64 -> Word#
+    {Count trailing zeros in a 64-bit word.}
+primop   CtzOp     "ctz#"   Monadic   Word# -> Word#
+    {Count trailing zeros in a word.}
+
+primop   BSwap16Op   "byteSwap16#"   Monadic   Word# -> Word#
+    {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. }
+primop   BSwap32Op   "byteSwap32#"   Monadic   Word# -> Word#
+    {Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. }
+primop   BSwap64Op   "byteSwap64#"   Monadic   WORD64 -> WORD64
+    {Swap bytes in a 64 bits of a word.}
+primop   BSwapOp     "byteSwap#"     Monadic   Word# -> Word#
+    {Swap bytes in a word.}
+
+primop   BRev8Op    "bitReverse8#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 8-bit word.}
+primop   BRev16Op   "bitReverse16#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 16-bit word.}
+primop   BRev32Op   "bitReverse32#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 32-bit word.}
+primop   BRev64Op   "bitReverse64#"   Monadic   WORD64 -> WORD64
+    {Reverse the order of the bits in a 64-bit word.}
+primop   BRevOp     "bitReverse#"     Monadic   Word# -> Word#
+    {Reverse the order of the bits in a word.}
+
+------------------------------------------------------------------------
+section "Narrowings"
+        {Explicit narrowing of native-sized ints or words.}
+------------------------------------------------------------------------
+
+primop   Narrow8IntOp      "narrow8Int#"      Monadic   Int# -> Int#
+primop   Narrow16IntOp     "narrow16Int#"     Monadic   Int# -> Int#
+primop   Narrow32IntOp     "narrow32Int#"     Monadic   Int# -> Int#
+primop   Narrow8WordOp     "narrow8Word#"     Monadic   Word# -> Word#
+primop   Narrow16WordOp    "narrow16Word#"    Monadic   Word# -> Word#
+primop   Narrow32WordOp    "narrow32Word#"    Monadic   Word# -> Word#
+
+------------------------------------------------------------------------
+section "Double#"
+        {Operations on double-precision (64 bit) floating-point numbers.}
+------------------------------------------------------------------------
+
+primtype Double#
+
+primop   DoubleGtOp ">##"   Compare   Double# -> Double# -> Int#
+   with fixity = infix 4
+
+primop   DoubleGeOp ">=##"   Compare   Double# -> Double# -> Int#
+   with fixity = infix 4
+
+primop DoubleEqOp "==##"   Compare
+   Double# -> Double# -> Int#
+   with commutable = True
+        fixity = infix 4
+
+primop DoubleNeOp "/=##"   Compare
+   Double# -> Double# -> Int#
+   with commutable = True
+        fixity = infix 4
+
+primop   DoubleLtOp "<##"   Compare   Double# -> Double# -> Int#
+   with fixity = infix 4
+
+primop   DoubleLeOp "<=##"   Compare   Double# -> Double# -> Int#
+   with fixity = infix 4
+
+primop   DoubleAddOp   "+##"   Dyadic
+   Double# -> Double# -> Double#
+   with commutable = True
+        fixity = infixl 6
+
+primop   DoubleSubOp   "-##"   Dyadic   Double# -> Double# -> Double#
+   with fixity = infixl 6
+
+primop   DoubleMulOp   "*##"   Dyadic
+   Double# -> Double# -> Double#
+   with commutable = True
+        fixity = infixl 7
+
+primop   DoubleDivOp   "/##"   Dyadic
+   Double# -> Double# -> Double#
+   with can_fail = True
+        fixity = infixl 7
+
+primop   DoubleNegOp   "negateDouble#"  Monadic   Double# -> Double#
+
+primop   DoubleFabsOp  "fabsDouble#"    Monadic   Double# -> Double#
+
+primop   Double2IntOp   "double2Int#"          GenPrimOp  Double# -> Int#
+   {Truncates a {\tt Double#} value to the nearest {\tt Int#}.
+    Results are undefined if the truncation if truncation yields
+    a value outside the range of {\tt Int#}.}
+
+primop   Double2FloatOp   "double2Float#" GenPrimOp Double# -> Float#
+
+primop   DoubleExpOp   "expDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleExpM1Op "expm1Double#"    Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleLogOp   "logDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   DoubleLog1POp   "log1pDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   DoubleSqrtOp   "sqrtDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleSinOp   "sinDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleCosOp   "cosDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleTanOp   "tanDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleAsinOp   "asinDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   DoubleAcosOp   "acosDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   DoubleAtanOp   "atanDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleSinhOp   "sinhDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleCoshOp   "coshDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleTanhOp   "tanhDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleAsinhOp   "asinhDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleAcoshOp   "acoshDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleAtanhOp   "atanhDouble#"      Monadic
+   Double# -> Double#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoublePowerOp   "**##" Dyadic
+   Double# -> Double# -> Double#
+   {Exponentiation.}
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   DoubleDecode_2IntOp   "decodeDouble_2Int#" GenPrimOp
+   Double# -> (# Int#, Word#, Word#, Int# #)
+   {Convert to integer.
+    First component of the result is -1 or 1, indicating the sign of the
+    mantissa. The next two are the high and low 32 bits of the mantissa
+    respectively, and the last is the exponent.}
+   with out_of_line = True
+
+primop   DoubleDecode_Int64Op   "decodeDouble_Int64#" GenPrimOp
+   Double# -> (# INT64, Int# #)
+   {Decode {\tt Double\#} into mantissa and base-2 exponent.}
+   with out_of_line = True
+
+------------------------------------------------------------------------
+section "Float#"
+        {Operations on single-precision (32-bit) floating-point numbers.}
+------------------------------------------------------------------------
+
+primtype Float#
+
+primop   FloatGtOp  "gtFloat#"   Compare   Float# -> Float# -> Int#
+primop   FloatGeOp  "geFloat#"   Compare   Float# -> Float# -> Int#
+
+primop   FloatEqOp  "eqFloat#"   Compare
+   Float# -> Float# -> Int#
+   with commutable = True
+
+primop   FloatNeOp  "neFloat#"   Compare
+   Float# -> Float# -> Int#
+   with commutable = True
+
+primop   FloatLtOp  "ltFloat#"   Compare   Float# -> Float# -> Int#
+primop   FloatLeOp  "leFloat#"   Compare   Float# -> Float# -> Int#
+
+primop   FloatAddOp   "plusFloat#"      Dyadic
+   Float# -> Float# -> Float#
+   with commutable = True
+
+primop   FloatSubOp   "minusFloat#"      Dyadic      Float# -> Float# -> Float#
+
+primop   FloatMulOp   "timesFloat#"      Dyadic
+   Float# -> Float# -> Float#
+   with commutable = True
+
+primop   FloatDivOp   "divideFloat#"      Dyadic
+   Float# -> Float# -> Float#
+   with can_fail = True
+
+primop   FloatNegOp   "negateFloat#"      Monadic    Float# -> Float#
+
+primop   FloatFabsOp  "fabsFloat#"        Monadic    Float# -> Float#
+
+primop   Float2IntOp   "float2Int#"      GenPrimOp  Float# -> Int#
+   {Truncates a {\tt Float#} value to the nearest {\tt Int#}.
+    Results are undefined if the truncation if truncation yields
+    a value outside the range of {\tt Int#}.}
+
+primop   FloatExpOp   "expFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatExpM1Op   "expm1Float#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatLogOp   "logFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   FloatLog1POp  "log1pFloat#"     Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   FloatSqrtOp   "sqrtFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatSinOp   "sinFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatCosOp   "cosFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatTanOp   "tanFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatAsinOp   "asinFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   FloatAcosOp   "acosFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
+
+primop   FloatAtanOp   "atanFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatSinhOp   "sinhFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatCoshOp   "coshFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatTanhOp   "tanhFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatAsinhOp   "asinhFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatAcoshOp   "acoshFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatAtanhOp   "atanhFloat#"      Monadic
+   Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   FloatPowerOp   "powerFloat#"      Dyadic
+   Float# -> Float# -> Float#
+   with
+   code_size = { primOpCodeSizeForeignCall }
+
+primop   Float2DoubleOp   "float2Double#" GenPrimOp  Float# -> Double#
+
+primop   FloatDecode_IntOp   "decodeFloat_Int#" GenPrimOp
+   Float# -> (# Int#, Int# #)
+   {Convert to integers.
+    First {\tt Int\#} in result is the mantissa; second is the exponent.}
+   with out_of_line = True
+
+------------------------------------------------------------------------
+section "Arrays"
+        {Operations on {\tt Array\#}.}
+------------------------------------------------------------------------
+
+primtype Array# a
+
+primtype MutableArray# s a
+
+primop  NewArrayOp "newArray#" GenPrimOp
+   Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
+   {Create a new mutable array with the specified number of elements,
+    in the specified state thread,
+    with each element containing the specified initial value.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameMutableArrayOp "sameMutableArray#" GenPrimOp
+   MutableArray# s a -> MutableArray# s a -> Int#
+
+primop  ReadArrayOp "readArray#" GenPrimOp
+   MutableArray# s a -> Int# -> State# s -> (# State# s, a #)
+   {Read from specified index of mutable array. Result is not yet evaluated.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  WriteArrayOp "writeArray#" GenPrimOp
+   MutableArray# s a -> Int# -> a -> State# s -> State# s
+   {Write to specified index of mutable array.}
+   with
+   has_side_effects = True
+   can_fail         = True
+   code_size        = 2 -- card update too
+
+primop  SizeofArrayOp "sizeofArray#" GenPrimOp
+   Array# a -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofMutableArrayOp "sizeofMutableArray#" GenPrimOp
+   MutableArray# s a -> Int#
+   {Return the number of elements in the array.}
+
+primop  IndexArrayOp "indexArray#" GenPrimOp
+   Array# a -> Int# -> (# a #)
+   {Read from the specified index of an immutable array. The result is packaged
+    into an unboxed unary tuple; the result itself is not yet
+    evaluated. Pattern matching on the tuple forces the indexing of the
+    array to happen but does not evaluate the element itself. Evaluating
+    the thunk prevents additional thunks from building up on the
+    heap. Avoiding these thunks, in turn, reduces references to the
+    argument array, allowing it to be garbage collected more promptly.}
+   with
+   can_fail         = True
+
+primop  UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
+   MutableArray# s a -> State# s -> (# State# s, Array# a #)
+   {Make a mutable array immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  UnsafeThawArrayOp  "unsafeThawArray#" GenPrimOp
+   Array# a -> State# s -> (# State# s, MutableArray# s a #)
+   {Make an immutable array mutable, without copying.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  CopyArrayOp "copyArray#" GenPrimOp
+  Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. The two arrays must not
+   be the same array in different states, but this is not checked
+   either.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CopyMutableArrayOp "copyMutableArray#" GenPrimOp
+  MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. In the case where
+   the source and destination are the same array the source and
+   destination regions may overlap.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneArrayOp "cloneArray#" GenPrimOp
+  Array# a -> Int# -> Int# -> Array# a
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
+  MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  FreezeArrayOp "freezeArray#" GenPrimOp
+  MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  ThawArrayOp "thawArray#" GenPrimOp
+  Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop CasArrayOp  "casArray#" GenPrimOp
+   MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+   {Given an array, an offset, the expected old value, and
+    the new value, perform an atomic compare and swap (i.e. write the new
+    value if the current value and the old value are the same pointer).
+    Returns 0 if the swap succeeds and 1 if it fails. Additionally, returns
+    the element at the offset after the operation completes. This means that
+    on a success the new value is returned, and on a failure the actual old
+    value (not the expected one) is returned. Implies a full memory barrier.
+    The use of a pointer equality on a lifted value makes this function harder
+    to use correctly than {\tt casIntArray\#}. All of the difficulties
+    of using {\tt reallyUnsafePtrEquality\#} correctly apply to
+    {\tt casArray\#} as well.
+   }
+   with
+   out_of_line = True
+   has_side_effects = True
+
+
+------------------------------------------------------------------------
+section "Small Arrays"
+
+        {Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works
+         just like an {\tt Array\#}, but with different space use and
+         performance characteristics (that are often useful with small
+         arrays). The {\tt SmallArray\#} and {\tt SmallMutableArray#}
+         lack a `card table'. The purpose of a card table is to avoid
+         having to scan every element of the array on each GC by
+         keeping track of which elements have changed since the last GC
+         and only scanning those that have changed. So the consequence
+         of there being no card table is that the representation is
+         somewhat smaller and the writes are somewhat faster (because
+         the card table does not need to be updated). The disadvantage
+         of course is that for a {\tt SmallMutableArray#} the whole
+         array has to be scanned on each GC. Thus it is best suited for
+         use cases where the mutable array is not long lived, e.g.
+         where a mutable array is initialised quickly and then frozen
+         to become an immutable {\tt SmallArray\#}.
+        }
+
+------------------------------------------------------------------------
+
+primtype SmallArray# a
+
+primtype SmallMutableArray# s a
+
+primop  NewSmallArrayOp "newSmallArray#" GenPrimOp
+   Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Create a new mutable array with the specified number of elements,
+    in the specified state thread,
+    with each element containing the specified initial value.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
+
+primop  ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> State# s -> State# s
+   {Shrink mutable array to new specified size, in
+    the specified state thread. The new size argument must be less than or
+    equal to the current size as reported by {\tt sizeofSmallMutableArray\#}.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  ReadSmallArrayOp "readSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
+   {Read from specified index of mutable array. Result is not yet evaluated.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  WriteSmallArrayOp "writeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
+   {Write to specified index of mutable array.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
+   SmallArray# a -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> Int#
+   {Return the number of elements in the array. Note that this is deprecated
+   as it is unsafe in the presence of resize operations on the
+   same byte array.}
+   with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead }
+
+primop  GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
+   {Return the number of elements in the array.}
+
+primop  IndexSmallArrayOp "indexSmallArray#" GenPrimOp
+   SmallArray# a -> Int# -> (# a #)
+   {Read from specified index of immutable array. Result is packaged into
+    an unboxed singleton; the result itself is not yet evaluated.}
+   with
+   can_fail         = True
+
+primop  UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
+   {Make a mutable array immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  UnsafeThawSmallArrayOp  "unsafeThawSmallArray#" GenPrimOp
+   SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Make an immutable array mutable, without copying.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+-- The code_size is only correct for the case when the copy family of
+-- primops aren't inlined. It would be nice to keep track of both.
+
+primop  CopySmallArrayOp "copySmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. The two arrays must not
+   be the same array in different states, but this is not checked
+   either.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. The source and destination arrays can
+   refer to the same array. Both arrays must fully contain the
+   specified ranges, but this is not checked.
+   The regions are allowed to overlap, although this is only possible when the same
+   array is provided as both the source and the destination. }
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> SmallArray# a
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  ThawSmallArrayOp "thawSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop CasSmallArrayOp  "casSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+   {Unsafe, machine-level atomic compare and swap on an element within an array.
+    See the documentation of {\tt casArray\#}.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "Byte Arrays"
+        {Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of
+         raw memory in the garbage-collected heap, which is not
+         scanned for pointers. It carries its own size (in bytes).
+         There are
+         three sets of operations for accessing byte array contents:
+         index for reading from immutable byte arrays, and read/write
+         for mutable byte arrays.  Each set contains operations for a
+         range of useful primitive data types.  Each operation takes
+         an offset measured in terms of the size of the primitive type
+         being read or written.}
+
+------------------------------------------------------------------------
+
+primtype ByteArray#
+
+primtype MutableByteArray# s
+
+primop  NewByteArrayOp_Char "newByteArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutableByteArray# s #)
+   {Create a new mutable byte array of specified size (in bytes), in
+    the specified state thread.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutableByteArray# s #)
+   {Create a mutable byte array that the GC guarantees not to move.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp
+   Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
+   {Create a mutable byte array, aligned by the specified amount, that the GC guarantees not to move.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp
+   MutableByteArray# s -> Int#
+   {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move
+   during GC.}
+   with out_of_line = True
+
+primop  ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp
+   ByteArray# -> Int#
+   {Determine whether a {\tt ByteArray\#} is guaranteed not to move during GC.}
+   with out_of_line = True
+
+primop  ByteArrayContents_Char "byteArrayContents#" GenPrimOp
+   ByteArray# -> Addr#
+   {Intended for use with pinned arrays; otherwise very unsafe!}
+
+primop  SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> MutableByteArray# s -> Int#
+
+primop  ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> State# s
+   {Shrink mutable byte array to new specified size (in bytes), in
+    the specified state thread. The new size argument must be less than or
+    equal to the current size as reported by {\tt sizeofMutableByteArray\#}.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
+   {Resize (unpinned) mutable byte array to new specified size (in bytes).
+    The returned {\tt MutableByteArray\#} is either the original
+    {\tt MutableByteArray\#} resized in-place or, if not possible, a newly
+    allocated (unpinned) {\tt MutableByteArray\#} (with the original content
+    copied over).
+
+    To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall
+    not be accessed anymore after a {\tt resizeMutableByteArray\#} has been
+    performed.  Moreover, no reference to the old one should be kept in order
+    to allow garbage collection of the original {\tt MutableByteArray\#} in
+    case a new {\tt MutableByteArray\#} had to be allocated.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
+   MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
+   {Make a mutable byte array immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
+   ByteArray# -> Int#
+   {Return the size of the array in bytes.}
+
+primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int#
+   {Return the size of the array in bytes. Note that this is deprecated as it is
+   unsafe in the presence of resize operations on the same byte
+   array.}
+   with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead }
+
+primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> State# s -> (# State# s, Int# #)
+   {Return the number of elements in the array.}
+
+primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
+   ByteArray# -> Int# -> Char#
+   {Read 8-bit character; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
+   ByteArray# -> Int# -> Char#
+   {Read 31-bit character; offset in 4-byte words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
+   ByteArray# -> Int# -> Int#
+   with can_fail = True
+
+primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
+   ByteArray# -> Int# -> Word#
+   with can_fail = True
+
+primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
+   ByteArray# -> Int# -> Addr#
+   with can_fail = True
+
+primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
+   ByteArray# -> Int# -> Float#
+   with can_fail = True
+
+primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
+   ByteArray# -> Int# -> Double#
+   with can_fail = True
+
+primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
+   ByteArray# -> Int# -> StablePtr# a
+   with can_fail = True
+
+primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
+   ByteArray# -> Int# -> Int#
+   {Read 8-bit integer; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
+   ByteArray# -> Int# -> Int#
+   {Read 16-bit integer; offset in 16-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
+   ByteArray# -> Int# -> INT32
+   {Read 32-bit integer; offset in 32-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
+   ByteArray# -> Int# -> INT64
+   {Read 64-bit integer; offset in 64-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
+   ByteArray# -> Int# -> Word#
+   {Read 8-bit word; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
+   ByteArray# -> Int# -> Word#
+   {Read 16-bit word; offset in 16-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
+   ByteArray# -> Int# -> WORD32
+   {Read 32-bit word; offset in 32-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
+   ByteArray# -> Int# -> WORD64
+   {Read 64-bit word; offset in 64-bit words.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp
+   ByteArray# -> Int# -> Char#
+   {Read 8-bit character; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp
+   ByteArray# -> Int# -> Char#
+   {Read 31-bit character; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp
+   ByteArray# -> Int# -> Addr#
+   {Read address; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp
+   ByteArray# -> Int# -> Float#
+   {Read float; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp
+   ByteArray# -> Int# -> Double#
+   {Read double; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp
+   ByteArray# -> Int# -> StablePtr# a
+   {Read stable pointer; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp
+   ByteArray# -> Int# -> Int#
+   {Read 16-bit int; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp
+   ByteArray# -> Int# -> INT32
+   {Read 32-bit int; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp
+   ByteArray# -> Int# -> INT64
+   {Read 64-bit int; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp
+   ByteArray# -> Int# -> Int#
+   {Read int; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp
+   ByteArray# -> Int# -> Word#
+   {Read 16-bit word; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp
+   ByteArray# -> Int# -> WORD32
+   {Read 32-bit word; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp
+   ByteArray# -> Int# -> WORD64
+   {Read 64-bit word; offset in bytes.}
+   with can_fail = True
+
+primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp
+   ByteArray# -> Int# -> Word#
+   {Read word; offset in bytes.}
+   with can_fail = True
+
+primop  ReadByteArrayOp_Char "readCharArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
+   {Read 8-bit character; offset in bytes.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
+   {Read 31-bit character; offset in 4-byte words.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Int "readIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   {Read integer; offset in machine words.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word "readWordArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   {Read word; offset in machine words.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Float "readFloatArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, INT32 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD32 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, INT32 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD32 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
+   {Write 8-bit character; offset in bytes.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
+   {Write 31-bit character; offset in 4-byte words.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word "writeWordArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> INT32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s
+   with can_fail = True
+        has_side_effects = True
+
+primop  WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> WORD32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
+   MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp
+   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp
+   MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp
+   MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp
+   MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp
+   MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp
+   MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp
+   MutableByteArray# s -> Int# -> INT32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp
+   MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp
+   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp
+   MutableByteArray# s -> Int# -> WORD32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp
+   MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp
+   MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  CompareByteArraysOp "compareByteArrays#" GenPrimOp
+   ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
+   {{\tt compareByteArrays# src1 src1_ofs src2 src2_ofs n} compares
+    {\tt n} bytes starting at offset {\tt src1_ofs} in the first
+    {\tt ByteArray#} {\tt src1} to the range of {\tt n} bytes
+    (i.e. same length) starting at offset {\tt src2_ofs} of the second
+    {\tt ByteArray#} {\tt src2}.  Both arrays must fully contain the
+    specified ranges, but this is not checked.  Returns an {\tt Int#}
+    less than, equal to, or greater than zero if the range is found,
+    respectively, to be byte-wise lexicographically less than, to
+    match, or be greater than the second range.}
+   with
+   can_fail = True
+
+primop  CopyByteArrayOp "copyByteArray#" GenPrimOp
+  ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+  {{\tt copyByteArray# src src_ofs dst dst_ofs n} copies the range
+   starting at offset {\tt src_ofs} of length {\tt n} from the
+   {\tt ByteArray#} {\tt src} to the {\tt MutableByteArray#} {\tt dst}
+   starting at offset {\tt dst_ofs}.  Both arrays must fully contain
+   the specified ranges, but this is not checked.  The two arrays must
+   not be the same array in different states, but this is not checked
+   either.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4}
+  can_fail = True
+
+primop  CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp
+  MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a range of the first MutableByteArray\# to the specified region in the second MutableByteArray\#.
+   Both arrays must fully contain the specified ranges, but this is not checked. The regions are
+   allowed to overlap, although this is only possible when the same array is provided
+   as both the source and the destination.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail = True
+
+primop  CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp
+  ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s
+  {Copy a range of the ByteArray\# to the memory range starting at the Addr\#.
+   The ByteArray\# and the memory region at Addr\# must fully contain the
+   specified ranges, but this is not checked. The Addr\# must not point into the
+   ByteArray\# (e.g. if the ByteArray\# were pinned), but this is not checked
+   either.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4}
+  can_fail = True
+
+primop  CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp
+  MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s
+  {Copy a range of the MutableByteArray\# to the memory range starting at the
+   Addr\#. The MutableByteArray\# and the memory region at Addr\# must fully
+   contain the specified ranges, but this is not checked. The Addr\# must not
+   point into the MutableByteArray\# (e.g. if the MutableByteArray\# were
+   pinned), but this is not checked either.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4}
+  can_fail = True
+
+primop  CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp
+  Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a memory range starting at the Addr\# to the specified range in the
+   MutableByteArray\#. The memory region at Addr\# and the ByteArray\# must fully
+   contain the specified ranges, but this is not checked. The Addr\# must not
+   point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned),
+   but this is not checked either.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4}
+  can_fail = True
+
+primop  SetByteArrayOp "setByteArray#" GenPrimOp
+  MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s
+  {{\tt setByteArray# ba off len c} sets the byte range {\tt [off, off+len]} of
+   the {\tt MutableByteArray#} to the byte {\tt c}.}
+  with
+  has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail = True
+
+-- Atomic operations
+
+primop  AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array and an offset in machine words, read an element. The
+    index is assumed to be in bounds. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   {Given an array and an offset in machine words, write an element. The
+    index is assumed to be in bounds. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, an offset in machine words, the expected old value, and
+    the new value, perform an atomic compare and swap i.e. write the new
+    value if the current value matches the provided old value. Returns
+    the value of the element before the operation. Implies a full memory
+    barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to add,
+    atomically add the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to subtract,
+    atomically subtract the value to the element. Returns the value of
+    the element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to AND,
+    atomically AND the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to NAND,
+    atomically NAND the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to OR,
+    atomically OR the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in machine words, and a value to XOR,
+    atomically XOR the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+
+------------------------------------------------------------------------
+section "Arrays of arrays"
+        {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
+         arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types,
+         just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array\#}.
+         We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific
+         indexing, reading, and writing.}
+------------------------------------------------------------------------
+
+primtype ArrayArray#
+
+primtype MutableArrayArray# s
+
+primop  NewArrayArrayOp "newArrayArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutableArrayArray# s #)
+   {Create a new mutable array of arrays with the specified number of elements,
+    in the specified state thread, with each element recursively referring to the
+    newly created array.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp
+   MutableArrayArray# s -> MutableArrayArray# s -> Int#
+
+primop  UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
+   MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
+   {Make a mutable array of arrays immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp
+   ArrayArray# -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int#
+   {Return the number of elements in the array.}
+
+primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp
+   ArrayArray# -> Int# -> ByteArray#
+   with can_fail = True
+
+primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp
+   ArrayArray# -> Int# -> ArrayArray#
+   with can_fail = True
+
+primop  ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  CopyArrayArrayOp "copyArrayArray#" GenPrimOp
+  ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a range of the ArrayArray\# to the specified region in the MutableArrayArray\#.
+   Both arrays must fully contain the specified ranges, but this is not checked.
+   The two arrays must not be the same array in different states, but this is not checked either.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp
+  MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a range of the first MutableArrayArray# to the specified region in the second
+   MutableArrayArray#.
+   Both arrays must fully contain the specified ranges, but this is not checked.
+   The regions are allowed to overlap, although this is only possible when the same
+   array is provided as both the source and the destination.
+   }
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+------------------------------------------------------------------------
+section "Addr#"
+------------------------------------------------------------------------
+
+primtype Addr#
+        { An arbitrary machine address assumed to point outside
+         the garbage-collected heap. }
+
+pseudoop "nullAddr#" Addr#
+        { The null address. }
+
+primop   AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr#
+primop   AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int#
+         {Result is meaningless if two {\tt Addr\#}s are so far apart that their
+         difference doesn't fit in an {\tt Int\#}.}
+primop   AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
+         {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#},
+          is divided by the {\tt Int\#} arg.}
+primop   Addr2IntOp  "addr2Int#"     GenPrimOp   Addr# -> Int#
+        {Coerce directly from address to int.}
+   with code_size = 0
+        deprecated_msg = { This operation is strongly deprecated. }
+primop   Int2AddrOp   "int2Addr#"    GenPrimOp  Int# -> Addr#
+        {Coerce directly from int to address.}
+   with code_size = 0
+        deprecated_msg = { This operation is strongly deprecated. }
+
+primop   AddrGtOp  "gtAddr#"   Compare   Addr# -> Addr# -> Int#
+primop   AddrGeOp  "geAddr#"   Compare   Addr# -> Addr# -> Int#
+primop   AddrEqOp  "eqAddr#"   Compare   Addr# -> Addr# -> Int#
+primop   AddrNeOp  "neAddr#"   Compare   Addr# -> Addr# -> Int#
+primop   AddrLtOp  "ltAddr#"   Compare   Addr# -> Addr# -> Int#
+primop   AddrLeOp  "leAddr#"   Compare   Addr# -> Addr# -> Int#
+
+primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> Char#
+   {Reads 8-bit character; offset in bytes.}
+   with can_fail = True
+
+primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> Char#
+   {Reads 31-bit character; offset in 4-byte words.}
+   with can_fail = True
+
+primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
+   Addr# -> Int# -> Int#
+   with can_fail = True
+
+primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp
+   Addr# -> Int# -> Word#
+   with can_fail = True
+
+primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp
+   Addr# -> Int# -> Addr#
+   with can_fail = True
+
+primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp
+   Addr# -> Int# -> Float#
+   with can_fail = True
+
+primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp
+   Addr# -> Int# -> Double#
+   with can_fail = True
+
+primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp
+   Addr# -> Int# -> StablePtr# a
+   with can_fail = True
+
+primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp
+   Addr# -> Int# -> Int#
+   with can_fail = True
+
+primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
+   Addr# -> Int# -> Int#
+   with can_fail = True
+
+primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
+   Addr# -> Int# -> INT32
+   with can_fail = True
+
+primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
+   Addr# -> Int# -> INT64
+   with can_fail = True
+
+primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
+   Addr# -> Int# -> Word#
+   with can_fail = True
+
+primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
+   Addr# -> Int# -> Word#
+   with can_fail = True
+
+primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
+   Addr# -> Int# -> WORD32
+   with can_fail = True
+
+primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
+   Addr# -> Int# -> WORD64
+   with can_fail = True
+
+primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Char# #)
+   {Reads 8-bit character; offset in bytes.}
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Char# #)
+   {Reads 31-bit character; offset in 4-byte words.}
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Addr# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Float# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Double# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, INT32 #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, INT64 #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Word# #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, WORD32 #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, WORD64 #)
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
+   Addr# -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp
+   Addr# -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
+   Addr# -> Int# -> Addr# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
+   Addr# -> Int# -> Float# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp
+   Addr# -> Int# -> Double# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp
+   Addr# -> Int# -> StablePtr# a -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp
+   Addr# -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
+   Addr# -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
+   Addr# -> Int# -> INT32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
+   Addr# -> Int# -> INT64 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
+   Addr# -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
+   Addr# -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
+   Addr# -> Int# -> WORD32 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
+   Addr# -> Int# -> WORD64 -> State# s -> State# s
+   with has_side_effects = True
+        can_fail         = True
+
+------------------------------------------------------------------------
+section "Mutable variables"
+        {Operations on MutVar\#s.}
+------------------------------------------------------------------------
+
+primtype MutVar# s a
+        {A {\tt MutVar\#} behaves like a single-element mutable array.}
+
+primop  NewMutVarOp "newMutVar#" GenPrimOp
+   a -> State# s -> (# State# s, MutVar# s a #)
+   {Create {\tt MutVar\#} with specified initial value in specified state thread.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+-- Note [Why MutVar# ops can't fail]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- We don't label readMutVar# or writeMutVar# as can_fail.
+-- This may seem a bit peculiar, because they surely *could*
+-- fail spectacularly if passed a pointer to unallocated memory.
+-- But MutVar#s are always correct by construction; we never
+-- test if a pointer is valid before using it with these operations.
+-- So we never have to worry about floating the pointer reference
+-- outside a validity test. At the moment, has_side_effects blocks
+-- up the relevant optimizations anyway, but we hope to draw finer
+-- distinctions soon, which should improve matters for readMutVar#
+-- at least.
+
+primop  ReadMutVarOp "readMutVar#" GenPrimOp
+   MutVar# s a -> State# s -> (# State# s, a #)
+   {Read contents of {\tt MutVar\#}. Result is not yet evaluated.}
+   with
+   -- See Note [Why MutVar# ops can't fail]
+   has_side_effects = True
+
+primop  WriteMutVarOp "writeMutVar#"  GenPrimOp
+   MutVar# s a -> a -> State# s -> State# s
+   {Write contents of {\tt MutVar\#}.}
+   with
+   -- See Note [Why MutVar# ops can't fail]
+   has_side_effects = True
+   code_size = { primOpCodeSizeForeignCall } -- for the write barrier
+
+primop  SameMutVarOp "sameMutVar#" GenPrimOp
+   MutVar# s a -> MutVar# s a -> Int#
+
+-- Note [Why not an unboxed tuple in atomicModifyMutVar2#?]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Looking at the type of atomicModifyMutVar2#, one might wonder why
+-- it doesn't return an unboxed tuple. e.g.,
+--
+--   MutVar# s a -> (a -> (# a, b #)) -> State# s -> (# State# s, a, (# a, b #) #)
+--
+-- The reason is that atomicModifyMutVar2# relies on laziness for its atomicity.
+-- Given a MutVar# containing x, atomicModifyMutVar2# merely replaces
+-- its contents with a thunk of the form (fst (f x)). This can be done using an
+-- atomic compare-and-swap as it is merely replacing a pointer.
+
+primop  AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp
+   MutVar# s a -> (a -> c) -> State# s -> (# State# s, a, c #)
+   { Modify the contents of a {\tt MutVar\#}, returning the previous
+     contents and the result of applying the given function to the
+     previous contents. Note that this isn't strictly
+     speaking the correct type for this function; it should really be
+     {\tt MutVar\# s a -> (a -> (a,b)) -> State\# s -> (\# State\# s, a, (a, b) \#)},
+     but we don't know about pairs here. }
+   with
+   out_of_line = True
+   has_side_effects = True
+   can_fail         = True
+
+primop  AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp
+   MutVar# s a -> (a -> a) -> State# s -> (# State# s, a, a #)
+   { Modify the contents of a {\tt MutVar\#}, returning the previous
+     contents and the result of applying the given function to the
+     previous contents. }
+   with
+   out_of_line = True
+   has_side_effects = True
+   can_fail         = True
+
+primop  CasMutVarOp "casMutVar#" GenPrimOp
+  MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "Exceptions"
+------------------------------------------------------------------------
+
+-- Note [Strictness for mask/unmask/catch]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Consider this example, which comes from GHC.IO.Handle.Internals:
+--    wantReadableHandle3 f ma b st
+--      = case ... of
+--          DEFAULT -> case ma of MVar a -> ...
+--          0#      -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...)
+-- The outer case just decides whether to mask exceptions, but we don't want
+-- thereby to hide the strictness in 'ma'!  Hence the use of strictApply1Dmd.
+
+primop  CatchOp "catch#" GenPrimOp
+          (State# RealWorld -> (# State# RealWorld, a #) )
+       -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+       -> State# RealWorld
+       -> (# State# RealWorld, a #)
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+                                                 , lazyApply2Dmd
+                                                 , topDmd] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+primop  RaiseOp "raise#" GenPrimOp
+   b -> o
+      -- NB: the type variable "o" is "a", but with OpenKind
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+   out_of_line = True
+   has_side_effects = True
+     -- raise# certainly throws a Haskell exception and hence has_side_effects
+     -- It doesn't actually make much difference because the fact that it
+     -- returns bottom independently ensures that we are careful not to discard
+     -- it.  But still, it's better to say the Right Thing.
+
+-- Note [Arithmetic exception primops]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- The RTS provides several primops to raise specific exceptions (raiseDivZero#,
+-- raiseUnderflow#, raiseOverflow#). These primops are meant to be used by the
+-- package implementing arbitrary precision numbers (Natural,Integer). It can't
+-- depend on `base` package to raise exceptions in a normal way because it would
+-- create a package dependency circle (base <-> bignum package).
+--
+-- See #14664
+
+primtype Void#
+
+primop  RaiseDivZeroOp "raiseDivZero#" GenPrimOp
+   Void# -> o
+   {Raise a 'DivideByZero' arithmetic exception.}
+      -- NB: the type variable "o" is "a", but with OpenKind
+      -- See Note [Arithmetic exception primops]
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  RaiseUnderflowOp "raiseUnderflow#" GenPrimOp
+   Void# -> o
+   {Raise an 'Underflow' arithmetic exception.}
+      -- NB: the type variable "o" is "a", but with OpenKind
+      -- See Note [Arithmetic exception primops]
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  RaiseOverflowOp "raiseOverflow#" GenPrimOp
+   Void# -> o
+   {Raise an 'Overflow' arithmetic exception.}
+      -- NB: the type variable "o" is "a", but with OpenKind
+      -- See Note [Arithmetic exception primops]
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  RaiseIOOp "raiseIO#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, b #)
+   with
+   -- See Note [Precise exceptions and strictness analysis] in Demand.hs
+   -- for why we give it topDiv
+   -- strictness  = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
+        (State# RealWorld -> (# State# RealWorld, a #))
+     -> (State# RealWorld -> (# State# RealWorld, a #))
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+primop  MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
+        (State# RealWorld -> (# State# RealWorld, a #))
+     -> (State# RealWorld -> (# State# RealWorld, a #))
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
+        (State# RealWorld -> (# State# RealWorld, a #))
+     -> (State# RealWorld -> (# State# RealWorld, a #))
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+primop  MaskStatus "getMaskingState#" GenPrimOp
+        State# RealWorld -> (# State# RealWorld, Int# #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "STM-accessible Mutable Variables"
+------------------------------------------------------------------------
+
+primtype TVar# s a
+
+primop  AtomicallyOp "atomically#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> State# RealWorld -> (# State# RealWorld, a #)
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+-- NB: retry#'s strictness information specifies it to diverge.
+-- This lets the compiler perform some extra simplifications, since retry#
+-- will technically never return.
+--
+-- This allows the simplifier to replace things like:
+--   case retry# s1
+--     (# s2, a #) -> e
+-- with:
+--   retry# s1
+-- where 'e' would be unreachable anyway.  See #8091.
+primop  RetryOp "retry#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, a #)
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchRetryOp "catchRetry#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+                                                 , lazyApply1Dmd
+                                                 , topDmd ] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchSTMOp "catchSTM#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with
+   strictness  = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+                                                 , lazyApply2Dmd
+                                                 , topDmd ] topDiv }
+                 -- See Note [Strictness for mask/unmask/catch]
+   out_of_line = True
+   has_side_effects = True
+
+primop  NewTVarOp "newTVar#" GenPrimOp
+       a
+    -> State# s -> (# State# s, TVar# s a #)
+   {Create a new {\tt TVar\#} holding a specified initial value.}
+   with
+   out_of_line  = True
+   has_side_effects = True
+
+primop  ReadTVarOp "readTVar#" GenPrimOp
+       TVar# s a
+    -> State# s -> (# State# s, a #)
+   {Read contents of {\tt TVar\#}.  Result is not yet evaluated.}
+   with
+   out_of_line  = True
+   has_side_effects = True
+
+primop ReadTVarIOOp "readTVarIO#" GenPrimOp
+       TVar# s a
+    -> State# s -> (# State# s, a #)
+   {Read contents of {\tt TVar\#} outside an STM transaction}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  WriteTVarOp "writeTVar#" GenPrimOp
+       TVar# s a
+    -> a
+    -> State# s -> State# s
+   {Write contents of {\tt TVar\#}.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  SameTVarOp "sameTVar#" GenPrimOp
+   TVar# s a -> TVar# s a -> Int#
+
+
+------------------------------------------------------------------------
+section "Synchronized Mutable Variables"
+        {Operations on {\tt MVar\#}s. }
+------------------------------------------------------------------------
+
+primtype MVar# s a
+        { A shared mutable variable ({\it not} the same as a {\tt MutVar\#}!).
+        (Note: in a non-concurrent implementation, {\tt (MVar\# a)} can be
+        represented by {\tt (MutVar\# (Maybe a))}.) }
+
+primop  NewMVarOp "newMVar#"  GenPrimOp
+   State# s -> (# State# s, MVar# s a #)
+   {Create new {\tt MVar\#}; initially empty.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  TakeMVarOp "takeMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, a #)
+   {If {\tt MVar\#} is empty, block until it becomes full.
+   Then remove and return its contents, and set it empty.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  TryTakeMVarOp "tryTakeMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int#, a #)
+   {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined.
+   Otherwise, return with integer 1 and contents of {\tt MVar\#}, and set {\tt MVar\#} empty.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  PutMVarOp "putMVar#" GenPrimOp
+   MVar# s a -> a -> State# s -> State# s
+   {If {\tt MVar\#} is full, block until it becomes empty.
+   Then store value arg as its new contents.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  TryPutMVarOp "tryPutMVar#" GenPrimOp
+   MVar# s a -> a -> State# s -> (# State# s, Int# #)
+   {If {\tt MVar\#} is full, immediately return with integer 0.
+    Otherwise, store value arg as {\tt MVar\#}'s new contents, and return with integer 1.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  ReadMVarOp "readMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, a #)
+   {If {\tt MVar\#} is empty, block until it becomes full.
+   Then read its contents without modifying the MVar, without possibility
+   of intervention from other threads.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  TryReadMVarOp "tryReadMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int#, a #)
+   {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined.
+   Otherwise, return with integer 1 and contents of {\tt MVar\#}.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
+primop  SameMVarOp "sameMVar#" GenPrimOp
+   MVar# s a -> MVar# s a -> Int#
+
+primop  IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int# #)
+   {Return 1 if {\tt MVar\#} is empty; 0 otherwise.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "Delay/wait operations"
+------------------------------------------------------------------------
+
+primop  DelayOp "delay#" GenPrimOp
+   Int# -> State# s -> State# s
+   {Sleep specified number of microseconds.}
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  WaitReadOp "waitRead#" GenPrimOp
+   Int# -> State# s -> State# s
+   {Block until input is available on specified file descriptor.}
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  WaitWriteOp "waitWrite#" GenPrimOp
+   Int# -> State# s -> State# s
+   {Block until output is possible on specified file descriptor.}
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+------------------------------------------------------------------------
+section "Concurrency primitives"
+------------------------------------------------------------------------
+
+primtype State# s
+        { {\tt State\#} is the primitive, unlifted type of states.  It has
+        one type parameter, thus {\tt State\# RealWorld}, or {\tt State\# s},
+        where s is a type variable. The only purpose of the type parameter
+        is to keep different state threads separate.  It is represented by
+        nothing at all. }
+
+primtype RealWorld
+        { {\tt RealWorld} is deeply magical.  It is {\it primitive}, but it is not
+        {\it unlifted} (hence {\tt ptrArg}).  We never manipulate values of type
+        {\tt RealWorld}; it's only used in the type system, to parameterise {\tt State\#}. }
+
+primtype ThreadId#
+        {(In a non-concurrent implementation, this can be a singleton
+        type, whose (unique) value is returned by {\tt myThreadId\#}.  The
+        other operations can be omitted.)}
+
+primop  ForkOp "fork#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  ForkOnOp "forkOn#" GenPrimOp
+   Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  KillThreadOp "killThread#"  GenPrimOp
+   ThreadId# -> a -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  YieldOp "yield#" GenPrimOp
+   State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  MyThreadIdOp "myThreadId#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, ThreadId# #)
+   with
+   has_side_effects = True
+
+primop LabelThreadOp "labelThread#" GenPrimOp
+   ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, Int# #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  NoDuplicateOp "noDuplicate#" GenPrimOp
+   State# s -> State# s
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  ThreadStatusOp "threadStatus#" GenPrimOp
+   ThreadId# -> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "Weak pointers"
+------------------------------------------------------------------------
+
+primtype Weak# b
+
+-- note that tyvar "o" denotes openAlphaTyVar
+
+primop  MkWeakOp "mkWeak#" GenPrimOp
+   o -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+     -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+   { {\tt mkWeak# k v finalizer s} creates a weak reference to value {\tt k},
+     with an associated reference to some value {\tt v}. If {\tt k} is still
+     alive then {\tt v} can be retrieved using {\tt deRefWeak#}. Note that
+     the type of {\tt k} must be represented by a pointer (i.e. of kind {\tt
+     TYPE 'LiftedRep} or {\tt TYPE 'UnliftedRep}). }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp
+   o -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp
+   Addr# -> Addr# -> Int# -> Addr# -> Weak# b
+          -> State# RealWorld -> (# State# RealWorld, Int# #)
+   { {\tt addCFinalizerToWeak# fptr ptr flag eptr w} attaches a C
+     function pointer {\tt fptr} to a weak pointer {\tt w} as a finalizer. If
+     {\tt flag} is zero, {\tt fptr} will be called with one argument,
+     {\tt ptr}. Otherwise, it will be called with two arguments,
+     {\tt eptr} and {\tt ptr}. {\tt addCFinalizerToWeak#} returns
+     1 on success, or 0 if {\tt w} is already dead. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  DeRefWeakOp "deRefWeak#" GenPrimOp
+   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
+   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#,
+              (State# RealWorld -> (# State# RealWorld, b #) ) #)
+   { Finalize a weak pointer. The return value is an unboxed tuple
+     containing the new state of the world and an "unboxed Maybe",
+     represented by an {\tt Int#} and a (possibly invalid) finalization
+     action. An {\tt Int#} of {\tt 1} indicates that the finalizer is valid. The
+     return value {\tt b} from the finalizer should be ignored. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop TouchOp "touch#" GenPrimOp
+   o -> State# RealWorld -> State# RealWorld
+   with
+   code_size = { 0 }
+   has_side_effects = True
+
+------------------------------------------------------------------------
+section "Stable pointers and names"
+------------------------------------------------------------------------
+
+primtype StablePtr# a
+
+primtype StableName# a
+
+primop  MakeStablePtrOp "makeStablePtr#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
+   StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  EqStablePtrOp "eqStablePtr#" GenPrimOp
+   StablePtr# a -> StablePtr# a -> Int#
+   with
+   has_side_effects = True
+
+primop  MakeStableNameOp "makeStableName#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  EqStableNameOp "eqStableName#" GenPrimOp
+   StableName# a -> StableName# b -> Int#
+
+primop  StableNameToIntOp "stableNameToInt#" GenPrimOp
+   StableName# a -> Int#
+
+------------------------------------------------------------------------
+section "Compact normal form"
+
+        {Primitives for working with compact regions. The {\tt ghc\-compact}
+         library and the {\tt compact} library demonstrate how to use these
+         primitives. The documentation below draws a distinction between
+         a CNF and a compact block. A CNF contains one or more compact
+         blocks. The source file {\tt rts\/sm\/CNF.c}
+         diagrams this relationship. When discussing a compact
+         block, an additional distinction is drawn between capacity and
+         utilized bytes. The capacity is the maximum number of bytes that
+         the compact block can hold. The utilized bytes is the number of
+         bytes that are actually used by the compact block.
+        }
+
+------------------------------------------------------------------------
+
+primtype Compact#
+
+primop  CompactNewOp "compactNew#" GenPrimOp
+   Word# -> State# RealWorld -> (# State# RealWorld, Compact# #)
+   { Create a new CNF with a single compact block. The argument is
+     the capacity of the compact block (in bytes, not words).
+     The capacity is rounded up to a multiple of the allocator block size
+     and is capped to one mega block. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  CompactResizeOp "compactResize#" GenPrimOp
+   Compact# -> Word# -> State# RealWorld ->
+   State# RealWorld
+   { Set the new allocation size of the CNF. This value (in bytes)
+     determines the capacity of each compact block in the CNF. It
+     does not retroactively affect existing compact blocks in the CNF. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  CompactContainsOp "compactContains#" GenPrimOp
+   Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #)
+   { Returns 1\# if the object is contained in the CNF, 0\# otherwise. }
+   with
+   out_of_line      = True
+
+primop  CompactContainsAnyOp "compactContainsAny#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, Int# #)
+   { Returns 1\# if the object is in any CNF at all, 0\# otherwise. }
+   with
+   out_of_line      = True
+
+primop  CompactGetFirstBlockOp "compactGetFirstBlock#" GenPrimOp
+   Compact# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #)
+   { Returns the address and the utilized size (in bytes) of the
+     first compact block of a CNF.}
+   with
+   out_of_line      = True
+
+primop  CompactGetNextBlockOp "compactGetNextBlock#" GenPrimOp
+   Compact# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #)
+   { Given a CNF and the address of one its compact blocks, returns the
+     next compact block and its utilized size, or {\tt nullAddr\#} if the
+     argument was the last compact block in the CNF. }
+   with
+   out_of_line      = True
+
+primop  CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp
+   Word# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #)
+   { Attempt to allocate a compact block with the capacity (in
+     bytes) given by the first argument. The {\texttt Addr\#} is a pointer
+     to previous compact block of the CNF or {\texttt nullAddr\#} to create a
+     new CNF with a single compact block.
+
+     The resulting block is not known to the GC until
+     {\texttt compactFixupPointers\#} is called on it, and care must be taken
+     so that the address does not escape or memory will be leaked.
+   }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  CompactFixupPointersOp "compactFixupPointers#" GenPrimOp
+   Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Compact#, Addr# #)
+   { Given the pointer to the first block of a CNF and the
+     address of the root object in the old address space, fix up
+     the internal pointers inside the CNF to account for
+     a different position in memory than when it was serialized.
+     This method must be called exactly once after importing
+     a serialized CNF. It returns the new CNF and the new adjusted
+     root address. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop CompactAdd "compactAdd#" GenPrimOp
+   Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
+   { Recursively add a closure and its transitive closure to a
+     {\texttt Compact\#} (a CNF), evaluating any unevaluated components
+     at the same time. Note: {\texttt compactAdd\#} is not thread-safe, so
+     only one thread may call {\texttt compactAdd\#} with a particular
+     {\texttt Compact\#} at any given time. The primop does not
+     enforce any mutual exclusion; the caller is expected to
+     arrange this. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp
+   Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #)
+   { Like {\texttt compactAdd\#}, but retains sharing and cycles
+   during compaction. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop CompactSize "compactSize#" GenPrimOp
+   Compact# -> State# RealWorld -> (# State# RealWorld, Word# #)
+   { Return the total capacity (in bytes) of all the compact blocks
+     in the CNF. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+------------------------------------------------------------------------
+section "Unsafe pointer equality"
+--  (#1 Bad Guy: Alastair Reid :)
+------------------------------------------------------------------------
+
+primop  ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
+   a -> a -> Int#
+   { Returns {\texttt 1\#} if the given pointers are equal and {\texttt 0\#} otherwise. }
+   with
+   can_fail   = True -- See Note [reallyUnsafePtrEquality#]
+
+
+-- Note [reallyUnsafePtrEquality#]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it can_fail
+-- anyway. Until 5a9a1738023a, GHC considered primops okay for speculation only
+-- when their arguments were known to be forced. This was unnecessarily
+-- conservative, but it prevented reallyUnsafePtrEquality# from floating out of
+-- places where its arguments were known to be forced. Unfortunately, GHC could
+-- sometimes lose track of whether those arguments were forced, leading to let/app
+-- invariant failures (see #13027 and the discussion in #11444). Now that
+-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent
+-- reallyUnsafePtrEquality# from floating out. Imagine if we had
+--
+--     \x y . case x of x'
+--              DEFAULT ->
+--            case y of y'
+--              DEFAULT ->
+--               let eq = reallyUnsafePtrEquality# x' y'
+--               in ...
+--
+-- If the let floats out, we'll get
+--
+--     \x y . let eq = reallyUnsafePtrEquality# x y
+--            in case x of ...
+--
+-- The trouble is that pointer equality between thunks is very different
+-- from pointer equality between the values those thunks reduce to, and the latter
+-- is typically much more precise.
+
+------------------------------------------------------------------------
+section "Parallelism"
+------------------------------------------------------------------------
+
+primop  ParOp "par#" GenPrimOp
+   a -> Int#
+   with
+      -- Note that Par is lazy to avoid that the sparked thing
+      -- gets evaluated strictly, which it should *not* be
+   has_side_effects = True
+   code_size = { primOpCodeSizeForeignCall }
+   deprecated_msg = { Use 'spark#' instead }
+
+primop SparkOp "spark#" GenPrimOp
+   a -> State# s -> (# State# s, a #)
+   with has_side_effects = True
+   code_size = { primOpCodeSizeForeignCall }
+
+primop SeqOp "seq#" GenPrimOp
+   a -> State# s -> (# State# s, a #)
+   -- See Note [seq# magic] in GHC.Core.Op.ConstantFold
+
+primop GetSparkOp "getSpark#" GenPrimOp
+   State# s -> (# State# s, Int#, a #)
+   with
+   has_side_effects = True
+   out_of_line = True
+
+primop NumSparks "numSparks#" GenPrimOp
+   State# s -> (# State# s, Int# #)
+   { Returns the number of sparks in the local spark pool. }
+   with
+   has_side_effects = True
+   out_of_line = True
+
+------------------------------------------------------------------------
+section "Tag to enum stuff"
+        {Convert back and forth between values of enumerated types
+        and small integers.}
+------------------------------------------------------------------------
+
+primop  DataToTagOp "dataToTag#" GenPrimOp
+   a -> Int#  -- Zero-indexed; the first constructor has tag zero
+   with
+   strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topDiv }
+   -- See Note [dataToTag# magic] in GHC.Core.Op.ConstantFold
+
+primop  TagToEnumOp "tagToEnum#" GenPrimOp
+   Int# -> a
+
+------------------------------------------------------------------------
+section "Bytecode operations"
+        {Support for manipulating bytecode objects used by the interpreter and
+        linker.
+
+        Bytecode objects are heap objects which represent top-level bindings and
+        contain a list of instructions and data needed by these instructions.}
+------------------------------------------------------------------------
+
+primtype BCO
+   { Primitive bytecode type. }
+
+primop   AddrToAnyOp "addrToAny#" GenPrimOp
+   Addr# -> (# a #)
+   { Convert an {\tt Addr\#} to a followable Any type. }
+   with
+   code_size = 0
+
+primop   AnyToAddrOp "anyToAddr#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, Addr# #)
+   { Retrieve the address of any Haskell value. This is
+     essentially an {\texttt unsafeCoerce\#}, but if implemented as such
+     the core lint pass complains and fails to compile.
+     As a primop, it is opaque to core/stg, and only appears
+     in cmm (where the copy propagation pass will get rid of it).
+     Note that "a" must be a value, not a thunk! It's too late
+     for strictness analysis to enforce this, so you're on your
+     own to guarantee this. Also note that {\texttt Addr\#} is not a GC
+     pointer - up to you to guarantee that it does not become
+     a dangling pointer immediately after you get it.}
+   with
+   code_size = 0
+
+primop   MkApUpd0_Op "mkApUpd0#" GenPrimOp
+   BCO -> (# a #)
+   { Wrap a BCO in a {\tt AP_UPD} thunk which will be updated with the value of
+     the BCO when evaluated. }
+   with
+   out_of_line = True
+
+primop  NewBCOOp "newBCO#" GenPrimOp
+   ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #)
+   { {\tt newBCO\# instrs lits ptrs arity bitmap} creates a new bytecode object. The
+     resulting object encodes a function of the given arity with the instructions
+     encoded in {\tt instrs}, and a static reference table usage bitmap given by
+     {\tt bitmap}. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  UnpackClosureOp "unpackClosure#" GenPrimOp
+   a -> (# Addr#, ByteArray#, Array# b #)
+   { {\tt unpackClosure\# closure} copies the closure and pointers in the
+     payload of the given closure into two new arrays, and returns a pointer to
+     the first word of the closure's info table, a non-pointer array for the raw
+     bytes of the closure, and a pointer array for the pointers in the payload. }
+   with
+   out_of_line = True
+
+primop  ClosureSizeOp "closureSize#" GenPrimOp
+   a -> Int#
+   { {\tt closureSize\# closure} returns the size of the given closure in
+     machine words. }
+   with
+   out_of_line = True
+
+primop  GetApStackValOp "getApStackVal#" GenPrimOp
+   a -> Int# -> (# Int#, b #)
+   with
+   out_of_line = True
+
+------------------------------------------------------------------------
+section "Misc"
+        {These aren't nearly as wired in as Etc...}
+------------------------------------------------------------------------
+
+primop  GetCCSOfOp "getCCSOf#" GenPrimOp
+   a -> State# s -> (# State# s, Addr# #)
+
+primop  GetCurrentCCSOp "getCurrentCCS#" GenPrimOp
+   a -> State# s -> (# State# s, Addr# #)
+   { Returns the current {\tt CostCentreStack} (value is {\tt NULL} if
+     not profiling).  Takes a dummy argument which can be used to
+     avoid the call to {\tt getCurrentCCS\#} being floated out by the
+     simplifier, which would result in an uninformative stack
+     ("CAF"). }
+
+primop  ClearCCSOp "clearCCS#" GenPrimOp
+   (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #)
+   { Run the supplied IO action with an empty CCS.  For example, this
+     is used by the interpreter to run an interpreted computation
+     without the call stack showing that it was invoked from GHC. }
+   with
+   out_of_line = True
+
+------------------------------------------------------------------------
+section "Etc"
+        {Miscellaneous built-ins}
+------------------------------------------------------------------------
+
+primtype Proxy# a
+   { The type constructor {\tt Proxy#} is used to bear witness to some
+   type variable. It's used when you want to pass around proxy values
+   for doing things like modelling type applications. A {\tt Proxy#}
+   is not only unboxed, it also has a polymorphic kind, and has no
+   runtime representation, being totally free. }
+
+pseudoop "proxy#"
+   Proxy# a
+   { Witness for an unboxed {\tt Proxy#} value, which has no runtime
+   representation. }
+
+pseudoop   "seq"
+   a -> b -> b
+   { The value of {\tt seq a b} is bottom if {\tt a} is bottom, and
+     otherwise equal to {\tt b}. In other words, it evaluates the first
+     argument {\tt a} to weak head normal form (WHNF). {\tt seq} is usually
+     introduced to improve performance by avoiding unneeded laziness.
+
+     A note on evaluation order: the expression {\tt seq a b} does
+     {\it not} guarantee that {\tt a} will be evaluated before {\tt b}.
+     The only guarantee given by {\tt seq} is that the both {\tt a}
+     and {\tt b} will be evaluated before {\tt seq} returns a value.
+     In particular, this means that {\tt b} may be evaluated before
+     {\tt a}. If you need to guarantee a specific order of evaluation,
+     you must use the function {\tt pseq} from the "parallel" package. }
+   with fixity = infixr 0
+         -- This fixity is only the one picked up by Haddock. If you
+         -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'.
+
+pseudoop   "unsafeCoerce#"
+   a -> b
+   { The function {\tt unsafeCoerce\#} allows you to side-step the typechecker entirely. That
+        is, it allows you to coerce any type into any other type. If you use this function,
+        you had better get it right, otherwise segmentation faults await. It is generally
+        used when you want to write a program that you know is well-typed, but where Haskell's
+        type system is not expressive enough to prove that it is well typed.
+
+        The following uses of {\tt unsafeCoerce\#} are supposed to work (i.e. not lead to
+        spurious compile-time or run-time crashes):
+
+         * Casting any lifted type to {\tt Any}
+
+         * Casting {\tt Any} back to the real type
+
+         * Casting an unboxed type to another unboxed type of the same size.
+           (Casting between floating-point and integral types does not work.
+           See the {\tt GHC.Float} module for functions to do work.)
+
+         * Casting between two types that have the same runtime representation.  One case is when
+           the two types differ only in "phantom" type parameters, for example
+           {\tt Ptr Int} to {\tt Ptr Float}, or {\tt [Int]} to {\tt [Float]} when the list is
+           known to be empty.  Also, a {\tt newtype} of a type {\tt T} has the same representation
+           at runtime as {\tt T}.
+
+        Other uses of {\tt unsafeCoerce\#} are undefined.  In particular, you should not use
+        {\tt unsafeCoerce\#} to cast a T to an algebraic data type D, unless T is also
+        an algebraic data type.  For example, do not cast {\tt Int->Int} to {\tt Bool}, even if
+        you later cast that {\tt Bool} back to {\tt Int->Int} before applying it.  The reasons
+        have to do with GHC's internal representation details (for the cognoscenti, data values
+        can be entered but function closures cannot).  If you want a safe type to cast things
+        to, use {\tt Any}, which is not an algebraic data type.
+
+        }
+   with can_fail = True
+
+-- NB. It is tempting to think that casting a value to a type that it doesn't have is safe
+-- as long as you don't "do anything" with the value in its cast form, such as seq on it.  This
+-- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type,
+-- Bad Things Might Happen.  See bug #1616: in this case we cast a function of type (a,b) -> (a,b)
+-- to () -> () and back again.  The strictness analyser saw that the function was strict, but
+-- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed
+-- a new (), with the result that the code ended up with "case () of (a,b) -> ...".
+
+primop  TraceEventOp "traceEvent#" GenPrimOp
+   Addr# -> State# s -> State# s
+   { Emits an event via the RTS tracing framework.  The contents
+     of the event is the zero-terminated byte string passed as the first
+     argument.  The event will be emitted either to the {\tt .eventlog} file,
+     or to stderr, depending on the runtime RTS flags. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp
+   Addr# -> Int# -> State# s -> State# s
+   { Emits an event via the RTS tracing framework.  The contents
+     of the event is the binary object passed as the first argument with
+     the the given length passed as the second argument. The event will be
+     emitted to the {\tt .eventlog} file. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  TraceMarkerOp "traceMarker#" GenPrimOp
+   Addr# -> State# s -> State# s
+   { Emits a marker event via the RTS tracing framework.  The contents
+     of the event is the zero-terminated byte string passed as the first
+     argument.  The event will be emitted either to the {\tt .eventlog} file,
+     or to stderr, depending on the runtime RTS flags. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  SetThreadAllocationCounter "setThreadAllocationCounter#" GenPrimOp
+   INT64 -> State# RealWorld -> State# RealWorld
+   { Sets the allocation counter for the current thread to the given value. }
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+------------------------------------------------------------------------
+section "Safe coercions"
+------------------------------------------------------------------------
+
+pseudoop   "coerce"
+   Coercible a b => a -> b
+   { The function {\tt coerce} allows you to safely convert between values of
+     types that have the same representation with no run-time overhead. In the
+     simplest case you can use it instead of a newtype constructor, to go from
+     the newtype's concrete type to the abstract type. But it also works in
+     more complicated settings, e.g. converting a list of newtypes to a list of
+     concrete types.
+
+     This function is runtime-representation polymorphic, but the
+     {\tt RuntimeRep} type argument is marked as {\tt Inferred}, meaning
+     that it is not available for visible type application. This means
+     the typechecker will accept {\tt coerce @Int @Age 42}.
+   }
+
+------------------------------------------------------------------------
+section "SIMD Vectors"
+        {Operations on SIMD vectors.}
+------------------------------------------------------------------------
+
+#define ALL_VECTOR_TYPES \
+  [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
+  ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
+  ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
+  ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \
+  ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \
+  ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8> \
+  ,<Float,Float#,4>,<Double,Double#,2> \
+  ,<Float,Float#,8>,<Double,Double#,4> \
+  ,<Float,Float#,16>,<Double,Double#,8>]
+
+#define SIGNED_VECTOR_TYPES \
+  [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
+  ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
+  ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
+  ,<Float,Float#,4>,<Double,Double#,2> \
+  ,<Float,Float#,8>,<Double,Double#,4> \
+  ,<Float,Float#,16>,<Double,Double#,8>]
+
+#define FLOAT_VECTOR_TYPES \
+  [<Float,Float#,4>,<Double,Double#,2> \
+  ,<Float,Float#,8>,<Double,Double#,4> \
+  ,<Float,Float#,16>,<Double,Double#,8>]
+
+#define INT_VECTOR_TYPES \
+  [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
+  ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
+  ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
+  ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \
+  ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \
+  ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8>]
+
+primtype VECTOR
+   with llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecBroadcastOp "broadcast#" GenPrimOp
+   SCALAR -> VECTOR
+   { Broadcast a scalar to all elements of a vector. }
+   with llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecPackOp "pack#" GenPrimOp
+   VECTUPLE -> VECTOR
+   { Pack the elements of an unboxed tuple into a vector. }
+   with llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecUnpackOp "unpack#" GenPrimOp
+   VECTOR -> VECTUPLE
+   { Unpack the elements of a vector into an unboxed tuple. #}
+   with llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecInsertOp "insert#" GenPrimOp
+   VECTOR -> SCALAR -> Int# -> VECTOR
+   { Insert a scalar at the given position in a vector. }
+   with can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecAddOp "plus#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Add two vectors element-wise. }
+   with commutable = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecSubOp "minus#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Subtract two vectors element-wise. }
+   with llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecMulOp "times#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Multiply two vectors element-wise. }
+   with commutable = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecDivOp "divide#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Divide two vectors element-wise. }
+   with can_fail = True
+        llvm_only = True
+        vector = FLOAT_VECTOR_TYPES
+
+primop VecQuotOp "quot#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Rounds towards zero element-wise. }
+   with can_fail = True
+        llvm_only = True
+        vector = INT_VECTOR_TYPES
+
+primop VecRemOp "rem#" Dyadic
+   VECTOR -> VECTOR -> VECTOR
+   { Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. }
+   with can_fail = True
+        llvm_only = True
+        vector = INT_VECTOR_TYPES
+
+primop VecNegOp "negate#" Monadic
+   VECTOR -> VECTOR
+   { Negate element-wise. }
+   with llvm_only = True
+        vector = SIGNED_VECTOR_TYPES
+
+primop VecIndexByteArrayOp "indexArray#" GenPrimOp
+   ByteArray# -> Int# -> VECTOR
+   { Read a vector from specified index of immutable array. }
+   with can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecReadByteArrayOp "readArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #)
+   { Read a vector from specified index of mutable array. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecWriteByteArrayOp "writeArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s
+   { Write a vector to specified index of mutable array. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp
+   Addr# -> Int# -> VECTOR
+   { Reads vector; offset in bytes. }
+   with can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecReadOffAddrOp "readOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, VECTOR #)
+   { Reads vector; offset in bytes. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp
+   Addr# -> Int# -> VECTOR -> State# s -> State# s
+   { Write vector; offset in bytes. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+
+primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp
+   ByteArray# -> Int# -> VECTOR
+   { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. }
+   with can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #)
+   { Read a vector from specified index of mutable array of scalars; offset is in scalar elements. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp
+   MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s
+   { Write a vector to specified index of mutable array of scalars; offset is in scalar elements. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp
+   Addr# -> Int# -> VECTOR
+   { Reads vector; offset in scalar elements. }
+   with can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, VECTOR #)
+   { Reads vector; offset in scalar elements. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp
+   Addr# -> Int# -> VECTOR -> State# s -> State# s
+   { Write vector; offset in scalar elements. }
+   with has_side_effects = True
+        can_fail = True
+        llvm_only = True
+        vector = ALL_VECTOR_TYPES
+
+------------------------------------------------------------------------
+
+section "Prefetch"
+        {Prefetch operations: Note how every prefetch operation has a name
+  with the pattern prefetch*N#, where N is either 0,1,2, or 3.
+
+  This suffix number, N, is the "locality level" of the prefetch, following the
+  convention in GCC and other compilers.
+  Higher locality numbers correspond to the memory being loaded in more
+  levels of the cpu cache, and being retained after initial use. The naming
+  convention follows the naming convention of the prefetch intrinsic found
+  in the GCC and Clang C compilers.
+
+  On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic
+  with locality level N. The code generated by LLVM is target architecture
+  dependent, but should agree with the GHC NCG on x86 systems.
+
+  On the Sparc and PPC native backends, prefetch*N is a No-Op.
+
+  On the x86 NCG, N=0 will generate prefetchNTA,
+  N=1 generates prefetcht2, N=2 generates prefetcht1, and
+  N=3 generates prefetcht0.
+
+  For streaming workloads, the prefetch*0 operations are recommended.
+  For workloads which do many reads or writes to a memory location in a short period of time,
+  prefetch*3 operations are recommended.
+
+  For further reading about prefetch and associated systems performance optimization,
+  the instruction set and optimization manuals by Intel and other CPU vendors are
+  excellent starting place.
+
+
+  The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is
+  especially a helpful read, even if your software is meant for other CPU
+  architectures or vendor hardware. The manual can be found at
+  http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html .
+
+  The {\tt prefetch*} family of operations has the order of operations
+  determined by passing around the {\tt State#} token.
+
+  To get a "pure" version of these operations, use {\tt inlinePerformIO} which is quite safe in this context.
+
+  It is important to note that while the prefetch operations will never change the
+  answer to a pure computation, They CAN change the memory locations resident
+  in a CPU cache and that may change the performance and timing characteristics
+  of an application. The prefetch operations are marked has_side_effects=True
+  to reflect that these operations have side effects with respect to the runtime
+  performance characteristics of the resulting code. Additionally, if the prefetchValue
+  operations did not have this attribute, GHC does a float out transformation that
+  results in a let/app violation, at least with the current design.
+  }
+
+
+
+------------------------------------------------------------------------
+
+
+--- the Int# argument for prefetch is the byte offset on the byteArray or  Addr#
+
+---
+primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp
+  ByteArray# -> Int# ->  State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp
+  MutableByteArray# s -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp
+  Addr# -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchValueOp3 "prefetchValue3#" GenPrimOp
+   a -> State# s -> State# s
+   with strictness  = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv }
+        has_side_effects =  True
+----
+
+primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp
+  ByteArray# -> Int# ->  State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp
+  MutableByteArray# s -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp
+  Addr# -> Int# ->  State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchValueOp2 "prefetchValue2#" GenPrimOp
+   a ->  State# s -> State# s
+   with strictness  = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv }
+        has_side_effects =  True
+----
+
+primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp
+   ByteArray# -> Int# -> State# s -> State# s
+   with has_side_effects =  True
+
+primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp
+  MutableByteArray# s -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp
+  Addr# -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchValueOp1 "prefetchValue1#" GenPrimOp
+   a -> State# s -> State# s
+   with strictness  = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv }
+        has_side_effects =  True
+----
+
+primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp
+  ByteArray# -> Int# ->  State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp
+  MutableByteArray# s -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp
+  Addr# -> Int# -> State# s -> State# s
+  with has_side_effects =  True
+
+primop PrefetchValueOp0 "prefetchValue0#" GenPrimOp
+   a -> State# s -> State# s
+   with strictness  = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv }
+        has_side_effects =  True
+
+------------------------------------------------------------------------
+---                                                                  ---
+------------------------------------------------------------------------
+
+thats_all_folks
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index be1da0a2ef..b473f418e3 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -27,7 +27,7 @@ import GHC.Core
 import GHC.Types.Literal
 import GHC.Core.DataCon
 import GHC.Types.Var.Set
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Runtime.Heap.Layout
 
 import Data.Word
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 0e0dc3ca92..9ad218e35e 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -30,7 +30,7 @@ import GHC.ByteCode.Types
 import GHC.Driver.Types
 import GHC.Types.Name
 import GHC.Types.Name.Env
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.Module
 import FastString
 import Panic
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index dbd5152b5c..7073da63c2 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -20,7 +20,7 @@ import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import Outputable
-import PrimOp
+import GHC.Builtin.PrimOps
 import SizedSeq
 import GHC.Core.Type
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index a12adc543a..807f6adb64 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -122,7 +122,7 @@ import GHC.Driver.Packages
 import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Unique
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.CostCentre
 import Outputable
 import FastString
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index a1aebc9fb9..d0fca50bd3 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -19,13 +19,13 @@ import GhcPrelude
 
 import GHC.Cmm.Expr
 
-import Lexer
+import GHC.Parser.Lexer
 import GHC.Cmm.Monad
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.FM
 import StringBuffer
 import FastString
-import Ctype
+import GHC.Parser.CharClass
 import Util
 --import TRACE
 
diff --git a/compiler/GHC/Cmm/Monad.hs b/compiler/GHC/Cmm/Monad.hs
index d6c8a5b3cc..d97df7719e 100644
--- a/compiler/GHC/Cmm/Monad.hs
+++ b/compiler/GHC/Cmm/Monad.hs
@@ -18,7 +18,7 @@ import GhcPrelude
 import Control.Monad
 
 import GHC.Driver.Session
-import Lexer
+import GHC.Parser.Lexer
 
 newtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a }
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 535c8fd5d0..9ff637de70 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -232,7 +232,7 @@ import GHC.Cmm.Lexer
 import GHC.Cmm.CLabel
 import GHC.Cmm.Monad
 import GHC.Runtime.Heap.Layout
-import Lexer
+import GHC.Parser.Lexer
 
 import GHC.Types.CostCentre
 import GHC.Types.ForeignCall
@@ -247,7 +247,7 @@ import ErrUtils
 import StringBuffer
 import FastString
 import Panic
-import Constants
+import GHC.Settings.Constants
 import Outputable
 import GHC.Types.Basic
 import Bag              ( emptyBag, unitBag )
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
index 1ac2a0fa34..77a4f00035 100644
--- a/compiler/GHC/CmmToLlvm.hs
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -34,7 +34,7 @@ import GHC.Platform ( platformArch, Arch(..) )
 import ErrUtils
 import FastString
 import Outputable
-import SysTools ( figureLlvmVersion )
+import GHC.SysTools ( figureLlvmVersion )
 import qualified Stream
 
 import Control.Monad ( when, forM_ )
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index a45292079c..17384f0d43 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -451,7 +451,7 @@ The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in
 GHC.Core.Make.
 
 For discussion of some implications of the let/app invariant primops see
-Note [Checking versus non-checking primops] in PrimOp.
+Note [Checking versus non-checking primops] in GHC.Builtin.PrimOps.
 
 Note [Case expression invariants]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Class.hs b/compiler/GHC/Core/Class.hs
index 7b73f3a423..5fb1fc9ea9 100644
--- a/compiler/GHC/Core/Class.hs
+++ b/compiler/GHC/Core/Class.hs
@@ -79,7 +79,7 @@ data Class
 --
 --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'',
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 type FunDep a = ([a],[a])
 
 type ClassOpItem = (Id, DefMethInfo)
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 1fccb0a84b..ad97c4d7e9 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -142,8 +142,8 @@ import Outputable
 import GHC.Types.Unique
 import Pair
 import GHC.Types.SrcLoc
-import PrelNames
-import TysPrim
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim
 import ListSetOps
 import Maybes
 import GHC.Types.Unique.FM
diff --git a/compiler/GHC/Core/Coercion/Axiom.hs b/compiler/GHC/Core/Coercion/Axiom.hs
index 7f38b3dcd6..cc4cbeff6d 100644
--- a/compiler/GHC/Core/Coercion/Axiom.hs
+++ b/compiler/GHC/Core/Coercion/Axiom.hs
@@ -500,7 +500,7 @@ data Role = Nominal | Representational | Phantom
 -- These names are slurped into the parser code. Changing these strings
 -- will change the **surface syntax** that GHC accepts! If you want to
 -- change only the pretty-printing, do some replumbing. See
--- mkRoleAnnotDecl in RdrHsSyn
+-- mkRoleAnnotDecl in GHC.Parser.PostProcess
 fsFromRole :: Role -> FastString
 fsFromRole Nominal          = fsLit "nominal"
 fsFromRole Representational = fsLit "representational"
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index 7d767a2416..a4521d688c 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -71,7 +71,7 @@ import GHC.Core.TyCon
 import GHC.Types.FieldLabel
 import GHC.Core.Class
 import GHC.Types.Name
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Core.Predicate
 import GHC.Types.Var
 import Outputable
@@ -298,7 +298,7 @@ Note that (Foo a) might not be an instance of Ord.
 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
 --             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data DataCon
   = MkData {
         dcName    :: Name,      -- This is the name of the *source data con*
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index 6995cc71a1..6e7fa259ff 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -76,7 +76,7 @@ import GHC.Core.TyCo.FVs
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Core.FamInstEnv
-import TysPrim( funTyConName )
+import GHC.Builtin.Types.Prim( funTyConName )
 import Maybes( orElse )
 import Util
 import GHC.Types.Basic( Activation )
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index ea1ab371a7..b496b87484 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -33,7 +33,7 @@ import GHC.Core.Opt.Monad
 import Bag
 import GHC.Types.Literal
 import GHC.Core.DataCon
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Tc.Utils.TcType ( isFloatingTy )
 import GHC.Types.Var as Var
 import GHC.Types.Var.Env
@@ -57,7 +57,7 @@ import GHC.Core.Coercion.Axiom
 import GHC.Types.Basic
 import ErrUtils as Err
 import ListSetOps
-import PrelNames
+import GHC.Builtin.Names
 import Outputable
 import FastString
 import Util
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 51d706ff23..bf927ebd4d 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -65,14 +65,14 @@ import GHC.Types.Literal
 import GHC.Driver.Types
 import GHC.Platform
 
-import TysWiredIn
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Names
 
 import GHC.Hs.Utils      ( mkChunkified, chunkify )
 import GHC.Core.Type
 import GHC.Core.Coercion ( isCoVar )
 import GHC.Core.DataCon  ( DataCon, dataConWorkId )
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Types.Id.Info
 import GHC.Types.Demand
 import GHC.Types.Cpr
@@ -343,7 +343,7 @@ We could do one of two things:
 * Flatten it out, so that
     mkCoreTup [e1] = e1
 
-* Build a one-tuple (see Note [One-tuples] in TysWiredIn)
+* Build a one-tuple (see Note [One-tuples] in GHC.Builtin.Types)
     mkCoreTup1 [e1] = Unit e1
   We use a suffix "1" to indicate this.
 
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 4c291b05ba..91b44af996 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -35,9 +35,9 @@ import GHC.Core.Make
 import GHC.Types.Id
 import GHC.Types.Literal
 import GHC.Core.SimpleOpt ( exprIsLiteral_maybe )
-import PrimOp             ( PrimOp(..), tagToEnumKey )
-import TysWiredIn
-import TysPrim
+import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
 import GHC.Core.TyCon
    ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
    , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons
@@ -48,7 +48,7 @@ import GHC.Core.Utils  ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType
 import GHC.Core.Unfold ( exprIsConApp_maybe )
 import GHC.Core.Type
 import GHC.Types.Name.Occurrence ( occNameFS )
-import PrelNames
+import GHC.Builtin.Names
 import Maybes      ( orElse )
 import GHC.Types.Name ( Name, nameOccName )
 import Outputable
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 9e46884960..30956fd768 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -34,8 +34,8 @@ import GHC.Core.Coercion ( Coercion, coVarsOfCo )
 import GHC.Core.FamInstEnv
 import Util
 import Maybes           ( isJust )
-import TysWiredIn
-import TysPrim          ( realWorldStatePrimTy )
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
 import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
 import GHC.Types.Unique.Set
 
diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs
index 3b25e42764..c5b8acc7f6 100644
--- a/compiler/GHC/Core/Opt/FloatIn.hs
+++ b/compiler/GHC/Core/Opt/FloatIn.hs
@@ -407,7 +407,7 @@ floating in cases with a single alternative that may bind values.
 
 But there are wrinkles
 
-* Which unlifted cases do we float? See PrimOp.hs
+* Which unlifted cases do we float? See GHC.Builtin.PrimOps
   Note [PrimOp can_fail and has_side_effects] which explains:
    - We can float-in can_fail primops, but we can't float them out.
    - But we can float a has_side_effects primop, but NOT inside a lambda,
diff --git a/compiler/GHC/Core/Opt/LiberateCase.hs b/compiler/GHC/Core/Opt/LiberateCase.hs
index 4f2bf38081..2e284e3611 100644
--- a/compiler/GHC/Core/Opt/LiberateCase.hs
+++ b/compiler/GHC/Core/Opt/LiberateCase.hs
@@ -14,7 +14,7 @@ import GhcPrelude
 import GHC.Driver.Session
 import GHC.Core
 import GHC.Core.Unfold  ( couldBeSmallEnoughToInline )
-import TysWiredIn       ( unitDataConId )
+import GHC.Builtin.Types ( unitDataConId )
 import GHC.Types.Id
 import GHC.Types.Var.Env
 import Util             ( notNull )
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index 278370d439..710a8cf70f 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -95,7 +95,7 @@ import GHC.Core.Type    ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType
                         , mightBeUnliftedType, closeOverKindsDSet )
 import GHC.Types.Basic  ( Arity, RecFlag(..), isRec )
 import GHC.Core.DataCon ( dataConOrigResTy )
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Unique.Supply
 import Util
 import Outputable
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 44d2eee8a6..d2b63ecb94 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -58,7 +58,7 @@ import FastString
 import Util
 import ErrUtils
 import GHC.Types.Module ( moduleName, pprModuleName )
-import PrimOp           ( PrimOp (SeqOp) )
+import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )
 
 
 {-
@@ -2516,7 +2516,7 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
           -- The entire case is dead, so we can drop it
           -- if the scrutinee converges without having imperative
           -- side effects or raising a Haskell exception
-          -- See Note [PrimOp can_fail and has_side_effects] in PrimOp
+          -- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps
    = simplExprF env rhs cont
 
   -- 2b.  Turn the case into a let, if
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index 27b846c564..2827ba037d 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -58,7 +58,7 @@ import OrdList
 import GHC.Types.Id as Id
 import GHC.Core.Make            ( mkWildValBinder )
 import GHC.Driver.Session       ( DynFlags )
-import TysWiredIn
+import GHC.Builtin.Types
 import qualified GHC.Core.Type as Type
 import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst )
 import qualified GHC.Core.Coercion as Coercion
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 048357321e..1de946f724 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -58,7 +58,7 @@ import GHC.Types.Var
 import GHC.Types.Demand
 import GHC.Types.Var.Set
 import GHC.Types.Basic
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Type     hiding( substTy )
 import GHC.Core.Coercion hiding( substCo )
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index 206143ab4d..f0a7821b1f 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -59,7 +59,7 @@ import GHC.Types.Unique.FM
 import MonadUtils
 import Control.Monad    ( zipWithM )
 import Data.List
-import PrelNames        ( specTyConName )
+import GHC.Builtin.Names ( specTyConName )
 import GHC.Types.Module
 import GHC.Core.TyCon ( TyCon )
 import GHC.Exts( SpecConstrAnnotation(..) )
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 6ca48ca5ca..b1a85fa93f 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -37,7 +37,7 @@ import GHC.Core.Arity     ( etaExpandToJoinPointRule )
 import GHC.Types.Unique.Supply
 import GHC.Types.Name
 import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
-import TysPrim            ( voidPrimTy )
+import GHC.Builtin.Types.Prim ( voidPrimTy )
 import Maybes           ( mapMaybe, maybeToList, isJust )
 import MonadUtils       ( foldlM )
 import GHC.Types.Basic
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 1964233ca7..cbd8788d66 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -28,8 +28,8 @@ import GHC.Types.Cpr
 import GHC.Core.Make    ( mkAbsentErrorApp, mkCoreUbxTup
                         , mkCoreApp, mkCoreLet )
 import GHC.Types.Id.Make ( voidArgId, voidPrimId )
-import TysWiredIn       ( tupleDataCon )
-import TysPrim          ( voidPrimTy )
+import GHC.Builtin.Types      ( tupleDataCon )
+import GHC.Builtin.Types.Prim ( voidPrimTy )
 import GHC.Types.Literal ( absentLiteralOf, rubbishLit )
 import GHC.Types.Var.Env ( mkInScopeSet )
 import GHC.Types.Var.Set ( VarSet )
diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs
index c9894655f7..dbeb099440 100644
--- a/compiler/GHC/Core/Predicate.hs
+++ b/compiler/GHC/Core/Predicate.hs
@@ -36,7 +36,7 @@ import GHC.Core.TyCon
 import GHC.Types.Var
 import GHC.Core.Coercion
 
-import PrelNames
+import GHC.Builtin.Names
 
 import FastString
 import Outputable
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 907c7104a5..899ae25d1b 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -44,7 +44,7 @@ import GHC.Core.Type as Type
    ( Type, TCvSubst, extendTvSubst, extendCvSubst
    , mkEmptyTCvSubst, substTy )
 import GHC.Tc.Utils.TcType  ( tcSplitTyConApp_maybe )
-import TysWiredIn           ( anyTypeOfKind )
+import GHC.Builtin.Types    ( anyTypeOfKind )
 import GHC.Core.Coercion as Coercion
 import GHC.Core.Tidy     ( tidyRules )
 import GHC.Types.Id
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 419d4088d4..0728ea11c8 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -45,8 +45,8 @@ import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSub
                             , isInScope, substTyVarBndr, cloneTyVarBndr )
 import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
 import GHC.Core.TyCon ( tyConArity )
-import TysWiredIn
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Names
 import GHC.Types.Basic
 import GHC.Types.Module ( Module )
 import ErrUtils
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 7a4c14edf2..9963875bf3 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -52,7 +52,7 @@ import GHC.Core.Type hiding
    , isInScope, substTyVarBndr, cloneTyVarBndr )
 import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
 
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Id
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index 8fe8f6e97d..00d3f95c43 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -7,14 +7,14 @@ Note [The Type-related module hierarchy]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   GHC.Core.Class
   GHC.Core.Coercion.Axiom
-  GHC.Core.TyCon      imports GHC.Core.{Class, Coercion.Axiom}
-  GHC.Core.TyCo.Rep   imports GHC.Core.{Class, Coercion.Axiom, TyCon}
-  GHC.Core.TyCo.Ppr   imports GHC.Core.TyCo.Rep
-  GHC.Core.TyCo.FVs   imports GHC.Core.TyCo.Rep
-  GHC.Core.TyCo.Subst imports GHC.Core.TyCo.{Rep, FVs, Ppr}
-  GHC.Core.TyCo.Tidy  imports GHC.Core.TyCo.{Rep, FVs}
-  TysPrim             imports GHC.Core.TyCo.Rep ( including mkTyConTy )
-  GHC.Core.Coercion   imports GHC.Core.Type
+  GHC.Core.TyCon           imports GHC.Core.{Class, Coercion.Axiom}
+  GHC.Core.TyCo.Rep        imports GHC.Core.{Class, Coercion.Axiom, TyCon}
+  GHC.Core.TyCo.Ppr        imports GHC.Core.TyCo.Rep
+  GHC.Core.TyCo.FVs        imports GHC.Core.TyCo.Rep
+  GHC.Core.TyCo.Subst      imports GHC.Core.TyCo.{Rep, FVs, Ppr}
+  GHC.Core.TyCo.Tidy       imports GHC.Core.TyCo.{Rep, FVs}
+  GHC.Builtin.Types.Prim   imports GHC.Core.TyCo.Rep ( including mkTyConTy )
+  GHC.Core.Coercion        imports GHC.Core.Type
 -}
 
 -- We expose the relevant stuff from this module via the Type module
@@ -105,7 +105,7 @@ import Data.IORef ( IORef )   -- for CoercionHole
 
 Despite the fact that DataCon has to be imported via a hi-boot route,
 this module seems the right place for TyThing, because it's needed for
-funTyCon and all the types in TysPrim.
+funTyCon and all the types in GHC.Builtin.Types.Prim.
 
 It is also SOURCE-imported into Name.hs
 
@@ -377,7 +377,7 @@ How does this work?
 
 * We support both homogeneous (~) and heterogeneous (~~)
   equality.  (See Note [The equality types story]
-  in TysPrim for a primer on these equality types.)
+  in GHC.Builtin.Types.Prim for a primer on these equality types.)
 
 * How do we prevent a MkT having an illegal constraint like
   Eq a?  We check for this at use-sites; see GHC.Tc.Gen.HsType.tcTyVar,
@@ -948,7 +948,7 @@ represented by evidence of type p.
 %*                                                                      *
 %************************************************************************
 
-These functions are here so that they can be used by TysPrim,
+These functions are here so that they can be used by GHC.Builtin.Types.Prim,
 which in turn is imported by Type
 -}
 
@@ -1594,7 +1594,7 @@ During typechecking, constraint solving for type classes works by
     which actually binds d7 to the (Num a) evidence
 
 For equality constraints we use a different strategy.  See Note [The
-equality types story] in TysPrim for background on equality constraints.
+equality types story] in GHC.Builtin.Types.Prim for background on equality constraints.
   - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just
     like type classes above. (Indeed, boxed equality constraints *are* classes.)
   - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2)
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index d28d8b0f0c..e82cb2e219 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -141,7 +141,7 @@ import {-# SOURCE #-} GHC.Core.TyCo.Rep
    ( Kind, Type, PredType, mkForAllTy, mkFunTy )
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr
    ( pprType )
-import {-# SOURCE #-} TysWiredIn
+import {-# SOURCE #-} GHC.Builtin.Types
    ( runtimeRepTyCon, constraintKind
    , vecCountTyCon, vecElemTyCon, liftedTypeKind )
 import {-# SOURCE #-} GHC.Core.DataCon
@@ -158,12 +158,12 @@ import GHC.Types.ForeignCall
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Core.Coercion.Axiom
-import PrelNames
+import GHC.Builtin.Names
 import Maybes
 import Outputable
 import FastStringEnv
 import GHC.Types.FieldLabel
-import Constants
+import GHC.Settings.Constants
 import Util
 import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique )
 import GHC.Types.Unique.Set
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 9f86e98fd8..a6521801b4 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -240,13 +240,14 @@ import GHC.Types.Var.Set
 import GHC.Types.Unique.Set
 
 import GHC.Core.TyCon
-import TysPrim
-import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind
+import GHC.Builtin.Types.Prim
+import {-# SOURCE #-} GHC.Builtin.Types
+                                 ( listTyCon, typeNatKind
                                  , typeSymbolKind, liftedTypeKind
                                  , liftedTypeKindTyCon
                                  , constraintKind )
 import GHC.Types.Name( Name )
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Core.Coercion.Axiom
 import {-# SOURCE #-} GHC.Core.Coercion
    ( mkNomReflCo, mkGReflCo, mkReflCo
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index f307206384..6c88c5a24d 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -56,12 +56,12 @@ import GHC.Types.Id
 import GHC.Types.Demand ( StrictSig, isBottomingSig )
 import GHC.Core.DataCon
 import GHC.Types.Literal
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.Id.Info
 import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec )
 import GHC.Core.Type
-import PrelNames
-import TysPrim          ( realWorldStatePrimTy )
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
 import Bag
 import Util
 import Outputable
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 63d269875c..a0704ef03a 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -66,7 +66,7 @@ import GhcPrelude
 import GHC.Platform
 
 import GHC.Core
-import PrelNames ( makeStaticName )
+import GHC.Builtin.Names ( makeStaticName )
 import GHC.Core.Ppr
 import GHC.Core.FVs( exprFreeVars )
 import GHC.Types.Var
@@ -76,10 +76,10 @@ import GHC.Types.Var.Set
 import GHC.Types.Name
 import GHC.Types.Literal
 import GHC.Core.DataCon
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.Id
 import GHC.Types.Id.Info
-import PrelNames( absentErrorIdKey )
+import GHC.Builtin.Names( absentErrorIdKey )
 import GHC.Core.Type as Type
 import GHC.Core.Predicate
 import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder )
@@ -87,7 +87,7 @@ import GHC.Core.Coercion
 import GHC.Core.TyCon
 import GHC.Types.Unique
 import Outputable
-import TysPrim
+import GHC.Builtin.Types.Prim
 import FastString
 import Maybes
 import ListSetOps       ( minusList )
@@ -1499,7 +1499,7 @@ it's applied only to dictionaries.
 --    exprIsHNF            implies exprOkForSpeculation
 --    exprOkForSpeculation implies exprOkForSideEffects
 --
--- See Note [PrimOp can_fail and has_side_effects] in PrimOp
+-- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps
 -- and Note [Transformations affected by can_fail and has_side_effects]
 --
 -- As an example of the considerations in this test, consider:
@@ -1628,7 +1628,7 @@ altsAreExhaustive ((con1,_,_) : alts)
 
 -- | True of dyadic operators that can fail only if the second arg is zero!
 isDivOp :: PrimOp -> Bool
--- This function probably belongs in PrimOp, or even in
+-- This function probably belongs in GHC.Builtin.PrimOps, or even in
 -- an automagically generated file.. but it's such a
 -- special case I thought I'd leave it here for now.
 isDivOp IntQuotOp        = True
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 75a2110e1d..b2f185498c 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -35,7 +35,7 @@ import GHC.Core.Utils
 import GHC.Core
 import GHC.Core.Ppr
 import GHC.Types.Literal
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Core.FVs
 import GHC.Core.Type
 import GHC.Types.RepType
@@ -43,7 +43,7 @@ import GHC.Core.DataCon
 import GHC.Core.TyCon
 import Util
 import GHC.Types.Var.Set
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Core.TyCo.Ppr ( pprType )
 import ErrUtils
 import GHC.Types.Unique
@@ -56,7 +56,7 @@ import GHC.Data.Bitmap
 import OrdList
 import Maybes
 import GHC.Types.Var.Env
-import PrelNames ( unsafeEqualityProofName )
+import GHC.Builtin.Names ( unsafeEqualityProofName )
 
 import Data.List
 import Foreign
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 85a5e52b79..dcce320ed9 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -54,10 +54,10 @@ import GHC.Types.Id.Info
 import GHC.Core
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
-import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
-import TysWiredIn ( heqTyCon )
+import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
+import GHC.Builtin.Types ( heqTyCon )
 import GHC.Types.Id.Make ( noinlineIdName )
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Core.Type
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 0ebe4a8f90..a35c81789b 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -35,7 +35,7 @@ import GHC.Types.Var.Env
 import GHC.Types.Module
 import GHC.Types.Name   ( isExternalName, nameModule_maybe )
 import GHC.Types.Basic  ( Arity )
-import TysWiredIn       ( unboxedUnitDataCon, unitDataConId )
+import GHC.Builtin.Types ( unboxedUnitDataCon, unitDataConId )
 import GHC.Types.Literal
 import Outputable
 import MonadUtils
@@ -44,10 +44,10 @@ import Util
 import GHC.Driver.Session
 import GHC.Driver.Ways
 import GHC.Types.ForeignCall
-import GHC.Types.Demand ( isUsedOnce )
-import PrimOp           ( PrimCall(..), primOpWrapperId )
-import GHC.Types.SrcLoc ( mkGeneralSrcSpan )
-import PrelNames        ( unsafeEqualityProofName )
+import GHC.Types.Demand    ( isUsedOnce )
+import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId )
+import GHC.Types.SrcLoc    ( mkGeneralSrcSpan )
+import GHC.Builtin.Names   ( unsafeEqualityProofName )
 
 import Data.List.NonEmpty (nonEmpty, toList)
 import Data.Maybe    (fromMaybe)
@@ -539,7 +539,7 @@ coreToStgApp f args ticks = do
                                       (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty)))
 
                 -- Some primitive operator that might be implemented as a library call.
-                -- As described in Note [Primop wrappers] in PrimOp.hs, here we
+                -- As described in Note [Primop wrappers] in GHC.Builtin.PrimOps, here we
                 -- turn unsaturated primop applications into applications of
                 -- the primop's wrapper.
                 PrimOpId op
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index dd7419a89a..50ae474cdf 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -23,7 +23,7 @@ import GHC.Platform
 import GHC.Core.Opt.OccurAnal
 
 import GHC.Driver.Types
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Id.Make ( realWorldPrimId )
 import GHC.Core.Utils
 import GHC.Core.Arity
@@ -43,7 +43,7 @@ import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Id
 import GHC.Types.Id.Info
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Core.DataCon
 import GHC.Types.Basic
 import GHC.Types.Module
@@ -1071,7 +1071,7 @@ Note that eta expansion in CorePrep is very fragile due to the "prediction" of
 CAFfyness made during tidying (see Note [CAFfyness inconsistencies due to eta
 expansion in CorePrep] in GHC.Iface.Tidy for details.  We previously saturated primop
 applications here as well but due to this fragility (see #16846) we now deal
-with this another way, as described in Note [Primop wrappers] in PrimOp.
+with this another way, as described in Note [Primop wrappers] in GHC.Builtin.PrimOps.
 
 It's quite likely that eta expansion of constructor applications will
 eventually break in a similar way to how primops did. We really should
@@ -1469,7 +1469,7 @@ lookupMkNaturalName dflags hsc_env
     = guardNaturalUse dflags $ liftM tyThingId $
       lookupGlobal hsc_env mkNaturalName
 
--- See Note [The integer library] in PrelNames
+-- See Note [The integer library] in GHC.Builtin.Names
 lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon)
 lookupIntegerSDataConName dflags hsc_env = case integerLibrary dflags of
     IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 6ab71b7fec..4f179f4aa1 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -23,11 +23,11 @@ import GhcPrelude
 -- In a separate module because it hooks into the parser.
 import GHC.Driver.Backpack.Syntax
 
-import ApiAnnotation
+import GHC.Parser.Annotation
 import GHC hiding (Failed, Succeeded)
 import GHC.Driver.Packages
-import Parser
-import Lexer
+import GHC.Parser
+import GHC.Parser.Lexer
 import GHC.Driver.Monad
 import GHC.Driver.Session
 import GHC.Tc.Utils.Monad
@@ -43,11 +43,11 @@ import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
 import Outputable
 import Maybes
-import HeaderInfo
+import GHC.Parser.Header
 import GHC.Iface.Recomp
 import GHC.Driver.Make
 import GHC.Types.Unique.DSet
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Driver.Finder
 import Util
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index d9078e9ca1..f87661846e 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -32,7 +32,7 @@ import GHC.Driver.Types
 import GHC.Driver.Session
 import Stream           ( Stream )
 import qualified Stream
-import FileCleanup
+import GHC.SysTools.FileCleanup
 
 import ErrUtils
 import Outputable
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index d2538d90e8..0a4b07509f 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -40,7 +40,7 @@ import GHC.Driver.Types
 import GHC.Driver.Packages
 import FastString
 import Util
-import PrelNames        ( gHC_PRIM )
+import GHC.Builtin.Names ( gHC_PRIM )
 import GHC.Driver.Session
 import Outputable
 import Maybes           ( expectJust )
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index da19a6aa96..2e867ac85f 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -351,7 +351,7 @@ data GeneralFlag
 
 -- Check whether a flag should be considered an "optimisation flag"
 -- for purposes of recompilation avoidance (see
--- Note [Ignoring some flag changes] in FlagChecker). Being listed here is
+-- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is
 -- not a guarantee that the flag has no other effect. We could, and
 -- perhaps should, separate out the flags that have some minor impact on
 -- program semantics and/or error behavior (e.g., assertions), but
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 2eda36cd90..2b5dfb2b11 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -100,7 +100,7 @@ import GHC.Types.Var.Env       ( emptyTidyEnv )
 import Panic
 import GHC.Core.ConLike
 
-import ApiAnnotation
+import GHC.Parser.Annotation
 import GHC.Types.Module
 import GHC.Driver.Packages
 import GHC.Types.Name.Reader
@@ -108,15 +108,15 @@ import GHC.Hs
 import GHC.Hs.Dump
 import GHC.Core
 import StringBuffer
-import Parser
-import Lexer
+import GHC.Parser
+import GHC.Parser.Lexer as Lexer
 import GHC.Types.SrcLoc
 import GHC.Tc.Module
 import GHC.IfaceToCore  ( typecheckIface )
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Zonk    ( ZonkFlexi (DefaultFlexi) )
 import GHC.Types.Name.Cache ( initNameCache )
-import PrelInfo
+import GHC.Builtin.Utils
 import GHC.Core.Opt.Driver
 import GHC.HsToCore
 import GHC.Iface.Load   ( ifaceStats, initExternalPackageState, writeIface )
@@ -144,7 +144,7 @@ import GHC.Core.FamInstEnv
 import Fingerprint      ( Fingerprint )
 import GHC.Driver.Hooks
 import GHC.Tc.Utils.Env
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Driver.Plugins
 import GHC.Runtime.Loader   ( initializePlugins )
 
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 359e602be8..7df02dd7c8 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -43,7 +43,7 @@ import GHC.Driver.Session
 import ErrUtils
 import GHC.Driver.Finder
 import GHC.Driver.Monad
-import HeaderInfo
+import GHC.Parser.Header
 import GHC.Driver.Types
 import GHC.Types.Module
 import GHC.IfaceToCore  ( typecheckIface )
@@ -70,7 +70,7 @@ import GHC.Types.Unique.Set
 import Util
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Types.Name.Env
-import FileCleanup
+import GHC.SysTools.FileCleanup
 
 import Data.Either ( rights, partitionEithers )
 import qualified Data.Map as Map
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 385b1de791..d45b39e3b3 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -23,7 +23,7 @@ import GHC.Driver.Session
 import GHC.Driver.Ways
 import Util
 import GHC.Driver.Types
-import qualified SysTools
+import qualified GHC.SysTools as SysTools
 import GHC.Types.Module
 import Digraph          ( SCC(..) )
 import GHC.Driver.Finder
@@ -32,7 +32,7 @@ import Panic
 import GHC.Types.SrcLoc
 import Data.List
 import FastString
-import FileCleanup
+import GHC.SysTools.FileCleanup
 
 import Exception
 import ErrUtils
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index d7ecbeb39b..b2299a1403 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -924,7 +924,7 @@ sortByPreference prec_map = sortBy (flip (compareByPreference prec_map))
 -- package to use in place of @integer-wired-in@ and that two different
 -- package databases supply a different integer library. For more about
 -- the fake @integer-wired-in@ package, see Note [The integer library]
--- in the @PrelNames@ module.
+-- in the @GHC.Builtin.Names@ module.
 compareByPreference
     :: PackagePrecedenceIndex
     -> UnitInfo
@@ -1022,7 +1022,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
   let
         matches :: UnitInfo -> WiredInUnitId -> Bool
         pc `matches` pid
-            -- See Note [The integer library] in PrelNames
+            -- See Note [The integer library] in GHC.Builtin.Names
             | pid == unitIdString integerUnitId
             = packageNameString pc `elem` ["integer-gmp", "integer-simple"]
         pc `matches` pid = packageNameString pc == pid
@@ -1126,7 +1126,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
 -- compiler, as described in Note [Wired-in packages] in GHC.Types.Module.
 --
 -- For instance, base-4.9.0.0 will be rewritten to just base, to match
--- what appears in PrelNames.
+-- what appears in GHC.Builtin.Names.
 
 upd_wired_in_mod :: WiredPackagesMap -> Module -> Module
 upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 53d7b5f0ac..f61430b475 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -41,10 +41,10 @@ import GhcPrelude
 import GHC.Driver.Pipeline.Monad
 import GHC.Driver.Packages
 import GHC.Driver.Ways
-import HeaderInfo
+import GHC.Parser.Header
 import GHC.Driver.Phases
-import SysTools
-import SysTools.ExtraObj
+import GHC.SysTools
+import GHC.SysTools.ExtraObj
 import GHC.Driver.Main
 import GHC.Driver.Finder
 import GHC.Driver.Types hiding ( Hsc )
@@ -62,11 +62,11 @@ import GHC.CmmToLlvm    ( llvmFixupAsm, llvmVersionList )
 import MonadUtils
 import GHC.Platform
 import GHC.Tc.Types
-import ToolSettings
 import GHC.Driver.Hooks
 import qualified GHC.LanguageExtensions as LangExt
-import FileCleanup
-import Ar
+import GHC.SysTools.FileCleanup
+import GHC.SysTools.Ar
+import GHC.Settings
 import Bag              ( unitBag )
 import FastString       ( mkFastString )
 import GHC.Iface.Make   ( mkFullIface )
@@ -955,14 +955,14 @@ runPhase (RealPhase (Unlit sf)) input_fn dflags
 
        let flags = [ -- The -h option passes the file name for unlit to
                      -- put in a #line directive
-                     SysTools.Option     "-h"
+                     GHC.SysTools.Option     "-h"
                      -- See Note [Don't normalise input filenames].
-                   , SysTools.Option $ escape input_fn
-                   , SysTools.FileOption "" input_fn
-                   , SysTools.FileOption "" output_fn
+                   , GHC.SysTools.Option $ escape input_fn
+                   , GHC.SysTools.FileOption "" input_fn
+                   , GHC.SysTools.FileOption "" output_fn
                    ]
 
-       liftIO $ SysTools.runUnlit dflags flags
+       liftIO $ GHC.SysTools.runUnlit dflags flags
 
        return (RealPhase (Cpp sf), output_fn)
   where
@@ -1030,10 +1030,10 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags
             PipeEnv{src_basename, src_suffix} <- getPipeEnv
             let orig_fn = src_basename <.> src_suffix
             output_fn <- phaseOutputFilename (Hsc sf)
-            liftIO $ SysTools.runPp dflags
-                           ( [ SysTools.Option     orig_fn
-                             , SysTools.Option     input_fn
-                             , SysTools.FileOption "" output_fn
+            liftIO $ GHC.SysTools.runPp dflags
+                           ( [ GHC.SysTools.Option     orig_fn
+                             , GHC.SysTools.Option     input_fn
+                             , GHC.SysTools.FileOption "" output_fn
                              ]
                            )
 
@@ -1311,12 +1311,12 @@ runPhase (RealPhase cc_phase) input_fn dflags
 
         ghcVersionH <- liftIO $ getGhcVersionPathName dflags
 
-        liftIO $ SysTools.runCc (phaseForeignLanguage cc_phase) dflags (
-                        [ SysTools.FileOption "" input_fn
-                        , SysTools.Option "-o"
-                        , SysTools.FileOption "" output_fn
+        liftIO $ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) dflags (
+                        [ GHC.SysTools.FileOption "" input_fn
+                        , GHC.SysTools.Option "-o"
+                        , GHC.SysTools.FileOption "" output_fn
                         ]
-                       ++ map SysTools.Option (
+                       ++ map GHC.SysTools.Option (
                           pic_c_flags
 
                 -- Stub files generated for foreign exports references the runIO_closure
@@ -1370,8 +1370,8 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
         -- assembler, so we use clang as the assembler instead. (#5636)
         let as_prog | hscTarget dflags == HscLlvm &&
                       platformOS (targetPlatform dflags) == OSDarwin
-                    = SysTools.runClang
-                    | otherwise = SysTools.runAs
+                    = GHC.SysTools.runClang
+                    | otherwise = GHC.SysTools.runAs
 
         let cmdline_include_paths = includePaths dflags
         let pic_c_flags = picCCOpts dflags
@@ -1384,9 +1384,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
         liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
 
         ccInfo <- liftIO $ getCompilerInfo dflags
-        let global_includes = [ SysTools.Option ("-I" ++ p)
+        let global_includes = [ GHC.SysTools.Option ("-I" ++ p)
                               | p <- includePathsGlobal cmdline_include_paths ]
-        let local_includes = [ SysTools.Option ("-iquote" ++ p)
+        let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)
                              | p <- includePathsQuote cmdline_include_paths ]
         let runAssembler inputFilename outputFilename
               = liftIO $ do
@@ -1395,9 +1395,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
                        dflags
                        (local_includes ++ global_includes
                        -- See Note [-fPIC for assembler]
-                       ++ map SysTools.Option pic_c_flags
+                       ++ map GHC.SysTools.Option pic_c_flags
                        -- See Note [Produce big objects on Windows]
-                       ++ [ SysTools.Option "-Wa,-mbig-obj"
+                       ++ [ GHC.SysTools.Option "-Wa,-mbig-obj"
                           | platformOS (targetPlatform dflags) == OSMinGW32
                           , not $ target32Bit (targetPlatform dflags)
                           ]
@@ -1410,19 +1410,19 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
         --
         -- This is a temporary hack.
                        ++ (if platformArch (targetPlatform dflags) == ArchSPARC
-                           then [SysTools.Option "-mcpu=v9"]
+                           then [GHC.SysTools.Option "-mcpu=v9"]
                            else [])
                        ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
-                            then [SysTools.Option "-Qunused-arguments"]
+                            then [GHC.SysTools.Option "-Qunused-arguments"]
                             else [])
-                       ++ [ SysTools.Option "-x"
+                       ++ [ GHC.SysTools.Option "-x"
                           , if with_cpp
-                              then SysTools.Option "assembler-with-cpp"
-                              else SysTools.Option "assembler"
-                          , SysTools.Option "-c"
-                          , SysTools.FileOption "" inputFilename
-                          , SysTools.Option "-o"
-                          , SysTools.FileOption "" temp_outputFilename
+                              then GHC.SysTools.Option "assembler-with-cpp"
+                              else GHC.SysTools.Option "assembler"
+                          , GHC.SysTools.Option "-c"
+                          , GHC.SysTools.FileOption "" inputFilename
+                          , GHC.SysTools.Option "-o"
+                          , GHC.SysTools.FileOption "" temp_outputFilename
                           ])
 
         liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
@@ -1437,12 +1437,12 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
   = do
     output_fn <- phaseOutputFilename LlvmLlc
 
-    liftIO $ SysTools.runLlvmOpt dflags
+    liftIO $ GHC.SysTools.runLlvmOpt dflags
                (   optFlag
                 ++ defaultOptions ++
-                [ SysTools.FileOption "" input_fn
-                , SysTools.Option "-o"
-                , SysTools.FileOption "" output_fn]
+                [ GHC.SysTools.FileOption "" input_fn
+                , GHC.SysTools.Option "-o"
+                , GHC.SysTools.FileOption "" output_fn]
                 )
 
     return (RealPhase LlvmLlc, output_fn)
@@ -1461,10 +1461,10 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
         -- passes only, so if the user is passing us extra options we assume
         -- they know what they are doing and don't get in the way.
         optFlag = if null (getOpts dflags opt_lo)
-                  then map SysTools.Option $ words llvmOpts
+                  then map GHC.SysTools.Option $ words llvmOpts
                   else []
 
-        defaultOptions = map SysTools.Option . concat . fmap words . fst
+        defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst
                        $ unzip (llvmOptions dflags)
 
 -----------------------------------------------------------------------------
@@ -1479,12 +1479,12 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
 
     output_fn <- phaseOutputFilename next_phase
 
-    liftIO $ SysTools.runLlvmLlc dflags
+    liftIO $ GHC.SysTools.runLlvmLlc dflags
                 (  optFlag
                 ++ defaultOptions
-                ++ [ SysTools.FileOption "" input_fn
-                   , SysTools.Option "-o"
-                   , SysTools.FileOption "" output_fn
+                ++ [ GHC.SysTools.FileOption "" input_fn
+                   , GHC.SysTools.Option "-o"
+                   , GHC.SysTools.FileOption "" output_fn
                    ]
                 )
 
@@ -1535,10 +1535,10 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
       _ -> "-O2"
 
     optFlag = if null (getOpts dflags opt_lc)
-              then map SysTools.Option $ words llvmOpts
+              then map GHC.SysTools.Option $ words llvmOpts
               else []
 
-    defaultOptions = map SysTools.Option . concatMap words . snd
+    defaultOptions = map GHC.SysTools.Option . concatMap words . snd
                    $ unzip (llvmOptions dflags)
 
 
@@ -1781,15 +1781,15 @@ linkBinary' staticLink dflags o_files dep_packages = do
     rc_objs <- maybeCreateManifest dflags output_fn
 
     let link = if staticLink
-                   then SysTools.runLibtool
-                   else SysTools.runLink
+                   then GHC.SysTools.runLibtool
+                   else GHC.SysTools.runLink
     link dflags (
-                       map SysTools.Option verbFlags
-                      ++ [ SysTools.Option "-o"
-                         , SysTools.FileOption "" output_fn
+                       map GHC.SysTools.Option verbFlags
+                      ++ [ GHC.SysTools.Option "-o"
+                         , GHC.SysTools.FileOption "" output_fn
                          ]
                       ++ libmLinkOpts
-                      ++ map SysTools.Option (
+                      ++ map GHC.SysTools.Option (
                          []
 
                       -- See Note [No PIE when linking]
@@ -1841,7 +1841,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
                       ++ o_files
                       ++ lib_path_opts)
                       ++ extra_ld_inputs
-                      ++ map SysTools.Option (
+                      ++ map GHC.SysTools.Option (
                          rc_objs
                       ++ framework_opts
                       ++ pkg_lib_path_opts
@@ -1911,7 +1911,7 @@ maybeCreateManifest dflags exe_filename
                -- show is a bit hackish above, but we need to escape the
                -- backslashes in the path.
 
-         runWindres dflags $ map SysTools.Option $
+         runWindres dflags $ map GHC.SysTools.Option $
                ["--input="++rc_filename,
                 "--output="++rc_obj_filename,
                 "--output-format=coff"]
@@ -1963,7 +1963,7 @@ linkStaticLib dflags o_files dep_packages = do
     else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
 
   -- run ranlib over the archive. write*Ar does *not* create the symbol index.
-  runRanlib dflags [SysTools.FileOption "" output_fn]
+  runRanlib dflags [GHC.SysTools.FileOption "" output_fn]
 
 -- -----------------------------------------------------------------------------
 -- Running CPP
@@ -1982,8 +1982,8 @@ doCpp dflags raw input_fn output_fn = do
 
     let verbFlags = getVerbFlags dflags
 
-    let cpp_prog args | raw       = SysTools.runCpp dflags args
-                      | otherwise = SysTools.runCc Nothing dflags (SysTools.Option "-E" : args)
+    let cpp_prog args | raw       = GHC.SysTools.runCpp dflags args
+                      | otherwise = GHC.SysTools.runCc Nothing dflags (GHC.SysTools.Option "-E" : args)
 
     let targetArch = stringEncodeArch $ platformArch $ targetPlatform dflags
         targetOS = stringEncodeOS $ platformOS $ targetPlatform dflags
@@ -2027,26 +2027,26 @@ doCpp dflags raw input_fn output_fn = do
                     -- size of 1000 packages, it takes cpp an estimated 2
                     -- milliseconds to process this file. See #10970
                     -- comment 8.
-                    return [SysTools.FileOption "-include" macro_stub]
+                    return [GHC.SysTools.FileOption "-include" macro_stub]
             else return []
 
-    cpp_prog       (   map SysTools.Option verbFlags
-                    ++ map SysTools.Option include_paths
-                    ++ map SysTools.Option hsSourceCppOpts
-                    ++ map SysTools.Option target_defs
-                    ++ map SysTools.Option backend_defs
-                    ++ map SysTools.Option th_defs
-                    ++ map SysTools.Option hscpp_opts
-                    ++ map SysTools.Option sse_defs
-                    ++ map SysTools.Option avx_defs
+    cpp_prog       (   map GHC.SysTools.Option verbFlags
+                    ++ map GHC.SysTools.Option include_paths
+                    ++ map GHC.SysTools.Option hsSourceCppOpts
+                    ++ map GHC.SysTools.Option target_defs
+                    ++ map GHC.SysTools.Option backend_defs
+                    ++ map GHC.SysTools.Option th_defs
+                    ++ map GHC.SysTools.Option hscpp_opts
+                    ++ map GHC.SysTools.Option sse_defs
+                    ++ map GHC.SysTools.Option avx_defs
                     ++ mb_macro_include
         -- Set the language mode to assembler-with-cpp when preprocessing. This
         -- alleviates some of the C99 macro rules relating to whitespace and the hash
         -- operator, which we tend to abuse. Clang in particular is not very happy
         -- about this.
-                    ++ [ SysTools.Option     "-x"
-                       , SysTools.Option     "assembler-with-cpp"
-                       , SysTools.Option     input_fn
+                    ++ [ GHC.SysTools.Option     "-x"
+                       , GHC.SysTools.Option     "assembler-with-cpp"
+                       , GHC.SysTools.Option     input_fn
         -- We hackily use Option instead of FileOption here, so that the file
         -- name is not back-slashed on Windows.  cpp is capable of
         -- dealing with / in filenames, so it works fine.  Furthermore
@@ -2055,8 +2055,8 @@ doCpp dflags raw input_fn output_fn = do
         -- our error messages get double backslashes in them.
         -- In due course we should arrange that the lexer deals
         -- with these \\ escapes properly.
-                       , SysTools.Option     "-o"
-                       , SysTools.FileOption "" output_fn
+                       , GHC.SysTools.Option     "-o"
+                       , GHC.SysTools.FileOption "" output_fn
                        ])
 
 getBackendDefs :: DynFlags -> IO [String]
@@ -2137,20 +2137,20 @@ joinObjectFiles dflags o_files output_fn = do
   let toolSettings' = toolSettings dflags
       ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
       osInfo = platformOS (targetPlatform dflags)
-      ld_r args cc = SysTools.runLink dflags ([
-                       SysTools.Option "-nostdlib",
-                       SysTools.Option "-Wl,-r"
+      ld_r args cc = GHC.SysTools.runLink dflags ([
+                       GHC.SysTools.Option "-nostdlib",
+                       GHC.SysTools.Option "-Wl,-r"
                      ]
                         -- See Note [No PIE while linking] in GHC.Driver.Session
                      ++ (if toolSettings_ccSupportsNoPie toolSettings'
-                          then [SysTools.Option "-no-pie"]
+                          then [GHC.SysTools.Option "-no-pie"]
                           else [])
 
                      ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]
                           then []
-                          else [SysTools.Option "-nodefaultlibs"])
+                          else [GHC.SysTools.Option "-nodefaultlibs"])
                      ++ (if osInfo == OSFreeBSD
-                          then [SysTools.Option "-L/usr/lib"]
+                          then [GHC.SysTools.Option "-L/usr/lib"]
                           else [])
                         -- gcc on sparc sets -Wl,--relax implicitly, but
                         -- -r and --relax are incompatible for ld, so
@@ -2158,16 +2158,16 @@ joinObjectFiles dflags o_files output_fn = do
                      ++ (if platformArch (targetPlatform dflags)
                                 `elem` [ArchSPARC, ArchSPARC64]
                          && ldIsGnuLd
-                            then [SysTools.Option "-Wl,-no-relax"]
+                            then [GHC.SysTools.Option "-Wl,-no-relax"]
                             else [])
                         -- See Note [Produce big objects on Windows]
-                     ++ [ SysTools.Option "-Wl,--oformat,pe-bigobj-x86-64"
+                     ++ [ GHC.SysTools.Option "-Wl,--oformat,pe-bigobj-x86-64"
                         | OSMinGW32 == osInfo
                         , not $ target32Bit (targetPlatform dflags)
                         ]
-                     ++ map SysTools.Option ld_build_id
-                     ++ [ SysTools.Option "-o",
-                          SysTools.FileOption "" output_fn ]
+                     ++ map GHC.SysTools.Option ld_build_id
+                     ++ [ GHC.SysTools.Option "-o",
+                          GHC.SysTools.FileOption "" output_fn ]
                      ++ args)
 
       -- suppress the generation of the .note.gnu.build-id section,
@@ -2183,15 +2183,15 @@ joinObjectFiles dflags o_files output_fn = do
           cwd <- getCurrentDirectory
           let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files
           writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
-          ld_r [SysTools.FileOption "" script] ccInfo
+          ld_r [GHC.SysTools.FileOption "" script] ccInfo
      else if toolSettings_ldSupportsFilelist toolSettings'
      then do
           filelist <- newTempName dflags TFL_CurrentModule "filelist"
           writeFile filelist $ unlines o_files
-          ld_r [SysTools.Option "-Wl,-filelist",
-                SysTools.FileOption "-Wl," filelist] ccInfo
+          ld_r [GHC.SysTools.Option "-Wl,-filelist",
+                GHC.SysTools.FileOption "-Wl," filelist] ccInfo
      else do
-          ld_r (map (SysTools.FileOption "") o_files) ccInfo
+          ld_r (map (GHC.SysTools.FileOption "") o_files) ccInfo
 
 -- -----------------------------------------------------------------------------
 -- Misc.
@@ -2228,7 +2228,7 @@ hscPostBackendPhase _ hsc_lang =
 touchObjectFile :: DynFlags -> FilePath -> IO ()
 touchObjectFile dflags path = do
   createDirectoryIfMissing True $ takeDirectory path
-  SysTools.touch dflags "Touching object file" path
+  GHC.SysTools.touch dflags "Touching object file" path
 
 -- | Find out path to @ghcversion.h@ file
 getGhcVersionPathName :: DynFlags -> IO FilePath
diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index 6e07924d1e..753f829f3c 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -19,7 +19,7 @@ import GHC.Driver.Session
 import GHC.Driver.Phases
 import GHC.Driver.Types
 import GHC.Types.Module
-import FileCleanup (TempFileLifetime)
+import GHC.SysTools.FileCleanup (TempFileLifetime)
 
 import Control.Monad
 
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 2f8fb99162..5ed6e093d7 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -242,11 +242,10 @@ import GhcPrelude
 
 import GHC.Platform
 import GHC.UniqueSubdir (uniqueSubdir)
-import PlatformConstants
 import GHC.Types.Module
 import {-# SOURCE #-} GHC.Driver.Plugins
 import {-# SOURCE #-} GHC.Driver.Hooks
-import {-# SOURCE #-} PrelNames ( mAIN )
+import {-# SOURCE #-} GHC.Builtin.Names ( mAIN )
 import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkComponentId)
 import GHC.Driver.Phases ( Phase(..), phaseInputExt )
 import GHC.Driver.Flags
@@ -255,8 +254,7 @@ import Config
 import CliOption
 import GHC.Driver.CmdLine hiding (WarnReason(..))
 import qualified GHC.Driver.CmdLine as Cmd
-import Constants
-import GhcNameVersion
+import GHC.Settings.Constants
 import Panic
 import qualified PprColour as Col
 import Util
@@ -267,17 +265,15 @@ import GHC.Types.SrcLoc
 import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
 import FastString
 import Fingerprint
-import FileSettings
 import Outputable
-import Settings
-import ToolSettings
+import GHC.Settings
 
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn
                                , getCaretDiagnostic, DumpAction, TraceAction
                                , defaultDumpAction, defaultTraceAction )
 import Json
-import SysTools.Terminal ( stderrSupportsAnsiColors )
-import SysTools.BaseDir ( expandToolDir, expandTopDir )
+import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
+import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
 
 import System.IO.Unsafe ( unsafePerformIO )
 import Data.IORef
@@ -457,10 +453,10 @@ data DynFlags = DynFlags {
 
   integerLibrary        :: IntegerLibrary,
     -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overridden
-    --   by GHC-API users. See Note [The integer library] in PrelNames
+    --   by GHC-API users. See Note [The integer library] in GHC.Builtin.Names
   llvmConfig            :: LlvmConfig,
     -- ^ N.B. It's important that this field is lazy since we load the LLVM
-    -- configuration lazily. See Note [LLVM Configuration] in SysTools.
+    -- configuration lazily. See Note [LLVM Configuration] in GHC.SysTools.
   verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
   optLevel              :: Int,         -- ^ Optimisation level
   debugLevel            :: Int,         -- ^ How much debug information to produce
@@ -888,7 +884,7 @@ data LlvmTarget = LlvmTarget
   , lAttributes :: [String]
   }
 
--- | See Note [LLVM Configuration] in SysTools.
+-- | See Note [LLVM Configuration] in GHC.SysTools.
 data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]
                              , llvmPasses  :: [(Int, String)]
                              }
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index d532ef09b0..581a90ea1d 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -182,7 +182,7 @@ import GHC.Types.Id
 import GHC.Types.Id.Info ( IdDetails(..), RecSelParent(..))
 import GHC.Core.Type
 
-import ApiAnnotation    ( ApiAnns )
+import GHC.Parser.Annotation    ( ApiAnns )
 import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
 import GHC.Core.Class
 import GHC.Core.TyCon
@@ -190,8 +190,8 @@ import GHC.Core.Coercion.Axiom
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
-import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
-import TysWiredIn
+import GHC.Builtin.Names ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
+import GHC.Builtin.Types
 import GHC.Driver.Packages hiding  ( Version(..) )
 import GHC.Driver.CmdLine
 import GHC.Driver.Session
@@ -1561,7 +1561,7 @@ as if they were defined in modules
    ...etc...
 with each bunch of declarations using a new module, all sharing a
 common package 'interactive' (see Module.interactiveUnitId, and
-PrelNames.mkInteractiveModule).
+GHC.Builtin.Names.mkInteractiveModule).
 
 This scheme deals well with shadowing.  For example:
 
@@ -3154,7 +3154,7 @@ data HsParsedModule = HsParsedModule {
        -- the .hi file, so that we can force recompilation if any of
        -- them change (#3589)
     hpm_annotations :: ApiAnns
-    -- See note [Api annotations] in ApiAnnotation.hs
+    -- See note [Api annotations] in GHC.Parser.Annotation
   }
 
 {-
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 98509398aa..72710c6830 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -79,7 +79,7 @@ data HsModule
         --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
         --                                   ,'ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
       hsmodImports :: [LImportDecl GhcPs],
         -- ^ We snaffle interesting stuff out of the imported interfaces early
         -- on, adding that info to TyDecls/etc; so this list is often empty,
@@ -93,14 +93,14 @@ data HsModule
         --                                   ,'ApiAnnotation.AnnClose'
         --
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
       hsmodHaddockModHeader :: Maybe LHsDocString
         -- ^ Haddock module info and description, unparsed
         --
         --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
         --                                   ,'ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
    }
      -- ^ 'ApiAnnotation.AnnKeywordId's
      --
@@ -110,7 +110,7 @@ data HsModule
      --    'ApiAnnotation.AnnClose' for explicit braces and semi around
      --    hsmodImports,hsmodDecls if this style is used.
 
-     -- For details on above see note [Api annotations] in ApiAnnotation
+     -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 deriving instance Data HsModule
 
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 54718d289f..5068f082ce 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -218,7 +218,7 @@ data HsBindLR idL idR
     --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
     --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
     FunBind {
 
         fun_ext :: XFunBind idL idR,
@@ -259,7 +259,7 @@ data HsBindLR idL idR
   --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | PatBind {
         pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]
         pat_lhs    :: LPat idL,
@@ -310,7 +310,7 @@ data HsBindLR idL idR
         --          'ApiAnnotation.AnnWhere'
         --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | XHsBindsLR !(XXHsBindsLR idL idR)
 
@@ -365,7 +365,7 @@ type instance XXABExport (GhcPass p) = NoExtCon
 --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
 --             'ApiAnnotation.AnnClose' @'}'@,
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Pattern Synonym binding
 data PatSynBind idL idR
@@ -824,7 +824,7 @@ type LIPBind id = Located (IPBind id)
 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
 --   list
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Implicit parameter bindings.
 --
@@ -835,7 +835,7 @@ type LIPBind id = Located (IPBind id)
 --
 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data IPBind id
   = IPBind
         (XCIPBind id)
@@ -890,7 +890,7 @@ data Sig pass
       --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
       --          'ApiAnnotation.AnnComma'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
     TypeSig
        (XTypeSig pass)
        [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah
@@ -904,7 +904,7 @@ data Sig pass
       --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
       --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
       -- P :: forall a b. Req => Prov => ty
 
@@ -935,7 +935,7 @@ data Sig pass
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
         --           'ApiAnnotation.AnnVal'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | FixSig (XFixSig pass) (FixitySig pass)
 
         -- | An inline pragma
@@ -948,7 +948,7 @@ data Sig pass
         --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',
         --       'ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | InlineSig   (XInlineSig pass)
                 (Located (IdP pass)) -- Function name
                 InlinePragma         -- Never defaultInlinePragma
@@ -964,7 +964,7 @@ data Sig pass
         --      'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,
         --      'ApiAnnotation.AnnDcolon'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | SpecSig     (XSpecSig pass)
                 (Located (IdP pass)) -- Specialise a function or datatype  ...
                 [LHsSigType pass]  -- ... to these types
@@ -982,7 +982,7 @@ data Sig pass
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
                   -- Note [Pragma source text] in GHC.Types.Basic
 
@@ -994,7 +994,7 @@ data Sig pass
         --      'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',
         --      'ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | MinimalSig (XMinimalSig pass)
                SourceText (LBooleanFormula (Located (IdP pass)))
                -- Note [Pragma source text] in GHC.Types.Basic
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index c3388b6362..0be89127a5 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -135,7 +135,7 @@ type LHsDecl p = Located (HsDecl p)
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
         --
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | A Haskell Declaration
 data HsDecl p
@@ -452,7 +452,7 @@ have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
 In *source-code* class declarations:
 
  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
-   This is done by RdrHsSyn.mkClassOpSigDM
+   This is done by GHC.Parser.PostProcess.mkClassOpSigDM
 
  - The renamer renames it to a Name
 
@@ -546,7 +546,7 @@ data TyClDecl pass
     --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
     --             'ApiAnnotation.AnnVbar'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
     FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
 
   | -- | @type@ declaration
@@ -554,7 +554,7 @@ data TyClDecl pass
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
     --             'ApiAnnotation.AnnEqual',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
     SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
             , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
             , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
@@ -571,7 +571,7 @@ data TyClDecl pass
     --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
     --              'ApiAnnotation.AnnWhere',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
     DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs
              , tcdLName    :: Located (IdP pass)   -- ^ Type constructor
              , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables
@@ -598,7 +598,7 @@ data TyClDecl pass
         --                          'ApiAnnotation.AnnComma'
         --                          'ApiAnnotation.AnnRarrow'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XTyClDecl !(XXTyClDecl pass)
 
 type LHsFunDep pass = Located (FunDep (Located (IdP pass)))
@@ -1047,14 +1047,14 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
     NoSig (XNoSig pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | KindSig  (XCKindSig pass) (LHsKind pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
   --             'ApiAnnotation.AnnCloseP'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
@@ -1062,7 +1062,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
   --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
   | XFamilyResultSig !(XXFamilyResultSig pass)
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 type instance XNoSig            (GhcPass _) = NoExtField
 type instance XCKindSig         (GhcPass _) = NoExtField
@@ -1093,7 +1093,7 @@ data FamilyDecl pass = FamilyDecl
   --             'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
   --             'ApiAnnotation.AnnVbar'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 type instance XCFamilyDecl    (GhcPass _) = NoExtField
 type instance XXFamilyDecl    (GhcPass _) = NoExtCon
@@ -1115,7 +1115,7 @@ data InjectivityAnn pass
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 data FamilyInfo pass
   = DataFamily
@@ -1231,7 +1231,7 @@ data HsDataDefn pass   -- The payload of a data type defn
 
                  dd_derivs :: HsDeriving pass  -- ^ Optional 'deriving' clause
 
-             -- For details on above see note [Api annotations] in ApiAnnotation
+             -- For details on above see note [Api annotations] in GHC.Parser.Annotation
    }
   | XHsDataDefn !(XXHsDataDefn pass)
 
@@ -1348,7 +1348,7 @@ type LConDecl pass = Located (ConDecl pass)
       -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
       --   in a GADT constructor list
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- |
 --
@@ -1372,7 +1372,7 @@ type LConDecl pass = Located (ConDecl pass)
 --            'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',
 --            'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | data Constructor Declaration
 data ConDecl pass
@@ -1444,7 +1444,7 @@ There's a wrinkle in ConDeclGADT
   so it's hard to split up the arguments until we've done the precedence
   resolution (in the renamer).
 
-  So:  - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr
+  So:  - In the parser (GHC.Parser.PostProcess.mkGadtDecl), we put the whole constr
          type into the res_ty for a ConDeclGADT for now, and use
          PrefixCon []
             con_args   = PrefixCon []
@@ -1593,7 +1593,7 @@ type LTyFamInstEqn pass = Located (TyFamInstEqn pass)
   -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
   --   when in a list
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Haskell Type Patterns
 type HsTyPats pass = [LHsTypeArg pass]
@@ -1652,7 +1652,7 @@ newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
     --           'ApiAnnotation.AnnInstance',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 ----------------- Data family instances -------------
 
@@ -1669,7 +1669,7 @@ newtype DataFamInstDecl pass
     --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
     --           'ApiAnnotation.AnnClose'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 ----------------- Family instances (common types) -------------
 
@@ -1700,7 +1700,7 @@ data FamEqn pass rhs
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
   | XFamEqn !(XXFamEqn pass rhs)
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 type instance XCFamEqn    (GhcPass _) r = NoExtField
 type instance XXFamEqn    (GhcPass _) r = NoExtCon
@@ -1725,14 +1725,14 @@ data ClsInstDecl pass
          -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
          --                                    'ApiAnnotation.AnnClose',
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
       }
     -- ^
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',
     --           'ApiAnnotation.AnnWhere',
     --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XClsInstDecl !(XXClsInstDecl pass)
 
 type instance XCClsInstDecl    (GhcPass _) = NoExtField
@@ -1922,7 +1922,7 @@ data DerivDecl pass = DerivDecl
          --        'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
          --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
         }
   | XDerivDecl !(XXDerivDecl pass)
 
@@ -2023,7 +2023,7 @@ data DefaultDecl pass
         -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
         --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XDefaultDecl !(XXDefaultDecl pass)
 
 type instance XCDefaultDecl    (GhcPass _) = NoExtField
@@ -2069,7 +2069,7 @@ data ForeignDecl pass
         --           'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',
         --           'ApiAnnotation.AnnDcolon'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XForeignDecl !(XXForeignDecl pass)
 
 {-
@@ -2250,7 +2250,7 @@ data RuleBndr pass
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 type instance XCRuleBndr    (GhcPass _) = NoExtField
 type instance XRuleBndrSig  (GhcPass _) = NoExtField
@@ -2386,7 +2386,7 @@ data AnnDecl pass = HsAnnotation
       --           'ApiAnnotation.AnnModule'
       --           'ApiAnnotation.AnnClose'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XAnnDecl !(XXAnnDecl pass)
 
 type instance XHsAnnotation (GhcPass _) = NoExtField
@@ -2438,7 +2438,7 @@ data RoleAnnotDecl pass
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
       --           'ApiAnnotation.AnnRole'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XRoleAnnotDecl !(XXRoleAnnotDecl pass)
 
 type instance XCRoleAnnotDecl (GhcPass _) = NoExtField
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 050ba91d6b..d52f9cac65 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -47,7 +47,7 @@ import Util
 import Outputable
 import FastString
 import GHC.Core.Type
-import TysWiredIn (mkTupleStr)
+import GHC.Builtin.Types (mkTupleStr)
 import GHC.Tc.Utils.TcType (TcType)
 import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv)
 
@@ -75,7 +75,7 @@ type LHsExpr p = Located (HsExpr p)
   -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
   --   in a list
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -------------------------
 -- | Post-Type checking Expression
@@ -281,7 +281,7 @@ data HsExpr p
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --       'ApiAnnotation.AnnRarrow',
 
-       -- For details on above see note [Api annotations] in ApiAnnotation
+       -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
        --
@@ -289,7 +289,7 @@ data HsExpr p
        --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
        --           'ApiAnnotation.AnnClose'
 
-       -- For details on above see note [Api annotations] in ApiAnnotation
+       -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
 
@@ -316,7 +316,7 @@ data HsExpr p
   --
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | NegApp      (XNegApp p)
                 (LHsExpr p)
                 (SyntaxExpr p)
@@ -324,7 +324,7 @@ data HsExpr p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
   --             'ApiAnnotation.AnnClose' @')'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsPar       (XPar p)
                 (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
 
@@ -340,7 +340,7 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
   --         'ApiAnnotation.AnnClose'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   -- Note [ExplicitTuple]
   | ExplicitTuple
         (XExplicitTuple p)
@@ -364,7 +364,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
   --       'ApiAnnotation.AnnClose' @'}'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsCase      (XCase p)
                 (LHsExpr p)
                 (MatchGroup p (LHsExpr p))
@@ -374,7 +374,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
   --       'ApiAnnotation.AnnElse',
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsIf        (XIf p)        -- GhcPs: this is a Bool; False <=> do not use
                                --  rebindable syntax
                 (SyntaxExpr p) -- cond function
@@ -389,7 +389,7 @@ data HsExpr p
   -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]
 
   -- | let(rec)
@@ -398,7 +398,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnOpen' @'{'@,
   --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsLet       (XLet p)
                 (LHsLocalBinds p)
                 (LHsExpr  p)
@@ -408,7 +408,7 @@ data HsExpr p
   --             'ApiAnnotation.AnnVbar',
   --             'ApiAnnotation.AnnClose'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsDo        (XDo p)                  -- Type of the whole expression
                 (HsStmtContext GhcRn)    -- The parameterisation is unimportant
                                          -- because in this context we never use
@@ -420,7 +420,7 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
   --              'ApiAnnotation.AnnClose' @']'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   -- See Note [Empty lists]
   | ExplicitList
                 (XExplicitList p)  -- Gives type of components of list
@@ -433,7 +433,7 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
   --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | RecordCon
       { rcon_ext      :: XRecordCon p
       , rcon_con_name :: Located (IdP p)    -- The constructor name;
@@ -445,7 +445,7 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
   --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | RecordUpd
       { rupd_ext  :: XRecordUpd p
       , rupd_expr :: LHsExpr p
@@ -458,7 +458,7 @@ data HsExpr p
   --
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | ExprWithTySig
                 (XExprWithTySig p)
 
@@ -471,14 +471,14 @@ data HsExpr p
   --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
   --              'ApiAnnotation.AnnClose' @']'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | ArithSeq
                 (XArithSeq p)
                 (Maybe (SyntaxExpr p))
                                   -- For OverloadedLists, the fromList witness
                 (ArithSeqInfo p)
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   -----------------------------------------------------------
   -- MetaHaskell Extensions
@@ -487,7 +487,7 @@ data HsExpr p
   --         'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',
   --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsBracket    (XBracket p) (HsBracket p)
 
     -- See Note [Pending Splices]
@@ -509,7 +509,7 @@ data HsExpr p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
   --         'ApiAnnotation.AnnClose'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsSpliceE  (XSpliceE p) (HsSplice p)
 
   -----------------------------------------------------------
@@ -520,7 +520,7 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
   --          'ApiAnnotation.AnnRarrow'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsProc      (XProc p)
                 (LPat p)               -- arrow abstraction, proc
                 (LHsCmdTop p)          -- body of the abstraction
@@ -530,7 +530,7 @@ data HsExpr p
   -- static pointers extension
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsStatic (XStatic p) -- Free variables of the body
              (LHsExpr p)        -- Body
 
@@ -681,7 +681,7 @@ data HsPragE p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsPragCore  (XCoreAnn p)
                 SourceText            -- Note [Pragma source text] in GHC.Types.Basic
                 StringLiteral         -- hdaume: core annotation
@@ -695,7 +695,7 @@ data HsPragE p
   --       'ApiAnnotation.AnnVal',
   --       'ApiAnnotation.AnnClose' @'\#-}'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsPragTick                        -- A pragma introduced tick
      (XTickPragma p)
      SourceText                       -- Note [Pragma source text] in GHC.Types.Basic
@@ -721,7 +721,7 @@ type instance XXPragE        (GhcPass _) = NoExtCon
 type LHsTupArg id = Located (HsTupArg id)
 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Haskell Tuple Argument
 data HsTupArg id
@@ -841,7 +841,7 @@ A tuple data constructor like () or (,,,) is parsed as an `HsVar`, not an
 
 Sadly, the grammar for this is actually ambiguous, and it's only thanks to the
 preference of a shift in a shift/reduce conflict that the parser works as this
-Note details. Search for a reference to this Note in Parser.y for further
+Note details. Search for a reference to this Note in GHC.Parser for further
 explanation.
 
 Note [Empty lists]
@@ -853,7 +853,7 @@ various phases and why.
 Parsing
 -------
 An empty list is parsed by the sysdcon nonterminal. It thus comes to life via
-HsVar nilDataCon (defined in TysWiredIn). A freshly-parsed (HsExpr GhcPs) empty list
+HsVar nilDataCon (defined in GHC.Builtin.Types). A freshly-parsed (HsExpr GhcPs) empty list
 is never a ExplicitList.
 
 Renaming
@@ -1270,7 +1270,7 @@ data HsCmd id
   --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
   --          'ApiAnnotation.AnnRarrowtail'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)
         (XCmdArrApp id)  -- type of the arrow expressions f,
                          -- of the form a t t', where arg :: t
@@ -1283,7 +1283,7 @@ data HsCmd id
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
   --         'ApiAnnotation.AnnCloseB' @'|)'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)
         (XCmdArrForm id)
         (LHsExpr id)     -- The operator.
@@ -1304,14 +1304,14 @@ data HsCmd id
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --       'ApiAnnotation.AnnRarrow',
 
-       -- For details on above see note [Api annotations] in ApiAnnotation
+       -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsCmdPar    (XCmdPar id)
                 (LHsCmd id)                     -- parenthesised command
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
     --             'ApiAnnotation.AnnClose' @')'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsCmdCase   (XCmdCase id)
                 (LHsExpr id)
@@ -1320,7 +1320,7 @@ data HsCmd id
     --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
     --       'ApiAnnotation.AnnClose' @'}'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsCmdIf     (XCmdIf id)
                 (SyntaxExpr id)         -- cond function
@@ -1332,7 +1332,7 @@ data HsCmd id
     --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
     --       'ApiAnnotation.AnnElse',
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsCmdLet    (XCmdLet id)
                 (LHsLocalBinds id)      -- let(rec)
@@ -1341,7 +1341,7 @@ data HsCmd id
     --       'ApiAnnotation.AnnOpen' @'{'@,
     --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression
                 (Located [CmdLStmt id])
@@ -1350,7 +1350,7 @@ data HsCmd id
     --             'ApiAnnotation.AnnVbar',
     --             'ApiAnnotation.AnnClose'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | XCmd        !(XXCmd id)     -- Note [Trees that Grow] extension point
 
@@ -1567,7 +1567,7 @@ type LMatch id body = Located (Match id body)
 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
 --   list
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data Match p body
   = Match {
         m_ext :: XCMatch p body,
@@ -1659,7 +1659,7 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats
 --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 --        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data GRHSs p body
   = GRHSs {
       grhssExt :: XCGRHSs p body,
@@ -1809,7 +1809,7 @@ type GhciStmt   id = Stmt  id (LHsExpr id)
 --         'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
 --         'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data StmtLR idL idR body -- body should always be (LHs**** idR)
   = LastStmt  -- Always the last Stmt in ListComp, MonadComp,
               -- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr
@@ -1827,7 +1827,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
             -- See Note [Monad Comprehensions]
             -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | BindStmt (XBindStmt idL idR body)
              -- ^ Post renaming has optional fail and bind / (>>=) operator.
              -- Post typechecking, also has result type of the
@@ -1861,7 +1861,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
   --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | LetStmt  (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)
 
   -- ParStmts only occur in a list/monad comprehension
@@ -1899,7 +1899,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   -- Recursive statement (see Note [How RecStmt works] below)
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | RecStmt
      { recS_ext :: XRecStmt idL idR body
      , recS_stmts :: [LStmtLR idL idR body]
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index f0f62b9fb6..d4ed3e64a0 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -48,7 +48,7 @@ type LImportDecl pass = Located (ImportDecl pass)
         --
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | If/how an import is 'qualified'.
 data ImportDeclQualifiedStyle
@@ -59,7 +59,7 @@ data ImportDeclQualifiedStyle
 
 -- | Given two possible located 'qualified' tokens, compute a style
 -- (in a conforming Haskell program only one of the two can be not
--- 'Nothing'). This is called from 'Parser.y'.
+-- 'Nothing'). This is called from 'GHC.Parser'.
 importDeclQualifiedStyle :: Maybe (Located a)
                          -> Maybe (Located a)
                          -> ImportDeclQualifiedStyle
@@ -107,7 +107,7 @@ data ImportDecl pass
      --    'ApiAnnotation.AnnClose' attached
      --     to location in ideclHiding
 
-     -- For details on above see note [Api annotations] in ApiAnnotation
+     -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 type instance XCImportDecl  (GhcPass _) = NoExtField
 type instance XXImportDecl  (GhcPass _) = NoExtCon
@@ -189,7 +189,7 @@ data IEWrappedName name
 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
 --         'ApiAnnotation.AnnPattern'
 type LIEWrappedName name = Located (IEWrappedName name)
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 
 -- | Located Import or Export
@@ -198,7 +198,7 @@ type LIE pass = Located (IE pass)
         --
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Imported or exported entity.
 data IE pass
@@ -212,7 +212,7 @@ data IE pass
         --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
         --             'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
         -- See Note [Located RdrNames] in GHC.Hs.Expr
   | IEThingAll  (XIEThingAll pass) (LIEWrappedName (IdP pass))
         -- ^ Imported or exported Thing with All imported or exported
@@ -223,7 +223,7 @@ data IE pass
         --       'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',
         --                                 'ApiAnnotation.AnnType'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
         -- See Note [Located RdrNames] in GHC.Hs.Expr
 
   | IEThingWith (XIEThingWith pass)
@@ -240,7 +240,7 @@ data IE pass
         --                                   'ApiAnnotation.AnnComma',
         --                                   'ApiAnnotation.AnnType'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | IEModuleContents  (XIEModuleContents pass) (Located ModuleName)
         -- ^ Imported or exported module contents
         --
@@ -248,7 +248,7 @@ data IE pass
         --
         -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | IEGroup             (XIEGroup pass) Int HsDocString -- ^ Doc section heading
   | IEDoc               (XIEDoc pass) HsDocString       -- ^ Some documentation
   | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index bfa8bb9ed0..2b5c871ab1 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -60,7 +60,7 @@ import GHC.Types.Basic
 -- others:
 import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
 import GHC.Driver.Session ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Var
 import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.ConLike
@@ -83,7 +83,7 @@ type LPat p = XRec p Pat
 --
 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data Pat p
   =     ------------ Simple patterns ---------------
     WildPat     (XWildPat p)        -- ^ Wildcard Pattern
@@ -99,13 +99,13 @@ data Pat p
                 (LPat p)                -- ^ Lazy Pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | AsPat       (XAsPat p)
                 (Located (IdP p)) (LPat p)    -- ^ As pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | ParPat      (XParPat p)
                 (LPat p)                -- ^ Parenthesised pattern
@@ -113,12 +113,12 @@ data Pat p
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
     --                                    'ApiAnnotation.AnnClose' @')'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | BangPat     (XBangPat p)
                 (LPat p)                -- ^ Bang pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
         ------------ Lists, tuples, arrays ---------------
   | ListPat     (XListPat p)
@@ -132,7 +132,7 @@ data Pat p
     -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
     --                                    'ApiAnnotation.AnnClose' @']'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | TuplePat    (XTuplePat p)
                   -- after typechecking, holds the types of the tuple components
@@ -170,7 +170,7 @@ data Pat p
     --            'ApiAnnotation.AnnOpen' @'(#'@,
     --            'ApiAnnotation.AnnClose' @'#)'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
         ------------ Constructor patterns ---------------
   | ConPatIn    (Located (IdP p))
@@ -201,7 +201,7 @@ data Pat p
         ------------ View patterns ---------------
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | ViewPat       (XViewPat p)     -- The overall type of the pattern
                                    -- (= the argument type of the view function)
                                    -- for hsPatType.
@@ -213,7 +213,7 @@ data Pat p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@
   --        'ApiAnnotation.AnnClose' @')'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | SplicePat       (XSplicePat p)
                     (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)
 
@@ -239,7 +239,7 @@ data Pat p
   --
   -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
                     (Located (IdP p))        -- n+k pattern
                     (Located (HsOverLit p))  -- It'll always be an HsIntegral
@@ -254,7 +254,7 @@ data Pat p
         ------------ Pattern type signatures ---------------
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
-  -- For details on above see note [Api annotations] in ApiAnnotation
+  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | SigPat          (XSigPat p)             -- After typechecker: Type
                     (LPat p)                -- Pattern with a type signature
                     (LHsSigWcType (NoGhcTc p)) --  Signature can bind both
@@ -389,7 +389,7 @@ type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
 --
 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',
 --
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data HsRecField' id arg = HsRecField {
         hsRecFieldLbl :: Located id,
         hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index d9a8ae3066..38a0300a8f 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -83,7 +83,7 @@ import GHC.Types.Name( Name, NamedThing(getName) )
 import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.DataCon( HsSrcBang(..), HsImplBang(..),
                          SrcStrictness(..), SrcUnpackedness(..) )
-import TysWiredIn( mkTupleStr )
+import GHC.Builtin.Types( mkTupleStr )
 import GHC.Core.Type
 import GHC.Hs.Doc
 import GHC.Types.Basic
@@ -284,7 +284,7 @@ quantified in left-to-right order in kind signatures is nice since:
 -- | Located Haskell Context
 type LHsContext pass = Located (HsContext pass)
       -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 noLHsContext :: LHsContext pass
 -- Use this when there is no context in the original program
@@ -302,7 +302,7 @@ type LHsType pass = Located (HsType pass)
       -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
       --   in a list
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Haskell Kind
 type HsKind pass = HsType pass
@@ -311,7 +311,7 @@ type HsKind pass = HsType pass
 type LHsKind pass = Located (HsKind pass)
       -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 --------------------------------------------------
 --             LHsQTyVars
@@ -495,7 +495,7 @@ data HsTyVarBndr pass
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --          'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
+        -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | XTyVarBndr
       !(XXTyVarBndr pass)
@@ -531,7 +531,7 @@ data HsType pass
       }
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
       --         'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsQualTy   -- See Note [HsType binders]
       { hst_xqual :: XQualTy pass
@@ -547,14 +547,14 @@ data HsType pass
                   -- See Note [Located RdrNames] in GHC.Hs.Expr
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsAppTy             (XAppTy pass)
                         (LHsType pass)
                         (LHsType pass)
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsAppKindTy         (XAppKindTy pass) -- type level type app
                         (LHsType pass)
@@ -565,14 +565,14 @@ data HsType pass
                         (LHsType pass)
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsListTy            (XListTy pass)
                         (LHsType pass)  -- Element type
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
       --         'ApiAnnotation.AnnClose' @']'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsTupleTy           (XTupleTy pass)
                         HsTupleSort
@@ -580,20 +580,20 @@ data HsType pass
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,
     --         'ApiAnnotation.AnnClose' @')' or '#)'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsSumTy             (XSumTy pass)
                         [LHsType pass]  -- Element types (length gives arity)
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
     --         'ApiAnnotation.AnnClose' '#)'@
 
-    -- For details on above see note [Api annotations] in ApiAnnotation
+    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsOpTy              (XOpTy pass)
                         (LHsType pass) (Located (IdP pass)) (LHsType pass)
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsParTy             (XParTy pass)
                         (LHsType pass)   -- See Note [Parens in HsSyn] in GHC.Hs.Expr
@@ -603,7 +603,7 @@ data HsType pass
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
       --         'ApiAnnotation.AnnClose' @')'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsIParamTy          (XIParamTy pass)
                         (Located HsIPName) -- (?x :: ty)
@@ -614,7 +614,7 @@ data HsType pass
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsStarTy            (XStarTy pass)
                         Bool             -- Is this the Unicode variant?
@@ -630,20 +630,20 @@ data HsType pass
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
       --         'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsSpliceTy          (XSpliceTy pass)
                         (HsSplice pass)   -- Includes quasi-quotes
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
       --         'ApiAnnotation.AnnClose' @')'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsDocTy             (XDocTy pass)
                         (LHsType pass) LHsDocString -- A documented type
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsBangTy    (XBangTy pass)
                 HsSrcBang (LHsType pass)   -- Bang-style type annotations
@@ -652,20 +652,20 @@ data HsType pass
       --         'ApiAnnotation.AnnClose' @'#-}'@
       --         'ApiAnnotation.AnnBang' @\'!\'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsRecTy     (XRecTy pass)
                 [LConDeclField pass]    -- Only in data type declarations
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
       --         'ApiAnnotation.AnnClose' @'}'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed*
   --                                -- Core Type through HsSyn.
   --     -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsExplicitListTy       -- A promoted explicit list
         (XExplicitListTy pass)
@@ -674,7 +674,7 @@ data HsType pass
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
       --         'ApiAnnotation.AnnClose' @']'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsExplicitTupleTy      -- A promoted explicit tuple
         (XExplicitTupleTy pass)
@@ -682,18 +682,18 @@ data HsType pass
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
       --         'ApiAnnotation.AnnClose' @')'@
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsTyLit (XTyLit pass) HsTyLit      -- A promoted numeric literal.
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   | HsWildCardTy (XWildCardTy pass)  -- A type wildcard
       -- See Note [The wildcard story for types]
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
   -- For adding new constructors via Trees that Grow
   | XHsType
@@ -857,7 +857,7 @@ type LConDeclField pass = Located (ConDeclField pass)
       -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
       --   in a list
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
 -- | Constructor Declaration Field
 data ConDeclField pass  -- Record fields have Haddock docs on them
@@ -868,7 +868,7 @@ data ConDeclField pass  -- Record fields have Haddock docs on them
                    cd_fld_doc  :: Maybe LHsDocString }
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
-      -- For details on above see note [Api annotations] in ApiAnnotation
+      -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | XConDeclField !(XXConDeclField pass)
 
 type instance XConDeclField  (GhcPass _) = NoExtField
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 0a6c2a66a6..5daa380819 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -9,7 +9,7 @@ which deal with the instantiated versions are located elsewhere:
 
    Parameterised by          Module
    ----------------          -------------
-   GhcPs/RdrName             parser/RdrHsSyn
+   GhcPs/RdrName             GHC.Parser.PostProcess
    GhcRn/Name                GHC.Rename.*
    GhcTc/Id                  GHC.Tc.Utils.Zonk
 
@@ -116,7 +116,7 @@ import GHC.Types.Var
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
 import GHC.Core.Type ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig )
-import TysWiredIn ( unitTy )
+import GHC.Builtin.Types ( unitTy )
 import GHC.Tc.Utils.TcType
 import GHC.Core.DataCon
 import GHC.Core.ConLike
@@ -130,7 +130,7 @@ import FastString
 import Util
 import Bag
 import Outputable
-import Constants
+import GHC.Settings.Constants
 
 import Data.Either
 import Data.Function
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index ea634615ed..ad445bf8bc 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -43,10 +43,10 @@ import GHC.HsToCore.Monad
 import GHC.HsToCore.Expr
 import GHC.HsToCore.Binds
 import GHC.HsToCore.Foreign.Decl
-import PrelNames
-import TysPrim
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim
 import GHC.Core.Coercion
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Core.DataCon ( dataConWrapId )
 import GHC.Core.Make
 import GHC.Types.Module
@@ -558,7 +558,7 @@ subsequent transformations could fire.
 Note [Patching magic definitions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We sometimes need to have access to defined Ids in pure contexts. Usually, we
-simply "wire in" these entities, as we do for types in TysWiredIn and for Ids
+simply "wire in" these entities, as we do for types in GHC.Builtin.Types and for Ids
 in GHC.Types.Id.Make. See Note [Wired-in Ids] in GHC.Types.Id.Make.
 
 However, it is sometimes *much* easier to define entities in Haskell,
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 856d48d946..3139610902 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -47,9 +47,9 @@ import GHC.HsToCore.Binds (dsHsWrapper)
 
 import GHC.Types.Id
 import GHC.Core.ConLike
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Basic
-import PrelNames
+import GHC.Builtin.Names
 import Outputable
 import GHC.Types.Var.Set
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index c2762d0255..cd2a786445 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -47,13 +47,13 @@ import GHC.Core.FVs
 import Digraph
 import GHC.Core.Predicate
 
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Core.TyCon
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Core.Coercion
-import TysWiredIn ( typeNatKind, typeSymbolKind )
+import GHC.Builtin.Types ( typeNatKind, typeSymbolKind )
 import GHC.Types.Id
 import GHC.Types.Id.Make(proxyHashId)
 import GHC.Types.Name
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 6dc59b978a..2432680900 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -57,8 +57,8 @@ import GHC.Types.Module
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCo.Ppr( pprWithTYPE )
-import TysWiredIn
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Names
 import GHC.Types.Basic
 import Maybes
 import GHC.Types.Var.Env
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index 1ae9f3de65..b3ecd82cf8 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -39,13 +39,13 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Types.Id   ( Id )
 import GHC.Core.Coercion
-import PrimOp
-import TysPrim
+import GHC.Builtin.PrimOps
+import GHC.Builtin.Types.Prim
 import GHC.Core.TyCon
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Types.Literal
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Driver.Session
 import Outputable
 import Util
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index f30e1bab1d..dadfc40005 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -43,9 +43,9 @@ import GHC.Cmm.Expr
 import GHC.Cmm.Utils
 import GHC.Driver.Types
 import GHC.Types.ForeignCall
-import TysWiredIn
-import TysPrim
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Names
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import Outputable
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 070b42a20f..368576cf30 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -30,9 +30,9 @@ import GHC.Driver.Session
 import GHC.Core.Utils
 import GHC.Types.Id
 import GHC.Core.Type
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.HsToCore.Match
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 import Outputable
 import GHC.Tc.Utils.TcType
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 02fb753597..c847bca068 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -52,7 +52,7 @@ import GHC.HsToCore.Match.Literal
 import GHC.Core.Type
 import GHC.Core.Coercion ( eqCoercion )
 import GHC.Core.TyCon    ( isNewTyCon )
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.SrcLoc
 import Maybes
 import Util
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 882318b163..d835e62e42 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -43,9 +43,9 @@ import GHC.Tc.Utils.Zonk ( shortCutLit )
 import GHC.Tc.Utils.TcType
 import GHC.Types.Name
 import GHC.Core.Type
-import PrelNames
-import TysWiredIn
-import TysPrim
+import GHC.Builtin.Names
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
 import GHC.Types.Literal
 import GHC.Types.SrcLoc
 import Data.Ratio
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index 78c643e478..d09473798a 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -62,7 +62,7 @@ import GHC.Core.Utils ( exprType, isExprLevPoly )
 import GHC.Hs
 import GHC.IfaceToCore
 import GHC.Tc.Utils.TcMType ( checkForLevPolyX, formatLevPolyErr )
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import Bag
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 82dc98ee8b..7fd431c434 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -37,7 +37,7 @@ import GHC.Types.Id
 import GHC.Core.ConLike
 import GHC.Types.Name
 import GHC.Tc.Instance.Family
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.SrcLoc
 import Util
 import Outputable
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index e5c0e7ac92..63cc4710dd 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -56,8 +56,8 @@ import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Core.TyCon
-import TysWiredIn
-import TysPrim (tYPETyCon)
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim (tYPETyCon)
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
 import GHC.Tc.Solver   (tcNormalise, tcCheckSatisfiability)
diff --git a/compiler/GHC/HsToCore/PmCheck/Ppr.hs b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
index 2f62b5e9be..30a5a92f2b 100644
--- a/compiler/GHC/HsToCore/PmCheck/Ppr.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
@@ -18,7 +18,7 @@ import GHC.Types.Var.Env
 import GHC.Types.Unique.DFM
 import GHC.Core.ConLike
 import GHC.Core.DataCon
-import TysWiredIn
+import GHC.Builtin.Types
 import Outputable
 import Control.Monad.Trans.RWS.CPS
 import Util
diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs
index 091e22f3ce..60ed0ce356 100644
--- a/compiler/GHC/HsToCore/PmCheck/Types.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Types.hs
@@ -61,9 +61,9 @@ import GHC.Types.Literal
 import GHC.Core
 import GHC.Core.Map
 import GHC.Core.Utils (exprType)
-import PrelNames
-import TysWiredIn
-import TysPrim
+import GHC.Builtin.Names
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
 import GHC.Tc.Utils.TcType (evVarPred)
 
 import Numeric (fromRat)
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 40df5ec734..c96eaf4e10 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -17,8 +17,8 @@
 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
 --
 -- It also defines a bunch of knownKeyNames, in the same way as is done
--- in prelude/PrelNames.  It's much more convenient to do it here, because
--- otherwise we have to recompile PrelNames whenever we add a Name, which is
+-- in prelude/GHC.Builtin.Names.  It's much more convenient to do it here, because
+-- otherwise we have to recompile GHC.Builtin.Names whenever we add a Name, which is
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
@@ -37,16 +37,16 @@ import GHC.HsToCore.Monad
 import qualified Language.Haskell.TH as TH
 
 import GHC.Hs
-import PrelNames
+import GHC.Builtin.Names
 
 import GHC.Types.Module
 import GHC.Types.Id
 import GHC.Types.Name hiding( varName, tcName )
-import THNames
+import GHC.Builtin.Names.TH
 import GHC.Types.Name.Env
 import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Core
 import GHC.Core.Make
 import GHC.Core.Utils
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 2e9c5987f8..3f0637f350 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -65,14 +65,14 @@ import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Core.Type
 import GHC.Core.Coercion
-import TysPrim
-import TysWiredIn
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Core.ConLike
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
 import GHC.Types.Module
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name( isInternalName )
 import Outputable
 import GHC.Types.SrcLoc
@@ -578,7 +578,7 @@ There are two cases.
        let { t = case e of Just (Just v) -> Unit v
            ; v = case t of Unit v -> v }
        in t `seq` body
-    The 'Unit' is a one-tuple; see Note [One-tuples] in TysWiredIn
+    The 'Unit' is a one-tuple; see Note [One-tuples] in GHC.Builtin.Types
     Note that forcing 't' makes the pattern match happen,
     but does not force 'v'.
 
@@ -599,7 +599,7 @@ There are two cases.
      - Forcing 't' will force the pattern to match fully;
        e.g. will diverge if (snd e) is bottom
      - But 'a' itself is not forced; it is wrapped in a one-tuple
-       (see Note [One-tuples] in TysWiredIn)
+       (see Note [One-tuples] in GHC.Builtin.Types)
 
   *   !(Just x) = e
     ==>
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 07a9da4c96..2e1953ade7 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -36,7 +36,7 @@ module GHC.Iface.Binary (
 import GhcPrelude
 
 import GHC.Tc.Utils.Monad
-import PrelInfo   ( isKnownKeyName, lookupKnownKeyName )
+import GHC.Builtin.Utils   ( isKnownKeyName, lookupKnownKeyName )
 import GHC.Iface.Env
 import GHC.Driver.Types
 import GHC.Types.Module
@@ -54,7 +54,7 @@ import Outputable
 import GHC.Types.Name.Cache
 import GHC.Platform
 import FastString
-import Constants
+import GHC.Settings.Constants
 import Util
 
 import Data.Array
@@ -355,7 +355,7 @@ serialiseName bh name _ = do
 --  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
 --   A known-key name. x is the Unique's Char, y is the int part. We assume that
 --   all known-key uniques fit in this space. This is asserted by
---   PrelInfo.knownKeyNamesOkay.
+--   GHC.Builtin.Utils.knownKeyNamesOkay.
 --
 -- During serialization we check for known-key things using isKnownKeyName.
 -- During deserialization we use lookupKnownKeyName to get from the unique back
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 41610d1625..c3b144dbfa 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -37,7 +37,7 @@ import GHC.Types.Name.Env         ( NameEnv, emptyNameEnv, extendNameEnv, lookup
 import GHC.Types.SrcLoc
 import GHC.Tc.Utils.Zonk          ( hsLitType, hsPatType )
 import GHC.Core.Type              ( mkVisFunTys, Type )
-import TysWiredIn                 ( mkListTy, mkSumTy )
+import GHC.Builtin.Types          ( mkListTy, mkSumTy )
 import GHC.Types.Var              ( Id, Var, setVarName, varName, varType )
 import GHC.Tc.Types
 import GHC.Iface.Make             ( mkIfaceExports )
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 1a231b95f7..a90234c60f 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -15,7 +15,7 @@ module GHC.Iface.Ext.Binary
    )
 where
 
-import GHC.Settings               ( maybeRead )
+import GHC.Settings.Utils         ( maybeRead )
 
 import Config                     ( cProjectVersion )
 import GhcPrelude
@@ -27,7 +27,7 @@ import GHC.Types.Module           ( Module )
 import GHC.Types.Name
 import GHC.Types.Name.Cache
 import Outputable
-import PrelInfo
+import GHC.Builtin.Utils
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
 import GHC.Types.Unique
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 2108e84079..8fc46734c2 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -49,12 +49,12 @@ import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Tc.Utils.Monad
 
 import Binary   ( BinData(..) )
-import Constants
-import PrelNames
-import PrelInfo
-import PrimOp   ( allThePrimOps, primOpFixity, primOpOcc )
-import GHC.Types.Id.Make ( seqId )
-import TysPrim  ( funTyConName )
+import GHC.Settings.Constants
+import GHC.Builtin.Names
+import GHC.Builtin.Utils
+import GHC.Builtin.PrimOps    ( allThePrimOps, primOpFixity, primOpOcc )
+import GHC.Types.Id.Make      ( seqId )
+import GHC.Builtin.Types.Prim ( funTyConName )
 import GHC.Core.Rules
 import GHC.Core.TyCon
 import GHC.Types.Annotations
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 4ecf9666ee..57809a6d59 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -15,9 +15,9 @@ where
 import GhcPrelude
 
 import GHC.Iface.Syntax
-import BinFingerprint
+import GHC.Iface.Recomp.Binary
 import GHC.Iface.Load
-import FlagChecker
+import GHC.Iface.Recomp.Flags
 
 import GHC.Types.Annotations
 import GHC.Core
diff --git a/compiler/GHC/Iface/Recomp/Binary.hs b/compiler/GHC/Iface/Recomp/Binary.hs
new file mode 100644
index 0000000000..55742b55eb
--- /dev/null
+++ b/compiler/GHC/Iface/Recomp/Binary.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP #-}
+
+-- | Computing fingerprints of values serializeable with GHC's "Binary" module.
+module GHC.Iface.Recomp.Binary
+  ( -- * Computing fingerprints
+    fingerprintBinMem
+  , computeFingerprint
+  , putNameLiterally
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Fingerprint
+import Binary
+import GHC.Types.Name
+import PlainPanic
+import Util
+
+fingerprintBinMem :: BinHandle -> IO Fingerprint
+fingerprintBinMem bh = withBinBuffer bh f
+  where
+    f bs =
+        -- we need to take care that we force the result here
+        -- lest a reference to the ByteString may leak out of
+        -- withBinBuffer.
+        let fp = fingerprintByteString bs
+        in fp `seq` return fp
+
+computeFingerprint :: (Binary a)
+                   => (BinHandle -> Name -> IO ())
+                   -> a
+                   -> IO Fingerprint
+computeFingerprint put_nonbinding_name a = do
+    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
+    put_ bh a
+    fp <- fingerprintBinMem bh
+    return fp
+  where
+    set_user_data bh =
+      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
+
+-- | Used when we want to fingerprint a structure without depending on the
+-- fingerprints of external Names that it refers to.
+putNameLiterally :: BinHandle -> Name -> IO ()
+putNameLiterally bh name = ASSERT( isExternalName name ) do
+    put_ bh $! nameModule name
+    put_ bh $! nameOccName name
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
new file mode 100644
index 0000000000..ff5b23b709
--- /dev/null
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- | This module manages storing the various GHC option flags in a modules
+-- interface file as part of the recompilation checking infrastructure.
+module GHC.Iface.Recomp.Flags (
+        fingerprintDynFlags
+      , fingerprintOptFlags
+      , fingerprintHpcFlags
+    ) where
+
+import GhcPrelude
+
+import Binary
+import GHC.Driver.Session
+import GHC.Driver.Types
+import GHC.Types.Module
+import GHC.Types.Name
+import Fingerprint
+import GHC.Iface.Recomp.Binary
+-- import Outputable
+
+import qualified EnumSet
+import System.FilePath (normalise)
+
+-- | Produce a fingerprint of a @DynFlags@ value. We only base
+-- the finger print on important fields in @DynFlags@ so that
+-- the recompilation checker can use this fingerprint.
+--
+-- NB: The 'Module' parameter is the 'Module' recorded by the
+-- *interface* file, not the actual 'Module' according to our
+-- 'DynFlags'.
+fingerprintDynFlags :: DynFlags -> Module
+                    -> (BinHandle -> Name -> IO ())
+                    -> IO Fingerprint
+
+fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
+    let mainis   = if mainModIs == this_mod then Just mainFunIs else Nothing
+                      -- see #5878
+        -- pkgopts  = (thisPackage dflags, sort $ packageFlags dflags)
+        safeHs   = setSafeMode safeHaskell
+        -- oflags   = sort $ filter filterOFlags $ flags dflags
+
+        -- *all* the extension flags and the language
+        lang = (fmap fromEnum language,
+                map fromEnum $ EnumSet.toList extensionFlags)
+
+        -- -I, -D and -U flags affect CPP
+        cpp = ( map normalise $ flattenIncludes includePaths
+            -- normalise: eliminate spurious differences due to "./foo" vs "foo"
+              , picPOpts dflags
+              , opt_P_signature dflags)
+            -- See Note [Repeated -optP hashing]
+
+        -- Note [path flags and recompilation]
+        paths = [ hcSuf ]
+
+        -- -fprof-auto etc.
+        prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0
+
+        -- Ticky
+        ticky =
+          map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk]
+
+        flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel))
+
+    in -- pprTrace "flags" (ppr flags) $
+       computeFingerprint nameio flags
+
+-- Fingerprint the optimisation info. We keep this separate from the rest of
+-- the flags because GHCi users (especially) may wish to ignore changes in
+-- optimisation level or optimisation flags so as to use as many pre-existing
+-- object files as they can.
+-- See Note [Ignoring some flag changes]
+fingerprintOptFlags :: DynFlags
+                      -> (BinHandle -> Name -> IO ())
+                      -> IO Fingerprint
+fingerprintOptFlags DynFlags{..} nameio =
+      let
+        -- See https://gitlab.haskell.org/ghc/ghc/issues/10923
+        -- We used to fingerprint the optimisation level, but as Joachim
+        -- Breitner pointed out in comment 9 on that ticket, it's better
+        -- to ignore that and just look at the individual optimisation flags.
+        opt_flags = map fromEnum $ filter (`EnumSet.member` optimisationFlags)
+                                          (EnumSet.toList generalFlags)
+
+      in computeFingerprint nameio opt_flags
+
+-- Fingerprint the HPC info. We keep this separate from the rest of
+-- the flags because GHCi users (especially) may wish to use an object
+-- file compiled for HPC when not actually using HPC.
+-- See Note [Ignoring some flag changes]
+fingerprintHpcFlags :: DynFlags
+                      -> (BinHandle -> Name -> IO ())
+                      -> IO Fingerprint
+fingerprintHpcFlags dflags@DynFlags{..} nameio =
+      let
+        -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798
+        -- hpcDir is output-only, so we should recompile if it changes
+        hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing
+
+      in computeFingerprint nameio hpc
+
+
+{- Note [path flags and recompilation]
+
+There are several flags that we deliberately omit from the
+recompilation check; here we explain why.
+
+-osuf, -odir, -hisuf, -hidir
+  If GHC decides that it does not need to recompile, then
+  it must have found an up-to-date .hi file and .o file.
+  There is no point recording these flags - the user must
+  have passed the correct ones.  Indeed, the user may
+  have compiled the source file in one-shot mode using
+  -o to specify the .o file, and then loaded it in GHCi
+  using -odir.
+
+-stubdir
+  We omit this one because it is automatically set by -outputdir, and
+  we don't want changes in -outputdir to automatically trigger
+  recompilation.  This could be wrong, but only in very rare cases.
+
+-i (importPaths)
+  For the same reason as -osuf etc. above: if GHC decides not to
+  recompile, then it must have already checked all the .hi files on
+  which the current module depends, so it must have found them
+  successfully.  It is occasionally useful to be able to cd to a
+  different directory and use -i flags to enable GHC to find the .hi
+  files; we don't want this to force recompilation.
+
+The only path-related flag left is -hcsuf.
+-}
+
+{- Note [Ignoring some flag changes]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Normally, --make tries to reuse only compilation products that are
+the same as those that would have been produced compiling from
+scratch. Sometimes, however, users would like to be more aggressive
+about recompilation avoidance. This is particularly likely when
+developing using GHCi (see #13604). Currently, we allow users to
+ignore optimisation changes using -fignore-optim-changes, and to
+ignore HPC option changes using -fignore-hpc-changes. If there's a
+demand for it, we could also allow changes to -fprof-auto-* flags
+(although we can't allow -prof flags to differ). The key thing about
+these options is that we can still successfully link a library or
+executable when some of its components differ in these ways.
+
+The way we accomplish this is to leave the optimization and HPC
+options out of the flag hash, hashing them separately.
+-}
+
+{- Note [Repeated -optP hashing]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We invoke fingerprintDynFlags for each compiled module to include
+the hash of relevant DynFlags in the resulting interface file.
+-optP (preprocessor) flags are part of that hash.
+-optP flags can come from multiple places:
+
+  1. -optP flags directly passed on command line.
+  2. -optP flags implied by other flags. Eg. -DPROFILING implied by -prof.
+  3. -optP flags added with {-# OPTIONS -optP-D__F__ #-} in a file.
+
+When compiling many modules at once with many -optP command line arguments
+the work of hashing -optP flags would be repeated. This can get expensive
+and as noted on #14697 it can take 7% of time and 14% of allocations on
+a real codebase.
+
+The obvious solution is to cache the hash of -optP flags per GHC invocation.
+However, one has to be careful there, as the flags that were added in 3. way
+have to be accounted for.
+
+The current strategy is as follows:
+
+  1. Lazily compute the hash of sOpt_p in sOpt_P_fingerprint whenever sOpt_p
+     is modified. This serves dual purpose. It ensures correctness for when
+     we add per file -optP flags and lets us save work for when we don't.
+  2. When computing the fingerprint in fingerprintDynFlags use the cached
+     value *and* fingerprint the additional implied (see 2. above) -optP flags.
+     This is relatively cheap and saves the headache of fingerprinting all
+     the -optP flags and tracking all the places that could invalidate the
+     cache.
+-}
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 131db67141..3c707bc348 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -45,7 +45,7 @@ module GHC.Iface.Syntax (
 import GhcPrelude
 
 import GHC.Iface.Type
-import BinFingerprint
+import GHC.Iface.Recomp.Binary
 import GHC.Core( IsOrphan, isOrphan )
 import GHC.Types.Demand
 import GHC.Types.Cpr
@@ -70,7 +70,7 @@ import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
 import Util( dropList, filterByList, notNull, unzipWith, debugIsOn )
 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
 import GHC.Utils.Lexeme (isLexSym)
-import TysWiredIn ( constraintKindTyConName )
+import GHC.Builtin.Types ( constraintKindTyConName )
 import Util (seqList)
 
 import Control.Monad
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 85b1a19f40..6aedf0fd4c 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -62,14 +62,15 @@ module GHC.Iface.Type (
 
 import GhcPrelude
 
-import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
+import {-# SOURCE #-} GHC.Builtin.Types
+                                 ( coercibleTyCon, heqTyCon
                                  , liftedRepDataConTyCon, tupleTyConName )
 import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy )
 
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Var
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name
 import GHC.Types.Basic
 import Binary
@@ -267,7 +268,7 @@ We do the same for covars, naturally.
 Note [Equality predicates in IfaceType]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 GHC has several varieties of type equality (see Note [The equality types story]
-in TysPrim for details).  In an effort to avoid confusing users, we suppress
+in GHC.Builtin.Types.Prim for details).  In an effort to avoid confusing users, we suppress
 the differences during pretty printing unless certain flags are enabled.
 Here is how each equality predicate* is printed in homogeneous and
 heterogeneous contexts, depending on which combination of the
@@ -318,7 +319,7 @@ possible since we can't see through type synonyms. Consequently, we need to
 record whether this particular application is homogeneous in IfaceTyConSort
 for the purposes of pretty-printing.
 
-See Note [The equality types story] in TysPrim.
+See Note [The equality types story] in GHC.Builtin.Types.Prim.
 -}
 
 data IfaceTyConInfo   -- Used to guide pretty-printing
@@ -343,7 +344,7 @@ data IfaceCoercion
   | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
        -- There are only a fixed number of CoAxiomRules, so it suffices
        -- to use an IfaceLclName to distinguish them.
-       -- See Note [Adding built-in type families] in TcTypeNats
+       -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
   | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
   | IfaceSymCo        IfaceCoercion
   | IfaceTransCo      IfaceCoercion IfaceCoercion
@@ -1345,7 +1346,7 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case
 --      heqTyCon         (~~)
 --
 -- See Note [Equality predicates in IfaceType]
--- and Note [The equality types story] in TysPrim
+-- and Note [The equality types story] in GHC.Builtin.Types.Prim
 ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
 ppr_equality ctxt_prec tc args
   | hetero_eq_tc
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 0ea420840d..5f3cd10cfb 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -26,7 +26,7 @@ module GHC.IfaceToCore (
 
 import GhcPrelude
 
-import TcTypeNats(typeNatCoAxiomRules)
+import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
 import GHC.Iface.Syntax
 import GHC.Iface.Load
 import GHC.Iface.Env
@@ -54,8 +54,8 @@ import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Core.ConLike
 import GHC.Core.DataCon
-import PrelNames
-import TysWiredIn
+import GHC.Builtin.Names
+import GHC.Builtin.Types
 import GHC.Types.Literal
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
new file mode 100644
index 0000000000..90b23f7ca6
--- /dev/null
+++ b/compiler/GHC/Parser.y
@@ -0,0 +1,4131 @@
+--                                                              -*-haskell-*-
+-- ---------------------------------------------------------------------------
+-- (c) The University of Glasgow 1997-2003
+---
+-- The GHC grammar.
+--
+-- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
+-- ---------------------------------------------------------------------------
+
+{
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | This module provides the generated Happy parser for Haskell. It exports
+-- a number of parsers which may be used in any library that uses the GHC API.
+-- A common usage pattern is to initialize the parser state with a given string
+-- and then parse that string:
+--
+-- @
+--     runParser :: DynFlags -> String -> P a -> ParseResult a
+--     runParser flags str parser = unP parser parseState
+--     where
+--       filename = "\<interactive\>"
+--       location = mkRealSrcLoc (mkFastString filename) 1 1
+--       buffer = stringToStringBuffer str
+--       parseState = mkPState flags buffer location
+-- @
+module GHC.Parser
+   ( parseModule, parseSignature, parseImport, parseStatement, parseBackpack
+   , parseDeclaration, parseExpression, parsePattern
+   , parseTypeSignature
+   , parseStmt, parseIdentifier
+   , parseType, parseHeader
+   )
+where
+
+-- base
+import Control.Monad    ( unless, liftM, when, (<=<) )
+import GHC.Exts
+import Data.Char
+import Data.Maybe       ( maybeToList )
+import Control.Monad    ( mplus )
+import Control.Applicative ((<$))
+import qualified Prelude
+
+-- compiler
+import GHC.Hs
+
+import GHC.Driver.Phases  ( HscSource(..) )
+import GHC.Driver.Types   ( IsBootInterface, WarningTxt(..) )
+import GHC.Driver.Session
+import GHC.Driver.Backpack.Syntax
+import UnitInfo
+
+-- compiler/utils
+import OrdList
+import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
+import FastString
+import Maybes           ( isJust, orElse )
+import Outputable
+import Util             ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
+import GhcPrelude
+
+-- compiler/basicTypes
+import GHC.Types.Name.Reader
+import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
+import GHC.Core.DataCon          ( DataCon, dataConName )
+import GHC.Types.SrcLoc
+import GHC.Types.Module
+import GHC.Types.Basic
+import GHC.Types.ForeignCall
+
+import GHC.Core.Type    ( funTyCon )
+import GHC.Core.Class   ( FunDep )
+
+-- compiler/parser
+import GHC.Parser.PostProcess
+import GHC.Parser.PostProcess.Haddock
+import GHC.Parser.Lexer
+import GHC.Parser.Annotation
+
+import GHC.Tc.Types.Evidence  ( emptyTcEvBinds )
+
+-- compiler/prelude
+import GHC.Builtin.Types.Prim ( eqPrimTyCon )
+import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
+                           unboxedUnitTyCon, unboxedUnitDataCon,
+                           listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
+}
+
+%expect 232 -- shift/reduce conflicts
+
+{- Last updated: 04 June 2018
+
+If you modify this parser and add a conflict, please update this comment.
+You can learn more about the conflicts by passing 'happy' the -i flag:
+
+    happy -agc --strict compiler/GHC/Parser.y -idetailed-info
+
+How is this section formatted? Look up the state the conflict is
+reported at, and copy the list of applicable rules (at the top, without the
+rule numbers).  Mark *** for the rule that is the conflicting reduction (that
+is, the interpretation which is NOT taken).  NB: Happy doesn't print a rule
+in a state if it is empty, but you should include it in the list (you can
+look these up in the Grammar section of the info file).
+
+Obviously the state numbers are not stable across modifications to the parser,
+the idea is to reproduce enough information on each conflict so you can figure
+out what happened if the states were renumbered.  Try not to gratuitously move
+productions around in this file.
+
+-------------------------------------------------------------------------------
+
+state 0 contains 1 shift/reduce conflicts.
+
+    Conflicts: DOCNEXT (empty missing_module_keyword reduces)
+
+Ambiguity when the source file starts with "-- | doc". We need another
+token of lookahead to determine if a top declaration or the 'module' keyword
+follows. Shift parses as if the 'module' keyword follows.
+
+-------------------------------------------------------------------------------
+
+state 60 contains 1 shift/reduce conflict.
+
+        context -> btype .
+    *** type -> btype .
+        type -> btype . '->' ctype
+
+    Conflicts: '->'
+
+-------------------------------------------------------------------------------
+
+state 61 contains 47 shift/reduce conflicts.
+
+    *** btype -> tyapps .
+        tyapps -> tyapps . tyapp
+
+    Conflicts: '_' ':' '~' '!' '.' '`' '{' '[' '(' '(#' '`' TYPEAPP
+      SIMPLEQUOTE VARID CONID VARSYM CONSYM QCONID QVARSYM QCONSYM
+      STRING INTEGER TH_ID_SPLICE '$(' TH_QUASIQUOTE TH_QQUASIQUOTE
+      and all the special ids.
+
+Example ambiguity:
+    'if x then y else z :: F a'
+
+Shift parses as (per longest-parse rule):
+    'if x then y else z :: (F a)'
+
+-------------------------------------------------------------------------------
+
+state 143 contains 15 shift/reduce conflicts.
+
+        exp -> infixexp . '::' sigtype
+        exp -> infixexp . '-<' exp
+        exp -> infixexp . '>-' exp
+        exp -> infixexp . '-<<' exp
+        exp -> infixexp . '>>-' exp
+    *** exp -> infixexp .
+        infixexp -> infixexp . qop exp10
+
+    Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-'
+               '.' '`' '*' VARSYM CONSYM QVARSYM QCONSYM
+
+Examples of ambiguity:
+    'if x then y else z -< e'
+    'if x then y else z :: T'
+    'if x then y else z + 1' (NB: '+' is in VARSYM)
+
+Shift parses as (per longest-parse rule):
+    'if x then y else (z -< T)'
+    'if x then y else (z :: T)'
+    'if x then y else (z + 1)'
+
+-------------------------------------------------------------------------------
+
+state 148 contains 67 shift/reduce conflicts.
+
+    *** exp10 -> fexp .
+        fexp -> fexp . aexp
+        fexp -> fexp . TYPEAPP atype
+
+    Conflicts: TYPEAPP and all the tokens that can start an aexp
+
+Examples of ambiguity:
+    'if x then y else f z'
+    'if x then y else f @ z'
+
+Shift parses as (per longest-parse rule):
+    'if x then y else (f z)'
+    'if x then y else (f @ z)'
+
+-------------------------------------------------------------------------------
+
+state 203 contains 27 shift/reduce conflicts.
+
+        aexp2 -> TH_TY_QUOTE . tyvar
+        aexp2 -> TH_TY_QUOTE . gtycon
+    *** aexp2 -> TH_TY_QUOTE .
+
+    Conflicts: two single quotes is error syntax with specific error message.
+
+Example of ambiguity:
+    'x = '''
+    'x = ''a'
+    'x = ''T'
+
+Shift parses as (per longest-parse rule):
+    'x = ''a'
+    'x = ''T'
+
+-------------------------------------------------------------------------------
+
+state 299 contains 1 shift/reduce conflicts.
+
+        rule -> STRING . rule_activation rule_forall infixexp '=' exp
+
+    Conflict: '[' (empty rule_activation reduces)
+
+We don't know whether the '[' starts the activation or not: it
+might be the start of the declaration with the activation being
+empty.  --SDM 1/4/2002
+
+Example ambiguity:
+    '{-# RULE [0] f = ... #-}'
+
+We parse this as having a [0] rule activation for rewriting 'f', rather
+a rule instructing how to rewrite the expression '[0] f'.
+
+-------------------------------------------------------------------------------
+
+state 309 contains 1 shift/reduce conflict.
+
+    *** type -> btype .
+        type -> btype . '->' ctype
+
+    Conflict: '->'
+
+Same as state 61 but without contexts.
+
+-------------------------------------------------------------------------------
+
+state 353 contains 1 shift/reduce conflicts.
+
+        tup_exprs -> commas . tup_tail
+        sysdcon_nolist -> '(' commas . ')'
+        commas -> commas . ','
+
+    Conflict: ')' (empty tup_tail reduces)
+
+A tuple section with NO free variables '(,,)' is indistinguishable
+from the Haskell98 data constructor for a tuple.  Shift resolves in
+favor of sysdcon, which is good because a tuple section will get rejected
+if -XTupleSections is not specified.
+
+See also Note [ExplicitTuple] in GHC.Hs.Expr.
+
+-------------------------------------------------------------------------------
+
+state 408 contains 1 shift/reduce conflicts.
+
+        tup_exprs -> commas . tup_tail
+        sysdcon_nolist -> '(#' commas . '#)'
+        commas -> commas . ','
+
+    Conflict: '#)' (empty tup_tail reduces)
+
+Same as State 354 for unboxed tuples.
+
+-------------------------------------------------------------------------------
+
+state 416 contains 67 shift/reduce conflicts.
+
+    *** exp10 -> '-' fexp .
+        fexp -> fexp . aexp
+        fexp -> fexp . TYPEAPP atype
+
+Same as 149 but with a unary minus.
+
+-------------------------------------------------------------------------------
+
+state 481 contains 1 shift/reduce conflict.
+
+        oqtycon -> '(' qtyconsym . ')'
+    *** qtyconop -> qtyconsym .
+
+    Conflict: ')'
+
+Example ambiguity: 'foo :: (:%)'
+
+Shift means '(:%)' gets parsed as a type constructor, rather than than a
+parenthesized infix type expression of length 1.
+
+-------------------------------------------------------------------------------
+
+state 678 contains 1 shift/reduce conflicts.
+
+    *** aexp2 -> ipvar .
+        dbind -> ipvar . '=' exp
+
+    Conflict: '='
+
+Example ambiguity: 'let ?x ...'
+
+The parser can't tell whether the ?x is the lhs of a normal binding or
+an implicit binding.  Fortunately, resolving as shift gives it the only
+sensible meaning, namely the lhs of an implicit binding.
+
+-------------------------------------------------------------------------------
+
+state 756 contains 1 shift/reduce conflicts.
+
+        rule -> STRING rule_activation . rule_forall infixexp '=' exp
+
+    Conflict: 'forall' (empty rule_forall reduces)
+
+Example ambiguity: '{-# RULES "name" forall = ... #-}'
+
+'forall' is a valid variable name---we don't know whether
+to treat a forall on the input as the beginning of a quantifier
+or the beginning of the rule itself.  Resolving to shift means
+it's always treated as a quantifier, hence the above is disallowed.
+This saves explicitly defining a grammar for the rule lhs that
+doesn't include 'forall'.
+
+-------------------------------------------------------------------------------
+
+state 992 contains 1 shift/reduce conflicts.
+
+        transformqual -> 'then' 'group' . 'using' exp
+        transformqual -> 'then' 'group' . 'by' exp 'using' exp
+    *** special_id -> 'group' .
+
+    Conflict: 'by'
+
+-------------------------------------------------------------------------------
+
+state 1089 contains 1 shift/reduce conflicts.
+
+        rule_foralls -> 'forall' rule_vars '.' . 'forall' rule_vars '.'
+    *** rule_foralls -> 'forall' rule_vars '.' .
+
+    Conflict: 'forall'
+
+Example ambiguity: '{-# RULES "name" forall a. forall ... #-}'
+
+Here the parser cannot tell whether the second 'forall' is the beginning of
+a term-level quantifier, for example:
+
+'{-# RULES "name" forall a. forall x. id @a x = x #-}'
+
+or a valid variable named 'forall', for example a function @:: Int -> Int@
+
+'{-# RULES "name" forall a. forall 0 = 0 #-}'
+
+Shift means the parser only allows the former. Also see conflict 753 above.
+
+-------------------------------------------------------------------------------
+
+state 1390 contains 1 shift/reduce conflict.
+
+    *** atype -> tyvar .
+        tv_bndr -> '(' tyvar . '::' kind ')'
+
+    Conflict: '::'
+
+Example ambiguity: 'class C a where type D a = ( a :: * ...'
+
+Here the parser cannot tell whether this is specifying a default for the
+associated type like:
+
+'class C a where type D a = ( a :: * ); type D a'
+
+or it is an injectivity signature like:
+
+'class C a where type D a = ( r :: * ) | r -> a'
+
+Shift means the parser only allows the latter.
+
+-------------------------------------------------------------------------------
+-- API Annotations
+--
+
+A lot of the productions are now cluttered with calls to
+aa,am,ams,amms etc.
+
+These are helper functions to make sure that the locations of the
+various keywords such as do / let / in are captured for use by tools
+that want to do source to source conversions, such as refactorers or
+structured editors.
+
+The helper functions are defined at the bottom of this file.
+
+See
+  https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations and
+  https://gitlab.haskell.org/ghc/ghc/wikis/ghc-ast-annotations
+for some background.
+
+If you modify the parser and want to ensure that the API annotations are processed
+correctly, see the README in (REPO)/utils/check-api-annotations for details on
+how to set up a test using the check-api-annotations utility, and interpret the
+output it generates.
+
+Note [Parsing lists]
+---------------------
+You might be wondering why we spend so much effort encoding our lists this
+way:
+
+importdecls
+        : importdecls ';' importdecl
+        | importdecls ';'
+        | importdecl
+        | {- empty -}
+
+This might seem like an awfully roundabout way to declare a list; plus, to add
+insult to injury you have to reverse the results at the end.  The answer is that
+left recursion prevents us from running out of stack space when parsing long
+sequences.  See: https://www.haskell.org/happy/doc/html/sec-sequences.html for
+more guidance.
+
+By adding/removing branches, you can affect what lists are accepted.  Here
+are the most common patterns, rewritten as regular expressions for clarity:
+
+    -- Equivalent to: ';'* (x ';'+)* x?  (can be empty, permits leading/trailing semis)
+    xs : xs ';' x
+       | xs ';'
+       | x
+       | {- empty -}
+
+    -- Equivalent to x (';' x)* ';'*  (non-empty, permits trailing semis)
+    xs : xs ';' x
+       | xs ';'
+       | x
+
+    -- Equivalent to ';'* alts (';' alts)* ';'* (non-empty, permits leading/trailing semis)
+    alts : alts1
+         | ';' alts
+    alts1 : alts1 ';' alt
+          | alts1 ';'
+          | alt
+
+    -- Equivalent to x (',' x)+ (non-empty, no trailing semis)
+    xs : x
+       | x ',' xs
+
+-- -----------------------------------------------------------------------------
+
+-}
+
+%token
+ '_'            { L _ ITunderscore }            -- Haskell keywords
+ 'as'           { L _ ITas }
+ 'case'         { L _ ITcase }
+ 'class'        { L _ ITclass }
+ 'data'         { L _ ITdata }
+ 'default'      { L _ ITdefault }
+ 'deriving'     { L _ ITderiving }
+ 'do'           { L _ ITdo }
+ 'else'         { L _ ITelse }
+ 'hiding'       { L _ IThiding }
+ 'if'           { L _ ITif }
+ 'import'       { L _ ITimport }
+ 'in'           { L _ ITin }
+ 'infix'        { L _ ITinfix }
+ 'infixl'       { L _ ITinfixl }
+ 'infixr'       { L _ ITinfixr }
+ 'instance'     { L _ ITinstance }
+ 'let'          { L _ ITlet }
+ 'module'       { L _ ITmodule }
+ 'newtype'      { L _ ITnewtype }
+ 'of'           { L _ ITof }
+ 'qualified'    { L _ ITqualified }
+ 'then'         { L _ ITthen }
+ 'type'         { L _ ITtype }
+ 'where'        { L _ ITwhere }
+
+ 'forall'       { L _ (ITforall _) }                -- GHC extension keywords
+ 'foreign'      { L _ ITforeign }
+ 'export'       { L _ ITexport }
+ 'label'        { L _ ITlabel }
+ 'dynamic'      { L _ ITdynamic }
+ 'safe'         { L _ ITsafe }
+ 'interruptible' { L _ ITinterruptible }
+ 'unsafe'       { L _ ITunsafe }
+ 'mdo'          { L _ ITmdo }
+ 'family'       { L _ ITfamily }
+ 'role'         { L _ ITrole }
+ 'stdcall'      { L _ ITstdcallconv }
+ 'ccall'        { L _ ITccallconv }
+ 'capi'         { L _ ITcapiconv }
+ 'prim'         { L _ ITprimcallconv }
+ 'javascript'   { L _ ITjavascriptcallconv }
+ 'proc'         { L _ ITproc }          -- for arrow notation extension
+ 'rec'          { L _ ITrec }           -- for arrow notation extension
+ 'group'    { L _ ITgroup }     -- for list transform extension
+ 'by'       { L _ ITby }        -- for list transform extension
+ 'using'    { L _ ITusing }     -- for list transform extension
+ 'pattern'      { L _ ITpattern } -- for pattern synonyms
+ 'static'       { L _ ITstatic }  -- for static pointers extension
+ 'stock'        { L _ ITstock }    -- for DerivingStrategies extension
+ 'anyclass'     { L _ ITanyclass } -- for DerivingStrategies extension
+ 'via'          { L _ ITvia }      -- for DerivingStrategies extension
+
+ 'unit'         { L _ ITunit }
+ 'signature'    { L _ ITsignature }
+ 'dependency'   { L _ ITdependency }
+
+ '{-# INLINE'             { L _ (ITinline_prag _ _ _) } -- INLINE or INLINABLE
+ '{-# SPECIALISE'         { L _ (ITspec_prag _) }
+ '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
+ '{-# SOURCE'             { L _ (ITsource_prag _) }
+ '{-# RULES'              { L _ (ITrules_prag _) }
+ '{-# CORE'               { L _ (ITcore_prag _) }      -- hdaume: annotated core
+ '{-# SCC'                { L _ (ITscc_prag _)}
+ '{-# GENERATED'          { L _ (ITgenerated_prag _) }
+ '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }
+ '{-# WARNING'            { L _ (ITwarning_prag _) }
+ '{-# UNPACK'             { L _ (ITunpack_prag _) }
+ '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
+ '{-# ANN'                { L _ (ITann_prag _) }
+ '{-# MINIMAL'            { L _ (ITminimal_prag _) }
+ '{-# CTYPE'              { L _ (ITctype _) }
+ '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
+ '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }
+ '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }
+ '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }
+ '{-# COMPLETE'           { L _ (ITcomplete_prag _)   }
+ '#-}'                    { L _ ITclose_prag }
+
+ '..'           { L _ ITdotdot }                        -- reserved symbols
+ ':'            { L _ ITcolon }
+ '::'           { L _ (ITdcolon _) }
+ '='            { L _ ITequal }
+ '\\'           { L _ ITlam }
+ 'lcase'        { L _ ITlcase }
+ '|'            { L _ ITvbar }
+ '<-'           { L _ (ITlarrow _) }
+ '->'           { L _ (ITrarrow _) }
+ TIGHT_INFIX_AT { L _ ITat }
+ '=>'           { L _ (ITdarrow _) }
+ '-'            { L _ ITminus }
+ PREFIX_TILDE   { L _ ITtilde }
+ PREFIX_BANG    { L _ ITbang }
+ '*'            { L _ (ITstar _) }
+ '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
+ '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
+ '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
+ '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation
+ '.'            { L _ ITdot }
+ PREFIX_AT      { L _ ITtypeApp }
+
+ '{'            { L _ ITocurly }                        -- special symbols
+ '}'            { L _ ITccurly }
+ vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
+ vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
+ '['            { L _ ITobrack }
+ ']'            { L _ ITcbrack }
+ '('            { L _ IToparen }
+ ')'            { L _ ITcparen }
+ '(#'           { L _ IToubxparen }
+ '#)'           { L _ ITcubxparen }
+ '(|'           { L _ (IToparenbar _) }
+ '|)'           { L _ (ITcparenbar _) }
+ ';'            { L _ ITsemi }
+ ','            { L _ ITcomma }
+ '`'            { L _ ITbackquote }
+ SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
+
+ VARID          { L _ (ITvarid    _) }          -- identifiers
+ CONID          { L _ (ITconid    _) }
+ VARSYM         { L _ (ITvarsym   _) }
+ CONSYM         { L _ (ITconsym   _) }
+ QVARID         { L _ (ITqvarid   _) }
+ QCONID         { L _ (ITqconid   _) }
+ QVARSYM        { L _ (ITqvarsym  _) }
+ QCONSYM        { L _ (ITqconsym  _) }
+
+ IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
+ LABELVARID     { L _ (ITlabelvarid   _) }
+
+ CHAR           { L _ (ITchar   _ _) }
+ STRING         { L _ (ITstring _ _) }
+ INTEGER        { L _ (ITinteger _) }
+ RATIONAL       { L _ (ITrational _) }
+
+ PRIMCHAR       { L _ (ITprimchar   _ _) }
+ PRIMSTRING     { L _ (ITprimstring _ _) }
+ PRIMINTEGER    { L _ (ITprimint    _ _) }
+ PRIMWORD       { L _ (ITprimword   _ _) }
+ PRIMFLOAT      { L _ (ITprimfloat  _) }
+ PRIMDOUBLE     { L _ (ITprimdouble _) }
+
+ DOCNEXT        { L _ (ITdocCommentNext _) }
+ DOCPREV        { L _ (ITdocCommentPrev _) }
+ DOCNAMED       { L _ (ITdocCommentNamed _) }
+ DOCSECTION     { L _ (ITdocSection _ _) }
+
+-- Template Haskell
+'[|'            { L _ (ITopenExpQuote _ _) }
+'[p|'           { L _ ITopenPatQuote  }
+'[t|'           { L _ ITopenTypQuote  }
+'[d|'           { L _ ITopenDecQuote  }
+'|]'            { L _ (ITcloseQuote _) }
+'[||'           { L _ (ITopenTExpQuote _) }
+'||]'           { L _ ITcloseTExpQuote  }
+PREFIX_DOLLAR   { L _ ITdollar }
+PREFIX_DOLLAR_DOLLAR { L _ ITdollardollar }
+TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
+TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
+TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
+
+%monad { P } { >>= } { return }
+%lexer { (lexer True) } { L _ ITeof }
+  -- Replace 'lexer' above with 'lexerDbg'
+  -- to dump the tokens fed to the parser.
+%tokentype { (Located Token) }
+
+-- Exported parsers
+%name parseModule module
+%name parseSignature signature
+%name parseImport importdecl
+%name parseStatement e_stmt
+%name parseDeclaration topdecl
+%name parseExpression exp
+%name parsePattern pat
+%name parseTypeSignature sigdecl
+%name parseStmt   maybe_stmt
+%name parseIdentifier  identifier
+%name parseType ktype
+%name parseBackpack backpack
+%partial parseHeader header
+%%
+
+-----------------------------------------------------------------------------
+-- Identifiers; one of the entry points
+identifier :: { Located RdrName }
+        : qvar                          { $1 }
+        | qcon                          { $1 }
+        | qvarop                        { $1 }
+        | qconop                        { $1 }
+    | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
+                               [mop $1,mu AnnRarrow $2,mcp $3] }
+
+-----------------------------------------------------------------------------
+-- Backpack stuff
+
+backpack :: { [LHsUnit PackageName] }
+         : implicit_top units close { fromOL $2 }
+         | '{' units '}'            { fromOL $2 }
+
+units :: { OrdList (LHsUnit PackageName) }
+         : units ';' unit { $1 `appOL` unitOL $3 }
+         | units ';'      { $1 }
+         | unit           { unitOL $1 }
+
+unit :: { LHsUnit PackageName }
+        : 'unit' pkgname 'where' unitbody
+            { sL1 $1 $ HsUnit { hsunitName = $2
+                              , hsunitBody = fromOL $4 } }
+
+unitid :: { LHsUnitId PackageName }
+        : pkgname                  { sL1 $1 $ HsUnitId $1 [] }
+        | pkgname '[' msubsts ']'  { sLL $1 $> $ HsUnitId $1 (fromOL $3) }
+
+msubsts :: { OrdList (LHsModuleSubst PackageName) }
+        : msubsts ',' msubst { $1 `appOL` unitOL $3 }
+        | msubsts ','        { $1 }
+        | msubst             { unitOL $1 }
+
+msubst :: { LHsModuleSubst PackageName }
+        : modid '=' moduleid { sLL $1 $> $ ($1, $3) }
+        | modid VARSYM modid VARSYM { sLL $1 $> $ ($1, sLL $2 $> $ HsModuleVar $3) }
+
+moduleid :: { LHsModuleId PackageName }
+          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar $2 }
+          | unitid ':' modid    { sLL $1 $> $ HsModuleId $1 $3 }
+
+pkgname :: { Located PackageName }
+        : STRING     { sL1 $1 $ PackageName (getSTRING $1) }
+        | litpkgname { sL1 $1 $ PackageName (unLoc $1) }
+
+litpkgname_segment :: { Located FastString }
+        : VARID  { sL1 $1 $ getVARID $1 }
+        | CONID  { sL1 $1 $ getCONID $1 }
+        | special_id { $1 }
+
+litpkgname :: { Located FastString }
+        : litpkgname_segment { $1 }
+        -- a bit of a hack, means p - b is parsed same as p-b, enough for now.
+        | litpkgname_segment '-' litpkgname  { sLL $1 $> $ appendFS (unLoc $1) (consFS '-' (unLoc $3)) }
+
+mayberns :: { Maybe [LRenaming] }
+        : {- empty -} { Nothing }
+        | '(' rns ')' { Just (fromOL $2) }
+
+rns :: { OrdList LRenaming }
+        : rns ',' rn { $1 `appOL` unitOL $3 }
+        | rns ','    { $1 }
+        | rn         { unitOL $1 }
+
+rn :: { LRenaming }
+        : modid 'as' modid { sLL $1 $> $ Renaming $1 (Just $3) }
+        | modid            { sL1 $1    $ Renaming $1 Nothing }
+
+unitbody :: { OrdList (LHsUnitDecl PackageName) }
+        : '{'     unitdecls '}'   { $2 }
+        | vocurly unitdecls close { $2 }
+
+unitdecls :: { OrdList (LHsUnitDecl PackageName) }
+        : unitdecls ';' unitdecl { $1 `appOL` unitOL $3 }
+        | unitdecls ';'         { $1 }
+        | unitdecl              { unitOL $1 }
+
+unitdecl :: { LHsUnitDecl PackageName }
+        : maybedocheader 'module' maybe_src  modid maybemodwarning maybeexports 'where' body
+             -- XXX not accurate
+             { sL1 $2 $ DeclD
+                 (case snd $3 of
+                   False -> HsSrcFile
+                   True  -> HsBootFile)
+                 $4
+                 (Just $ sL1 $2 (HsModule (Just $4) $6 (fst $ snd $8) (snd $ snd $8) $5 $1)) }
+        | maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
+             { sL1 $2 $ DeclD
+                 HsigFile
+                 $3
+                 (Just $ sL1 $2 (HsModule (Just $3) $5 (fst $ snd $7) (snd $ snd $7) $4 $1)) }
+        -- NB: MUST have maybedocheader here, otherwise shift-reduce conflict
+        -- will prevent us from parsing both forms.
+        | maybedocheader 'module' maybe_src modid
+             { sL1 $2 $ DeclD (case snd $3 of
+                   False -> HsSrcFile
+                   True  -> HsBootFile) $4 Nothing }
+        | maybedocheader 'signature' modid
+             { sL1 $2 $ DeclD HsigFile $3 Nothing }
+        | 'dependency' unitid mayberns
+             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2
+                                              , idModRenaming = $3
+                                              , idSignatureInclude = False }) }
+        | 'dependency' 'signature' unitid
+             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $3
+                                              , idModRenaming = Nothing
+                                              , idSignatureInclude = True }) }
+
+-----------------------------------------------------------------------------
+-- Module Header
+
+-- The place for module deprecation is really too restrictive, but if it
+-- was allowed at its natural place just before 'module', we get an ugly
+-- s/r conflict with the second alternative. Another solution would be the
+-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
+-- either, and DEPRECATED is only expected to be used by people who really
+-- know what they are doing. :-)
+
+signature :: { Located HsModule }
+       : maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
+             {% fileSrcSpan >>= \ loc ->
+                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
+                              (snd $ snd $7) $4 $1)
+                    )
+                    ([mj AnnSignature $2, mj AnnWhere $6] ++ fst $7) }
+
+module :: { Located HsModule }
+       : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
+             {% fileSrcSpan >>= \ loc ->
+                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
+                              (snd $ snd $7) $4 $1)
+                    )
+                    ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
+        | body2
+                {% fileSrcSpan >>= \ loc ->
+                   ams (L loc (HsModule Nothing Nothing
+                               (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
+                       (fst $1) }
+
+maybedocheader :: { Maybe LHsDocString }
+        : moduleheader            { $1 }
+        | {- empty -}             { Nothing }
+
+missing_module_keyword :: { () }
+        : {- empty -}                           {% pushModuleContext }
+
+implicit_top :: { () }
+        : {- empty -}                           {% pushModuleContext }
+
+maybemodwarning :: { Maybe (Located WarningTxt) }
+    : '{-# DEPRECATED' strings '#-}'
+                      {% ajs (sLL $1 $> $ DeprecatedTxt (sL1 $1 (getDEPRECATED_PRAGs $1)) (snd $ unLoc $2))
+                             (mo $1:mc $3: (fst $ unLoc $2)) }
+    | '{-# WARNING' strings '#-}'
+                         {% ajs (sLL $1 $> $ WarningTxt (sL1 $1 (getWARNING_PRAGs $1)) (snd $ unLoc $2))
+                                (mo $1:mc $3 : (fst $ unLoc $2)) }
+    |  {- empty -}                  { Nothing }
+
+body    :: { ([AddAnn]
+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
+        :  '{'            top '}'      { (moc $1:mcc $3:(fst $2)
+                                         , snd $2) }
+        |      vocurly    top close    { (fst $2, snd $2) }
+
+body2   :: { ([AddAnn]
+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
+        :  '{' top '}'                          { (moc $1:mcc $3
+                                                   :(fst $2), snd $2) }
+        |  missing_module_keyword top close     { ([],snd $2) }
+
+
+top     :: { ([AddAnn]
+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])) }
+        : semis top1                            { ($1, $2) }
+
+top1    :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }
+        : importdecls_semi topdecls_semi        { (reverse $1, cvTopDecls $2) }
+        | importdecls_semi topdecls             { (reverse $1, cvTopDecls $2) }
+        | importdecls                           { (reverse $1, []) }
+
+-----------------------------------------------------------------------------
+-- Module declaration & imports only
+
+header  :: { Located HsModule }
+        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
+                {% fileSrcSpan >>= \ loc ->
+                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
+                          )) [mj AnnModule $2,mj AnnWhere $6] }
+        | maybedocheader 'signature' modid maybemodwarning maybeexports 'where' header_body
+                {% fileSrcSpan >>= \ loc ->
+                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
+                          )) [mj AnnModule $2,mj AnnWhere $6] }
+        | header_body2
+                {% fileSrcSpan >>= \ loc ->
+                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
+                          Nothing)) }
+
+header_body :: { [LImportDecl GhcPs] }
+        :  '{'            header_top            { $2 }
+        |      vocurly    header_top            { $2 }
+
+header_body2 :: { [LImportDecl GhcPs] }
+        :  '{' header_top                       { $2 }
+        |  missing_module_keyword header_top    { $2 }
+
+header_top :: { [LImportDecl GhcPs] }
+        :  semis header_top_importdecls         { $2 }
+
+header_top_importdecls :: { [LImportDecl GhcPs] }
+        :  importdecls_semi                     { $1 }
+        |  importdecls                          { $1 }
+
+-----------------------------------------------------------------------------
+-- The Export List
+
+maybeexports :: { (Maybe (Located [LIE GhcPs])) }
+        :  '(' exportlist ')'       {% amsL (comb2 $1 $>) [mop $1,mcp $3] >>
+                                       return (Just (sLL $1 $> (fromOL $2))) }
+        |  {- empty -}              { Nothing }
+
+exportlist :: { OrdList (LIE GhcPs) }
+        : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
+                                         >> return ($1 `appOL` $3) }
+        | exportlist1                 { $1 }
+
+exportlist1 :: { OrdList (LIE GhcPs) }
+        : expdoclist export expdoclist ',' exportlist1
+                          {% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
+                                            AnnComma (gl $4) ) >>
+                              return ($1 `appOL` $2 `appOL` $3 `appOL` $5) }
+        | expdoclist export expdoclist             { $1 `appOL` $2 `appOL` $3 }
+        | expdoclist                               { $1 }
+
+expdoclist :: { OrdList (LIE GhcPs) }
+        : exp_doc expdoclist                           { $1 `appOL` $2 }
+        | {- empty -}                                  { nilOL }
+
+exp_doc :: { OrdList (LIE GhcPs) }
+        : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExtField n doc)) }
+        | docnamed      { unitOL (sL1 $1 (IEDocNamed noExtField ((fst . unLoc) $1))) }
+        | docnext       { unitOL (sL1 $1 (IEDoc noExtField (unLoc $1))) }
+
+
+   -- No longer allow things like [] and (,,,) to be exported
+   -- They are built in syntax, always available
+export  :: { OrdList (LIE GhcPs) }
+        : qcname_ext export_subspec  {% mkModuleImpExp $1 (snd $ unLoc $2)
+                                          >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
+        |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents noExtField $2))
+                                             [mj AnnModule $1] }
+        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar noExtField (sLL $1 $> (IEPattern $2))))
+                                             [mj AnnPattern $1] }
+
+export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
+        : {- empty -}             { sL0 ([],ImpExpAbs) }
+        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse (snd $2))
+                                      >>= \(as,ie) -> return $ sLL $1 $>
+                                            (as ++ [mop $1,mcp $3] ++ fst $2, ie) }
+
+
+qcnames :: { ([AddAnn], [Located ImpExpQcSpec]) }
+  : {- empty -}                   { ([],[]) }
+  | qcnames1                      { $1 }
+
+qcnames1 :: { ([AddAnn], [Located ImpExpQcSpec]) }     -- A reversed list
+        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
+                                                    l@(L _ ImpExpQcWildcard) ->
+                                                       return ([mj AnnComma $2, mj AnnDotdot l]
+                                                               ,(snd (unLoc $3)  : snd $1))
+                                                    l -> (ams (head (snd $1)) [mj AnnComma $2] >>
+                                                          return (fst $1 ++ fst (unLoc $3),
+                                                                  snd (unLoc $3) : snd $1)) }
+
+
+        -- Annotations re-added in mkImpExpSubSpec
+        |  qcname_ext_w_wildcard                   { (fst (unLoc $1),[snd (unLoc $1)]) }
+
+-- Variable, data constructor or wildcard
+-- or tagged type constructor
+qcname_ext_w_wildcard :: { Located ([AddAnn], Located ImpExpQcSpec) }
+        :  qcname_ext               { sL1 $1 ([],$1) }
+        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 ImpExpQcWildcard)  }
+
+qcname_ext :: { Located ImpExpQcSpec }
+        :  qcname                   { sL1 $1 (ImpExpQcName $1) }
+        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2
+                                          ; ams (sLL $1 $> (ImpExpQcType n))
+                                                [mj AnnType $1] } }
+
+qcname  :: { Located RdrName }  -- Variable or type constructor
+        :  qvar                 { $1 } -- Things which look like functions
+                                       -- Note: This includes record selectors but
+                                       -- also (-.->), see #11432
+        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]
+
+-----------------------------------------------------------------------------
+-- Import Declarations
+
+-- importdecls and topdecls must contain at least one declaration;
+-- top handles the fact that these may be optional.
+
+-- One or more semicolons
+semis1  :: { [AddAnn] }
+semis1  : semis1 ';'  { mj AnnSemi $2 : $1 }
+        | ';'         { [mj AnnSemi $1] }
+
+-- Zero or more semicolons
+semis   :: { [AddAnn] }
+semis   : semis ';'   { mj AnnSemi $2 : $1 }
+        | {- empty -} { [] }
+
+-- No trailing semicolons, non-empty
+importdecls :: { [LImportDecl GhcPs] }
+importdecls
+        : importdecls_semi importdecl
+                                { $2 : $1 }
+
+-- May have trailing semicolons, can be empty
+importdecls_semi :: { [LImportDecl GhcPs] }
+importdecls_semi
+        : importdecls_semi importdecl semis1
+                                {% ams $2 $3 >> return ($2 : $1) }
+        | {- empty -}           { [] }
+
+importdecl :: { LImportDecl GhcPs }
+        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
+                {% do {
+                  ; checkImportDecl $4 $7
+                  ; ams (L (comb4 $1 $6 (snd $8) $9) $
+                      ImportDecl { ideclExt = noExtField
+                                  , ideclSourceSrc = snd $ fst $2
+                                  , ideclName = $6, ideclPkgQual = snd $5
+                                  , ideclSource = snd $2, ideclSafe = snd $3
+                                  , ideclQualified = importDeclQualifiedStyle $4 $7
+                                  , ideclImplicit = False
+                                  , ideclAs = unLoc (snd $8)
+                                  , ideclHiding = unLoc $9 })
+                         (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4)
+                                          ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8)
+                  }
+                }
+
+
+maybe_src :: { (([AddAnn],SourceText),IsBootInterface) }
+        : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],getSOURCE_PRAGs $1)
+                                      , True) }
+        | {- empty -}               { (([],NoSourceText),False) }
+
+maybe_safe :: { ([AddAnn],Bool) }
+        : 'safe'                                { ([mj AnnSafe $1],True) }
+        | {- empty -}                           { ([],False) }
+
+maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
+        : STRING  {% do { let { pkgFS = getSTRING $1 }
+                        ; unless (looksLikePackageName (unpackFS pkgFS)) $
+                             addError (getLoc $1) $ vcat [
+                             text "Parse error" <> colon <+> quotes (ppr pkgFS),
+                             text "Version number or non-alphanumeric" <+>
+                             text "character in package name"]
+                        ; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
+        | {- empty -}                           { ([],Nothing) }
+
+optqualified :: { Maybe (Located Token) }
+        : 'qualified'                           { Just $1 }
+        | {- empty -}                           { Nothing }
+
+maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
+        : 'as' modid                           { ([mj AnnAs $1]
+                                                 ,sLL $1 $> (Just $2)) }
+        | {- empty -}                          { ([],noLoc Nothing) }
+
+maybeimpspec :: { Located (Maybe (Bool, Located [LIE GhcPs])) }
+        : impspec                  {% let (b, ie) = unLoc $1 in
+                                       checkImportSpec ie
+                                        >>= \checkedIe ->
+                                          return (L (gl $1) (Just (b, checkedIe)))  }
+        | {- empty -}              { noLoc Nothing }
+
+impspec :: { Located (Bool, Located [LIE GhcPs]) }
+        :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
+                                                      sLL $1 $> $ fromOL $2))
+                                                   [mop $1,mcp $3] }
+        |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
+                                                      sLL $1 $> $ fromOL $3))
+                                               [mj AnnHiding $1,mop $2,mcp $4] }
+
+-----------------------------------------------------------------------------
+-- Fixity Declarations
+
+prec    :: { Located (SourceText,Int) }
+        : {- empty -}           { noLoc (NoSourceText,9) }
+        | INTEGER
+                 { sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1))) }
+
+infix   :: { Located FixityDirection }
+        : 'infix'                               { sL1 $1 InfixN  }
+        | 'infixl'                              { sL1 $1 InfixL  }
+        | 'infixr'                              { sL1 $1 InfixR }
+
+ops     :: { Located (OrdList (Located RdrName)) }
+        : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
+                              return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
+        | op               { sL1 $1 (unitOL $1) }
+
+-----------------------------------------------------------------------------
+-- Top-Level Declarations
+
+-- No trailing semicolons, non-empty
+topdecls :: { OrdList (LHsDecl GhcPs) }
+        : topdecls_semi topdecl        { $1 `snocOL` $2 }
+
+-- May have trailing semicolons, can be empty
+topdecls_semi :: { OrdList (LHsDecl GhcPs) }
+        : topdecls_semi topdecl semis1 {% ams $2 $3 >> return ($1 `snocOL` $2) }
+        | {- empty -}                  { nilOL }
+
+topdecl :: { LHsDecl GhcPs }
+        : cl_decl                               { sL1 $1 (TyClD noExtField (unLoc $1)) }
+        | ty_decl                               { sL1 $1 (TyClD noExtField (unLoc $1)) }
+        | standalone_kind_sig                   { sL1 $1 (KindSigD noExtField (unLoc $1)) }
+        | inst_decl                             { sL1 $1 (InstD noExtField (unLoc $1)) }
+        | stand_alone_deriving                  { sLL $1 $> (DerivD noExtField (unLoc $1)) }
+        | role_annot                            { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) }
+        | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD noExtField (DefaultDecl noExtField $3)))
+                                                         [mj AnnDefault $1
+                                                         ,mop $2,mcp $4] }
+        | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
+                                           (mj AnnForeign $1:(fst $ unLoc $2)) }
+        | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getDEPRECATED_PRAGs $1) (fromOL $2)))
+                                                       [mo $1,mc $3] }
+        | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getWARNING_PRAGs $1) (fromOL $2)))
+                                                       [mo $1,mc $3] }
+        | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD noExtField (HsRules noExtField (getRULES_PRAGs $1) (fromOL $2)))
+                                                       [mo $1,mc $3] }
+        | annotation { $1 }
+        | decl_no_th                            { $1 }
+
+        -- Template Haskell Extension
+        -- The $(..) form is one possible form of infixexp
+        -- but we treat an arbitrary expression just as if
+        -- it had a $(..) wrapped around it
+        | infixexp                              {% runECP_P $1 >>= \ $1 ->
+                                                   return $ sLL $1 $> $ mkSpliceDecl $1 }
+
+-- Type classes
+--
+cl_decl :: { LTyClDecl GhcPs }
+        : 'class' tycl_hdr fds where_cls
+                {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
+                        (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
+
+-- Type declarations (toplevel)
+--
+ty_decl :: { LTyClDecl GhcPs }
+           -- ordinary type synonyms
+        : 'type' type '=' ktypedoc
+                -- Note ktypedoc, not sigtype, on the right of '='
+                -- We allow an explicit for-all but we don't insert one
+                -- in   type Foo a = (b,b)
+                -- Instead we just say b is out of scope
+                --
+                -- Note the use of type for the head; this allows
+                -- infix type constructors to be declared
+                {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
+                        [mj AnnType $1,mj AnnEqual $3] }
+
+           -- type family declarations
+        | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info
+                          where_type_family
+                -- Note the use of type for the head; this allows
+                -- infix type constructors to be declared
+                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
+                                   (snd $ unLoc $4) (snd $ unLoc $5))
+                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
+                           ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
+
+          -- ordinary data type or newtype declaration
+        | data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
+                {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
+                           Nothing (reverse (snd $ unLoc $4))
+                                   (fmap reverse $5))
+                                   -- We need the location on tycl_hdr in case
+                                   -- constrs and deriving are both empty
+                        ((fst $ unLoc $1):(fst $ unLoc $4)) }
+
+          -- ordinary GADT declaration
+        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
+                 gadt_constrlist
+                 maybe_derivings
+            {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
+                            (snd $ unLoc $4) (snd $ unLoc $5)
+                            (fmap reverse $6) )
+                                   -- We need the location on tycl_hdr in case
+                                   -- constrs and deriving are both empty
+                    ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
+
+          -- data/newtype family
+        | 'data' 'family' type opt_datafam_kind_sig
+                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
+                                   (snd $ unLoc $4) Nothing)
+                        (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
+
+-- standalone kind signature
+standalone_kind_sig :: { LStandaloneKindSig GhcPs }
+  : 'type' sks_vars '::' ktypedoc
+      {% amms (mkStandaloneKindSig (comb2 $1 $4) $2 $4)
+              [mj AnnType $1,mu AnnDcolon $3] }
+
+-- See also: sig_vars
+sks_vars :: { Located [Located RdrName] }  -- Returned in reverse order
+  : sks_vars ',' oqtycon
+      {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
+         return (sLL $1 $> ($3 : unLoc $1)) }
+  | oqtycon { sL1 $1 [$1] }
+
+inst_decl :: { LInstDecl GhcPs }
+        : 'instance' overlap_pragma inst_type where_inst
+       {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
+             ; let cid = ClsInstDecl { cid_ext = noExtField
+                                     , cid_poly_ty = $3, cid_binds = binds
+                                     , cid_sigs = mkClassOpSigs sigs
+                                     , cid_tyfam_insts = ats
+                                     , cid_overlap_mode = $2
+                                     , cid_datafam_insts = adts }
+             ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))
+                   (mj AnnInstance $1 : (fst $ unLoc $4)) } }
+
+           -- type instance declarations
+        | 'type' 'instance' ty_fam_inst_eqn
+                {% ams $3 (fst $ unLoc $3)
+                >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
+                    (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
+
+          -- data/newtype instance declaration
+        | data_or_newtype 'instance' capi_ctype tycl_hdr_inst constrs
+                          maybe_derivings
+            {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4)
+                                      Nothing (reverse (snd  $ unLoc $5))
+                                              (fmap reverse $6))
+                    ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
+
+          -- GADT instance declaration
+        | data_or_newtype 'instance' capi_ctype tycl_hdr_inst opt_kind_sig
+                 gadt_constrlist
+                 maybe_derivings
+            {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (snd $ unLoc $4)
+                                   (snd $ unLoc $5) (snd $ unLoc $6)
+                                   (fmap reverse $7))
+                    ((fst $ unLoc $1):mj AnnInstance $2
+                       :(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) }
+
+overlap_pragma :: { Maybe (Located OverlapMode) }
+  : '{-# OVERLAPPABLE'    '#-}' {% ajs (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
+                                       [mo $1,mc $2] }
+  | '{-# OVERLAPPING'     '#-}' {% ajs (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))
+                                       [mo $1,mc $2] }
+  | '{-# OVERLAPS'        '#-}' {% ajs (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))
+                                       [mo $1,mc $2] }
+  | '{-# INCOHERENT'      '#-}' {% ajs (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))
+                                       [mo $1,mc $2] }
+  | {- empty -}                 { Nothing }
+
+deriv_strategy_no_via :: { LDerivStrategy GhcPs }
+  : 'stock'                     {% ams (sL1 $1 StockStrategy)
+                                       [mj AnnStock $1] }
+  | 'anyclass'                  {% ams (sL1 $1 AnyclassStrategy)
+                                       [mj AnnAnyclass $1] }
+  | 'newtype'                   {% ams (sL1 $1 NewtypeStrategy)
+                                       [mj AnnNewtype $1] }
+
+deriv_strategy_via :: { LDerivStrategy GhcPs }
+  : 'via' type              {% ams (sLL $1 $> (ViaStrategy (mkLHsSigType $2)))
+                                            [mj AnnVia $1] }
+
+deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }
+  : 'stock'                     {% ajs (sL1 $1 StockStrategy)
+                                       [mj AnnStock $1] }
+  | 'anyclass'                  {% ajs (sL1 $1 AnyclassStrategy)
+                                       [mj AnnAnyclass $1] }
+  | 'newtype'                   {% ajs (sL1 $1 NewtypeStrategy)
+                                       [mj AnnNewtype $1] }
+  | deriv_strategy_via          { Just $1 }
+  | {- empty -}                 { Nothing }
+
+-- Injective type families
+
+opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn GhcPs)) }
+        : {- empty -}               { noLoc ([], Nothing) }
+        | '|' injectivity_cond      { sLL $1 $> ([mj AnnVbar $1]
+                                                , Just ($2)) }
+
+injectivity_cond :: { LInjectivityAnn GhcPs }
+        : tyvarid '->' inj_varids
+           {% ams (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))
+                  [mu AnnRarrow $2] }
+
+inj_varids :: { Located [Located RdrName] }
+        : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }
+        | tyvarid             { sLL $1 $> [$1]            }
+
+-- Closed type families
+
+where_type_family :: { Located ([AddAnn],FamilyInfo GhcPs) }
+        : {- empty -}                      { noLoc ([],OpenTypeFamily) }
+        | 'where' ty_fam_inst_eqn_list
+               { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
+                    ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
+
+ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn GhcPs]) }
+        :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
+                                                ,Just (unLoc $2)) }
+        | vocurly ty_fam_inst_eqns close   { let (L loc _) = $2 in
+                                             L loc ([],Just (unLoc $2)) }
+        |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
+                                                 ,mcc $3],Nothing) }
+        | vocurly '..' close               { let (L loc _) = $2 in
+                                             L loc ([mj AnnDotdot $2],Nothing) }
+
+ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
+        : ty_fam_inst_eqns ';' ty_fam_inst_eqn
+                                      {% let (L loc (anns, eqn)) = $3 in
+                                         asl (unLoc $1) $2 (L loc eqn)
+                                         >> ams $3 anns
+                                         >> return (sLL $1 $> (L loc eqn : unLoc $1)) }
+        | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
+                                         >> return (sLL $1 $>  (unLoc $1)) }
+        | ty_fam_inst_eqn             {% let (L loc (anns, eqn)) = $1 in
+                                         ams $1 anns
+                                         >> return (sLL $1 $> [L loc eqn]) }
+        | {- empty -}                 { noLoc [] }
+
+ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) }
+        : 'forall' tv_bndrs '.' type '=' ktype
+              {% do { hintExplicitForall $1
+                    ; (eqn,ann) <- mkTyFamInstEqn (Just $2) $4 $6
+                    ; return (sLL $1 $>
+                               (mu AnnForall $1:mj AnnDot $3:mj AnnEqual $5:ann,eqn)) } }
+        | type '=' ktype
+              {% do { (eqn,ann) <- mkTyFamInstEqn Nothing $1 $3
+                    ; return (sLL $1 $> (mj AnnEqual $2:ann, eqn))  } }
+              -- Note the use of type for the head; this allows
+              -- infix type constructors and type patterns
+
+-- Associated type family declarations
+--
+-- * They have a different syntax than on the toplevel (no family special
+--   identifier).
+--
+-- * They also need to be separate from instances; otherwise, data family
+--   declarations without a kind signature cause parsing conflicts with empty
+--   data declarations.
+--
+at_decl_cls :: { LHsDecl GhcPs }
+        :  -- data family declarations, with optional 'family' keyword
+          'data' opt_family type opt_datafam_kind_sig
+                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
+                                                  (snd $ unLoc $4) Nothing))
+                        (mj AnnData $1:$2++(fst $ unLoc $4)) }
+
+           -- type family declarations, with optional 'family' keyword
+           -- (can't use opt_instance because you get shift/reduce errors
+        | 'type' type opt_at_kind_inj_sig
+               {% amms (liftM mkTyClD
+                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2
+                                   (fst . snd $ unLoc $3)
+                                   (snd . snd $ unLoc $3)))
+                       (mj AnnType $1:(fst $ unLoc $3)) }
+        | 'type' 'family' type opt_at_kind_inj_sig
+               {% amms (liftM mkTyClD
+                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3
+                                   (fst . snd $ unLoc $4)
+                                   (snd . snd $ unLoc $4)))
+                       (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
+
+           -- default type instances, with optional 'instance' keyword
+        | 'type' ty_fam_inst_eqn
+                {% ams $2 (fst $ unLoc $2) >>
+                   amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
+                        (mj AnnType $1:(fst $ unLoc $2)) }
+        | 'type' 'instance' ty_fam_inst_eqn
+                {% ams $3 (fst $ unLoc $3) >>
+                   amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
+                        (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
+
+opt_family   :: { [AddAnn] }
+              : {- empty -}   { [] }
+              | 'family'      { [mj AnnFamily $1] }
+
+opt_instance :: { [AddAnn] }
+              : {- empty -} { [] }
+              | 'instance'  { [mj AnnInstance $1] }
+
+-- Associated type instances
+--
+at_decl_inst :: { LInstDecl GhcPs }
+           -- type instance declarations, with optional 'instance' keyword
+        : 'type' opt_instance ty_fam_inst_eqn
+                -- Note the use of type for the head; this allows
+                -- infix type constructors and type patterns
+                {% ams $3 (fst $ unLoc $3) >>
+                   amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
+                        (mj AnnType $1:$2++(fst $ unLoc $3)) }
+
+        -- data/newtype instance declaration, with optional 'instance' keyword
+        | data_or_newtype opt_instance capi_ctype tycl_hdr_inst constrs maybe_derivings
+               {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4)
+                                    Nothing (reverse (snd $ unLoc $5))
+                                            (fmap reverse $6))
+                       ((fst $ unLoc $1):$2++(fst $ unLoc $4)++(fst $ unLoc $5)) }
+
+        -- GADT instance declaration, with optional 'instance' keyword
+        | data_or_newtype opt_instance capi_ctype tycl_hdr_inst opt_kind_sig
+                 gadt_constrlist
+                 maybe_derivings
+                {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3
+                                (snd $ unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6)
+                                (fmap reverse $7))
+                        ((fst $ unLoc $1):$2++(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) }
+
+data_or_newtype :: { Located (AddAnn, NewOrData) }
+        : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
+        | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
+
+-- Family result/return kind signatures
+
+opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind GhcPs)) }
+        :               { noLoc     ([]               , Nothing) }
+        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
+
+opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
+        :               { noLoc     ([]               , noLoc (NoSig noExtField)         )}
+        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExtField $2))}
+
+opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
+        :              { noLoc     ([]               , noLoc     (NoSig    noExtField)   )}
+        | '::' kind    { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig  noExtField $2))}
+        | '='  tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExtField $2))}
+
+opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig GhcPs
+                                            , Maybe (LInjectivityAnn GhcPs)))}
+        :            { noLoc ([], (noLoc (NoSig noExtField), Nothing)) }
+        | '::' kind  { sLL $1 $> ( [mu AnnDcolon $1]
+                                 , (sLL $2 $> (KindSig noExtField $2), Nothing)) }
+        | '='  tv_bndr '|' injectivity_cond
+                { sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]
+                            , (sLL $1 $2 (TyVarSig noExtField $2), Just $4))}
+
+-- tycl_hdr parses the header of a class or data type decl,
+-- which takes the form
+--      T a b
+--      Eq a => T a
+--      (Eq a, Ord b) => T a b
+--      T Int [a]                       -- for associated types
+-- Rather a lot of inlining here, else we get reduce/reduce errors
+tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }
+        : context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
+                                       >> (return (sLL $1 $> (Just $1, $3)))
+                                    }
+        | type                      { sL1 $1 (Nothing, $1) }
+
+tycl_hdr_inst :: { Located ([AddAnn],(Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs)) }
+        : 'forall' tv_bndrs '.' context '=>' type   {% hintExplicitForall $1
+                                                       >> (addAnnotation (gl $4) (toUnicodeAnn AnnDarrow $5) (gl $5)
+                                                           >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3]
+                                                                                , (Just $4, Just $2, $6)))
+                                                          )
+                                                    }
+        | 'forall' tv_bndrs '.' type   {% hintExplicitForall $1
+                                          >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3]
+                                                               , (Nothing, Just $2, $4)))
+                                       }
+        | context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
+                                       >> (return (sLL $1 $>([], (Just $1, Nothing, $3))))
+                                    }
+        | type                      { sL1 $1 ([], (Nothing, Nothing, $1)) }
+
+
+capi_ctype :: { Maybe (Located CType) }
+capi_ctype : '{-# CTYPE' STRING STRING '#-}'
+                       {% ajs (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
+                                        (getSTRINGs $3,getSTRING $3)))
+                              [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
+
+           | '{-# CTYPE'        STRING '#-}'
+                       {% ajs (sLL $1 $> (CType (getCTYPEs $1) Nothing (getSTRINGs $2, getSTRING $2)))
+                              [mo $1,mj AnnVal $2,mc $3] }
+
+           |           { Nothing }
+
+-----------------------------------------------------------------------------
+-- Stand-alone deriving
+
+-- Glasgow extension: stand-alone deriving declarations
+stand_alone_deriving :: { LDerivDecl GhcPs }
+  : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type
+                {% do { let { err = text "in the stand-alone deriving instance"
+                                    <> colon <+> quotes (ppr $5) }
+                      ; ams (sLL $1 (hsSigType $>)
+                                 (DerivDecl noExtField (mkHsWildCardBndrs $5) $2 $4))
+                            [mj AnnDeriving $1, mj AnnInstance $3] } }
+
+-----------------------------------------------------------------------------
+-- Role annotations
+
+role_annot :: { LRoleAnnotDecl GhcPs }
+role_annot : 'type' 'role' oqtycon maybe_roles
+          {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
+                  [mj AnnType $1,mj AnnRole $2] }
+
+-- Reversed!
+maybe_roles :: { Located [Located (Maybe FastString)] }
+maybe_roles : {- empty -}    { noLoc [] }
+            | roles          { $1 }
+
+roles :: { Located [Located (Maybe FastString)] }
+roles : role             { sLL $1 $> [$1] }
+      | roles role       { sLL $1 $> $ $2 : unLoc $1 }
+
+-- read it in as a varid for better error messages
+role :: { Located (Maybe FastString) }
+role : VARID             { sL1 $1 $ Just $ getVARID $1 }
+     | '_'               { sL1 $1 Nothing }
+
+-- Pattern synonyms
+
+-- Glasgow extension: pattern synonyms
+pattern_synonym_decl :: { LHsDecl GhcPs }
+        : 'pattern' pattern_synonym_lhs '=' pat
+         {%      let (name, args,as ) = $2 in
+                 ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4
+                                                    ImplicitBidirectional)
+               (as ++ [mj AnnPattern $1, mj AnnEqual $3])
+         }
+
+        | 'pattern' pattern_synonym_lhs '<-' pat
+         {%    let (name, args, as) = $2 in
+               ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional)
+               (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
+
+        | 'pattern' pattern_synonym_lhs '<-' pat where_decls
+            {% do { let (name, args, as) = $2
+                  ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
+                  ; ams (sLL $1 $> . ValD noExtField $
+                           mkPatSynBind name args $4 (ExplicitBidirectional mg))
+                       (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
+                   }}
+
+pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) }
+        : con vars0 { ($1, PrefixCon $2, []) }
+        | varid conop varid { ($2, InfixCon $1 $3, []) }
+        | con '{' cvars1 '}' { ($1, RecCon $3, [moc $2, mcc $4] ) }
+
+vars0 :: { [Located RdrName] }
+        : {- empty -}                 { [] }
+        | varid vars0                 { $1 : $2 }
+
+cvars1 :: { [RecordPatSynField (Located RdrName)] }
+       : var                          { [RecordPatSynField $1 $1] }
+       | var ',' cvars1               {% addAnnotation (getLoc $1) AnnComma (getLoc $2) >>
+                                         return ((RecordPatSynField $1 $1) : $3 )}
+
+where_decls :: { Located ([AddAnn]
+                         , Located (OrdList (LHsDecl GhcPs))) }
+        : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
+                                           :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
+        | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
+                                          ,sL1 $3 (snd $ unLoc $3)) }
+
+pattern_synonym_sig :: { LSig GhcPs }
+        : 'pattern' con_list '::' sigtypedoc
+                   {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) (mkLHsSigType $4))
+                          [mj AnnPattern $1, mu AnnDcolon $3] }
+
+-----------------------------------------------------------------------------
+-- Nested declarations
+
+-- Declaration in class bodies
+--
+decl_cls  :: { LHsDecl GhcPs }
+decl_cls  : at_decl_cls                 { $1 }
+          | decl                        { $1 }
+
+          -- A 'default' signature used with the generic-programming extension
+          | 'default' infixexp '::' sigtypedoc
+                    {% runECP_P $2 >>= \ $2 ->
+                       do { v <- checkValSigLhs $2
+                          ; let err = text "in default signature" <> colon <+>
+                                      quotes (ppr $2)
+                          ; ams (sLL $1 $> $ SigD noExtField $ ClassOpSig noExtField True [v] $ mkLHsSigType $4)
+                                [mj AnnDefault $1,mu AnnDcolon $3] } }
+
+decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }  -- Reversed
+          : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
+                                             then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                                    , unitOL $3))
+                                             else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
+                                           >> return (sLL $1 $> (fst $ unLoc $1
+                                                                ,(snd $ unLoc $1) `appOL` unitOL $3)) }
+          | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
+                                             then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                                                   ,snd $ unLoc $1))
+                                             else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
+                                           >> return (sLL $1 $>  (unLoc $1)) }
+          | decl_cls                    { sL1 $1 ([], unitOL $1) }
+          | {- empty -}                 { noLoc ([],nilOL) }
+
+decllist_cls
+        :: { Located ([AddAnn]
+                     , OrdList (LHsDecl GhcPs)) }      -- Reversed
+        : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
+                                             ,snd $ unLoc $2) }
+        |     vocurly decls_cls close   { $2 }
+
+-- Class body
+--
+where_cls :: { Located ([AddAnn]
+                       ,(OrdList (LHsDecl GhcPs))) }    -- Reversed
+                                -- No implicit parameters
+                                -- May have type declarations
+        : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
+                                             ,snd $ unLoc $2) }
+        | {- empty -}                   { noLoc ([],nilOL) }
+
+-- Declarations in instance bodies
+--
+decl_inst  :: { Located (OrdList (LHsDecl GhcPs)) }
+decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) }
+           | decl                       { sLL $1 $> (unitOL $1) }
+
+decls_inst :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }   -- Reversed
+           : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
+                                             then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                                    , unLoc $3))
+                                             else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
+                                           >> return
+                                            (sLL $1 $> (fst $ unLoc $1
+                                                       ,(snd $ unLoc $1) `appOL` unLoc $3)) }
+           | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)
+                                             then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                                                   ,snd $ unLoc $1))
+                                             else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
+                                           >> return (sLL $1 $> (unLoc $1)) }
+           | decl_inst                  { sL1 $1 ([],unLoc $1) }
+           | {- empty -}                { noLoc ([],nilOL) }
+
+decllist_inst
+        :: { Located ([AddAnn]
+                     , OrdList (LHsDecl GhcPs)) }      -- Reversed
+        : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
+        |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }
+
+-- Instance body
+--
+where_inst :: { Located ([AddAnn]
+                        , OrdList (LHsDecl GhcPs)) }   -- Reversed
+                                -- No implicit parameters
+                                -- May have type declarations
+        : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
+                                             ,(snd $ unLoc $2)) }
+        | {- empty -}                   { noLoc ([],nilOL) }
+
+-- Declarations in binding groups other than classes and instances
+--
+decls   :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }
+        : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
+                                 then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                        , unitOL $3))
+                                 else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
+                                           >> return (
+                                          let { this = unitOL $3;
+                                                rest = snd $ unLoc $1;
+                                                these = rest `appOL` this }
+                                          in rest `seq` this `seq` these `seq`
+                                             (sLL $1 $> (fst $ unLoc $1,these))) }
+        | decls ';'          {% if isNilOL (snd $ unLoc $1)
+                                  then return (sLL $1 $> ((mj AnnSemi $2:(fst $ unLoc $1)
+                                                          ,snd $ unLoc $1)))
+                                  else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
+                                           >> return (sLL $1 $> (unLoc $1)) }
+        | decl                          { sL1 $1 ([], unitOL $1) }
+        | {- empty -}                   { noLoc ([],nilOL) }
+
+decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl GhcPs))) }
+        : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
+                                                   ,sL1 $2 $ snd $ unLoc $2) }
+        |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
+
+-- Binding groups other than those of class and instance declarations
+--
+binds   ::  { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
+                                         -- May have implicit parameters
+                                                -- No type declarations
+        : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
+                                  ; return (sL1 $1 (fst $ unLoc $1
+                                                    ,sL1 $1 $ HsValBinds noExtField val_binds)) } }
+
+        | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
+                                             ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
+
+        |     vocurly    dbinds close   { L (getLoc $2) ([]
+                                            ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
+
+
+wherebinds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
+                                                -- May have implicit parameters
+                                                -- No type declarations
+        : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
+                                             ,snd $ unLoc $2) }
+        | {- empty -}                   { noLoc ([],noLoc emptyLocalBinds) }
+
+
+-----------------------------------------------------------------------------
+-- Transformation Rules
+
+rules   :: { OrdList (LRuleDecl GhcPs) }
+        :  rules ';' rule              {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return ($1 `snocOL` $3) }
+        |  rules ';'                   {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return $1 }
+        |  rule                        { unitOL $1 }
+        |  {- empty -}                 { nilOL }
+
+rule    :: { LRuleDecl GhcPs }
+        : STRING rule_activation rule_foralls infixexp '=' exp
+         {%runECP_P $4 >>= \ $4 ->
+           runECP_P $6 >>= \ $6 ->
+           ams (sLL $1 $> $ HsRule { rd_ext = noExtField
+                                   , rd_name = L (gl $1) (getSTRINGs $1, getSTRING $1)
+                                   , rd_act = (snd $2) `orElse` AlwaysActive
+                                   , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3
+                                   , rd_lhs = $4, rd_rhs = $6 })
+               (mj AnnEqual $5 : (fst $2) ++ (fstOf3 $3)) }
+
+-- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
+rule_activation :: { ([AddAnn],Maybe Activation) }
+        : {- empty -}                           { ([],Nothing) }
+        | rule_explicit_activation              { (fst $1,Just (snd $1)) }
+
+-- This production is used to parse the tilde syntax in pragmas such as
+--   * {-# INLINE[~2] ... #-}
+--   * {-# SPECIALISE [~ 001] ... #-}
+--   * {-# RULES ... [~0] ... g #-}
+-- Note that it can be written either
+--   without a space [~1]  (the PREFIX_TILDE case), or
+--   with    a space [~ 1] (the VARSYM case).
+-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+rule_activation_marker :: { [AddAnn] }
+      : PREFIX_TILDE { [mj AnnTilde $1] }
+      | VARSYM  {% if (getVARSYM $1 == fsLit "~")
+                   then return [mj AnnTilde $1]
+                   else do { addError (getLoc $1) $ text "Invalid rule activation marker"
+                           ; return [] } }
+
+rule_explicit_activation :: { ([AddAnn]
+                              ,Activation) }  -- In brackets
+        : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
+                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
+        | '[' rule_activation_marker INTEGER ']'
+                                { ($2++[mos $1,mj AnnVal $3,mcs $4]
+                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
+        | '[' rule_activation_marker ']'
+                                { ($2++[mos $1,mcs $3]
+                                  ,NeverActive) }
+
+rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]) }
+        : 'forall' rule_vars '.' 'forall' rule_vars '.'    {% let tyvs = mkRuleTyVarBndrs $2
+                                                              in hintExplicitForall $1
+                                                              >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2)
+                                                              >> return ([mu AnnForall $1,mj AnnDot $3,
+                                                                          mu AnnForall $4,mj AnnDot $6],
+                                                                         Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) }
+        | 'forall' rule_vars '.'                           { ([mu AnnForall $1,mj AnnDot $3],
+                                                              Nothing, mkRuleBndrs $2) }
+        | {- empty -}                                      { ([], Nothing, []) }
+
+rule_vars :: { [LRuleTyTmVar] }
+        : rule_var rule_vars                    { $1 : $2 }
+        | {- empty -}                           { [] }
+
+rule_var :: { LRuleTyTmVar }
+        : varid                         { sLL $1 $> (RuleTyTmVar $1 Nothing) }
+        | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleTyTmVar $2 (Just $4)))
+                                               [mop $1,mu AnnDcolon $3,mcp $5] }
+
+{- Note [Parsing explicit foralls in Rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We really want the above definition of rule_foralls to be:
+
+  rule_foralls : 'forall' tv_bndrs '.' 'forall' rule_vars '.'
+               | 'forall' rule_vars '.'
+               | {- empty -}
+
+where rule_vars (term variables) can be named "forall", "family", or "role",
+but tv_vars (type variables) cannot be. However, such a definition results
+in a reduce/reduce conflict. For example, when parsing:
+> {-# RULE "name" forall a ... #-}
+before the '...' it is impossible to determine whether we should be in the
+first or second case of the above.
+
+This is resolved by using rule_vars (which is more general) for both, and
+ensuring that type-level quantified variables do not have the names "forall",
+"family", or "role" in the function 'checkRuleTyVarBndrNames' in
+GHC.Parser.PostProcess.
+Thus, whenever the definition of tyvarid (used for tv_bndrs) is changed relative
+to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
+-}
+
+-----------------------------------------------------------------------------
+-- Warnings and deprecations (c.f. rules)
+
+warnings :: { OrdList (LWarnDecl GhcPs) }
+        : warnings ';' warning         {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return ($1 `appOL` $3) }
+        | warnings ';'                 {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return $1 }
+        | warning                      { $1 }
+        | {- empty -}                  { nilOL }
+
+-- SUP: TEMPORARY HACK, not checking for `module Foo'
+warning :: { OrdList (LWarnDecl GhcPs) }
+        : namelist strings
+                {% amsu (sLL $1 $> (Warning noExtField (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
+                     (fst $ unLoc $2) }
+
+deprecations :: { OrdList (LWarnDecl GhcPs) }
+        : deprecations ';' deprecation
+                                       {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return ($1 `appOL` $3) }
+        | deprecations ';'             {% addAnnotation (oll $1) AnnSemi (gl $2)
+                                          >> return $1 }
+        | deprecation                  { $1 }
+        | {- empty -}                  { nilOL }
+
+-- SUP: TEMPORARY HACK, not checking for `module Foo'
+deprecation :: { OrdList (LWarnDecl GhcPs) }
+        : namelist strings
+             {% amsu (sLL $1 $> $ (Warning noExtField (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
+                     (fst $ unLoc $2) }
+
+strings :: { Located ([AddAnn],[Located StringLiteral]) }
+    : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
+    | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
+
+stringlist :: { Located (OrdList (Located StringLiteral)) }
+    : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
+                               return (sLL $1 $> (unLoc $1 `snocOL`
+                                                  (L (gl $3) (getStringLiteral $3)))) }
+    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }
+    | {- empty -}           { noLoc nilOL }
+
+-----------------------------------------------------------------------------
+-- Annotations
+annotation :: { LHsDecl GhcPs }
+    : '{-# ANN' name_var aexp '#-}'      {% runECP_P $3 >>= \ $3 ->
+                                            ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
+                                            (getANN_PRAGs $1)
+                                            (ValueAnnProvenance $2) $3))
+                                            [mo $1,mc $4] }
+
+    | '{-# ANN' 'type' tycon aexp '#-}'  {% runECP_P $4 >>= \ $4 ->
+                                            ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
+                                            (getANN_PRAGs $1)
+                                            (TypeAnnProvenance $3) $4))
+                                            [mo $1,mj AnnType $2,mc $5] }
+
+    | '{-# ANN' 'module' aexp '#-}'      {% runECP_P $3 >>= \ $3 ->
+                                            ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
+                                                (getANN_PRAGs $1)
+                                                 ModuleAnnProvenance $3))
+                                                [mo $1,mj AnnModule $2,mc $4] }
+
+
+-----------------------------------------------------------------------------
+-- Foreign import and export declarations
+
+fdecl :: { Located ([AddAnn],HsDecl GhcPs) }
+fdecl : 'import' callconv safety fspec
+               {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
+                 return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
+      | 'import' callconv        fspec
+               {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
+                    return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
+      | 'export' callconv fspec
+               {% mkExport $2 (snd $ unLoc $3) >>= \i ->
+                  return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
+
+callconv :: { Located CCallConv }
+          : 'stdcall'                   { sLL $1 $> StdCallConv }
+          | 'ccall'                     { sLL $1 $> CCallConv   }
+          | 'capi'                      { sLL $1 $> CApiConv    }
+          | 'prim'                      { sLL $1 $> PrimCallConv}
+          | 'javascript'                { sLL $1 $> JavaScriptCallConv }
+
+safety :: { Located Safety }
+        : 'unsafe'                      { sLL $1 $> PlayRisky }
+        | 'safe'                        { sLL $1 $> PlaySafe }
+        | 'interruptible'               { sLL $1 $> PlayInterruptible }
+
+fspec :: { Located ([AddAnn]
+                    ,(Located StringLiteral, Located RdrName, LHsSigType GhcPs)) }
+       : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
+                                             ,(L (getLoc $1)
+                                                    (getStringLiteral $1), $2, mkLHsSigType $4)) }
+       |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
+                                             ,(noLoc (StringLiteral NoSourceText nilFS), $1, mkLHsSigType $3)) }
+         -- if the entity string is missing, it defaults to the empty string;
+         -- the meaning of an empty entity string depends on the calling
+         -- convention
+
+-----------------------------------------------------------------------------
+-- Type signatures
+
+opt_sig :: { ([AddAnn], Maybe (LHsType GhcPs)) }
+        : {- empty -}                   { ([],Nothing) }
+        | '::' sigtype                  { ([mu AnnDcolon $1],Just $2) }
+
+opt_tyconsig :: { ([AddAnn], Maybe (Located RdrName)) }
+             : {- empty -}              { ([], Nothing) }
+             | '::' gtycon              { ([mu AnnDcolon $1], Just $2) }
+
+sigtype :: { LHsType GhcPs }
+        : ctype                            { $1 }
+
+sigtypedoc :: { LHsType GhcPs }
+        : ctypedoc                         { $1 }
+
+
+sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
+         : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
+                                                       AnnComma (gl $2)
+                                         >> return (sLL $1 $> ($3 : unLoc $1)) }
+         | var                        { sL1 $1 [$1] }
+
+sigtypes1 :: { (OrdList (LHsSigType GhcPs)) }
+   : sigtype                 { unitOL (mkLHsSigType $1) }
+   | sigtype ',' sigtypes1   {% addAnnotation (gl $1) AnnComma (gl $2)
+                                >> return (unitOL (mkLHsSigType $1) `appOL` $3) }
+
+-----------------------------------------------------------------------------
+-- Types
+
+unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
+        : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], getUNPACK_PRAGs $1, SrcUnpack) }
+        | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) }
+
+forall_vis_flag :: { (AddAnn, ForallVisFlag) }
+        : '.'  { (mj AnnDot $1,    ForallInvis) }
+        | '->' { (mu AnnRarrow $1, ForallVis)   }
+
+-- A ktype/ktypedoc is a ctype/ctypedoc, possibly with a kind annotation
+ktype :: { LHsType GhcPs }
+        : ctype                { $1 }
+        | ctype '::' kind      {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3)
+                                      [mu AnnDcolon $2] }
+
+ktypedoc :: { LHsType GhcPs }
+         : ctypedoc            { $1 }
+         | ctypedoc '::' kind  {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3)
+                                      [mu AnnDcolon $2] }
+
+-- A ctype is a for-all type
+ctype   :: { LHsType GhcPs }
+        : 'forall' tv_bndrs forall_vis_flag ctype
+                                        {% let (fv_ann, fv_flag) = $3 in
+                                           hintExplicitForall $1 *>
+                                           ams (sLL $1 $> $
+                                                HsForAllTy { hst_fvf = fv_flag
+                                                           , hst_bndrs = $2
+                                                           , hst_xforall = noExtField
+                                                           , hst_body = $4 })
+                                               [mu AnnForall $1,fv_ann] }
+        | context '=>' ctype          {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
+                                         >> return (sLL $1 $> $
+                                            HsQualTy { hst_ctxt = $1
+                                                     , hst_xqual = noExtField
+                                                     , hst_body = $3 }) }
+        | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3))
+                                             [mu AnnDcolon $2] }
+        | type                        { $1 }
+
+-- Note [ctype and ctypedoc]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- It would have been nice to simplify the grammar by unifying `ctype` and
+-- ctypedoc` into one production, allowing comments on types everywhere (and
+-- rejecting them after parsing, where necessary).  This is however not possible
+-- since it leads to ambiguity. The reason is the support for comments on record
+-- fields:
+--         data R = R { field :: Int -- ^ comment on the field }
+-- If we allow comments on types here, it's not clear if the comment applies
+-- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
+
+ctypedoc :: { LHsType GhcPs }
+        : 'forall' tv_bndrs forall_vis_flag ctypedoc
+                                         {% let (fv_ann, fv_flag) = $3 in
+                                            hintExplicitForall $1 *>
+                                            ams (sLL $1 $> $
+                                                 HsForAllTy { hst_fvf = fv_flag
+                                                            , hst_bndrs = $2
+                                                            , hst_xforall = noExtField
+                                                            , hst_body = $4 })
+                                                [mu AnnForall $1,fv_ann] }
+        | context '=>' ctypedoc       {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
+                                         >> return (sLL $1 $> $
+                                            HsQualTy { hst_ctxt = $1
+                                                     , hst_xqual = noExtField
+                                                     , hst_body = $3 }) }
+        | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3))
+                                             [mu AnnDcolon $2] }
+        | typedoc                     { $1 }
+
+----------------------
+-- Notes for 'context'
+-- We parse a context as a btype so that we don't get reduce/reduce
+-- errors in ctype.  The basic problem is that
+--      (Eq a, Ord a)
+-- looks so much like a tuple type.  We can't tell until we find the =>
+
+context :: { LHsContext GhcPs }
+        :  btype                        {% do { (anns,ctx) <- checkContext $1
+                                                ; if null (unLoc ctx)
+                                                   then addAnnotation (gl $1) AnnUnit (gl $1)
+                                                   else return ()
+                                                ; ams ctx anns
+                                                } }
+
+-- See Note [Constr variations of non-terminals]
+constr_context :: { LHsContext GhcPs }
+        :  constr_btype                 {% do { (anns,ctx) <- checkContext $1
+                                                ; if null (unLoc ctx)
+                                                   then addAnnotation (gl $1) AnnUnit (gl $1)
+                                                   else return ()
+                                                ; ams ctx anns
+                                                } }
+
+{- Note [GADT decl discards annotations]
+~~~~~~~~~~~~~~~~~~~~~
+The type production for
+
+    btype `->`         ctypedoc
+    btype docprev `->` ctypedoc
+
+add the AnnRarrow annotation twice, in different places.
+
+This is because if the type is processed as usual, it belongs on the annotations
+for the type as a whole.
+
+But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and
+the top-level annotation will be disconnected. Hence for this specific case it
+is connected to the first type too.
+-}
+
+type :: { LHsType GhcPs }
+        : btype                        { $1 }
+        | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3)
+                                              [mu AnnRarrow $2] }
+
+
+typedoc :: { LHsType GhcPs }
+        : btype                          { $1 }
+        | btype docprev                  { sLL $1 $> $ HsDocTy noExtField $1 $2 }
+        | docnext btype                  { sLL $1 $> $ HsDocTy noExtField $2 $1 }
+        | btype '->'     ctypedoc        {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
+                                         >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3)
+                                                [mu AnnRarrow $2] }
+        | btype docprev '->' ctypedoc    {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
+                                         >> ams (sLL $1 $> $
+                                                 HsFunTy noExtField (L (comb2 $1 $2)
+                                                            (HsDocTy noExtField $1 $2))
+                                                         $4)
+                                                [mu AnnRarrow $3] }
+        | docnext btype '->' ctypedoc    {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
+                                         >> ams (sLL $1 $> $
+                                                 HsFunTy noExtField (L (comb2 $1 $2)
+                                                            (HsDocTy noExtField $2 $1))
+                                                         $4)
+                                                [mu AnnRarrow $3] }
+
+-- See Note [Constr variations of non-terminals]
+constr_btype :: { LHsType GhcPs }
+        : constr_tyapps                 {% mergeOps (unLoc $1) }
+
+-- See Note [Constr variations of non-terminals]
+constr_tyapps :: { Located [Located TyEl] } -- NB: This list is reversed
+        : constr_tyapp                  { sL1 $1 [$1] }
+        | constr_tyapps constr_tyapp    { sLL $1 $> $ $2 : (unLoc $1) }
+
+-- See Note [Constr variations of non-terminals]
+constr_tyapp :: { Located TyEl }
+        : tyapp                         { $1 }
+        | docprev                       { sL1 $1 $ TyElDocPrev (unLoc $1) }
+
+btype :: { LHsType GhcPs }
+        : tyapps                        {% mergeOps $1 }
+
+tyapps :: { [Located TyEl] } -- NB: This list is reversed
+        : tyapp                         { [$1] }
+        | tyapps tyapp                  { $2 : $1 }
+
+tyapp :: { Located TyEl }
+        : atype                         { sL1 $1 $ TyElOpd (unLoc $1) }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | PREFIX_AT atype               { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
+
+        | qtyconop                      { sL1 $1 $ TyElOpr (unLoc $1) }
+        | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
+        | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
+                                               [mj AnnSimpleQuote $1,mj AnnVal $2] }
+        | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
+                                               [mj AnnSimpleQuote $1,mj AnnVal $2] }
+        | unpackedness                  { sL1 $1 $ TyElUnpackedness (unLoc $1) }
+
+atype :: { LHsType GhcPs }
+        : ntgtycon                       { sL1 $1 (HsTyVar noExtField NotPromoted $1) }      -- Not including unit tuples
+        | tyvar                          { sL1 $1 (HsTyVar noExtField NotPromoted $1) }      -- (See Note [Unit tuples])
+        | '*'                            {% do { warnStarIsType (getLoc $1)
+                                               ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | PREFIX_TILDE atype             {% ams (sLL $1 $> (mkBangTy SrcLazy $2)) [mj AnnTilde $1] }
+        | PREFIX_BANG  atype             {% ams (sLL $1 $> (mkBangTy SrcStrict $2)) [mj AnnBang $1] }
+
+        | '{' fielddecls '}'             {% amms (checkRecordSyntax
+                                                    (sLL $1 $> $ HsRecTy noExtField $2))
+                                                        -- Constructor sigs only
+                                                 [moc $1,mcc $3] }
+        | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy noExtField
+                                                    HsBoxedOrConstraintTuple [])
+                                                [mop $1,mcp $2] }
+        | '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
+                                                          (gl $3) >>
+                                            ams (sLL $1 $> $ HsTupleTy noExtField
+
+                                             HsBoxedOrConstraintTuple ($2 : $4))
+                                                [mop $1,mcp $5] }
+        | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple [])
+                                             [mo $1,mc $2] }
+        | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple $2)
+                                             [mo $1,mc $3] }
+        | '(#' bar_types2 '#)'        {% ams (sLL $1 $> $ HsSumTy noExtField $2)
+                                             [mo $1,mc $3] }
+        | '[' ktype ']'               {% ams (sLL $1 $> $ HsListTy  noExtField $2) [mos $1,mcs $3] }
+        | '(' ktype ')'               {% ams (sLL $1 $> $ HsParTy   noExtField $2) [mop $1,mcp $3] }
+        | quasiquote                  { mapLoc (HsSpliceTy noExtField) $1 }
+        | splice_untyped              { mapLoc (HsSpliceTy noExtField) $1 }
+                                      -- see Note [Promotion] for the followings
+        | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'
+                             {% addAnnotation (gl $3) AnnComma (gl $4) >>
+                                ams (sLL $1 $> $ HsExplicitTupleTy noExtField ($3 : $5))
+                                    [mj AnnSimpleQuote $1,mop $2,mcp $6] }
+        | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy noExtField IsPromoted $3)
+                                                       [mj AnnSimpleQuote $1,mos $2,mcs $4] }
+        | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2)
+                                                       [mj AnnSimpleQuote $1,mj AnnName $2] }
+
+        -- Two or more [ty, ty, ty] must be a promoted list type, just as
+        -- if you had written '[ty, ty, ty]
+        -- (One means a list type, zero means the list type constructor,
+        -- so you have to quote those.)
+        | '[' ktype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
+                                                           (gl $3) >>
+                                             ams (sLL $1 $> $ HsExplicitListTy noExtField NotPromoted ($2 : $4))
+                                                 [mos $1,mcs $5] }
+        | INTEGER              { sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1)
+                                                           (il_value (getINTEGER $1)) }
+        | STRING               { sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1)
+                                                                     (getSTRING  $1) }
+        | '_'                  { sL1 $1 $ mkAnonWildCardTy }
+
+-- An inst_type is what occurs in the head of an instance decl
+--      e.g.  (Foo a, Gaz b) => Wibble a b
+-- It's kept as a single type for convenience.
+inst_type :: { LHsSigType GhcPs }
+        : sigtype                       { mkLHsSigType $1 }
+
+deriv_types :: { [LHsSigType GhcPs] }
+        : ktypedoc                      { [mkLHsSigType $1] }
+
+        | ktypedoc ',' deriv_types      {% addAnnotation (gl $1) AnnComma (gl $2)
+                                           >> return (mkLHsSigType $1 : $3) }
+
+comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty
+        : comma_types1                  { $1 }
+        | {- empty -}                   { [] }
+
+comma_types1    :: { [LHsType GhcPs] }  -- One or more:  ty,ty,ty
+        : ktype                        { [$1] }
+        | ktype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
+                                          >> return ($1 : $3) }
+
+bar_types2    :: { [LHsType GhcPs] }  -- Two or more:  ty|ty|ty
+        : ktype  '|' ktype             {% addAnnotation (gl $1) AnnVbar (gl $2)
+                                          >> return [$1,$3] }
+        | ktype  '|' bar_types2        {% addAnnotation (gl $1) AnnVbar (gl $2)
+                                          >> return ($1 : $3) }
+
+tv_bndrs :: { [LHsTyVarBndr GhcPs] }
+         : tv_bndr tv_bndrs             { $1 : $2 }
+         | {- empty -}                  { [] }
+
+tv_bndr :: { LHsTyVarBndr GhcPs }
+        : tyvar                         { sL1 $1 (UserTyVar noExtField $1) }
+        | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar noExtField $2 $4))
+                                               [mop $1,mu AnnDcolon $3
+                                               ,mcp $5] }
+
+fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
+        : {- empty -}                   { noLoc ([],[]) }
+        | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
+                                                 ,reverse (unLoc $2))) }
+
+fds1 :: { Located [Located (FunDep (Located RdrName))] }
+        : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
+                           >> return (sLL $1 $> ($3 : unLoc $1)) }
+        | fd            { sL1 $1 [$1] }
+
+fd :: { Located (FunDep (Located RdrName)) }
+        : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
+                                       (reverse (unLoc $1), reverse (unLoc $3)))
+                                       [mu AnnRarrow $2] }
+
+varids0 :: { Located [Located RdrName] }
+        : {- empty -}                   { noLoc [] }
+        | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
+
+-----------------------------------------------------------------------------
+-- Kinds
+
+kind :: { LHsKind GhcPs }
+        : ctype                  { $1 }
+
+{- Note [Promotion]
+   ~~~~~~~~~~~~~~~~
+
+- Syntax of promoted qualified names
+We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
+names. Moreover ticks are only allowed in types, not in kinds, for a
+few reasons:
+  1. we don't need quotes since we cannot define names in kinds
+  2. if one day we merge types and kinds, tick would mean look in DataName
+  3. we don't have a kind namespace anyway
+
+- Name resolution
+When the user write Zero instead of 'Zero in types, we parse it a
+HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
+deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
+bounded in the type level, then we look for it in the term level (we
+change its namespace to DataName, see Note [Demotion] in GHC.Types.Names.OccName).
+And both become a HsTyVar ("Zero", DataName) after the renamer.
+
+-}
+
+
+-----------------------------------------------------------------------------
+-- Datatype declarations
+
+gadt_constrlist :: { Located ([AddAnn]
+                          ,[LConDecl GhcPs]) } -- Returned in order
+
+        : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $
+                                                      L (comb2 $1 $3)
+                                                        ([mj AnnWhere $1
+                                                         ,moc $2
+                                                         ,mcc $4]
+                                                        , unLoc $3) }
+        | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $
+                                                      L (comb2 $1 $3)
+                                                        ([mj AnnWhere $1]
+                                                        , unLoc $3) }
+        | {- empty -}                            { noLoc ([],[]) }
+
+gadt_constrs :: { Located [LConDecl GhcPs] }
+        : gadt_constr_with_doc ';' gadt_constrs
+                  {% addAnnotation (gl $1) AnnSemi (gl $2)
+                     >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
+        | gadt_constr_with_doc          { L (gl $1) [$1] }
+        | {- empty -}                   { noLoc [] }
+
+-- We allow the following forms:
+--      C :: Eq a => a -> T a
+--      C :: forall a. Eq a => !a -> T a
+--      D { x,y :: a } :: T a
+--      forall a. Eq a => D { x,y :: a } :: T a
+
+gadt_constr_with_doc :: { LConDecl GhcPs }
+gadt_constr_with_doc
+        : maybe_docnext ';' gadt_constr
+                {% return $ addConDoc $3 $1 }
+        | gadt_constr
+                {% return $1 }
+
+gadt_constr :: { LConDecl GhcPs }
+    -- see Note [Difference in parsing GADT and data constructors]
+    -- Returns a list because of:   C,D :: ty
+        : con_list '::' sigtypedoc
+                {% let (gadt,anns) = mkGadtDecl (unLoc $1) $3
+                   in ams (sLL $1 $> gadt)
+                       (mu AnnDcolon $2:anns) }
+
+{- Note [Difference in parsing GADT and data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GADT constructors have simpler syntax than usual data constructors:
+in GADTs, types cannot occur to the left of '::', so they cannot be mixed
+with constructor names (see Note [Parsing data constructors is hard]).
+
+Due to simplified syntax, GADT constructor names (left-hand side of '::')
+use simpler grammar production than usual data constructor names. As a
+consequence, GADT constructor names are restricted (names like '(*)' are
+allowed in usual data constructors, but not in GADTs).
+-}
+
+constrs :: { Located ([AddAnn],[LConDecl GhcPs]) }
+        : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
+                                                     ,addConDocs (unLoc $3) $1)}
+
+constrs1 :: { Located [LConDecl GhcPs] }
+        : constrs1 maybe_docnext '|' maybe_docprev constr
+            {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
+               >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
+        | constr                                          { sL1 $1 [$1] }
+
+{- Note [Constr variations of non-terminals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In record declarations we assume that 'ctype' used to parse the type will not
+consume the trailing docprev:
+
+  data R = R { field :: Int -- ^ comment on the field }
+
+In 'R' we expect the comment to apply to the entire field, not to 'Int'. The
+same issue is detailed in Note [ctype and ctypedoc].
+
+So, we do not want 'ctype'  to consume 'docprev', therefore
+    we do not want 'btype'  to consume 'docprev', therefore
+    we do not want 'tyapps' to consume 'docprev'.
+
+At the same time, when parsing a 'constr', we do want to consume 'docprev':
+
+  data T = C Int  -- ^ comment on Int
+             Bool -- ^ comment on Bool
+
+So, we do want 'constr_stuff' to consume 'docprev'.
+
+The problem arises because the clauses in 'constr' have the following
+structure:
+
+  (a)  context '=>' constr_stuff   (e.g.  data T a = Ord a => C a)
+  (b)               constr_stuff   (e.g.  data T a =          C a)
+
+and to avoid a reduce/reduce conflict, 'context' and 'constr_stuff' must be
+compatible. And for 'context' to be compatible with 'constr_stuff', it must
+consume 'docprev'.
+
+So, we want 'context'  to consume 'docprev', therefore
+    we want 'btype'    to consume 'docprev', therefore
+    we want 'tyapps'   to consume 'docprev'.
+
+Our requirements end up conflicting: for parsing record types, we want 'tyapps'
+to leave 'docprev' alone, but for parsing constructors, we want it to consume
+'docprev'.
+
+As the result, we maintain two parallel hierarchies of non-terminals that
+either consume 'docprev' or not:
+
+  tyapps      constr_tyapps
+  btype       constr_btype
+  context     constr_context
+  ...
+
+They must be kept identical except for their treatment of 'docprev'.
+
+-}
+
+constr :: { LConDecl GhcPs }
+        : maybe_docnext forall constr_context '=>' constr_stuff
+                {% ams (let (con,details,doc_prev) = unLoc $5 in
+                  addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
+                                                       (snd $ unLoc $2)
+                                                       (Just $3)
+                                                       details))
+                            ($1 `mplus` doc_prev))
+                        (mu AnnDarrow $4:(fst $ unLoc $2)) }
+        | maybe_docnext forall constr_stuff
+                {% ams ( let (con,details,doc_prev) = unLoc $3 in
+                  addConDoc (L (comb2 $2 $3) (mkConDeclH98 con
+                                                      (snd $ unLoc $2)
+                                                      Nothing   -- No context
+                                                      details))
+                            ($1 `mplus` doc_prev))
+                       (fst $ unLoc $2) }
+
+forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]) }
+        : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
+        | {- empty -}                 { noLoc ([], Nothing) }
+
+constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs, Maybe LHsDocString) }
+        : constr_tyapps                    {% do { c <- mergeDataCon (unLoc $1)
+                                                 ; return $ sL1 $1 c } }
+
+fielddecls :: { [LConDeclField GhcPs] }
+        : {- empty -}     { [] }
+        | fielddecls1     { $1 }
+
+fielddecls1 :: { [LConDeclField GhcPs] }
+        : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
+            {% addAnnotation (gl $1) AnnComma (gl $3) >>
+               return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
+        | fielddecl   { [$1] }
+
+fielddecl :: { LConDeclField GhcPs }
+                                              -- A list because of   f,g :: Int
+        : maybe_docnext sig_vars '::' ctype maybe_docprev
+            {% ams (L (comb2 $2 $4)
+                      (ConDeclField noExtField (reverse (map (\ln@(L l n) -> L l $ FieldOcc noExtField ln) (unLoc $2))) $4 ($1 `mplus` $5)))
+                   [mu AnnDcolon $3] }
+
+-- Reversed!
+maybe_derivings :: { HsDeriving GhcPs }
+        : {- empty -}             { noLoc [] }
+        | derivings               { $1 }
+
+-- A list of one or more deriving clauses at the end of a datatype
+derivings :: { HsDeriving GhcPs }
+        : derivings deriving      { sLL $1 $> $ $2 : unLoc $1 }
+        | deriving                { sLL $1 $> [$1] }
+
+-- The outer Located is just to allow the caller to
+-- know the rightmost extremity of the 'deriving' clause
+deriving :: { LHsDerivingClause GhcPs }
+        : 'deriving' deriv_clause_types
+              {% let { full_loc = comb2 $1 $> }
+                 in ams (L full_loc $ HsDerivingClause noExtField Nothing $2)
+                        [mj AnnDeriving $1] }
+
+        | 'deriving' deriv_strategy_no_via deriv_clause_types
+              {% let { full_loc = comb2 $1 $> }
+                 in ams (L full_loc $ HsDerivingClause noExtField (Just $2) $3)
+                        [mj AnnDeriving $1] }
+
+        | 'deriving' deriv_clause_types deriv_strategy_via
+              {% let { full_loc = comb2 $1 $> }
+                 in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2)
+                        [mj AnnDeriving $1] }
+
+deriv_clause_types :: { Located [LHsSigType GhcPs] }
+        : qtycondoc           { sL1 $1 [mkLHsSigType $1] }
+        | '(' ')'             {% ams (sLL $1 $> [])
+                                     [mop $1,mcp $2] }
+        | '(' deriv_types ')' {% ams (sLL $1 $> $2)
+                                     [mop $1,mcp $3] }
+             -- Glasgow extension: allow partial
+             -- applications in derivings
+
+-----------------------------------------------------------------------------
+-- Value definitions
+
+{- Note [Declaration/signature overlap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's an awkward overlap with a type signature.  Consider
+        f :: Int -> Int = ...rhs...
+   Then we can't tell whether it's a type signature or a value
+   definition with a result signature until we see the '='.
+   So we have to inline enough to postpone reductions until we know.
+-}
+
+{-
+  ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
+  instead of qvar, we get another shift/reduce-conflict. Consider the
+  following programs:
+
+     { (^^) :: Int->Int ; }          Type signature; only var allowed
+
+     { (^^) :: Int->Int = ... ; }    Value defn with result signature;
+                                     qvar allowed (because of instance decls)
+
+  We can't tell whether to reduce var to qvar until after we've read the signatures.
+-}
+
+docdecl :: { LHsDecl GhcPs }
+        : docdecld { sL1 $1 (DocD noExtField (unLoc $1)) }
+
+docdecld :: { LDocDecl }
+        : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
+        | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
+        | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
+        | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
+
+decl_no_th :: { LHsDecl GhcPs }
+        : sigdecl               { $1 }
+
+        | infixexp     opt_sig rhs  {% runECP_P $1 >>= \ $1 ->
+                                       do { (ann,r) <- checkValDef $1 (snd $2) $3;
+                                        let { l = comb2 $1 $> };
+                                        -- Depending upon what the pattern looks like we might get either
+                                        -- a FunBind or PatBind back from checkValDef. See Note
+                                        -- [FunBind vs PatBind]
+                                        case r of {
+                                          (FunBind _ n _ _) ->
+                                                amsL l (mj AnnFunId n:(fst $2)) >> return () ;
+                                          (PatBind _ (L lh _lhs) _rhs _) ->
+                                                amsL lh (fst $2) >> return () } ;
+                                        _ <- amsL l (ann ++ (fst $ unLoc $3));
+                                        return $! (sL l $ ValD noExtField r) } }
+        | pattern_synonym_decl  { $1 }
+        | docdecl               { $1 }
+
+decl    :: { LHsDecl GhcPs }
+        : decl_no_th            { $1 }
+
+        -- Why do we only allow naked declaration splices in top-level
+        -- declarations and not here? Short answer: because readFail009
+        -- fails terribly with a panic in cvBindsAndSigs otherwise.
+        | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
+
+rhs     :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
+        : '=' exp wherebinds    {% runECP_P $2 >>= \ $2 -> return $
+                                  sL (comb3 $1 $2 $3)
+                                    ((mj AnnEqual $1 : (fst $ unLoc $3))
+                                    ,GRHSs noExtField (unguardedRHS (comb3 $1 $2 $3) $2)
+                                   (snd $ unLoc $3)) }
+        | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
+                                    ,GRHSs noExtField (reverse (unLoc $1))
+                                                    (snd $ unLoc $2)) }
+
+gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
+        : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
+        | gdrh                  { sL1 $1 [$1] }
+
+gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
+        : '|' guardquals '=' exp  {% runECP_P $4 >>= \ $4 ->
+                                     ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4)
+                                         [mj AnnVbar $1,mj AnnEqual $3] }
+
+sigdecl :: { LHsDecl GhcPs }
+        :
+        -- See Note [Declaration/signature overlap] for why we need infixexp here
+          infixexp     '::' sigtypedoc
+                        {% do { $1 <- runECP_P $1
+                              ; v <- checkValSigLhs $1
+                              ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
+                              ; return (sLL $1 $> $ SigD noExtField $
+                                  TypeSig noExtField [v] (mkLHsSigWcType $3))} }
+
+        | var ',' sig_vars '::' sigtypedoc
+           {% do { let sig = TypeSig noExtField ($1 : reverse (unLoc $3))
+                                     (mkLHsSigWcType $5)
+                 ; addAnnotation (gl $1) AnnComma (gl $2)
+                 ; ams ( sLL $1 $> $ SigD noExtField sig )
+                       [mu AnnDcolon $4] } }
+
+        | infix prec ops
+              {% checkPrecP $2 $3 >>
+                 ams (sLL $1 $> $ SigD noExtField
+                        (FixSig noExtField (FixitySig noExtField (fromOL $ unLoc $3)
+                                (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
+                     [mj AnnInfix $1,mj AnnVal $2] }
+
+        | pattern_synonym_sig   { sLL $1 $> . SigD noExtField . unLoc $ $1 }
+
+        | '{-# COMPLETE' con_list opt_tyconsig  '#-}'
+                {% let (dcolon, tc) = $3
+                   in ams
+                       (sLL $1 $>
+                         (SigD noExtField (CompleteMatchSig noExtField (getCOMPLETE_PRAGs $1) $2 tc)))
+                    ([ mo $1 ] ++ dcolon ++ [mc $4]) }
+
+        -- This rule is for both INLINE and INLINABLE pragmas
+        | '{-# INLINE' activation qvar '#-}'
+                {% ams ((sLL $1 $> $ SigD noExtField (InlineSig noExtField $3
+                            (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
+                                            (snd $2)))))
+                       ((mo $1:fst $2) ++ [mc $4]) }
+
+        | '{-# SCC' qvar '#-}'
+          {% ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 Nothing)))
+                 [mo $1, mc $3] }
+
+        | '{-# SCC' qvar STRING '#-}'
+          {% do { scc <- getSCC $3
+                ; let str_lit = StringLiteral (getSTRINGs $3) scc
+                ; ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit)))))
+                      [mo $1, mc $4] } }
+
+        | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
+             {% ams (
+                 let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
+                                             (NoUserInline, FunLike) (snd $2)
+                  in sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5) inl_prag))
+                    (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
+
+        | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
+             {% ams (sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5)
+                               (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
+                                               (getSPEC_INLINE $1) (snd $2))))
+                       (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
+
+        | '{-# SPECIALISE' 'instance' inst_type '#-}'
+                {% ams (sLL $1 $>
+                                  $ SigD noExtField (SpecInstSig noExtField (getSPEC_PRAGs $1) $3))
+                       [mo $1,mj AnnInstance $2,mc $4] }
+
+        -- A minimal complete definition
+        | '{-# MINIMAL' name_boolformula_opt '#-}'
+            {% ams (sLL $1 $> $ SigD noExtField (MinimalSig noExtField (getMINIMAL_PRAGs $1) $2))
+                   [mo $1,mc $3] }
+
+activation :: { ([AddAnn],Maybe Activation) }
+        : {- empty -}                           { ([],Nothing) }
+        | explicit_activation                   { (fst $1,Just (snd $1)) }
+
+explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
+        : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
+                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
+        | '[' rule_activation_marker INTEGER ']'
+                                { ($2++[mj AnnOpenS $1,mj AnnVal $3,mj AnnCloseS $4]
+                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
+
+-----------------------------------------------------------------------------
+-- Expressions
+
+quasiquote :: { Located (HsSplice GhcPs) }
+        : TH_QUASIQUOTE   { let { loc = getLoc $1
+                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
+                                ; quoterId = mkUnqual varName quoter }
+                            in sL1 $1 (mkHsQuasiQuote quoterId (mkSrcSpanPs quoteSpan) quote) }
+        | TH_QQUASIQUOTE  { let { loc = getLoc $1
+                                ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
+                                ; quoterId = mkQual varName (qual, quoter) }
+                            in sL (getLoc $1) (mkHsQuasiQuote quoterId (mkSrcSpanPs quoteSpan) quote) }
+
+exp   :: { ECP }
+        : infixexp '::' sigtype
+                                { ECP $
+                                   runECP_PV $1 >>= \ $1 ->
+                                   rejectPragmaPV $1 >>
+                                   amms (mkHsTySigPV (comb2 $1 $>) $1 $3)
+                                       [mu AnnDcolon $2] }
+        | infixexp '-<' exp     {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
+                                   ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3
+                                                        HsFirstOrderApp True)
+                                       [mu Annlarrowtail $2] }
+        | infixexp '>-' exp     {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
+                                   ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1
+                                                      HsFirstOrderApp False)
+                                       [mu Annrarrowtail $2] }
+        | infixexp '-<<' exp    {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
+                                   ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3
+                                                      HsHigherOrderApp True)
+                                       [mu AnnLarrowtail $2] }
+        | infixexp '>>-' exp    {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
+                                   ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1
+                                                      HsHigherOrderApp False)
+                                       [mu AnnRarrowtail $2] }
+        | infixexp              { $1 }
+        | exp_prag(exp)         { $1 } -- See Note [Pragmas and operator fixity]
+
+infixexp :: { ECP }
+        : exp10 { $1 }
+        | infixexp qop exp10p    -- See Note [Pragmas and operator fixity]
+                               { ECP $
+                                 superInfixOp $
+                                 $2 >>= \ $2 ->
+                                 runECP_PV $1 >>= \ $1 ->
+                                 runECP_PV $3 >>= \ $3 ->
+                                 rejectPragmaPV $1 >>
+                                 amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
+                                     [mj AnnVal $2] }
+                 -- AnnVal annotation for NPlusKPat, which discards the operator
+
+exp10p :: { ECP }
+  : exp10            { $1 }
+  | exp_prag(exp10p) { $1 } -- See Note [Pragmas and operator fixity]
+
+exp_prag(e) :: { ECP }
+  : prag_e e  -- See Note [Pragmas and operator fixity]
+      {% runECP_P $2 >>= \ $2 ->
+         fmap ecpFromExp $
+         ams (sLL $1 $> $ HsPragE noExtField (snd $ unLoc $1) $2)
+             (fst $ unLoc $1) }
+
+exp10 :: { ECP }
+        : '-' fexp                      { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkHsNegAppPV (comb2 $1 $>) $2)
+                                               [mj AnnMinus $1] }
+        | fexp                         { $1 }
+
+optSemi :: { ([Located Token],Bool) }
+        : ';'         { ([$1],True) }
+        | {- empty -} { ([],False) }
+
+{- Note [Pragmas and operator fixity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'prag_e' is an expression pragma, such as {-# SCC ... #-}, {-# CORE ... #-}, or
+{-# GENERATED ... #-}.
+
+It must be used with care, or else #15730 happens. Consider this infix
+expression:
+
+         1 / 2 / 2
+
+There are two ways to parse it:
+
+    1.   (1 / 2) / 2   =  0.25
+    2.   1 / (2 / 2)   =  1.0
+
+Due to the fixity of the (/) operator (assuming it comes from Prelude),
+option 1 is the correct parse. However, in the past GHC's parser used to get
+confused by the SCC annotation when it occurred in the middle of an infix
+expression:
+
+         1 / {-# SCC ann #-} 2 / 2    -- used to get parsed as option 2
+
+There are several ways to address this issue, see GHC Proposal #176 for a
+detailed exposition:
+
+  https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst
+
+The accepted fix is to disallow pragmas that occur within infix expressions.
+Infix expressions are assembled out of 'exp10', so 'exp10' must not accept
+pragmas. Instead, we accept them in exactly two places:
+
+* at the start of an expression or a parenthesized subexpression:
+
+    f = {-# SCC ann #-} 1 / 2 / 2          -- at the start of the expression
+    g = 5 + ({-# SCC ann #-} 1 / 2 / 2)    -- at the start of a parenthesized subexpression
+
+* immediately after the last operator:
+
+    f = 1 / 2 / {-# SCC ann #-} 2
+
+In both cases, the parse does not depend on operator fixity. The second case
+may sound unnecessary, but it's actually needed to support a common idiom:
+
+    f $ {-# SCC ann $-} ...
+
+-}
+prag_e :: { Located ([AddAnn], HsPragE GhcPs) }
+      : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
+                                          ; return $ sLL $1 $>
+                                             ([mo $1,mj AnnValStr $2,mc $3],
+                                              HsPragSCC noExtField
+                                                (getSCC_PRAGs $1)
+                                                (StringLiteral (getSTRINGs $2) scc)) }
+      | '{-# SCC' VARID  '#-}'      { sLL $1 $> ([mo $1,mj AnnVal $2,mc $3],
+                                                  HsPragSCC noExtField
+                                                    (getSCC_PRAGs $1)
+                                                    (StringLiteral NoSourceText (getVARID $2))) }
+      | '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
+                                      { let getINT = fromInteger . il_value . getINTEGER in
+                                        sLL $1 $> $ ([mo $1,mj AnnVal $2
+                                              ,mj AnnVal $3,mj AnnColon $4
+                                              ,mj AnnVal $5,mj AnnMinus $6
+                                              ,mj AnnVal $7,mj AnnColon $8
+                                              ,mj AnnVal $9,mc $10],
+                                              HsPragTick noExtField
+                                                (getGENERATED_PRAGs $1)
+                                                (getStringLiteral $2,
+                                                 (getINT $3, getINT $5),
+                                                 (getINT $7, getINT $9))
+                                                ((getINTEGERs $3, getINTEGERs $5),
+                                                 (getINTEGERs $7, getINTEGERs $9) )) }
+      | '{-# CORE' STRING '#-}'
+        { sLL $1 $> $
+            ([mo $1,mj AnnVal $2,mc $3],
+             HsPragCore noExtField (getCORE_PRAGs $1) (getStringLiteral $2)) }
+
+fexp    :: { ECP }
+        : fexp aexp                  { ECP $
+                                          superFunArg $
+                                          runECP_PV $1 >>= \ $1 ->
+                                          runECP_PV $2 >>= \ $2 ->
+                                          mkHsAppPV (comb2 $1 $>) $1 $2 }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | fexp PREFIX_AT atype       {% runECP_P $1 >>= \ $1 ->
+                                        runPV (checkExpBlockArguments $1) >>= \_ ->
+                                        fmap ecpFromExp $
+                                        ams (sLL $1 $> $ HsAppType noExtField $1 (mkHsWildCardBndrs $3))
+                                            [mj AnnAt $2] }
+
+        | 'static' aexp              {% runECP_P $2 >>= \ $2 ->
+                                        fmap ecpFromExp $
+                                        ams (sLL $1 $> $ HsStatic noExtField $2)
+                                            [mj AnnStatic $1] }
+        | aexp                       { $1 }
+
+aexp    :: { ECP }
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        : qvar TIGHT_INFIX_AT aexp
+                                { ECP $
+                                   runECP_PV $3 >>= \ $3 ->
+                                   amms (mkHsAsPatPV (comb2 $1 $>) $1 $3) [mj AnnAt $2] }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | PREFIX_TILDE aexp     { ECP $
+                                   runECP_PV $2 >>= \ $2 ->
+                                   amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] }
+        | PREFIX_BANG aexp      { ECP $
+                                   runECP_PV $2 >>= \ $2 ->
+                                   amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1] }
+
+        | '\\' apat apats '->' exp
+                   {  ECP $
+                      runECP_PV $5 >>= \ $5 ->
+                      amms (mkHsLamPV (comb2 $1 $>) (mkMatchGroup FromSource
+                            [sLL $1 $> $ Match { m_ext = noExtField
+                                               , m_ctxt = LambdaExpr
+                                               , m_pats = $2:$3
+                                               , m_grhss = unguardedGRHSs $5 }]))
+                          [mj AnnLam $1, mu AnnRarrow $4] }
+        | 'let' binds 'in' exp          {  ECP $
+                                           runECP_PV $4 >>= \ $4 ->
+                                           amms (mkHsLetPV (comb2 $1 $>) (snd (unLoc $2)) $4)
+                                               (mj AnnLet $1:mj AnnIn $3
+                                                 :(fst $ unLoc $2)) }
+        | '\\' 'lcase' altslist
+            {% runPV $3 >>= \ $3 ->
+               fmap ecpFromExp $
+               ams (sLL $1 $> $ HsLamCase noExtField
+                                   (mkMatchGroup FromSource (snd $ unLoc $3)))
+                   (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
+        | 'if' exp optSemi 'then' exp optSemi 'else' exp
+                         {% runECP_P $2 >>= \ $2 ->
+                            return $ ECP $
+                              runECP_PV $5 >>= \ $5 ->
+                              runECP_PV $8 >>= \ $8 ->
+                              amms (mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8)
+                                  (mj AnnIf $1:mj AnnThen $4
+                                     :mj AnnElse $7
+                                     :(map (\l -> mj AnnSemi l) (fst $3))
+                                    ++(map (\l -> mj AnnSemi l) (fst $6))) }
+        | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->
+                                           fmap ecpFromExp $
+                                           ams (sLL $1 $> $ HsMultiIf noExtField
+                                                     (reverse $ snd $ unLoc $2))
+                                               (mj AnnIf $1:(fst $ unLoc $2)) }
+        | 'case' exp 'of' altslist    {% runECP_P $2 >>= \ $2 ->
+                                         return $ ECP $
+                                           $4 >>= \ $4 ->
+                                           amms (mkHsCasePV (comb3 $1 $3 $4) $2 (mkMatchGroup
+                                                   FromSource (snd $ unLoc $4)))
+                                               (mj AnnCase $1:mj AnnOf $3
+                                                  :(fst $ unLoc $4)) }
+        | 'do' stmtlist              { ECP $
+                                        $2 >>= \ $2 ->
+                                        amms (mkHsDoPV (comb2 $1 $2) (mapLoc snd $2))
+                                               (mj AnnDo $1:(fst $ unLoc $2)) }
+        | 'mdo' stmtlist            {% runPV $2 >>= \ $2 ->
+                                       fmap ecpFromExp $
+                                       ams (L (comb2 $1 $2)
+                                              (mkHsDo MDoExpr (snd $ unLoc $2)))
+                                           (mj AnnMdo $1:(fst $ unLoc $2)) }
+        | 'proc' aexp '->' exp
+                       {% (checkPattern <=< runECP_P) $2 >>= \ p ->
+                           runECP_P $4 >>= \ $4@cmd ->
+                           fmap ecpFromExp $
+                           ams (sLL $1 $> $ HsProc noExtField p (sLL $1 $> $ HsCmdTop noExtField cmd))
+                                            -- TODO: is LL right here?
+                               [mj AnnProc $1,mu AnnRarrow $3] }
+
+        | aexp1                 { $1 }
+
+aexp1   :: { ECP }
+        : aexp1 '{' fbinds '}' { ECP $
+                                  runECP_PV $1 >>= \ $1 ->
+                                  $3 >>= \ $3 ->
+                                  amms (mkHsRecordPV (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
+                                       (moc $2:mcc $4:(fst $3)) }
+        | aexp2                { $1 }
+
+aexp2   :: { ECP }
+        : qvar                          { ECP $ mkHsVarPV $! $1 }
+        | qcon                          { ECP $ mkHsVarPV $! $1 }
+        | ipvar                         { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) }
+        | overloaded_label              { ecpFromExp $ sL1 $1 (HsOverLabel noExtField Nothing $! unLoc $1) }
+        | literal                       { ECP $ mkHsLitPV $! $1 }
+-- This will enable overloaded strings permanently.  Normally the renamer turns HsString
+-- into HsOverLit when -foverloaded-strings is on.
+--      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
+--                                       (getSTRING $1) noExtField) }
+        | INTEGER   { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsIntegral   (getINTEGER  $1)) }
+        | RATIONAL  { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsFractional (getRATIONAL $1)) }
+
+        -- N.B.: sections get parsed by these next two productions.
+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
+        -- correct Haskell (you'd have to write '((+ 3), (4 -))')
+        -- but the less cluttered version fell out of having texps.
+        | '(' texp ')'                  { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkHsParPV (comb2 $1 $>) $2) [mop $1,mcp $3] }
+        | '(' tup_exprs ')'             { ECP $
+                                           $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Boxed (snd $2))
+                                                ((mop $1:fst $2) ++ [mcp $3]) }
+
+        | '(#' texp '#)'                { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [L (gl $2) (Just $2)]))
+                                                [mo $1,mc $3] }
+        | '(#' tup_exprs '#)'           { ECP $
+                                           $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (snd $2))
+                                                ((mo $1:fst $2) ++ [mc $3]) }
+
+        | '[' list ']'      { ECP $ $2 (comb2 $1 $>) >>= \a -> ams a [mos $1,mcs $3] }
+        | '_'               { ECP $ mkHsWildCardPV (getLoc $1) }
+
+        -- Template Haskell Extension
+        | splice_untyped { ECP $ mkHsSplicePV $1 }
+        | splice_typed   { ecpFromExp $ mapLoc (HsSpliceE noExtField) $1 }
+
+        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
+        | '[|' exp '|]'       {% runECP_P $2 >>= \ $2 ->
+                                 fmap ecpFromExp $
+                                 ams (sLL $1 $> $ HsBracket noExtField (ExpBr noExtField $2))
+                                      (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
+                                                    else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
+        | '[||' exp '||]'     {% runECP_P $2 >>= \ $2 ->
+                                 fmap ecpFromExp $
+                                 ams (sLL $1 $> $ HsBracket noExtField (TExpBr noExtField $2))
+                                      (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
+        | '[t|' ktype '|]'    {% fmap ecpFromExp $
+                                 ams (sLL $1 $> $ HsBracket noExtField (TypBr noExtField $2)) [mo $1,mu AnnCloseQ $3] }
+        | '[p|' infixexp '|]' {% (checkPattern <=< runECP_P) $2 >>= \p ->
+                                      fmap ecpFromExp $
+                                      ams (sLL $1 $> $ HsBracket noExtField (PatBr noExtField p))
+                                          [mo $1,mu AnnCloseQ $3] }
+        | '[d|' cvtopbody '|]' {% fmap ecpFromExp $
+                                  ams (sLL $1 $> $ HsBracket noExtField (DecBrL noExtField (snd $2)))
+                                      (mo $1:mu AnnCloseQ $3:fst $2) }
+        | quasiquote          { ECP $ mkHsSplicePV $1 }
+
+        -- arrow notation extension
+        | '(|' aexp2 cmdargs '|)'  {% runECP_P $2 >>= \ $2 ->
+                                      fmap ecpFromCmd $
+                                      ams (sLL $1 $> $ HsCmdArrForm noExtField $2 Prefix
+                                                           Nothing (reverse $3))
+                                          [mu AnnOpenB $1,mu AnnCloseB $4] }
+
+splice_exp :: { LHsExpr GhcPs }
+        : splice_untyped { mapLoc (HsSpliceE noExtField) $1 }
+        | splice_typed   { mapLoc (HsSpliceE noExtField) $1 }
+
+splice_untyped :: { Located (HsSplice GhcPs) }
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        : PREFIX_DOLLAR aexp2   {% runECP_P $2 >>= \ $2 ->
+                                   ams (sLL $1 $> $ mkUntypedSplice DollarSplice $2)
+                                       [mj AnnDollar $1] }
+
+splice_typed :: { Located (HsSplice GhcPs) }
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        : PREFIX_DOLLAR_DOLLAR aexp2
+                                {% runECP_P $2 >>= \ $2 ->
+                                   ams (sLL $1 $> $ mkTypedSplice DollarSplice $2)
+                                       [mj AnnDollarDollar $1] }
+
+cmdargs :: { [LHsCmdTop GhcPs] }
+        : cmdargs acmd                  { $2 : $1 }
+        | {- empty -}                   { [] }
+
+acmd    :: { LHsCmdTop GhcPs }
+        : aexp2                 {% runECP_P $1 >>= \ cmd ->
+                                    return (sL1 cmd $ HsCmdTop noExtField cmd) }
+
+cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
+        :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
+                                                  ,mj AnnCloseC $3],$2) }
+        |      vocurly    cvtopdecls0 close    { ([],$2) }
+
+cvtopdecls0 :: { [LHsDecl GhcPs] }
+        : topdecls_semi         { cvTopDecls $1 }
+        | topdecls              { cvTopDecls $1 }
+
+-----------------------------------------------------------------------------
+-- Tuple expressions
+
+-- "texp" is short for tuple expressions:
+-- things that can appear unparenthesized as long as they're
+-- inside parens or delimitted by commas
+texp :: { ECP }
+        : exp                           { $1 }
+
+        -- Note [Parsing sections]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~
+        -- We include left and right sections here, which isn't
+        -- technically right according to the Haskell standard.
+        -- For example (3 +, True) isn't legal.
+        -- However, we want to parse bang patterns like
+        --      (!x, !y)
+        -- and it's convenient to do so here as a section
+        -- Then when converting expr to pattern we unravel it again
+        -- Meanwhile, the renamer checks that real sections appear
+        -- inside parens.
+        | infixexp qop
+                             {% runECP_P $1 >>= \ $1 ->
+                                runPV (rejectPragmaPV $1) >>
+                                runPV $2 >>= \ $2 ->
+                                return $ ecpFromExp $
+                                sLL $1 $> $ SectionL noExtField $1 $2 }
+        | qopm infixexp      { ECP $
+                                superInfixOp $
+                                runECP_PV $2 >>= \ $2 ->
+                                $1 >>= \ $1 ->
+                                mkHsSectionR_PV (comb2 $1 $>) $1 $2 }
+
+       -- View patterns get parenthesized above
+        | exp '->' texp   { ECP $
+                             runECP_PV $1 >>= \ $1 ->
+                             runECP_PV $3 >>= \ $3 ->
+                             amms (mkHsViewPatPV (comb2 $1 $>) $1 $3) [mu AnnRarrow $2] }
+
+-- Always at least one comma or bar.
+-- Though this can parse just commas (without any expressions), it won't
+-- in practice, because (,,,) is parsed as a name. See Note [ExplicitTuple]
+-- in GHC.Hs.Expr.
+tup_exprs :: { forall b. DisambECP b => PV ([AddAnn],SumOrTuple b) }
+           : texp commas_tup_tail
+                           { runECP_PV $1 >>= \ $1 ->
+                             $2 >>= \ $2 ->
+                             do { addAnnotation (gl $1) AnnComma (fst $2)
+                                ; return ([],Tuple ((sL1 $1 (Just $1)) : snd $2)) } }
+
+           | texp bars   { runECP_PV $1 >>= \ $1 -> return $
+                            (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
+
+           | commas tup_tail
+                 { $2 >>= \ $2 ->
+                   do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
+                      ; return
+                           ([],Tuple (map (\l -> L l Nothing) (fst $1) ++ $2)) } }
+
+           | bars texp bars0
+                { runECP_PV $2 >>= \ $2 -> return $
+                  (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
+
+-- Always starts with commas; always follows an expr
+commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Located (Maybe (Located b))]) }
+commas_tup_tail : commas tup_tail
+        { $2 >>= \ $2 ->
+          do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
+             ; return (
+            (head $ fst $1
+            ,(map (\l -> L l Nothing) (tail $ fst $1)) ++ $2)) } }
+
+-- Always follows a comma
+tup_tail :: { forall b. DisambECP b => PV [Located (Maybe (Located b))] }
+          : texp commas_tup_tail { runECP_PV $1 >>= \ $1 ->
+                                   $2 >>= \ $2 ->
+                                   addAnnotation (gl $1) AnnComma (fst $2) >>
+                                   return ((L (gl $1) (Just $1)) : snd $2) }
+          | texp                 { runECP_PV $1 >>= \ $1 ->
+                                   return [L (gl $1) (Just $1)] }
+          | {- empty -}          { return [noLoc Nothing] }
+
+-----------------------------------------------------------------------------
+-- List expressions
+
+-- The rules below are little bit contorted to keep lexps left-recursive while
+-- avoiding another shift/reduce-conflict.
+-- Never empty.
+list :: { forall b. DisambECP b => SrcSpan -> PV (Located b) }
+        : texp    { \loc -> runECP_PV $1 >>= \ $1 ->
+                            mkHsExplicitListPV loc [$1] }
+        | lexps   { \loc -> $1 >>= \ $1 ->
+                            mkHsExplicitListPV loc (reverse $1) }
+        | texp '..'  { \loc ->    runECP_PV $1 >>= \ $1 ->
+                                  ams (L loc $ ArithSeq noExtField Nothing (From $1))
+                                      [mj AnnDotdot $2]
+                                      >>= ecpFromExp' }
+        | texp ',' exp '..' { \loc ->
+                                   runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromThen $1 $3))
+                                       [mj AnnComma $2,mj AnnDotdot $4]
+                                       >>= ecpFromExp' }
+        | texp '..' exp  { \loc -> runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromTo $1 $3))
+                                       [mj AnnDotdot $2]
+                                       >>= ecpFromExp' }
+        | texp ',' exp '..' exp { \loc ->
+                                   runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   runECP_PV $5 >>= \ $5 ->
+                                   ams (L loc $ ArithSeq noExtField Nothing (FromThenTo $1 $3 $5))
+                                       [mj AnnComma $2,mj AnnDotdot $4]
+                                       >>= ecpFromExp' }
+        | texp '|' flattenedpquals
+             { \loc ->
+                checkMonadComp >>= \ ctxt ->
+                runECP_PV $1 >>= \ $1 ->
+                ams (L loc $ mkHsComp ctxt (unLoc $3) $1)
+                    [mj AnnVbar $2]
+                    >>= ecpFromExp' }
+
+lexps :: { forall b. DisambECP b => PV [Located b] }
+        : lexps ',' texp           { $1 >>= \ $1 ->
+                                     runECP_PV $3 >>= \ $3 ->
+                                     addAnnotation (gl $ head $ $1)
+                                                            AnnComma (gl $2) >>
+                                      return (((:) $! $3) $! $1) }
+        | texp ',' texp             { runECP_PV $1 >>= \ $1 ->
+                                      runECP_PV $3 >>= \ $3 ->
+                                      addAnnotation (gl $1) AnnComma (gl $2) >>
+                                      return [$3,$1] }
+
+-----------------------------------------------------------------------------
+-- List Comprehensions
+
+flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
+    : pquals   { case (unLoc $1) of
+                    [qs] -> sL1 $1 qs
+                    -- We just had one thing in our "parallel" list so
+                    -- we simply return that thing directly
+
+                    qss -> sL1 $1 [sL1 $1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr |
+                                            qs <- qss]
+                                            noExpr noSyntaxExpr]
+                    -- We actually found some actual parallel lists so
+                    -- we wrap them into as a ParStmt
+                }
+
+pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }
+    : squals '|' pquals
+                     {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
+                        return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
+    | squals         { L (getLoc $1) [reverse (unLoc $1)] }
+
+squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last
+                                        -- one can "grab" the earlier ones
+    : squals ',' transformqual
+             {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
+                amsL (comb2 $1 $>) (fst $ unLoc $3) >>
+                return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
+    | squals ',' qual
+             {% runPV $3 >>= \ $3 ->
+                addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
+                return (sLL $1 $> ($3 : unLoc $1)) }
+    | transformqual        {% ams $1 (fst $ unLoc $1) >>
+                              return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
+    | qual                               {% runPV $1 >>= \ $1 ->
+                                            return $ sL1 $1 [$1] }
+--  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
+--  | '{|' pquals '|}'                       { sL1 $1 [$2] }
+
+-- It is possible to enable bracketing (associating) qualifier lists
+-- by uncommenting the lines with {| |} above. Due to a lack of
+-- consensus on the syntax, this feature is not being used until we
+-- get user demand.
+
+transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
+                        -- Function is applied to a list of stmts *in order*
+    : 'then' exp              {% runECP_P $2 >>= \ $2 -> return $
+                                 sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
+    | 'then' exp 'by' exp     {% runECP_P $2 >>= \ $2 ->
+                                 runECP_P $4 >>= \ $4 ->
+                                 return $ sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],
+                                                     \ss -> (mkTransformByStmt ss $2 $4)) }
+    | 'then' 'group' 'using' exp
+            {% runECP_P $4 >>= \ $4 ->
+               return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3],
+                                   \ss -> (mkGroupUsingStmt ss $4)) }
+
+    | 'then' 'group' 'by' exp 'using' exp
+            {% runECP_P $4 >>= \ $4 ->
+               runECP_P $6 >>= \ $6 ->
+               return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5],
+                                   \ss -> (mkGroupByUsingStmt ss $4 $6)) }
+
+-- Note that 'group' is a special_id, which means that you can enable
+-- TransformListComp while still using Data.List.group. However, this
+-- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
+-- in by choosing the "group by" variant, which is what we want.
+
+-----------------------------------------------------------------------------
+-- Guards
+
+guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
+    : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
+
+guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
+    : guardquals1 ',' qual  {% runPV $3 >>= \ $3 ->
+                               addAnnotation (gl $ head $ unLoc $1) AnnComma
+                                             (gl $2) >>
+                               return (sLL $1 $> ($3 : unLoc $1)) }
+    | qual                  {% runPV $1 >>= \ $1 ->
+                               return $ sL1 $1 [$1] }
+
+-----------------------------------------------------------------------------
+-- Case alternatives
+
+altslist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
+        : '{'            alts '}'  { $2 >>= \ $2 -> return $
+                                     sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
+                                               ,(reverse (snd $ unLoc $2))) }
+        |     vocurly    alts  close { $2 >>= \ $2 -> return $
+                                       L (getLoc $2) (fst $ unLoc $2
+                                        ,(reverse (snd $ unLoc $2))) }
+        | '{'                 '}'    { return $ sLL $1 $> ([moc $1,mcc $2],[]) }
+        |     vocurly          close { return $ noLoc ([],[]) }
+
+alts    :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
+        : alts1                    { $1 >>= \ $1 -> return $
+                                     sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+        | ';' alts                 { $2 >>= \ $2 -> return $
+                                     sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
+                                               ,snd $ unLoc $2) }
+
+alts1   :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
+        : alts1 ';' alt         { $1 >>= \ $1 ->
+                                  $3 >>= \ $3 ->
+                                     if null (snd $ unLoc $1)
+                                     then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                  ,[$3]))
+                                     else (ams (head $ snd $ unLoc $1)
+                                               (mj AnnSemi $2:(fst $ unLoc $1))
+                                           >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
+        | alts1 ';'             {  $1 >>= \ $1 ->
+                                   if null (snd $ unLoc $1)
+                                     then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                  ,snd $ unLoc $1))
+                                     else (ams (head $ snd $ unLoc $1)
+                                               (mj AnnSemi $2:(fst $ unLoc $1))
+                                           >> return (sLL $1 $> ([],snd $ unLoc $1))) }
+        | alt                   { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }
+
+alt     :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) }
+           : pat alt_rhs  { $2 >>= \ $2 ->
+                            ams (sLL $1 $> (Match { m_ext = noExtField
+                                                  , m_ctxt = CaseAlt
+                                                  , m_pats = [$1]
+                                                  , m_grhss = snd $ unLoc $2 }))
+                                      (fst $ unLoc $2)}
+
+alt_rhs :: { forall b. DisambECP b => PV (Located ([AddAnn],GRHSs GhcPs (Located b))) }
+        : ralt wherebinds           { $1 >>= \alt ->
+                                      return $ sLL alt $> (fst $ unLoc $2, GRHSs noExtField (unLoc alt) (snd $ unLoc $2)) }
+
+ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) }
+        : '->' exp            { runECP_PV $2 >>= \ $2 ->
+                                ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
+                                    [mu AnnRarrow $1] }
+        | gdpats              { $1 >>= \gdpats ->
+                                return $ sL1 gdpats (reverse (unLoc gdpats)) }
+
+gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) }
+        : gdpats gdpat { $1 >>= \gdpats ->
+                         $2 >>= \gdpat ->
+                         return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }
+        | gdpat        { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] }
+
+-- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
+-- generate the open brace in addition to the vertical bar in the lexer, and
+-- we don't need it.
+ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
+         : '{' gdpats '}'                 {% runPV $2 >>= \ $2 ->
+                                             return $ sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
+         |     gdpats close               {% runPV $1 >>= \ $1 ->
+                                             return $ sL1 $1 ([],unLoc $1) }
+
+gdpat   :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) }
+        : '|' guardquals '->' exp
+                                   { runECP_PV $4 >>= \ $4 ->
+                                     ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4)
+                                         [mj AnnVbar $1,mu AnnRarrow $3] }
+
+-- 'pat' recognises a pattern, including one with a bang at the top
+--      e.g.  "!x" or "!(x,y)" or "C a b" etc
+-- Bangs inside are parsed as infix operator applications, so that
+-- we parse them right when bang-patterns are off
+pat     :: { LPat GhcPs }
+pat     :  exp          {% (checkPattern <=< runECP_P) $1 }
+
+bindpat :: { LPat GhcPs }
+bindpat :  exp            {% -- See Note [Parser-Validator ReaderT SDoc] in GHC.Parser.PostProcess
+                             checkPattern_msg (text "Possibly caused by a missing 'do'?")
+                                              (runECP_PV $1) }
+
+apat   :: { LPat GhcPs }
+apat    : aexp                  {% (checkPattern <=< runECP_P) $1 }
+
+apats  :: { [LPat GhcPs] }
+        : apat apats            { $1 : $2 }
+        | {- empty -}           { [] }
+
+-----------------------------------------------------------------------------
+-- Statement sequences
+
+stmtlist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LStmt GhcPs (Located b)])) }
+        : '{'           stmts '}'       { $2 >>= \ $2 -> return $
+                                          sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
+                                             ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
+        |     vocurly   stmts close     { $2 >>= \ $2 -> return $
+                                          L (gl $2) (fst $ unLoc $2
+                                                    ,reverse $ snd $ unLoc $2) }
+
+--      do { ;; s ; s ; ; s ;; }
+-- The last Stmt should be an expression, but that's hard to enforce
+-- here, because we need too much lookahead if we see do { e ; }
+-- So we use BodyStmts throughout, and switch the last one over
+-- in ParseUtils.checkDo instead
+
+stmts :: { forall b. DisambECP b => PV (Located ([AddAnn],[LStmt GhcPs (Located b)])) }
+        : stmts ';' stmt  { $1 >>= \ $1 ->
+                            $3 >>= \ $3 ->
+                            if null (snd $ unLoc $1)
+                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
+                                                     ,$3 : (snd $ unLoc $1)))
+                              else do
+                               { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
+                               ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
+
+        | stmts ';'     {  $1 >>= \ $1 ->
+                           if null (snd $ unLoc $1)
+                             then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
+                             else do
+                               { ams (head $ snd $ unLoc $1)
+                                               [mj AnnSemi $2]
+                               ; return $1 }
+          }
+        | stmt                   { $1 >>= \ $1 ->
+                                   return $ sL1 $1 ([],[$1]) }
+        | {- empty -}            { return $ noLoc ([],[]) }
+
+
+-- For typing stmts at the GHCi prompt, where
+-- the input may consist of just comments.
+maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }
+        : stmt                          {% fmap Just (runPV $1) }
+        | {- nothing -}                 { Nothing }
+
+-- For GHC API.
+e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
+        : stmt                          {% runPV $1 }
+
+stmt  :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
+        : qual                          { $1 }
+        | 'rec' stmtlist                {  $2 >>= \ $2 ->
+                                           ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
+                                               (mj AnnRec $1:(fst $ unLoc $2)) }
+
+qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
+    : bindpat '<-' exp                   { runECP_PV $3 >>= \ $3 ->
+                                           ams (sLL $1 $> $ mkPsBindStmt $1 $3)
+                                               [mu AnnLarrow $2] }
+    | exp                                { runECP_PV $1 >>= \ $1 ->
+                                           return $ sL1 $1 $ mkBodyStmt $1 }
+    | 'let' binds                        { ams (sLL $1 $> $ LetStmt noExtField (snd $ unLoc $2))
+                                               (mj AnnLet $1:(fst $ unLoc $2)) }
+
+-----------------------------------------------------------------------------
+-- Record Field Update/Construction
+
+fbinds  :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+        : fbinds1                       { $1 }
+        | {- empty -}                   { return ([],([], Nothing)) }
+
+fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+        : fbind ',' fbinds1
+                 { $1 >>= \ $1 ->
+                   $3 >>= \ $3 ->
+                   addAnnotation (gl $1) AnnComma (gl $2) >>
+                   return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
+        | fbind                         { $1 >>= \ $1 ->
+                                          return ([],([$1], Nothing)) }
+        | '..'                          { return ([mj AnnDotdot $1],([],   Just (getLoc $1))) }
+
+fbind   :: { forall b. DisambECP b => PV (LHsRecField GhcPs (Located b)) }
+        : qvar '=' texp  { runECP_PV $3 >>= \ $3 ->
+                           ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
+                                [mj AnnEqual $2] }
+                        -- RHS is a 'texp', allowing view patterns (#6038)
+                        -- and, incidentally, sections.  Eg
+                        -- f (R { x = show -> s }) = ...
+
+        | qvar          { placeHolderPunRhs >>= \rhs ->
+                          return $ sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True }
+                        -- In the punning case, use a place-holder
+                        -- The renamer fills in the final value
+
+-----------------------------------------------------------------------------
+-- Implicit Parameter Bindings
+
+dbinds  :: { Located [LIPBind GhcPs] }
+        : dbinds ';' dbind
+                      {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
+                         return (let { this = $3; rest = unLoc $1 }
+                              in rest `seq` this `seq` sLL $1 $> (this : rest)) }
+        | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
+                         return (sLL $1 $> (unLoc $1)) }
+        | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
+--      | {- empty -}                  { [] }
+
+dbind   :: { LIPBind GhcPs }
+dbind   : ipvar '=' exp                {% runECP_P $3 >>= \ $3 ->
+                                          ams (sLL $1 $> (IPBind noExtField (Left $1) $3))
+                                              [mj AnnEqual $2] }
+
+ipvar   :: { Located HsIPName }
+        : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
+
+-----------------------------------------------------------------------------
+-- Overloaded labels
+
+overloaded_label :: { Located FastString }
+        : LABELVARID          { sL1 $1 (getLABELVARID $1) }
+
+-----------------------------------------------------------------------------
+-- Warnings and deprecations
+
+name_boolformula_opt :: { LBooleanFormula (Located RdrName) }
+        : name_boolformula          { $1 }
+        | {- empty -}               { noLoc mkTrue }
+
+name_boolformula :: { LBooleanFormula (Located RdrName) }
+        : name_boolformula_and                      { $1 }
+        | name_boolformula_and '|' name_boolformula
+                           {% aa $1 (AnnVbar, $2)
+                              >> return (sLL $1 $> (Or [$1,$3])) }
+
+name_boolformula_and :: { LBooleanFormula (Located RdrName) }
+        : name_boolformula_and_list
+                  { sLL (head $1) (last $1) (And ($1)) }
+
+name_boolformula_and_list :: { [LBooleanFormula (Located RdrName)] }
+        : name_boolformula_atom                               { [$1] }
+        | name_boolformula_atom ',' name_boolformula_and_list
+            {% aa $1 (AnnComma, $2) >> return ($1 : $3) }
+
+name_boolformula_atom :: { LBooleanFormula (Located RdrName) }
+        : '(' name_boolformula ')'  {% ams (sLL $1 $> (Parens $2)) [mop $1,mcp $3] }
+        | name_var                  { sL1 $1 (Var $1) }
+
+namelist :: { Located [Located RdrName] }
+namelist : name_var              { sL1 $1 [$1] }
+         | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
+                                    return (sLL $1 $> ($1 : unLoc $3)) }
+
+name_var :: { Located RdrName }
+name_var : var { $1 }
+         | con { $1 }
+
+-----------------------------------------
+-- Data constructors
+-- There are two different productions here as lifted list constructors
+-- are parsed differently.
+
+qcon_nowiredlist :: { Located RdrName }
+        : gen_qcon                     { $1 }
+        | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
+
+qcon :: { Located RdrName }
+  : gen_qcon              { $1}
+  | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
+
+gen_qcon :: { Located RdrName }
+  : qconid                { $1 }
+  | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
+                                   [mop $1,mj AnnVal $2,mcp $3] }
+
+con     :: { Located RdrName }
+        : conid                 { $1 }
+        | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mop $1,mj AnnVal $2,mcp $3] }
+        | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
+
+con_list :: { Located [Located RdrName] }
+con_list : con                  { sL1 $1 [$1] }
+         | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
+                                   return (sLL $1 $> ($1 : unLoc $3)) }
+
+-- See Note [ExplicitTuple] in GHC.Hs.Expr
+sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
+        : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
+        | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
+                                       (mop $1:mcp $3:(mcommas (fst $2))) }
+        | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
+                                       (mo $1:mc $3:(mcommas (fst $2))) }
+
+-- See Note [Empty lists] in GHC.Hs.Expr
+sysdcon :: { Located DataCon }
+        : sysdcon_nolist                 { $1 }
+        | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
+
+conop :: { Located RdrName }
+        : consym                { $1 }
+        | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+qconop :: { Located RdrName }
+        : qconsym               { $1 }
+        | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+----------------------------------------------------------------------------
+-- Type constructors
+
+
+-- See Note [Unit tuples] in GHC.Hs.Types for the distinction
+-- between gtycon and ntgtycon
+gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
+        : ntgtycon                     { $1 }
+        | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
+                                              [mop $1,mcp $2] }
+        | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
+                                              [mo $1,mc $2] }
+
+ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
+        : oqtycon               { $1 }
+        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
+                                                        (snd $2 + 1)))
+                                       (mop $1:mcp $3:(mcommas (fst $2))) }
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
+                                                        (snd $2 + 1)))
+                                       (mo $1:mc $3:(mcommas (fst $2))) }
+        | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
+                                       [mop $1,mu AnnRarrow $2,mcp $3] }
+        | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
+
+oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
+                                -- These can appear in export lists
+        : qtycon                        { $1 }
+        | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
+                                               [mop $1,mj AnnVal $2,mcp $3] }
+
+oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
+                                          -- for variable constructor in export lists
+                                          -- see Note [Type constructors in export list]
+        :  qtycon            { $1 }
+        | '(' QCONSYM ')'    {% let { name :: Located RdrName
+                                    ; name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2) }
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+        | '(' CONSYM ')'     {% let { name :: Located RdrName
+                                    ; name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2) }
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+        | '(' ':' ')'        {% let { name :: Located RdrName
+                                    ; name = sL1 $2 $! consDataCon_RDR }
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+
+{- Note [Type constructors in export list]
+~~~~~~~~~~~~~~~~~~~~~
+Mixing type constructors and data constructors in export lists introduces
+ambiguity in grammar: e.g. (*) may be both a type constructor and a function.
+
+-XExplicitNamespaces allows to disambiguate by explicitly prefixing type
+constructors with 'type' keyword.
+
+This ambiguity causes reduce/reduce conflicts in parser, which are always
+resolved in favour of data constructors. To get rid of conflicts we demand
+that ambiguous type constructors (those, which are formed by the same
+productions as variable constructors) are always prefixed with 'type' keyword.
+Unambiguous type constructors may occur both with or without 'type' keyword.
+
+Note that in the parser we still parse data constructors as type
+constructors. As such, they still end up in the type constructor namespace
+until after renaming when we resolve the proper namespace for each exported
+child.
+-}
+
+qtyconop :: { Located RdrName } -- Qualified or unqualified
+        : qtyconsym                     { $1 }
+        | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
+                                               [mj AnnBackquote $1,mj AnnVal $2
+                                               ,mj AnnBackquote $3] }
+
+qtycon :: { Located RdrName }   -- Qualified or unqualified
+        : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
+        | tycon             { $1 }
+
+qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified
+        : qtycon            { sL1 $1                           (HsTyVar noExtField NotPromoted $1)      }
+        | qtycon docprev    { sLL $1 $> (HsDocTy noExtField (sL1 $1 (HsTyVar noExtField NotPromoted $1)) $2) }
+
+tycon   :: { Located RdrName }  -- Unqualified
+        : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
+
+qtyconsym :: { Located RdrName }
+        : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
+        | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
+        | tyconsym           { $1 }
+
+tyconsym :: { Located RdrName }
+        : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
+        | VARSYM                { sL1 $1 $!
+                                    -- See Note [eqTyCon (~) is built-in syntax] in GHC.Builtin.Types
+                                    if getVARSYM $1 == fsLit "~"
+                                      then eqTyCon_RDR
+                                      else mkUnqual tcClsName (getVARSYM $1) }
+        | ':'                   { sL1 $1 $! consDataCon_RDR }
+        | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
+        | '.'                   { sL1 $1 $! mkUnqual tcClsName (fsLit ".") }
+
+
+-----------------------------------------------------------------------------
+-- Operators
+
+op      :: { Located RdrName }   -- used in infix decls
+        : varop                 { $1 }
+        | conop                 { $1 }
+        | '->'                  { sL1 $1 $ getRdrName funTyCon }
+
+varop   :: { Located RdrName }
+        : varsym                { $1 }
+        | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+qop     :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+        : qvarop                { mkHsVarOpPV $1 }
+        | qconop                { mkHsConOpPV $1 }
+        | hole_op               { $1 }
+
+qopm    :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+        : qvaropm               { mkHsVarOpPV $1 }
+        | qconop                { mkHsConOpPV $1 }
+        | hole_op               { $1 }
+
+hole_op :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+hole_op : '`' '_' '`'           { amms (mkHsInfixHolePV (comb2 $1 $>))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+qvarop :: { Located RdrName }
+        : qvarsym               { $1 }
+        | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+qvaropm :: { Located RdrName }
+        : qvarsym_no_minus      { $1 }
+        | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+-----------------------------------------------------------------------------
+-- Type variables
+
+tyvar   :: { Located RdrName }
+tyvar   : tyvarid               { $1 }
+
+tyvarop :: { Located RdrName }
+tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
+                                       [mj AnnBackquote $1,mj AnnVal $2
+                                       ,mj AnnBackquote $3] }
+
+tyvarid :: { Located RdrName }
+        : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
+        | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
+        | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
+        | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
+        | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
+        -- If this changes relative to varid, update 'checkRuleTyVarBndrNames'
+        -- in GHC.Parser.PostProcess
+        -- See Note [Parsing explicit foralls in Rules]
+
+-----------------------------------------------------------------------------
+-- Variables
+
+var     :: { Located RdrName }
+        : varid                 { $1 }
+        | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mop $1,mj AnnVal $2,mcp $3] }
+
+qvar    :: { Located RdrName }
+        : qvarid                { $1 }
+        | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
+                                       [mop $1,mj AnnVal $2,mcp $3] }
+        | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
+                                       [mop $1,mj AnnVal $2,mcp $3] }
+-- We've inlined qvarsym here so that the decision about
+-- whether it's a qvar or a var can be postponed until
+-- *after* we see the close paren.
+
+qvarid :: { Located RdrName }
+        : varid               { $1 }
+        | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
+
+-- Note that 'role' and 'family' get lexed separately regardless of
+-- the use of extensions. However, because they are listed here,
+-- this is OK and they can be used as normal varids.
+-- See Note [Lexing type pseudo-keywords] in GHC.Parser.Lexer
+varid :: { Located RdrName }
+        : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
+        | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
+        | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
+        | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
+        | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
+        | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
+        | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
+        | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
+        -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames'
+        -- in GHC.Parser.PostProcess
+        -- See Note [Parsing explicit foralls in Rules]
+
+qvarsym :: { Located RdrName }
+        : varsym                { $1 }
+        | qvarsym1              { $1 }
+
+qvarsym_no_minus :: { Located RdrName }
+        : varsym_no_minus       { $1 }
+        | qvarsym1              { $1 }
+
+qvarsym1 :: { Located RdrName }
+qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
+
+varsym :: { Located RdrName }
+        : varsym_no_minus       { $1 }
+        | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
+
+varsym_no_minus :: { Located RdrName } -- varsym not including '-'
+        : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
+        | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
+
+
+-- These special_ids are treated as keywords in various places,
+-- but as ordinary ids elsewhere.   'special_id' collects all these
+-- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock', and
+-- 'anyclass', whose treatment differs depending on context
+special_id :: { Located FastString }
+special_id
+        : 'as'                  { sL1 $1 (fsLit "as") }
+        | 'qualified'           { sL1 $1 (fsLit "qualified") }
+        | 'hiding'              { sL1 $1 (fsLit "hiding") }
+        | 'export'              { sL1 $1 (fsLit "export") }
+        | 'label'               { sL1 $1 (fsLit "label")  }
+        | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
+        | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
+        | 'ccall'               { sL1 $1 (fsLit "ccall") }
+        | 'capi'                { sL1 $1 (fsLit "capi") }
+        | 'prim'                { sL1 $1 (fsLit "prim") }
+        | 'javascript'          { sL1 $1 (fsLit "javascript") }
+        | 'group'               { sL1 $1 (fsLit "group") }
+        | 'stock'               { sL1 $1 (fsLit "stock") }
+        | 'anyclass'            { sL1 $1 (fsLit "anyclass") }
+        | 'via'                 { sL1 $1 (fsLit "via") }
+        | 'unit'                { sL1 $1 (fsLit "unit") }
+        | 'dependency'          { sL1 $1 (fsLit "dependency") }
+        | 'signature'           { sL1 $1 (fsLit "signature") }
+
+special_sym :: { Located FastString }
+special_sym : '.'       { sL1 $1 (fsLit ".") }
+            | '*'       { sL1 $1 (fsLit (starSym (isUnicode $1))) }
+
+-----------------------------------------------------------------------------
+-- Data constructors
+
+qconid :: { Located RdrName }   -- Qualified or unqualified
+        : conid              { $1 }
+        | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
+
+conid   :: { Located RdrName }
+        : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
+
+qconsym :: { Located RdrName }  -- Qualified or unqualified
+        : consym               { $1 }
+        | QCONSYM              { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
+
+consym :: { Located RdrName }
+        : CONSYM              { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
+
+        -- ':' means only list cons
+        | ':'                { sL1 $1 $ consDataCon_RDR }
+
+
+-----------------------------------------------------------------------------
+-- Literals
+
+literal :: { Located (HsLit GhcPs) }
+        : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
+        | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
+                                                    $ getSTRING $1 }
+        | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
+                                                    $ getPRIMINTEGER $1 }
+        | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
+                                                    $ getPRIMWORD $1 }
+        | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
+                                                    $ getPRIMCHAR $1 }
+        | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
+                                                    $ getPRIMSTRING $1 }
+        | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  noExtField $ getPRIMFLOAT $1 }
+        | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim noExtField $ getPRIMDOUBLE $1 }
+
+-----------------------------------------------------------------------------
+-- Layout
+
+close :: { () }
+        : vccurly               { () } -- context popped in lexer.
+        | error                 {% popContext }
+
+-----------------------------------------------------------------------------
+-- Miscellaneous (mostly renamings)
+
+modid   :: { Located ModuleName }
+        : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
+        | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
+                                  mkModuleNameFS
+                                   (mkFastString
+                                     (unpackFS mod ++ '.':unpackFS c))
+                                }
+
+commas :: { ([SrcSpan],Int) }   -- One or more commas
+        : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
+        | ','                    { ([gl $1],1) }
+
+bars0 :: { ([SrcSpan],Int) }     -- Zero or more bars
+        : bars                   { $1 }
+        |                        { ([], 0) }
+
+bars :: { ([SrcSpan],Int) }     -- One or more bars
+        : bars '|'               { ((fst $1)++[gl $2],snd $1 + 1) }
+        | '|'                    { ([gl $1],1) }
+
+-----------------------------------------------------------------------------
+-- Documentation comments
+
+docnext :: { LHsDocString }
+  : DOCNEXT {% return (sL1 $1 (mkHsDocString (getDOCNEXT $1))) }
+
+docprev :: { LHsDocString }
+  : DOCPREV {% return (sL1 $1 (mkHsDocString (getDOCPREV $1))) }
+
+docnamed :: { Located (String, HsDocString) }
+  : DOCNAMED {%
+      let string = getDOCNAMED $1
+          (name, rest) = break isSpace string
+      in return (sL1 $1 (name, mkHsDocString rest)) }
+
+docsection :: { Located (Int, HsDocString) }
+  : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
+        return (sL1 $1 (n, mkHsDocString doc)) }
+
+moduleheader :: { Maybe LHsDocString }
+        : DOCNEXT {% let string = getDOCNEXT $1 in
+                     return (Just (sL1 $1 (mkHsDocString string))) }
+
+maybe_docprev :: { Maybe LHsDocString }
+        : docprev                       { Just $1 }
+        | {- empty -}                   { Nothing }
+
+maybe_docnext :: { Maybe LHsDocString }
+        : docnext                       { Just $1 }
+        | {- empty -}                   { Nothing }
+
+{
+happyError :: P a
+happyError = srcParseFail
+
+getVARID        (L _ (ITvarid    x)) = x
+getCONID        (L _ (ITconid    x)) = x
+getVARSYM       (L _ (ITvarsym   x)) = x
+getCONSYM       (L _ (ITconsym   x)) = x
+getQVARID       (L _ (ITqvarid   x)) = x
+getQCONID       (L _ (ITqconid   x)) = x
+getQVARSYM      (L _ (ITqvarsym  x)) = x
+getQCONSYM      (L _ (ITqconsym  x)) = x
+getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
+getLABELVARID   (L _ (ITlabelvarid   x)) = x
+getCHAR         (L _ (ITchar   _ x)) = x
+getSTRING       (L _ (ITstring _ x)) = x
+getINTEGER      (L _ (ITinteger x))  = x
+getRATIONAL     (L _ (ITrational x)) = x
+getPRIMCHAR     (L _ (ITprimchar _ x)) = x
+getPRIMSTRING   (L _ (ITprimstring _ x)) = x
+getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
+getPRIMWORD     (L _ (ITprimword _ x)) = x
+getPRIMFLOAT    (L _ (ITprimfloat x)) = x
+getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
+getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
+getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
+getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
+getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x
+
+getDOCNEXT (L _ (ITdocCommentNext x)) = x
+getDOCPREV (L _ (ITdocCommentPrev x)) = x
+getDOCNAMED (L _ (ITdocCommentNamed x)) = x
+getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
+
+getINTEGERs     (L _ (ITinteger (IL src _ _))) = src
+getCHARs        (L _ (ITchar       src _)) = src
+getSTRINGs      (L _ (ITstring     src _)) = src
+getPRIMCHARs    (L _ (ITprimchar   src _)) = src
+getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
+getPRIMINTEGERs (L _ (ITprimint    src _)) = src
+getPRIMWORDs    (L _ (ITprimword   src _)) = src
+
+-- See Note [Pragma source text] in BasicTypes for the following
+getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
+getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
+getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
+getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
+getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
+getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
+getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
+getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
+getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
+getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
+getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
+getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
+getANN_PRAGs          (L _ (ITann_prag          src)) = src
+getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
+getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
+getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
+getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
+getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
+getCTYPEs             (L _ (ITctype             src)) = src
+
+getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
+
+isUnicode :: Located Token -> Bool
+isUnicode (L _ (ITforall         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdcolon         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow         iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (IToparenbar      iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcparenbar      iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITstar           iu)) = iu == UnicodeSyntax
+isUnicode _                           = False
+
+hasE :: Located Token -> Bool
+hasE (L _ (ITopenExpQuote HasE _)) = True
+hasE (L _ (ITopenTExpQuote HasE))  = True
+hasE _                             = False
+
+getSCC :: Located Token -> P FastString
+getSCC lt = do let s = getSTRING lt
+                   err = "Spaces are not allowed in SCCs"
+               -- We probably actually want to be more restrictive than this
+               if ' ' `elem` unpackFS s
+                   then addFatalError (getLoc lt) (text err)
+                   else return s
+
+-- Utilities for combining source spans
+comb2 :: Located a -> Located b -> SrcSpan
+comb2 a b = a `seq` b `seq` combineLocs a b
+
+comb3 :: Located a -> Located b -> Located c -> SrcSpan
+comb3 a b c = a `seq` b `seq` c `seq`
+    combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
+
+comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
+comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
+    (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
+                combineSrcSpans (getLoc c) (getLoc d))
+
+-- strict constructor version:
+{-# INLINE sL #-}
+sL :: SrcSpan -> a -> Located a
+sL span a = span `seq` a `seq` L span a
+
+-- See Note [Adding location info] for how these utility functions are used
+
+-- replaced last 3 CPP macros in this file
+{-# INLINE sL0 #-}
+sL0 :: a -> Located a
+sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
+
+{-# INLINE sL1 #-}
+sL1 :: Located a -> b -> Located b
+sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
+
+{-# INLINE sLL #-}
+sLL :: Located a -> Located b -> c -> Located c
+sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
+
+{- Note [Adding location info]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+This is done using the three functions below, sL0, sL1
+and sLL.  Note that these functions were mechanically
+converted from the three macros that used to exist before,
+namely L0, L1 and LL.
+
+They each add a SrcSpan to their argument.
+
+   sL0  adds 'noSrcSpan', used for empty productions
+     -- This doesn't seem to work anymore -=chak
+
+   sL1  for a production with a single token on the lhs.  Grabs the SrcSpan
+        from that token.
+
+   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from
+        the first and last tokens.
+
+These suffice for the majority of cases.  However, we must be
+especially careful with empty productions: sLL won't work if the first
+or last token on the lhs can represent an empty span.  In these cases,
+we have to calculate the span using more of the tokens from the lhs, eg.
+
+        | 'newtype' tycl_hdr '=' newconstr deriving
+                { L (comb3 $1 $4 $5)
+                    (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }
+
+We provide comb3 and comb4 functions which are useful in such cases.
+
+Be careful: there's no checking that you actually got this right, the
+only symptom will be that the SrcSpans of your syntax will be
+incorrect.
+
+-}
+
+-- Make a source location for the file.  We're a bit lazy here and just
+-- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
+-- try to find the span of the whole file (ToDo).
+fileSrcSpan :: P SrcSpan
+fileSrcSpan = do
+  l <- getRealSrcLoc;
+  let loc = mkSrcLoc (srcLocFile l) 1 1;
+  return (mkSrcSpan loc loc)
+
+-- Hint about the MultiWayIf extension
+hintMultiWayIf :: SrcSpan -> P ()
+hintMultiWayIf span = do
+  mwiEnabled <- getBit MultiWayIfBit
+  unless mwiEnabled $ addError span $
+    text "Multi-way if-expressions need MultiWayIf turned on"
+
+-- Hint about explicit-forall
+hintExplicitForall :: Located Token -> P ()
+hintExplicitForall tok = do
+    forall   <- getBit ExplicitForallBit
+    rulePrag <- getBit InRulePragBit
+    unless (forall || rulePrag) $ addError (getLoc tok) $ vcat
+      [ text "Illegal symbol" <+> quotes forallSymDoc <+> text "in type"
+      , text "Perhaps you intended to use RankNTypes or a similar language"
+      , text "extension to enable explicit-forall syntax:" <+>
+        forallSymDoc <+> text "<tvs>. <type>"
+      ]
+  where
+    forallSymDoc = text (forallSym (isUnicode tok))
+
+-- When two single quotes don't followed by tyvar or gtycon, we report the
+-- error as empty character literal, or TH quote that missing proper type
+-- variable or constructor. See #13450.
+reportEmptyDoubleQuotes :: SrcSpan -> P a
+reportEmptyDoubleQuotes span = do
+    thQuotes <- getBit ThQuotesBit
+    if thQuotes
+      then addFatalError span $ vcat
+        [ text "Parser error on `''`"
+        , text "Character literals may not be empty"
+        , text "Or perhaps you intended to use quotation syntax of TemplateHaskell,"
+        , text "but the type variable or constructor is missing"
+        ]
+      else addFatalError span $ vcat
+        [ text "Parser error on `''`"
+        , text "Character literals may not be empty"
+        ]
+
+{-
+%************************************************************************
+%*                                                                      *
+        Helper functions for generating annotations in the parser
+%*                                                                      *
+%************************************************************************
+
+For the general principles of the following routines, see Note [Api annotations]
+in GHC.Parser.Annotation
+
+-}
+
+-- |Construct an AddAnn from the annotation keyword and the location
+-- of the keyword itself
+mj :: AnnKeywordId -> Located e -> AddAnn
+mj a l = AddAnn a (gl l)
+
+
+-- |Construct an AddAnn from the annotation keyword and the Located Token. If
+-- the token has a unicode equivalent and this has been used, provide the
+-- unicode variant of the annotation.
+mu :: AnnKeywordId -> Located Token -> AddAnn
+mu a lt@(L l t) = AddAnn (toUnicodeAnn a lt) l
+
+-- | If the 'Token' is using its unicode variant return the unicode variant of
+--   the annotation
+toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
+toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
+
+gl :: Located a -> SrcSpan
+gl = getLoc
+
+-- |Add an annotation to the located element, and return the located
+-- element as a pass through
+aa :: Located a -> (AnnKeywordId, Located c) -> P (Located a)
+aa a@(L l _) (b,s) = addAnnotation l b (gl s) >> return a
+
+-- |Add an annotation to a located element resulting from a monadic action
+am :: P (Located a) -> (AnnKeywordId, Located b) -> P (Located a)
+am a (b,s) = do
+  av@(L l _) <- a
+  addAnnotation l b (gl s)
+  return av
+
+-- | Add a list of AddAnns to the given AST element.  For example,
+-- the parsing rule for @let@ looks like:
+--
+-- @
+--      | 'let' binds 'in' exp    {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
+--                                       (mj AnnLet $1:mj AnnIn $3
+--                                         :(fst $ unLoc $2)) }
+-- @
+--
+-- This adds an AnnLet annotation for @let@, an AnnIn for @in@, as well
+-- as any annotations that may arise in the binds. This will include open
+-- and closing braces if they are used to delimit the let expressions.
+--
+ams :: MonadP m => Located a -> [AddAnn] -> m (Located a)
+ams a@(L l _) bs = addAnnsAt l bs >> return a
+
+amsL :: SrcSpan -> [AddAnn] -> P ()
+amsL sp bs = addAnnsAt sp bs >> return ()
+
+-- |Add all [AddAnn] to an AST element, and wrap it in a 'Just'
+ajs :: MonadP m => Located a -> [AddAnn] -> m (Maybe (Located a))
+ajs a bs = Just <$> ams a bs
+
+-- |Add a list of AddAnns to the given AST element, where the AST element is the
+--  result of a monadic action
+amms :: MonadP m => m (Located a) -> [AddAnn] -> m (Located a)
+amms a bs = do { av@(L l _) <- a
+               ; addAnnsAt l bs
+               ; return av }
+
+-- |Add a list of AddAnns to the AST element, and return the element as a
+--  OrdList
+amsu :: Located a -> [AddAnn] -> P (OrdList (Located a))
+amsu a@(L l _) bs = addAnnsAt l bs >> return (unitOL a)
+
+-- |Synonyms for AddAnn versions of AnnOpen and AnnClose
+mo,mc :: Located Token -> AddAnn
+mo ll = mj AnnOpen ll
+mc ll = mj AnnClose ll
+
+moc,mcc :: Located Token -> AddAnn
+moc ll = mj AnnOpenC ll
+mcc ll = mj AnnCloseC ll
+
+mop,mcp :: Located Token -> AddAnn
+mop ll = mj AnnOpenP ll
+mcp ll = mj AnnCloseP ll
+
+mos,mcs :: Located Token -> AddAnn
+mos ll = mj AnnOpenS ll
+mcs ll = mj AnnCloseS ll
+
+-- |Given a list of the locations of commas, provide a [AddAnn] with an AnnComma
+--  entry for each SrcSpan
+mcommas :: [SrcSpan] -> [AddAnn]
+mcommas = map (AddAnn AnnCommaTuple)
+
+-- |Given a list of the locations of '|'s, provide a [AddAnn] with an AnnVbar
+--  entry for each SrcSpan
+mvbars :: [SrcSpan] -> [AddAnn]
+mvbars = map (AddAnn AnnVbar)
+
+-- |Get the location of the last element of a OrdList, or noSrcSpan
+oll :: OrdList (Located a) -> SrcSpan
+oll l =
+  if isNilOL l then noSrcSpan
+               else getLoc (lastOL l)
+
+-- |Add a semicolon annotation in the right place in a list. If the
+-- leading list is empty, add it to the tail
+asl :: [Located a] -> Located b -> Located a -> P ()
+asl [] (L ls _) (L l _) = addAnnotation l          AnnSemi ls
+asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
+}
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
new file mode 100644
index 0000000000..dbd1f79e23
--- /dev/null
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -0,0 +1,378 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module GHC.Parser.Annotation (
+  getAnnotation, getAndRemoveAnnotation,
+  getAnnotationComments,getAndRemoveAnnotationComments,
+  ApiAnns(..),
+  ApiAnnKey,
+  AnnKeywordId(..),
+  AnnotationComment(..),
+  IsUnicodeSyntax(..),
+  unicodeAnn,
+  HasE(..),
+  LRdrName -- Exists for haddocks only
+  ) where
+
+import GhcPrelude
+
+import GHC.Types.Name.Reader
+import Outputable
+import GHC.Types.SrcLoc
+import qualified Data.Map as Map
+import Data.Data
+
+
+{-
+Note [Api annotations]
+~~~~~~~~~~~~~~~~~~~~~~
+Given a parse tree of a Haskell module, how can we reconstruct
+the original Haskell source code, retaining all whitespace and
+source code comments?  We need to track the locations of all
+elements from the original source: this includes keywords such as
+'let' / 'in' / 'do' etc as well as punctuation such as commas and
+braces, and also comments.  We collectively refer to this
+metadata as the "API annotations".
+
+Rather than annotate the resulting parse tree with these locations
+directly (this would be a major change to some fairly core data
+structures in GHC), we instead capture locations for these elements in a
+structure separate from the parse tree, and returned in the
+pm_annotations field of the ParsedModule type.
+
+The full ApiAnns type is
+
+> data ApiAnns =
+>  ApiAnns
+>    { apiAnnItems :: Map.Map ApiAnnKey [RealSrcSpan],
+>      apiAnnEofPos :: Maybe RealSrcSpan,
+>      apiAnnComments :: Map.Map RealSrcSpan [RealLocated AnnotationComment],
+>      apiAnnRogueComments :: [RealLocated AnnotationComment]
+>    }
+
+NON-COMMENT ELEMENTS
+
+Intuitively, every AST element directly contains a bag of keywords
+(keywords can show up more than once in a node: a semicolon i.e. newline
+can show up multiple times before the next AST element), each of which
+needs to be associated with its location in the original source code.
+
+Consequently, the structure that records non-comment elements is logically
+a two level map, from the RealSrcSpan of the AST element containing it, to
+a map from keywords ('AnnKeyWord') to all locations of the keyword directly
+in the AST element:
+
+> type ApiAnnKey = (RealSrcSpan,AnnKeywordId)
+>
+> Map.Map ApiAnnKey [RealSrcSpan]
+
+So
+
+> let x = 1 in 2 *x
+
+would result in the AST element
+
+  L span (HsLet (binds for x = 1) (2 * x))
+
+and the annotations
+
+  (span,AnnLet) having the location of the 'let' keyword
+  (span,AnnEqual) having the location of the '=' sign
+  (span,AnnIn)  having the location of the 'in' keyword
+
+For any given element in the AST, there is only a set number of
+keywords that are applicable for it (e.g., you'll never see an
+'import' keyword associated with a let-binding.)  The set of allowed
+keywords is documented in a comment associated with the constructor
+of a given AST element, although the ground truth is in GHC.Parser
+and GHC.Parser.PostProcess (which actually add the annotations; see #13012).
+
+COMMENT ELEMENTS
+
+Every comment is associated with a *located* AnnotationComment.
+We associate comments with the lowest (most specific) AST element
+enclosing them:
+
+> Map.Map RealSrcSpan [RealLocated AnnotationComment]
+
+PARSER STATE
+
+There are three fields in PState (the parser state) which play a role
+with annotations.
+
+>  annotations :: [(ApiAnnKey,[RealSrcSpan])],
+>  comment_q :: [RealLocated AnnotationComment],
+>  annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])]
+
+The 'annotations' and 'annotations_comments' fields are simple: they simply
+accumulate annotations that will end up in 'ApiAnns' at the end
+(after they are passed to Map.fromList).
+
+The 'comment_q' field captures comments as they are seen in the token stream,
+so that when they are ready to be allocated via the parser they are
+available (at the time we lex a comment, we don't know what the enclosing
+AST node of it is, so we can't associate it with a RealSrcSpan in
+annotations_comments).
+
+PARSER EMISSION OF ANNOTATIONS
+
+The parser interacts with the lexer using the function
+
+> addAnnotation :: RealSrcSpan -> AnnKeywordId -> RealSrcSpan -> P ()
+
+which takes the AST element RealSrcSpan, the annotation keyword and the
+target RealSrcSpan.
+
+This adds the annotation to the `annotations` field of `PState` and
+transfers any comments in `comment_q` WHICH ARE ENCLOSED by
+the RealSrcSpan of this element to the `annotations_comments`
+field.  (Comments which are outside of this annotation are deferred
+until later. 'allocateComments' in 'Lexer' is responsible for
+making sure we only attach comments that actually fit in the 'SrcSpan'.)
+
+The wiki page describing this feature is
+https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
+
+-}
+-- ---------------------------------------------------------------------
+
+-- If you update this, update the Note [Api annotations] above
+data ApiAnns =
+  ApiAnns
+    { apiAnnItems :: Map.Map ApiAnnKey [RealSrcSpan],
+      apiAnnEofPos :: Maybe RealSrcSpan,
+      apiAnnComments :: Map.Map RealSrcSpan [RealLocated AnnotationComment],
+      apiAnnRogueComments :: [RealLocated AnnotationComment]
+    }
+
+-- If you update this, update the Note [Api annotations] above
+type ApiAnnKey = (RealSrcSpan,AnnKeywordId)
+
+
+-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'
+-- of the annotated AST element, and the known type of the annotation.
+getAnnotation :: ApiAnns -> RealSrcSpan -> AnnKeywordId -> [RealSrcSpan]
+getAnnotation anns span ann =
+  case Map.lookup ann_key ann_items of
+    Nothing -> []
+    Just ss -> ss
+  where ann_items = apiAnnItems anns
+        ann_key = (span,ann)
+
+-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'
+-- of the annotated AST element, and the known type of the annotation.
+-- The list is removed from the annotations.
+getAndRemoveAnnotation :: ApiAnns -> RealSrcSpan -> AnnKeywordId
+                       -> ([RealSrcSpan],ApiAnns)
+getAndRemoveAnnotation anns span ann =
+  case Map.lookup ann_key ann_items of
+    Nothing -> ([],anns)
+    Just ss -> (ss,anns{ apiAnnItems = Map.delete ann_key ann_items })
+  where ann_items = apiAnnItems anns
+        ann_key = (span,ann)
+
+-- |Retrieve the comments allocated to the current 'SrcSpan'
+--
+--  Note: A given 'SrcSpan' may appear in multiple AST elements,
+--  beware of duplicates
+getAnnotationComments :: ApiAnns -> RealSrcSpan -> [RealLocated AnnotationComment]
+getAnnotationComments anns span =
+  case Map.lookup span (apiAnnComments anns) of
+    Just cs -> cs
+    Nothing -> []
+
+-- |Retrieve the comments allocated to the current 'SrcSpan', and
+-- remove them from the annotations
+getAndRemoveAnnotationComments :: ApiAnns -> RealSrcSpan
+                               -> ([RealLocated AnnotationComment],ApiAnns)
+getAndRemoveAnnotationComments anns span =
+  case Map.lookup span ann_comments of
+    Just cs -> (cs, anns{ apiAnnComments = Map.delete span ann_comments })
+    Nothing -> ([], anns)
+  where ann_comments = apiAnnComments anns
+
+-- --------------------------------------------------------------------
+
+-- | API Annotations exist so that tools can perform source to source
+-- conversions of Haskell code. They are used to keep track of the
+-- various syntactic keywords that are not captured in the existing
+-- AST.
+--
+-- The annotations, together with original source comments are made
+-- available in the @'pm_annotations'@ field of @'GHC.ParsedModule'@.
+-- Comments are only retained if @'Opt_KeepRawTokenStream'@ is set in
+-- @'DynFlags.DynFlags'@ before parsing.
+--
+-- The wiki page describing this feature is
+-- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
+--
+-- Note: in general the names of these are taken from the
+-- corresponding token, unless otherwise noted
+-- See note [Api annotations] above for details of the usage
+data AnnKeywordId
+    = AnnAnyclass
+    | AnnAs
+    | AnnAt
+    | AnnBang  -- ^ '!'
+    | AnnBackquote -- ^ '`'
+    | AnnBy
+    | AnnCase -- ^ case or lambda case
+    | AnnClass
+    | AnnClose -- ^  '\#)' or '\#-}'  etc
+    | AnnCloseB -- ^ '|)'
+    | AnnCloseBU -- ^ '|)', unicode variant
+    | AnnCloseC -- ^ '}'
+    | AnnCloseQ  -- ^ '|]'
+    | AnnCloseQU -- ^ '|]', unicode variant
+    | AnnCloseP -- ^ ')'
+    | AnnCloseS -- ^ ']'
+    | AnnColon
+    | AnnComma -- ^ as a list separator
+    | AnnCommaTuple -- ^ in a RdrName for a tuple
+    | AnnDarrow -- ^ '=>'
+    | AnnDarrowU -- ^ '=>', unicode variant
+    | AnnData
+    | AnnDcolon -- ^ '::'
+    | AnnDcolonU -- ^ '::', unicode variant
+    | AnnDefault
+    | AnnDeriving
+    | AnnDo
+    | AnnDot    -- ^ '.'
+    | AnnDotdot -- ^ '..'
+    | AnnElse
+    | AnnEqual
+    | AnnExport
+    | AnnFamily
+    | AnnForall
+    | AnnForallU -- ^ Unicode variant
+    | AnnForeign
+    | AnnFunId -- ^ for function name in matches where there are
+               -- multiple equations for the function.
+    | AnnGroup
+    | AnnHeader -- ^ for CType
+    | AnnHiding
+    | AnnIf
+    | AnnImport
+    | AnnIn
+    | AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'
+    | AnnInstance
+    | AnnLam
+    | AnnLarrow     -- ^ '<-'
+    | AnnLarrowU    -- ^ '<-', unicode variant
+    | AnnLet
+    | AnnMdo
+    | AnnMinus -- ^ '-'
+    | AnnModule
+    | AnnNewtype
+    | AnnName -- ^ where a name loses its location in the AST, this carries it
+    | AnnOf
+    | AnnOpen    -- ^ '(\#' or '{-\# LANGUAGE' etc
+    | AnnOpenB   -- ^ '(|'
+    | AnnOpenBU  -- ^ '(|', unicode variant
+    | AnnOpenC   -- ^ '{'
+    | AnnOpenE   -- ^ '[e|' or '[e||'
+    | AnnOpenEQ  -- ^ '[|'
+    | AnnOpenEQU -- ^ '[|', unicode variant
+    | AnnOpenP   -- ^ '('
+    | AnnOpenS   -- ^ '['
+    | AnnDollar          -- ^ prefix '$'   -- TemplateHaskell
+    | AnnDollarDollar    -- ^ prefix '$$'  -- TemplateHaskell
+    | AnnPackageName
+    | AnnPattern
+    | AnnProc
+    | AnnQualified
+    | AnnRarrow -- ^ '->'
+    | AnnRarrowU -- ^ '->', unicode variant
+    | AnnRec
+    | AnnRole
+    | AnnSafe
+    | AnnSemi -- ^ ';'
+    | AnnSimpleQuote -- ^ '''
+    | AnnSignature
+    | AnnStatic -- ^ 'static'
+    | AnnStock
+    | AnnThen
+    | AnnThIdSplice -- ^ '$'
+    | AnnThIdTySplice -- ^ '$$'
+    | AnnThTyQuote -- ^ double '''
+    | AnnTilde -- ^ '~'
+    | AnnType
+    | AnnUnit -- ^ '()' for types
+    | AnnUsing
+    | AnnVal  -- ^ e.g. INTEGER
+    | AnnValStr  -- ^ String value, will need quotes when output
+    | AnnVbar -- ^ '|'
+    | AnnVia -- ^ 'via'
+    | AnnWhere
+    | Annlarrowtail -- ^ '-<'
+    | AnnlarrowtailU -- ^ '-<', unicode variant
+    | Annrarrowtail -- ^ '->'
+    | AnnrarrowtailU -- ^ '->', unicode variant
+    | AnnLarrowtail -- ^ '-<<'
+    | AnnLarrowtailU -- ^ '-<<', unicode variant
+    | AnnRarrowtail -- ^ '>>-'
+    | AnnRarrowtailU -- ^ '>>-', unicode variant
+    deriving (Eq, Ord, Data, Show)
+
+instance Outputable AnnKeywordId where
+  ppr x = text (show x)
+
+-- ---------------------------------------------------------------------
+
+data AnnotationComment =
+  -- Documentation annotations
+    AnnDocCommentNext  String     -- ^ something beginning '-- |'
+  | AnnDocCommentPrev  String     -- ^ something beginning '-- ^'
+  | AnnDocCommentNamed String     -- ^ something beginning '-- $'
+  | AnnDocSection      Int String -- ^ a section heading
+  | AnnDocOptions      String     -- ^ doc options (prune, ignore-exports, etc)
+  | AnnLineComment     String     -- ^ comment starting by "--"
+  | AnnBlockComment    String     -- ^ comment in {- -}
+    deriving (Eq, Ord, Data, Show)
+-- Note: these are based on the Token versions, but the Token type is
+-- defined in GHC.Parser.Lexer and bringing it in here would create a loop
+
+instance Outputable AnnotationComment where
+  ppr x = text (show x)
+
+-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
+--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma',
+--             'ApiAnnotation.AnnRarrow'
+--             'ApiAnnotation.AnnTilde'
+--   - May have 'ApiAnnotation.AnnComma' when in a list
+type LRdrName = Located RdrName
+
+
+-- | Certain tokens can have alternate representations when unicode syntax is
+-- enabled. This flag is attached to those tokens in the lexer so that the
+-- original source representation can be reproduced in the corresponding
+-- 'ApiAnnotation'
+data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax
+    deriving (Eq, Ord, Data, Show)
+
+-- | Convert a normal annotation into its unicode equivalent one
+unicodeAnn :: AnnKeywordId -> AnnKeywordId
+unicodeAnn AnnForall     = AnnForallU
+unicodeAnn AnnDcolon     = AnnDcolonU
+unicodeAnn AnnLarrow     = AnnLarrowU
+unicodeAnn AnnRarrow     = AnnRarrowU
+unicodeAnn AnnDarrow     = AnnDarrowU
+unicodeAnn Annlarrowtail = AnnlarrowtailU
+unicodeAnn Annrarrowtail = AnnrarrowtailU
+unicodeAnn AnnLarrowtail = AnnLarrowtailU
+unicodeAnn AnnRarrowtail = AnnRarrowtailU
+unicodeAnn AnnOpenB      = AnnOpenBU
+unicodeAnn AnnCloseB     = AnnCloseBU
+unicodeAnn AnnOpenEQ     = AnnOpenEQU
+unicodeAnn AnnCloseQ     = AnnCloseQU
+unicodeAnn ann           = ann
+
+
+-- | Some template haskell tokens have two variants, one with an `e` the other
+-- not:
+--
+-- >  [| or [e|
+-- >  [|| or [e||
+--
+-- This type indicates whether the 'e' is present or not.
+data HasE = HasE | NoE
+     deriving (Eq, Ord, Data, Show)
diff --git a/compiler/GHC/Parser/CharClass.hs b/compiler/GHC/Parser/CharClass.hs
new file mode 100644
index 0000000000..dc98d48f94
--- /dev/null
+++ b/compiler/GHC/Parser/CharClass.hs
@@ -0,0 +1,215 @@
+-- Character classification
+{-# LANGUAGE CPP #-}
+module GHC.Parser.CharClass
+        ( is_ident      -- Char# -> Bool
+        , is_symbol     -- Char# -> Bool
+        , is_any        -- Char# -> Bool
+        , is_space      -- Char# -> Bool
+        , is_lower      -- Char# -> Bool
+        , is_upper      -- Char# -> Bool
+        , is_digit      -- Char# -> Bool
+        , is_alphanum   -- Char# -> Bool
+
+        , is_decdigit, is_hexdigit, is_octdigit, is_bindigit
+        , hexDigit, octDecDigit
+        ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Data.Bits        ( Bits((.&.),(.|.)) )
+import Data.Char        ( ord, chr )
+import Data.Word
+import Panic
+
+-- Bit masks
+
+cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Word8
+cIdent  =  1
+cSymbol =  2
+cAny    =  4
+cSpace  =  8
+cLower  = 16
+cUpper  = 32
+cDigit  = 64
+
+-- | The predicates below look costly, but aren't, GHC+GCC do a great job
+-- at the big case below.
+
+{-# INLINABLE is_ctype #-}
+is_ctype :: Word8 -> Char -> Bool
+is_ctype mask c = (charType c .&. mask) /= 0
+
+is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,
+    is_alphanum :: Char -> Bool
+is_ident  = is_ctype cIdent
+is_symbol = is_ctype cSymbol
+is_any    = is_ctype cAny
+is_space  = is_ctype cSpace
+is_lower  = is_ctype cLower
+is_upper  = is_ctype cUpper
+is_digit  = is_ctype cDigit
+is_alphanum = is_ctype (cLower+cUpper+cDigit)
+
+-- Utils
+
+hexDigit :: Char -> Int
+hexDigit c | is_decdigit c = ord c - ord '0'
+           | otherwise     = ord (to_lower c) - ord 'a' + 10
+
+octDecDigit :: Char -> Int
+octDecDigit c = ord c - ord '0'
+
+is_decdigit :: Char -> Bool
+is_decdigit c
+        =  c >= '0' && c <= '9'
+
+is_hexdigit :: Char -> Bool
+is_hexdigit c
+        =  is_decdigit c
+        || (c >= 'a' && c <= 'f')
+        || (c >= 'A' && c <= 'F')
+
+is_octdigit :: Char -> Bool
+is_octdigit c = c >= '0' && c <= '7'
+
+is_bindigit :: Char -> Bool
+is_bindigit c = c == '0' || c == '1'
+
+to_lower :: Char -> Char
+to_lower c
+  | c >=  'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))
+  | otherwise = c
+
+charType :: Char -> Word8
+charType c = case c of
+   '\0'   -> 0                             -- \000
+   '\1'   -> 0                             -- \001
+   '\2'   -> 0                             -- \002
+   '\3'   -> 0                             -- \003
+   '\4'   -> 0                             -- \004
+   '\5'   -> 0                             -- \005
+   '\6'   -> 0                             -- \006
+   '\7'   -> 0                             -- \007
+   '\8'   -> 0                             -- \010
+   '\9'   -> cSpace                        -- \t  (not allowed in strings, so !cAny)
+   '\10'  -> cSpace                        -- \n  (ditto)
+   '\11'  -> cSpace                        -- \v  (ditto)
+   '\12'  -> cSpace                        -- \f  (ditto)
+   '\13'  -> cSpace                        --  ^M (ditto)
+   '\14'  -> 0                             -- \016
+   '\15'  -> 0                             -- \017
+   '\16'  -> 0                             -- \020
+   '\17'  -> 0                             -- \021
+   '\18'  -> 0                             -- \022
+   '\19'  -> 0                             -- \023
+   '\20'  -> 0                             -- \024
+   '\21'  -> 0                             -- \025
+   '\22'  -> 0                             -- \026
+   '\23'  -> 0                             -- \027
+   '\24'  -> 0                             -- \030
+   '\25'  -> 0                             -- \031
+   '\26'  -> 0                             -- \032
+   '\27'  -> 0                             -- \033
+   '\28'  -> 0                             -- \034
+   '\29'  -> 0                             -- \035
+   '\30'  -> 0                             -- \036
+   '\31'  -> 0                             -- \037
+   '\32'  -> cAny .|. cSpace               --
+   '\33'  -> cAny .|. cSymbol              -- !
+   '\34'  -> cAny                          -- "
+   '\35'  -> cAny .|. cSymbol              --  #
+   '\36'  -> cAny .|. cSymbol              --  $
+   '\37'  -> cAny .|. cSymbol              -- %
+   '\38'  -> cAny .|. cSymbol              -- &
+   '\39'  -> cAny .|. cIdent               -- '
+   '\40'  -> cAny                          -- (
+   '\41'  -> cAny                          -- )
+   '\42'  -> cAny .|. cSymbol              --  *
+   '\43'  -> cAny .|. cSymbol              -- +
+   '\44'  -> cAny                          -- ,
+   '\45'  -> cAny .|. cSymbol              -- -
+   '\46'  -> cAny .|. cSymbol              -- .
+   '\47'  -> cAny .|. cSymbol              --  /
+   '\48'  -> cAny .|. cIdent  .|. cDigit   -- 0
+   '\49'  -> cAny .|. cIdent  .|. cDigit   -- 1
+   '\50'  -> cAny .|. cIdent  .|. cDigit   -- 2
+   '\51'  -> cAny .|. cIdent  .|. cDigit   -- 3
+   '\52'  -> cAny .|. cIdent  .|. cDigit   -- 4
+   '\53'  -> cAny .|. cIdent  .|. cDigit   -- 5
+   '\54'  -> cAny .|. cIdent  .|. cDigit   -- 6
+   '\55'  -> cAny .|. cIdent  .|. cDigit   -- 7
+   '\56'  -> cAny .|. cIdent  .|. cDigit   -- 8
+   '\57'  -> cAny .|. cIdent  .|. cDigit   -- 9
+   '\58'  -> cAny .|. cSymbol              -- :
+   '\59'  -> cAny                          -- ;
+   '\60'  -> cAny .|. cSymbol              -- <
+   '\61'  -> cAny .|. cSymbol              -- =
+   '\62'  -> cAny .|. cSymbol              -- >
+   '\63'  -> cAny .|. cSymbol              -- ?
+   '\64'  -> cAny .|. cSymbol              -- @
+   '\65'  -> cAny .|. cIdent  .|. cUpper   -- A
+   '\66'  -> cAny .|. cIdent  .|. cUpper   -- B
+   '\67'  -> cAny .|. cIdent  .|. cUpper   -- C
+   '\68'  -> cAny .|. cIdent  .|. cUpper   -- D
+   '\69'  -> cAny .|. cIdent  .|. cUpper   -- E
+   '\70'  -> cAny .|. cIdent  .|. cUpper   -- F
+   '\71'  -> cAny .|. cIdent  .|. cUpper   -- G
+   '\72'  -> cAny .|. cIdent  .|. cUpper   -- H
+   '\73'  -> cAny .|. cIdent  .|. cUpper   -- I
+   '\74'  -> cAny .|. cIdent  .|. cUpper   -- J
+   '\75'  -> cAny .|. cIdent  .|. cUpper   -- K
+   '\76'  -> cAny .|. cIdent  .|. cUpper   -- L
+   '\77'  -> cAny .|. cIdent  .|. cUpper   -- M
+   '\78'  -> cAny .|. cIdent  .|. cUpper   -- N
+   '\79'  -> cAny .|. cIdent  .|. cUpper   -- O
+   '\80'  -> cAny .|. cIdent  .|. cUpper   -- P
+   '\81'  -> cAny .|. cIdent  .|. cUpper   -- Q
+   '\82'  -> cAny .|. cIdent  .|. cUpper   -- R
+   '\83'  -> cAny .|. cIdent  .|. cUpper   -- S
+   '\84'  -> cAny .|. cIdent  .|. cUpper   -- T
+   '\85'  -> cAny .|. cIdent  .|. cUpper   -- U
+   '\86'  -> cAny .|. cIdent  .|. cUpper   -- V
+   '\87'  -> cAny .|. cIdent  .|. cUpper   -- W
+   '\88'  -> cAny .|. cIdent  .|. cUpper   -- X
+   '\89'  -> cAny .|. cIdent  .|. cUpper   -- Y
+   '\90'  -> cAny .|. cIdent  .|. cUpper   -- Z
+   '\91'  -> cAny                          -- [
+   '\92'  -> cAny .|. cSymbol              -- backslash
+   '\93'  -> cAny                          -- ]
+   '\94'  -> cAny .|. cSymbol              --  ^
+   '\95'  -> cAny .|. cIdent  .|. cLower   -- _
+   '\96'  -> cAny                          -- `
+   '\97'  -> cAny .|. cIdent  .|. cLower   -- a
+   '\98'  -> cAny .|. cIdent  .|. cLower   -- b
+   '\99'  -> cAny .|. cIdent  .|. cLower   -- c
+   '\100' -> cAny .|. cIdent  .|. cLower   -- d
+   '\101' -> cAny .|. cIdent  .|. cLower   -- e
+   '\102' -> cAny .|. cIdent  .|. cLower   -- f
+   '\103' -> cAny .|. cIdent  .|. cLower   -- g
+   '\104' -> cAny .|. cIdent  .|. cLower   -- h
+   '\105' -> cAny .|. cIdent  .|. cLower   -- i
+   '\106' -> cAny .|. cIdent  .|. cLower   -- j
+   '\107' -> cAny .|. cIdent  .|. cLower   -- k
+   '\108' -> cAny .|. cIdent  .|. cLower   -- l
+   '\109' -> cAny .|. cIdent  .|. cLower   -- m
+   '\110' -> cAny .|. cIdent  .|. cLower   -- n
+   '\111' -> cAny .|. cIdent  .|. cLower   -- o
+   '\112' -> cAny .|. cIdent  .|. cLower   -- p
+   '\113' -> cAny .|. cIdent  .|. cLower   -- q
+   '\114' -> cAny .|. cIdent  .|. cLower   -- r
+   '\115' -> cAny .|. cIdent  .|. cLower   -- s
+   '\116' -> cAny .|. cIdent  .|. cLower   -- t
+   '\117' -> cAny .|. cIdent  .|. cLower   -- u
+   '\118' -> cAny .|. cIdent  .|. cLower   -- v
+   '\119' -> cAny .|. cIdent  .|. cLower   -- w
+   '\120' -> cAny .|. cIdent  .|. cLower   -- x
+   '\121' -> cAny .|. cIdent  .|. cLower   -- y
+   '\122' -> cAny .|. cIdent  .|. cLower   -- z
+   '\123' -> cAny                          -- {
+   '\124' -> cAny .|. cSymbol              --  |
+   '\125' -> cAny                          -- }
+   '\126' -> cAny .|. cSymbol              -- ~
+   '\127' -> 0                             -- \177
+   _ -> panic ("charType: " ++ show c)
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
new file mode 100644
index 0000000000..e2373827f4
--- /dev/null
+++ b/compiler/GHC/Parser/Header.hs
@@ -0,0 +1,361 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-----------------------------------------------------------------------------
+--
+-- | Parsing the top of a Haskell source file to get its module name,
+-- imports and options.
+--
+-- (c) Simon Marlow 2005
+-- (c) Lemmih 2006
+--
+-----------------------------------------------------------------------------
+
+module GHC.Parser.Header
+   ( getImports
+   , mkPrelImports -- used by the renamer too
+   , getOptionsFromFile
+   , getOptions
+   , optionsErrorMsgs
+   , checkProcessArgsResult
+   )
+where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Platform
+import GHC.Driver.Types
+import GHC.Parser           ( parseHeader )
+import GHC.Parser.Lexer
+import FastString
+import GHC.Hs
+import GHC.Types.Module
+import GHC.Builtin.Names
+import StringBuffer
+import GHC.Types.SrcLoc
+import GHC.Driver.Session
+import ErrUtils
+import Util
+import Outputable
+import Maybes
+import Bag              ( emptyBag, listToBag, unitBag )
+import MonadUtils
+import Exception
+import GHC.Types.Basic
+import qualified GHC.LanguageExtensions as LangExt
+
+import Control.Monad
+import System.IO
+import System.IO.Unsafe
+import Data.List
+
+------------------------------------------------------------------------------
+
+-- | Parse the imports of a source file.
+--
+-- Throws a 'SourceError' if parsing fails.
+getImports :: DynFlags
+           -> StringBuffer -- ^ Parse this.
+           -> FilePath     -- ^ Filename the buffer came from.  Used for
+                           --   reporting parse error locations.
+           -> FilePath     -- ^ The original source filename (used for locations
+                           --   in the function result)
+           -> IO (Either
+               ErrorMessages
+               ([(Maybe FastString, Located ModuleName)],
+                [(Maybe FastString, Located ModuleName)],
+                Located ModuleName))
+              -- ^ The source imports and normal imports (with optional package
+              -- names from -XPackageImports), and the module name.
+getImports dflags buf filename source_filename = do
+  let loc  = mkRealSrcLoc (mkFastString filename) 1 1
+  case unP parseHeader (mkPState dflags buf loc) of
+    PFailed pst ->
+        -- assuming we're not logging warnings here as per below
+      return $ Left $ getErrorMessages pst dflags
+    POk pst rdr_module -> fmap Right $ do
+      let _ms@(_warns, errs) = getMessages pst dflags
+      -- don't log warnings: they'll be reported when we parse the file
+      -- for real.  See #2500.
+          ms = (emptyBag, errs)
+      -- logWarnings warns
+      if errorsFound dflags ms
+        then throwIO $ mkSrcErr errs
+        else
+          let   hsmod = unLoc rdr_module
+                mb_mod = hsmodName hsmod
+                imps = hsmodImports hsmod
+                main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)
+                                       1 1)
+                mod = mb_mod `orElse` L main_loc mAIN_NAME
+                (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
+
+               -- GHC.Prim doesn't exist physically, so don't go looking for it.
+                ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc
+                                        . ideclName . unLoc)
+                                       ord_idecls
+
+                implicit_prelude = xopt LangExt.ImplicitPrelude dflags
+                implicit_imports = mkPrelImports (unLoc mod) main_loc
+                                                 implicit_prelude imps
+                convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
+              in
+              return (map convImport src_idecls,
+                      map convImport (implicit_imports ++ ordinary_imps),
+                      mod)
+
+mkPrelImports :: ModuleName
+              -> SrcSpan    -- Attribute the "import Prelude" to this location
+              -> Bool -> [LImportDecl GhcPs]
+              -> [LImportDecl GhcPs]
+-- Construct the implicit declaration "import Prelude" (or not)
+--
+-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
+-- because the former doesn't even look at Prelude.hi for instance
+-- declarations, whereas the latter does.
+mkPrelImports this_mod loc implicit_prelude import_decls
+  | this_mod == pRELUDE_NAME
+   || explicit_prelude_import
+   || not implicit_prelude
+  = []
+  | otherwise = [preludeImportDecl]
+  where
+      explicit_prelude_import
+       = notNull [ () | L _ (ImportDecl { ideclName = mod
+                                        , ideclPkgQual = Nothing })
+                          <- import_decls
+                      , unLoc mod == pRELUDE_NAME ]
+
+      preludeImportDecl :: LImportDecl GhcPs
+      preludeImportDecl
+        = L loc $ ImportDecl { ideclExt       = noExtField,
+                               ideclSourceSrc = NoSourceText,
+                               ideclName      = L loc pRELUDE_NAME,
+                               ideclPkgQual   = Nothing,
+                               ideclSource    = False,
+                               ideclSafe      = False,  -- Not a safe import
+                               ideclQualified = NotQualified,
+                               ideclImplicit  = True,   -- Implicit!
+                               ideclAs        = Nothing,
+                               ideclHiding    = Nothing  }
+
+--------------------------------------------------------------
+-- Get options
+--------------------------------------------------------------
+
+-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
+--
+-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
+getOptionsFromFile :: DynFlags
+                   -> FilePath            -- ^ Input file
+                   -> IO [Located String] -- ^ Parsed options, if any.
+getOptionsFromFile dflags filename
+    = Exception.bracket
+              (openBinaryFile filename ReadMode)
+              (hClose)
+              (\handle -> do
+                  opts <- fmap (getOptions' dflags)
+                               (lazyGetToks dflags' filename handle)
+                  seqList opts $ return opts)
+    where -- We don't need to get haddock doc tokens when we're just
+          -- getting the options from pragmas, and lazily lexing them
+          -- correctly is a little tricky: If there is "\n" or "\n-"
+          -- left at the end of a buffer then the haddock doc may
+          -- continue past the end of the buffer, despite the fact that
+          -- we already have an apparently-complete token.
+          -- We therefore just turn Opt_Haddock off when doing the lazy
+          -- lex.
+          dflags' = gopt_unset dflags Opt_Haddock
+
+blockSize :: Int
+-- blockSize = 17 -- for testing :-)
+blockSize = 1024
+
+lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
+lazyGetToks dflags filename handle = do
+  buf <- hGetStringBufferBlock handle blockSize
+  unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize
+ where
+  loc  = mkRealSrcLoc (mkFastString filename) 1 1
+
+  lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
+  lazyLexBuf handle state eof size = do
+    case unP (lexer False return) state of
+      POk state' t -> do
+        -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
+        if atEnd (buffer state') && not eof
+           -- if this token reached the end of the buffer, and we haven't
+           -- necessarily read up to the end of the file, then the token might
+           -- be truncated, so read some more of the file and lex it again.
+           then getMore handle state size
+           else case unLoc t of
+                  ITeof  -> return [t]
+                  _other -> do rest <- lazyLexBuf handle state' eof size
+                               return (t : rest)
+      _ | not eof   -> getMore handle state size
+        | otherwise -> return [L (mkSrcSpanPs (last_loc state)) ITeof]
+                         -- parser assumes an ITeof sentinel at the end
+
+  getMore :: Handle -> PState -> Int -> IO [Located Token]
+  getMore handle state size = do
+     -- pprTrace "getMore" (text (show (buffer state))) (return ())
+     let new_size = size * 2
+       -- double the buffer size each time we read a new block.  This
+       -- counteracts the quadratic slowdown we otherwise get for very
+       -- large module names (#5981)
+     nextbuf <- hGetStringBufferBlock handle new_size
+     if (len nextbuf == 0) then lazyLexBuf handle state True new_size else do
+       newbuf <- appendStringBuffers (buffer state) nextbuf
+       unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size
+
+
+getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
+getToks dflags filename buf = lexAll (pragState dflags buf loc)
+ where
+  loc  = mkRealSrcLoc (mkFastString filename) 1 1
+
+  lexAll state = case unP (lexer False return) state of
+                   POk _      t@(L _ ITeof) -> [t]
+                   POk state' t -> t : lexAll state'
+                   _ -> [L (mkSrcSpanPs (last_loc state)) ITeof]
+
+
+-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
+--
+-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
+getOptions :: DynFlags
+           -> StringBuffer -- ^ Input Buffer
+           -> FilePath     -- ^ Source filename.  Used for location info.
+           -> [Located String] -- ^ Parsed options.
+getOptions dflags buf filename
+    = getOptions' dflags (getToks dflags filename buf)
+
+-- The token parser is written manually because Happy can't
+-- return a partial result when it encounters a lexer error.
+-- We want to extract options before the buffer is passed through
+-- CPP, so we can't use the same trick as 'getImports'.
+getOptions' :: DynFlags
+            -> [Located Token]      -- Input buffer
+            -> [Located String]     -- Options.
+getOptions' dflags toks
+    = parseToks toks
+    where
+          parseToks (open:close:xs)
+              | IToptions_prag str <- unLoc open
+              , ITclose_prag       <- unLoc close
+              = case toArgs str of
+                  Left _err -> optionsParseError str dflags $   -- #15053
+                                 combineSrcSpans (getLoc open) (getLoc close)
+                  Right args -> map (L (getLoc open)) args ++ parseToks xs
+          parseToks (open:close:xs)
+              | ITinclude_prag str <- unLoc open
+              , ITclose_prag       <- unLoc close
+              = map (L (getLoc open)) ["-#include",removeSpaces str] ++
+                parseToks xs
+          parseToks (open:close:xs)
+              | ITdocOptions str <- unLoc open
+              , ITclose_prag     <- unLoc close
+              = map (L (getLoc open)) ["-haddock-opts", removeSpaces str]
+                ++ parseToks xs
+          parseToks (open:xs)
+              | ITlanguage_prag <- unLoc open
+              = parseLanguage xs
+          parseToks (comment:xs) -- Skip over comments
+              | isComment (unLoc comment)
+              = parseToks xs
+          parseToks _ = []
+          parseLanguage ((L loc (ITconid fs)):rest)
+              = checkExtension dflags (L loc fs) :
+                case rest of
+                  (L _loc ITcomma):more -> parseLanguage more
+                  (L _loc ITclose_prag):more -> parseToks more
+                  (L loc _):_ -> languagePragParseError dflags loc
+                  [] -> panic "getOptions'.parseLanguage(1) went past eof token"
+          parseLanguage (tok:_)
+              = languagePragParseError dflags (getLoc tok)
+          parseLanguage []
+              = panic "getOptions'.parseLanguage(2) went past eof token"
+
+          isComment :: Token -> Bool
+          isComment c =
+            case c of
+              (ITlineComment {})     -> True
+              (ITblockComment {})    -> True
+              (ITdocCommentNext {})  -> True
+              (ITdocCommentPrev {})  -> True
+              (ITdocCommentNamed {}) -> True
+              (ITdocSection {})      -> True
+              _                      -> False
+
+-----------------------------------------------------------------------------
+
+-- | Complain about non-dynamic flags in OPTIONS pragmas.
+--
+-- Throws a 'SourceError' if the input list is non-empty claiming that the
+-- input flags are unknown.
+checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
+checkProcessArgsResult dflags flags
+  = when (notNull flags) $
+      liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
+    where mkMsg (L loc flag)
+              = mkPlainErrMsg dflags loc $
+                  (text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+>
+                   text flag)
+
+-----------------------------------------------------------------------------
+
+checkExtension :: DynFlags -> Located FastString -> Located String
+checkExtension dflags (L l ext)
+-- Checks if a given extension is valid, and if so returns
+-- its corresponding flag. Otherwise it throws an exception.
+  = if ext' `elem` supported
+    then L l ("-X"++ext')
+    else unsupportedExtnError dflags l ext'
+  where
+    ext' = unpackFS ext
+    supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags
+
+languagePragParseError :: DynFlags -> SrcSpan -> a
+languagePragParseError dflags loc =
+    throwErr dflags loc $
+       vcat [ text "Cannot parse LANGUAGE pragma"
+            , text "Expecting comma-separated list of language options,"
+            , text "each starting with a capital letter"
+            , nest 2 (text "E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]
+
+unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a
+unsupportedExtnError dflags loc unsup =
+    throwErr dflags loc $
+        text "Unsupported extension: " <> text unsup $$
+        if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)
+  where
+     supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags
+     suggestions = fuzzyMatch unsup supported
+
+
+optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages
+optionsErrorMsgs dflags unhandled_flags flags_lines _filename
+  = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
+  where unhandled_flags_lines :: [Located String]
+        unhandled_flags_lines = [ L l f
+                                | f <- unhandled_flags
+                                , L l f' <- flags_lines
+                                , f == f' ]
+        mkMsg (L flagSpan flag) =
+            ErrUtils.mkPlainErrMsg dflags flagSpan $
+                    text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+> text flag
+
+optionsParseError :: String -> DynFlags -> SrcSpan -> a     -- #15053
+optionsParseError str dflags loc =
+  throwErr dflags loc $
+      vcat [ text "Error while parsing OPTIONS_GHC pragma."
+           , text "Expecting whitespace-separated list of GHC options."
+           , text "  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
+           , text ("Input was: " ++ show str) ]
+
+throwErr :: DynFlags -> SrcSpan -> SDoc -> a                -- #15053
+throwErr dflags loc doc =
+  throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
new file mode 100644
index 0000000000..17b6674c95
--- /dev/null
+++ b/compiler/GHC/Parser/Lexer.x
@@ -0,0 +1,3294 @@
+-----------------------------------------------------------------------------
+-- (c) The University of Glasgow, 2006
+--
+-- GHC's lexer for Haskell 2010 [1].
+--
+-- This is a combination of an Alex-generated lexer [2] from a regex
+-- definition, with some hand-coded bits. [3]
+--
+-- Completely accurate information about token-spans within the source
+-- file is maintained.  Every token has a start and end RealSrcLoc
+-- attached to it.
+--
+-- References:
+-- [1] https://www.haskell.org/onlinereport/haskell2010/haskellch2.html
+-- [2] http://www.haskell.org/alex/
+-- [3] https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/parser
+--
+-----------------------------------------------------------------------------
+
+--   ToDo / known bugs:
+--    - parsing integers is a bit slow
+--    - readRational is a bit slow
+--
+--   Known bugs, that were also in the previous version:
+--    - M... should be 3 tokens, not 1.
+--    - pragma-end should be only valid in a pragma
+
+--   qualified operator NOTES.
+--
+--   - If M.(+) is a single lexeme, then..
+--     - Probably (+) should be a single lexeme too, for consistency.
+--       Otherwise ( + ) would be a prefix operator, but M.( + ) would not be.
+--     - But we have to rule out reserved operators, otherwise (..) becomes
+--       a different lexeme.
+--     - Should we therefore also rule out reserved operators in the qualified
+--       form?  This is quite difficult to achieve.  We don't do it for
+--       qualified varids.
+
+
+-- -----------------------------------------------------------------------------
+-- Alex "Haskell code fragment top"
+
+{
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module GHC.Parser.Lexer (
+   Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..),
+   P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..),
+   appendWarning,
+   appendError,
+   allocateComments,
+   MonadP(..),
+   getRealSrcLoc, getPState, withThisPackage,
+   failMsgP, failLocMsgP, srcParseFail,
+   getErrorMessages, getMessages,
+   popContext, pushModuleContext, setLastToken, setSrcLoc,
+   activeContext, nextIsEOF,
+   getLexState, popLexState, pushLexState,
+   ExtBits(..),
+   xtest,
+   lexTokenStream,
+   AddAnn(..),mkParensApiAnn,
+   addAnnsAt,
+   commentToAnnotation
+  ) where
+
+import GhcPrelude
+
+-- base
+import Control.Monad
+import Data.Bits
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Word
+
+import EnumSet (EnumSet)
+import qualified EnumSet
+
+-- ghc-boot
+import qualified GHC.LanguageExtensions as LangExt
+
+-- bytestring
+import Data.ByteString (ByteString)
+
+-- containers
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+-- compiler/utils
+import Bag
+import Outputable
+import StringBuffer
+import FastString
+import GHC.Types.Unique.FM
+import Util             ( readRational, readHexRational )
+
+-- compiler/main
+import ErrUtils
+import GHC.Driver.Session as DynFlags
+
+-- compiler/basicTypes
+import GHC.Types.SrcLoc
+import GHC.Types.Module
+import GHC.Types.Basic ( InlineSpec(..), RuleMatchInfo(..),
+                         IntegralLit(..), FractionalLit(..),
+                         SourceText(..) )
+
+-- compiler/parser
+import GHC.Parser.CharClass
+
+import GHC.Parser.Annotation
+}
+
+-- -----------------------------------------------------------------------------
+-- Alex "Character set macros"
+
+-- NB: The logic behind these definitions is also reflected in basicTypes/Lexeme.hs
+-- Any changes here should likely be reflected there.
+$unispace    = \x05 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$nl          = [\n\r\f]
+$whitechar   = [$nl\v\ $unispace]
+$white_no_nl = $whitechar # \n -- TODO #8424
+$tab         = \t
+
+$ascdigit  = 0-9
+$unidigit  = \x03 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$decdigit  = $ascdigit -- for now, should really be $digit (ToDo)
+$digit     = [$ascdigit $unidigit]
+
+$special   = [\(\)\,\;\[\]\`\{\}]
+$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]
+$unisymbol = \x04 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$symbol    = [$ascsymbol $unisymbol] # [$special \_\"\']
+
+$unilarge  = \x01 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$asclarge  = [A-Z]
+$large     = [$asclarge $unilarge]
+
+$unismall  = \x02 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$ascsmall  = [a-z]
+$small     = [$ascsmall $unismall \_]
+
+$unigraphic = \x06 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$graphic   = [$small $large $symbol $digit $special $unigraphic \"\']
+
+$binit     = 0-1
+$octit     = 0-7
+$hexit     = [$decdigit A-F a-f]
+
+$uniidchar = \x07 -- Trick Alex into handling Unicode. See [Unicode in Alex].
+$idchar    = [$small $large $digit $uniidchar \']
+
+$pragmachar = [$small $large $digit]
+
+$docsym    = [\| \^ \* \$]
+
+
+-- -----------------------------------------------------------------------------
+-- Alex "Regular expression macros"
+
+@varid     = $small $idchar*          -- variable identifiers
+@conid     = $large $idchar*          -- constructor identifiers
+
+@varsym    = ($symbol # \:) $symbol*  -- variable (operator) symbol
+@consym    = \: $symbol*              -- constructor (operator) symbol
+
+-- See Note [Lexing NumericUnderscores extension] and #14473
+@numspc       = _*                   -- numeric spacer (#14473)
+@decimal      = $decdigit(@numspc $decdigit)*
+@binary       = $binit(@numspc $binit)*
+@octal        = $octit(@numspc $octit)*
+@hexadecimal  = $hexit(@numspc $hexit)*
+@exponent     = @numspc [eE] [\-\+]? @decimal
+@bin_exponent = @numspc [pP] [\-\+]? @decimal
+
+@qual = (@conid \.)+
+@qvarid = @qual @varid
+@qconid = @qual @conid
+@qvarsym = @qual @varsym
+@qconsym = @qual @consym
+
+@floating_point = @numspc @decimal \. @decimal @exponent? | @numspc @decimal @exponent
+@hex_floating_point = @numspc @hexadecimal \. @hexadecimal @bin_exponent? | @numspc @hexadecimal @bin_exponent
+
+-- normal signed numerical literals can only be explicitly negative,
+-- not explicitly positive (contrast @exponent)
+@negative = \-
+@signed = @negative ?
+
+
+-- -----------------------------------------------------------------------------
+-- Alex "Identifier"
+
+haskell :-
+
+
+-- -----------------------------------------------------------------------------
+-- Alex "Rules"
+
+-- everywhere: skip whitespace
+$white_no_nl+ ;
+$tab          { warnTab }
+
+-- Everywhere: deal with nested comments.  We explicitly rule out
+-- pragmas, "{-#", so that we don't accidentally treat them as comments.
+-- (this can happen even though pragmas will normally take precedence due to
+-- longest-match, because pragmas aren't valid in every state, but comments
+-- are). We also rule out nested Haddock comments, if the -haddock flag is
+-- set.
+
+"{-" / { isNormalComment } { nested_comment lexToken }
+
+-- Single-line comments are a bit tricky.  Haskell 98 says that two or
+-- more dashes followed by a symbol should be parsed as a varsym, so we
+-- have to exclude those.
+
+-- Since Haddock comments aren't valid in every state, we need to rule them
+-- out here.
+
+-- The following two rules match comments that begin with two dashes, but
+-- continue with a different character. The rules test that this character
+-- is not a symbol (in which case we'd have a varsym), and that it's not a
+-- space followed by a Haddock comment symbol (docsym) (in which case we'd
+-- have a Haddock comment). The rules then munch the rest of the line.
+
+"-- " ~$docsym .* { lineCommentToken }
+"--" [^$symbol \ ] .* { lineCommentToken }
+
+-- Next, match Haddock comments if no -haddock flag
+
+"-- " $docsym .* / { alexNotPred (ifExtension HaddockBit) } { lineCommentToken }
+
+-- Now, when we've matched comments that begin with 2 dashes and continue
+-- with a different character, we need to match comments that begin with three
+-- or more dashes (which clearly can't be Haddock comments). We only need to
+-- make sure that the first non-dash character isn't a symbol, and munch the
+-- rest of the line.
+
+"---"\-* ~$symbol .* { lineCommentToken }
+
+-- Since the previous rules all match dashes followed by at least one
+-- character, we also need to match a whole line filled with just dashes.
+
+"--"\-* / { atEOL } { lineCommentToken }
+
+-- We need this rule since none of the other single line comment rules
+-- actually match this case.
+
+"-- " / { atEOL } { lineCommentToken }
+
+-- 'bol' state: beginning of a line.  Slurp up all the whitespace (including
+-- blank lines) until we find a non-whitespace character, then do layout
+-- processing.
+--
+-- One slight wibble here: what if the line begins with {-#? In
+-- theory, we have to lex the pragma to see if it's one we recognise,
+-- and if it is, then we backtrack and do_bol, otherwise we treat it
+-- as a nested comment.  We don't bother with this: if the line begins
+-- with {-#, then we'll assume it's a pragma we know about and go for do_bol.
+<bol> {
+  \n                                    ;
+  ^\# line                              { begin line_prag1 }
+  ^\# / { followedByDigit }             { begin line_prag1 }
+  ^\# pragma .* \n                      ; -- GCC 3.3 CPP generated, apparently
+  ^\# \! .* \n                          ; -- #!, for scripts
+  ()                                    { do_bol }
+}
+
+-- after a layout keyword (let, where, do, of), we begin a new layout
+-- context if the curly brace is missing.
+-- Careful! This stuff is quite delicate.
+<layout, layout_do, layout_if> {
+  \{ / { notFollowedBy '-' }            { hopefully_open_brace }
+        -- we might encounter {-# here, but {- has been handled already
+  \n                                    ;
+  ^\# (line)?                           { begin line_prag1 }
+}
+
+-- after an 'if', a vertical bar starts a layout context for MultiWayIf
+<layout_if> {
+  \| / { notFollowedBySymbol }          { new_layout_context True dontGenerateSemic ITvbar }
+  ()                                    { pop }
+}
+
+-- do is treated in a subtly different way, see new_layout_context
+<layout>    ()                          { new_layout_context True  generateSemic ITvocurly }
+<layout_do> ()                          { new_layout_context False generateSemic ITvocurly }
+
+-- after a new layout context which was found to be to the left of the
+-- previous context, we have generated a '{' token, and we now need to
+-- generate a matching '}' token.
+<layout_left>  ()                       { do_layout_left }
+
+<0,option_prags> \n                     { begin bol }
+
+"{-#" $whitechar* $pragmachar+ / { known_pragma linePrags }
+                                { dispatch_pragmas linePrags }
+
+-- single-line line pragmas, of the form
+--    # <line> "<file>" <extra-stuff> \n
+<line_prag1> {
+  @decimal $white_no_nl+ \" [$graphic \ ]* \"  { setLineAndFile line_prag1a }
+  ()                                           { failLinePrag1 }
+}
+<line_prag1a> .*                               { popLinePrag1 }
+
+-- Haskell-style line pragmas, of the form
+--    {-# LINE <line> "<file>" #-}
+<line_prag2> {
+  @decimal $white_no_nl+ \" [$graphic \ ]* \"  { setLineAndFile line_prag2a }
+}
+<line_prag2a> "#-}"|"-}"                       { pop }
+   -- NOTE: accept -} at the end of a LINE pragma, for compatibility
+   -- with older versions of GHC which generated these.
+
+-- Haskell-style column pragmas, of the form
+--    {-# COLUMN <column> #-}
+<column_prag> @decimal $whitechar* "#-}" { setColumn }
+
+<0,option_prags> {
+  "{-#" $whitechar* $pragmachar+
+        $whitechar+ $pragmachar+ / { known_pragma twoWordPrags }
+                                 { dispatch_pragmas twoWordPrags }
+
+  "{-#" $whitechar* $pragmachar+ / { known_pragma oneWordPrags }
+                                 { dispatch_pragmas oneWordPrags }
+
+  -- We ignore all these pragmas, but don't generate a warning for them
+  "{-#" $whitechar* $pragmachar+ / { known_pragma ignoredPrags }
+                                 { dispatch_pragmas ignoredPrags }
+
+  -- ToDo: should only be valid inside a pragma:
+  "#-}"                          { endPrag }
+}
+
+<option_prags> {
+  "{-#"  $whitechar* $pragmachar+ / { known_pragma fileHeaderPrags }
+                                   { dispatch_pragmas fileHeaderPrags }
+}
+
+<0> {
+  -- In the "0" mode we ignore these pragmas
+  "{-#"  $whitechar* $pragmachar+ / { known_pragma fileHeaderPrags }
+                     { nested_comment lexToken }
+}
+
+<0,option_prags> {
+  "{-#"  { warnThen Opt_WarnUnrecognisedPragmas (text "Unrecognised pragma")
+                    (nested_comment lexToken) }
+}
+
+-- '0' state: ordinary lexemes
+
+-- Haddock comments
+
+<0,option_prags> {
+  "-- " $docsym      / { ifExtension HaddockBit } { multiline_doc_comment }
+  "{-" \ ? $docsym   / { ifExtension HaddockBit } { nested_doc_comment }
+}
+
+-- "special" symbols
+
+<0> {
+  "[|"        / { ifExtension ThQuotesBit } { token (ITopenExpQuote NoE NormalSyntax) }
+  "[||"       / { ifExtension ThQuotesBit } { token (ITopenTExpQuote NoE) }
+  "[e|"       / { ifExtension ThQuotesBit } { token (ITopenExpQuote HasE NormalSyntax) }
+  "[e||"      / { ifExtension ThQuotesBit } { token (ITopenTExpQuote HasE) }
+  "[p|"       / { ifExtension ThQuotesBit } { token ITopenPatQuote }
+  "[d|"       / { ifExtension ThQuotesBit } { layout_token ITopenDecQuote }
+  "[t|"       / { ifExtension ThQuotesBit } { token ITopenTypQuote }
+  "|]"        / { ifExtension ThQuotesBit } { token (ITcloseQuote NormalSyntax) }
+  "||]"       / { ifExtension ThQuotesBit } { token ITcloseTExpQuote }
+
+  "[" @varid "|"  / { ifExtension QqBit }   { lex_quasiquote_tok }
+
+  -- qualified quasi-quote (#5555)
+  "[" @qvarid "|"  / { ifExtension QqBit }  { lex_qquasiquote_tok }
+
+  $unigraphic -- ⟦
+    / { ifCurrentChar '⟦' `alexAndPred`
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ThQuotesBit }
+    { token (ITopenExpQuote NoE UnicodeSyntax) }
+  $unigraphic -- ⟧
+    / { ifCurrentChar '⟧' `alexAndPred`
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ThQuotesBit }
+    { token (ITcloseQuote UnicodeSyntax) }
+}
+
+<0> {
+  "(|"
+    / { ifExtension ArrowsBit `alexAndPred`
+        notFollowedBySymbol }
+    { special (IToparenbar NormalSyntax) }
+  "|)"
+    / { ifExtension ArrowsBit }
+    { special (ITcparenbar NormalSyntax) }
+
+  $unigraphic -- ⦇
+    / { ifCurrentChar '⦇' `alexAndPred`
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ArrowsBit }
+    { special (IToparenbar UnicodeSyntax) }
+  $unigraphic -- ⦈
+    / { ifCurrentChar '⦈' `alexAndPred`
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ArrowsBit }
+    { special (ITcparenbar UnicodeSyntax) }
+}
+
+<0> {
+  \? @varid / { ifExtension IpBit } { skip_one_varid ITdupipvarid }
+}
+
+<0> {
+  "#" @varid / { ifExtension OverloadedLabelsBit } { skip_one_varid ITlabelvarid }
+}
+
+<0> {
+  "(#" / { ifExtension UnboxedTuplesBit `alexOrPred`
+           ifExtension UnboxedSumsBit }
+         { token IToubxparen }
+  "#)" / { ifExtension UnboxedTuplesBit `alexOrPred`
+           ifExtension UnboxedSumsBit }
+         { token ITcubxparen }
+}
+
+<0,option_prags> {
+  \(                                    { special IToparen }
+  \)                                    { special ITcparen }
+  \[                                    { special ITobrack }
+  \]                                    { special ITcbrack }
+  \,                                    { special ITcomma }
+  \;                                    { special ITsemi }
+  \`                                    { special ITbackquote }
+
+  \{                                    { open_brace }
+  \}                                    { close_brace }
+}
+
+<0,option_prags> {
+  @qvarid                       { idtoken qvarid }
+  @qconid                       { idtoken qconid }
+  @varid                        { varid }
+  @conid                        { idtoken conid }
+}
+
+<0> {
+  @qvarid "#"+      / { ifExtension MagicHashBit } { idtoken qvarid }
+  @qconid "#"+      / { ifExtension MagicHashBit } { idtoken qconid }
+  @varid "#"+       / { ifExtension MagicHashBit } { varid }
+  @conid "#"+       / { ifExtension MagicHashBit } { idtoken conid }
+}
+
+-- Operators classified into prefix, suffix, tight infix, and loose infix.
+-- See Note [Whitespace-sensitive operator parsing]
+<0> {
+  @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix }
+  @varsym / { followedByOpeningToken }  { varsym_prefix }
+  @varsym / { precededByClosingToken }  { varsym_suffix }
+  @varsym                               { varsym_loose_infix }
+}
+
+-- ToDo: - move `var` and (sym) into lexical syntax?
+--       - remove backquote from $special?
+<0> {
+  @qvarsym                                         { idtoken qvarsym }
+  @qconsym                                         { idtoken qconsym }
+  @consym                                          { consym }
+}
+
+-- For the normal boxed literals we need to be careful
+-- when trying to be close to Haskell98
+
+-- Note [Lexing NumericUnderscores extension] (#14473)
+--
+-- NumericUnderscores extension allows underscores in numeric literals.
+-- Multiple underscores are represented with @numspc macro.
+-- To be simpler, we have only the definitions with underscores.
+-- And then we have a separate function (tok_integral and tok_frac)
+-- that validates the literals.
+-- If extensions are not enabled, check that there are no underscores.
+--
+<0> {
+  -- Normal integral literals (:: Num a => a, from Integer)
+  @decimal                                                                   { tok_num positive 0 0 decimal }
+  0[bB] @numspc @binary                / { ifExtension BinaryLiteralsBit }   { tok_num positive 2 2 binary }
+  0[oO] @numspc @octal                                                       { tok_num positive 2 2 octal }
+  0[xX] @numspc @hexadecimal                                                 { tok_num positive 2 2 hexadecimal }
+  @negative @decimal                   / { ifExtension NegativeLiteralsBit } { tok_num negative 1 1 decimal }
+  @negative 0[bB] @numspc @binary      / { ifExtension NegativeLiteralsBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_num negative 3 3 binary }
+  @negative 0[oO] @numspc @octal       / { ifExtension NegativeLiteralsBit } { tok_num negative 3 3 octal }
+  @negative 0[xX] @numspc @hexadecimal / { ifExtension NegativeLiteralsBit } { tok_num negative 3 3 hexadecimal }
+
+  -- Normal rational literals (:: Fractional a => a, from Rational)
+  @floating_point                                                            { tok_frac 0 tok_float }
+  @negative @floating_point            / { ifExtension NegativeLiteralsBit } { tok_frac 0 tok_float }
+  0[xX] @numspc @hex_floating_point    / { ifExtension HexFloatLiteralsBit } { tok_frac 0 tok_hex_float }
+  @negative 0[xX] @numspc @hex_floating_point
+                                       / { ifExtension HexFloatLiteralsBit `alexAndPred`
+                                           ifExtension NegativeLiteralsBit } { tok_frac 0 tok_hex_float }
+}
+
+<0> {
+  -- Unboxed ints (:: Int#) and words (:: Word#)
+  -- It's simpler (and faster?) to give separate cases to the negatives,
+  -- especially considering octal/hexadecimal prefixes.
+  @decimal                          \# / { ifExtension MagicHashBit }        { tok_primint positive 0 1 decimal }
+  0[bB] @numspc @binary             \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primint positive 2 3 binary }
+  0[oO] @numspc @octal              \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 octal }
+  0[xX] @numspc @hexadecimal        \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 hexadecimal }
+  @negative @decimal                \# / { ifExtension MagicHashBit }        { tok_primint negative 1 2 decimal }
+  @negative 0[bB] @numspc @binary   \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primint negative 3 4 binary }
+  @negative 0[oO] @numspc @octal    \# / { ifExtension MagicHashBit }        { tok_primint negative 3 4 octal }
+  @negative 0[xX] @numspc @hexadecimal \#
+                                       / { ifExtension MagicHashBit }        { tok_primint negative 3 4 hexadecimal }
+
+  @decimal                       \# \# / { ifExtension MagicHashBit }        { tok_primword 0 2 decimal }
+  0[bB] @numspc @binary          \# \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primword 2 4 binary }
+  0[oO] @numspc @octal           \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 octal }
+  0[xX] @numspc @hexadecimal     \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 hexadecimal }
+
+  -- Unboxed floats and doubles (:: Float#, :: Double#)
+  -- prim_{float,double} work with signed literals
+  @signed @floating_point           \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }
+  @signed @floating_point        \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }
+}
+
+-- Strings and chars are lexed by hand-written code.  The reason is
+-- that even if we recognise the string or char here in the regex
+-- lexer, we would still have to parse the string afterward in order
+-- to convert it to a String.
+<0> {
+  \'                            { lex_char_tok }
+  \"                            { lex_string_tok }
+}
+
+-- Note [Whitespace-sensitive operator parsing]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In accord with GHC Proposal #229 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst
+-- we classify operator occurrences into four categories:
+--
+--     a ! b   -- a loose infix occurrence
+--     a!b     -- a tight infix occurrence
+--     a !b    -- a prefix occurrence
+--     a! b    -- a suffix occurrence
+--
+-- The rules are a bit more elaborate than simply checking for whitespace, in
+-- order to accommodate the following use cases:
+--
+--     f (!a) = ...    -- prefix occurrence
+--     g (a !)         -- loose infix occurrence
+--     g (! a)         -- loose infix occurrence
+--
+-- The precise rules are as follows:
+--
+--  * Identifiers, literals, and opening brackets (, (#, [, [|, [||, [p|, [e|,
+--    [t|, {, are considered "opening tokens". The function followedByOpeningToken
+--    tests whether the next token is an opening token.
+--
+--  * Identifiers, literals, and closing brackets ), #), ], |], },
+--    are considered "closing tokens". The function precededByClosingToken tests
+--    whether the previous token is a closing token.
+--
+--  * Whitespace, comments, separators, and other tokens, are considered
+--    neither opening nor closing.
+--
+--  * Any unqualified operator occurrence is classified as prefix, suffix, or
+--    tight/loose infix, based on preceding and following tokens:
+--
+--       precededByClosingToken | followedByOpeningToken | Occurrence
+--      ------------------------+------------------------+------------
+--       False                  | True                   | prefix
+--       True                   | False                  | suffix
+--       True                   | True                   | tight infix
+--       False                  | False                  | loose infix
+--      ------------------------+------------------------+------------
+--
+-- A loose infix occurrence is always considered an operator. Other types of
+-- occurrences may be assigned a special per-operator meaning override:
+--
+--   Operator |  Occurrence   | Token returned
+--  ----------+---------------+------------------------------------------
+--    !       |  prefix       | ITbang
+--            |               |   strictness annotation or bang pattern,
+--            |               |   e.g.  f !x = rhs, data T = MkT !a
+--            |  not prefix   | ITvarsym "!"
+--            |               |   ordinary operator or type operator,
+--            |               |   e.g.  xs ! 3, (! x), Int ! Bool
+--  ----------+---------------+------------------------------------------
+--    ~       |  prefix       | ITtilde
+--            |               |   laziness annotation or lazy pattern,
+--            |               |   e.g.  f ~x = rhs, data T = MkT ~a
+--            |  not prefix   | ITvarsym "~"
+--            |               |   ordinary operator or type operator,
+--            |               |   e.g.  xs ~ 3, (~ x), Int ~ Bool
+--  ----------+---------------+------------------------------------------
+--    $  $$   |  prefix       | ITdollar, ITdollardollar
+--            |               |   untyped or typed Template Haskell splice,
+--            |               |   e.g.  $(f x), $$(f x), $$"str"
+--            |  not prefix   | ITvarsym "$", ITvarsym "$$"
+--            |               |   ordinary operator or type operator,
+--            |               |   e.g.  f $ g x, a $$ b
+--  ----------+---------------+------------------------------------------
+--    @       |  prefix       | ITtypeApp
+--            |               |   type application, e.g.  fmap @Maybe
+--            |  tight infix  | ITat
+--            |               |   as-pattern, e.g.  f p@(a,b) = rhs
+--            |  suffix       | parse error
+--            |               |   e.g. f p@ x = rhs
+--            |  loose infix  | ITvarsym "@"
+--            |               |   ordinary operator or type operator,
+--            |               |   e.g.  f @ g, (f @)
+--  ----------+---------------+------------------------------------------
+--
+-- Also, some of these overrides are guarded behind language extensions.
+-- According to the specification, we must determine the occurrence based on
+-- surrounding *tokens* (see the proposal for the exact rules). However, in
+-- the implementation we cheat a little and do the classification based on
+-- characters, for reasons of both simplicity and efficiency (see
+-- 'followedByOpeningToken' and 'precededByClosingToken')
+--
+-- When an operator is subject to a meaning override, it is mapped to special
+-- token: ITbang, ITtilde, ITat, ITdollar, ITdollardollar. Otherwise, it is
+-- returned as ITvarsym.
+--
+-- For example, this is how we process the (!):
+--
+--    precededByClosingToken | followedByOpeningToken | Token
+--   ------------------------+------------------------+-------------
+--    False                  | True                   | ITbang
+--    True                   | False                  | ITvarsym "!"
+--    True                   | True                   | ITvarsym "!"
+--    False                  | False                  | ITvarsym "!"
+--   ------------------------+------------------------+-------------
+--
+-- And this is how we process the (@):
+--
+--    precededByClosingToken | followedByOpeningToken | Token
+--   ------------------------+------------------------+-------------
+--    False                  | True                   | ITtypeApp
+--    True                   | False                  | parse error
+--    True                   | True                   | ITat
+--    False                  | False                  | ITvarsym "@"
+--   ------------------------+------------------------+-------------
+
+-- -----------------------------------------------------------------------------
+-- Alex "Haskell code fragment bottom"
+
+{
+
+-- -----------------------------------------------------------------------------
+-- The token type
+
+data Token
+  = ITas                        -- Haskell keywords
+  | ITcase
+  | ITclass
+  | ITdata
+  | ITdefault
+  | ITderiving
+  | ITdo
+  | ITelse
+  | IThiding
+  | ITforeign
+  | ITif
+  | ITimport
+  | ITin
+  | ITinfix
+  | ITinfixl
+  | ITinfixr
+  | ITinstance
+  | ITlet
+  | ITmodule
+  | ITnewtype
+  | ITof
+  | ITqualified
+  | ITthen
+  | ITtype
+  | ITwhere
+
+  | ITforall            IsUnicodeSyntax -- GHC extension keywords
+  | ITexport
+  | ITlabel
+  | ITdynamic
+  | ITsafe
+  | ITinterruptible
+  | ITunsafe
+  | ITstdcallconv
+  | ITccallconv
+  | ITcapiconv
+  | ITprimcallconv
+  | ITjavascriptcallconv
+  | ITmdo
+  | ITfamily
+  | ITrole
+  | ITgroup
+  | ITby
+  | ITusing
+  | ITpattern
+  | ITstatic
+  | ITstock
+  | ITanyclass
+  | ITvia
+
+  -- Backpack tokens
+  | ITunit
+  | ITsignature
+  | ITdependency
+  | ITrequires
+
+  -- Pragmas, see  note [Pragma source text] in BasicTypes
+  | ITinline_prag       SourceText InlineSpec RuleMatchInfo
+  | ITspec_prag         SourceText                -- SPECIALISE
+  | ITspec_inline_prag  SourceText Bool    -- SPECIALISE INLINE (or NOINLINE)
+  | ITsource_prag       SourceText
+  | ITrules_prag        SourceText
+  | ITwarning_prag      SourceText
+  | ITdeprecated_prag   SourceText
+  | ITline_prag         SourceText  -- not usually produced, see 'UsePosPragsBit'
+  | ITcolumn_prag       SourceText  -- not usually produced, see 'UsePosPragsBit'
+  | ITscc_prag          SourceText
+  | ITgenerated_prag    SourceText
+  | ITcore_prag         SourceText         -- hdaume: core annotations
+  | ITunpack_prag       SourceText
+  | ITnounpack_prag     SourceText
+  | ITann_prag          SourceText
+  | ITcomplete_prag     SourceText
+  | ITclose_prag
+  | IToptions_prag String
+  | ITinclude_prag String
+  | ITlanguage_prag
+  | ITminimal_prag      SourceText
+  | IToverlappable_prag SourceText  -- instance overlap mode
+  | IToverlapping_prag  SourceText  -- instance overlap mode
+  | IToverlaps_prag     SourceText  -- instance overlap mode
+  | ITincoherent_prag   SourceText  -- instance overlap mode
+  | ITctype             SourceText
+  | ITcomment_line_prag         -- See Note [Nested comment line pragmas]
+
+  | ITdotdot                    -- reserved symbols
+  | ITcolon
+  | ITdcolon            IsUnicodeSyntax
+  | ITequal
+  | ITlam
+  | ITlcase
+  | ITvbar
+  | ITlarrow            IsUnicodeSyntax
+  | ITrarrow            IsUnicodeSyntax
+  | ITdarrow            IsUnicodeSyntax
+  | ITminus
+  | ITbang     -- Prefix (!) only, e.g. f !x = rhs
+  | ITtilde    -- Prefix (~) only, e.g. f ~x = rhs
+  | ITat       -- Tight infix (@) only, e.g. f x@pat = rhs
+  | ITtypeApp  -- Prefix (@) only, e.g. f @t
+  | ITstar              IsUnicodeSyntax
+  | ITdot
+
+  | ITbiglam                    -- GHC-extension symbols
+
+  | ITocurly                    -- special symbols
+  | ITccurly
+  | ITvocurly
+  | ITvccurly
+  | ITobrack
+  | ITopabrack                  -- [:, for parallel arrays with -XParallelArrays
+  | ITcpabrack                  -- :], for parallel arrays with -XParallelArrays
+  | ITcbrack
+  | IToparen
+  | ITcparen
+  | IToubxparen
+  | ITcubxparen
+  | ITsemi
+  | ITcomma
+  | ITunderscore
+  | ITbackquote
+  | ITsimpleQuote               --  '
+
+  | ITvarid   FastString        -- identifiers
+  | ITconid   FastString
+  | ITvarsym  FastString
+  | ITconsym  FastString
+  | ITqvarid  (FastString,FastString)
+  | ITqconid  (FastString,FastString)
+  | ITqvarsym (FastString,FastString)
+  | ITqconsym (FastString,FastString)
+
+  | ITdupipvarid   FastString   -- GHC extension: implicit param: ?x
+  | ITlabelvarid   FastString   -- Overloaded label: #x
+
+  | ITchar     SourceText Char       -- Note [Literal source text] in BasicTypes
+  | ITstring   SourceText FastString -- Note [Literal source text] in BasicTypes
+  | ITinteger  IntegralLit           -- Note [Literal source text] in BasicTypes
+  | ITrational FractionalLit
+
+  | ITprimchar   SourceText Char     -- Note [Literal source text] in BasicTypes
+  | ITprimstring SourceText ByteString -- Note [Literal source text] @BasicTypes
+  | ITprimint    SourceText Integer  -- Note [Literal source text] in BasicTypes
+  | ITprimword   SourceText Integer  -- Note [Literal source text] in BasicTypes
+  | ITprimfloat  FractionalLit
+  | ITprimdouble FractionalLit
+
+  -- Template Haskell extension tokens
+  | ITopenExpQuote HasE IsUnicodeSyntax --  [| or [e|
+  | ITopenPatQuote                      --  [p|
+  | ITopenDecQuote                      --  [d|
+  | ITopenTypQuote                      --  [t|
+  | ITcloseQuote IsUnicodeSyntax        --  |]
+  | ITopenTExpQuote HasE                --  [|| or [e||
+  | ITcloseTExpQuote                    --  ||]
+  | ITdollar                            --  prefix $
+  | ITdollardollar                      --  prefix $$
+  | ITtyQuote                           --  ''
+  | ITquasiQuote (FastString,FastString,PsSpan)
+    -- ITquasiQuote(quoter, quote, loc)
+    -- represents a quasi-quote of the form
+    -- [quoter| quote |]
+  | ITqQuasiQuote (FastString,FastString,FastString,PsSpan)
+    -- ITqQuasiQuote(Qual, quoter, quote, loc)
+    -- represents a qualified quasi-quote of the form
+    -- [Qual.quoter| quote |]
+
+  -- Arrow notation extension
+  | ITproc
+  | ITrec
+  | IToparenbar  IsUnicodeSyntax -- ^ @(|@
+  | ITcparenbar  IsUnicodeSyntax -- ^ @|)@
+  | ITlarrowtail IsUnicodeSyntax -- ^ @-<@
+  | ITrarrowtail IsUnicodeSyntax -- ^ @>-@
+  | ITLarrowtail IsUnicodeSyntax -- ^ @-<<@
+  | ITRarrowtail IsUnicodeSyntax -- ^ @>>-@
+
+  | ITunknown String             -- ^ Used when the lexer can't make sense of it
+  | ITeof                        -- ^ end of file token
+
+  -- Documentation annotations
+  | ITdocCommentNext  String     -- ^ something beginning @-- |@
+  | ITdocCommentPrev  String     -- ^ something beginning @-- ^@
+  | ITdocCommentNamed String     -- ^ something beginning @-- $@
+  | ITdocSection      Int String -- ^ a section heading
+  | ITdocOptions      String     -- ^ doc options (prune, ignore-exports, etc)
+  | ITlineComment     String     -- ^ comment starting by "--"
+  | ITblockComment    String     -- ^ comment in {- -}
+
+  deriving Show
+
+instance Outputable Token where
+  ppr x = text (show x)
+
+
+-- the bitmap provided as the third component indicates whether the
+-- corresponding extension keyword is valid under the extension options
+-- provided to the compiler; if the extension corresponding to *any* of the
+-- bits set in the bitmap is enabled, the keyword is valid (this setup
+-- facilitates using a keyword in two different extensions that can be
+-- activated independently)
+--
+reservedWordsFM :: UniqFM (Token, ExtsBitmap)
+reservedWordsFM = listToUFM $
+    map (\(x, y, z) -> (mkFastString x, (y, z)))
+        [( "_",              ITunderscore,    0 ),
+         ( "as",             ITas,            0 ),
+         ( "case",           ITcase,          0 ),
+         ( "class",          ITclass,         0 ),
+         ( "data",           ITdata,          0 ),
+         ( "default",        ITdefault,       0 ),
+         ( "deriving",       ITderiving,      0 ),
+         ( "do",             ITdo,            0 ),
+         ( "else",           ITelse,          0 ),
+         ( "hiding",         IThiding,        0 ),
+         ( "if",             ITif,            0 ),
+         ( "import",         ITimport,        0 ),
+         ( "in",             ITin,            0 ),
+         ( "infix",          ITinfix,         0 ),
+         ( "infixl",         ITinfixl,        0 ),
+         ( "infixr",         ITinfixr,        0 ),
+         ( "instance",       ITinstance,      0 ),
+         ( "let",            ITlet,           0 ),
+         ( "module",         ITmodule,        0 ),
+         ( "newtype",        ITnewtype,       0 ),
+         ( "of",             ITof,            0 ),
+         ( "qualified",      ITqualified,     0 ),
+         ( "then",           ITthen,          0 ),
+         ( "type",           ITtype,          0 ),
+         ( "where",          ITwhere,         0 ),
+
+         ( "forall",         ITforall NormalSyntax, 0),
+         ( "mdo",            ITmdo,           xbit RecursiveDoBit),
+             -- See Note [Lexing type pseudo-keywords]
+         ( "family",         ITfamily,        0 ),
+         ( "role",           ITrole,          0 ),
+         ( "pattern",        ITpattern,       xbit PatternSynonymsBit),
+         ( "static",         ITstatic,        xbit StaticPointersBit ),
+         ( "stock",          ITstock,         0 ),
+         ( "anyclass",       ITanyclass,      0 ),
+         ( "via",            ITvia,           0 ),
+         ( "group",          ITgroup,         xbit TransformComprehensionsBit),
+         ( "by",             ITby,            xbit TransformComprehensionsBit),
+         ( "using",          ITusing,         xbit TransformComprehensionsBit),
+
+         ( "foreign",        ITforeign,       xbit FfiBit),
+         ( "export",         ITexport,        xbit FfiBit),
+         ( "label",          ITlabel,         xbit FfiBit),
+         ( "dynamic",        ITdynamic,       xbit FfiBit),
+         ( "safe",           ITsafe,          xbit FfiBit .|.
+                                              xbit SafeHaskellBit),
+         ( "interruptible",  ITinterruptible, xbit InterruptibleFfiBit),
+         ( "unsafe",         ITunsafe,        xbit FfiBit),
+         ( "stdcall",        ITstdcallconv,   xbit FfiBit),
+         ( "ccall",          ITccallconv,     xbit FfiBit),
+         ( "capi",           ITcapiconv,      xbit CApiFfiBit),
+         ( "prim",           ITprimcallconv,  xbit FfiBit),
+         ( "javascript",     ITjavascriptcallconv, xbit FfiBit),
+
+         ( "unit",           ITunit,          0 ),
+         ( "dependency",     ITdependency,       0 ),
+         ( "signature",      ITsignature,     0 ),
+
+         ( "rec",            ITrec,           xbit ArrowsBit .|.
+                                              xbit RecursiveDoBit),
+         ( "proc",           ITproc,          xbit ArrowsBit)
+     ]
+
+{-----------------------------------
+Note [Lexing type pseudo-keywords]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+One might think that we wish to treat 'family' and 'role' as regular old
+varids whenever -XTypeFamilies and -XRoleAnnotations are off, respectively.
+But, there is no need to do so. These pseudo-keywords are not stolen syntax:
+they are only used after the keyword 'type' at the top-level, where varids are
+not allowed. Furthermore, checks further downstream (GHC.Tc.TyCl) ensure that
+type families and role annotations are never declared without their extensions
+on. In fact, by unconditionally lexing these pseudo-keywords as special, we
+can get better error messages.
+
+Also, note that these are included in the `varid` production in the parser --
+a key detail to make all this work.
+-------------------------------------}
+
+reservedSymsFM :: UniqFM (Token, IsUnicodeSyntax, ExtsBitmap)
+reservedSymsFM = listToUFM $
+    map (\ (x,w,y,z) -> (mkFastString x,(w,y,z)))
+      [ ("..",  ITdotdot,                   NormalSyntax,  0 )
+        -- (:) is a reserved op, meaning only list cons
+       ,(":",   ITcolon,                    NormalSyntax,  0 )
+       ,("::",  ITdcolon NormalSyntax,      NormalSyntax,  0 )
+       ,("=",   ITequal,                    NormalSyntax,  0 )
+       ,("\\",  ITlam,                      NormalSyntax,  0 )
+       ,("|",   ITvbar,                     NormalSyntax,  0 )
+       ,("<-",  ITlarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("->",  ITrarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("=>",  ITdarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("-",   ITminus,                    NormalSyntax,  0 )
+
+       ,("*",   ITstar NormalSyntax,        NormalSyntax,  xbit StarIsTypeBit)
+
+        -- For 'forall a . t'
+       ,(".",   ITdot,                      NormalSyntax,  0 )
+
+       ,("-<",  ITlarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,(">-",  ITrarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,("-<<", ITLarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,(">>-", ITRarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+
+       ,("∷",   ITdcolon UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("⇒",   ITdarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("∀",   ITforall UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("→",   ITrarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("←",   ITlarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+
+       ,("⤙",   ITlarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤚",   ITrarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤛",   ITLarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤜",   ITRarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+
+       ,("★",   ITstar UnicodeSyntax,       UnicodeSyntax, xbit StarIsTypeBit)
+
+        -- ToDo: ideally, → and ∷ should be "specials", so that they cannot
+        -- form part of a large operator.  This would let us have a better
+        -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).
+       ]
+
+-- -----------------------------------------------------------------------------
+-- Lexer actions
+
+type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token)
+
+special :: Token -> Action
+special tok span _buf _len = return (L span tok)
+
+token, layout_token :: Token -> Action
+token t span _buf _len = return (L span t)
+layout_token t span _buf _len = pushLexState layout >> return (L span t)
+
+idtoken :: (StringBuffer -> Int -> Token) -> Action
+idtoken f span buf len = return (L span $! (f buf len))
+
+skip_one_varid :: (FastString -> Token) -> Action
+skip_one_varid f span buf len
+  = return (L span $! f (lexemeToFastString (stepOn buf) (len-1)))
+
+skip_two_varid :: (FastString -> Token) -> Action
+skip_two_varid f span buf len
+  = return (L span $! f (lexemeToFastString (stepOn (stepOn buf)) (len-2)))
+
+strtoken :: (String -> Token) -> Action
+strtoken f span buf len =
+  return (L span $! (f $! lexemeToString buf len))
+
+begin :: Int -> Action
+begin code _span _str _len = do pushLexState code; lexToken
+
+pop :: Action
+pop _span _buf _len = do _ <- popLexState
+                         lexToken
+-- See Note [Nested comment line pragmas]
+failLinePrag1 :: Action
+failLinePrag1 span _buf _len = do
+  b <- getBit InNestedCommentBit
+  if b then return (L span ITcomment_line_prag)
+       else lexError "lexical error in pragma"
+
+-- See Note [Nested comment line pragmas]
+popLinePrag1 :: Action
+popLinePrag1 span _buf _len = do
+  b <- getBit InNestedCommentBit
+  if b then return (L span ITcomment_line_prag) else do
+    _ <- popLexState
+    lexToken
+
+hopefully_open_brace :: Action
+hopefully_open_brace span buf len
+ = do relaxed <- getBit RelaxedLayoutBit
+      ctx <- getContext
+      (AI l _) <- getInput
+      let offset = srcLocCol (psRealLoc l)
+          isOK = relaxed ||
+                 case ctx of
+                 Layout prev_off _ : _ -> prev_off < offset
+                 _                     -> True
+      if isOK then pop_and open_brace span buf len
+              else addFatalError (mkSrcSpanPs span) (text "Missing block")
+
+pop_and :: Action -> Action
+pop_and act span buf len = do _ <- popLexState
+                              act span buf len
+
+-- See Note [Whitespace-sensitive operator parsing]
+followedByOpeningToken :: AlexAccPred ExtsBitmap
+followedByOpeningToken _ _ _ (AI _ buf)
+  | atEnd buf = False
+  | otherwise =
+      case nextChar buf of
+        ('{', buf') -> nextCharIsNot buf' (== '-')
+        ('(', _) -> True
+        ('[', _) -> True
+        ('\"', _) -> True
+        ('\'', _) -> True
+        ('_', _) -> True
+        (c, _) -> isAlphaNum c
+
+-- See Note [Whitespace-sensitive operator parsing]
+precededByClosingToken :: AlexAccPred ExtsBitmap
+precededByClosingToken _ (AI _ buf) _ _ =
+  case prevChar buf '\n' of
+    '}' -> decodePrevNChars 1 buf /= "-"
+    ')' -> True
+    ']' -> True
+    '\"' -> True
+    '\'' -> True
+    '_' -> True
+    c -> isAlphaNum c
+
+{-# INLINE nextCharIs #-}
+nextCharIs :: StringBuffer -> (Char -> Bool) -> Bool
+nextCharIs buf p = not (atEnd buf) && p (currentChar buf)
+
+{-# INLINE nextCharIsNot #-}
+nextCharIsNot :: StringBuffer -> (Char -> Bool) -> Bool
+nextCharIsNot buf p = not (nextCharIs buf p)
+
+notFollowedBy :: Char -> AlexAccPred ExtsBitmap
+notFollowedBy char _ _ _ (AI _ buf)
+  = nextCharIsNot buf (== char)
+
+notFollowedBySymbol :: AlexAccPred ExtsBitmap
+notFollowedBySymbol _ _ _ (AI _ buf)
+  = nextCharIsNot buf (`elem` "!#$%&*+./<=>?@\\^|-~")
+
+followedByDigit :: AlexAccPred ExtsBitmap
+followedByDigit _ _ _ (AI _ buf)
+  = afterOptionalSpace buf (\b -> nextCharIs b (`elem` ['0'..'9']))
+
+ifCurrentChar :: Char -> AlexAccPred ExtsBitmap
+ifCurrentChar char _ (AI _ buf) _ _
+  = nextCharIs buf (== char)
+
+-- We must reject doc comments as being ordinary comments everywhere.
+-- In some cases the doc comment will be selected as the lexeme due to
+-- maximal munch, but not always, because the nested comment rule is
+-- valid in all states, but the doc-comment rules are only valid in
+-- the non-layout states.
+isNormalComment :: AlexAccPred ExtsBitmap
+isNormalComment bits _ _ (AI _ buf)
+  | HaddockBit `xtest` bits = notFollowedByDocOrPragma
+  | otherwise               = nextCharIsNot buf (== '#')
+  where
+    notFollowedByDocOrPragma
+       = afterOptionalSpace buf (\b -> nextCharIsNot b (`elem` "|^*$#"))
+
+afterOptionalSpace :: StringBuffer -> (StringBuffer -> Bool) -> Bool
+afterOptionalSpace buf p
+    = if nextCharIs buf (== ' ')
+      then p (snd (nextChar buf))
+      else p buf
+
+atEOL :: AlexAccPred ExtsBitmap
+atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n'
+
+ifExtension :: ExtBits -> AlexAccPred ExtsBitmap
+ifExtension extBits bits _ _ _ = extBits `xtest` bits
+
+alexNotPred p userState in1 len in2
+  = not (p userState in1 len in2)
+
+alexOrPred p1 p2 userState in1 len in2
+  = p1 userState in1 len in2 || p2 userState in1 len in2
+
+multiline_doc_comment :: Action
+multiline_doc_comment span buf _len = withLexedDocType (worker "")
+  where
+    worker commentAcc input docType checkNextLine = case alexGetChar' input of
+      Just ('\n', input')
+        | checkNextLine -> case checkIfCommentLine input' of
+          Just input -> worker ('\n':commentAcc) input docType checkNextLine
+          Nothing -> docCommentEnd input commentAcc docType buf span
+        | otherwise -> docCommentEnd input commentAcc docType buf span
+      Just (c, input) -> worker (c:commentAcc) input docType checkNextLine
+      Nothing -> docCommentEnd input commentAcc docType buf span
+
+    -- Check if the next line of input belongs to this doc comment as well.
+    -- A doc comment continues onto the next line when the following
+    -- conditions are met:
+    --   * The line starts with "--"
+    --   * The line doesn't start with "---".
+    --   * The line doesn't start with "-- $", because that would be the
+    --     start of a /new/ named haddock chunk (#10398).
+    checkIfCommentLine :: AlexInput -> Maybe AlexInput
+    checkIfCommentLine input = check (dropNonNewlineSpace input)
+      where
+        check input = do
+          ('-', input) <- alexGetChar' input
+          ('-', input) <- alexGetChar' input
+          (c, after_c) <- alexGetChar' input
+          case c of
+            '-' -> Nothing
+            ' ' -> case alexGetChar' after_c of
+                     Just ('$', _) -> Nothing
+                     _ -> Just input
+            _   -> Just input
+
+        dropNonNewlineSpace input = case alexGetChar' input of
+          Just (c, input')
+            | isSpace c && c /= '\n' -> dropNonNewlineSpace input'
+            | otherwise -> input
+          Nothing -> input
+
+lineCommentToken :: Action
+lineCommentToken span buf len = do
+  b <- getBit RawTokenStreamBit
+  if b then strtoken ITlineComment span buf len else lexToken
+
+{-
+  nested comments require traversing by hand, they can't be parsed
+  using regular expressions.
+-}
+nested_comment :: P (PsLocated Token) -> Action
+nested_comment cont span buf len = do
+  input <- getInput
+  go (reverse $ lexemeToString buf len) (1::Int) input
+  where
+    go commentAcc 0 input = do
+      setInput input
+      b <- getBit RawTokenStreamBit
+      if b
+        then docCommentEnd input commentAcc ITblockComment buf span
+        else cont
+    go commentAcc n input = case alexGetChar' input of
+      Nothing -> errBrace input (psRealSpan span)
+      Just ('-',input) -> case alexGetChar' input of
+        Nothing  -> errBrace input (psRealSpan span)
+        Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}'
+        Just (_,_)          -> go ('-':commentAcc) n input
+      Just ('\123',input) -> case alexGetChar' input of  -- '{' char
+        Nothing  -> errBrace input (psRealSpan span)
+        Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input
+        Just (_,_)       -> go ('\123':commentAcc) n input
+      -- See Note [Nested comment line pragmas]
+      Just ('\n',input) -> case alexGetChar' input of
+        Nothing  -> errBrace input (psRealSpan span)
+        Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input
+                           go (parsedAcc ++ '\n':commentAcc) n input
+        Just (_,_)   -> go ('\n':commentAcc) n input
+      Just (c,input) -> go (c:commentAcc) n input
+
+nested_doc_comment :: Action
+nested_doc_comment span buf _len = withLexedDocType (go "")
+  where
+    go commentAcc input docType _ = case alexGetChar' input of
+      Nothing -> errBrace input (psRealSpan span)
+      Just ('-',input) -> case alexGetChar' input of
+        Nothing -> errBrace input (psRealSpan span)
+        Just ('\125',input) ->
+          docCommentEnd input commentAcc docType buf span
+        Just (_,_) -> go ('-':commentAcc) input docType False
+      Just ('\123', input) -> case alexGetChar' input of
+        Nothing  -> errBrace input (psRealSpan span)
+        Just ('-',input) -> do
+          setInput input
+          let cont = do input <- getInput; go commentAcc input docType False
+          nested_comment cont span buf _len
+        Just (_,_) -> go ('\123':commentAcc) input docType False
+      -- See Note [Nested comment line pragmas]
+      Just ('\n',input) -> case alexGetChar' input of
+        Nothing  -> errBrace input (psRealSpan span)
+        Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input
+                           go (parsedAcc ++ '\n':commentAcc) input docType False
+        Just (_,_)   -> go ('\n':commentAcc) input docType False
+      Just (c,input) -> go (c:commentAcc) input docType False
+
+-- See Note [Nested comment line pragmas]
+parseNestedPragma :: AlexInput -> P (String,AlexInput)
+parseNestedPragma input@(AI _ buf) = do
+  origInput <- getInput
+  setInput input
+  setExts (.|. xbit InNestedCommentBit)
+  pushLexState bol
+  lt <- lexToken
+  _ <- popLexState
+  setExts (.&. complement (xbit InNestedCommentBit))
+  postInput@(AI _ postBuf) <- getInput
+  setInput origInput
+  case unLoc lt of
+    ITcomment_line_prag -> do
+      let bytes = byteDiff buf postBuf
+          diff  = lexemeToString buf bytes
+      return (reverse diff, postInput)
+    lt' -> panic ("parseNestedPragma: unexpected token" ++ (show lt'))
+
+{-
+Note [Nested comment line pragmas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We used to ignore cpp-preprocessor-generated #line pragmas if they were inside
+nested comments.
+
+Now, when parsing a nested comment, if we encounter a line starting with '#' we
+call parseNestedPragma, which executes the following:
+1. Save the current lexer input (loc, buf) for later
+2. Set the current lexer input to the beginning of the line starting with '#'
+3. Turn the 'InNestedComment' extension on
+4. Push the 'bol' lexer state
+5. Lex a token. Due to (2), (3), and (4), this should always lex a single line
+   or less and return the ITcomment_line_prag token. This may set source line
+   and file location if a #line pragma is successfully parsed
+6. Restore lexer input and state to what they were before we did all this
+7. Return control to the function parsing a nested comment, informing it of
+   what the lexer parsed
+
+Regarding (5) above:
+Every exit from the 'bol' lexer state (do_bol, popLinePrag1, failLinePrag1)
+checks if the 'InNestedComment' extension is set. If it is, that function will
+return control to parseNestedPragma by returning the ITcomment_line_prag token.
+
+See #314 for more background on the bug this fixes.
+-}
+
+withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (PsLocated Token))
+                 -> P (PsLocated Token)
+withLexedDocType lexDocComment = do
+  input@(AI _ buf) <- getInput
+  case prevChar buf ' ' of
+    -- The `Bool` argument to lexDocComment signals whether or not the next
+    -- line of input might also belong to this doc comment.
+    '|' -> lexDocComment input ITdocCommentNext True
+    '^' -> lexDocComment input ITdocCommentPrev True
+    '$' -> lexDocComment input ITdocCommentNamed True
+    '*' -> lexDocSection 1 input
+    _ -> panic "withLexedDocType: Bad doc type"
+ where
+    lexDocSection n input = case alexGetChar' input of
+      Just ('*', input) -> lexDocSection (n+1) input
+      Just (_,   _)     -> lexDocComment input (ITdocSection n) False
+      Nothing -> do setInput input; lexToken -- eof reached, lex it normally
+
+-- RULES pragmas turn on the forall and '.' keywords, and we turn them
+-- off again at the end of the pragma.
+rulePrag :: Action
+rulePrag span buf len = do
+  setExts (.|. xbit InRulePragBit)
+  let !src = lexemeToString buf len
+  return (L span (ITrules_prag (SourceText src)))
+
+-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead
+-- of updating the position in 'PState'
+linePrag :: Action
+linePrag span buf len = do
+  usePosPrags <- getBit UsePosPragsBit
+  if usePosPrags
+    then begin line_prag2 span buf len
+    else let !src = lexemeToString buf len
+         in return (L span (ITline_prag (SourceText src)))
+
+-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead
+-- of updating the position in 'PState'
+columnPrag :: Action
+columnPrag span buf len = do
+  usePosPrags <- getBit UsePosPragsBit
+  let !src = lexemeToString buf len
+  if usePosPrags
+    then begin column_prag span buf len
+    else let !src = lexemeToString buf len
+         in return (L span (ITcolumn_prag (SourceText src)))
+
+endPrag :: Action
+endPrag span _buf _len = do
+  setExts (.&. complement (xbit InRulePragBit))
+  return (L span ITclose_prag)
+
+-- docCommentEnd
+-------------------------------------------------------------------------------
+-- This function is quite tricky. We can't just return a new token, we also
+-- need to update the state of the parser. Why? Because the token is longer
+-- than what was lexed by Alex, and the lexToken function doesn't know this, so
+-- it writes the wrong token length to the parser state. This function is
+-- called afterwards, so it can just update the state.
+
+docCommentEnd :: AlexInput -> String -> (String -> Token) -> StringBuffer ->
+                 PsSpan -> P (PsLocated Token)
+docCommentEnd input commentAcc docType buf span = do
+  setInput input
+  let (AI loc nextBuf) = input
+      comment = reverse commentAcc
+      span' = mkPsSpan (psSpanStart span) loc
+      last_len = byteDiff buf nextBuf
+
+  span `seq` setLastToken span' last_len
+  return (L span' (docType comment))
+
+errBrace :: AlexInput -> RealSrcSpan -> P a
+errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) (psRealLoc end) "unterminated `{-'"
+
+open_brace, close_brace :: Action
+open_brace span _str _len = do
+  ctx <- getContext
+  setContext (NoLayout:ctx)
+  return (L span ITocurly)
+close_brace span _str _len = do
+  popContext
+  return (L span ITccurly)
+
+qvarid, qconid :: StringBuffer -> Int -> Token
+qvarid buf len = ITqvarid $! splitQualName buf len False
+qconid buf len = ITqconid $! splitQualName buf len False
+
+splitQualName :: StringBuffer -> Int -> Bool -> (FastString,FastString)
+-- takes a StringBuffer and a length, and returns the module name
+-- and identifier parts of a qualified name.  Splits at the *last* dot,
+-- because of hierarchical module names.
+splitQualName orig_buf len parens = split orig_buf orig_buf
+  where
+    split buf dot_buf
+        | orig_buf `byteDiff` buf >= len  = done dot_buf
+        | c == '.'                        = found_dot buf'
+        | otherwise                       = split buf' dot_buf
+      where
+       (c,buf') = nextChar buf
+
+    -- careful, we might get names like M....
+    -- so, if the character after the dot is not upper-case, this is
+    -- the end of the qualifier part.
+    found_dot buf -- buf points after the '.'
+        | isUpper c    = split buf' buf
+        | otherwise    = done buf
+      where
+       (c,buf') = nextChar buf
+
+    done dot_buf =
+        (lexemeToFastString orig_buf (qual_size - 1),
+         if parens -- Prelude.(+)
+            then lexemeToFastString (stepOn dot_buf) (len - qual_size - 2)
+            else lexemeToFastString dot_buf (len - qual_size))
+      where
+        qual_size = orig_buf `byteDiff` dot_buf
+
+varid :: Action
+varid span buf len =
+  case lookupUFM reservedWordsFM fs of
+    Just (ITcase, _) -> do
+      lastTk <- getLastTk
+      keyword <- case lastTk of
+        Just ITlam -> do
+          lambdaCase <- getBit LambdaCaseBit
+          unless lambdaCase $ do
+            pState <- getPState
+            addError (mkSrcSpanPs (last_loc pState)) $ text
+                     "Illegal lambda-case (use LambdaCase)"
+          return ITlcase
+        _ -> return ITcase
+      maybe_layout keyword
+      return $ L span keyword
+    Just (keyword, 0) -> do
+      maybe_layout keyword
+      return $ L span keyword
+    Just (keyword, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0
+        then do
+          maybe_layout keyword
+          return $ L span keyword
+        else
+          return $ L span $ ITvarid fs
+    Nothing ->
+      return $ L span $ ITvarid fs
+  where
+    !fs = lexemeToFastString buf len
+
+conid :: StringBuffer -> Int -> Token
+conid buf len = ITconid $! lexemeToFastString buf len
+
+qvarsym, qconsym :: StringBuffer -> Int -> Token
+qvarsym buf len = ITqvarsym $! splitQualName buf len False
+qconsym buf len = ITqconsym $! splitQualName buf len False
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_prefix :: Action
+varsym_prefix = sym $ \exts s ->
+  if | TypeApplicationsBit `xtest` exts, s == fsLit "@"
+     -> return ITtypeApp
+     | ThQuotesBit `xtest` exts, s == fsLit "$"
+     -> return ITdollar
+     | ThQuotesBit `xtest` exts, s == fsLit "$$"
+     -> return ITdollardollar
+     | s == fsLit "!" -> return ITbang
+     | s == fsLit "~" -> return ITtilde
+     | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_suffix :: Action
+varsym_suffix = sym $ \_ s ->
+  if | s == fsLit "@"
+     -> failMsgP "Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
+     | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_tight_infix :: Action
+varsym_tight_infix = sym $ \_ s ->
+  if | s == fsLit "@" -> return ITat
+     | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_loose_infix :: Action
+varsym_loose_infix = sym (\_ s -> return $ ITvarsym s)
+
+consym :: Action
+consym = sym (\_exts s -> return $ ITconsym s)
+
+sym :: (ExtsBitmap -> FastString -> P Token) -> Action
+sym con span buf len =
+  case lookupUFM reservedSymsFM fs of
+    Just (keyword, NormalSyntax, 0) ->
+      return $ L span keyword
+    Just (keyword, NormalSyntax, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0
+        then return $ L span keyword
+        else L span <$!> con exts fs
+    Just (keyword, UnicodeSyntax, 0) -> do
+      exts <- getExts
+      if xtest UnicodeSyntaxBit exts
+        then return $ L span keyword
+        else L span <$!> con exts fs
+    Just (keyword, UnicodeSyntax, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
+        then return $ L span keyword
+        else L span <$!> con exts fs
+    Nothing -> do
+      exts <- getExts
+      L span <$!> con exts fs
+  where
+    !fs = lexemeToFastString buf len
+
+-- Variations on the integral numeric literal.
+tok_integral :: (SourceText -> Integer -> Token)
+             -> (Integer -> Integer)
+             -> Int -> Int
+             -> (Integer, (Char -> Int))
+             -> Action
+tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = do
+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473
+  let src = lexemeToString buf len
+  when ((not numericUnderscores) && ('_' `elem` src)) $ do
+    pState <- getPState
+    addError (mkSrcSpanPs (last_loc pState)) $ text
+             "Use NumericUnderscores to allow underscores in integer literals"
+  return $ L span $ itint (SourceText src)
+       $! transint $ parseUnsignedInteger
+       (offsetBytes transbuf buf) (subtract translen len) radix char_to_int
+
+tok_num :: (Integer -> Integer)
+        -> Int -> Int
+        -> (Integer, (Char->Int)) -> Action
+tok_num = tok_integral $ \case
+    st@(SourceText ('-':_)) -> itint st (const True)
+    st@(SourceText _)       -> itint st (const False)
+    st@NoSourceText         -> itint st (< 0)
+  where
+    itint :: SourceText -> (Integer -> Bool) -> Integer -> Token
+    itint !st is_negative !val = ITinteger ((IL st $! is_negative val) val)
+
+tok_primint :: (Integer -> Integer)
+            -> Int -> Int
+            -> (Integer, (Char->Int)) -> Action
+tok_primint = tok_integral ITprimint
+
+
+tok_primword :: Int -> Int
+             -> (Integer, (Char->Int)) -> Action
+tok_primword = tok_integral ITprimword positive
+positive, negative :: (Integer -> Integer)
+positive = id
+negative = negate
+decimal, octal, hexadecimal :: (Integer, Char -> Int)
+decimal = (10,octDecDigit)
+binary = (2,octDecDigit)
+octal = (8,octDecDigit)
+hexadecimal = (16,hexDigit)
+
+-- readRational can understand negative rationals, exponents, everything.
+tok_frac :: Int -> (String -> Token) -> Action
+tok_frac drop f span buf len = do
+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473
+  let src = lexemeToString buf (len-drop)
+  when ((not numericUnderscores) && ('_' `elem` src)) $ do
+    pState <- getPState
+    addError (mkSrcSpanPs (last_loc pState)) $ text
+             "Use NumericUnderscores to allow underscores in floating literals"
+  return (L span $! (f $! src))
+
+tok_float, tok_primfloat, tok_primdouble :: String -> Token
+tok_float        str = ITrational   $! readFractionalLit str
+tok_hex_float    str = ITrational   $! readHexFractionalLit str
+tok_primfloat    str = ITprimfloat  $! readFractionalLit str
+tok_primdouble   str = ITprimdouble $! readFractionalLit str
+
+readFractionalLit :: String -> FractionalLit
+readFractionalLit str = ((FL $! (SourceText str)) $! is_neg) $! readRational str
+                        where is_neg = case str of ('-':_) -> True
+                                                   _       -> False
+readHexFractionalLit :: String -> FractionalLit
+readHexFractionalLit str =
+  FL { fl_text  = SourceText str
+     , fl_neg   = case str of
+                    '-' : _ -> True
+                    _       -> False
+     , fl_value = readHexRational str
+     }
+
+-- -----------------------------------------------------------------------------
+-- Layout processing
+
+-- we're at the first token on a line, insert layout tokens if necessary
+do_bol :: Action
+do_bol span _str _len = do
+        -- See Note [Nested comment line pragmas]
+        b <- getBit InNestedCommentBit
+        if b then return (L span ITcomment_line_prag) else do
+          (pos, gen_semic) <- getOffside
+          case pos of
+              LT -> do
+                  --trace "layout: inserting '}'" $ do
+                  popContext
+                  -- do NOT pop the lex state, we might have a ';' to insert
+                  return (L span ITvccurly)
+              EQ | gen_semic -> do
+                  --trace "layout: inserting ';'" $ do
+                  _ <- popLexState
+                  return (L span ITsemi)
+              _ -> do
+                  _ <- popLexState
+                  lexToken
+
+-- certain keywords put us in the "layout" state, where we might
+-- add an opening curly brace.
+maybe_layout :: Token -> P ()
+maybe_layout t = do -- If the alternative layout rule is enabled then
+                    -- we never create an implicit layout context here.
+                    -- Layout is handled XXX instead.
+                    -- The code for closing implicit contexts, or
+                    -- inserting implicit semi-colons, is therefore
+                    -- irrelevant as it only applies in an implicit
+                    -- context.
+                    alr <- getBit AlternativeLayoutRuleBit
+                    unless alr $ f t
+    where f ITdo    = pushLexState layout_do
+          f ITmdo   = pushLexState layout_do
+          f ITof    = pushLexState layout
+          f ITlcase = pushLexState layout
+          f ITlet   = pushLexState layout
+          f ITwhere = pushLexState layout
+          f ITrec   = pushLexState layout
+          f ITif    = pushLexState layout_if
+          f _       = return ()
+
+-- Pushing a new implicit layout context.  If the indentation of the
+-- next token is not greater than the previous layout context, then
+-- Haskell 98 says that the new layout context should be empty; that is
+-- the lexer must generate {}.
+--
+-- We are slightly more lenient than this: when the new context is started
+-- by a 'do', then we allow the new context to be at the same indentation as
+-- the previous context.  This is what the 'strict' argument is for.
+new_layout_context :: Bool -> Bool -> Token -> Action
+new_layout_context strict gen_semic tok span _buf len = do
+    _ <- popLexState
+    (AI l _) <- getInput
+    let offset = srcLocCol (psRealLoc l) - len
+    ctx <- getContext
+    nondecreasing <- getBit NondecreasingIndentationBit
+    let strict' = strict || not nondecreasing
+    case ctx of
+        Layout prev_off _ : _  |
+           (strict'     && prev_off >= offset  ||
+            not strict' && prev_off > offset) -> do
+                -- token is indented to the left of the previous context.
+                -- we must generate a {} sequence now.
+                pushLexState layout_left
+                return (L span tok)
+        _ -> do setContext (Layout offset gen_semic : ctx)
+                return (L span tok)
+
+do_layout_left :: Action
+do_layout_left span _buf _len = do
+    _ <- popLexState
+    pushLexState bol  -- we must be at the start of a line
+    return (L span ITvccurly)
+
+-- -----------------------------------------------------------------------------
+-- LINE pragmas
+
+setLineAndFile :: Int -> Action
+setLineAndFile code (PsSpan span _) buf len = do
+  let src = lexemeToString buf (len - 1)  -- drop trailing quotation mark
+      linenumLen = length $ head $ words src
+      linenum = parseUnsignedInteger buf linenumLen 10 octDecDigit
+      file = mkFastString $ go $ drop 1 $ dropWhile (/= '"') src
+          -- skip everything through first quotation mark to get to the filename
+        where go ('\\':c:cs) = c : go cs
+              go (c:cs)      = c : go cs
+              go []          = []
+              -- decode escapes in the filename.  e.g. on Windows
+              -- when our filenames have backslashes in, gcc seems to
+              -- escape the backslashes.  One symptom of not doing this
+              -- is that filenames in error messages look a bit strange:
+              --   C:\\foo\bar.hs
+              -- only the first backslash is doubled, because we apply
+              -- System.FilePath.normalise before printing out
+              -- filenames and it does not remove duplicate
+              -- backslashes after the drive letter (should it?).
+  resetAlrLastLoc file
+  setSrcLoc (mkRealSrcLoc file (fromIntegral linenum - 1) (srcSpanEndCol span))
+      -- subtract one: the line number refers to the *following* line
+  addSrcFile file
+  _ <- popLexState
+  pushLexState code
+  lexToken
+
+setColumn :: Action
+setColumn (PsSpan span _) buf len = do
+  let column =
+        case reads (lexemeToString buf len) of
+          [(column, _)] -> column
+          _ -> error "setColumn: expected integer" -- shouldn't happen
+  setSrcLoc (mkRealSrcLoc (srcSpanFile span) (srcSpanEndLine span)
+                          (fromIntegral (column :: Integer)))
+  _ <- popLexState
+  lexToken
+
+alrInitialLoc :: FastString -> RealSrcSpan
+alrInitialLoc file = mkRealSrcSpan loc loc
+    where -- This is a hack to ensure that the first line in a file
+          -- looks like it is after the initial location:
+          loc = mkRealSrcLoc file (-1) (-1)
+
+-- -----------------------------------------------------------------------------
+-- Options, includes and language pragmas.
+
+lex_string_prag :: (String -> Token) -> Action
+lex_string_prag mkTok span _buf _len
+    = do input <- getInput
+         start <- getParsedLoc
+         tok <- go [] input
+         end <- getParsedLoc
+         return (L (mkPsSpan start end) tok)
+    where go acc input
+              = if isString input "#-}"
+                   then do setInput input
+                           return (mkTok (reverse acc))
+                   else case alexGetChar input of
+                          Just (c,i) -> go (c:acc) i
+                          Nothing -> err input
+          isString _ [] = True
+          isString i (x:xs)
+              = case alexGetChar i of
+                  Just (c,i') | c == x    -> isString i' xs
+                  _other -> False
+          err (AI end _) = failLocMsgP (realSrcSpanStart (psRealSpan span)) (psRealLoc end) "unterminated options pragma"
+
+
+-- -----------------------------------------------------------------------------
+-- Strings & Chars
+
+-- This stuff is horrible.  I hates it.
+
+lex_string_tok :: Action
+lex_string_tok span buf _len = do
+  tok <- lex_string ""
+  (AI end bufEnd) <- getInput
+  let
+    tok' = case tok of
+            ITprimstring _ bs -> ITprimstring (SourceText src) bs
+            ITstring _ s -> ITstring (SourceText src) s
+            _ -> panic "lex_string_tok"
+    src = lexemeToString buf (cur bufEnd - cur buf)
+  return (L (mkPsSpan (psSpanStart span) end) tok')
+
+lex_string :: String -> P Token
+lex_string s = do
+  i <- getInput
+  case alexGetChar' i of
+    Nothing -> lit_error i
+
+    Just ('"',i)  -> do
+        setInput i
+        let s' = reverse s
+        magicHash <- getBit MagicHashBit
+        if magicHash
+          then do
+            i <- getInput
+            case alexGetChar' i of
+              Just ('#',i) -> do
+                setInput i
+                when (any (> '\xFF') s') $ do
+                  pState <- getPState
+                  addError (mkSrcSpanPs (last_loc pState)) $ text
+                     "primitive string literal must contain only characters <= \'\\xFF\'"
+                return (ITprimstring (SourceText s') (unsafeMkByteString s'))
+              _other ->
+                return (ITstring (SourceText s') (mkFastString s'))
+          else
+                return (ITstring (SourceText s') (mkFastString s'))
+
+    Just ('\\',i)
+        | Just ('&',i) <- next -> do
+                setInput i; lex_string s
+        | Just (c,i) <- next, c <= '\x7f' && is_space c -> do
+                           -- is_space only works for <= '\x7f' (#3751, #5425)
+                setInput i; lex_stringgap s
+        where next = alexGetChar' i
+
+    Just (c, i1) -> do
+        case c of
+          '\\' -> do setInput i1; c' <- lex_escape; lex_string (c':s)
+          c | isAny c -> do setInput i1; lex_string (c:s)
+          _other -> lit_error i
+
+lex_stringgap :: String -> P Token
+lex_stringgap s = do
+  i <- getInput
+  c <- getCharOrFail i
+  case c of
+    '\\' -> lex_string s
+    c | c <= '\x7f' && is_space c -> lex_stringgap s
+                           -- is_space only works for <= '\x7f' (#3751, #5425)
+    _other -> lit_error i
+
+
+lex_char_tok :: Action
+-- Here we are basically parsing character literals, such as 'x' or '\n'
+-- but we additionally spot 'x and ''T, returning ITsimpleQuote and
+-- ITtyQuote respectively, but WITHOUT CONSUMING the x or T part
+-- (the parser does that).
+-- So we have to do two characters of lookahead: when we see 'x we need to
+-- see if there's a trailing quote
+lex_char_tok span buf _len = do        -- We've seen '
+   i1 <- getInput       -- Look ahead to first character
+   let loc = psSpanStart span
+   case alexGetChar' i1 of
+        Nothing -> lit_error  i1
+
+        Just ('\'', i2@(AI end2 _)) -> do       -- We've seen ''
+                   setInput i2
+                   return (L (mkPsSpan loc end2)  ITtyQuote)
+
+        Just ('\\', i2@(AI _end2 _)) -> do      -- We've seen 'backslash
+                  setInput i2
+                  lit_ch <- lex_escape
+                  i3 <- getInput
+                  mc <- getCharOrFail i3 -- Trailing quote
+                  if mc == '\'' then finish_char_tok buf loc lit_ch
+                                else lit_error i3
+
+        Just (c, i2@(AI _end2 _))
+                | not (isAny c) -> lit_error i1
+                | otherwise ->
+
+                -- We've seen 'x, where x is a valid character
+                --  (i.e. not newline etc) but not a quote or backslash
+           case alexGetChar' i2 of      -- Look ahead one more character
+                Just ('\'', i3) -> do   -- We've seen 'x'
+                        setInput i3
+                        finish_char_tok buf loc c
+                _other -> do            -- We've seen 'x not followed by quote
+                                        -- (including the possibility of EOF)
+                                        -- Just parse the quote only
+                        let (AI end _) = i1
+                        return (L (mkPsSpan loc end) ITsimpleQuote)
+
+finish_char_tok :: StringBuffer -> PsLoc -> Char -> P (PsLocated Token)
+finish_char_tok buf loc ch  -- We've already seen the closing quote
+                        -- Just need to check for trailing #
+  = do  magicHash <- getBit MagicHashBit
+        i@(AI end bufEnd) <- getInput
+        let src = lexemeToString buf (cur bufEnd - cur buf)
+        if magicHash then do
+            case alexGetChar' i of
+              Just ('#',i@(AI end _)) -> do
+                setInput i
+                return (L (mkPsSpan loc end)
+                          (ITprimchar (SourceText src) ch))
+              _other ->
+                return (L (mkPsSpan loc end)
+                          (ITchar (SourceText src) ch))
+            else do
+              return (L (mkPsSpan loc end) (ITchar (SourceText src) ch))
+
+isAny :: Char -> Bool
+isAny c | c > '\x7f' = isPrint c
+        | otherwise  = is_any c
+
+lex_escape :: P Char
+lex_escape = do
+  i0 <- getInput
+  c <- getCharOrFail i0
+  case c of
+        'a'   -> return '\a'
+        'b'   -> return '\b'
+        'f'   -> return '\f'
+        'n'   -> return '\n'
+        'r'   -> return '\r'
+        't'   -> return '\t'
+        'v'   -> return '\v'
+        '\\'  -> return '\\'
+        '"'   -> return '\"'
+        '\''  -> return '\''
+        '^'   -> do i1 <- getInput
+                    c <- getCharOrFail i1
+                    if c >= '@' && c <= '_'
+                        then return (chr (ord c - ord '@'))
+                        else lit_error i1
+
+        'x'   -> readNum is_hexdigit 16 hexDigit
+        'o'   -> readNum is_octdigit  8 octDecDigit
+        x | is_decdigit x -> readNum2 is_decdigit 10 octDecDigit (octDecDigit x)
+
+        c1 ->  do
+           i <- getInput
+           case alexGetChar' i of
+            Nothing -> lit_error i0
+            Just (c2,i2) ->
+              case alexGetChar' i2 of
+                Nothing -> do lit_error i0
+                Just (c3,i3) ->
+                   let str = [c1,c2,c3] in
+                   case [ (c,rest) | (p,c) <- silly_escape_chars,
+                                     Just rest <- [stripPrefix p str] ] of
+                          (escape_char,[]):_ -> do
+                                setInput i3
+                                return escape_char
+                          (escape_char,_:_):_ -> do
+                                setInput i2
+                                return escape_char
+                          [] -> lit_error i0
+
+readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> P Char
+readNum is_digit base conv = do
+  i <- getInput
+  c <- getCharOrFail i
+  if is_digit c
+        then readNum2 is_digit base conv (conv c)
+        else lit_error i
+
+readNum2 :: (Char -> Bool) -> Int -> (Char -> Int) -> Int -> P Char
+readNum2 is_digit base conv i = do
+  input <- getInput
+  read i input
+  where read i input = do
+          case alexGetChar' input of
+            Just (c,input') | is_digit c -> do
+               let i' = i*base + conv c
+               if i' > 0x10ffff
+                  then setInput input >> lexError "numeric escape sequence out of range"
+                  else read i' input'
+            _other -> do
+              setInput input; return (chr i)
+
+
+silly_escape_chars :: [(String, Char)]
+silly_escape_chars = [
+        ("NUL", '\NUL'),
+        ("SOH", '\SOH'),
+        ("STX", '\STX'),
+        ("ETX", '\ETX'),
+        ("EOT", '\EOT'),
+        ("ENQ", '\ENQ'),
+        ("ACK", '\ACK'),
+        ("BEL", '\BEL'),
+        ("BS", '\BS'),
+        ("HT", '\HT'),
+        ("LF", '\LF'),
+        ("VT", '\VT'),
+        ("FF", '\FF'),
+        ("CR", '\CR'),
+        ("SO", '\SO'),
+        ("SI", '\SI'),
+        ("DLE", '\DLE'),
+        ("DC1", '\DC1'),
+        ("DC2", '\DC2'),
+        ("DC3", '\DC3'),
+        ("DC4", '\DC4'),
+        ("NAK", '\NAK'),
+        ("SYN", '\SYN'),
+        ("ETB", '\ETB'),
+        ("CAN", '\CAN'),
+        ("EM", '\EM'),
+        ("SUB", '\SUB'),
+        ("ESC", '\ESC'),
+        ("FS", '\FS'),
+        ("GS", '\GS'),
+        ("RS", '\RS'),
+        ("US", '\US'),
+        ("SP", '\SP'),
+        ("DEL", '\DEL')
+        ]
+
+-- before calling lit_error, ensure that the current input is pointing to
+-- the position of the error in the buffer.  This is so that we can report
+-- a correct location to the user, but also so we can detect UTF-8 decoding
+-- errors if they occur.
+lit_error :: AlexInput -> P a
+lit_error i = do setInput i; lexError "lexical error in string/character literal"
+
+getCharOrFail :: AlexInput -> P Char
+getCharOrFail i =  do
+  case alexGetChar' i of
+        Nothing -> lexError "unexpected end-of-file in string/character literal"
+        Just (c,i)  -> do setInput i; return c
+
+-- -----------------------------------------------------------------------------
+-- QuasiQuote
+
+lex_qquasiquote_tok :: Action
+lex_qquasiquote_tok span buf len = do
+  let (qual, quoter) = splitQualName (stepOn buf) (len - 2) False
+  quoteStart <- getParsedLoc
+  quote <- lex_quasiquote (psRealLoc quoteStart) ""
+  end <- getParsedLoc
+  return (L (mkPsSpan (psSpanStart span) end)
+           (ITqQuasiQuote (qual,
+                           quoter,
+                           mkFastString (reverse quote),
+                           mkPsSpan quoteStart end)))
+
+lex_quasiquote_tok :: Action
+lex_quasiquote_tok span buf len = do
+  let quoter = tail (lexemeToString buf (len - 1))
+                -- 'tail' drops the initial '[',
+                -- while the -1 drops the trailing '|'
+  quoteStart <- getParsedLoc
+  quote <- lex_quasiquote (psRealLoc quoteStart) ""
+  end <- getParsedLoc
+  return (L (mkPsSpan (psSpanStart span) end)
+           (ITquasiQuote (mkFastString quoter,
+                          mkFastString (reverse quote),
+                          mkPsSpan quoteStart end)))
+
+lex_quasiquote :: RealSrcLoc -> String -> P String
+lex_quasiquote start s = do
+  i <- getInput
+  case alexGetChar' i of
+    Nothing -> quasiquote_error start
+
+    -- NB: The string "|]" terminates the quasiquote,
+    -- with absolutely no escaping. See the extensive
+    -- discussion on #5348 for why there is no
+    -- escape handling.
+    Just ('|',i)
+        | Just (']',i) <- alexGetChar' i
+        -> do { setInput i; return s }
+
+    Just (c, i) -> do
+         setInput i; lex_quasiquote start (c : s)
+
+quasiquote_error :: RealSrcLoc -> P a
+quasiquote_error start = do
+  (AI end buf) <- getInput
+  reportLexError start (psRealLoc end) buf "unterminated quasiquotation"
+
+-- -----------------------------------------------------------------------------
+-- Warnings
+
+warnTab :: Action
+warnTab srcspan _buf _len = do
+    addTabWarning (psRealSpan srcspan)
+    lexToken
+
+warnThen :: WarningFlag -> SDoc -> Action -> Action
+warnThen option warning action srcspan buf len = do
+    addWarning option (RealSrcSpan (psRealSpan srcspan) Nothing) warning
+    action srcspan buf len
+
+-- -----------------------------------------------------------------------------
+-- The Parse Monad
+
+-- | Do we want to generate ';' layout tokens? In some cases we just want to
+-- generate '}', e.g. in MultiWayIf we don't need ';'s because '|' separates
+-- alternatives (unlike a `case` expression where we need ';' to as a separator
+-- between alternatives).
+type GenSemic = Bool
+
+generateSemic, dontGenerateSemic :: GenSemic
+generateSemic     = True
+dontGenerateSemic = False
+
+data LayoutContext
+  = NoLayout
+  | Layout !Int !GenSemic
+  deriving Show
+
+-- | The result of running a parser.
+data ParseResult a
+  = POk      -- ^ The parser has consumed a (possibly empty) prefix
+             --   of the input and produced a result. Use 'getMessages'
+             --   to check for accumulated warnings and non-fatal errors.
+      PState -- ^ The resulting parsing state. Can be used to resume parsing.
+      a      -- ^ The resulting value.
+  | PFailed  -- ^ The parser has consumed a (possibly empty) prefix
+             --   of the input and failed.
+      PState -- ^ The parsing state right before failure, including the fatal
+             --   parse error. 'getMessages' and 'getErrorMessages' must return
+             --   a non-empty bag of errors.
+
+-- | Test whether a 'WarningFlag' is set
+warnopt :: WarningFlag -> ParserFlags -> Bool
+warnopt f options = f `EnumSet.member` pWarningFlags options
+
+-- | The subset of the 'DynFlags' used by the parser.
+-- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.
+data ParserFlags = ParserFlags {
+    pWarningFlags   :: EnumSet WarningFlag
+  , pThisPackage    :: UnitId      -- ^ key of package currently being compiled
+  , pExtsBitmap     :: !ExtsBitmap -- ^ bitmap of permitted extensions
+  }
+
+data PState = PState {
+        buffer     :: StringBuffer,
+        options    :: ParserFlags,
+        -- This needs to take DynFlags as an argument until
+        -- we have a fix for #10143
+        messages   :: DynFlags -> Messages,
+        tab_first  :: Maybe RealSrcSpan, -- pos of first tab warning in the file
+        tab_count  :: !Int,              -- number of tab warnings in the file
+        last_tk    :: Maybe Token,
+        last_loc   :: PsSpan,      -- pos of previous token
+        last_len   :: !Int,        -- len of previous token
+        loc        :: PsLoc,       -- current loc (end of prev token + 1)
+        context    :: [LayoutContext],
+        lex_state  :: [Int],
+        srcfiles   :: [FastString],
+        -- Used in the alternative layout rule:
+        -- These tokens are the next ones to be sent out. They are
+        -- just blindly emitted, without the rule looking at them again:
+        alr_pending_implicit_tokens :: [PsLocated Token],
+        -- This is the next token to be considered or, if it is Nothing,
+        -- we need to get the next token from the input stream:
+        alr_next_token :: Maybe (PsLocated Token),
+        -- This is what we consider to be the location of the last token
+        -- emitted:
+        alr_last_loc :: PsSpan,
+        -- The stack of layout contexts:
+        alr_context :: [ALRContext],
+        -- Are we expecting a '{'? If it's Just, then the ALRLayout tells
+        -- us what sort of layout the '{' will open:
+        alr_expecting_ocurly :: Maybe ALRLayout,
+        -- Have we just had the '}' for a let block? If so, than an 'in'
+        -- token doesn't need to close anything:
+        alr_justClosedExplicitLetBlock :: Bool,
+
+        -- The next three are used to implement Annotations giving the
+        -- locations of 'noise' tokens in the source, so that users of
+        -- the GHC API can do source to source conversions.
+        -- See note [Api annotations] in GHC.Parser.Annotation
+        annotations :: [(ApiAnnKey,[RealSrcSpan])],
+        eof_pos :: Maybe RealSrcSpan,
+        comment_q :: [RealLocated AnnotationComment],
+        annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])]
+     }
+        -- last_loc and last_len are used when generating error messages,
+        -- and in pushCurrentContext only.  Sigh, if only Happy passed the
+        -- current token to happyError, we could at least get rid of last_len.
+        -- Getting rid of last_loc would require finding another way to
+        -- implement pushCurrentContext (which is only called from one place).
+
+data ALRContext = ALRNoLayout Bool{- does it contain commas? -}
+                              Bool{- is it a 'let' block? -}
+                | ALRLayout ALRLayout Int
+data ALRLayout = ALRLayoutLet
+               | ALRLayoutWhere
+               | ALRLayoutOf
+               | ALRLayoutDo
+
+-- | The parsing monad, isomorphic to @StateT PState Maybe@.
+newtype P a = P { unP :: PState -> ParseResult a }
+
+instance Functor P where
+  fmap = liftM
+
+instance Applicative P where
+  pure = returnP
+  (<*>) = ap
+
+instance Monad P where
+  (>>=) = thenP
+
+returnP :: a -> P a
+returnP a = a `seq` (P $ \s -> POk s a)
+
+thenP :: P a -> (a -> P b) -> P b
+(P m) `thenP` k = P $ \ s ->
+        case m s of
+                POk s1 a         -> (unP (k a)) s1
+                PFailed s1 -> PFailed s1
+
+failMsgP :: String -> P a
+failMsgP msg = do
+  pState <- getPState
+  addFatalError (mkSrcSpanPs (last_loc pState)) (text msg)
+
+failLocMsgP :: RealSrcLoc -> RealSrcLoc -> String -> P a
+failLocMsgP loc1 loc2 str =
+  addFatalError (RealSrcSpan (mkRealSrcSpan loc1 loc2) Nothing) (text str)
+
+getPState :: P PState
+getPState = P $ \s -> POk s s
+
+withThisPackage :: (UnitId -> a) -> P a
+withThisPackage f = P $ \s@(PState{options = o}) -> POk s (f (pThisPackage o))
+
+getExts :: P ExtsBitmap
+getExts = P $ \s -> POk s (pExtsBitmap . options $ s)
+
+setExts :: (ExtsBitmap -> ExtsBitmap) -> P ()
+setExts f = P $ \s -> POk s {
+  options =
+    let p = options s
+    in  p { pExtsBitmap = f (pExtsBitmap p) }
+  } ()
+
+setSrcLoc :: RealSrcLoc -> P ()
+setSrcLoc new_loc =
+  P $ \s@(PState{ loc = PsLoc _ buf_loc }) ->
+  POk s{ loc = PsLoc new_loc buf_loc } ()
+
+getRealSrcLoc :: P RealSrcLoc
+getRealSrcLoc = P $ \s@(PState{ loc=loc }) -> POk s (psRealLoc loc)
+
+getParsedLoc :: P PsLoc
+getParsedLoc  = P $ \s@(PState{ loc=loc }) -> POk s loc
+
+addSrcFile :: FastString -> P ()
+addSrcFile f = P $ \s -> POk s{ srcfiles = f : srcfiles s } ()
+
+setEofPos :: RealSrcSpan -> P ()
+setEofPos span = P $ \s -> POk s{ eof_pos = Just span } ()
+
+setLastToken :: PsSpan -> Int -> P ()
+setLastToken loc len = P $ \s -> POk s {
+  last_loc=loc,
+  last_len=len
+  } ()
+
+setLastTk :: Token -> P ()
+setLastTk tk = P $ \s -> POk s { last_tk = Just tk } ()
+
+getLastTk :: P (Maybe Token)
+getLastTk = P $ \s@(PState { last_tk = last_tk }) -> POk s last_tk
+
+data AlexInput = AI PsLoc StringBuffer
+
+{-
+Note [Unicode in Alex]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Although newer versions of Alex support unicode, this grammar is processed with
+the old style '--latin1' behaviour. This means that when implementing the
+functions
+
+    alexGetByte       :: AlexInput -> Maybe (Word8,AlexInput)
+    alexInputPrevChar :: AlexInput -> Char
+
+which Alex uses to take apart our 'AlexInput', we must
+
+  * return a latin1 character in the 'Word8' that 'alexGetByte' expects
+  * return a latin1 character in 'alexInputPrevChar'.
+
+We handle this in 'adjustChar' by squishing entire classes of unicode
+characters into single bytes.
+-}
+
+{-# INLINE adjustChar #-}
+adjustChar :: Char -> Word8
+adjustChar c = fromIntegral $ ord adj_c
+  where non_graphic     = '\x00'
+        upper           = '\x01'
+        lower           = '\x02'
+        digit           = '\x03'
+        symbol          = '\x04'
+        space           = '\x05'
+        other_graphic   = '\x06'
+        uniidchar       = '\x07'
+
+        adj_c
+          | c <= '\x07' = non_graphic
+          | c <= '\x7f' = c
+          -- Alex doesn't handle Unicode, so when Unicode
+          -- character is encountered we output these values
+          -- with the actual character value hidden in the state.
+          | otherwise =
+                -- NB: The logic behind these definitions is also reflected
+                -- in basicTypes/Lexeme.hs
+                -- Any changes here should likely be reflected there.
+
+                case generalCategory c of
+                  UppercaseLetter       -> upper
+                  LowercaseLetter       -> lower
+                  TitlecaseLetter       -> upper
+                  ModifierLetter        -> uniidchar -- see #10196
+                  OtherLetter           -> lower -- see #1103
+                  NonSpacingMark        -> uniidchar -- see #7650
+                  SpacingCombiningMark  -> other_graphic
+                  EnclosingMark         -> other_graphic
+                  DecimalNumber         -> digit
+                  LetterNumber          -> other_graphic
+                  OtherNumber           -> digit -- see #4373
+                  ConnectorPunctuation  -> symbol
+                  DashPunctuation       -> symbol
+                  OpenPunctuation       -> other_graphic
+                  ClosePunctuation      -> other_graphic
+                  InitialQuote          -> other_graphic
+                  FinalQuote            -> other_graphic
+                  OtherPunctuation      -> symbol
+                  MathSymbol            -> symbol
+                  CurrencySymbol        -> symbol
+                  ModifierSymbol        -> symbol
+                  OtherSymbol           -> symbol
+                  Space                 -> space
+                  _other                -> non_graphic
+
+-- Getting the previous 'Char' isn't enough here - we need to convert it into
+-- the same format that 'alexGetByte' would have produced.
+--
+-- See Note [Unicode in Alex] and #13986.
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (AI _ buf) = chr (fromIntegral (adjustChar pc))
+  where pc = prevChar buf '\n'
+
+-- backwards compatibility for Alex 2.x
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar inp = case alexGetByte inp of
+                    Nothing    -> Nothing
+                    Just (b,i) -> c `seq` Just (c,i)
+                       where c = chr $ fromIntegral b
+
+-- See Note [Unicode in Alex]
+alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)
+alexGetByte (AI loc s)
+  | atEnd s   = Nothing
+  | otherwise = byte `seq` loc' `seq` s' `seq`
+                --trace (show (ord c)) $
+                Just (byte, (AI loc' s'))
+  where (c,s') = nextChar s
+        loc'   = advancePsLoc loc c
+        byte   = adjustChar c
+
+-- This version does not squash unicode characters, it is used when
+-- lexing strings.
+alexGetChar' :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar' (AI loc s)
+  | atEnd s   = Nothing
+  | otherwise = c `seq` loc' `seq` s' `seq`
+                --trace (show (ord c)) $
+                Just (c, (AI loc' s'))
+  where (c,s') = nextChar s
+        loc'   = advancePsLoc loc c
+
+getInput :: P AlexInput
+getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (AI l b)
+
+setInput :: AlexInput -> P ()
+setInput (AI l b) = P $ \s -> POk s{ loc=l, buffer=b } ()
+
+nextIsEOF :: P Bool
+nextIsEOF = do
+  AI _ s <- getInput
+  return $ atEnd s
+
+pushLexState :: Int -> P ()
+pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} ()
+
+popLexState :: P Int
+popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls
+
+getLexState :: P Int
+getLexState = P $ \s@PState{ lex_state=ls:_ } -> POk s ls
+
+popNextToken :: P (Maybe (PsLocated Token))
+popNextToken
+    = P $ \s@PState{ alr_next_token = m } ->
+              POk (s {alr_next_token = Nothing}) m
+
+activeContext :: P Bool
+activeContext = do
+  ctxt <- getALRContext
+  expc <- getAlrExpectingOCurly
+  impt <- implicitTokenPending
+  case (ctxt,expc) of
+    ([],Nothing) -> return impt
+    _other       -> return True
+
+resetAlrLastLoc :: FastString -> P ()
+resetAlrLastLoc file =
+  P $ \s@(PState {alr_last_loc = PsSpan _ buf_span}) ->
+  POk s{ alr_last_loc = PsSpan (alrInitialLoc file) buf_span } ()
+
+setAlrLastLoc :: PsSpan -> P ()
+setAlrLastLoc l = P $ \s -> POk (s {alr_last_loc = l}) ()
+
+getAlrLastLoc :: P PsSpan
+getAlrLastLoc = P $ \s@(PState {alr_last_loc = l}) -> POk s l
+
+getALRContext :: P [ALRContext]
+getALRContext = P $ \s@(PState {alr_context = cs}) -> POk s cs
+
+setALRContext :: [ALRContext] -> P ()
+setALRContext cs = P $ \s -> POk (s {alr_context = cs}) ()
+
+getJustClosedExplicitLetBlock :: P Bool
+getJustClosedExplicitLetBlock
+ = P $ \s@(PState {alr_justClosedExplicitLetBlock = b}) -> POk s b
+
+setJustClosedExplicitLetBlock :: Bool -> P ()
+setJustClosedExplicitLetBlock b
+ = P $ \s -> POk (s {alr_justClosedExplicitLetBlock = b}) ()
+
+setNextToken :: PsLocated Token -> P ()
+setNextToken t = P $ \s -> POk (s {alr_next_token = Just t}) ()
+
+implicitTokenPending :: P Bool
+implicitTokenPending
+    = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->
+              case ts of
+              [] -> POk s False
+              _  -> POk s True
+
+popPendingImplicitToken :: P (Maybe (PsLocated Token))
+popPendingImplicitToken
+    = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->
+              case ts of
+              [] -> POk s Nothing
+              (t : ts') -> POk (s {alr_pending_implicit_tokens = ts'}) (Just t)
+
+setPendingImplicitTokens :: [PsLocated Token] -> P ()
+setPendingImplicitTokens ts = P $ \s -> POk (s {alr_pending_implicit_tokens = ts}) ()
+
+getAlrExpectingOCurly :: P (Maybe ALRLayout)
+getAlrExpectingOCurly = P $ \s@(PState {alr_expecting_ocurly = b}) -> POk s b
+
+setAlrExpectingOCurly :: Maybe ALRLayout -> P ()
+setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
+
+-- | For reasons of efficiency, boolean parsing flags (eg, language extensions
+-- or whether we are currently in a @RULE@ pragma) are represented by a bitmap
+-- stored in a @Word64@.
+type ExtsBitmap = Word64
+
+xbit :: ExtBits -> ExtsBitmap
+xbit = bit . fromEnum
+
+xtest :: ExtBits -> ExtsBitmap -> Bool
+xtest ext xmap = testBit xmap (fromEnum ext)
+
+-- | Various boolean flags, mostly language extensions, that impact lexing and
+-- parsing. Note that a handful of these can change during lexing/parsing.
+data ExtBits
+  -- Flags that are constant once parsing starts
+  = FfiBit
+  | InterruptibleFfiBit
+  | CApiFfiBit
+  | ArrowsBit
+  | ThBit
+  | ThQuotesBit
+  | IpBit
+  | OverloadedLabelsBit -- #x overloaded labels
+  | ExplicitForallBit -- the 'forall' keyword
+  | BangPatBit -- Tells the parser to understand bang-patterns
+               -- (doesn't affect the lexer)
+  | PatternSynonymsBit -- pattern synonyms
+  | HaddockBit-- Lex and parse Haddock comments
+  | MagicHashBit -- "#" in both functions and operators
+  | RecursiveDoBit -- mdo
+  | UnicodeSyntaxBit -- the forall symbol, arrow symbols, etc
+  | UnboxedTuplesBit -- (# and #)
+  | UnboxedSumsBit -- (# and #)
+  | DatatypeContextsBit
+  | MonadComprehensionsBit
+  | TransformComprehensionsBit
+  | QqBit -- enable quasiquoting
+  | RawTokenStreamBit -- producing a token stream with all comments included
+  | AlternativeLayoutRuleBit
+  | ALRTransitionalBit
+  | RelaxedLayoutBit
+  | NondecreasingIndentationBit
+  | SafeHaskellBit
+  | TraditionalRecordSyntaxBit
+  | ExplicitNamespacesBit
+  | LambdaCaseBit
+  | BinaryLiteralsBit
+  | NegativeLiteralsBit
+  | HexFloatLiteralsBit
+  | TypeApplicationsBit
+  | StaticPointersBit
+  | NumericUnderscoresBit
+  | StarIsTypeBit
+  | BlockArgumentsBit
+  | NPlusKPatternsBit
+  | DoAndIfThenElseBit
+  | MultiWayIfBit
+  | GadtSyntaxBit
+  | ImportQualifiedPostBit
+
+  -- Flags that are updated once parsing starts
+  | InRulePragBit
+  | InNestedCommentBit -- See Note [Nested comment line pragmas]
+  | UsePosPragsBit
+    -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'
+    -- update the internal position. Otherwise, those pragmas are lexed as
+    -- tokens of their own.
+  deriving Enum
+
+
+
+
+
+-- PState for parsing options pragmas
+--
+pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
+pragState dynflags buf loc = (mkPState dynflags buf loc) {
+                                 lex_state = [bol, option_prags, 0]
+                             }
+
+{-# INLINE mkParserFlags' #-}
+mkParserFlags'
+  :: EnumSet WarningFlag        -- ^ warnings flags enabled
+  -> EnumSet LangExt.Extension  -- ^ permitted language extensions enabled
+  -> UnitId                     -- ^ key of package currently being compiled
+  -> Bool                       -- ^ are safe imports on?
+  -> Bool                       -- ^ keeping Haddock comment tokens
+  -> Bool                       -- ^ keep regular comment tokens
+
+  -> Bool
+  -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}' update
+  -- the internal position kept by the parser. Otherwise, those pragmas are
+  -- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens.
+
+  -> ParserFlags
+-- ^ Given exactly the information needed, set up the 'ParserFlags'
+mkParserFlags' warningFlags extensionFlags thisPackage
+  safeImports isHaddock rawTokStream usePosPrags =
+    ParserFlags {
+      pWarningFlags = warningFlags
+    , pThisPackage = thisPackage
+    , pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
+    }
+  where
+    safeHaskellBit = SafeHaskellBit `setBitIf` safeImports
+    langExtBits =
+          FfiBit                      `xoptBit` LangExt.ForeignFunctionInterface
+      .|. InterruptibleFfiBit         `xoptBit` LangExt.InterruptibleFFI
+      .|. CApiFfiBit                  `xoptBit` LangExt.CApiFFI
+      .|. ArrowsBit                   `xoptBit` LangExt.Arrows
+      .|. ThBit                       `xoptBit` LangExt.TemplateHaskell
+      .|. ThQuotesBit                 `xoptBit` LangExt.TemplateHaskellQuotes
+      .|. QqBit                       `xoptBit` LangExt.QuasiQuotes
+      .|. IpBit                       `xoptBit` LangExt.ImplicitParams
+      .|. OverloadedLabelsBit         `xoptBit` LangExt.OverloadedLabels
+      .|. ExplicitForallBit           `xoptBit` LangExt.ExplicitForAll
+      .|. BangPatBit                  `xoptBit` LangExt.BangPatterns
+      .|. MagicHashBit                `xoptBit` LangExt.MagicHash
+      .|. RecursiveDoBit              `xoptBit` LangExt.RecursiveDo
+      .|. UnicodeSyntaxBit            `xoptBit` LangExt.UnicodeSyntax
+      .|. UnboxedTuplesBit            `xoptBit` LangExt.UnboxedTuples
+      .|. UnboxedSumsBit              `xoptBit` LangExt.UnboxedSums
+      .|. DatatypeContextsBit         `xoptBit` LangExt.DatatypeContexts
+      .|. TransformComprehensionsBit  `xoptBit` LangExt.TransformListComp
+      .|. MonadComprehensionsBit      `xoptBit` LangExt.MonadComprehensions
+      .|. AlternativeLayoutRuleBit    `xoptBit` LangExt.AlternativeLayoutRule
+      .|. ALRTransitionalBit          `xoptBit` LangExt.AlternativeLayoutRuleTransitional
+      .|. RelaxedLayoutBit            `xoptBit` LangExt.RelaxedLayout
+      .|. NondecreasingIndentationBit `xoptBit` LangExt.NondecreasingIndentation
+      .|. TraditionalRecordSyntaxBit  `xoptBit` LangExt.TraditionalRecordSyntax
+      .|. ExplicitNamespacesBit       `xoptBit` LangExt.ExplicitNamespaces
+      .|. LambdaCaseBit               `xoptBit` LangExt.LambdaCase
+      .|. BinaryLiteralsBit           `xoptBit` LangExt.BinaryLiterals
+      .|. NegativeLiteralsBit         `xoptBit` LangExt.NegativeLiterals
+      .|. HexFloatLiteralsBit         `xoptBit` LangExt.HexFloatLiterals
+      .|. PatternSynonymsBit          `xoptBit` LangExt.PatternSynonyms
+      .|. TypeApplicationsBit         `xoptBit` LangExt.TypeApplications
+      .|. StaticPointersBit           `xoptBit` LangExt.StaticPointers
+      .|. NumericUnderscoresBit       `xoptBit` LangExt.NumericUnderscores
+      .|. StarIsTypeBit               `xoptBit` LangExt.StarIsType
+      .|. BlockArgumentsBit           `xoptBit` LangExt.BlockArguments
+      .|. NPlusKPatternsBit           `xoptBit` LangExt.NPlusKPatterns
+      .|. DoAndIfThenElseBit          `xoptBit` LangExt.DoAndIfThenElse
+      .|. MultiWayIfBit               `xoptBit` LangExt.MultiWayIf
+      .|. GadtSyntaxBit               `xoptBit` LangExt.GADTSyntax
+      .|. ImportQualifiedPostBit      `xoptBit` LangExt.ImportQualifiedPost
+    optBits =
+          HaddockBit        `setBitIf` isHaddock
+      .|. RawTokenStreamBit `setBitIf` rawTokStream
+      .|. UsePosPragsBit    `setBitIf` usePosPrags
+
+    xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags
+
+    setBitIf :: ExtBits -> Bool -> ExtsBitmap
+    b `setBitIf` cond | cond      = xbit b
+                      | otherwise = 0
+
+-- | Extracts the flag information needed for parsing
+mkParserFlags :: DynFlags -> ParserFlags
+mkParserFlags =
+  mkParserFlags'
+    <$> DynFlags.warningFlags
+    <*> DynFlags.extensionFlags
+    <*> DynFlags.thisPackage
+    <*> safeImportsOn
+    <*> gopt Opt_Haddock
+    <*> gopt Opt_KeepRawTokenStream
+    <*> const True
+
+-- | Creates a parse state from a 'DynFlags' value
+mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
+mkPState flags = mkPStatePure (mkParserFlags flags)
+
+-- | Creates a parse state from a 'ParserFlags' value
+mkPStatePure :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState
+mkPStatePure options buf loc =
+  PState {
+      buffer        = buf,
+      options       = options,
+      messages      = const emptyMessages,
+      tab_first     = Nothing,
+      tab_count     = 0,
+      last_tk       = Nothing,
+      last_loc      = mkPsSpan init_loc init_loc,
+      last_len      = 0,
+      loc           = init_loc,
+      context       = [],
+      lex_state     = [bol, 0],
+      srcfiles      = [],
+      alr_pending_implicit_tokens = [],
+      alr_next_token = Nothing,
+      alr_last_loc = PsSpan (alrInitialLoc (fsLit "<no file>")) (BufSpan (BufPos 0) (BufPos 0)),
+      alr_context = [],
+      alr_expecting_ocurly = Nothing,
+      alr_justClosedExplicitLetBlock = False,
+      annotations = [],
+      eof_pos = Nothing,
+      comment_q = [],
+      annotations_comments = []
+    }
+  where init_loc = PsLoc loc (BufPos 0)
+
+-- | An mtl-style class for monads that support parsing-related operations.
+-- For example, sometimes we make a second pass over the parsing results to validate,
+-- disambiguate, or rearrange them, and we do so in the PV monad which cannot consume
+-- input but can report parsing errors, check for extension bits, and accumulate
+-- parsing annotations. Both P and PV are instances of MonadP.
+--
+-- MonadP grants us convenient overloading. The other option is to have separate operations
+-- for each monad: addErrorP vs addErrorPV, getBitP vs getBitPV, and so on.
+--
+class Monad m => MonadP m where
+  -- | Add a non-fatal error. Use this when the parser can produce a result
+  --   despite the error.
+  --
+  --   For example, when GHC encounters a @forall@ in a type,
+  --   but @-XExplicitForAll@ is disabled, the parser constructs @ForAllTy@
+  --   as if @-XExplicitForAll@ was enabled, adding a non-fatal error to
+  --   the accumulator.
+  --
+  --   Control flow wise, non-fatal errors act like warnings: they are added
+  --   to the accumulator and parsing continues. This allows GHC to report
+  --   more than one parse error per file.
+  --
+  addError :: SrcSpan -> SDoc -> m ()
+  -- | Add a warning to the accumulator.
+  --   Use 'getMessages' to get the accumulated warnings.
+  addWarning :: WarningFlag -> SrcSpan -> SDoc -> m ()
+  -- | Add a fatal error. This will be the last error reported by the parser, and
+  --   the parser will not produce any result, ending in a 'PFailed' state.
+  addFatalError :: SrcSpan -> SDoc -> m a
+  -- | Check if a given flag is currently set in the bitmap.
+  getBit :: ExtBits -> m Bool
+  -- | Given a location and a list of AddAnn, apply them all to the location.
+  addAnnotation :: SrcSpan          -- SrcSpan of enclosing AST construct
+                -> AnnKeywordId     -- The first two parameters are the key
+                -> SrcSpan          -- The location of the keyword itself
+                -> m ()
+
+appendError
+  :: SrcSpan
+  -> SDoc
+  -> (DynFlags -> Messages)
+  -> (DynFlags -> Messages)
+appendError srcspan msg m =
+  \d ->
+    let (ws, es) = m d
+        errormsg = mkErrMsg d srcspan alwaysQualify msg
+        es' = es `snocBag` errormsg
+    in (ws, es')
+
+appendWarning
+  :: ParserFlags
+  -> WarningFlag
+  -> SrcSpan
+  -> SDoc
+  -> (DynFlags -> Messages)
+  -> (DynFlags -> Messages)
+appendWarning o option srcspan warning m =
+  \d ->
+    let (ws, es) = m d
+        warning' = makeIntoWarning (Reason option) $
+           mkWarnMsg d srcspan alwaysQualify warning
+        ws' = if warnopt option o then ws `snocBag` warning' else ws
+    in (ws', es)
+
+instance MonadP P where
+  addError srcspan msg
+   = P $ \s@PState{messages=m} ->
+             POk s{messages=appendError srcspan msg m} ()
+  addWarning option srcspan warning
+   = P $ \s@PState{messages=m, options=o} ->
+             POk s{messages=appendWarning o option srcspan warning m} ()
+  addFatalError span msg =
+    addError span msg >> P PFailed
+  getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)
+                         in b `seq` POk s b
+  addAnnotation (RealSrcSpan l _) a (RealSrcSpan v _) = do
+    addAnnotationOnly l a v
+    allocateCommentsP l
+  addAnnotation _ _ _ = return ()
+
+addAnnsAt :: MonadP m => SrcSpan -> [AddAnn] -> m ()
+addAnnsAt l = mapM_ (\(AddAnn a v) -> addAnnotation l a v)
+
+addTabWarning :: RealSrcSpan -> P ()
+addTabWarning srcspan
+ = P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->
+       let tf' = if isJust tf then tf else Just srcspan
+           tc' = tc + 1
+           s' = if warnopt Opt_WarnTabs o
+                then s{tab_first = tf', tab_count = tc'}
+                else s
+       in POk s' ()
+
+mkTabWarning :: PState -> DynFlags -> Maybe ErrMsg
+mkTabWarning PState{tab_first=tf, tab_count=tc} d =
+  let middle = if tc == 1
+        then text ""
+        else text ", and in" <+> speakNOf (tc - 1) (text "further location")
+      message = text "Tab character found here"
+                <> middle
+                <> text "."
+                $+$ text "Please use spaces instead."
+  in fmap (\s -> makeIntoWarning (Reason Opt_WarnTabs) $
+                 mkWarnMsg d (RealSrcSpan s Nothing) alwaysQualify message) tf
+
+-- | Get a bag of the errors that have been accumulated so far.
+--   Does not take -Werror into account.
+getErrorMessages :: PState -> DynFlags -> ErrorMessages
+getErrorMessages PState{messages=m} d =
+  let (_, es) = m d in es
+
+-- | Get the warnings and errors accumulated so far.
+--   Does not take -Werror into account.
+getMessages :: PState -> DynFlags -> Messages
+getMessages p@PState{messages=m} d =
+  let (ws, es) = m d
+      tabwarning = mkTabWarning p d
+      ws' = maybe ws (`consBag` ws) tabwarning
+  in (ws', es)
+
+getContext :: P [LayoutContext]
+getContext = P $ \s@PState{context=ctx} -> POk s ctx
+
+setContext :: [LayoutContext] -> P ()
+setContext ctx = P $ \s -> POk s{context=ctx} ()
+
+popContext :: P ()
+popContext = P $ \ s@(PState{ buffer = buf, options = o, context = ctx,
+                              last_len = len, last_loc = last_loc }) ->
+  case ctx of
+        (_:tl) ->
+          POk s{ context = tl } ()
+        []     ->
+          unP (addFatalError (mkSrcSpanPs last_loc) (srcParseErr o buf len)) s
+
+-- Push a new layout context at the indentation of the last token read.
+pushCurrentContext :: GenSemic -> P ()
+pushCurrentContext gen_semic = P $ \ s@PState{ last_loc=loc, context=ctx } ->
+    POk s{context = Layout (srcSpanStartCol (psRealSpan loc)) gen_semic : ctx} ()
+
+-- This is only used at the outer level of a module when the 'module' keyword is
+-- missing.
+pushModuleContext :: P ()
+pushModuleContext = pushCurrentContext generateSemic
+
+getOffside :: P (Ordering, Bool)
+getOffside = P $ \s@PState{last_loc=loc, context=stk} ->
+                let offs = srcSpanStartCol (psRealSpan loc) in
+                let ord = case stk of
+                            Layout n gen_semic : _ ->
+                              --trace ("layout: " ++ show n ++ ", offs: " ++ show offs) $
+                              (compare offs n, gen_semic)
+                            _ ->
+                              (GT, dontGenerateSemic)
+                in POk s ord
+
+-- ---------------------------------------------------------------------------
+-- Construct a parse error
+
+srcParseErr
+  :: ParserFlags
+  -> StringBuffer       -- current buffer (placed just after the last token)
+  -> Int                -- length of the previous token
+  -> MsgDoc
+srcParseErr options buf len
+  = if null token
+         then text "parse error (possibly incorrect indentation or mismatched brackets)"
+         else text "parse error on input" <+> quotes (text token)
+              $$ ppWhen (not th_enabled && token == "$") -- #7396
+                        (text "Perhaps you intended to use TemplateHaskell")
+              $$ ppWhen (token == "<-")
+                        (if mdoInLast100
+                           then text "Perhaps you intended to use RecursiveDo"
+                           else text "Perhaps this statement should be within a 'do' block?")
+              $$ ppWhen (token == "=" && doInLast100) -- #15849
+                        (text "Perhaps you need a 'let' in a 'do' block?"
+                         $$ text "e.g. 'let x = 5' instead of 'x = 5'")
+              $$ ppWhen (not ps_enabled && pattern == "pattern ") -- #12429
+                        (text "Perhaps you intended to use PatternSynonyms")
+  where token = lexemeToString (offsetBytes (-len) buf) len
+        pattern = decodePrevNChars 8 buf
+        last100 = decodePrevNChars 100 buf
+        doInLast100 = "do" `isInfixOf` last100
+        mdoInLast100 = "mdo" `isInfixOf` last100
+        th_enabled = ThQuotesBit `xtest` pExtsBitmap options
+        ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options
+
+-- Report a parse failure, giving the span of the previous token as
+-- the location of the error.  This is the entry point for errors
+-- detected during parsing.
+srcParseFail :: P a
+srcParseFail = P $ \s@PState{ buffer = buf, options = o, last_len = len,
+                            last_loc = last_loc } ->
+    unP (addFatalError (mkSrcSpanPs last_loc) (srcParseErr o buf len)) s
+
+-- A lexical error is reported at a particular position in the source file,
+-- not over a token range.
+lexError :: String -> P a
+lexError str = do
+  loc <- getRealSrcLoc
+  (AI end buf) <- getInput
+  reportLexError loc (psRealLoc end) buf str
+
+-- -----------------------------------------------------------------------------
+-- This is the top-level function: called from the parser each time a
+-- new token is to be read from the input.
+
+lexer, lexerDbg :: Bool -> (Located Token -> P a) -> P a
+
+lexer queueComments cont = do
+  alr <- getBit AlternativeLayoutRuleBit
+  let lexTokenFun = if alr then lexTokenAlr else lexToken
+  (L span tok) <- lexTokenFun
+  --trace ("token: " ++ show tok) $ do
+
+  if (queueComments && isDocComment tok)
+    then queueComment (L (psRealSpan span) tok)
+    else return ()
+
+  if (queueComments && isComment tok)
+    then queueComment (L (psRealSpan span) tok) >> lexer queueComments cont
+    else cont (L (mkSrcSpanPs span) tok)
+
+-- Use this instead of 'lexer' in GHC.Parser to dump the tokens for debugging.
+lexerDbg queueComments cont = lexer queueComments contDbg
+  where
+    contDbg tok = trace ("token: " ++ show (unLoc tok)) (cont tok)
+
+lexTokenAlr :: P (PsLocated Token)
+lexTokenAlr = do mPending <- popPendingImplicitToken
+                 t <- case mPending of
+                      Nothing ->
+                          do mNext <- popNextToken
+                             t <- case mNext of
+                                  Nothing -> lexToken
+                                  Just next -> return next
+                             alternativeLayoutRuleToken t
+                      Just t ->
+                          return t
+                 setAlrLastLoc (getLoc t)
+                 case unLoc t of
+                     ITwhere -> setAlrExpectingOCurly (Just ALRLayoutWhere)
+                     ITlet   -> setAlrExpectingOCurly (Just ALRLayoutLet)
+                     ITof    -> setAlrExpectingOCurly (Just ALRLayoutOf)
+                     ITlcase -> setAlrExpectingOCurly (Just ALRLayoutOf)
+                     ITdo    -> setAlrExpectingOCurly (Just ALRLayoutDo)
+                     ITmdo   -> setAlrExpectingOCurly (Just ALRLayoutDo)
+                     ITrec   -> setAlrExpectingOCurly (Just ALRLayoutDo)
+                     _       -> return ()
+                 return t
+
+alternativeLayoutRuleToken :: PsLocated Token -> P (PsLocated Token)
+alternativeLayoutRuleToken t
+    = do context <- getALRContext
+         lastLoc <- getAlrLastLoc
+         mExpectingOCurly <- getAlrExpectingOCurly
+         transitional <- getBit ALRTransitionalBit
+         justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock
+         setJustClosedExplicitLetBlock False
+         let thisLoc = getLoc t
+             thisCol = srcSpanStartCol (psRealSpan thisLoc)
+             newLine = srcSpanStartLine (psRealSpan thisLoc) > srcSpanEndLine (psRealSpan lastLoc)
+         case (unLoc t, context, mExpectingOCurly) of
+             -- This case handles a GHC extension to the original H98
+             -- layout rule...
+             (ITocurly, _, Just alrLayout) ->
+                 do setAlrExpectingOCurly Nothing
+                    let isLet = case alrLayout of
+                                ALRLayoutLet -> True
+                                _ -> False
+                    setALRContext (ALRNoLayout (containsCommas ITocurly) isLet : context)
+                    return t
+             -- ...and makes this case unnecessary
+             {-
+             -- I think our implicit open-curly handling is slightly
+             -- different to John's, in how it interacts with newlines
+             -- and "in"
+             (ITocurly, _, Just _) ->
+                 do setAlrExpectingOCurly Nothing
+                    setNextToken t
+                    lexTokenAlr
+             -}
+             (_, ALRLayout _ col : _ls, Just expectingOCurly)
+              | (thisCol > col) ||
+                (thisCol == col &&
+                 isNonDecreasingIndentation expectingOCurly) ->
+                 do setAlrExpectingOCurly Nothing
+                    setALRContext (ALRLayout expectingOCurly thisCol : context)
+                    setNextToken t
+                    return (L thisLoc ITvocurly)
+              | otherwise ->
+                 do setAlrExpectingOCurly Nothing
+                    setPendingImplicitTokens [L lastLoc ITvccurly]
+                    setNextToken t
+                    return (L lastLoc ITvocurly)
+             (_, _, Just expectingOCurly) ->
+                 do setAlrExpectingOCurly Nothing
+                    setALRContext (ALRLayout expectingOCurly thisCol : context)
+                    setNextToken t
+                    return (L thisLoc ITvocurly)
+             -- We do the [] cases earlier than in the spec, as we
+             -- have an actual EOF token
+             (ITeof, ALRLayout _ _ : ls, _) ->
+                 do setALRContext ls
+                    setNextToken t
+                    return (L thisLoc ITvccurly)
+             (ITeof, _, _) ->
+                 return t
+             -- the other ITeof case omitted; general case below covers it
+             (ITin, _, _)
+              | justClosedExplicitLetBlock ->
+                 return t
+             (ITin, ALRLayout ALRLayoutLet _ : ls, _)
+              | newLine ->
+                 do setPendingImplicitTokens [t]
+                    setALRContext ls
+                    return (L thisLoc ITvccurly)
+             -- This next case is to handle a transitional issue:
+             (ITwhere, ALRLayout _ col : ls, _)
+              | newLine && thisCol == col && transitional ->
+                 do addWarning Opt_WarnAlternativeLayoutRuleTransitional
+                               (mkSrcSpanPs thisLoc)
+                               (transitionalAlternativeLayoutWarning
+                                    "`where' clause at the same depth as implicit layout block")
+                    setALRContext ls
+                    setNextToken t
+                    -- Note that we use lastLoc, as we may need to close
+                    -- more layouts, or give a semicolon
+                    return (L lastLoc ITvccurly)
+             -- This next case is to handle a transitional issue:
+             (ITvbar, ALRLayout _ col : ls, _)
+              | newLine && thisCol == col && transitional ->
+                 do addWarning Opt_WarnAlternativeLayoutRuleTransitional
+                               (mkSrcSpanPs thisLoc)
+                               (transitionalAlternativeLayoutWarning
+                                    "`|' at the same depth as implicit layout block")
+                    setALRContext ls
+                    setNextToken t
+                    -- Note that we use lastLoc, as we may need to close
+                    -- more layouts, or give a semicolon
+                    return (L lastLoc ITvccurly)
+             (_, ALRLayout _ col : ls, _)
+              | newLine && thisCol == col ->
+                 do setNextToken t
+                    let loc = psSpanStart thisLoc
+                        zeroWidthLoc = mkPsSpan loc loc
+                    return (L zeroWidthLoc ITsemi)
+              | newLine && thisCol < col ->
+                 do setALRContext ls
+                    setNextToken t
+                    -- Note that we use lastLoc, as we may need to close
+                    -- more layouts, or give a semicolon
+                    return (L lastLoc ITvccurly)
+             -- We need to handle close before open, as 'then' is both
+             -- an open and a close
+             (u, _, _)
+              | isALRclose u ->
+                 case context of
+                 ALRLayout _ _ : ls ->
+                     do setALRContext ls
+                        setNextToken t
+                        return (L thisLoc ITvccurly)
+                 ALRNoLayout _ isLet : ls ->
+                     do let ls' = if isALRopen u
+                                     then ALRNoLayout (containsCommas u) False : ls
+                                     else ls
+                        setALRContext ls'
+                        when isLet $ setJustClosedExplicitLetBlock True
+                        return t
+                 [] ->
+                     do let ls = if isALRopen u
+                                    then [ALRNoLayout (containsCommas u) False]
+                                    else []
+                        setALRContext ls
+                        -- XXX This is an error in John's code, but
+                        -- it looks reachable to me at first glance
+                        return t
+             (u, _, _)
+              | isALRopen u ->
+                 do setALRContext (ALRNoLayout (containsCommas u) False : context)
+                    return t
+             (ITin, ALRLayout ALRLayoutLet _ : ls, _) ->
+                 do setALRContext ls
+                    setPendingImplicitTokens [t]
+                    return (L thisLoc ITvccurly)
+             (ITin, ALRLayout _ _ : ls, _) ->
+                 do setALRContext ls
+                    setNextToken t
+                    return (L thisLoc ITvccurly)
+             -- the other ITin case omitted; general case below covers it
+             (ITcomma, ALRLayout _ _ : ls, _)
+              | topNoLayoutContainsCommas ls ->
+                 do setALRContext ls
+                    setNextToken t
+                    return (L thisLoc ITvccurly)
+             (ITwhere, ALRLayout ALRLayoutDo _ : ls, _) ->
+                 do setALRContext ls
+                    setPendingImplicitTokens [t]
+                    return (L thisLoc ITvccurly)
+             -- the other ITwhere case omitted; general case below covers it
+             (_, _, _) -> return t
+
+transitionalAlternativeLayoutWarning :: String -> SDoc
+transitionalAlternativeLayoutWarning msg
+    = text "transitional layout will not be accepted in the future:"
+   $$ text msg
+
+isALRopen :: Token -> Bool
+isALRopen ITcase          = True
+isALRopen ITif            = True
+isALRopen ITthen          = True
+isALRopen IToparen        = True
+isALRopen ITobrack        = True
+isALRopen ITocurly        = True
+-- GHC Extensions:
+isALRopen IToubxparen     = True
+isALRopen _               = False
+
+isALRclose :: Token -> Bool
+isALRclose ITof     = True
+isALRclose ITthen   = True
+isALRclose ITelse   = True
+isALRclose ITcparen = True
+isALRclose ITcbrack = True
+isALRclose ITccurly = True
+-- GHC Extensions:
+isALRclose ITcubxparen = True
+isALRclose _        = False
+
+isNonDecreasingIndentation :: ALRLayout -> Bool
+isNonDecreasingIndentation ALRLayoutDo = True
+isNonDecreasingIndentation _           = False
+
+containsCommas :: Token -> Bool
+containsCommas IToparen = True
+containsCommas ITobrack = True
+-- John doesn't have {} as containing commas, but records contain them,
+-- which caused a problem parsing Cabal's Distribution.Simple.InstallDirs
+-- (defaultInstallDirs).
+containsCommas ITocurly = True
+-- GHC Extensions:
+containsCommas IToubxparen = True
+containsCommas _        = False
+
+topNoLayoutContainsCommas :: [ALRContext] -> Bool
+topNoLayoutContainsCommas [] = False
+topNoLayoutContainsCommas (ALRLayout _ _ : ls) = topNoLayoutContainsCommas ls
+topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b
+
+lexToken :: P (PsLocated Token)
+lexToken = do
+  inp@(AI loc1 buf) <- getInput
+  sc <- getLexState
+  exts <- getExts
+  case alexScanUser exts inp sc of
+    AlexEOF -> do
+        let span = mkPsSpan loc1 loc1
+        setEofPos (psRealSpan span)
+        setLastToken span 0
+        return (L span ITeof)
+    AlexError (AI loc2 buf) ->
+        reportLexError (psRealLoc loc1) (psRealLoc loc2) buf "lexical error"
+    AlexSkip inp2 _ -> do
+        setInput inp2
+        lexToken
+    AlexToken inp2@(AI end buf2) _ t -> do
+        setInput inp2
+        let span = mkPsSpan loc1 end
+        let bytes = byteDiff buf buf2
+        span `seq` setLastToken span bytes
+        lt <- t span buf bytes
+        let lt' = unLoc lt
+        unless (isComment lt') (setLastTk lt')
+        return lt
+
+reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> [Char] -> P a
+reportLexError loc1 loc2 buf str
+  | atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input")
+  | otherwise =
+  let c = fst (nextChar buf)
+  in if c == '\0' -- decoding errors are mapped to '\0', see utf8DecodeChar#
+     then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)")
+     else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
+
+lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
+lexTokenStream buf loc dflags = unP go initState{ options = opts' }
+    where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
+          initState@PState{ options = opts } = mkPState dflags' buf loc
+          opts' = opts{ pExtsBitmap = complement (xbit UsePosPragsBit) .&. pExtsBitmap opts }
+          go = do
+            ltok <- lexer False return
+            case ltok of
+              L _ ITeof -> return []
+              _ -> liftM (ltok:) go
+
+linePrags = Map.singleton "line" linePrag
+
+fileHeaderPrags = Map.fromList([("options", lex_string_prag IToptions_prag),
+                                 ("options_ghc", lex_string_prag IToptions_prag),
+                                 ("options_haddock", lex_string_prag ITdocOptions),
+                                 ("language", token ITlanguage_prag),
+                                 ("include", lex_string_prag ITinclude_prag)])
+
+ignoredPrags = Map.fromList (map ignored pragmas)
+               where ignored opt = (opt, nested_comment lexToken)
+                     impls = ["hugs", "nhc98", "jhc", "yhc", "catch", "derive"]
+                     options_pragmas = map ("options_" ++) impls
+                     -- CFILES is a hugs-only thing.
+                     pragmas = options_pragmas ++ ["cfiles", "contract"]
+
+oneWordPrags = Map.fromList [
+     ("rules", rulePrag),
+     ("inline",
+         strtoken (\s -> (ITinline_prag (SourceText s) Inline FunLike))),
+     ("inlinable",
+         strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),
+     ("inlineable",
+         strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),
+                                    -- Spelling variant
+     ("notinline",
+         strtoken (\s -> (ITinline_prag (SourceText s) NoInline FunLike))),
+     ("specialize", strtoken (\s -> ITspec_prag (SourceText s))),
+     ("source", strtoken (\s -> ITsource_prag (SourceText s))),
+     ("warning", strtoken (\s -> ITwarning_prag (SourceText s))),
+     ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))),
+     ("scc", strtoken (\s -> ITscc_prag (SourceText s))),
+     ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))),
+     ("core", strtoken (\s -> ITcore_prag (SourceText s))),
+     ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))),
+     ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))),
+     ("ann", strtoken (\s -> ITann_prag (SourceText s))),
+     ("minimal", strtoken (\s -> ITminimal_prag (SourceText s))),
+     ("overlaps", strtoken (\s -> IToverlaps_prag (SourceText s))),
+     ("overlappable", strtoken (\s -> IToverlappable_prag (SourceText s))),
+     ("overlapping", strtoken (\s -> IToverlapping_prag (SourceText s))),
+     ("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))),
+     ("ctype", strtoken (\s -> ITctype (SourceText s))),
+     ("complete", strtoken (\s -> ITcomplete_prag (SourceText s))),
+     ("column", columnPrag)
+     ]
+
+twoWordPrags = Map.fromList [
+     ("inline conlike",
+         strtoken (\s -> (ITinline_prag (SourceText s) Inline ConLike))),
+     ("notinline conlike",
+         strtoken (\s -> (ITinline_prag (SourceText s) NoInline ConLike))),
+     ("specialize inline",
+         strtoken (\s -> (ITspec_inline_prag (SourceText s) True))),
+     ("specialize notinline",
+         strtoken (\s -> (ITspec_inline_prag (SourceText s) False)))
+     ]
+
+dispatch_pragmas :: Map String Action -> Action
+dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToString buf len)) prags of
+                                       Just found -> found span buf len
+                                       Nothing -> lexError "unknown pragma"
+
+known_pragma :: Map String Action -> AlexAccPred ExtsBitmap
+known_pragma prags _ (AI _ startbuf) _ (AI _ curbuf)
+ = isKnown && nextCharIsNot curbuf pragmaNameChar
+    where l = lexemeToString startbuf (byteDiff startbuf curbuf)
+          isKnown = isJust $ Map.lookup (clean_pragma l) prags
+          pragmaNameChar c = isAlphaNum c || c == '_'
+
+clean_pragma :: String -> String
+clean_pragma prag = canon_ws (map toLower (unprefix prag))
+                    where unprefix prag' = case stripPrefix "{-#" prag' of
+                                             Just rest -> rest
+                                             Nothing -> prag'
+                          canonical prag' = case prag' of
+                                              "noinline" -> "notinline"
+                                              "specialise" -> "specialize"
+                                              "constructorlike" -> "conlike"
+                                              _ -> prag'
+                          canon_ws s = unwords (map canonical (words s))
+
+
+
+{-
+%************************************************************************
+%*                                                                      *
+        Helper functions for generating annotations in the parser
+%*                                                                      *
+%************************************************************************
+-}
+
+-- | Encapsulated call to addAnnotation, requiring only the SrcSpan of
+--   the AST construct the annotation belongs to; together with the
+--   AnnKeywordId, this is the key of the annotation map.
+--
+--   This type is useful for places in the parser where it is not yet
+--   known what SrcSpan an annotation should be added to.  The most
+--   common situation is when we are parsing a list: the annotations
+--   need to be associated with the AST element that *contains* the
+--   list, not the list itself.  'AddAnn' lets us defer adding the
+--   annotations until we finish parsing the list and are now parsing
+--   the enclosing element; we then apply the 'AddAnn' to associate
+--   the annotations.  Another common situation is where a common fragment of
+--   the AST has been factored out but there is no separate AST node for
+--   this fragment (this occurs in class and data declarations). In this
+--   case, the annotation belongs to the parent data declaration.
+--
+--   The usual way an 'AddAnn' is created is using the 'mj' ("make jump")
+--   function, and then it can be discharged using the 'ams' function.
+data AddAnn = AddAnn AnnKeywordId SrcSpan
+
+addAnnotationOnly :: RealSrcSpan -> AnnKeywordId -> RealSrcSpan -> P ()
+addAnnotationOnly l a v = P $ \s -> POk s {
+  annotations = ((l,a), [v]) : annotations s
+  } ()
+
+-- |Given a 'SrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate
+-- 'AddAnn' values for the opening and closing bordering on the start
+-- and end of the span
+mkParensApiAnn :: SrcSpan -> [AddAnn]
+mkParensApiAnn (UnhelpfulSpan _)  = []
+mkParensApiAnn (RealSrcSpan ss _) = [AddAnn AnnOpenP lo,AddAnn AnnCloseP lc]
+  where
+    f = srcSpanFile ss
+    sl = srcSpanStartLine ss
+    sc = srcSpanStartCol ss
+    el = srcSpanEndLine ss
+    ec = srcSpanEndCol ss
+    lo = RealSrcSpan (mkRealSrcSpan (realSrcSpanStart ss)        (mkRealSrcLoc f sl (sc+1))) Nothing
+    lc = RealSrcSpan (mkRealSrcSpan (mkRealSrcLoc f el (ec - 1)) (realSrcSpanEnd ss))        Nothing
+
+queueComment :: RealLocated Token -> P()
+queueComment c = P $ \s -> POk s {
+  comment_q = commentToAnnotation c : comment_q s
+  } ()
+
+-- | Go through the @comment_q@ in @PState@ and remove all comments
+-- that belong within the given span
+allocateCommentsP :: RealSrcSpan -> P ()
+allocateCommentsP ss = P $ \s ->
+  let (comment_q', newAnns) = allocateComments ss (comment_q s) in
+    POk s {
+       comment_q = comment_q'
+     , annotations_comments = newAnns ++ (annotations_comments s)
+     } ()
+
+allocateComments
+  :: RealSrcSpan
+  -> [RealLocated AnnotationComment]
+  -> ([RealLocated AnnotationComment], [(RealSrcSpan,[RealLocated AnnotationComment])])
+allocateComments ss comment_q =
+  let
+    (before,rest)  = break (\(L l _) -> isRealSubspanOf l ss) comment_q
+    (middle,after) = break (\(L l _) -> not (isRealSubspanOf l ss)) rest
+    comment_q' = before ++ after
+    newAnns = if null middle then []
+                             else [(ss,middle)]
+  in
+    (comment_q', newAnns)
+
+
+commentToAnnotation :: RealLocated Token -> RealLocated AnnotationComment
+commentToAnnotation (L l (ITdocCommentNext s))  = L l (AnnDocCommentNext s)
+commentToAnnotation (L l (ITdocCommentPrev s))  = L l (AnnDocCommentPrev s)
+commentToAnnotation (L l (ITdocCommentNamed s)) = L l (AnnDocCommentNamed s)
+commentToAnnotation (L l (ITdocSection n s))    = L l (AnnDocSection n s)
+commentToAnnotation (L l (ITdocOptions s))      = L l (AnnDocOptions s)
+commentToAnnotation (L l (ITlineComment s))     = L l (AnnLineComment s)
+commentToAnnotation (L l (ITblockComment s))    = L l (AnnBlockComment s)
+commentToAnnotation _                           = panic "commentToAnnotation"
+
+-- ---------------------------------------------------------------------
+
+isComment :: Token -> Bool
+isComment (ITlineComment     _)   = True
+isComment (ITblockComment    _)   = True
+isComment _ = False
+
+isDocComment :: Token -> Bool
+isDocComment (ITdocCommentNext  _)   = True
+isDocComment (ITdocCommentPrev  _)   = True
+isDocComment (ITdocCommentNamed _)   = True
+isDocComment (ITdocSection      _ _) = True
+isDocComment (ITdocOptions      _)   = True
+isDocComment _ = False
+}
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
new file mode 100644
index 0000000000..7ce2f4fb9a
--- /dev/null
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -0,0 +1,3090 @@
+--
+--  (c) The University of Glasgow 2002-2006
+--
+
+-- Functions over HsSyn specialised to RdrName.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+
+module GHC.Parser.PostProcess (
+        mkHsOpApp,
+        mkHsIntegral, mkHsFractional, mkHsIsString,
+        mkHsDo, mkSpliceDecl,
+        mkRoleAnnotDecl,
+        mkClassDecl,
+        mkTyData, mkDataFamInst,
+        mkTySynonym, mkTyFamInstEqn,
+        mkStandaloneKindSig,
+        mkTyFamInst,
+        mkFamDecl, mkLHsSigType,
+        mkInlinePragma,
+        mkPatSynMatchGroup,
+        mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
+        mkTyClD, mkInstD,
+        mkRdrRecordCon, mkRdrRecordUpd,
+        setRdrNameSpace,
+        filterCTuple,
+
+        cvBindGroup,
+        cvBindsAndSigs,
+        cvTopDecls,
+        placeHolderPunRhs,
+
+        -- Stuff to do with Foreign declarations
+        mkImport,
+        parseCImport,
+        mkExport,
+        mkExtName,    -- RdrName -> CLabelString
+        mkGadtDecl,   -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
+        mkConDeclH98,
+
+        -- Bunch of functions in the parser monad for
+        -- checking and constructing values
+        checkImportDecl,
+        checkExpBlockArguments,
+        checkPrecP,           -- Int -> P Int
+        checkContext,         -- HsType -> P HsContext
+        checkPattern,         -- HsExp -> P HsPat
+        checkPattern_msg,
+        checkMonadComp,       -- P (HsStmtContext GhcPs)
+        checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
+        checkValSigLhs,
+        LRuleTyTmVar, RuleTyTmVar(..),
+        mkRuleBndrs, mkRuleTyVarBndrs,
+        checkRuleTyVarBndrNames,
+        checkRecordSyntax,
+        checkEmptyGADTs,
+        addFatalError, hintBangPat,
+        TyEl(..), mergeOps, mergeDataCon,
+        mkBangTy,
+
+        -- Help with processing exports
+        ImpExpSubSpec(..),
+        ImpExpQcSpec(..),
+        mkModuleImpExp,
+        mkTypeImpExp,
+        mkImpExpSubSpec,
+        checkImportSpec,
+
+        -- Token symbols
+        forallSym,
+        starSym,
+
+        -- Warnings and errors
+        warnStarIsType,
+        warnPrepositiveQualifiedModule,
+        failOpFewArgs,
+        failOpNotEnabledImportQualifiedPost,
+        failOpImportQualifiedTwice,
+
+        SumOrTuple (..),
+
+        -- Expression/command/pattern ambiguity resolution
+        PV,
+        runPV,
+        ECP(ECP, runECP_PV),
+        runECP_P,
+        DisambInfixOp(..),
+        DisambECP(..),
+        ecpFromExp,
+        ecpFromCmd,
+        PatBuilder
+    ) where
+
+import GhcPrelude
+import GHC.Hs           -- Lots of it
+import GHC.Core.TyCon          ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
+import GHC.Core.DataCon        ( DataCon, dataConTyCon )
+import GHC.Core.ConLike        ( ConLike(..) )
+import GHC.Core.Coercion.Axiom ( Role, fsFromRole )
+import GHC.Types.Name.Reader
+import GHC.Types.Name
+import GHC.Types.Basic
+import GHC.Parser.Lexer
+import GHC.Utils.Lexeme ( isLexCon )
+import GHC.Core.Type    ( TyThing(..), funTyCon )
+import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon,
+                          nilDataConName, nilDataConKey,
+                          listTyConName, listTyConKey, eqTyCon_RDR,
+                          tupleTyConName, cTupleTyConNameArity_maybe )
+import GHC.Types.ForeignCall
+import GHC.Builtin.Names ( allNameStrings )
+import GHC.Types.SrcLoc
+import GHC.Types.Unique ( hasKey )
+import OrdList          ( OrdList, fromOL )
+import Bag              ( emptyBag, consBag )
+import Outputable
+import FastString
+import Maybes
+import Util
+import GHC.Parser.Annotation
+import Data.List
+import GHC.Driver.Session ( WarningFlag(..), DynFlags )
+import ErrUtils ( Messages )
+
+import Control.Monad
+import Text.ParserCombinators.ReadP as ReadP
+import Data.Char
+import qualified Data.Monoid as Monoid
+import Data.Data       ( dataTypeOf, fromConstr, dataTypeConstrs )
+import Data.Kind       ( Type )
+
+#include "HsVersions.h"
+
+
+{- **********************************************************************
+
+  Construction functions for Rdr stuff
+
+  ********************************************************************* -}
+
+-- | mkClassDecl builds a RdrClassDecl, filling in the names for tycon and
+-- datacon by deriving them from the name of the class.  We fill in the names
+-- for the tycon and datacon corresponding to the class, by deriving them
+-- from the name of the class itself.  This saves recording the names in the
+-- interface file (which would be equally good).
+
+-- Similarly for mkConDecl, mkClassOpSig and default-method names.
+
+--         *** See Note [The Naming story] in GHC.Hs.Decls ****
+
+mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
+mkTyClD (L loc d) = L loc (TyClD noExtField d)
+
+mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
+mkInstD (L loc d) = L loc (InstD noExtField d)
+
+mkClassDecl :: SrcSpan
+            -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
+            -> Located (a,[LHsFunDep GhcPs])
+            -> OrdList (LHsDecl GhcPs)
+            -> P (LTyClDecl GhcPs)
+
+mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
+  = do { (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls
+       ; let cxt = fromMaybe (noLoc []) mcxt
+       ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams
+       ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan
+       ; return (L loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt
+                                  , tcdLName = cls, tcdTyVars = tyvars
+                                  , tcdFixity = fixity
+                                  , tcdFDs = snd (unLoc fds)
+                                  , tcdSigs = mkClassOpSigs sigs
+                                  , tcdMeths = binds
+                                  , tcdATs = ats, tcdATDefs = at_defs
+                                  , tcdDocs  = docs })) }
+
+mkTyData :: SrcSpan
+         -> NewOrData
+         -> Maybe (Located CType)
+         -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
+         -> Maybe (LHsKind GhcPs)
+         -> [LConDecl GhcPs]
+         -> HsDeriving GhcPs
+         -> P (LTyClDecl GhcPs)
+mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr))
+         ksig data_cons maybe_deriv
+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
+       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
+       ; return (L loc (DataDecl { tcdDExt = noExtField,
+                                   tcdLName = tc, tcdTyVars = tyvars,
+                                   tcdFixity = fixity,
+                                   tcdDataDefn = defn })) }
+
+mkDataDefn :: NewOrData
+           -> Maybe (Located CType)
+           -> Maybe (LHsContext GhcPs)
+           -> Maybe (LHsKind GhcPs)
+           -> [LConDecl GhcPs]
+           -> HsDeriving GhcPs
+           -> P (HsDataDefn GhcPs)
+mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
+  = do { checkDatatypeContext mcxt
+       ; let cxt = fromMaybe (noLoc []) mcxt
+       ; return (HsDataDefn { dd_ext = noExtField
+                            , dd_ND = new_or_data, dd_cType = cType
+                            , dd_ctxt = cxt
+                            , dd_cons = data_cons
+                            , dd_kindSig = ksig
+                            , dd_derivs = maybe_deriv }) }
+
+
+mkTySynonym :: SrcSpan
+            -> LHsType GhcPs  -- LHS
+            -> LHsType GhcPs  -- RHS
+            -> P (LTyClDecl GhcPs)
+mkTySynonym loc lhs rhs
+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
+       ; return (L loc (SynDecl { tcdSExt = noExtField
+                                , tcdLName = tc, tcdTyVars = tyvars
+                                , tcdFixity = fixity
+                                , tcdRhs = rhs })) }
+
+mkStandaloneKindSig
+  :: SrcSpan
+  -> Located [Located RdrName] -- LHS
+  -> LHsKind GhcPs             -- RHS
+  -> P (LStandaloneKindSig GhcPs)
+mkStandaloneKindSig loc lhs rhs =
+  do { vs <- mapM check_lhs_name (unLoc lhs)
+     ; v <- check_singular_lhs (reverse vs)
+     ; return $ L loc $ StandaloneKindSig noExtField v (mkLHsSigType rhs) }
+  where
+    check_lhs_name v@(unLoc->name) =
+      if isUnqual name && isTcOcc (rdrNameOcc name)
+      then return v
+      else addFatalError (getLoc v) $
+           hang (text "Expected an unqualified type constructor:") 2 (ppr v)
+    check_singular_lhs vs =
+      case vs of
+        [] -> panic "mkStandaloneKindSig: empty left-hand side"
+        [v] -> return v
+        _ -> addFatalError (getLoc lhs) $
+             vcat [ hang (text "Standalone kind signatures do not support multiple names at the moment:")
+                       2 (pprWithCommas ppr vs)
+                  , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details." ]
+
+mkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs]
+               -> LHsType GhcPs
+               -> LHsType GhcPs
+               -> P (TyFamInstEqn GhcPs,[AddAnn])
+mkTyFamInstEqn bndrs lhs rhs
+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
+       ; return (mkHsImplicitBndrs
+                  (FamEqn { feqn_ext    = noExtField
+                          , feqn_tycon  = tc
+                          , feqn_bndrs  = bndrs
+                          , feqn_pats   = tparams
+                          , feqn_fixity = fixity
+                          , feqn_rhs    = rhs }),
+                 ann) }
+
+mkDataFamInst :: SrcSpan
+              -> NewOrData
+              -> Maybe (Located CType)
+              -> (Maybe ( LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs]
+                        , LHsType GhcPs)
+              -> Maybe (LHsKind GhcPs)
+              -> [LConDecl GhcPs]
+              -> HsDeriving GhcPs
+              -> P (LInstDecl GhcPs)
+mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
+              ksig data_cons maybe_deriv
+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
+       ; return (L loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs
+                  (FamEqn { feqn_ext    = noExtField
+                          , feqn_tycon  = tc
+                          , feqn_bndrs  = bndrs
+                          , feqn_pats   = tparams
+                          , feqn_fixity = fixity
+                          , feqn_rhs    = defn }))))) }
+
+mkTyFamInst :: SrcSpan
+            -> TyFamInstEqn GhcPs
+            -> P (LInstDecl GhcPs)
+mkTyFamInst loc eqn
+  = return (L loc (TyFamInstD noExtField (TyFamInstDecl eqn)))
+
+mkFamDecl :: SrcSpan
+          -> FamilyInfo GhcPs
+          -> LHsType GhcPs                   -- LHS
+          -> Located (FamilyResultSig GhcPs) -- Optional result signature
+          -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation
+          -> P (LTyClDecl GhcPs)
+mkFamDecl loc info lhs ksig injAnn
+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
+       ; return (L loc (FamDecl noExtField (FamilyDecl
+                                           { fdExt       = noExtField
+                                           , fdInfo      = info, fdLName = tc
+                                           , fdTyVars    = tyvars
+                                           , fdFixity    = fixity
+                                           , fdResultSig = ksig
+                                           , fdInjectivityAnn = injAnn }))) }
+  where
+    equals_or_where = case info of
+                        DataFamily          -> empty
+                        OpenTypeFamily      -> empty
+                        ClosedTypeFamily {} -> whereDots
+
+mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
+-- If the user wrote
+--      [pads| ... ]   then return a QuasiQuoteD
+--      $(e)           then return a SpliceD
+-- but if she wrote, say,
+--      f x            then behave as if she'd written $(f x)
+--                     ie a SpliceD
+--
+-- Typed splices are not allowed at the top level, thus we do not represent them
+-- as spliced declaration.  See #10945
+mkSpliceDecl lexpr@(L loc expr)
+  | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr
+  = SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice)
+
+  | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr
+  = SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice)
+
+  | otherwise
+  = SpliceD noExtField (SpliceDecl noExtField (L loc (mkUntypedSplice BareSplice lexpr))
+                              ImplicitSplice)
+
+mkRoleAnnotDecl :: SrcSpan
+                -> Located RdrName                -- type being annotated
+                -> [Located (Maybe FastString)]      -- roles
+                -> P (LRoleAnnotDecl GhcPs)
+mkRoleAnnotDecl loc tycon roles
+  = do { roles' <- mapM parse_role roles
+       ; return $ L loc $ RoleAnnotDecl noExtField tycon roles' }
+  where
+    role_data_type = dataTypeOf (undefined :: Role)
+    all_roles = map fromConstr $ dataTypeConstrs role_data_type
+    possible_roles = [(fsFromRole role, role) | role <- all_roles]
+
+    parse_role (L loc_role Nothing) = return $ L loc_role Nothing
+    parse_role (L loc_role (Just role))
+      = case lookup role possible_roles of
+          Just found_role -> return $ L loc_role $ Just found_role
+          Nothing         ->
+            let nearby = fuzzyLookup (unpackFS role)
+                  (mapFst unpackFS possible_roles)
+            in
+            addFatalError loc_role
+              (text "Illegal role name" <+> quotes (ppr role) $$
+               suggestions nearby)
+
+    suggestions []   = empty
+    suggestions [r]  = text "Perhaps you meant" <+> quotes (ppr r)
+      -- will this last case ever happen??
+    suggestions list = hang (text "Perhaps you meant one of these:")
+                       2 (pprWithCommas (quotes . ppr) list)
+
+{- **********************************************************************
+
+  #cvBinds-etc# Converting to @HsBinds@, etc.
+
+  ********************************************************************* -}
+
+-- | Function definitions are restructured here. Each is assumed to be recursive
+-- initially, and non recursive definitions are discovered by the dependency
+-- analyser.
+
+
+--  | Groups together bindings for a single function
+cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]
+cvTopDecls decls = go (fromOL decls)
+  where
+    go :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]
+    go []                     = []
+    go ((L l (ValD x b)) : ds)
+      = L l' (ValD x b') : go ds'
+        where (L l' b', ds') = getMonoBind (L l b) ds
+    go (d : ds)                    = d : go ds
+
+-- Declaration list may only contain value bindings and signatures.
+cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
+cvBindGroup binding
+  = do { (mbs, sigs, fam_ds, tfam_insts
+         , dfam_insts, _) <- cvBindsAndSigs binding
+       ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)
+         return $ ValBinds noExtField mbs sigs }
+
+cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
+  -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
+          , [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl])
+-- Input decls contain just value bindings and signatures
+-- and in case of class or instance declarations also
+-- associated type declarations. They might also contain Haddock comments.
+cvBindsAndSigs fb = go (fromOL fb)
+  where
+    go []              = return (emptyBag, [], [], [], [], [])
+    go ((L l (ValD _ b)) : ds)
+      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds'
+           ; return (b' `consBag` bs, ss, ts, tfis, dfis, docs) }
+      where
+        (b', ds') = getMonoBind (L l b) ds
+    go ((L l decl) : ds)
+      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds
+           ; case decl of
+               SigD _ s
+                 -> return (bs, L l s : ss, ts, tfis, dfis, docs)
+               TyClD _ (FamDecl _ t)
+                 -> return (bs, ss, L l t : ts, tfis, dfis, docs)
+               InstD _ (TyFamInstD { tfid_inst = tfi })
+                 -> return (bs, ss, ts, L l tfi : tfis, dfis, docs)
+               InstD _ (DataFamInstD { dfid_inst = dfi })
+                 -> return (bs, ss, ts, tfis, L l dfi : dfis, docs)
+               DocD _ d
+                 -> return (bs, ss, ts, tfis, dfis, L l d : docs)
+               SpliceD _ d
+                 -> addFatalError l $
+                    hang (text "Declaration splices are allowed only" <+>
+                          text "at the top level:")
+                       2 (ppr d)
+               _ -> pprPanic "cvBindsAndSigs" (ppr decl) }
+
+-----------------------------------------------------------------------------
+-- Group function bindings into equation groups
+
+getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]
+  -> (LHsBind GhcPs, [LHsDecl GhcPs])
+-- Suppose      (b',ds') = getMonoBind b ds
+--      ds is a list of parsed bindings
+--      b is a MonoBinds that has just been read off the front
+
+-- Then b' is the result of grouping more equations from ds that
+-- belong with b into a single MonoBinds, and ds' is the depleted
+-- list of parsed bindings.
+--
+-- All Haddock comments between equations inside the group are
+-- discarded.
+--
+-- No AndMonoBinds or EmptyMonoBinds here; just single equations
+
+getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1)
+                             , fun_matches =
+                               MG { mg_alts = (L _ mtchs1) } }))
+            binds
+  | has_args mtchs1
+  = go mtchs1 loc1 binds []
+  where
+    go mtchs loc
+       ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2)
+                                 , fun_matches =
+                                    MG { mg_alts = (L _ mtchs2) } })))
+         : binds) _
+        | f1 == f2 = go (mtchs2 ++ mtchs)
+                        (combineSrcSpans loc loc2) binds []
+    go mtchs loc (doc_decl@(L loc2 (DocD {})) : binds) doc_decls
+        = let doc_decls' = doc_decl : doc_decls
+          in go mtchs (combineSrcSpans loc loc2) binds doc_decls'
+    go mtchs loc binds doc_decls
+        = ( L loc (makeFunBind fun_id1 (reverse mtchs))
+          , (reverse doc_decls) ++ binds)
+        -- Reverse the final matches, to get it back in the right order
+        -- Do the same thing with the trailing doc comments
+
+getMonoBind bind binds = (bind, binds)
+
+has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
+has_args []                                  = panic "GHC.Parser.PostProcess.has_args"
+has_args (L _ (Match { m_pats = args }) : _) = not (null args)
+        -- Don't group together FunBinds if they have
+        -- no arguments.  This is necessary now that variable bindings
+        -- with no arguments are now treated as FunBinds rather
+        -- than pattern bindings (tests/rename/should_fail/rnfail002).
+
+{- **********************************************************************
+
+  #PrefixToHS-utils# Utilities for conversion
+
+  ********************************************************************* -}
+
+{- Note [Parsing data constructors is hard]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The problem with parsing data constructors is that they look a lot like types.
+Compare:
+
+  (s1)   data T = C t1 t2
+  (s2)   type T = C t1 t2
+
+Syntactically, there's little difference between these declarations, except in
+(s1) 'C' is a data constructor, but in (s2) 'C' is a type constructor.
+
+This similarity would pose no problem if we knew ahead of time if we are
+parsing a type or a constructor declaration. Looking at (s1) and (s2), a simple
+(but wrong!) rule comes to mind: in 'data' declarations assume we are parsing
+data constructors, and in other contexts (e.g. 'type' declarations) assume we
+are parsing type constructors.
+
+This simple rule does not work because of two problematic cases:
+
+  (p1)   data T = C t1 t2 :+ t3
+  (p2)   data T = C t1 t2 => t3
+
+In (p1) we encounter (:+) and it turns out we are parsing an infix data
+declaration, so (C t1 t2) is a type and 'C' is a type constructor.
+In (p2) we encounter (=>) and it turns out we are parsing an existential
+context, so (C t1 t2) is a constraint and 'C' is a type constructor.
+
+As the result, in order to determine whether (C t1 t2) declares a data
+constructor, a type, or a context, we would need unlimited lookahead which
+'happy' is not so happy with.
+
+To further complicate matters, the interpretation of (!) and (~) is different
+in constructors and types:
+
+  (b1)   type T = C ! D
+  (b2)   data T = C ! D
+  (b3)   data T = C ! D => E
+
+In (b1) and (b3), (!) is a type operator with two arguments: 'C' and 'D'. At
+the same time, in (b2) it is a strictness annotation: 'C' is a data constructor
+with a single strict argument 'D'. For the programmer, these cases are usually
+easy to tell apart due to whitespace conventions:
+
+  (b2)   data T = C !D         -- no space after the bang hints that
+                               -- it is a strictness annotation
+
+For the parser, on the other hand, this whitespace does not matter. We cannot
+tell apart (b2) from (b3) until we encounter (=>), so it requires unlimited
+lookahead.
+
+The solution that accounts for all of these issues is to initially parse data
+declarations and types as a reversed list of TyEl:
+
+  data TyEl = TyElOpr RdrName
+            | TyElOpd (HsType GhcPs)
+            | ...
+
+For example, both occurrences of (C ! D) in the following example are parsed
+into equal lists of TyEl:
+
+  data T = C ! D => C ! D   results in   [ TyElOpd (HsTyVar "D")
+                                         , TyElOpr "!"
+                                         , TyElOpd (HsTyVar "C") ]
+
+Note that elements are in reverse order. Also, 'C' is parsed as a type
+constructor (HsTyVar) even when it is a data constructor. We fix this in
+`tyConToDataCon`.
+
+By the time the list of TyEl is assembled, we have looked ahead enough to
+decide whether to reduce using `mergeOps` (for types) or `mergeDataCon` (for
+data constructors). These functions are where the actual job of parsing is
+done.
+
+-}
+
+-- | Reinterpret a type constructor, including type operators, as a data
+--   constructor.
+-- See Note [Parsing data constructors is hard]
+tyConToDataCon :: SrcSpan -> RdrName -> Either (SrcSpan, SDoc) (Located RdrName)
+tyConToDataCon loc tc
+  | isTcOcc occ || isDataOcc occ
+  , isLexCon (occNameFS occ)
+  = return (L loc (setRdrNameSpace tc srcDataName))
+
+  | otherwise
+  = Left (loc, msg)
+  where
+    occ = rdrNameOcc tc
+    msg = text "Not a data constructor:" <+> quotes (ppr tc)
+
+mkPatSynMatchGroup :: Located RdrName
+                   -> Located (OrdList (LHsDecl GhcPs))
+                   -> P (MatchGroup GhcPs (LHsExpr GhcPs))
+mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
+    do { matches <- mapM fromDecl (fromOL decls)
+       ; when (null matches) (wrongNumberErr loc)
+       ; return $ mkMatchGroup FromSource matches }
+  where
+    fromDecl (L loc decl@(ValD _ (PatBind _
+                         pat@(L _ (ConPatIn ln@(L _ name) details))
+                               rhs _))) =
+        do { unless (name == patsyn_name) $
+               wrongNameBindingErr loc decl
+           ; match <- case details of
+               PrefixCon pats -> return $ Match { m_ext = noExtField
+                                                , m_ctxt = ctxt, m_pats = pats
+                                                , m_grhss = rhs }
+                   where
+                     ctxt = FunRhs { mc_fun = ln
+                                   , mc_fixity = Prefix
+                                   , mc_strictness = NoSrcStrict }
+
+               InfixCon p1 p2 -> return $ Match { m_ext = noExtField
+                                                , m_ctxt = ctxt
+                                                , m_pats = [p1, p2]
+                                                , m_grhss = rhs }
+                   where
+                     ctxt = FunRhs { mc_fun = ln
+                                   , mc_fixity = Infix
+                                   , mc_strictness = NoSrcStrict }
+
+               RecCon{} -> recordPatSynErr loc pat
+           ; return $ L loc match }
+    fromDecl (L loc decl) = extraDeclErr loc decl
+
+    extraDeclErr loc decl =
+        addFatalError loc $
+        text "pattern synonym 'where' clause must contain a single binding:" $$
+        ppr decl
+
+    wrongNameBindingErr loc decl =
+      addFatalError loc $
+      text "pattern synonym 'where' clause must bind the pattern synonym's name"
+      <+> quotes (ppr patsyn_name) $$ ppr decl
+
+    wrongNumberErr loc =
+      addFatalError loc $
+      text "pattern synonym 'where' clause cannot be empty" $$
+      text "In the pattern synonym declaration for: " <+> ppr (patsyn_name)
+
+recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
+recordPatSynErr loc pat =
+    addFatalError loc $
+    text "record syntax not supported for pattern synonym declarations:" $$
+    ppr pat
+
+mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]
+                -> Maybe (LHsContext GhcPs) -> HsConDeclDetails GhcPs
+                -> ConDecl GhcPs
+
+mkConDeclH98 name mb_forall mb_cxt args
+  = ConDeclH98 { con_ext    = noExtField
+               , con_name   = name
+               , con_forall = noLoc $ isJust mb_forall
+               , con_ex_tvs = mb_forall `orElse` []
+               , con_mb_cxt = mb_cxt
+               , con_args   = args
+               , con_doc    = Nothing }
+
+mkGadtDecl :: [Located RdrName]
+           -> LHsType GhcPs     -- Always a HsForAllTy
+           -> (ConDecl GhcPs, [AddAnn])
+mkGadtDecl names ty
+  = (ConDeclGADT { con_g_ext  = noExtField
+                 , con_names  = names
+                 , con_forall = L l $ isLHsForAllTy ty'
+                 , con_qvars  = mkHsQTvs tvs
+                 , con_mb_cxt = mcxt
+                 , con_args   = args
+                 , con_res_ty = res_ty
+                 , con_doc    = Nothing }
+    , anns1 ++ anns2)
+  where
+    (ty'@(L l _),anns1) = peel_parens ty []
+    (tvs, rho) = splitLHsForAllTyInvis ty'
+    (mcxt, tau, anns2) = split_rho rho []
+
+    split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann
+      = (Just cxt, tau, ann)
+    split_rho (L l (HsParTy _ ty)) ann
+      = split_rho ty (ann++mkParensApiAnn l)
+    split_rho tau                  ann
+      = (Nothing, tau, ann)
+
+    (args, res_ty) = split_tau tau
+
+    -- See Note [GADT abstract syntax] in GHC.Hs.Decls
+    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty))
+      = (RecCon (L loc rf), res_ty)
+    split_tau tau
+      = (PrefixCon [], tau)
+
+    peel_parens (L l (HsParTy _ ty)) ann = peel_parens ty
+                                                       (ann++mkParensApiAnn l)
+    peel_parens ty                   ann = (ty, ann)
+
+
+setRdrNameSpace :: RdrName -> NameSpace -> RdrName
+-- ^ This rather gruesome function is used mainly by the parser.
+-- When parsing:
+--
+-- > data T a = T | T1 Int
+--
+-- we parse the data constructors as /types/ because of parser ambiguities,
+-- so then we need to change the /type constr/ to a /data constr/
+--
+-- The exact-name case /can/ occur when parsing:
+--
+-- > data [] a = [] | a : [a]
+--
+-- For the exact-name case we return an original name.
+setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
+setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
+setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
+setRdrNameSpace (Exact n)    ns
+  | Just thing <- wiredInNameTyThing_maybe n
+  = setWiredInNameSpace thing ns
+    -- Preserve Exact Names for wired-in things,
+    -- notably tuples and lists
+
+  | isExternalName n
+  = Orig (nameModule n) occ
+
+  | otherwise   -- This can happen when quoting and then
+                -- splicing a fixity declaration for a type
+  = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))
+  where
+    occ = setOccNameSpace ns (nameOccName n)
+
+setWiredInNameSpace :: TyThing -> NameSpace -> RdrName
+setWiredInNameSpace (ATyCon tc) ns
+  | isDataConNameSpace ns
+  = ty_con_data_con tc
+  | isTcClsNameSpace ns
+  = Exact (getName tc)      -- No-op
+
+setWiredInNameSpace (AConLike (RealDataCon dc)) ns
+  | isTcClsNameSpace ns
+  = data_con_ty_con dc
+  | isDataConNameSpace ns
+  = Exact (getName dc)      -- No-op
+
+setWiredInNameSpace thing ns
+  = pprPanic "setWiredinNameSpace" (pprNameSpace ns <+> ppr thing)
+
+ty_con_data_con :: TyCon -> RdrName
+ty_con_data_con tc
+  | isTupleTyCon tc
+  , Just dc <- tyConSingleDataCon_maybe tc
+  = Exact (getName dc)
+
+  | tc `hasKey` listTyConKey
+  = Exact nilDataConName
+
+  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
+  = Unqual (setOccNameSpace srcDataName (getOccName tc))
+
+data_con_ty_con :: DataCon -> RdrName
+data_con_ty_con dc
+  | let tc = dataConTyCon dc
+  , isTupleTyCon tc
+  = Exact (getName tc)
+
+  | dc `hasKey` nilDataConKey
+  = Exact listTyConName
+
+  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
+  = Unqual (setOccNameSpace tcClsName (getOccName dc))
+
+-- | Replaces constraint tuple names with corresponding boxed ones.
+filterCTuple :: RdrName -> RdrName
+filterCTuple (Exact n)
+  | Just arity <- cTupleTyConNameArity_maybe n
+  = Exact $ tupleTyConName BoxedTuple arity
+filterCTuple rdr = rdr
+
+
+{- Note [setRdrNameSpace for wired-in names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In GHC.Types, which declares (:), we have
+  infixr 5 :
+The ambiguity about which ":" is meant is resolved by parsing it as a
+data constructor, but then using dataTcOccs to try the type constructor too;
+and that in turn calls setRdrNameSpace to change the name-space of ":" to
+tcClsName.  There isn't a corresponding ":" type constructor, but it's painful
+to make setRdrNameSpace partial, so we just make an Unqual name instead. It
+really doesn't matter!
+-}
+
+eitherToP :: Either (SrcSpan, SDoc) a -> P a
+-- Adapts the Either monad to the P monad
+eitherToP (Left (loc, doc)) = addFatalError loc doc
+eitherToP (Right thing)     = return thing
+
+checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]
+            -> P ( LHsQTyVars GhcPs  -- the synthesized type variables
+                 , [AddAnn] )        -- action which adds annotations
+-- ^ Check whether the given list of type parameters are all type variables
+-- (possibly with a kind signature).
+checkTyVars pp_what equals_or_where tc tparms
+  = do { (tvs, anns) <- fmap unzip $ mapM check tparms
+       ; return (mkHsQTvs tvs, concat anns) }
+  where
+    check (HsTypeArg _ ki@(L loc _))
+                              = addFatalError loc $
+                                      vcat [ text "Unexpected type application" <+>
+                                            text "@" <> ppr ki
+                                          , text "In the" <+> pp_what <+>
+                                            ptext (sLit "declaration for") <+> quotes (ppr tc)]
+    check (HsValArg ty) = chkParens [] ty
+    check (HsArgPar sp) = addFatalError sp $
+                          vcat [text "Malformed" <+> pp_what
+                            <+> text "declaration for" <+> quotes (ppr tc)]
+        -- Keep around an action for adjusting the annotations of extra parens
+    chkParens :: [AddAnn] -> LHsType GhcPs
+              -> P (LHsTyVarBndr GhcPs, [AddAnn])
+    chkParens acc (L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l ++ acc) ty
+    chkParens acc ty = do
+      tv <- chk ty
+      return (tv, reverse acc)
+
+        -- Check that the name space is correct!
+    chk :: LHsType GhcPs -> P (LHsTyVarBndr GhcPs)
+    chk (L l (HsKindSig _ (L lv (HsTyVar _ _ (L _ tv))) k))
+        | isRdrTyVar tv    = return (L l (KindedTyVar noExtField (L lv tv) k))
+    chk (L l (HsTyVar _ _ (L ltv tv)))
+        | isRdrTyVar tv    = return (L l (UserTyVar noExtField (L ltv tv)))
+    chk t@(L loc _)
+        = addFatalError loc $
+                vcat [ text "Unexpected type" <+> quotes (ppr t)
+                     , text "In the" <+> pp_what
+                       <+> ptext (sLit "declaration for") <+> quotes tc'
+                     , vcat[ (text "A" <+> pp_what
+                              <+> ptext (sLit "declaration should have form"))
+                     , nest 2
+                       (pp_what
+                        <+> tc'
+                        <+> hsep (map text (takeList tparms allNameStrings))
+                        <+> equals_or_where) ] ]
+
+    -- Avoid printing a constraint tuple in the error message. Print
+    -- a plain old tuple instead (since that's what the user probably
+    -- wrote). See #14907
+    tc' = ppr $ fmap filterCTuple tc
+
+
+
+whereDots, equalsDots :: SDoc
+-- Second argument to checkTyVars
+whereDots  = text "where ..."
+equalsDots = text "= ..."
+
+checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
+checkDatatypeContext Nothing = return ()
+checkDatatypeContext (Just c)
+    = do allowed <- getBit DatatypeContextsBit
+         unless allowed $
+             addError (getLoc c)
+                 (text "Illegal datatype context (use DatatypeContexts):"
+                  <+> pprLHsContext c)
+
+type LRuleTyTmVar = Located RuleTyTmVar
+data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs))
+-- ^ Essentially a wrapper for a @RuleBndr GhcPs@
+
+-- turns RuleTyTmVars into RuleBnrs - this is straightforward
+mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
+mkRuleBndrs = fmap (fmap cvt_one)
+  where cvt_one (RuleTyTmVar v Nothing)    = RuleBndr    noExtField v
+        cvt_one (RuleTyTmVar v (Just sig)) =
+          RuleBndrSig noExtField v (mkLHsSigWcType sig)
+
+-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting
+mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]
+mkRuleTyVarBndrs = fmap (fmap cvt_one)
+  where cvt_one (RuleTyTmVar v Nothing)    = UserTyVar   noExtField (fmap tm_to_ty v)
+        cvt_one (RuleTyTmVar v (Just sig))
+          = KindedTyVar noExtField (fmap tm_to_ty v) sig
+    -- takes something in namespace 'varName' to something in namespace 'tvName'
+        tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)
+        tm_to_ty _ = panic "mkRuleTyVarBndrs"
+
+-- See note [Parsing explicit foralls in Rules] in GHC.Parser
+checkRuleTyVarBndrNames :: [LHsTyVarBndr GhcPs] -> P ()
+checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
+  where check (L loc (Unqual occ)) = do
+          when ((occNameString occ ==) `any` ["forall","family","role"])
+               (addFatalError loc (text $ "parse error on input "
+                                    ++ occNameString occ))
+        check _ = panic "checkRuleTyVarBndrNames"
+
+checkRecordSyntax :: (MonadP m, Outputable a) => Located a -> m (Located a)
+checkRecordSyntax lr@(L loc r)
+    = do allowed <- getBit TraditionalRecordSyntaxBit
+         unless allowed $ addError loc $
+           text "Illegal record syntax (use TraditionalRecordSyntax):" <+> ppr r
+         return lr
+
+-- | Check if the gadt_constrlist is empty. Only raise parse error for
+-- `data T where` to avoid affecting existing error message, see #8258.
+checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
+                -> P (Located ([AddAnn], [LConDecl GhcPs]))
+checkEmptyGADTs gadts@(L span (_, []))           -- Empty GADT declaration.
+    = do gadtSyntax <- getBit GadtSyntaxBit   -- GADTs implies GADTSyntax
+         unless gadtSyntax $ addError span $ vcat
+           [ text "Illegal keyword 'where' in data declaration"
+           , text "Perhaps you intended to use GADTs or a similar language"
+           , text "extension to enable syntax: data T where"
+           ]
+         return gadts
+checkEmptyGADTs gadts = return gadts              -- Ordinary GADT declaration.
+
+checkTyClHdr :: Bool               -- True  <=> class header
+                                   -- False <=> type header
+             -> LHsType GhcPs
+             -> P (Located RdrName,      -- the head symbol (type or class name)
+                   [LHsTypeArg GhcPs],      -- parameters of head symbol
+                   LexicalFixity,        -- the declaration is in infix format
+                   [AddAnn]) -- API Annotation for HsParTy when stripping parens
+-- Well-formedness check and decomposition of type and class heads.
+-- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
+--              Int :*: Bool   into    (:*:, [Int, Bool])
+-- returning the pieces
+checkTyClHdr is_cls ty
+  = goL ty [] [] Prefix
+  where
+    goL (L l ty) acc ann fix = go l ty acc ann fix
+
+    -- workaround to define '*' despite StarIsType
+    go lp (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix
+      = do { warnStarBndr l
+           ; let name = mkOccName tcClsName (starSym isUni)
+           ; return (L l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }
+
+    go _ (HsTyVar _ _ ltc@(L _ tc)) acc ann fix
+      | isRdrTc tc               = return (ltc, acc, fix, ann)
+    go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix
+      | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann)
+    go l (HsParTy _ ty)    acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix
+    go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (HsValArg t2:acc) ann fix
+    go _ (HsAppKindTy l ty ki) acc ann fix = goL ty (HsTypeArg l ki:acc) ann fix
+    go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix
+      = return (L l (nameRdrName tup_name), map HsValArg ts, fix, ann)
+      where
+        arity = length ts
+        tup_name | is_cls    = cTupleTyConName arity
+                 | otherwise = getName (tupleTyCon Boxed arity)
+          -- See Note [Unit tuples] in GHC.Hs.Types  (TODO: is this still relevant?)
+    go l _ _ _ _
+      = addFatalError l (text "Malformed head of type or class declaration:"
+                          <+> ppr ty)
+
+-- | Yield a parse error if we have a function applied directly to a do block
+-- etc. and BlockArguments is not enabled.
+checkExpBlockArguments :: LHsExpr GhcPs -> PV ()
+checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
+(checkExpBlockArguments, checkCmdBlockArguments) = (checkExpr, checkCmd)
+  where
+    checkExpr :: LHsExpr GhcPs -> PV ()
+    checkExpr expr = case unLoc expr of
+      HsDo _ DoExpr _ -> check "do block" expr
+      HsDo _ MDoExpr _ -> check "mdo block" expr
+      HsLam {} -> check "lambda expression" expr
+      HsCase {} -> check "case expression" expr
+      HsLamCase {} -> check "lambda-case expression" expr
+      HsLet {} -> check "let expression" expr
+      HsIf {} -> check "if expression" expr
+      HsProc {} -> check "proc expression" expr
+      _ -> return ()
+
+    checkCmd :: LHsCmd GhcPs -> PV ()
+    checkCmd cmd = case unLoc cmd of
+      HsCmdLam {} -> check "lambda command" cmd
+      HsCmdCase {} -> check "case command" cmd
+      HsCmdIf {} -> check "if command" cmd
+      HsCmdLet {} -> check "let command" cmd
+      HsCmdDo {} -> check "do command" cmd
+      _ -> return ()
+
+    check :: Outputable a => String -> Located a -> PV ()
+    check element a = do
+      blockArguments <- getBit BlockArgumentsBit
+      unless blockArguments $
+        addError (getLoc a) $
+          text "Unexpected " <> text element <> text " in function application:"
+           $$ nest 4 (ppr a)
+           $$ text "You could write it with parentheses"
+           $$ text "Or perhaps you meant to enable BlockArguments?"
+
+-- | Validate the context constraints and break up a context into a list
+-- of predicates.
+--
+-- @
+--     (Eq a, Ord b)        -->  [Eq a, Ord b]
+--     Eq a                 -->  [Eq a]
+--     (Eq a)               -->  [Eq a]
+--     (((Eq a)))           -->  [Eq a]
+-- @
+checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
+checkContext (L l orig_t)
+  = check [] (L l orig_t)
+ where
+  check anns (L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))
+    -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
+    -- be used as context constraints.
+    = return (anns ++ mkParensApiAnn lp,L l ts)                -- Ditto ()
+
+  check anns (L lp1 (HsParTy _ ty))
+                                  -- to be sure HsParTy doesn't get into the way
+       = check anns' ty
+         where anns' = if l == lp1 then anns
+                                   else (anns ++ mkParensApiAnn lp1)
+
+  -- no need for anns, returning original
+  check _anns t = checkNoDocs msg t *> return ([],L l [L l orig_t])
+
+  msg = text "data constructor context"
+
+-- | Check recursively if there are any 'HsDocTy's in the given type.
+-- This only works on a subset of types produced by 'btype_no_ops'
+checkNoDocs :: SDoc -> LHsType GhcPs -> P ()
+checkNoDocs msg ty = go ty
+  where
+    go (L _ (HsAppKindTy _ ty ki)) = go ty *> go ki
+    go (L _ (HsAppTy _ t1 t2)) = go t1 *> go t2
+    go (L l (HsDocTy _ t ds)) = addError l $ hsep
+                                  [ text "Unexpected haddock", quotes (ppr ds)
+                                  , text "on", msg, quotes (ppr t) ]
+    go _ = pure ()
+
+checkImportDecl :: Maybe (Located Token)
+                -> Maybe (Located Token)
+                -> P ()
+checkImportDecl mPre mPost = do
+  let whenJust mg f = maybe (pure ()) f mg
+
+  importQualifiedPostEnabled <- getBit ImportQualifiedPostBit
+
+  -- Error if 'qualified' found in postpositive position and
+  -- 'ImportQualifiedPost' is not in effect.
+  whenJust mPost $ \post ->
+    when (not importQualifiedPostEnabled) $
+      failOpNotEnabledImportQualifiedPost (getLoc post)
+
+  -- Error if 'qualified' occurs in both pre and postpositive
+  -- positions.
+  whenJust mPost $ \post ->
+    when (isJust mPre) $
+      failOpImportQualifiedTwice (getLoc post)
+
+  -- Warn if 'qualified' found in prepositive position and
+  -- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
+  whenJust mPre $ \pre ->
+    warnPrepositiveQualifiedModule (getLoc pre)
+
+-- -------------------------------------------------------------------------
+-- Checking Patterns.
+
+-- We parse patterns as expressions and check for valid patterns below,
+-- converting the expression into a pattern at the same time.
+
+checkPattern :: Located (PatBuilder GhcPs) -> P (LPat GhcPs)
+checkPattern = runPV . checkLPat
+
+checkPattern_msg :: SDoc -> PV (Located (PatBuilder GhcPs)) -> P (LPat GhcPs)
+checkPattern_msg msg pp = runPV_msg msg (pp >>= checkLPat)
+
+checkLPat :: Located (PatBuilder GhcPs) -> PV (LPat GhcPs)
+checkLPat e@(L l _) = checkPat l e []
+
+checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [LPat GhcPs]
+         -> PV (LPat GhcPs)
+checkPat loc (L l e@(PatBuilderVar (L _ c))) args
+  | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
+  | not (null args) && patIsRec c =
+      localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
+      patFail l (ppr e)
+checkPat loc (L _ (PatBuilderApp f e)) args
+  = do p <- checkLPat e
+       checkPat loc f (p : args)
+checkPat loc (L _ e) []
+  = do p <- checkAPat loc e
+       return (L loc p)
+checkPat loc e _
+  = patFail loc (ppr e)
+
+checkAPat :: SrcSpan -> PatBuilder GhcPs -> PV (Pat GhcPs)
+checkAPat loc e0 = do
+ nPlusKPatterns <- getBit NPlusKPatternsBit
+ case e0 of
+   PatBuilderPat p -> return p
+   PatBuilderVar x -> return (VarPat noExtField x)
+
+   -- Overloaded numeric patterns (e.g. f 0 x = x)
+   -- Negation is recorded separately, so that the literal is zero or +ve
+   -- NB. Negative *primitive* literals are already handled by the lexer
+   PatBuilderOverLit pos_lit -> return (mkNPat (L loc pos_lit) Nothing)
+
+   -- n+k patterns
+   PatBuilderOpApp
+           (L nloc (PatBuilderVar (L _ n)))
+           (L _ plus)
+           (L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
+                      | nPlusKPatterns && (plus == plus_RDR)
+                      -> return (mkNPlusKPat (L nloc n) (L lloc lit))
+
+   PatBuilderOpApp l (L cl c) r
+     | isRdrDataCon c -> do
+         l <- checkLPat l
+         r <- checkLPat r
+         return (ConPatIn (L cl c) (InfixCon l r))
+
+   PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExtField))
+   _           -> patFail loc (ppr e0)
+
+placeHolderPunRhs :: DisambECP b => PV (Located b)
+-- The RHS of a punned record field will be filled in by the renamer
+-- It's better not to make it an error, in case we want to print it when
+-- debugging
+placeHolderPunRhs = mkHsVarPV (noLoc pun_RDR)
+
+plus_RDR, pun_RDR :: RdrName
+plus_RDR = mkUnqual varName (fsLit "+") -- Hack
+pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
+
+checkPatField :: LHsRecField GhcPs (Located (PatBuilder GhcPs))
+              -> PV (LHsRecField GhcPs (LPat GhcPs))
+checkPatField (L l fld) = do p <- checkLPat (hsRecFieldArg fld)
+                             return (L l (fld { hsRecFieldArg = p }))
+
+patFail :: SrcSpan -> SDoc -> PV a
+patFail loc e = addFatalError loc $ text "Parse error in pattern:" <+> ppr e
+
+patIsRec :: RdrName -> Bool
+patIsRec e = e == mkUnqual varName (fsLit "rec")
+
+---------------------------------------------------------------------------
+-- Check Equation Syntax
+
+checkValDef :: Located (PatBuilder GhcPs)
+            -> Maybe (LHsType GhcPs)
+            -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
+            -> P ([AddAnn],HsBind GhcPs)
+
+checkValDef lhs (Just sig) grhss
+        -- x :: ty = rhs  parses as a *pattern* binding
+  = do lhs' <- runPV $ mkHsTySigPV (combineLocs lhs sig) lhs sig >>= checkLPat
+       checkPatBind lhs' grhss
+
+checkValDef lhs Nothing g@(L l (_,grhss))
+  = do  { mb_fun <- isFunLhs lhs
+        ; case mb_fun of
+            Just (fun, is_infix, pats, ann) ->
+              checkFunBind NoSrcStrict ann (getLoc lhs)
+                           fun is_infix pats (L l grhss)
+            Nothing -> do
+              lhs' <- checkPattern lhs
+              checkPatBind lhs' g }
+
+checkFunBind :: SrcStrictness
+             -> [AddAnn]
+             -> SrcSpan
+             -> Located RdrName
+             -> LexicalFixity
+             -> [Located (PatBuilder GhcPs)]
+             -> Located (GRHSs GhcPs (LHsExpr GhcPs))
+             -> P ([AddAnn],HsBind GhcPs)
+checkFunBind strictness ann lhs_loc fun is_infix pats (L rhs_span grhss)
+  = do  ps <- mapM checkPattern pats
+        let match_span = combineSrcSpans lhs_loc rhs_span
+        -- Add back the annotations stripped from any HsPar values in the lhs
+        -- mapM_ (\a -> a match_span) ann
+        return (ann, makeFunBind fun
+                  [L match_span (Match { m_ext = noExtField
+                                       , m_ctxt = FunRhs
+                                           { mc_fun    = fun
+                                           , mc_fixity = is_infix
+                                           , mc_strictness = strictness }
+                                       , m_pats = ps
+                                       , m_grhss = grhss })])
+        -- The span of the match covers the entire equation.
+        -- That isn't quite right, but it'll do for now.
+
+makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
+            -> HsBind GhcPs
+-- Like GHC.Hs.Utils.mkFunBind, but we need to be able to set the fixity too
+makeFunBind fn ms
+  = FunBind { fun_ext = noExtField,
+              fun_id = fn,
+              fun_matches = mkMatchGroup FromSource ms,
+              fun_tick = [] }
+
+-- See Note [FunBind vs PatBind]
+checkPatBind :: LPat GhcPs
+             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
+             -> P ([AddAnn],HsBind GhcPs)
+checkPatBind lhs (L match_span (_,grhss))
+    | BangPat _ p <- unLoc lhs
+    , VarPat _ v <- unLoc p
+    = return ([], makeFunBind v [L match_span (m v)])
+  where
+    m v = Match { m_ext = noExtField
+                , m_ctxt = FunRhs { mc_fun    = L (getLoc lhs) (unLoc v)
+                                  , mc_fixity = Prefix
+                                  , mc_strictness = SrcStrict }
+                , m_pats = []
+                , m_grhss = grhss }
+
+checkPatBind lhs (L _ (_,grhss))
+  = return ([],PatBind noExtField lhs grhss ([],[]))
+
+checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
+checkValSigLhs (L _ (HsVar _ lrdr@(L _ v)))
+  | isUnqual v
+  , not (isDataOcc (rdrNameOcc v))
+  = return lrdr
+
+checkValSigLhs lhs@(L l _)
+  = addFatalError l ((text "Invalid type signature:" <+>
+                       ppr lhs <+> text ":: ...")
+                      $$ text hint)
+  where
+    hint | foreign_RDR `looks_like` lhs
+         = "Perhaps you meant to use ForeignFunctionInterface?"
+         | default_RDR `looks_like` lhs
+         = "Perhaps you meant to use DefaultSignatures?"
+         | pattern_RDR `looks_like` lhs
+         = "Perhaps you meant to use PatternSynonyms?"
+         | otherwise
+         = "Should be of form <variable> :: <type>"
+
+    -- A common error is to forget the ForeignFunctionInterface flag
+    -- so check for that, and suggest.  cf #3805
+    -- Sadly 'foreign import' still barfs 'parse error' because
+    --  'import' is a keyword
+    looks_like s (L _ (HsVar _ (L _ v))) = v == s
+    looks_like s (L _ (HsApp _ lhs _))   = looks_like s lhs
+    looks_like _ _                       = False
+
+    foreign_RDR = mkUnqual varName (fsLit "foreign")
+    default_RDR = mkUnqual varName (fsLit "default")
+    pattern_RDR = mkUnqual varName (fsLit "pattern")
+
+checkDoAndIfThenElse
+  :: (Outputable a, Outputable b, Outputable c)
+  => Located a -> Bool -> b -> Bool -> Located c -> PV ()
+checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
+ | semiThen || semiElse
+    = do doAndIfThenElse <- getBit DoAndIfThenElseBit
+         unless doAndIfThenElse $ do
+             addError (combineLocs guardExpr elseExpr)
+                            (text "Unexpected semi-colons in conditional:"
+                          $$ nest 4 expr
+                          $$ text "Perhaps you meant to use DoAndIfThenElse?")
+ | otherwise            = return ()
+    where pprOptSemi True  = semi
+          pprOptSemi False = empty
+          expr = text "if"   <+> ppr guardExpr <> pprOptSemi semiThen <+>
+                 text "then" <+> ppr thenExpr  <> pprOptSemi semiElse <+>
+                 text "else" <+> ppr elseExpr
+
+isFunLhs :: Located (PatBuilder GhcPs)
+      -> P (Maybe (Located RdrName, LexicalFixity, [Located (PatBuilder GhcPs)],[AddAnn]))
+-- A variable binding is parsed as a FunBind.
+-- Just (fun, is_infix, arg_pats) if e is a function LHS
+isFunLhs e = go e [] []
+ where
+   go (L loc (PatBuilderVar (L _ f))) es ann
+       | not (isRdrDataCon f)        = return (Just (L loc f, Prefix, es, ann))
+   go (L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
+   go (L l (PatBuilderPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
+   go (L loc (PatBuilderOpApp l (L loc' op) r)) es ann
+        | not (isRdrDataCon op)         -- We have found the function!
+        = return (Just (L loc' op, Infix, (l:r:es), ann))
+        | otherwise                     -- Infix data con; keep going
+        = do { mb_l <- go l es ann
+             ; case mb_l of
+                 Just (op', Infix, j : k : es', ann')
+                   -> return (Just (op', Infix, j : op_app : es', ann'))
+                   where
+                     op_app = L loc (PatBuilderOpApp k
+                               (L loc' op) r)
+                 _ -> return Nothing }
+   go _ _ _ = return Nothing
+
+-- | Either an operator or an operand.
+data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)
+          | TyElKindApp SrcSpan (LHsType GhcPs)
+          -- See Note [TyElKindApp SrcSpan interpretation]
+          | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)
+          | TyElDocPrev HsDocString
+
+
+{- Note [TyElKindApp SrcSpan interpretation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A TyElKindApp captures type application written in haskell as
+
+    @ Foo
+
+where Foo is some type.
+
+The SrcSpan reflects both elements, and there are AnnAt and AnnVal API
+Annotations attached to this SrcSpan for the specific locations of
+each within it.
+-}
+
+instance Outputable TyEl where
+  ppr (TyElOpr name) = ppr name
+  ppr (TyElOpd ty) = ppr ty
+  ppr (TyElKindApp _ ki) = text "@" <> ppr ki
+  ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk
+  ppr (TyElDocPrev doc) = ppr doc
+
+-- | Extract a strictness/unpackedness annotation from the front of a reversed
+-- 'TyEl' list.
+pUnpackedness
+  :: [Located TyEl] -- reversed TyEl
+  -> Maybe ( SrcSpan
+           , [AddAnn]
+           , SourceText
+           , SrcUnpackedness
+           , [Located TyEl] {- remaining TyEl -})
+pUnpackedness (L l x1 : xs)
+  | TyElUnpackedness (anns, prag, unpk) <- x1
+  = Just (l, anns, prag, unpk, xs)
+pUnpackedness _ = Nothing
+
+pBangTy
+  :: LHsType GhcPs  -- a type to be wrapped inside HsBangTy
+  -> [Located TyEl] -- reversed TyEl
+  -> ( Bool           {- has a strict mark been consumed? -}
+     , LHsType GhcPs  {- the resulting BangTy -}
+     , P ()           {- add annotations -}
+     , [Located TyEl] {- remaining TyEl -})
+pBangTy lt@(L l1 _) xs =
+  case pUnpackedness xs of
+    Nothing -> (False, lt, pure (), xs)
+    Just (l2, anns, prag, unpk, xs') ->
+      let bl = combineSrcSpans l1 l2
+          bt = addUnpackedness (prag, unpk) lt
+      in (True, L bl bt, addAnnsAt bl anns, xs')
+
+mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs
+mkBangTy strictness =
+  HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness)
+
+addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs
+addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t))
+  | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang
+  = HsBangTy x (HsSrcBang prag unpk strictness) t
+addUnpackedness (prag, unpk) t
+  = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t
+
+-- | Merge a /reversed/ and /non-empty/ soup of operators and operands
+--   into a type.
+--
+-- User input: @F x y + G a b * X@
+-- Input to 'mergeOps': [X, *, b, a, G, +, y, x, F]
+-- Output corresponds to what the user wrote assuming all operators are of the
+-- same fixity and right-associative.
+--
+-- It's a bit silly that we're doing it at all, as the renamer will have to
+-- rearrange this, and it'd be easier to keep things separate.
+--
+-- See Note [Parsing data constructors is hard]
+mergeOps :: [Located TyEl] -> P (LHsType GhcPs)
+mergeOps ((L l1 (TyElOpd t)) : xs)
+  | (_, t', addAnns, xs') <- pBangTy (L l1 t) xs
+  , null xs' -- We accept a BangTy only when there are no preceding TyEl.
+  = addAnns >> return t'
+mergeOps all_xs = go (0 :: Int) [] id all_xs
+  where
+    -- NB. When modifying clauses in 'go', make sure that the reasoning in
+    -- Note [Non-empty 'acc' in mergeOps clause [end]] is still correct.
+
+    -- clause [unpk]:
+    -- handle (NO)UNPACK pragmas
+    go k acc ops_acc ((L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =
+      if not (null acc) && null xs
+      then do { acc' <- eitherToP $ mergeOpsAcc acc
+              ; let a = ops_acc acc'
+                    strictMark = HsSrcBang unpkSrc unpk NoSrcStrict
+                    bl = combineSrcSpans l (getLoc a)
+                    bt = HsBangTy noExtField strictMark a
+              ; addAnnsAt bl anns
+              ; return (L bl bt) }
+      else addFatalError l unpkError
+      where
+        unpkSDoc = case unpkSrc of
+          NoSourceText -> ppr unpk
+          SourceText str -> text str <> text " #-}"
+        unpkError
+          | not (null xs) = unpkSDoc <+> text "cannot appear inside a type."
+          | null acc && k == 0 = unpkSDoc <+> text "must be applied to a type."
+          | otherwise =
+              -- See Note [Impossible case in mergeOps clause [unpk]]
+              panic "mergeOps.UNPACK: impossible position"
+
+    -- clause [doc]:
+    -- we do not expect to encounter any docs
+    go _ _ _ ((L l (TyElDocPrev _)):_) =
+      failOpDocPrev l
+
+    -- clause [opr]:
+    -- when we encounter an operator, we must have accumulated
+    -- something for its rhs, and there must be something left
+    -- to build its lhs.
+    go k acc ops_acc ((L l (TyElOpr op)):xs) =
+      if null acc || null (filter isTyElOpd xs)
+        then failOpFewArgs (L l op)
+        else do { acc' <- eitherToP (mergeOpsAcc acc)
+                ; go (k + 1) [] (\c -> mkLHsOpTy c (L l op) (ops_acc acc')) xs }
+      where
+        isTyElOpd (L _ (TyElOpd _)) = True
+        isTyElOpd _ = False
+
+    -- clause [opd]:
+    -- whenever an operand is encountered, it is added to the accumulator
+    go k acc ops_acc ((L l (TyElOpd a)):xs) = go k (HsValArg (L l a):acc) ops_acc xs
+
+    -- clause [tyapp]:
+    -- whenever a type application is encountered, it is added to the accumulator
+    go k acc ops_acc ((L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs
+
+    -- clause [end]
+    -- See Note [Non-empty 'acc' in mergeOps clause [end]]
+    go _ acc ops_acc [] = do { acc' <- eitherToP (mergeOpsAcc acc)
+                             ; return (ops_acc acc') }
+
+mergeOpsAcc :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
+         -> Either (SrcSpan, SDoc) (LHsType GhcPs)
+mergeOpsAcc [] = panic "mergeOpsAcc: empty input"
+mergeOpsAcc (HsTypeArg _ (L loc ki):_)
+  = Left (loc, text "Unexpected type application:" <+> ppr ki)
+mergeOpsAcc (HsValArg ty : xs) = go1 ty xs
+  where
+    go1 :: LHsType GhcPs
+        -> [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
+        -> Either (SrcSpan, SDoc) (LHsType GhcPs)
+    go1 lhs []     = Right lhs
+    go1 lhs (x:xs) = case x of
+        HsValArg ty -> go1 (mkHsAppTy lhs ty) xs
+        HsTypeArg loc ki -> let ty = mkHsAppKindTy loc lhs ki
+                            in go1 ty xs
+        HsArgPar _ -> go1 lhs xs
+mergeOpsAcc (HsArgPar _: xs) = mergeOpsAcc xs
+
+{- Note [Impossible case in mergeOps clause [unpk]]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This case should never occur. Let us consider all possible
+variations of 'acc', 'xs', and 'k':
+
+  acc          xs        k
+==============================
+  null   |    null       0      -- "must be applied to a type"
+  null   |  not null     0      -- "must be applied to a type"
+not null |    null       0      -- successful parse
+not null |  not null     0      -- "cannot appear inside a type"
+  null   |    null      >0      -- handled in clause [opr]
+  null   |  not null    >0      -- "cannot appear inside a type"
+not null |    null      >0      -- successful parse
+not null |  not null    >0      -- "cannot appear inside a type"
+
+The (null acc && null xs && k>0) case is handled in clause [opr]
+by the following check:
+
+    if ... || null (filter isTyElOpd xs)
+     then failOpFewArgs (L l op)
+
+We know that this check has been performed because k>0, and by
+the time we reach the end of the list (null xs), the only way
+for (null acc) to hold is that there was not a single TyElOpd
+between the operator and the end of the list. But this case is
+caught by the check and reported as 'failOpFewArgs'.
+-}
+
+{- Note [Non-empty 'acc' in mergeOps clause [end]]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In clause [end] we need to know that 'acc' is non-empty to call 'mergeAcc'
+without a check.
+
+Running 'mergeOps' with an empty input list is forbidden, so we do not consider
+this possibility. This means we'll hit at least one other clause before we
+reach clause [end].
+
+* Clauses [unpk] and [doc] do not call 'go' recursively, so we cannot hit
+  clause [end] from there.
+* Clause [opd] makes 'acc' non-empty, so if we hit clause [end] after it, 'acc'
+  will be non-empty.
+* Clause [opr] checks that (filter isTyElOpd xs) is not null - so we are going
+  to hit clause [opd] at least once before we reach clause [end], making 'acc'
+  non-empty.
+* There are no other clauses.
+
+Therefore, it is safe to omit a check for non-emptiness of 'acc' in clause
+[end].
+
+-}
+
+pInfixSide :: [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])
+pInfixSide ((L l (TyElOpd t)):xs)
+  | (True, t', addAnns, xs') <- pBangTy (L l t) xs
+  = Just (t', addAnns, xs')
+pInfixSide (el:xs1)
+  | Just t1 <- pLHsTypeArg el
+  = go [t1] xs1
+   where
+     go :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
+        -> [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])
+     go acc (el:xs)
+       | Just t <- pLHsTypeArg el
+       = go (t:acc) xs
+     go acc xs = case mergeOpsAcc acc of
+       Left _ -> Nothing
+       Right acc' -> Just (acc', pure (), xs)
+pInfixSide _ = Nothing
+
+pLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (LHsKind GhcPs))
+pLHsTypeArg (L l (TyElOpd a)) = Just (HsValArg (L l a))
+pLHsTypeArg (L _ (TyElKindApp l a)) = Just (HsTypeArg l a)
+pLHsTypeArg _ = Nothing
+
+pDocPrev :: [Located TyEl] -> (Maybe LHsDocString, [Located TyEl])
+pDocPrev = go Nothing
+  where
+    go mTrailingDoc ((L l (TyElDocPrev doc)):xs) =
+      go (mTrailingDoc `mplus` Just (L l doc)) xs
+    go mTrailingDoc xs = (mTrailingDoc, xs)
+
+orErr :: Maybe a -> b -> Either b a
+orErr (Just a) _ = Right a
+orErr Nothing b = Left b
+
+-- | Merge a /reversed/ and /non-empty/ soup of operators and operands
+--   into a data constructor.
+--
+-- User input: @C !A B -- ^ doc@
+-- Input to 'mergeDataCon': ["doc", B, !A, C]
+-- Output: (C, PrefixCon [!A, B], "doc")
+--
+-- See Note [Parsing data constructors is hard]
+mergeDataCon
+      :: [Located TyEl]
+      -> P ( Located RdrName         -- constructor name
+           , HsConDeclDetails GhcPs  -- constructor field information
+           , Maybe LHsDocString      -- docstring to go on the constructor
+           )
+mergeDataCon all_xs =
+  do { (addAnns, a) <- eitherToP res
+     ; addAnns
+     ; return a }
+  where
+    -- We start by splitting off the trailing documentation comment,
+    -- if any exists.
+    (mTrailingDoc, all_xs') = pDocPrev all_xs
+
+    -- Determine whether the trailing documentation comment exists and is the
+    -- only docstring in this constructor declaration.
+    --
+    -- When true, it means that it applies to the constructor itself:
+    --    data T = C
+    --             A
+    --             B -- ^ Comment on C (singleDoc == True)
+    --
+    -- When false, it means that it applies to the last field:
+    --    data T = C -- ^ Comment on C
+    --             A -- ^ Comment on A
+    --             B -- ^ Comment on B (singleDoc == False)
+    singleDoc = isJust mTrailingDoc &&
+                null [ () | (L _ (TyElDocPrev _)) <- all_xs' ]
+
+    -- The result of merging the list of reversed TyEl into a
+    -- data constructor, along with [AddAnn].
+    res = goFirst all_xs'
+
+    -- Take the trailing docstring into account when interpreting
+    -- the docstring near the constructor.
+    --
+    --    data T = C -- ^ docstring right after C
+    --             A
+    --             B -- ^ trailing docstring
+    --
+    -- 'mkConDoc' must be applied to the docstring right after C, so that it
+    -- falls back to the trailing docstring when appropriate (see singleDoc).
+    mkConDoc mDoc | singleDoc = mDoc `mplus` mTrailingDoc
+                  | otherwise = mDoc
+
+    -- The docstring for the last field of a data constructor.
+    trailingFieldDoc | singleDoc = Nothing
+                     | otherwise = mTrailingDoc
+
+    goFirst [ L l (TyElOpd (HsTyVar _ _ (L _ tc))) ]
+      = do { data_con <- tyConToDataCon l tc
+           ; return (pure (), (data_con, PrefixCon [], mTrailingDoc)) }
+    goFirst ((L l (TyElOpd (HsRecTy _ fields))):xs)
+      | (mConDoc, xs') <- pDocPrev xs
+      , [ L l' (TyElOpd (HsTyVar _ _ (L _ tc))) ] <- xs'
+      = do { data_con <- tyConToDataCon l' tc
+           ; let mDoc = mTrailingDoc `mplus` mConDoc
+           ; return (pure (), (data_con, RecCon (L l fields), mDoc)) }
+    goFirst [L l (TyElOpd (HsTupleTy _ HsBoxedOrConstraintTuple ts))]
+      = return ( pure ()
+               , ( L l (getRdrName (tupleDataCon Boxed (length ts)))
+                 , PrefixCon ts
+                 , mTrailingDoc ) )
+    goFirst ((L l (TyElOpd t)):xs)
+      | (_, t', addAnns, xs') <- pBangTy (L l t) xs
+      = go addAnns Nothing [mkLHsDocTyMaybe t' trailingFieldDoc] xs'
+    goFirst (L l (TyElKindApp _ _):_)
+      = goInfix Monoid.<> Left (l, kindAppErr)
+    goFirst xs
+      = go (pure ()) mTrailingDoc [] xs
+
+    go addAnns mLastDoc ts [ L l (TyElOpd (HsTyVar _ _ (L _ tc))) ]
+      = do { data_con <- tyConToDataCon l tc
+           ; return (addAnns, (data_con, PrefixCon ts, mkConDoc mLastDoc)) }
+    go addAnns mLastDoc ts ((L l (TyElDocPrev doc)):xs) =
+      go addAnns (mLastDoc `mplus` Just (L l doc)) ts xs
+    go addAnns mLastDoc ts ((L l (TyElOpd t)):xs)
+      | (_, t', addAnns', xs') <- pBangTy (L l t) xs
+      , t'' <- mkLHsDocTyMaybe t' mLastDoc
+      = go (addAnns >> addAnns') Nothing (t'':ts) xs'
+    go _ _ _ ((L _ (TyElOpr _)):_) =
+      -- Encountered an operator: backtrack to the beginning and attempt
+      -- to parse as an infix definition.
+      goInfix
+    go _ _ _ (L l (TyElKindApp _ _):_) =  goInfix Monoid.<> Left (l, kindAppErr)
+    go _ _ _ _ = Left malformedErr
+      where
+        malformedErr =
+          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')
+          , text "Cannot parse data constructor" <+>
+            text "in a data/newtype declaration:" $$
+            nest 2 (hsep . reverse $ map ppr all_xs'))
+
+    goInfix =
+      do { let xs0 = all_xs'
+         ; (rhs_t, rhs_addAnns, xs1) <- pInfixSide xs0 `orErr` malformedErr
+         ; let (mOpDoc, xs2) = pDocPrev xs1
+         ; (op, xs3) <- case xs2 of
+              (L l (TyElOpr op)) : xs3 ->
+                do { data_con <- tyConToDataCon l op
+                   ; return (data_con, xs3) }
+              _ -> Left malformedErr
+         ; let (mLhsDoc, xs4) = pDocPrev xs3
+         ; (lhs_t, lhs_addAnns, xs5) <- pInfixSide xs4 `orErr` malformedErr
+         ; unless (null xs5) (Left malformedErr)
+         ; let rhs = mkLHsDocTyMaybe rhs_t trailingFieldDoc
+               lhs = mkLHsDocTyMaybe lhs_t mLhsDoc
+               addAnns = lhs_addAnns >> rhs_addAnns
+         ; return (addAnns, (op, InfixCon lhs rhs, mkConDoc mOpDoc)) }
+      where
+        malformedErr =
+          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')
+          , text "Cannot parse an infix data constructor" <+>
+            text "in a data/newtype declaration:" $$
+            nest 2 (hsep . reverse $ map ppr all_xs'))
+
+    kindAppErr =
+      text "Unexpected kind application" <+>
+      text "in a data/newtype declaration:" $$
+      nest 2 (hsep . reverse $ map ppr all_xs')
+
+---------------------------------------------------------------------------
+-- | Check for monad comprehensions
+--
+-- If the flag MonadComprehensions is set, return a 'MonadComp' context,
+-- otherwise use the usual 'ListComp' context
+
+checkMonadComp :: PV (HsStmtContext GhcRn)
+checkMonadComp = do
+    monadComprehensions <- getBit MonadComprehensionsBit
+    return $ if monadComprehensions
+                then MonadComp
+                else ListComp
+
+-- -------------------------------------------------------------------------
+-- Expression/command/pattern ambiguity.
+-- See Note [Ambiguous syntactic categories]
+--
+
+-- See Note [Parser-Validator]
+-- See Note [Ambiguous syntactic categories]
+--
+-- This newtype is required to avoid impredicative types in monadic
+-- productions. That is, in a production that looks like
+--
+--    | ... {% return (ECP ...) }
+--
+-- we are dealing with
+--    P ECP
+-- whereas without a newtype we would be dealing with
+--    P (forall b. DisambECP b => PV (Located b))
+--
+newtype ECP =
+  ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) }
+
+runECP_P :: DisambECP b => ECP -> P (Located b)
+runECP_P p = runPV (runECP_PV p)
+
+ecpFromExp :: LHsExpr GhcPs -> ECP
+ecpFromExp a = ECP (ecpFromExp' a)
+
+ecpFromCmd :: LHsCmd GhcPs -> ECP
+ecpFromCmd a = ECP (ecpFromCmd' a)
+
+-- | Disambiguate infix operators.
+-- See Note [Ambiguous syntactic categories]
+class DisambInfixOp b where
+  mkHsVarOpPV :: Located RdrName -> PV (Located b)
+  mkHsConOpPV :: Located RdrName -> PV (Located b)
+  mkHsInfixHolePV :: SrcSpan -> PV (Located b)
+
+instance DisambInfixOp (HsExpr GhcPs) where
+  mkHsVarOpPV v = return $ L (getLoc v) (HsVar noExtField v)
+  mkHsConOpPV v = return $ L (getLoc v) (HsVar noExtField v)
+  mkHsInfixHolePV l = return $ L l hsHoleExpr
+
+instance DisambInfixOp RdrName where
+  mkHsConOpPV (L l v) = return $ L l v
+  mkHsVarOpPV (L l v) = return $ L l v
+  mkHsInfixHolePV l =
+    addFatalError l $ text "Invalid infix hole, expected an infix operator"
+
+-- | Disambiguate constructs that may appear when we do not know ahead of time whether we are
+-- parsing an expression, a command, or a pattern.
+-- See Note [Ambiguous syntactic categories]
+class b ~ (Body b) GhcPs => DisambECP b where
+  -- | See Note [Body in DisambECP]
+  type Body b :: Type -> Type
+  -- | Return a command without ambiguity, or fail in a non-command context.
+  ecpFromCmd' :: LHsCmd GhcPs -> PV (Located b)
+  -- | Return an expression without ambiguity, or fail in a non-expression context.
+  ecpFromExp' :: LHsExpr GhcPs -> PV (Located b)
+  -- | Disambiguate "\... -> ..." (lambda)
+  mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
+  -- | Disambiguate "let ... in ..."
+  mkHsLetPV :: SrcSpan -> LHsLocalBinds GhcPs -> Located b -> PV (Located b)
+  -- | Infix operator representation
+  type InfixOp b
+  -- | Bring superclass constraints on InfixOp into scope.
+  -- See Note [UndecidableSuperClasses for associated types]
+  superInfixOp :: (DisambInfixOp (InfixOp b) => PV (Located b )) -> PV (Located b)
+  -- | Disambiguate "f # x" (infix operator)
+  mkHsOpAppPV :: SrcSpan -> Located b -> Located (InfixOp b) -> Located b -> PV (Located b)
+  -- | Disambiguate "case ... of ..."
+  mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> MatchGroup GhcPs (Located b) -> PV (Located b)
+  -- | Function argument representation
+  type FunArg b
+  -- | Bring superclass constraints on FunArg into scope.
+  -- See Note [UndecidableSuperClasses for associated types]
+  superFunArg :: (DisambECP (FunArg b) => PV (Located b)) -> PV (Located b)
+  -- | Disambiguate "f x" (function application)
+  mkHsAppPV :: SrcSpan -> Located b -> Located (FunArg b) -> PV (Located b)
+  -- | Disambiguate "if ... then ... else ..."
+  mkHsIfPV :: SrcSpan
+         -> LHsExpr GhcPs
+         -> Bool  -- semicolon?
+         -> Located b
+         -> Bool  -- semicolon?
+         -> Located b
+         -> PV (Located b)
+  -- | Disambiguate "do { ... }" (do notation)
+  mkHsDoPV :: SrcSpan -> Located [LStmt GhcPs (Located b)] -> PV (Located b)
+  -- | Disambiguate "( ... )" (parentheses)
+  mkHsParPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate a variable "f" or a data constructor "MkF".
+  mkHsVarPV :: Located RdrName -> PV (Located b)
+  -- | Disambiguate a monomorphic literal
+  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located b)
+  -- | Disambiguate an overloaded literal
+  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located b)
+  -- | Disambiguate a wildcard
+  mkHsWildCardPV :: SrcSpan -> PV (Located b)
+  -- | Disambiguate "a :: t" (type annotation)
+  mkHsTySigPV :: SrcSpan -> Located b -> LHsType GhcPs -> PV (Located b)
+  -- | Disambiguate "[a,b,c]" (list syntax)
+  mkHsExplicitListPV :: SrcSpan -> [Located b] -> PV (Located b)
+  -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices)
+  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located b)
+  -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)
+  mkHsRecordPV ::
+    SrcSpan ->
+    SrcSpan ->
+    Located b ->
+    ([LHsRecField GhcPs (Located b)], Maybe SrcSpan) ->
+    PV (Located b)
+  -- | Disambiguate "-a" (negation)
+  mkHsNegAppPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate "(# a)" (right operator section)
+  mkHsSectionR_PV :: SrcSpan -> Located (InfixOp b) -> Located b -> PV (Located b)
+  -- | Disambiguate "(a -> b)" (view pattern)
+  mkHsViewPatPV :: SrcSpan -> LHsExpr GhcPs -> Located b -> PV (Located b)
+  -- | Disambiguate "a@b" (as-pattern)
+  mkHsAsPatPV :: SrcSpan -> Located RdrName -> Located b -> PV (Located b)
+  -- | Disambiguate "~a" (lazy pattern)
+  mkHsLazyPatPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate "!a" (bang pattern)
+  mkHsBangPatPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate tuple sections and unboxed sums
+  mkSumOrTuplePV :: SrcSpan -> Boxity -> SumOrTuple b -> PV (Located b)
+  -- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas
+  rejectPragmaPV :: Located b -> PV ()
+
+
+{- Note [UndecidableSuperClasses for associated types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+(This Note is about the code in GHC, not about the user code that we are parsing)
+
+Assume we have a class C with an associated type T:
+
+  class C a where
+    type T a
+    ...
+
+If we want to add 'C (T a)' as a superclass, we need -XUndecidableSuperClasses:
+
+  {-# LANGUAGE UndecidableSuperClasses #-}
+  class C (T a) => C a where
+    type T a
+    ...
+
+Unfortunately, -XUndecidableSuperClasses don't work all that well, sometimes
+making GHC loop. The workaround is to bring this constraint into scope
+manually with a helper method:
+
+  class C a where
+    type T a
+    superT :: (C (T a) => r) -> r
+
+In order to avoid ambiguous types, 'r' must mention 'a'.
+
+For consistency, we use this approach for all constraints on associated types,
+even when -XUndecidableSuperClasses are not required.
+-}
+
+{- Note [Body in DisambECP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are helper functions (mkBodyStmt, mkBindStmt, unguardedRHS, etc) that
+require their argument to take a form of (body GhcPs) for some (body :: Type ->
+*). To satisfy this requirement, we say that (b ~ Body b GhcPs) in the
+superclass constraints of DisambECP.
+
+The alternative is to change mkBodyStmt, mkBindStmt, unguardedRHS, etc, to drop
+this requirement. It is possible and would allow removing the type index of
+PatBuilder, but leads to worse type inference, breaking some code in the
+typechecker.
+-}
+
+instance DisambECP (HsCmd GhcPs) where
+  type Body (HsCmd GhcPs) = HsCmd
+  ecpFromCmd' = return
+  ecpFromExp' (L l e) = cmdFail l (ppr e)
+  mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg)
+  mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e)
+  type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
+  superInfixOp m = m
+  mkHsOpAppPV l c1 op c2 = do
+    let cmdArg c = L (getLoc c) $ HsCmdTop noExtField c
+    return $ L l $ HsCmdArrForm noExtField op Infix Nothing [cmdArg c1, cmdArg c2]
+  mkHsCasePV l c mg = return $ L l (HsCmdCase noExtField c mg)
+  type FunArg (HsCmd GhcPs) = HsExpr GhcPs
+  superFunArg m = m
+  mkHsAppPV l c e = do
+    checkCmdBlockArguments c
+    checkExpBlockArguments e
+    return $ L l (HsCmdApp noExtField c e)
+  mkHsIfPV l c semi1 a semi2 b = do
+    checkDoAndIfThenElse c semi1 a semi2 b
+    return $ L l (mkHsCmdIf c a b)
+  mkHsDoPV l stmts = return $ L l (HsCmdDo noExtField stmts)
+  mkHsParPV l c = return $ L l (HsCmdPar noExtField c)
+  mkHsVarPV (L l v) = cmdFail l (ppr v)
+  mkHsLitPV (L l a) = cmdFail l (ppr a)
+  mkHsOverLitPV (L l a) = cmdFail l (ppr a)
+  mkHsWildCardPV l = cmdFail l (text "_")
+  mkHsTySigPV l a sig = cmdFail l (ppr a <+> text "::" <+> ppr sig)
+  mkHsExplicitListPV l xs = cmdFail l $
+    brackets (fsep (punctuate comma (map ppr xs)))
+  mkHsSplicePV (L l sp) = cmdFail l (ppr sp)
+  mkHsRecordPV l _ a (fbinds, ddLoc) = cmdFail l $
+    ppr a <+> ppr (mk_rec_fields fbinds ddLoc)
+  mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a)
+  mkHsSectionR_PV l op c = cmdFail l $
+    let pp_op = fromMaybe (panic "cannot print infix operator")
+                          (ppr_infix_expr (unLoc op))
+    in pp_op <> ppr c
+  mkHsViewPatPV l a b = cmdFail l $
+    ppr a <+> text "->" <+> ppr b
+  mkHsAsPatPV l v c = cmdFail l $
+    pprPrefixOcc (unLoc v) <> text "@" <> ppr c
+  mkHsLazyPatPV l c = cmdFail l $
+    text "~" <> ppr c
+  mkHsBangPatPV l c = cmdFail l $
+    text "!" <> ppr c
+  mkSumOrTuplePV l boxity a = cmdFail l (pprSumOrTuple boxity a)
+  rejectPragmaPV _ = return ()
+
+cmdFail :: SrcSpan -> SDoc -> PV a
+cmdFail loc e = addFatalError loc $
+  hang (text "Parse error in command:") 2 (ppr e)
+
+instance DisambECP (HsExpr GhcPs) where
+  type Body (HsExpr GhcPs) = HsExpr
+  ecpFromCmd' (L l c) = do
+    addError l $ vcat
+      [ text "Arrow command found where an expression was expected:",
+        nest 2 (ppr c) ]
+    return (L l hsHoleExpr)
+  ecpFromExp' = return
+  mkHsLamPV l mg = return $ L l (HsLam noExtField mg)
+  mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c)
+  type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
+  superInfixOp m = m
+  mkHsOpAppPV l e1 op e2 = do
+    return $ L l $ OpApp noExtField e1 op e2
+  mkHsCasePV l e mg = return $ L l (HsCase noExtField e mg)
+  type FunArg (HsExpr GhcPs) = HsExpr GhcPs
+  superFunArg m = m
+  mkHsAppPV l e1 e2 = do
+    checkExpBlockArguments e1
+    checkExpBlockArguments e2
+    return $ L l (HsApp noExtField e1 e2)
+  mkHsIfPV l c semi1 a semi2 b = do
+    checkDoAndIfThenElse c semi1 a semi2 b
+    return $ L l (mkHsIf c a b)
+  mkHsDoPV l stmts = return $ L l (HsDo noExtField DoExpr stmts)
+  mkHsParPV l e = return $ L l (HsPar noExtField e)
+  mkHsVarPV v@(getLoc -> l) = return $ L l (HsVar noExtField v)
+  mkHsLitPV (L l a) = return $ L l (HsLit noExtField a)
+  mkHsOverLitPV (L l a) = return $ L l (HsOverLit noExtField a)
+  mkHsWildCardPV l = return $ L l hsHoleExpr
+  mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (mkLHsSigWcType sig))
+  mkHsExplicitListPV l xs = return $ L l (ExplicitList noExtField Nothing xs)
+  mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp
+  mkHsRecordPV l lrec a (fbinds, ddLoc) = do
+    r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)
+    checkRecordSyntax (L l r)
+  mkHsNegAppPV l a = return $ L l (NegApp noExtField a noSyntaxExpr)
+  mkHsSectionR_PV l op e = return $ L l (SectionR noExtField op e)
+  mkHsViewPatPV l a b = patSynErr "View pattern" l (ppr a <+> text "->" <+> ppr b) empty
+  mkHsAsPatPV l v e =
+    patSynErr "@-pattern" l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) $
+    text "Type application syntax requires a space before '@'"
+  mkHsLazyPatPV l e = patSynErr "Lazy pattern" l (text "~" <> ppr e) $
+    text "Did you mean to add a space after the '~'?"
+  mkHsBangPatPV l e = patSynErr "Bang pattern" l (text "!" <> ppr e) $
+    text "Did you mean to add a space after the '!'?"
+  mkSumOrTuplePV = mkSumOrTupleExpr
+  rejectPragmaPV (L _ (OpApp _ _ _ e)) =
+    -- assuming left-associative parsing of operators
+    rejectPragmaPV e
+  rejectPragmaPV (L l (HsPragE _ prag _)) =
+    addError l $
+      hang (text "A pragma is not allowed in this position:") 2 (ppr prag)
+  rejectPragmaPV _ = return ()
+
+patSynErr :: String -> SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
+patSynErr item l e explanation =
+  do { addError l $
+        sep [text item <+> text "in expression context:",
+             nest 4 (ppr e)] $$
+        explanation
+     ; return (L l hsHoleExpr) }
+
+hsHoleExpr :: HsExpr (GhcPass id)
+hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
+
+-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
+data PatBuilder p
+  = PatBuilderPat (Pat p)
+  | PatBuilderPar (Located (PatBuilder p))
+  | PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
+  | PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
+  | PatBuilderVar (Located RdrName)
+  | PatBuilderOverLit (HsOverLit GhcPs)
+
+instance Outputable (PatBuilder GhcPs) where
+  ppr (PatBuilderPat p) = ppr p
+  ppr (PatBuilderPar (L _ p)) = parens (ppr p)
+  ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
+  ppr (PatBuilderOpApp (L _ p1) op (L _ p2)) = ppr p1 <+> ppr op <+> ppr p2
+  ppr (PatBuilderVar v) = ppr v
+  ppr (PatBuilderOverLit l) = ppr l
+
+instance DisambECP (PatBuilder GhcPs) where
+  type Body (PatBuilder GhcPs) = PatBuilder
+  ecpFromCmd' (L l c) =
+    addFatalError l $
+      text "Command syntax in pattern:" <+> ppr c
+  ecpFromExp' (L l e) =
+    addFatalError l $
+      text "Expression syntax in pattern:" <+> ppr e
+  mkHsLamPV l _ = addFatalError l $
+    text "Lambda-syntax in pattern." $$
+    text "Pattern matching on functions is not possible."
+  mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
+  type InfixOp (PatBuilder GhcPs) = RdrName
+  superInfixOp m = m
+  mkHsOpAppPV l p1 op p2 = return $ L l $ PatBuilderOpApp p1 op p2
+  mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
+  type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
+  superFunArg m = m
+  mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2)
+  mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern"
+  mkHsDoPV l _ = addFatalError l $ text "do-notation in pattern"
+  mkHsParPV l p = return $ L l (PatBuilderPar p)
+  mkHsVarPV v@(getLoc -> l) = return $ L l (PatBuilderVar v)
+  mkHsLitPV lit@(L l a) = do
+    checkUnboxedStringLitPat lit
+    return $ L l (PatBuilderPat (LitPat noExtField a))
+  mkHsOverLitPV (L l a) = return $ L l (PatBuilderOverLit a)
+  mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
+  mkHsTySigPV l b sig = do
+    p <- checkLPat b
+    return $ L l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
+  mkHsExplicitListPV l xs = do
+    ps <- traverse checkLPat xs
+    return (L l (PatBuilderPat (ListPat noExtField ps)))
+  mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp))
+  mkHsRecordPV l _ a (fbinds, ddLoc) = do
+    r <- mkPatRec a (mk_rec_fields fbinds ddLoc)
+    checkRecordSyntax (L l r)
+  mkHsNegAppPV l (L lp p) = do
+    lit <- case p of
+      PatBuilderOverLit pos_lit -> return (L lp pos_lit)
+      _ -> patFail l (text "-" <> ppr p)
+    return $ L l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
+  mkHsSectionR_PV l op p = patFail l (pprInfixOcc (unLoc op) <> ppr p)
+  mkHsViewPatPV l a b = do
+    p <- checkLPat b
+    return $ L l (PatBuilderPat (ViewPat noExtField a p))
+  mkHsAsPatPV l v e = do
+    p <- checkLPat e
+    return $ L l (PatBuilderPat (AsPat noExtField v p))
+  mkHsLazyPatPV l e = do
+    p <- checkLPat e
+    return $ L l (PatBuilderPat (LazyPat noExtField p))
+  mkHsBangPatPV l e = do
+    p <- checkLPat e
+    let pb = BangPat noExtField p
+    hintBangPat l pb
+    return $ L l (PatBuilderPat pb)
+  mkSumOrTuplePV = mkSumOrTuplePat
+  rejectPragmaPV _ = return ()
+
+checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
+checkUnboxedStringLitPat (L loc lit) =
+  case lit of
+    HsStringPrim _ _  -- Trac #13260
+      -> addFatalError loc (text "Illegal unboxed string literal in pattern:" $$ ppr lit)
+    _ -> return ()
+
+mkPatRec ::
+  Located (PatBuilder GhcPs) ->
+  HsRecFields GhcPs (Located (PatBuilder GhcPs)) ->
+  PV (PatBuilder GhcPs)
+mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
+  | isRdrDataCon (unLoc c)
+  = do fs <- mapM checkPatField fs
+       return (PatBuilderPat (ConPatIn c (RecCon (HsRecFields fs dd))))
+mkPatRec p _ =
+  addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
+
+{- Note [Ambiguous syntactic categories]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are places in the grammar where we do not know whether we are parsing an
+expression or a pattern without unlimited lookahead (which we do not have in
+'happy'):
+
+View patterns:
+
+    f (Con a b     ) = ...  -- 'Con a b' is a pattern
+    f (Con a b -> x) = ...  -- 'Con a b' is an expression
+
+do-notation:
+
+    do { Con a b <- x } -- 'Con a b' is a pattern
+    do { Con a b }      -- 'Con a b' is an expression
+
+Guards:
+
+    x | True <- p && q = ...  -- 'True' is a pattern
+    x | True           = ...  -- 'True' is an expression
+
+Top-level value/function declarations (FunBind/PatBind):
+
+    f ! a         -- TH splice
+    f ! a = ...   -- function declaration
+
+    Until we encounter the = sign, we don't know if it's a top-level
+    TemplateHaskell splice where ! is used, or if it's a function declaration
+    where ! is bound.
+
+There are also places in the grammar where we do not know whether we are
+parsing an expression or a command:
+
+    proc x -> do { (stuff) -< x }   -- 'stuff' is an expression
+    proc x -> do { (stuff) }        -- 'stuff' is a command
+
+    Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff'
+    as an expression or a command.
+
+In fact, do-notation is subject to both ambiguities:
+
+    proc x -> do { (stuff) -< x }        -- 'stuff' is an expression
+    proc x -> do { (stuff) <- f -< x }   -- 'stuff' is a pattern
+    proc x -> do { (stuff) }             -- 'stuff' is a command
+
+There are many possible solutions to this problem. For an overview of the ones
+we decided against, see Note [Resolving parsing ambiguities: non-taken alternatives]
+
+The solution that keeps basic definitions (such as HsExpr) clean, keeps the
+concerns local to the parser, and does not require duplication of hsSyn types,
+or an extra pass over the entire AST, is to parse into an overloaded
+parser-validator (a so-called tagless final encoding):
+
+    class DisambECP b where ...
+    instance DisambECP (HsCmd GhcPs) where ...
+    instance DisambECP (HsExp GhcPs) where ...
+    instance DisambECP (PatBuilder GhcPs) where ...
+
+The 'DisambECP' class contains functions to build and validate 'b'. For example,
+to add parentheses we have:
+
+  mkHsParPV :: DisambECP b => SrcSpan -> Located b -> PV (Located b)
+
+'mkHsParPV' will wrap the inner value in HsCmdPar for commands, HsPar for
+expressions, and 'PatBuilderPar' for patterns (later transformed into ParPat,
+see Note [PatBuilder]).
+
+Consider the 'alts' production used to parse case-of alternatives:
+
+  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
+    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+We abstract over LHsExpr GhcPs, and it becomes:
+
+  alts :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
+    : alts1     { $1 >>= \ $1 ->
+                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts  { $2 >>= \ $2 ->
+                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+Compared to the initial definition, the added bits are:
+
+    forall b. DisambECP b => PV ( ... ) -- in the type signature
+    $1 >>= \ $1 -> return $             -- in one reduction rule
+    $2 >>= \ $2 -> return $             -- in another reduction rule
+
+The overhead is constant relative to the size of the rest of the reduction
+rule, so this approach scales well to large parser productions.
+
+Note that we write ($1 >>= \ $1 -> ...), so the second $1 is in a binding
+position and shadows the previous $1. We can do this because internally
+'happy' desugars $n to happy_var_n, and the rationale behind this idiom
+is to be able to write (sLL $1 $>) later on. The alternative would be to
+write this as ($1 >>= \ fresh_name -> ...), but then we couldn't refer
+to the last fresh name as $>.
+-}
+
+
+{- Note [Resolving parsing ambiguities: non-taken alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Alternative I, extra constructors in GHC.Hs.Expr
+------------------------------------------------
+We could add extra constructors to HsExpr to represent command-specific and
+pattern-specific syntactic constructs. Under this scheme, we parse patterns
+and commands as expressions and rejig later.  This is what GHC used to do, and
+it polluted 'HsExpr' with irrelevant constructors:
+
+  * for commands: 'HsArrForm', 'HsArrApp'
+  * for patterns: 'EWildPat', 'EAsPat', 'EViewPat', 'ELazyPat'
+
+(As of now, we still do that for patterns, but we plan to fix it).
+
+There are several issues with this:
+
+  * The implementation details of parsing are leaking into hsSyn definitions.
+
+  * Code that uses HsExpr has to panic on these impossible-after-parsing cases.
+
+  * HsExpr is arbitrarily selected as the extension basis. Why not extend
+    HsCmd or HsPat with extra constructors instead?
+
+Alternative II, extra constructors in GHC.Hs.Expr for GhcPs
+-----------------------------------------------------------
+We could address some of the problems with Alternative I by using Trees That
+Grow and extending HsExpr only in the GhcPs pass. However, GhcPs corresponds to
+the output of parsing, not to its intermediate results, so we wouldn't want
+them there either.
+
+Alternative III, extra constructors in GHC.Hs.Expr for GhcPrePs
+---------------------------------------------------------------
+We could introduce a new pass, GhcPrePs, to keep GhcPs pristine.
+Unfortunately, creating a new pass would significantly bloat conversion code
+and slow down the compiler by adding another linear-time pass over the entire
+AST. For example, in order to build HsExpr GhcPrePs, we would need to build
+HsLocalBinds GhcPrePs (as part of HsLet), and we never want HsLocalBinds
+GhcPrePs.
+
+
+Alternative IV, sum type and bottom-up data flow
+------------------------------------------------
+Expressions and commands are disjoint. There are no user inputs that could be
+interpreted as either an expression or a command depending on outer context:
+
+  5        -- definitely an expression
+  x -< y   -- definitely a command
+
+Even though we have both 'HsLam' and 'HsCmdLam', we can look at
+the body to disambiguate:
+
+  \p -> 5        -- definitely an expression
+  \p -> x -< y   -- definitely a command
+
+This means we could use a bottom-up flow of information to determine
+whether we are parsing an expression or a command, using a sum type
+for intermediate results:
+
+  Either (LHsExpr GhcPs) (LHsCmd GhcPs)
+
+There are two problems with this:
+
+  * We cannot handle the ambiguity between expressions and
+    patterns, which are not disjoint.
+
+  * Bottom-up flow of information leads to poor error messages. Consider
+
+        if ... then 5 else (x -< y)
+
+    Do we report that '5' is not a valid command or that (x -< y) is not a
+    valid expression?  It depends on whether we want the entire node to be
+    'HsIf' or 'HsCmdIf', and this information flows top-down, from the
+    surrounding parsing context (are we in 'proc'?)
+
+Alternative V, backtracking with parser combinators
+---------------------------------------------------
+One might think we could sidestep the issue entirely by using a backtracking
+parser and doing something along the lines of (try pExpr <|> pPat).
+
+Turns out, this wouldn't work very well, as there can be patterns inside
+expressions (e.g. via 'case', 'let', 'do') and expressions inside patterns
+(e.g. view patterns). To handle this, we would need to backtrack while
+backtracking, and unbound levels of backtracking lead to very fragile
+performance.
+
+Alternative VI, an intermediate data type
+-----------------------------------------
+There are common syntactic elements of expressions, commands, and patterns
+(e.g. all of them must have balanced parentheses), and we can capture this
+common structure in an intermediate data type, Frame:
+
+data Frame
+  = FrameVar RdrName
+    -- ^ Identifier: Just, map, BS.length
+  | FrameTuple [LTupArgFrame] Boxity
+    -- ^ Tuple (section): (a,b) (a,b,c) (a,,) (,a,)
+  | FrameTySig LFrame (LHsSigWcType GhcPs)
+    -- ^ Type signature: x :: ty
+  | FramePar (SrcSpan, SrcSpan) LFrame
+    -- ^ Parentheses
+  | FrameIf LFrame LFrame LFrame
+    -- ^ If-expression: if p then x else y
+  | FrameCase LFrame [LFrameMatch]
+    -- ^ Case-expression: case x of { p1 -> e1; p2 -> e2 }
+  | FrameDo (HsStmtContext GhcRn) [LFrameStmt]
+    -- ^ Do-expression: do { s1; a <- s2; s3 }
+  ...
+  | FrameExpr (HsExpr GhcPs)   -- unambiguously an expression
+  | FramePat (HsPat GhcPs)     -- unambiguously a pattern
+  | FrameCommand (HsCmd GhcPs) -- unambiguously a command
+
+To determine which constructors 'Frame' needs to have, we take the union of
+intersections between HsExpr, HsCmd, and HsPat.
+
+The intersection between HsPat and HsExpr:
+
+  HsPat  =  VarPat   | TuplePat      | SigPat        | ParPat   | ...
+  HsExpr =  HsVar    | ExplicitTuple | ExprWithTySig | HsPar    | ...
+  -------------------------------------------------------------------
+  Frame  =  FrameVar | FrameTuple    | FrameTySig    | FramePar | ...
+
+The intersection between HsCmd and HsExpr:
+
+  HsCmd  = HsCmdIf | HsCmdCase | HsCmdDo | HsCmdPar
+  HsExpr = HsIf    | HsCase    | HsDo    | HsPar
+  ------------------------------------------------
+  Frame = FrameIf  | FrameCase | FrameDo | FramePar
+
+The intersection between HsCmd and HsPat:
+
+  HsPat  = ParPat   | ...
+  HsCmd  = HsCmdPar | ...
+  -----------------------
+  Frame  = FramePar | ...
+
+Take the union of each intersection and this yields the final 'Frame' data
+type. The problem with this approach is that we end up duplicating a good
+portion of hsSyn:
+
+    Frame         for  HsExpr, HsPat, HsCmd
+    TupArgFrame   for  HsTupArg
+    FrameMatch    for  Match
+    FrameStmt     for  StmtLR
+    FrameGRHS     for  GRHS
+    FrameGRHSs    for  GRHSs
+    ...
+
+Alternative VII, a product type
+-------------------------------
+We could avoid the intermediate representation of Alternative VI by parsing
+into a product of interpretations directly:
+
+    -- See Note [Parser-Validator]
+    type ExpCmdPat = ( PV (LHsExpr GhcPs)
+                     , PV (LHsCmd GhcPs)
+                     , PV (LHsPat GhcPs) )
+
+This means that in positions where we do not know whether to produce
+expression, a pattern, or a command, we instead produce a parser-validator for
+each possible option.
+
+Then, as soon as we have parsed far enough to resolve the ambiguity, we pick
+the appropriate component of the product, discarding the rest:
+
+    checkExpOf3 (e, _, _) = e  -- interpret as an expression
+    checkCmdOf3 (_, c, _) = c  -- interpret as a command
+    checkPatOf3 (_, _, p) = p  -- interpret as a pattern
+
+We can easily define ambiguities between arbitrary subsets of interpretations.
+For example, when we know ahead of type that only an expression or a command is
+possible, but not a pattern, we can use a smaller type:
+
+    -- See Note [Parser-Validator]
+    type ExpCmd = (PV (LHsExpr GhcPs), PV (LHsCmd GhcPs))
+
+    checkExpOf2 (e, _) = e  -- interpret as an expression
+    checkCmdOf2 (_, c) = c  -- interpret as a command
+
+However, there is a slight problem with this approach, namely code duplication
+in parser productions. Consider the 'alts' production used to parse case-of
+alternatives:
+
+  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
+    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+Under the new scheme, we have to completely duplicate its type signature and
+each reduction rule:
+
+  alts :: { ( PV (Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression
+            , PV (Located ([AddAnn],[LMatch GhcPs (LHsCmd GhcPs)]))  -- as a command
+            ) }
+    : alts1
+        { ( checkExpOf2 $1 >>= \ $1 ->
+            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)
+          , checkCmdOf2 $1 >>= \ $1 ->
+            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)
+          ) }
+    | ';' alts
+        { ( checkExpOf2 $2 >>= \ $2 ->
+            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)
+          , checkCmdOf2 $2 >>= \ $2 ->
+            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)
+          ) }
+
+And the same goes for other productions: 'altslist', 'alts1', 'alt', 'alt_rhs',
+'ralt', 'gdpats', 'gdpat', 'exp', ... and so on. That is a lot of code!
+
+Alternative VIII, a function from a GADT
+----------------------------------------
+We could avoid code duplication of the Alternative VII by representing the product
+as a function from a GADT:
+
+    data ExpCmdG b where
+      ExpG :: ExpCmdG HsExpr
+      CmdG :: ExpCmdG HsCmd
+
+    type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs))
+
+    checkExp :: ExpCmd -> PV (LHsExpr GhcPs)
+    checkCmd :: ExpCmd -> PV (LHsCmd GhcPs)
+    checkExp f = f ExpG  -- interpret as an expression
+    checkCmd f = f CmdG  -- interpret as a command
+
+Consider the 'alts' production used to parse case-of alternatives:
+
+  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
+    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+We abstract over LHsExpr, and it becomes:
+
+  alts :: { forall b. ExpCmdG b -> PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+    : alts1
+        { \tag -> $1 tag >>= \ $1 ->
+                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts
+        { \tag -> $2 tag >>= \ $2 ->
+                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+Note that 'ExpCmdG' is a singleton type, the value is completely
+determined by the type:
+
+  when (b~HsExpr),  tag = ExpG
+  when (b~HsCmd),   tag = CmdG
+
+This is a clear indication that we can use a class to pass this value behind
+the scenes:
+
+  class    ExpCmdI b      where expCmdG :: ExpCmdG b
+  instance ExpCmdI HsExpr where expCmdG = ExpG
+  instance ExpCmdI HsCmd  where expCmdG = CmdG
+
+And now the 'alts' production is simplified, as we no longer need to
+thread 'tag' explicitly:
+
+  alts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+    : alts1     { $1 >>= \ $1 ->
+                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
+    | ';' alts  { $2 >>= \ $2 ->
+                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
+
+This encoding works well enough, but introduces an extra GADT unlike the
+tagless final encoding, and there's no need for this complexity.
+
+-}
+
+{- Note [PatBuilder]
+~~~~~~~~~~~~~~~~~~~~
+Unlike HsExpr or HsCmd, the Pat type cannot accommodate all intermediate forms,
+so we introduce the notion of a PatBuilder.
+
+Consider a pattern like this:
+
+  Con a b c
+
+We parse arguments to "Con" one at a time in the  fexp aexp  parser production,
+building the result with mkHsAppPV, so the intermediate forms are:
+
+  1. Con
+  2. Con a
+  3. Con a b
+  4. Con a b c
+
+In 'HsExpr', we have 'HsApp', so the intermediate forms are represented like
+this (pseudocode):
+
+  1. "Con"
+  2. HsApp "Con" "a"
+  3. HsApp (HsApp "Con" "a") "b"
+  3. HsApp (HsApp (HsApp "Con" "a") "b") "c"
+
+Similarly, in 'HsCmd' we have 'HsCmdApp'. In 'Pat', however, what we have
+instead is 'ConPatIn', which is very awkward to modify and thus unsuitable for
+the intermediate forms.
+
+We also need an intermediate representation to postpone disambiguation between
+FunBind and PatBind. Consider:
+
+  a `Con` b = ...
+  a `fun` b = ...
+
+How do we know that (a `Con` b) is a PatBind but (a `fun` b) is a FunBind? We
+learn this by inspecting an intermediate representation in 'isFunLhs' and
+seeing that 'Con' is a data constructor but 'f' is not. We need an intermediate
+representation capable of representing both a FunBind and a PatBind, so Pat is
+insufficient.
+
+PatBuilder is an extension of Pat that is capable of representing intermediate
+parsing results for patterns and function bindings:
+
+  data PatBuilder p
+    = PatBuilderPat (Pat p)
+    | PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
+    | PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
+    ...
+
+It can represent any pattern via 'PatBuilderPat', but it also has a variety of
+other constructors which were added by following a simple principle: we never
+pattern match on the pattern stored inside 'PatBuilderPat'.
+-}
+
+---------------------------------------------------------------------------
+-- Miscellaneous utilities
+
+-- | Check if a fixity is valid. We support bypassing the usual bound checks
+-- for some special operators.
+checkPrecP
+        :: Located (SourceText,Int)             -- ^ precedence
+        -> Located (OrdList (Located RdrName))  -- ^ operators
+        -> P ()
+checkPrecP (L l (_,i)) (L _ ol)
+ | 0 <= i, i <= maxPrecedence = pure ()
+ | all specialOp ol = pure ()
+ | otherwise = addFatalError l (text ("Precedence out of range: " ++ show i))
+  where
+    specialOp op = unLoc op `elem` [ eqTyCon_RDR
+                                   , getRdrName funTyCon ]
+
+mkRecConstrOrUpdate
+        :: LHsExpr GhcPs
+        -> SrcSpan
+        -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
+        -> PV (HsExpr GhcPs)
+
+mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd)
+  | isRdrDataCon c
+  = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
+mkRecConstrOrUpdate exp _ (fs,dd)
+  | Just dd_loc <- dd = addFatalError dd_loc (text "You cannot use `..' in a record update")
+  | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
+
+mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
+mkRdrRecordUpd exp flds
+  = RecordUpd { rupd_ext  = noExtField
+              , rupd_expr = exp
+              , rupd_flds = flds }
+
+mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
+mkRdrRecordCon con flds
+  = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds }
+
+mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg
+mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
+mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs
+                                     , rec_dotdot = Just (L s (length fs)) }
+
+mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
+mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun)
+  = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun
+
+mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
+               -> InlinePragma
+-- The (Maybe Activation) is because the user can omit
+-- the activation spec (and usually does)
+mkInlinePragma src (inl, match_info) mb_act
+  = InlinePragma { inl_src = src -- Note [Pragma source text] in GHC.Types.Basic
+                 , inl_inline = inl
+                 , inl_sat    = Nothing
+                 , inl_act    = act
+                 , inl_rule   = match_info }
+  where
+    act = case mb_act of
+            Just act -> act
+            Nothing  -> -- No phase specified
+                        case inl of
+                          NoInline -> NeverActive
+                          _other   -> AlwaysActive
+
+-----------------------------------------------------------------------------
+-- utilities for foreign declarations
+
+-- construct a foreign import declaration
+--
+mkImport :: Located CCallConv
+         -> Located Safety
+         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
+         -> P (HsDecl GhcPs)
+mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
+    case unLoc cconv of
+      CCallConv          -> mkCImport
+      CApiConv           -> mkCImport
+      StdCallConv        -> mkCImport
+      PrimCallConv       -> mkOtherImport
+      JavaScriptCallConv -> mkOtherImport
+  where
+    -- Parse a C-like entity string of the following form:
+    --   "[static] [chname] [&] [cid]" | "dynamic" | "wrapper"
+    -- If 'cid' is missing, the function name 'v' is used instead as symbol
+    -- name (cf section 8.5.1 in Haskell 2010 report).
+    mkCImport = do
+      let e = unpackFS entity
+      case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of
+        Nothing         -> addFatalError loc (text "Malformed entity string")
+        Just importSpec -> returnSpec importSpec
+
+    -- currently, all the other import conventions only support a symbol name in
+    -- the entity string. If it is missing, we use the function name instead.
+    mkOtherImport = returnSpec importSpec
+      where
+        entity'    = if nullFS entity
+                        then mkExtName (unLoc v)
+                        else entity
+        funcTarget = CFunction (StaticTarget esrc entity' Nothing True)
+        importSpec = CImport cconv safety Nothing funcTarget (L loc esrc)
+
+    returnSpec spec = return $ ForD noExtField $ ForeignImport
+          { fd_i_ext  = noExtField
+          , fd_name   = v
+          , fd_sig_ty = ty
+          , fd_fi     = spec
+          }
+
+
+
+-- the string "foo" is ambiguous: either a header or a C identifier.  The
+-- C identifier case comes first in the alternatives below, so we pick
+-- that one.
+parseCImport :: Located CCallConv -> Located Safety -> FastString -> String
+             -> Located SourceText
+             -> Maybe ForeignImport
+parseCImport cconv safety nm str sourceText =
+ listToMaybe $ map fst $ filter (null.snd) $
+     readP_to_S parse str
+ where
+   parse = do
+       skipSpaces
+       r <- choice [
+          string "dynamic" >> return (mk Nothing (CFunction DynamicTarget)),
+          string "wrapper" >> return (mk Nothing CWrapper),
+          do optional (token "static" >> skipSpaces)
+             ((mk Nothing <$> cimp nm) +++
+              (do h <- munch1 hdr_char
+                  skipSpaces
+                  mk (Just (Header (SourceText h) (mkFastString h)))
+                      <$> cimp nm))
+         ]
+       skipSpaces
+       return r
+
+   token str = do _ <- string str
+                  toks <- look
+                  case toks of
+                      c : _
+                       | id_char c -> pfail
+                      _            -> return ()
+
+   mk h n = CImport cconv safety h n sourceText
+
+   hdr_char c = not (isSpace c)
+   -- header files are filenames, which can contain
+   -- pretty much any char (depending on the platform),
+   -- so just accept any non-space character
+   id_first_char c = isAlpha    c || c == '_'
+   id_char       c = isAlphaNum c || c == '_'
+
+   cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)
+             +++ (do isFun <- case unLoc cconv of
+                               CApiConv ->
+                                  option True
+                                         (do token "value"
+                                             skipSpaces
+                                             return False)
+                               _ -> return True
+                     cid' <- cid
+                     return (CFunction (StaticTarget NoSourceText cid'
+                                        Nothing isFun)))
+          where
+            cid = return nm +++
+                  (do c  <- satisfy id_first_char
+                      cs <-  many (satisfy id_char)
+                      return (mkFastString (c:cs)))
+
+
+-- construct a foreign export declaration
+--
+mkExport :: Located CCallConv
+         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
+         -> P (HsDecl GhcPs)
+mkExport (L lc cconv) (L le (StringLiteral esrc entity), v, ty)
+ = return $ ForD noExtField $
+   ForeignExport { fd_e_ext = noExtField, fd_name = v, fd_sig_ty = ty
+                 , fd_fe = CExport (L lc (CExportStatic esrc entity' cconv))
+                                   (L le esrc) }
+  where
+    entity' | nullFS entity = mkExtName (unLoc v)
+            | otherwise     = entity
+
+-- Supplying the ext_name in a foreign decl is optional; if it
+-- isn't there, the Haskell name is assumed. Note that no transformation
+-- of the Haskell name is then performed, so if you foreign export (++),
+-- it's external name will be "++". Too bad; it's important because we don't
+-- want z-encoding (e.g. names with z's in them shouldn't be doubled)
+--
+mkExtName :: RdrName -> CLabelString
+mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
+
+--------------------------------------------------------------------------------
+-- Help with module system imports/exports
+
+data ImpExpSubSpec = ImpExpAbs
+                   | ImpExpAll
+                   | ImpExpList [Located ImpExpQcSpec]
+                   | ImpExpAllWith [Located ImpExpQcSpec]
+
+data ImpExpQcSpec = ImpExpQcName (Located RdrName)
+                  | ImpExpQcType (Located RdrName)
+                  | ImpExpQcWildcard
+
+mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
+mkModuleImpExp (L l specname) subs =
+  case subs of
+    ImpExpAbs
+      | isVarNameSpace (rdrNameSpace name)
+                       -> return $ IEVar noExtField (L l (ieNameFromSpec specname))
+      | otherwise      -> IEThingAbs noExtField . L l <$> nameT
+    ImpExpAll          -> IEThingAll noExtField . L l <$> nameT
+    ImpExpList xs      ->
+      (\newName -> IEThingWith noExtField (L l newName)
+        NoIEWildcard (wrapped xs) []) <$> nameT
+    ImpExpAllWith xs                       ->
+      do allowed <- getBit PatternSynonymsBit
+         if allowed
+          then
+            let withs = map unLoc xs
+                pos   = maybe NoIEWildcard IEWildcard
+                          (findIndex isImpExpQcWildcard withs)
+                ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
+            in (\newName
+                        -> IEThingWith noExtField (L l newName) pos ies [])
+               <$> nameT
+          else addFatalError l
+            (text "Illegal export form (use PatternSynonyms to enable)")
+  where
+    name = ieNameVal specname
+    nameT =
+      if isVarNameSpace (rdrNameSpace name)
+        then addFatalError l
+              (text "Expecting a type constructor but found a variable,"
+               <+> quotes (ppr name) <> text "."
+              $$ if isSymOcc $ rdrNameOcc name
+                   then text "If" <+> quotes (ppr name)
+                        <+> text "is a type constructor"
+           <+> text "then enable ExplicitNamespaces and use the 'type' keyword."
+                   else empty)
+        else return $ ieNameFromSpec specname
+
+    ieNameVal (ImpExpQcName ln)  = unLoc ln
+    ieNameVal (ImpExpQcType ln)  = unLoc ln
+    ieNameVal (ImpExpQcWildcard) = panic "ieNameVal got wildcard"
+
+    ieNameFromSpec (ImpExpQcName ln)  = IEName ln
+    ieNameFromSpec (ImpExpQcType ln)  = IEType ln
+    ieNameFromSpec (ImpExpQcWildcard) = panic "ieName got wildcard"
+
+    wrapped = map (mapLoc ieNameFromSpec)
+
+mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
+             -> P (Located RdrName)
+mkTypeImpExp name =
+  do allowed <- getBit ExplicitNamespacesBit
+     unless allowed $ addError (getLoc name) $
+       text "Illegal keyword 'type' (use ExplicitNamespaces to enable)"
+     return (fmap (`setRdrNameSpace` tcClsName) name)
+
+checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])
+checkImportSpec ie@(L _ specs) =
+    case [l | (L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of
+      [] -> return ie
+      (l:_) -> importSpecError l
+  where
+    importSpecError l =
+      addFatalError l
+        (text "Illegal import form, this syntax can only be used to bundle"
+        $+$ text "pattern synonyms with types in module exports.")
+
+-- In the correct order
+mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)
+mkImpExpSubSpec [] = return ([], ImpExpList [])
+mkImpExpSubSpec [L _ ImpExpQcWildcard] =
+  return ([], ImpExpAll)
+mkImpExpSubSpec xs =
+  if (any (isImpExpQcWildcard . unLoc) xs)
+    then return $ ([], ImpExpAllWith xs)
+    else return $ ([], ImpExpList xs)
+
+isImpExpQcWildcard :: ImpExpQcSpec -> Bool
+isImpExpQcWildcard ImpExpQcWildcard = True
+isImpExpQcWildcard _                = False
+
+-----------------------------------------------------------------------------
+-- Warnings and failures
+
+warnPrepositiveQualifiedModule :: SrcSpan -> P ()
+warnPrepositiveQualifiedModule span =
+  addWarning Opt_WarnPrepositiveQualifiedModule span msg
+  where
+    msg = text "Found" <+> quotes (text "qualified")
+           <+> text "in prepositive position"
+       $$ text "Suggested fix: place " <+> quotes (text "qualified")
+           <+> text "after the module name instead."
+
+failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
+failOpNotEnabledImportQualifiedPost loc = addError loc msg
+  where
+    msg = text "Found" <+> quotes (text "qualified")
+          <+> text "in postpositive position. "
+      $$ text "To allow this, enable language extension 'ImportQualifiedPost'"
+
+failOpImportQualifiedTwice :: SrcSpan -> P ()
+failOpImportQualifiedTwice loc = addError loc msg
+  where
+    msg = text "Multiple occurrences of 'qualified'"
+
+warnStarIsType :: SrcSpan -> P ()
+warnStarIsType span = addWarning Opt_WarnStarIsType span msg
+  where
+    msg =  text "Using" <+> quotes (text "*")
+           <+> text "(or its Unicode variant) to mean"
+           <+> quotes (text "Data.Kind.Type")
+        $$ text "relies on the StarIsType extension, which will become"
+        $$ text "deprecated in the future."
+        $$ text "Suggested fix: use" <+> quotes (text "Type")
+           <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
+
+warnStarBndr :: SrcSpan -> P ()
+warnStarBndr span = addWarning Opt_WarnStarBinder span msg
+  where
+    msg =  text "Found binding occurrence of" <+> quotes (text "*")
+           <+> text "yet StarIsType is enabled."
+        $$ text "NB. To use (or export) this operator in"
+           <+> text "modules with StarIsType,"
+        $$ text "    including the definition module, you must qualify it."
+
+failOpFewArgs :: Located RdrName -> P a
+failOpFewArgs (L loc op) =
+  do { star_is_type <- getBit StarIsTypeBit
+     ; let msg = too_few $$ starInfo star_is_type op
+     ; addFatalError loc msg }
+  where
+    too_few = text "Operator applied to too few arguments:" <+> ppr op
+
+failOpDocPrev :: SrcSpan -> P a
+failOpDocPrev loc = addFatalError loc msg
+  where
+    msg = text "Unexpected documentation comment."
+
+-----------------------------------------------------------------------------
+-- Misc utils
+
+data PV_Context =
+  PV_Context
+    { pv_options :: ParserFlags
+    , pv_hint :: SDoc  -- See Note [Parser-Validator Hint]
+    }
+
+data PV_Accum =
+  PV_Accum
+    { pv_messages :: DynFlags -> Messages
+    , pv_annotations :: [(ApiAnnKey,[RealSrcSpan])]
+    , pv_comment_q :: [RealLocated AnnotationComment]
+    , pv_annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])]
+    }
+
+data PV_Result a = PV_Ok PV_Accum a | PV_Failed PV_Accum
+
+-- See Note [Parser-Validator]
+newtype PV a = PV { unPV :: PV_Context -> PV_Accum -> PV_Result a }
+
+instance Functor PV where
+  fmap = liftM
+
+instance Applicative PV where
+  pure a = a `seq` PV (\_ acc -> PV_Ok acc a)
+  (<*>) = ap
+
+instance Monad PV where
+  m >>= f = PV $ \ctx acc ->
+    case unPV m ctx acc of
+      PV_Ok acc' a -> unPV (f a) ctx acc'
+      PV_Failed acc' -> PV_Failed acc'
+
+runPV :: PV a -> P a
+runPV = runPV_msg empty
+
+runPV_msg :: SDoc -> PV a -> P a
+runPV_msg msg m =
+  P $ \s ->
+    let
+      pv_ctx = PV_Context
+        { pv_options = options s
+        , pv_hint = msg }
+      pv_acc = PV_Accum
+        { pv_messages = messages s
+        , pv_annotations = annotations s
+        , pv_comment_q = comment_q s
+        , pv_annotations_comments = annotations_comments s }
+      mkPState acc' =
+        s { messages = pv_messages acc'
+          , annotations = pv_annotations acc'
+          , comment_q = pv_comment_q acc'
+          , annotations_comments = pv_annotations_comments acc' }
+    in
+      case unPV m pv_ctx pv_acc of
+        PV_Ok acc' a -> POk (mkPState acc') a
+        PV_Failed acc' -> PFailed (mkPState acc')
+
+localPV_msg :: (SDoc -> SDoc) -> PV a -> PV a
+localPV_msg f m =
+  let modifyHint ctx = ctx{pv_hint = f (pv_hint ctx)} in
+  PV (\ctx acc -> unPV m (modifyHint ctx) acc)
+
+instance MonadP PV where
+  addError srcspan msg =
+    PV $ \ctx acc@PV_Accum{pv_messages=m} ->
+      let msg' = msg $$ pv_hint ctx in
+      PV_Ok acc{pv_messages=appendError srcspan msg' m} ()
+  addWarning option srcspan warning =
+    PV $ \PV_Context{pv_options=o} acc@PV_Accum{pv_messages=m} ->
+      PV_Ok acc{pv_messages=appendWarning o option srcspan warning m} ()
+  addFatalError srcspan msg =
+    addError srcspan msg >> PV (const PV_Failed)
+  getBit ext =
+    PV $ \ctx acc ->
+      let b = ext `xtest` pExtsBitmap (pv_options ctx) in
+      PV_Ok acc $! b
+  addAnnotation (RealSrcSpan l _) a (RealSrcSpan v _) =
+    PV $ \_ acc ->
+      let
+        (comment_q', new_ann_comments) = allocateComments l (pv_comment_q acc)
+        annotations_comments' = new_ann_comments ++ pv_annotations_comments acc
+        annotations' = ((l,a), [v]) : pv_annotations acc
+        acc' = acc
+          { pv_annotations = annotations'
+          , pv_comment_q = comment_q'
+          , pv_annotations_comments = annotations_comments' }
+      in
+        PV_Ok acc' ()
+  addAnnotation _ _ _ = return ()
+
+{- Note [Parser-Validator]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+When resolving ambiguities, we need to postpone failure to make a choice later.
+For example, if we have ambiguity between some A and B, our parser could be
+
+  abParser :: P (Maybe A, Maybe B)
+
+This way we can represent four possible outcomes of parsing:
+
+    (Just a, Nothing)       -- definitely A
+    (Nothing, Just b)       -- definitely B
+    (Just a, Just b)        -- either A or B
+    (Nothing, Nothing)      -- neither A nor B
+
+However, if we want to report informative parse errors, accumulate warnings,
+and add API annotations, we are better off using 'P' instead of 'Maybe':
+
+  abParser :: P (P A, P B)
+
+So we have an outer layer of P that consumes the input and builds the inner
+layer, which validates the input.
+
+For clarity, we introduce the notion of a parser-validator: a parser that does
+not consume any input, but may fail or use other effects. Thus we have:
+
+  abParser :: P (PV A, PV B)
+
+-}
+
+{- Note [Parser-Validator Hint]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A PV computation is parametrized by a hint for error messages, which can be set
+depending on validation context. We use this in checkPattern to fix #984.
+
+Consider this example, where the user has forgotten a 'do':
+
+  f _ = do
+    x <- computation
+    case () of
+      _ ->
+        result <- computation
+        case () of () -> undefined
+
+GHC parses it as follows:
+
+  f _ = do
+    x <- computation
+    (case () of
+      _ ->
+        result) <- computation
+        case () of () -> undefined
+
+Note that this fragment is parsed as a pattern:
+
+  case () of
+    _ ->
+      result
+
+We attempt to detect such cases and add a hint to the error messages:
+
+  T984.hs:6:9:
+    Parse error in pattern: case () of { _ -> result }
+    Possibly caused by a missing 'do'?
+
+The "Possibly caused by a missing 'do'?" suggestion is the hint that is passed
+as the 'pv_hint' field 'PV_Context'. When validating in a context other than
+'bindpat' (a pattern to the left of <-), we set the hint to 'empty' and it has
+no effect on the error messages.
+
+-}
+
+-- | Hint about bang patterns, assuming @BangPatterns@ is off.
+hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
+hintBangPat span e = do
+    bang_on <- getBit BangPatBit
+    unless bang_on $
+      addError span
+        (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
+
+data SumOrTuple b
+  = Sum ConTag Arity (Located b)
+  | Tuple [Located (Maybe (Located b))]
+
+pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
+pprSumOrTuple boxity = \case
+    Sum alt arity e ->
+      parOpen <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)
+              <+> parClose
+    Tuple xs ->
+      parOpen <> (fcat . punctuate comma $ map (maybe empty ppr . unLoc) xs)
+              <> parClose
+  where
+    ppr_bars n = hsep (replicate n (Outputable.char '|'))
+    (parOpen, parClose) =
+      case boxity of
+        Boxed -> (text "(", text ")")
+        Unboxed -> (text "(#", text "#)")
+
+mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExpr GhcPs)
+
+-- Tuple
+mkSumOrTupleExpr l boxity (Tuple es) =
+    return $ L l (ExplicitTuple noExtField (map toTupArg es) boxity)
+  where
+    toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs
+    toTupArg = mapLoc (maybe missingTupArg (Present noExtField))
+
+-- Sum
+mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
+    return $ L l (ExplicitSum noExtField alt arity e)
+mkSumOrTupleExpr l Boxed a@Sum{} =
+    addFatalError l (hang (text "Boxed sums not supported:") 2
+                      (pprSumOrTuple Boxed a))
+
+mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
+
+-- Tuple
+mkSumOrTuplePat l boxity (Tuple ps) = do
+  ps' <- traverse toTupPat ps
+  return $ L l (PatBuilderPat (TuplePat noExtField ps' boxity))
+  where
+    toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)
+    toTupPat (L l p) = case p of
+      Nothing -> addFatalError l (text "Tuple section in pattern context")
+      Just p' -> checkLPat p'
+
+-- Sum
+mkSumOrTuplePat l Unboxed (Sum alt arity p) = do
+   p' <- checkLPat p
+   return $ L l (PatBuilderPat (SumPat noExtField p' alt arity))
+mkSumOrTuplePat l Boxed a@Sum{} =
+    addFatalError l (hang (text "Boxed sums not supported:") 2
+                      (pprSumOrTuple Boxed a))
+
+mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs
+mkLHsOpTy x op y =
+  let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y
+  in L loc (mkHsOpTy x op y)
+
+mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs
+mkLHsDocTy t doc =
+  let loc = getLoc t `combineSrcSpans` getLoc doc
+  in L loc (HsDocTy noExtField t doc)
+
+mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs
+mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)
+
+-----------------------------------------------------------------------------
+-- Token symbols
+
+starSym :: Bool -> String
+starSym True = "★"
+starSym False = "*"
+
+forallSym :: Bool -> String
+forallSym True = "∀"
+forallSym False = "forall"
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
new file mode 100644
index 0000000000..a3d5e101d7
--- /dev/null
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -0,0 +1,35 @@
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+
+module GHC.Parser.PostProcess.Haddock where
+
+import GhcPrelude
+
+import GHC.Hs
+import GHC.Types.SrcLoc
+
+import Control.Monad
+
+-- -----------------------------------------------------------------------------
+-- Adding documentation to record fields (used in parsing).
+
+addFieldDoc :: LConDeclField a -> Maybe LHsDocString -> LConDeclField a
+addFieldDoc (L l fld) doc
+  = L l (fld { cd_fld_doc = cd_fld_doc fld `mplus` doc })
+
+addFieldDocs :: [LConDeclField a] -> Maybe LHsDocString -> [LConDeclField a]
+addFieldDocs [] _ = []
+addFieldDocs (x:xs) doc = addFieldDoc x doc : xs
+
+
+addConDoc :: LConDecl a -> Maybe LHsDocString -> LConDecl a
+addConDoc decl    Nothing = decl
+addConDoc (L p c) doc     = L p ( c { con_doc = con_doc c `mplus` doc } )
+
+addConDocs :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]
+addConDocs [] _ = []
+addConDocs [x] doc = [addConDoc x doc]
+addConDocs (x:xs) doc = x : addConDocs xs doc
+
+addConDocFirst :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]
+addConDocFirst [] _ = []
+addConDocFirst (x:xs) doc = addConDoc x doc : xs
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index ce9d019a70..8ba1c5fb2d 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -31,7 +31,7 @@ module GHC.Plugins
    , module GHC.Core.Type
    , module GHC.Core.TyCon
    , module GHC.Core.Coercion
-   , module TysWiredIn
+   , module GHC.Builtin.Types
    , module GHC.Driver.Types
    , module GHC.Types.Basic
    , module GHC.Types.Var.Set
@@ -90,7 +90,7 @@ import GHC.Core.Type hiding {- conflict with GHC.Core.Subst -}
 import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
                 ( substCo )
 import GHC.Core.TyCon
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Driver.Types
 import GHC.Types.Basic hiding ( Version {- conflicts with Packages.Version -} )
 
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 1bd37047be..18d922d636 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -53,8 +53,8 @@ import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad
-import RdrHsSyn         ( filterCTuple, setRdrNameSpace )
-import TysWiredIn
+import GHC.Parser.PostProcess ( filterCTuple, setRdrNameSpace )
+import GHC.Builtin.Types
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
@@ -64,7 +64,7 @@ import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import ErrUtils         ( MsgDoc )
-import PrelNames        ( rOOT_MAIN )
+import GHC.Builtin.Names( rOOT_MAIN )
 import GHC.Types.Basic  ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
 import GHC.Types.SrcLoc as SrcLoc
 import Outputable
@@ -180,7 +180,7 @@ newTopSrcBinder (L loc rdr_name)
         --
         -- We can get built-in syntax showing up here too, sadly.  If you type
         --      data T = (,,,)
-        -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
+        -- the constructor is parsed as a type, and then GHC.Parser.PostProcess.tyConToDataCon
         -- uses setRdrNameSpace to make it into a data constructors.  At that point
         -- the nice Exact name for the TyCon gets swizzled to an Orig name.
         -- Hence the badOrigBinding error message.
@@ -1633,7 +1633,7 @@ We store the relevant Name in the HsSyn tree, in
   * NegApp
   * NPlusKPat
   * HsDo
-respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
+respectively.  Initially, we just store the "standard" name (GHC.Builtin.Names.fromIntegralName,
 fromRationalName etc), but the renamer changes this to the appropriate user
 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntax does.
 
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index acb589d35e..6142718ceb 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -45,7 +45,7 @@ import GHC.Rename.Splice  ( rnBracket, rnSpliceExpr, checkThLocalName )
 import GHC.Rename.HsType
 import GHC.Rename.Pat
 import GHC.Driver.Session
-import PrelNames
+import GHC.Builtin.Names
 
 import GHC.Types.Basic
 import GHC.Types.Name
@@ -60,7 +60,7 @@ import Outputable
 import GHC.Types.SrcLoc
 import FastString
 import Control.Monad
-import TysWiredIn       ( nilDataConName )
+import GHC.Builtin.Types ( nilDataConName )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Data.Ord
@@ -214,7 +214,7 @@ rnExpr (HsSpliceE _ splice) = rnSpliceExpr splice
 
 ---------------------------------------------
 --      Sections
--- See Note [Parsing sections] in Parser.y
+-- See Note [Parsing sections] in GHC.Parser
 rnExpr (HsPar x (L loc (section@(SectionL {}))))
   = do  { (section', fvs) <- rnSection section
         ; return (HsPar x (L loc section'), fvs) }
@@ -396,7 +396,7 @@ rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
         -- HsWrap
 
 ----------------------
--- See Note [Parsing sections] in Parser.y
+-- See Note [Parsing sections] in GHC.Parser
 rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 rnSection section@(SectionR x op expr)
   = do  { (op', fvs_op)     <- rnLExpr op
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 9def0b83e3..a91a672dfb 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -47,8 +47,8 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
                          , lookupTyFixityRn )
 import GHC.Tc.Utils.Monad
 import GHC.Types.Name.Reader
-import PrelNames
-import TysPrim          ( funTyConName )
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim ( funTyConName )
 import GHC.Types.Name
 import GHC.Types.SrcLoc
 import GHC.Types.Name.Set
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index dd14b33275..bc2c7d3d5d 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -44,7 +44,7 @@ import GHC.Tc.Utils.Monad
 import GHC.Types.ForeignCall ( CCallTarget(..) )
 import GHC.Types.Module
 import GHC.Driver.Types ( Warnings(..), plusWarns )
-import PrelNames        ( applicativeClassName, pureAName, thenAName
+import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName
                         , monadClassName, returnMName, thenMName
                         , semigroupClassName, sappendName
                         , monoidClassName, mappendName
@@ -2367,8 +2367,8 @@ add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest)
 
 add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
 add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs
-add_bind _ (XValBindsLR {})     = panic "RdrHsSyn:add_bind"
+add_bind _ (XValBindsLR {})     = panic "GHC.Rename.Module.add_bind"
 
 add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
 add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs)
-add_sig _ (XValBindsLR {})     = panic "RdrHsSyn:add_sig"
+add_sig _ (XValBindsLR {})     = panic "GHC.Rename.Module.add_sig"
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index bf2f15829e..ed08087899 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -43,7 +43,7 @@ import GHC.Rename.Fixity
 import GHC.Rename.Utils ( warnUnusedTopBinds, mkFieldEnv )
 import GHC.Iface.Load   ( loadSrcInterface )
 import GHC.Tc.Utils.Monad
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -52,7 +52,7 @@ import GHC.Types.Avail
 import GHC.Types.FieldLabel
 import GHC.Driver.Types
 import GHC.Types.Name.Reader
-import RdrHsSyn        ( setRdrNameSpace )
+import GHC.Parser.PostProcess ( setRdrNameSpace )
 import Outputable
 import Maybes
 import GHC.Types.SrcLoc as SrcLoc
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 166d46a05f..d8f55ccc1f 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -62,7 +62,7 @@ import GHC.Rename.Utils    ( HsDocContext(..), newLocalBndrRn, bindLocalNames
                            , checkDupNames, checkDupAndShadowedNames
                            , checkTupSize , unknownSubordinateErr )
 import GHC.Rename.HsType
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Reader
@@ -72,7 +72,7 @@ import ListSetOps          ( removeDups )
 import Outputable
 import GHC.Types.SrcLoc
 import GHC.Types.Literal   ( inCharRange )
-import TysWiredIn          ( nilDataCon )
+import GHC.Builtin.Types   ( nilDataCon )
 import GHC.Core.DataCon
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 560b908bbc..a0f0bb2419 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -37,16 +37,16 @@ import Control.Monad    ( unless, when )
 
 import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
 
-import GHC.Tc.Utils.Env ( checkWellStaged )
-import THNames          ( liftName )
+import GHC.Tc.Utils.Env     ( checkWellStaged )
+import GHC.Builtin.Names.TH ( liftName )
 
 import GHC.Driver.Session
 import FastString
 import ErrUtils         ( dumpIfSet_dyn_printer, DumpFormat (..) )
 import GHC.Tc.Utils.Env ( tcMetaTy )
 import GHC.Driver.Hooks
-import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
-                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
+import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
+                            , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
 
 import {-# SOURCE #-} GHC.Tc.Gen.Expr   ( tcPolyExpr )
 import {-# SOURCE #-} GHC.Tc.Gen.Splice
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 0de085eabf..aa4e05941f 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -26,7 +26,7 @@ import GHC.Types.Name
 import GHC.Types.Module
 import GHC.Types.SrcLoc as SrcLoc
 import Outputable
-import PrelNames ( mkUnboundName, isUnboundName, getUnique)
+import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
 import Util
 import Maybes
 import GHC.Driver.Session
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 2ed7c5db95..3c4f5d065f 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -53,7 +53,7 @@ import GHC.Driver.Session
 import FastString
 import Control.Monad
 import Data.List
-import Constants        ( mAX_TUPLE_SIZE )
+import GHC.Settings.Constants ( mAX_TUPLE_SIZE )
 import qualified Data.List.NonEmpty as NE
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 7d3877749a..655e0ea5bc 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -84,8 +84,8 @@ import GHC.Types.Unique
 import GHC.Types.Unique.Supply
 import MonadUtils
 import GHC.Types.Module
-import PrelNames  ( toDynName, pretendNameIsInScope )
-import TysWiredIn ( isCTupleTyConName )
+import GHC.Builtin.Names ( toDynName, pretendNameIsInScope )
+import GHC.Builtin.Types ( isCTupleTyConName )
 import Panic
 import Maybes
 import ErrUtils
@@ -95,8 +95,8 @@ import Outputable
 import FastString
 import Bag
 import Util
-import qualified Lexer (P (..), ParseResult(..), unP, mkPState)
-import qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport)
+import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, mkPState)
+import qualified GHC.Parser       as Parser (parseStmt, parseModule, parseDeclaration, parseImport)
 
 import System.Directory
 import Data.Dynamic
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index d4dfa49ca1..3802baf4df 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -53,9 +53,9 @@ import GHC.Iface.Env
 import Util
 import GHC.Types.Var.Set
 import GHC.Types.Basic ( Boxity(..) )
-import TysPrim
-import PrelNames
-import TysWiredIn
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Names
+import GHC.Builtin.Types
 import GHC.Driver.Session
 import Outputable as Ppr
 import GHC.Char
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 434f4dd29d..5da9a916af 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -60,8 +60,8 @@ import qualified Maybes
 import GHC.Types.Unique.DSet
 import FastString
 import GHC.Platform
-import SysTools
-import FileCleanup
+import GHC.SysTools
+import GHC.SysTools.FileCleanup
 
 -- Standard libraries
 import Control.Monad
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 5bad947b2a..be8395896c 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -36,7 +36,7 @@ import GHC.Types.Name.Reader   ( RdrName, ImportSpec(..), ImpDeclSpec(..)
 import GHC.Types.Name.Occurrence ( OccName, mkVarOcc )
 import GHC.Rename.Names ( gresFromAvails )
 import GHC.Driver.Plugins
-import PrelNames        ( pluginTyConName, frontendPluginTyConName )
+import GHC.Builtin.Names ( pluginTyConName, frontendPluginTyConName )
 
 import GHC.Driver.Types
 import GHCi.RemoteTypes  ( HValue )
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
new file mode 100644
index 0000000000..e0466a1cf2
--- /dev/null
+++ b/compiler/GHC/Settings.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE CPP #-}
+
+-- | Run-time settings
+module GHC.Settings
+  ( Settings (..)
+  , ToolSettings (..)
+  , FileSettings (..)
+  , GhcNameVersion (..)
+  , PlatformConstants (..)
+  , Platform (..)
+  , PlatformMisc (..)
+  , PlatformMini (..)
+  -- * Accessors
+  , sProgramName
+  , sProjectVersion
+  , sGhcUsagePath
+  , sGhciUsagePath
+  , sToolDir
+  , sTopDir
+  , sTmpDir
+  , sGlobalPackageDatabasePath
+  , sLdSupportsCompactUnwind
+  , sLdSupportsBuildId
+  , sLdSupportsFilelist
+  , sLdIsGnuLd
+  , sGccSupportsNoPie
+  , sPgm_L
+  , sPgm_P
+  , sPgm_F
+  , sPgm_c
+  , sPgm_a
+  , sPgm_l
+  , sPgm_dll
+  , sPgm_T
+  , sPgm_windres
+  , sPgm_libtool
+  , sPgm_ar
+  , sPgm_ranlib
+  , sPgm_lo
+  , sPgm_lc
+  , sPgm_lcc
+  , sPgm_i
+  , sOpt_L
+  , sOpt_P
+  , sOpt_P_fingerprint
+  , sOpt_F
+  , sOpt_c
+  , sOpt_cxx
+  , sOpt_a
+  , sOpt_l
+  , sOpt_windres
+  , sOpt_lo
+  , sOpt_lc
+  , sOpt_lcc
+  , sOpt_i
+  , sExtraGccViaCFlags
+  , sTargetPlatformString
+  , sIntegerLibrary
+  , sIntegerLibraryType
+  , sGhcWithInterpreter
+  , sGhcWithNativeCodeGen
+  , sGhcWithSMP
+  , sGhcRTSWays
+  , sTablesNextToCode
+  , sLeadingUnderscore
+  , sLibFFI
+  , sGhcThreaded
+  , sGhcDebugged
+  , sGhcRtsWithLibdw
+  ) where
+
+import GhcPrelude
+
+import CliOption
+import Fingerprint
+import GHC.Platform
+
+data Settings = Settings
+  { sGhcNameVersion    :: {-# UNPACk #-} !GhcNameVersion
+  , sFileSettings      :: {-# UNPACK #-} !FileSettings
+  , sTargetPlatform    :: Platform       -- Filled in by SysTools
+  , sToolSettings      :: {-# UNPACK #-} !ToolSettings
+  , sPlatformMisc      :: {-# UNPACK #-} !PlatformMisc
+  , sPlatformConstants :: PlatformConstants
+
+  -- You shouldn't need to look things up in rawSettings directly.
+  -- They should have their own fields instead.
+  , sRawSettings       :: [(String, String)]
+  }
+
+-- | Settings for other executables GHC calls.
+--
+-- Probably should further split down by phase, or split between
+-- platform-specific and platform-agnostic.
+data ToolSettings = ToolSettings
+  { toolSettings_ldSupportsCompactUnwind :: Bool
+  , toolSettings_ldSupportsBuildId       :: Bool
+  , toolSettings_ldSupportsFilelist      :: Bool
+  , toolSettings_ldIsGnuLd               :: Bool
+  , toolSettings_ccSupportsNoPie         :: Bool
+
+  -- commands for particular phases
+  , toolSettings_pgm_L       :: String
+  , toolSettings_pgm_P       :: (String, [Option])
+  , toolSettings_pgm_F       :: String
+  , toolSettings_pgm_c       :: String
+  , toolSettings_pgm_a       :: (String, [Option])
+  , toolSettings_pgm_l       :: (String, [Option])
+  , toolSettings_pgm_dll     :: (String, [Option])
+  , toolSettings_pgm_T       :: String
+  , toolSettings_pgm_windres :: String
+  , toolSettings_pgm_libtool :: String
+  , toolSettings_pgm_ar      :: String
+  , toolSettings_pgm_ranlib  :: String
+  , -- | LLVM: opt llvm optimiser
+    toolSettings_pgm_lo      :: (String, [Option])
+  , -- | LLVM: llc static compiler
+    toolSettings_pgm_lc      :: (String, [Option])
+  , -- | LLVM: c compiler
+    toolSettings_pgm_lcc     :: (String, [Option])
+  , toolSettings_pgm_i       :: String
+
+  -- options for particular phases
+  , toolSettings_opt_L             :: [String]
+  , toolSettings_opt_P             :: [String]
+  , -- | cached Fingerprint of sOpt_P
+    -- See Note [Repeated -optP hashing]
+    toolSettings_opt_P_fingerprint :: Fingerprint
+  , toolSettings_opt_F             :: [String]
+  , toolSettings_opt_c             :: [String]
+  , toolSettings_opt_cxx           :: [String]
+  , toolSettings_opt_a             :: [String]
+  , toolSettings_opt_l             :: [String]
+  , toolSettings_opt_windres       :: [String]
+  , -- | LLVM: llvm optimiser
+    toolSettings_opt_lo            :: [String]
+  , -- | LLVM: llc static compiler
+    toolSettings_opt_lc            :: [String]
+  , -- | LLVM: c compiler
+    toolSettings_opt_lcc           :: [String]
+  , -- | iserv options
+    toolSettings_opt_i             :: [String]
+
+  , toolSettings_extraGccViaCFlags :: [String]
+  }
+
+
+-- | Paths to various files and directories used by GHC, including those that
+-- provide more settings.
+data FileSettings = FileSettings
+  { fileSettings_ghcUsagePath          :: FilePath       -- ditto
+  , fileSettings_ghciUsagePath         :: FilePath       -- ditto
+  , fileSettings_toolDir               :: Maybe FilePath -- ditto
+  , fileSettings_topDir                :: FilePath       -- ditto
+  , fileSettings_tmpDir                :: String      -- no trailing '/'
+  , fileSettings_globalPackageDatabase :: FilePath
+  }
+
+
+-- | Settings for what GHC this is.
+data GhcNameVersion = GhcNameVersion
+  { ghcNameVersion_programName    :: String
+  , ghcNameVersion_projectVersion :: String
+  }
+
+-- Produced by deriveConstants
+-- Provides PlatformConstants datatype
+#include "GHCConstantsHaskellType.hs"
+
+-----------------------------------------------------------------------------
+-- Accessessors from 'Settings'
+
+sProgramName         :: Settings -> String
+sProgramName = ghcNameVersion_programName . sGhcNameVersion
+sProjectVersion      :: Settings -> String
+sProjectVersion = ghcNameVersion_projectVersion . sGhcNameVersion
+
+sGhcUsagePath        :: Settings -> FilePath
+sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings
+sGhciUsagePath       :: Settings -> FilePath
+sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings
+sToolDir             :: Settings -> Maybe FilePath
+sToolDir = fileSettings_toolDir . sFileSettings
+sTopDir              :: Settings -> FilePath
+sTopDir = fileSettings_topDir . sFileSettings
+sTmpDir              :: Settings -> String
+sTmpDir = fileSettings_tmpDir . sFileSettings
+sGlobalPackageDatabasePath :: Settings -> FilePath
+sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings
+
+sLdSupportsCompactUnwind :: Settings -> Bool
+sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings
+sLdSupportsBuildId :: Settings -> Bool
+sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings
+sLdSupportsFilelist :: Settings -> Bool
+sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings
+sLdIsGnuLd :: Settings -> Bool
+sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings
+sGccSupportsNoPie :: Settings -> Bool
+sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings
+
+sPgm_L :: Settings -> String
+sPgm_L = toolSettings_pgm_L . sToolSettings
+sPgm_P :: Settings -> (String, [Option])
+sPgm_P = toolSettings_pgm_P . sToolSettings
+sPgm_F :: Settings -> String
+sPgm_F = toolSettings_pgm_F . sToolSettings
+sPgm_c :: Settings -> String
+sPgm_c = toolSettings_pgm_c . sToolSettings
+sPgm_a :: Settings -> (String, [Option])
+sPgm_a = toolSettings_pgm_a . sToolSettings
+sPgm_l :: Settings -> (String, [Option])
+sPgm_l = toolSettings_pgm_l . sToolSettings
+sPgm_dll :: Settings -> (String, [Option])
+sPgm_dll = toolSettings_pgm_dll . sToolSettings
+sPgm_T :: Settings -> String
+sPgm_T = toolSettings_pgm_T . sToolSettings
+sPgm_windres :: Settings -> String
+sPgm_windres = toolSettings_pgm_windres . sToolSettings
+sPgm_libtool :: Settings -> String
+sPgm_libtool = toolSettings_pgm_libtool . sToolSettings
+sPgm_ar :: Settings -> String
+sPgm_ar = toolSettings_pgm_ar . sToolSettings
+sPgm_ranlib :: Settings -> String
+sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings
+sPgm_lo :: Settings -> (String, [Option])
+sPgm_lo = toolSettings_pgm_lo . sToolSettings
+sPgm_lc :: Settings -> (String, [Option])
+sPgm_lc = toolSettings_pgm_lc . sToolSettings
+sPgm_lcc :: Settings -> (String, [Option])
+sPgm_lcc = toolSettings_pgm_lcc . sToolSettings
+sPgm_i :: Settings -> String
+sPgm_i = toolSettings_pgm_i . sToolSettings
+sOpt_L :: Settings -> [String]
+sOpt_L = toolSettings_opt_L . sToolSettings
+sOpt_P :: Settings -> [String]
+sOpt_P = toolSettings_opt_P . sToolSettings
+sOpt_P_fingerprint :: Settings -> Fingerprint
+sOpt_P_fingerprint = toolSettings_opt_P_fingerprint . sToolSettings
+sOpt_F :: Settings -> [String]
+sOpt_F = toolSettings_opt_F . sToolSettings
+sOpt_c :: Settings -> [String]
+sOpt_c = toolSettings_opt_c . sToolSettings
+sOpt_cxx :: Settings -> [String]
+sOpt_cxx = toolSettings_opt_cxx . sToolSettings
+sOpt_a :: Settings -> [String]
+sOpt_a = toolSettings_opt_a . sToolSettings
+sOpt_l :: Settings -> [String]
+sOpt_l = toolSettings_opt_l . sToolSettings
+sOpt_windres :: Settings -> [String]
+sOpt_windres = toolSettings_opt_windres . sToolSettings
+sOpt_lo :: Settings -> [String]
+sOpt_lo = toolSettings_opt_lo . sToolSettings
+sOpt_lc :: Settings -> [String]
+sOpt_lc = toolSettings_opt_lc . sToolSettings
+sOpt_lcc :: Settings -> [String]
+sOpt_lcc = toolSettings_opt_lcc . sToolSettings
+sOpt_i :: Settings -> [String]
+sOpt_i = toolSettings_opt_i . sToolSettings
+
+sExtraGccViaCFlags :: Settings -> [String]
+sExtraGccViaCFlags = toolSettings_extraGccViaCFlags . sToolSettings
+
+sTargetPlatformString :: Settings -> String
+sTargetPlatformString = platformMisc_targetPlatformString . sPlatformMisc
+sIntegerLibrary :: Settings -> String
+sIntegerLibrary = platformMisc_integerLibrary . sPlatformMisc
+sIntegerLibraryType :: Settings -> IntegerLibrary
+sIntegerLibraryType = platformMisc_integerLibraryType . sPlatformMisc
+sGhcWithInterpreter :: Settings -> Bool
+sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc
+sGhcWithNativeCodeGen :: Settings -> Bool
+sGhcWithNativeCodeGen = platformMisc_ghcWithNativeCodeGen . sPlatformMisc
+sGhcWithSMP :: Settings -> Bool
+sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc
+sGhcRTSWays :: Settings -> String
+sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc
+sTablesNextToCode :: Settings -> Bool
+sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc
+sLeadingUnderscore :: Settings -> Bool
+sLeadingUnderscore = platformMisc_leadingUnderscore . sPlatformMisc
+sLibFFI :: Settings -> Bool
+sLibFFI = platformMisc_libFFI . sPlatformMisc
+sGhcThreaded :: Settings -> Bool
+sGhcThreaded = platformMisc_ghcThreaded . sPlatformMisc
+sGhcDebugged :: Settings -> Bool
+sGhcDebugged = platformMisc_ghcDebugged . sPlatformMisc
+sGhcRtsWithLibdw :: Settings -> Bool
+sGhcRtsWithLibdw = platformMisc_ghcRtsWithLibdw . sPlatformMisc
diff --git a/compiler/GHC/Settings/Constants.hs b/compiler/GHC/Settings/Constants.hs
new file mode 100644
index 0000000000..92a917e430
--- /dev/null
+++ b/compiler/GHC/Settings/Constants.hs
@@ -0,0 +1,45 @@
+-- | Compile-time settings
+module GHC.Settings.Constants where
+
+import GhcPrelude
+
+import Config
+
+hiVersion :: Integer
+hiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
+
+-- All pretty arbitrary:
+
+mAX_TUPLE_SIZE :: Int
+mAX_TUPLE_SIZE = 62 -- Should really match the number
+                    -- of decls in Data.Tuple
+
+mAX_CTUPLE_SIZE :: Int   -- Constraint tuples
+mAX_CTUPLE_SIZE = 62     -- Should match the number of decls in GHC.Classes
+
+mAX_SUM_SIZE :: Int
+mAX_SUM_SIZE = 62
+
+-- | Default maximum depth for both class instance search and type family
+-- reduction. See also #5395.
+mAX_REDUCTION_DEPTH :: Int
+mAX_REDUCTION_DEPTH = 200
+
+-- | Default maximum constraint-solver iterations
+-- Typically there should be very few
+mAX_SOLVER_ITERATIONS :: Int
+mAX_SOLVER_ITERATIONS = 4
+
+wORD64_SIZE :: Int
+wORD64_SIZE = 8
+
+-- Size of float in bytes.
+fLOAT_SIZE :: Int
+fLOAT_SIZE = 4
+
+-- Size of double in bytes.
+dOUBLE_SIZE :: Int
+dOUBLE_SIZE = 8
+
+tARGET_MAX_CHAR :: Int
+tARGET_MAX_CHAR = 0x10ffff
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
new file mode 100644
index 0000000000..bc15564543
--- /dev/null
+++ b/compiler/GHC/Settings/IO.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module GHC.Settings.IO
+ ( SettingsError (..)
+ , initSettings
+ ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Settings.Platform
+import GHC.Settings.Utils
+
+import Config
+import CliOption
+import Fingerprint
+import GHC.Platform
+import Outputable
+import GHC.Settings
+import GHC.SysTools.BaseDir
+
+import Control.Monad.Trans.Except
+import Control.Monad.IO.Class
+import qualified Data.Map as Map
+import System.FilePath
+import System.Directory
+
+data SettingsError
+  = SettingsError_MissingData String
+  | SettingsError_BadData String
+
+initSettings
+  :: forall m
+  .  MonadIO m
+  => String -- ^ TopDir path
+  -> ExceptT SettingsError m Settings
+initSettings top_dir = do
+  -- see Note [topdir: How GHC finds its files]
+  -- NB: top_dir is assumed to be in standard Unix
+  -- format, '/' separated
+  mtool_dir <- liftIO $ findToolDir top_dir
+        -- see Note [tooldir: How GHC finds mingw on Windows]
+
+  let installed :: FilePath -> FilePath
+      installed file = top_dir </> file
+      libexec :: FilePath -> FilePath
+      libexec file = top_dir </> "bin" </> file
+      settingsFile = installed "settings"
+      platformConstantsFile = installed "platformConstants"
+
+      readFileSafe :: FilePath -> ExceptT SettingsError m String
+      readFileSafe path = liftIO (doesFileExist path) >>= \case
+        True -> liftIO $ readFile path
+        False -> throwE $ SettingsError_MissingData $ "Missing file: " ++ path
+
+  settingsStr <- readFileSafe settingsFile
+  platformConstantsStr <- readFileSafe platformConstantsFile
+  settingsList <- case maybeReadFuzzy settingsStr of
+    Just s -> pure s
+    Nothing -> throwE $ SettingsError_BadData $
+      "Can't parse " ++ show settingsFile
+  let mySettings = Map.fromList settingsList
+  platformConstants <- case maybeReadFuzzy platformConstantsStr of
+    Just s -> pure s
+    Nothing -> throwE $ SettingsError_BadData $
+      "Can't parse " ++ show platformConstantsFile
+  -- See Note [Settings file] for a little more about this file. We're
+  -- just partially applying those functions and throwing 'Left's; they're
+  -- written in a very portable style to keep ghc-boot light.
+  let getSetting key = either pgmError pure $
+        getFilePathSetting0 top_dir settingsFile mySettings key
+      getToolSetting :: String -> ExceptT SettingsError m String
+      getToolSetting key = expandToolDir mtool_dir <$> getSetting key
+      getBooleanSetting :: String -> ExceptT SettingsError m Bool
+      getBooleanSetting key = either pgmError pure $
+        getBooleanSetting0 settingsFile mySettings key
+  targetPlatformString <- getSetting "target platform string"
+  tablesNextToCode <- getBooleanSetting "Tables next to code"
+  myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
+  -- On Windows, mingw is distributed with GHC,
+  -- so we look in TopDir/../mingw/bin,
+  -- as well as TopDir/../../mingw/bin for hadrian.
+  -- It would perhaps be nice to be able to override this
+  -- with the settings file, but it would be a little fiddly
+  -- to make that possible, so for now you can't.
+  cc_prog <- getToolSetting "C compiler command"
+  cc_args_str <- getSetting "C compiler flags"
+  cxx_args_str <- getSetting "C++ compiler flags"
+  gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
+  cpp_prog <- getToolSetting "Haskell CPP command"
+  cpp_args_str <- getSetting "Haskell CPP flags"
+
+  platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
+
+  let unreg_cc_args = if platformUnregisterised platform
+                      then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
+                      else []
+      cpp_args = map Option (words cpp_args_str)
+      cc_args  = words cc_args_str ++ unreg_cc_args
+      cxx_args = words cxx_args_str
+  ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
+  ldSupportsBuildId       <- getBooleanSetting "ld supports build-id"
+  ldSupportsFilelist      <- getBooleanSetting "ld supports filelist"
+  ldIsGnuLd               <- getBooleanSetting "ld is GNU ld"
+
+  let globalpkgdb_path = installed "package.conf.d"
+      ghc_usage_msg_path  = installed "ghc-usage.txt"
+      ghci_usage_msg_path = installed "ghci-usage.txt"
+
+  -- For all systems, unlit, split, mangle are GHC utilities
+  -- architecture-specific stuff is done when building Config.hs
+  unlit_path <- getToolSetting "unlit command"
+
+  windres_path <- getToolSetting "windres command"
+  libtool_path <- getToolSetting "libtool command"
+  ar_path <- getToolSetting "ar command"
+  ranlib_path <- getToolSetting "ranlib command"
+
+  -- TODO this side-effect doesn't belong here. Reading and parsing the settings
+  -- should be idempotent and accumulate no resources.
+  tmpdir <- liftIO $ getTemporaryDirectory
+
+  touch_path <- getToolSetting "touch command"
+
+  mkdll_prog <- getToolSetting "dllwrap command"
+  let mkdll_args = []
+
+  -- cpp is derived from gcc on all platforms
+  -- HACK, see setPgmP below. We keep 'words' here to remember to fix
+  -- Config.hs one day.
+
+
+  -- Other things being equal, as and ld are simply gcc
+  cc_link_args_str <- getSetting "C compiler link flags"
+  let   as_prog  = cc_prog
+        as_args  = map Option cc_args
+        ld_prog  = cc_prog
+        ld_args  = map Option (cc_args ++ words cc_link_args_str)
+
+  llvmTarget <- getSetting "LLVM target"
+
+  -- We just assume on command line
+  lc_prog <- getSetting "LLVM llc command"
+  lo_prog <- getSetting "LLVM opt command"
+  lcc_prog <- getSetting "LLVM clang command"
+
+  let iserv_prog = libexec "ghc-iserv"
+
+  integerLibrary <- getSetting "integer library"
+  integerLibraryType <- case integerLibrary of
+    "integer-gmp" -> pure IntegerGMP
+    "integer-simple" -> pure IntegerSimple
+    _ -> pgmError $ unwords
+      [ "Entry for"
+      , show "integer library"
+      , "must be one of"
+      , show "integer-gmp"
+      , "or"
+      , show "integer-simple"
+      ]
+
+  ghcWithInterpreter <- getBooleanSetting "Use interpreter"
+  ghcWithNativeCodeGen <- getBooleanSetting "Use native code generator"
+  ghcWithSMP <- getBooleanSetting "Support SMP"
+  ghcRTSWays <- getSetting "RTS ways"
+  leadingUnderscore <- getBooleanSetting "Leading underscore"
+  useLibFFI <- getBooleanSetting "Use LibFFI"
+  ghcThreaded <- getBooleanSetting "Use Threads"
+  ghcDebugged <- getBooleanSetting "Use Debugging"
+  ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw"
+
+  return $ Settings
+    { sGhcNameVersion = GhcNameVersion
+      { ghcNameVersion_programName = "ghc"
+      , ghcNameVersion_projectVersion = cProjectVersion
+      }
+
+    , sFileSettings = FileSettings
+      { fileSettings_tmpDir         = normalise tmpdir
+      , fileSettings_ghcUsagePath   = ghc_usage_msg_path
+      , fileSettings_ghciUsagePath  = ghci_usage_msg_path
+      , fileSettings_toolDir        = mtool_dir
+      , fileSettings_topDir         = top_dir
+      , fileSettings_globalPackageDatabase = globalpkgdb_path
+      }
+
+    , sToolSettings = ToolSettings
+      { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
+      , toolSettings_ldSupportsBuildId       = ldSupportsBuildId
+      , toolSettings_ldSupportsFilelist      = ldSupportsFilelist
+      , toolSettings_ldIsGnuLd               = ldIsGnuLd
+      , toolSettings_ccSupportsNoPie         = gccSupportsNoPie
+
+      , toolSettings_pgm_L   = unlit_path
+      , toolSettings_pgm_P   = (cpp_prog, cpp_args)
+      , toolSettings_pgm_F   = ""
+      , toolSettings_pgm_c   = cc_prog
+      , toolSettings_pgm_a   = (as_prog, as_args)
+      , toolSettings_pgm_l   = (ld_prog, ld_args)
+      , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
+      , toolSettings_pgm_T   = touch_path
+      , toolSettings_pgm_windres = windres_path
+      , toolSettings_pgm_libtool = libtool_path
+      , toolSettings_pgm_ar = ar_path
+      , toolSettings_pgm_ranlib = ranlib_path
+      , toolSettings_pgm_lo  = (lo_prog,[])
+      , toolSettings_pgm_lc  = (lc_prog,[])
+      , toolSettings_pgm_lcc = (lcc_prog,[])
+      , toolSettings_pgm_i   = iserv_prog
+      , toolSettings_opt_L       = []
+      , toolSettings_opt_P       = []
+      , toolSettings_opt_P_fingerprint = fingerprint0
+      , toolSettings_opt_F       = []
+      , toolSettings_opt_c       = cc_args
+      , toolSettings_opt_cxx     = cxx_args
+      , toolSettings_opt_a       = []
+      , toolSettings_opt_l       = []
+      , toolSettings_opt_windres = []
+      , toolSettings_opt_lcc     = []
+      , toolSettings_opt_lo      = []
+      , toolSettings_opt_lc      = []
+      , toolSettings_opt_i       = []
+
+      , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags
+      }
+
+    , sTargetPlatform = platform
+    , sPlatformMisc = PlatformMisc
+      { platformMisc_targetPlatformString = targetPlatformString
+      , platformMisc_integerLibrary = integerLibrary
+      , platformMisc_integerLibraryType = integerLibraryType
+      , platformMisc_ghcWithInterpreter = ghcWithInterpreter
+      , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
+      , platformMisc_ghcWithSMP = ghcWithSMP
+      , platformMisc_ghcRTSWays = ghcRTSWays
+      , platformMisc_tablesNextToCode = tablesNextToCode
+      , platformMisc_leadingUnderscore = leadingUnderscore
+      , platformMisc_libFFI = useLibFFI
+      , platformMisc_ghcThreaded = ghcThreaded
+      , platformMisc_ghcDebugged = ghcDebugged
+      , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw
+      , platformMisc_llvmTarget = llvmTarget
+      }
+
+    , sPlatformConstants = platformConstants
+
+    , sRawSettings    = settingsList
+    }
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index e31327c06c..7ee13baef8 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -79,7 +79,7 @@ import Outputable
 import GHC.Driver.Packages ( isDynLinkName )
 import GHC.Platform
 import GHC.Core.Ppr( {- instances -} )
-import PrimOp            ( PrimOp, PrimCall )
+import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
 import GHC.Core.TyCon    ( PrimRep(..), TyCon )
 import GHC.Core.Type     ( Type )
 import GHC.Types.RepType ( typePrimRep1 )
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 6e163ab3e9..de74b0b0ab 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -215,8 +215,8 @@ import Outputable
 import GHC.Types.RepType
 import GHC.Stg.Syntax
 import GHC.Core.Type
-import TysPrim (intPrimTy,wordPrimTy,word64PrimTy)
-import TysWiredIn
+import GHC.Builtin.Types.Prim (intPrimTy,wordPrimTy,word64PrimTy)
+import GHC.Builtin.Types
 import GHC.Types.Unique.Supply
 import Util
 import GHC.Types.Var.Env
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index d7c5aab01c..231144965e 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -46,7 +46,7 @@ import Outputable
 import Stream
 import GHC.Types.Basic
 import GHC.Types.Var.Set ( isEmptyDVarSet )
-import FileCleanup
+import GHC.SysTools.FileCleanup
 
 import OrdList
 import GHC.Cmm.Graph
diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index a36aa4c268..a3df5a881f 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -25,7 +25,7 @@ import GHC.Runtime.Heap.Layout ( WordOff )
 import GHC.Types.Id            ( Id )
 import GHC.Core.TyCon          ( PrimRep(..), primElemRepSizeB )
 import GHC.Types.Basic         ( RepArity )
-import Constants               ( wORD64_SIZE, dOUBLE_SIZE )
+import GHC.Settings.Constants  ( wORD64_SIZE, dOUBLE_SIZE )
 
 import Outputable
 import FastString
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 789dc8df57..a0645305fa 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -44,7 +44,7 @@ import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
 import GHC.Types.Name (isInternalName)
 import GHC.Types.RepType (countConRepArgs)
 import GHC.Types.Literal
-import PrelInfo
+import GHC.Builtin.Utils
 import Outputable
 import GHC.Platform
 import Util
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index 047353b89a..da2158c7e9 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -44,7 +44,7 @@ import GHC.Types.Name
 import Outputable
 import GHC.Stg.Syntax
 import GHC.Core.Type
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Types.Unique.FM
 import Util
 import GHC.Types.Var.Env
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 05a5e7c69b..94cd97ca23 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -41,7 +41,7 @@ import GHC.Core.DataCon
 import GHC.Driver.Session ( mAX_PTR_TAG )
 import GHC.Types.ForeignCall
 import GHC.Types.Id
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Core.TyCon
 import GHC.Core.Type        ( isUnliftedType )
 import GHC.Types.RepType    ( isVoidTy, countConRepArgs )
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 2a0578327a..51fee717c4 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -45,7 +45,7 @@ import GHC.Types.Unique.Supply
 import GHC.Types.Basic
 
 import GHC.Core.TyCo.Rep
-import TysPrim
+import GHC.Builtin.Types.Prim
 import Util (zipEqual)
 
 import Control.Monad
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 665fdeb21d..b315c6a196 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -47,7 +47,7 @@ import GHC.Core.Type    ( Type, tyConAppTyCon )
 import GHC.Core.TyCon
 import GHC.Cmm.CLabel
 import GHC.Cmm.Utils
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Runtime.Heap.Layout
 import FastString
 import Outputable
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 19ff523fba..179dc2d2d8 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -131,7 +131,7 @@ import Util
 import GHC.Driver.Session
 
 -- Turgid imports for showTypeCategory
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Core.Predicate
diff --git a/compiler/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
new file mode 100644
index 0000000000..f3f1b4b1ca
--- /dev/null
+++ b/compiler/GHC/SysTools.hs
@@ -0,0 +1,475 @@
+{-
+-----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 2001-2003
+--
+-- Access to system tools: gcc, cp, rm etc
+--
+-----------------------------------------------------------------------------
+-}
+
+{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
+
+module GHC.SysTools (
+        -- * Initialisation
+        initSysTools,
+        lazyInitLlvmConfig,
+
+        -- * Interface to system tools
+        module GHC.SysTools.Tasks,
+        module GHC.SysTools.Info,
+
+        linkDynLib,
+
+        copy,
+        copyWithHeader,
+
+        -- * General utilities
+        Option(..),
+        expandTopDir,
+
+        -- * Platform-specifics
+        libmLinkOpts,
+
+        -- * Mac OS X frameworks
+        getPkgFrameworkOpts,
+        getFrameworkOpts
+ ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Settings.Utils
+
+import GHC.Types.Module
+import GHC.Driver.Packages
+import Outputable
+import ErrUtils
+import GHC.Platform
+import GHC.Driver.Session
+import GHC.Driver.Ways
+
+import Control.Monad.Trans.Except (runExceptT)
+import System.FilePath
+import System.IO
+import System.IO.Unsafe (unsafeInterleaveIO)
+import GHC.SysTools.ExtraObj
+import GHC.SysTools.Info
+import GHC.SysTools.Tasks
+import GHC.SysTools.BaseDir
+import GHC.Settings.IO
+import qualified Data.Set as Set
+
+{-
+Note [How GHC finds toolchain utilities]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC.SysTools.initSysProgs figures out exactly where all the auxiliary programs
+are, and initialises mutable variables to make it easy to call them.
+To do this, it makes use of definitions in Config.hs, which is a Haskell
+file containing variables whose value is figured out by the build system.
+
+Config.hs contains two sorts of things
+
+  cGCC,         The *names* of the programs
+  cCPP            e.g.  cGCC = gcc
+  cUNLIT                cCPP = gcc -E
+  etc           They do *not* include paths
+
+
+  cUNLIT_DIR   The *path* to the directory containing unlit, split etc
+  cSPLIT_DIR   *relative* to the root of the build tree,
+                   for use when running *in-place* in a build tree (only)
+
+
+---------------------------------------------
+NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
+
+Another hair-brained scheme for simplifying the current tool location
+nightmare in GHC: Simon originally suggested using another
+configuration file along the lines of GCC's specs file - which is fine
+except that it means adding code to read yet another configuration
+file.  What I didn't notice is that the current package.conf is
+general enough to do this:
+
+Package
+    {name = "tools",    import_dirs = [],  source_dirs = [],
+     library_dirs = [], hs_libraries = [], extra_libraries = [],
+     include_dirs = [], c_includes = [],   package_deps = [],
+     extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
+     extra_cc_opts = [], extra_ld_opts = []}
+
+Which would have the advantage that we get to collect together in one
+place the path-specific package stuff with the path-specific tool
+stuff.
+                End of NOTES
+---------------------------------------------
+
+************************************************************************
+*                                                                      *
+\subsection{Initialisation}
+*                                                                      *
+************************************************************************
+-}
+
+-- Note [LLVM configuration]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The `llvm-targets` and `llvm-passes` files are shipped with GHC and contain
+-- information needed by the LLVM backend to invoke `llc` and `opt`.
+-- Specifically:
+--
+--  * llvm-targets maps autoconf host triples to the corresponding LLVM
+--    `data-layout` declarations. This information is extracted from clang using
+--    the script in utils/llvm-targets/gen-data-layout.sh and should be updated
+--    whenever we target a new version of LLVM.
+--
+--  * llvm-passes maps GHC optimization levels to sets of LLVM optimization
+--    flags that GHC should pass to `opt`.
+--
+-- This information is contained in files rather the GHC source to allow users
+-- to add new targets to GHC without having to recompile the compiler.
+--
+-- Since this information is only needed by the LLVM backend we load it lazily
+-- with unsafeInterleaveIO. Consequently it is important that we lazily pattern
+-- match on LlvmConfig until we actually need its contents.
+
+lazyInitLlvmConfig :: String
+               -> IO LlvmConfig
+lazyInitLlvmConfig top_dir
+  = unsafeInterleaveIO $ do    -- see Note [LLVM configuration]
+      targets <- readAndParse "llvm-targets" mkLlvmTarget
+      passes <- readAndParse "llvm-passes" id
+      return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes }
+  where
+    readAndParse name builder =
+      do let llvmConfigFile = top_dir </> name
+         llvmConfigStr <- readFile llvmConfigFile
+         case maybeReadFuzzy llvmConfigStr of
+           Just s -> return (fmap builder <$> s)
+           Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile)
+
+    mkLlvmTarget :: (String, String, String) -> LlvmTarget
+    mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
+
+
+initSysTools :: String          -- TopDir path
+             -> IO Settings     -- Set all the mutable variables above, holding
+                                --      (a) the system programs
+                                --      (b) the package-config file
+                                --      (c) the GHC usage message
+initSysTools top_dir = do
+  res <- runExceptT $ initSettings top_dir
+  case res of
+    Right a -> pure a
+    Left (SettingsError_MissingData msg) -> pgmError msg
+    Left (SettingsError_BadData msg) -> pgmError msg
+
+{- Note [Windows stack usage]
+
+See: #8870 (and #8834 for related info) and #12186
+
+On Windows, occasionally we need to grow the stack. In order to do
+this, we would normally just bump the stack pointer - but there's a
+catch on Windows.
+
+If the stack pointer is bumped by more than a single page, then the
+pages between the initial pointer and the resulting location must be
+properly committed by the Windows virtual memory subsystem. This is
+only needed in the event we bump by more than one page (i.e 4097 bytes
+or more).
+
+Windows compilers solve this by emitting a call to a special function
+called _chkstk, which does this committing of the pages for you.
+
+The reason this was causing a segfault was because due to the fact the
+new code generator tends to generate larger functions, we needed more
+stack space in GHC itself. In the x86 codegen, we needed approximately
+~12kb of stack space in one go, which caused the process to segfault,
+as the intervening pages were not committed.
+
+GCC can emit such a check for us automatically but only when the flag
+-fstack-check is used.
+
+See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
+for more information.
+
+-}
+
+copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
+copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
+
+copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
+               -> IO ()
+copyWithHeader dflags purpose maybe_header from to = do
+  showPass dflags purpose
+
+  hout <- openBinaryFile to   WriteMode
+  hin  <- openBinaryFile from ReadMode
+  ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
+  maybe (return ()) (header hout) maybe_header
+  hPutStr hout ls
+  hClose hout
+  hClose hin
+ where
+  -- write the header string in UTF-8.  The header is something like
+  --   {-# LINE "foo.hs" #-}
+  -- and we want to make sure a Unicode filename isn't mangled.
+  header h str = do
+   hSetEncoding h utf8
+   hPutStr h str
+   hSetBinaryMode h True
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Support code}
+*                                                                      *
+************************************************************************
+-}
+
+linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
+linkDynLib dflags0 o_files dep_packages
+ = do
+    let -- This is a rather ugly hack to fix dynamically linked
+        -- GHC on Windows. If GHC is linked with -threaded, then
+        -- it links against libHSrts_thr. But if base is linked
+        -- against libHSrts, then both end up getting loaded,
+        -- and things go wrong. We therefore link the libraries
+        -- with the same RTS flags that we link GHC with.
+        dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0
+          then addWay' WayThreaded dflags0
+          else                     dflags0
+        dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1
+          then addWay' WayDebug dflags1
+          else                  dflags1
+        dflags = updateWays dflags2
+
+        verbFlags = getVerbFlags dflags
+        o_file = outputFile dflags
+
+    pkgs <- getPreloadPackagesAnd dflags dep_packages
+
+    let pkg_lib_paths = collectLibraryPaths dflags pkgs
+    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
+        get_pkg_lib_path_opts l
+         | ( osElfTarget (platformOS (targetPlatform dflags)) ||
+             osMachOTarget (platformOS (targetPlatform dflags)) ) &&
+           dynLibLoader dflags == SystemDependent &&
+           WayDyn `Set.member` ways dflags
+            = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
+              -- See Note [-Xlinker -rpath vs -Wl,-rpath]
+         | otherwise = ["-L" ++ l]
+
+    let lib_paths = libraryPaths dflags
+    let lib_path_opts = map ("-L"++) lib_paths
+
+    -- We don't want to link our dynamic libs against the RTS package,
+    -- because the RTS lib comes in several flavours and we want to be
+    -- able to pick the flavour when a binary is linked.
+    -- On Windows we need to link the RTS import lib as Windows does
+    -- not allow undefined symbols.
+    -- The RTS library path is still added to the library search path
+    -- above in case the RTS is being explicitly linked in (see #3807).
+    let platform = targetPlatform dflags
+        os = platformOS platform
+        pkgs_no_rts = case os of
+                      OSMinGW32 ->
+                          pkgs
+                      _ ->
+                          filter ((/= rtsUnitId) . packageConfigId) pkgs
+    let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
+                        in  package_hs_libs ++ extra_libs ++ other_flags
+
+        -- probably _stub.o files
+        -- and last temporary shared object file
+    let extra_ld_inputs = ldInputs dflags
+
+    -- frameworks
+    pkg_framework_opts <- getPkgFrameworkOpts dflags platform
+                                              (map unitId pkgs)
+    let framework_opts = getFrameworkOpts dflags platform
+
+    case os of
+        OSMinGW32 -> do
+            -------------------------------------------------------------
+            -- Making a DLL
+            -------------------------------------------------------------
+            let output_fn = case o_file of
+                            Just s -> s
+                            Nothing -> "HSdll.dll"
+
+            runLink dflags (
+                    map Option verbFlags
+                 ++ [ Option "-o"
+                    , FileOption "" output_fn
+                    , Option "-shared"
+                    ] ++
+                    [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
+                    | gopt Opt_SharedImplib dflags
+                    ]
+                 ++ map (FileOption "") o_files
+
+                 -- Permit the linker to auto link _symbol to _imp_symbol
+                 -- This lets us link against DLLs without needing an "import library"
+                 ++ [Option "-Wl,--enable-auto-import"]
+
+                 ++ extra_ld_inputs
+                 ++ map Option (
+                    lib_path_opts
+                 ++ pkg_lib_path_opts
+                 ++ pkg_link_opts
+                ))
+        _ | os == OSDarwin -> do
+            -------------------------------------------------------------------
+            -- Making a darwin dylib
+            -------------------------------------------------------------------
+            -- About the options used for Darwin:
+            -- -dynamiclib
+            --   Apple's way of saying -shared
+            -- -undefined dynamic_lookup:
+            --   Without these options, we'd have to specify the correct
+            --   dependencies for each of the dylibs. Note that we could
+            --   (and should) do without this for all libraries except
+            --   the RTS; all we need to do is to pass the correct
+            --   HSfoo_dyn.dylib files to the link command.
+            --   This feature requires Mac OS X 10.3 or later; there is
+            --   a similar feature, -flat_namespace -undefined suppress,
+            --   which works on earlier versions, but it has other
+            --   disadvantages.
+            -- -single_module
+            --   Build the dynamic library as a single "module", i.e. no
+            --   dynamic binding nonsense when referring to symbols from
+            --   within the library. The NCG assumes that this option is
+            --   specified (on i386, at least).
+            -- -install_name
+            --   Mac OS/X stores the path where a dynamic library is (to
+            --   be) installed in the library itself.  It's called the
+            --   "install name" of the library. Then any library or
+            --   executable that links against it before it's installed
+            --   will search for it in its ultimate install location.
+            --   By default we set the install name to the absolute path
+            --   at build time, but it can be overridden by the
+            --   -dylib-install-name option passed to ghc. Cabal does
+            --   this.
+            -------------------------------------------------------------------
+
+            let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
+
+            instName <- case dylibInstallName dflags of
+                Just n -> return n
+                Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
+            runLink dflags (
+                    map Option verbFlags
+                 ++ [ Option "-dynamiclib"
+                    , Option "-o"
+                    , FileOption "" output_fn
+                    ]
+                 ++ map Option o_files
+                 ++ [ Option "-undefined",
+                      Option "dynamic_lookup",
+                      Option "-single_module" ]
+                 ++ (if platformArch platform == ArchX86_64
+                     then [ ]
+                     else [ Option "-Wl,-read_only_relocs,suppress" ])
+                 ++ [ Option "-install_name", Option instName ]
+                 ++ map Option lib_path_opts
+                 ++ extra_ld_inputs
+                 ++ map Option framework_opts
+                 ++ map Option pkg_lib_path_opts
+                 ++ map Option pkg_link_opts
+                 ++ map Option pkg_framework_opts
+                 ++ [ Option "-Wl,-dead_strip_dylibs" ]
+              )
+        _ -> do
+            -------------------------------------------------------------------
+            -- Making a DSO
+            -------------------------------------------------------------------
+
+            let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
+                unregisterised = platformUnregisterised (targetPlatform dflags)
+            let bsymbolicFlag = -- we need symbolic linking to resolve
+                                -- non-PIC intra-package-relocations for
+                                -- performance (where symbolic linking works)
+                                -- See Note [-Bsymbolic assumptions by GHC]
+                                ["-Wl,-Bsymbolic" | not unregisterised]
+
+            runLink dflags (
+                    map Option verbFlags
+                 ++ libmLinkOpts
+                 ++ [ Option "-o"
+                    , FileOption "" output_fn
+                    ]
+                 ++ map Option o_files
+                 ++ [ Option "-shared" ]
+                 ++ map Option bsymbolicFlag
+                    -- Set the library soname. We use -h rather than -soname as
+                    -- Solaris 10 doesn't support the latter:
+                 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
+                 ++ extra_ld_inputs
+                 ++ map Option lib_path_opts
+                 ++ map Option pkg_lib_path_opts
+                 ++ map Option pkg_link_opts
+              )
+
+-- | Some platforms require that we explicitly link against @libm@ if any
+-- math-y things are used (which we assume to include all programs). See #14022.
+libmLinkOpts :: [Option]
+libmLinkOpts =
+#if defined(HAVE_LIBM)
+  [Option "-lm"]
+#else
+  []
+#endif
+
+getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
+getPkgFrameworkOpts dflags platform dep_packages
+  | platformUsesFrameworks platform = do
+    pkg_framework_path_opts <- do
+        pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
+        return $ map ("-F" ++) pkg_framework_paths
+
+    pkg_framework_opts <- do
+        pkg_frameworks <- getPackageFrameworks dflags dep_packages
+        return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
+
+    return (pkg_framework_path_opts ++ pkg_framework_opts)
+
+  | otherwise = return []
+
+getFrameworkOpts :: DynFlags -> Platform -> [String]
+getFrameworkOpts dflags platform
+  | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
+  | otherwise = []
+  where
+    framework_paths     = frameworkPaths dflags
+    framework_path_opts = map ("-F" ++) framework_paths
+
+    frameworks     = cmdlineFrameworks dflags
+    -- reverse because they're added in reverse order from the cmd line:
+    framework_opts = concat [ ["-framework", fw]
+                            | fw <- reverse frameworks ]
+
+{-
+Note [-Bsymbolic assumptions by GHC]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC has a few assumptions about interaction of relocations in NCG and linker:
+
+1. -Bsymbolic resolves internal references when the shared library is linked,
+   which is important for performance.
+2. When there is a reference to data in a shared library from the main program,
+   the runtime linker relocates the data object into the main program using an
+   R_*_COPY relocation.
+3. If we used -Bsymbolic, then this results in multiple copies of the data
+   object, because some references have already been resolved to point to the
+   original instance. This is bad!
+
+We work around [3.] for native compiled code by avoiding the generation of
+R_*_COPY relocations.
+
+Unregisterised compiler can't evade R_*_COPY relocations easily thus we disable
+-Bsymbolic linking there.
+
+See related tickets: #4210, #15338
+-}
diff --git a/compiler/GHC/SysTools/Ar.hs b/compiler/GHC/SysTools/Ar.hs
new file mode 100644
index 0000000000..200b652049
--- /dev/null
+++ b/compiler/GHC/SysTools/Ar.hs
@@ -0,0 +1,268 @@
+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, CPP #-}
+{- Note: [The need for Ar.hs]
+Building `-staticlib` required the presence of libtool, and was a such
+restricted to mach-o only. As libtool on macOS and gnu libtool are very
+different, there was no simple portable way to support this.
+
+libtool for static archives does essentially: concatinate the input archives,
+add the input objects, and create a symbol index. Using `ar` for this task
+fails as even `ar` (bsd and gnu, llvm, ...) do not provide the same
+features across platforms (e.g. index prefixed retrieval of objects with
+the same name.)
+
+As Archives are rather simple structurally, we can just build the archives
+with Haskell directly and use ranlib on the final result to get the symbol
+index. This should allow us to work around with the differences/abailability
+of libtool across different platforms.
+-}
+module GHC.SysTools.Ar
+  (ArchiveEntry(..)
+  ,Archive(..)
+  ,afilter
+
+  ,parseAr
+
+  ,loadAr
+  ,loadObj
+  ,writeBSDAr
+  ,writeGNUAr
+
+  ,isBSDSymdef
+  ,isGNUSymdef
+  )
+   where
+
+import GhcPrelude
+
+import Data.List (mapAccumL, isPrefixOf)
+import Data.Monoid ((<>))
+import Data.Binary.Get
+import Data.Binary.Put
+import Control.Monad
+import Control.Applicative
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as L
+#if !defined(mingw32_HOST_OS)
+import qualified System.Posix.Files as POSIX
+#endif
+import System.FilePath (takeFileName)
+
+data ArchiveEntry = ArchiveEntry
+    { filename :: String       -- ^ File name.
+    , filetime :: Int          -- ^ File modification time.
+    , fileown  :: Int          -- ^ File owner.
+    , filegrp  :: Int          -- ^ File group.
+    , filemode :: Int          -- ^ File mode.
+    , filesize :: Int          -- ^ File size.
+    , filedata :: B.ByteString -- ^ File bytes.
+    } deriving (Eq, Show)
+
+newtype Archive = Archive [ArchiveEntry]
+        deriving (Eq, Show, Semigroup, Monoid)
+
+afilter :: (ArchiveEntry -> Bool) -> Archive -> Archive
+afilter f (Archive xs) = Archive (filter f xs)
+
+isBSDSymdef, isGNUSymdef :: ArchiveEntry -> Bool
+isBSDSymdef a = "__.SYMDEF" `isPrefixOf` (filename a)
+isGNUSymdef a = "/" == (filename a)
+
+-- | Archives have numeric values padded with '\x20' to the right.
+getPaddedInt :: B.ByteString -> Int
+getPaddedInt = read . C.unpack . C.takeWhile (/= '\x20')
+
+putPaddedInt :: Int -> Int -> Put
+putPaddedInt padding i = putPaddedString '\x20' padding (show i)
+
+putPaddedString :: Char -> Int -> String -> Put
+putPaddedString pad padding s = putByteString . C.pack . take padding $ s `mappend` (repeat pad)
+
+getBSDArchEntries :: Get [ArchiveEntry]
+getBSDArchEntries = do
+    empty <- isEmpty
+    if empty then
+        return []
+     else do
+        name    <- getByteString 16
+        when ('/' `C.elem` name && C.take 3 name /= "#1/") $
+          fail "Looks like GNU Archive"
+        time    <- getPaddedInt <$> getByteString 12
+        own     <- getPaddedInt <$> getByteString 6
+        grp     <- getPaddedInt <$> getByteString 6
+        mode    <- getPaddedInt <$> getByteString 8
+        st_size <- getPaddedInt <$> getByteString 10
+        end     <- getByteString 2
+        when (end /= "\x60\x0a") $
+          fail ("[BSD Archive] Invalid archive header end marker for name: " ++
+                C.unpack name)
+        off1    <- liftM fromIntegral bytesRead :: Get Int
+        -- BSD stores extended filenames, by writing #1/<length> into the
+        -- name field, the first @length@ bytes then represent the file name
+        -- thus the payload size is filesize + file name length.
+        name    <- if C.unpack (C.take 3 name) == "#1/" then
+                        liftM (C.unpack . C.takeWhile (/= '\0')) (getByteString $ read $ C.unpack $ C.drop 3 name)
+                    else
+                        return $ C.unpack $ C.takeWhile (/= ' ') name
+        off2    <- liftM fromIntegral bytesRead :: Get Int
+        file    <- getByteString (st_size - (off2 - off1))
+        -- data sections are two byte aligned (see #15396)
+        when (odd st_size) $
+          void (getByteString 1)
+
+        rest    <- getBSDArchEntries
+        return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest
+
+-- | GNU Archives feature a special '//' entry that contains the
+-- extended names. Those are referred to as /<num>, where num is the
+-- offset into the '//' entry.
+-- In addition, filenames are terminated with '/' in the archive.
+getGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]
+getGNUArchEntries extInfo = do
+  empty <- isEmpty
+  if empty
+    then return []
+    else
+    do
+      name    <- getByteString 16
+      time    <- getPaddedInt <$> getByteString 12
+      own     <- getPaddedInt <$> getByteString 6
+      grp     <- getPaddedInt <$> getByteString 6
+      mode    <- getPaddedInt <$> getByteString 8
+      st_size <- getPaddedInt <$> getByteString 10
+      end     <- getByteString 2
+      when (end /= "\x60\x0a") $
+        fail ("[BSD Archive] Invalid archive header end marker for name: " ++
+              C.unpack name)
+      file <- getByteString st_size
+      -- data sections are two byte aligned (see #15396)
+      when (odd st_size) $
+        void (getByteString 1)
+      name <- return . C.unpack $
+        if C.unpack (C.take 1 name) == "/"
+        then case C.takeWhile (/= ' ') name of
+               name@"/"  -> name               -- symbol table
+               name@"//" -> name               -- extendedn file names table
+               name      -> getExtName extInfo (read . C.unpack $ C.drop 1 name)
+        else C.takeWhile (/= '/') name
+      case name of
+        "/"  -> getGNUArchEntries extInfo
+        "//" -> getGNUArchEntries (Just (ArchiveEntry name time own grp mode st_size file))
+        _    -> (ArchiveEntry name time own grp mode st_size file :) <$> getGNUArchEntries extInfo
+
+  where
+   getExtName :: Maybe ArchiveEntry -> Int -> B.ByteString
+   getExtName Nothing _ = error "Invalid extended filename reference."
+   getExtName (Just info) offset = C.takeWhile (/= '/') . C.drop offset $ filedata info
+
+-- | put an Archive Entry. This assumes that the entries
+-- have been preprocessed to account for the extenden file name
+-- table section "//" e.g. for GNU Archives. Or that the names
+-- have been move into the payload for BSD Archives.
+putArchEntry :: ArchiveEntry -> PutM ()
+putArchEntry (ArchiveEntry name time own grp mode st_size file) = do
+  putPaddedString ' '  16 name
+  putPaddedInt         12 time
+  putPaddedInt          6 own
+  putPaddedInt          6 grp
+  putPaddedInt          8 mode
+  putPaddedInt         10 (st_size + pad)
+  putByteString           "\x60\x0a"
+  putByteString           file
+  when (pad == 1) $
+    putWord8              0x0a
+  where
+    pad         = st_size `mod` 2
+
+getArchMagic :: Get ()
+getArchMagic = do
+  magic <- liftM C.unpack $ getByteString 8
+  if magic /= "!<arch>\n"
+    then fail $ "Invalid magic number " ++ show magic
+    else return ()
+
+putArchMagic :: Put
+putArchMagic = putByteString $ C.pack "!<arch>\n"
+
+getArch :: Get Archive
+getArch = Archive <$> do
+  getArchMagic
+  getBSDArchEntries <|> getGNUArchEntries Nothing
+
+putBSDArch :: Archive -> PutM ()
+putBSDArch (Archive as) = do
+  putArchMagic
+  mapM_ putArchEntry (processEntries as)
+
+  where
+    padStr pad size str = take size $ str <> repeat pad
+    nameSize name = case length name `divMod` 4 of
+      (n, 0) -> 4 * n
+      (n, _) -> 4 * (n + 1)
+    needExt name = length name > 16 || ' ' `elem` name
+    processEntry :: ArchiveEntry -> ArchiveEntry
+    processEntry archive@(ArchiveEntry name _ _ _ _ st_size _)
+      | needExt name = archive { filename = "#1/" <> show sz
+                               , filedata = C.pack (padStr '\0' sz name) <> filedata archive
+                               , filesize = st_size + sz }
+      | otherwise    = archive
+
+      where sz = nameSize name
+
+    processEntries = map processEntry
+
+putGNUArch :: Archive -> PutM ()
+putGNUArch (Archive as) = do
+  putArchMagic
+  mapM_ putArchEntry (processEntries as)
+
+  where
+    processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
+    processEntry extInfo archive@(ArchiveEntry name _ _ _ _ _ _)
+      | length name > 15 = ( extInfo { filesize = filesize extInfo + length name + 2
+                                    ,  filedata = filedata extInfo <>  C.pack name <> "/\n" }
+                           , archive { filename = "/" <> show (filesize extInfo) } )
+      | otherwise        = ( extInfo, archive { filename = name <> "/" } )
+
+    processEntries :: [ArchiveEntry] -> [ArchiveEntry]
+    processEntries =
+      uncurry (:) . mapAccumL processEntry (ArchiveEntry "//" 0 0 0 0 0 mempty)
+
+parseAr :: B.ByteString -> Archive
+parseAr = runGet getArch . L.fromChunks . pure
+
+writeBSDAr, writeGNUAr :: FilePath -> Archive -> IO ()
+writeBSDAr fp = L.writeFile fp . runPut . putBSDArch
+writeGNUAr fp = L.writeFile fp . runPut . putGNUArch
+
+loadAr :: FilePath -> IO Archive
+loadAr fp = parseAr <$> B.readFile fp
+
+loadObj :: FilePath -> IO ArchiveEntry
+loadObj fp = do
+  payload <- B.readFile fp
+  (modt, own, grp, mode) <- fileInfo fp
+  return $ ArchiveEntry
+    (takeFileName fp) modt own grp mode
+    (B.length payload) payload
+
+-- | Take a filePath and return (mod time, own, grp, mode in decimal)
+fileInfo :: FilePath -> IO ( Int, Int, Int, Int) -- ^ mod time, own, grp, mode (in decimal)
+#if defined(mingw32_HOST_OS)
+-- on windows mod time, owner group and mode are zero.
+fileInfo _ = pure (0,0,0,0)
+#else
+fileInfo fp = go <$> POSIX.getFileStatus fp
+  where go status = ( fromEnum $ POSIX.modificationTime status
+                    , fromIntegral $ POSIX.fileOwner status
+                    , fromIntegral $ POSIX.fileGroup status
+                    , oct2dec . fromIntegral $ POSIX.fileMode status
+                    )
+
+oct2dec :: Int -> Int
+oct2dec = foldl' (\a b -> a * 10 + b) 0 . reverse . dec 8
+  where dec _ 0 = []
+        dec b i = let (rest, last) = i `quotRem` b
+                  in last:dec b rest
+
+#endif
diff --git a/compiler/GHC/SysTools/BaseDir.hs b/compiler/GHC/SysTools/BaseDir.hs
new file mode 100644
index 0000000000..fe749b5cdc
--- /dev/null
+++ b/compiler/GHC/SysTools/BaseDir.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-
+-----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 2001-2017
+--
+-- Finding the compiler's base directory.
+--
+-----------------------------------------------------------------------------
+-}
+
+module GHC.SysTools.BaseDir
+  ( expandTopDir, expandToolDir
+  , findTopDir, findToolDir
+  , tryFindTopDir
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+-- See note [Base Dir] for why some of this logic is shared with ghc-pkg.
+import GHC.BaseDir
+
+import Panic
+
+import System.Environment (lookupEnv)
+import System.FilePath
+
+-- Windows
+#if defined(mingw32_HOST_OS)
+import System.Directory (doesDirectoryExist)
+#endif
+
+#if defined(mingw32_HOST_OS)
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#endif
+
+{-
+Note [topdir: How GHC finds its files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC needs various support files (library packages, RTS etc), plus
+various auxiliary programs (cp, gcc, etc).  It starts by finding topdir,
+the root of GHC's support files
+
+On Unix:
+  - ghc always has a shell wrapper that passes a -B<dir> option
+
+On Windows:
+  - ghc never has a shell wrapper.
+  - we can find the location of the ghc binary, which is
+        $topdir/<foo>/<something>.exe
+    where <something> may be "ghc", "ghc-stage2", or similar
+  - we strip off the "<foo>/<something>.exe" to leave $topdir.
+
+from topdir we can find package.conf, ghc-asm, etc.
+
+
+Note [tooldir: How GHC finds mingw on Windows]
+
+GHC has some custom logic on Windows for finding the mingw
+toolchain and perl. Depending on whether GHC is built
+with the make build system or Hadrian, and on whether we're
+running a bindist, we might find the mingw toolchain and perl
+either under $topdir/../{mingw, perl}/ or
+$topdir/../../{mingw, perl}/.
+
+-}
+
+-- | Expand occurrences of the @$tooldir@ interpolation in a string
+-- on Windows, leave the string untouched otherwise.
+expandToolDir :: Maybe FilePath -> String -> String
+#if defined(mingw32_HOST_OS)
+expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
+expandToolDir Nothing         _ = panic "Could not determine $tooldir"
+#else
+expandToolDir _ s = s
+#endif
+
+-- | Returns a Unix-format path pointing to TopDir.
+findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
+           -> IO String    -- TopDir (in Unix format '/' separated)
+findTopDir m_minusb = do
+  maybe_exec_dir <- tryFindTopDir m_minusb
+  case maybe_exec_dir of
+      -- "Just" on Windows, "Nothing" on unix
+      Nothing -> throwGhcExceptionIO $
+          InstallationError "missing -B<dir> option"
+      Just dir -> return dir
+
+tryFindTopDir
+  :: Maybe String -- ^ Maybe TopDir path (without the '-B' prefix).
+  -> IO (Maybe String) -- ^ TopDir (in Unix format '/' separated)
+tryFindTopDir (Just minusb) = return $ Just $ normalise minusb
+tryFindTopDir Nothing
+    = do -- The _GHC_TOP_DIR environment variable can be used to specify
+         -- the top dir when the -B argument is not specified. It is not
+         -- intended for use by users, it was added specifically for the
+         -- purpose of running GHC within GHCi.
+         maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR"
+         case maybe_env_top_dir of
+             Just env_top_dir -> return $ Just env_top_dir
+             -- Try directory of executable
+             Nothing -> getBaseDir
+
+
+-- See Note [tooldir: How GHC finds mingw and perl on Windows]
+-- Returns @Nothing@ when not on Windows.
+-- When called on Windows, it either throws an error when the
+-- tooldir can't be located, or returns @Just tooldirpath@.
+findToolDir
+  :: FilePath -- ^ topdir
+  -> IO (Maybe FilePath)
+#if defined(mingw32_HOST_OS)
+findToolDir top_dir = go 0 (top_dir </> "..")
+  where maxDepth = 3
+        go :: Int -> FilePath -> IO (Maybe FilePath)
+        go k path
+          | k == maxDepth = throwGhcExceptionIO $
+              InstallationError "could not detect mingw toolchain"
+          | otherwise = do
+              oneLevel <- doesDirectoryExist (path </> "mingw")
+              if oneLevel
+                then return (Just path)
+                else go (k+1) (path </> "..")
+#else
+findToolDir _ = return Nothing
+#endif
diff --git a/compiler/GHC/SysTools/Elf.hs b/compiler/GHC/SysTools/Elf.hs
new file mode 100644
index 0000000000..5d4d87af45
--- /dev/null
+++ b/compiler/GHC/SysTools/Elf.hs
@@ -0,0 +1,460 @@
+{-
+-----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 2015
+--
+-- ELF format tools
+--
+-----------------------------------------------------------------------------
+-}
+
+module GHC.SysTools.Elf (
+    readElfSectionByName,
+    readElfNoteAsString,
+    makeElfNote
+  ) where
+
+import GhcPrelude
+
+import AsmUtils
+import Exception
+import GHC.Driver.Session
+import GHC.Platform
+import ErrUtils
+import Maybes     (MaybeT(..),runMaybeT)
+import Util       (charToC)
+import Outputable (text,hcat,SDoc)
+
+import Control.Monad (when)
+import Data.Binary.Get
+import Data.Word
+import Data.Char (ord)
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as B8
+
+{- Note [ELF specification]
+   ~~~~~~~~~~~~~~~~~~~~~~~~
+
+   ELF (Executable and Linking Format) is described in the System V Application
+   Binary Interface (or ABI). The latter is composed of two parts: a generic
+   part and a processor specific part. The generic ABI describes the parts of
+   the interface that remain constant across all hardware implementations of
+   System V.
+
+   The latest release of the specification of the generic ABI is the version
+   4.1 from March 18, 1997:
+
+     - http://www.sco.com/developers/devspecs/gabi41.pdf
+
+   Since 1997, snapshots of the draft for the "next" version are published:
+
+     - http://www.sco.com/developers/gabi/
+
+   Quoting the notice on the website: "There is more than one instance of these
+   chapters to permit references to older instances to remain valid. All
+   modifications to these chapters are forward-compatible, so that correct use
+   of an older specification will not be invalidated by a newer instance.
+   Approximately on a yearly basis, a new instance will be saved, as it reaches
+   what appears to be a stable state."
+
+   Nevertheless we will see that since 1998 it is not true for Note sections.
+
+   Many ELF sections
+   -----------------
+
+   ELF-4.1: the normal section number fields in ELF are limited to 16 bits,
+   which runs out of bits when you try to cram in more sections than that. Two
+   fields are concerned: the one containing the number of the sections and the
+   one containing the index of the section that contains section's names. (The
+   same thing applies to the field containing the number of segments, but we
+   don't care about it here).
+
+   ELF-next: to solve this, theses fields in the ELF header have an escape
+   value (different for each case), and the actual section number is stashed
+   into unused fields in the first section header.
+
+   We support this extension as it is forward-compatible with ELF-4.1.
+   Moreover, GHC may generate objects with a lot of sections with the
+   "function-sections" feature (one section per function).
+
+   Note sections
+   -------------
+
+   Sections with type "note" (SHT_NOTE in the specification) are used to add
+   arbitrary data into an ELF file. An entry in a note section is composed of a
+   name, a type and a value.
+
+   ELF-4.1: "The note information in sections and program header elements holds
+   any number of entries, each of which is an array of 4-byte words in the
+   format of the target processor." Each entry has the following format:
+         | namesz |   Word32: size of the name string (including the ending \0)
+         | descsz |   Word32: size of the value
+         |  type  |   Word32: type of the note
+         |  name  |   Name string (with \0 padding to ensure 4-byte alignment)
+         |  ...   |
+         |  desc  |   Value (with \0 padding to ensure 4-byte alignment)
+         |  ...   |
+
+   ELF-next: "The note information in sections and program header elements
+   holds a variable amount of entries. In 64-bit objects (files with
+   e_ident[EI_CLASS] equal to ELFCLASS64), each entry is an array of 8-byte
+   words in the format of the target processor. In 32-bit objects (files with
+   e_ident[EI_CLASS] equal to ELFCLASS32), each entry is an array of 4-byte
+   words in the format of the target processor." (from 1998-2015 snapshots)
+
+   This is not forward-compatible with ELF-4.1. In practice, for almost all
+   platforms namesz, descz and type fields are 4-byte words for both 32-bit and
+   64-bit objects (see elf.h and readelf source code).
+
+   The only exception in readelf source code is for IA_64 machines with OpenVMS
+   OS: "This OS has so many departures from the ELF standard that we test it at
+   many places" (comment for is_ia64_vms() in readelf.c). In this case, namesz,
+   descsz and type fields are 8-byte words and name and value fields are padded
+   to ensure 8-byte alignment.
+
+   We don't support this platform in the following code. Reading a note section
+   could be done easily (by testing Machine and OS fields in the ELF header).
+   Writing a note section, however, requires that we generate a different
+   assembly code for GAS depending on the target platform and this is a little
+   bit more involved.
+
+-}
+
+
+-- | ELF header
+--
+-- The ELF header indicates the native word size (32-bit or 64-bit) and the
+-- endianness of the target machine. We directly store getters for words of
+-- different sizes as it is more convenient to use. We also store the word size
+-- as it is useful to skip some uninteresting fields.
+--
+-- Other information such as the target machine and OS are left out as we don't
+-- use them yet. We could add them in the future if we ever need them.
+data ElfHeader = ElfHeader
+   { gw16     :: Get Word16   -- ^ Get a Word16 with the correct endianness
+   , gw32     :: Get Word32   -- ^ Get a Word32 with the correct endianness
+   , gwN      :: Get Word64   -- ^ Get a Word with the correct word size
+                              --   and endianness
+   , wordSize :: Int          -- ^ Word size in bytes
+   }
+
+
+-- | Read the ELF header
+readElfHeader :: DynFlags -> ByteString -> IO (Maybe ElfHeader)
+readElfHeader dflags bs = runGetOrThrow getHeader bs `catchIO` \_ -> do
+    debugTraceMsg dflags 3 $
+      text ("Unable to read ELF header")
+    return Nothing
+  where
+    getHeader = do
+      magic    <- getWord32be
+      ws       <- getWord8
+      endian   <- getWord8
+      version  <- getWord8
+      skip 9  -- skip OSABI, ABI version and padding
+      when (magic /= 0x7F454C46 || version /= 1) $ fail "Invalid ELF header"
+
+      case (ws, endian) of
+          -- ELF 32, little endian
+          (1,1) -> return . Just $ ElfHeader
+                           getWord16le
+                           getWord32le
+                           (fmap fromIntegral getWord32le) 4
+          -- ELF 32, big endian
+          (1,2) -> return . Just $ ElfHeader
+                           getWord16be
+                           getWord32be
+                           (fmap fromIntegral getWord32be) 4
+          -- ELF 64, little endian
+          (2,1) -> return . Just $ ElfHeader
+                           getWord16le
+                           getWord32le
+                           (fmap fromIntegral getWord64le) 8
+          -- ELF 64, big endian
+          (2,2) -> return . Just $ ElfHeader
+                           getWord16be
+                           getWord32be
+                           (fmap fromIntegral getWord64be) 8
+          _     -> fail "Invalid ELF header"
+
+
+------------------
+-- SECTIONS
+------------------
+
+
+-- | Description of the section table
+data SectionTable = SectionTable
+  { sectionTableOffset :: Word64  -- ^ offset of the table describing sections
+  , sectionEntrySize   :: Word16  -- ^ size of an entry in the section table
+  , sectionEntryCount  :: Word64  -- ^ number of sections
+  , sectionNameIndex   :: Word32  -- ^ index of a special section which
+                                  --   contains section's names
+  }
+
+-- | Read the ELF section table
+readElfSectionTable :: DynFlags
+                    -> ElfHeader
+                    -> ByteString
+                    -> IO (Maybe SectionTable)
+
+readElfSectionTable dflags hdr bs = action `catchIO` \_ -> do
+    debugTraceMsg dflags 3 $
+      text ("Unable to read ELF section table")
+    return Nothing
+  where
+    getSectionTable :: Get SectionTable
+    getSectionTable = do
+      skip (24 + 2*wordSize hdr) -- skip header and some other fields
+      secTableOffset <- gwN hdr
+      skip 10
+      entrySize      <- gw16 hdr
+      entryCount     <- gw16 hdr
+      secNameIndex   <- gw16 hdr
+      return (SectionTable secTableOffset entrySize
+                           (fromIntegral entryCount)
+                           (fromIntegral secNameIndex))
+
+    action = do
+      secTable <- runGetOrThrow getSectionTable bs
+      -- In some cases, the number of entries and the index of the section
+      -- containing section's names must be found in unused fields of the first
+      -- section entry (see Note [ELF specification])
+      let
+        offSize0 = fromIntegral $ sectionTableOffset secTable + 8
+                                  + 3 * fromIntegral (wordSize hdr)
+        offLink0 = fromIntegral $ offSize0 + fromIntegral (wordSize hdr)
+
+      entryCount'     <- if sectionEntryCount secTable /= 0
+                          then return (sectionEntryCount secTable)
+                          else runGetOrThrow (gwN hdr) (LBS.drop offSize0 bs)
+      entryNameIndex' <- if sectionNameIndex secTable /= 0xffff
+                          then return (sectionNameIndex secTable)
+                          else runGetOrThrow (gw32 hdr) (LBS.drop offLink0 bs)
+      return (Just $ secTable
+        { sectionEntryCount = entryCount'
+        , sectionNameIndex  = entryNameIndex'
+        })
+
+
+-- | A section
+data Section = Section
+  { entryName :: ByteString   -- ^ Name of the section
+  , entryBS   :: ByteString   -- ^ Content of the section
+  }
+
+-- | Read a ELF section
+readElfSectionByIndex :: DynFlags
+                      -> ElfHeader
+                      -> SectionTable
+                      -> Word64
+                      -> ByteString
+                      -> IO (Maybe Section)
+
+readElfSectionByIndex dflags hdr secTable i bs = action `catchIO` \_ -> do
+    debugTraceMsg dflags 3 $
+      text ("Unable to read ELF section")
+    return Nothing
+  where
+    -- read an entry from the section table
+    getEntry = do
+      nameIndex <- gw32 hdr
+      skip (4+2*wordSize hdr)
+      offset    <- fmap fromIntegral $ gwN hdr
+      size      <- fmap fromIntegral $ gwN hdr
+      let bs' = LBS.take size (LBS.drop offset bs)
+      return (nameIndex,bs')
+
+    -- read the entry with the given index in the section table
+    getEntryByIndex x = runGetOrThrow getEntry bs'
+      where
+        bs' = LBS.drop off bs
+        off = fromIntegral $ sectionTableOffset secTable +
+                             x * fromIntegral (sectionEntrySize secTable)
+
+    -- Get the name of a section
+    getEntryName nameIndex = do
+      let idx = fromIntegral (sectionNameIndex secTable)
+      (_,nameTable) <- getEntryByIndex idx
+      let bs' = LBS.drop nameIndex nameTable
+      runGetOrThrow getLazyByteStringNul bs'
+
+    action = do
+      (nameIndex,bs') <- getEntryByIndex (fromIntegral i)
+      name            <- getEntryName (fromIntegral nameIndex)
+      return (Just $ Section name bs')
+
+
+-- | Find a section from its name. Return the section contents.
+--
+-- We do not perform any check on the section type.
+findSectionFromName :: DynFlags
+                    -> ElfHeader
+                    -> SectionTable
+                    -> String
+                    -> ByteString
+                    -> IO (Maybe ByteString)
+findSectionFromName dflags hdr secTable name bs =
+    rec [0..sectionEntryCount secTable - 1]
+  where
+    -- convert the required section name into a ByteString to perform
+    -- ByteString comparison instead of String comparison
+    name' = B8.pack name
+
+    -- compare recursively each section name and return the contents of
+    -- the matching one, if any
+    rec []     = return Nothing
+    rec (x:xs) = do
+      me <- readElfSectionByIndex dflags hdr secTable x bs
+      case me of
+        Just e | entryName e == name' -> return (Just (entryBS e))
+        _                             -> rec xs
+
+
+-- | Given a section name, read its contents as a ByteString.
+--
+-- If the section isn't found or if there is any parsing error, we return
+-- Nothing
+readElfSectionByName :: DynFlags
+                     -> ByteString
+                     -> String
+                     -> IO (Maybe LBS.ByteString)
+
+readElfSectionByName dflags bs name = action `catchIO` \_ -> do
+    debugTraceMsg dflags 3 $
+      text ("Unable to read ELF section \"" ++ name ++ "\"")
+    return Nothing
+  where
+    action = runMaybeT $ do
+      hdr      <- MaybeT $ readElfHeader dflags bs
+      secTable <- MaybeT $ readElfSectionTable dflags hdr bs
+      MaybeT $ findSectionFromName dflags hdr secTable name bs
+
+------------------
+-- NOTE SECTIONS
+------------------
+
+-- | read a Note as a ByteString
+--
+-- If you try to read a note from a section which does not support the Note
+-- format, the parsing is likely to fail and Nothing will be returned
+readElfNoteBS :: DynFlags
+              -> ByteString
+              -> String
+              -> String
+              -> IO (Maybe LBS.ByteString)
+
+readElfNoteBS dflags bs sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg dflags 3 $
+         text ("Unable to read ELF note \"" ++ noteId ++
+               "\" in section \"" ++ sectionName ++ "\"")
+    return Nothing
+  where
+    -- align the getter on n bytes
+    align n = do
+      m <- bytesRead
+      if m `mod` n == 0
+        then return ()
+        else skip 1 >> align n
+
+    -- noteId as a bytestring
+    noteId' = B8.pack noteId
+
+    -- read notes recursively until the one with a valid identifier is found
+    findNote hdr = do
+      align 4
+      namesz <- gw32 hdr
+      descsz <- gw32 hdr
+      _      <- gw32 hdr -- we don't use the note type
+      name   <- if namesz == 0
+                  then return LBS.empty
+                  else getLazyByteStringNul
+      align 4
+      desc  <- if descsz == 0
+                  then return LBS.empty
+                  else getLazyByteString (fromIntegral descsz)
+      if name == noteId'
+        then return $ Just desc
+        else findNote hdr
+
+
+    action = runMaybeT $ do
+      hdr  <- MaybeT $ readElfHeader dflags bs
+      sec  <- MaybeT $ readElfSectionByName dflags bs sectionName
+      MaybeT $ runGetOrThrow (findNote hdr) sec
+
+-- | read a Note as a String
+--
+-- If you try to read a note from a section which does not support the Note
+-- format, the parsing is likely to fail and Nothing will be returned
+readElfNoteAsString :: DynFlags
+                    -> FilePath
+                    -> String
+                    -> String
+                    -> IO (Maybe String)
+
+readElfNoteAsString dflags path sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg dflags 3 $
+         text ("Unable to read ELF note \"" ++ noteId ++
+               "\" in section \"" ++ sectionName ++ "\"")
+    return Nothing
+  where
+    action = do
+      bs   <- LBS.readFile path
+      note <- readElfNoteBS dflags bs sectionName noteId
+      return (fmap B8.unpack note)
+
+
+-- | Generate the GAS code to create a Note section
+--
+-- Header fields for notes are 32-bit long (see Note [ELF specification]).
+makeElfNote :: Platform -> String -> String -> Word32 -> String -> SDoc
+makeElfNote platform sectionName noteName typ contents = hcat [
+    text "\t.section ",
+    text sectionName,
+    text ",\"\",",
+    sectionType platform "note",
+    text "\n",
+    text "\t.balign 4\n",
+
+    -- note name length (+ 1 for ending \0)
+    asWord32 (length noteName + 1),
+
+    -- note contents size
+    asWord32 (length contents),
+
+    -- note type
+    asWord32 typ,
+
+    -- note name (.asciz for \0 ending string) + padding
+    text "\t.asciz \"",
+    text noteName,
+    text "\"\n",
+    text "\t.balign 4\n",
+
+    -- note contents (.ascii to avoid ending \0) + padding
+    text "\t.ascii \"",
+    text (escape contents),
+    text "\"\n",
+    text "\t.balign 4\n"]
+  where
+    escape :: String -> String
+    escape = concatMap (charToC.fromIntegral.ord)
+
+    asWord32 :: Show a => a -> SDoc
+    asWord32 x = hcat [
+      text "\t.4byte ",
+      text (show x),
+      text "\n"]
+
+
+------------------
+-- Helpers
+------------------
+
+-- | runGet in IO monad that throws an IOException on failure
+runGetOrThrow :: Get a -> LBS.ByteString -> IO a
+runGetOrThrow g bs = case runGetOrFail g bs of
+  Left _        -> fail "Error while reading file"
+  Right (_,_,a) -> return a
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
new file mode 100644
index 0000000000..f20f815107
--- /dev/null
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -0,0 +1,244 @@
+-----------------------------------------------------------------------------
+--
+-- GHC Extra object linking code
+--
+-- (c) The GHC Team 2017
+--
+-----------------------------------------------------------------------------
+
+module GHC.SysTools.ExtraObj (
+  mkExtraObj, mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
+  checkLinkInfo, getLinkInfo, getCompilerInfo,
+  ghcLinkInfoSectionName, ghcLinkInfoNoteName, platformSupportsSavingLinkOpts,
+  haveRtsOptsFlags
+) where
+
+import AsmUtils
+import ErrUtils
+import GHC.Driver.Session
+import GHC.Driver.Packages
+import GHC.Platform
+import Outputable
+import GHC.Types.SrcLoc ( noSrcSpan )
+import GHC.Types.Module
+import GHC.SysTools.Elf
+import Util
+import GhcPrelude
+
+import Control.Monad
+import Data.Maybe
+
+import Control.Monad.IO.Class
+
+import GHC.SysTools.FileCleanup
+import GHC.SysTools.Tasks
+import GHC.SysTools.Info
+
+mkExtraObj :: DynFlags -> Suffix -> String -> IO FilePath
+mkExtraObj dflags extn xs
+ = do cFile <- newTempName dflags TFL_CurrentModule extn
+      oFile <- newTempName dflags TFL_GhcSession "o"
+      writeFile cFile xs
+      ccInfo <- liftIO $ getCompilerInfo dflags
+      runCc Nothing dflags
+            ([Option        "-c",
+              FileOption "" cFile,
+              Option        "-o",
+              FileOption "" oFile]
+              ++ if extn /= "s"
+                    then cOpts
+                    else asmOpts ccInfo)
+      return oFile
+    where
+      -- Pass a different set of options to the C compiler depending one whether
+      -- we're compiling C or assembler. When compiling C, we pass the usual
+      -- set of include directories and PIC flags.
+      cOpts = map Option (picCCOpts dflags)
+                    ++ map (FileOption "-I")
+                            (includeDirs $ getPackageDetails dflags rtsUnitId)
+
+      -- When compiling assembler code, we drop the usual C options, and if the
+      -- compiler is Clang, we add an extra argument to tell Clang to ignore
+      -- unused command line options. See trac #11684.
+      asmOpts ccInfo =
+            if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
+                then [Option "-Qunused-arguments"]
+                else []
+
+-- When linking a binary, we need to create a C main() function that
+-- starts everything off.  This used to be compiled statically as part
+-- of the RTS, but that made it hard to change the -rtsopts setting,
+-- so now we generate and compile a main() stub as part of every
+-- binary and pass the -rtsopts setting directly to the RTS (#5373)
+--
+-- On Windows, when making a shared library we also may need a DllMain.
+--
+mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath
+mkExtraObjToLinkIntoBinary dflags = do
+  when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do
+     putLogMsg dflags NoReason SevInfo noSrcSpan
+         (defaultUserStyle dflags)
+         (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
+          text "    Call hs_init_ghc() from your main() function to set these options.")
+
+  mkExtraObj dflags "c" (showSDoc dflags main)
+  where
+    main
+      | gopt Opt_NoHsMain dflags = Outputable.empty
+      | otherwise
+          = case ghcLink dflags of
+                  LinkDynLib -> if platformOS (targetPlatform dflags) == OSMinGW32
+                                    then dllMain
+                                    else Outputable.empty
+                  _                      -> exeMain
+
+    exeMain = vcat [
+        text "#include <Rts.h>",
+        text "extern StgClosure ZCMain_main_closure;",
+        text "int main(int argc, char *argv[])",
+        char '{',
+        text " RtsConfig __conf = defaultRtsConfig;",
+        text " __conf.rts_opts_enabled = "
+            <> text (show (rtsOptsEnabled dflags)) <> semi,
+        text " __conf.rts_opts_suggestions = "
+            <> text (if rtsOptsSuggestions dflags
+                        then "true"
+                        else "false") <> semi,
+        text "__conf.keep_cafs = "
+            <> text (if gopt Opt_KeepCAFs dflags
+                       then "true"
+                       else "false") <> semi,
+        case rtsOpts dflags of
+            Nothing   -> Outputable.empty
+            Just opts -> text "    __conf.rts_opts= " <>
+                          text (show opts) <> semi,
+        text " __conf.rts_hs_main = true;",
+        text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
+        char '}',
+        char '\n' -- final newline, to keep gcc happy
+        ]
+
+    dllMain = vcat [
+        text "#include <Rts.h>",
+        text "#include <windows.h>",
+        text "#include <stdbool.h>",
+        char '\n',
+        text "bool",
+        text "WINAPI",
+        text "DllMain ( HINSTANCE hInstance STG_UNUSED",
+        text "        , DWORD reason STG_UNUSED",
+        text "        , LPVOID reserved STG_UNUSED",
+        text "        )",
+        text "{",
+        text "  return true;",
+        text "}",
+        char '\n' -- final newline, to keep gcc happy
+        ]
+
+-- Write out the link info section into a new assembly file. Previously
+-- this was included as inline assembly in the main.c file but this
+-- is pretty fragile. gas gets upset trying to calculate relative offsets
+-- that span the .note section (notably .text) when debug info is present
+mkNoteObjsToLinkIntoBinary :: DynFlags -> [InstalledUnitId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary dflags dep_packages = do
+   link_info <- getLinkInfo dflags dep_packages
+
+   if (platformSupportsSavingLinkOpts (platformOS platform ))
+     then fmap (:[]) $ mkExtraObj dflags "s" (showSDoc dflags (link_opts link_info))
+     else return []
+
+  where
+    platform = targetPlatform dflags
+    link_opts info = hcat [
+      -- "link info" section (see Note [LinkInfo section])
+      makeElfNote platform ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info,
+
+      -- ALL generated assembly must have this section to disable
+      -- executable stacks.  See also
+      -- compiler/nativeGen/AsmCodeGen.hs for another instance
+      -- where we need to do this.
+      if platformHasGnuNonexecStack platform
+        then text ".section .note.GNU-stack,\"\","
+             <> sectionType platform "progbits" <> char '\n'
+        else Outputable.empty
+      ]
+
+-- | Return the "link info" string
+--
+-- See Note [LinkInfo section]
+getLinkInfo :: DynFlags -> [InstalledUnitId] -> IO String
+getLinkInfo dflags dep_packages = do
+   package_link_opts <- getPackageLinkOpts dflags dep_packages
+   pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
+                     then getPackageFrameworks dflags dep_packages
+                     else return []
+   let extra_ld_inputs = ldInputs dflags
+   let
+      link_info = (package_link_opts,
+                   pkg_frameworks,
+                   rtsOpts dflags,
+                   rtsOptsEnabled dflags,
+                   gopt Opt_NoHsMain dflags,
+                   map showOpt extra_ld_inputs,
+                   getOpts dflags opt_l)
+   --
+   return (show link_info)
+
+platformSupportsSavingLinkOpts :: OS -> Bool
+platformSupportsSavingLinkOpts os
+ | os == OSSolaris2 = False -- see #5382
+ | otherwise        = osElfTarget os
+
+-- See Note [LinkInfo section]
+ghcLinkInfoSectionName :: String
+ghcLinkInfoSectionName = ".debug-ghc-link-info"
+  -- if we use the ".debug" prefix, then strip will strip it by default
+
+-- Identifier for the note (see Note [LinkInfo section])
+ghcLinkInfoNoteName :: String
+ghcLinkInfoNoteName = "GHC link info"
+
+-- Returns 'False' if it was, and we can avoid linking, because the
+-- previous binary was linked with "the same options".
+checkLinkInfo :: DynFlags -> [InstalledUnitId] -> FilePath -> IO Bool
+checkLinkInfo dflags pkg_deps exe_file
+ | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
+ -- ToDo: Windows and OS X do not use the ELF binary format, so
+ -- readelf does not work there.  We need to find another way to do
+ -- this.
+ = return False -- conservatively we should return True, but not
+                -- linking in this case was the behaviour for a long
+                -- time so we leave it as-is.
+ | otherwise
+ = do
+   link_info <- getLinkInfo dflags pkg_deps
+   debugTraceMsg dflags 3 $ text ("Link info: " ++ link_info)
+   m_exe_link_info <- readElfNoteAsString dflags exe_file
+                          ghcLinkInfoSectionName ghcLinkInfoNoteName
+   let sameLinkInfo = (Just link_info == m_exe_link_info)
+   debugTraceMsg dflags 3 $ case m_exe_link_info of
+     Nothing -> text "Exe link info: Not found"
+     Just s
+       | sameLinkInfo -> text ("Exe link info is the same")
+       | otherwise    -> text ("Exe link info is different: " ++ s)
+   return (not sameLinkInfo)
+
+{- Note [LinkInfo section]
+   ~~~~~~~~~~~~~~~~~~~~~~~
+
+The "link info" is a string representing the parameters of the link. We save
+this information in the binary, and the next time we link, if nothing else has
+changed, we use the link info stored in the existing binary to decide whether
+to re-link or not.
+
+The "link info" string is stored in a ELF section called ".debug-ghc-link-info"
+(see ghcLinkInfoSectionName) with the SHT_NOTE type.  For some time, it used to
+not follow the specified record-based format (see #11022).
+
+-}
+
+haveRtsOptsFlags :: DynFlags -> Bool
+haveRtsOptsFlags dflags =
+        isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
+                                       RtsOptsSafeOnly -> False
+                                       _ -> True
diff --git a/compiler/GHC/SysTools/FileCleanup.hs b/compiler/GHC/SysTools/FileCleanup.hs
new file mode 100644
index 0000000000..ef41185cdd
--- /dev/null
+++ b/compiler/GHC/SysTools/FileCleanup.hs
@@ -0,0 +1,314 @@
+{-# LANGUAGE CPP #-}
+module GHC.SysTools.FileCleanup
+  ( TempFileLifetime(..)
+  , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles
+  , addFilesToClean, changeTempFilesLifetime
+  , newTempName, newTempLibName, newTempDir
+  , withSystemTempDirectory, withTempDirectory
+  ) where
+
+import GhcPrelude
+
+import GHC.Driver.Session
+import ErrUtils
+import Outputable
+import Util
+import Exception
+import GHC.Driver.Phases
+
+import Control.Monad
+import Data.List
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.IORef
+import System.Directory
+import System.FilePath
+import System.IO.Error
+
+#if !defined(mingw32_HOST_OS)
+import qualified System.Posix.Internals
+#endif
+
+-- | Used when a temp file is created. This determines which component Set of
+-- FilesToClean will get the temp file
+data TempFileLifetime
+  = TFL_CurrentModule
+  -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the
+  -- end of upweep_mod
+  | TFL_GhcSession
+  -- ^ A file with lifetime TFL_GhcSession will be cleaned up at the end of
+  -- runGhc(T)
+  deriving (Show)
+
+cleanTempDirs :: DynFlags -> IO ()
+cleanTempDirs dflags
+   = unless (gopt Opt_KeepTmpFiles dflags)
+   $ mask_
+   $ do let ref = dirsToClean dflags
+        ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
+        removeTmpDirs dflags (Map.elems ds)
+
+-- | Delete all files in @filesToClean dflags@.
+cleanTempFiles :: DynFlags -> IO ()
+cleanTempFiles dflags
+   = unless (gopt Opt_KeepTmpFiles dflags)
+   $ mask_
+   $ do let ref = filesToClean dflags
+        to_delete <- atomicModifyIORef' ref $
+            \FilesToClean
+                { ftcCurrentModule = cm_files
+                , ftcGhcSession = gs_files
+                } -> ( emptyFilesToClean
+                     , Set.toList cm_files ++ Set.toList gs_files)
+        removeTmpFiles dflags to_delete
+
+-- | Delete all files in @filesToClean dflags@. That have lifetime
+-- TFL_CurrentModule.
+-- If a file must be cleaned eventually, but must survive a
+-- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.
+cleanCurrentModuleTempFiles :: DynFlags -> IO ()
+cleanCurrentModuleTempFiles dflags
+   = unless (gopt Opt_KeepTmpFiles dflags)
+   $ mask_
+   $ do let ref = filesToClean dflags
+        to_delete <- atomicModifyIORef' ref $
+            \ftc@FilesToClean{ftcCurrentModule = cm_files} ->
+                (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)
+        removeTmpFiles dflags to_delete
+
+-- | Ensure that new_files are cleaned on the next call of
+-- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.
+-- If any of new_files are already tracked, they will have their lifetime
+-- updated.
+addFilesToClean :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
+addFilesToClean dflags lifetime new_files = modifyIORef' (filesToClean dflags) $
+  \FilesToClean
+    { ftcCurrentModule = cm_files
+    , ftcGhcSession = gs_files
+    } -> case lifetime of
+      TFL_CurrentModule -> FilesToClean
+        { ftcCurrentModule = cm_files `Set.union` new_files_set
+        , ftcGhcSession = gs_files `Set.difference` new_files_set
+        }
+      TFL_GhcSession -> FilesToClean
+        { ftcCurrentModule = cm_files `Set.difference` new_files_set
+        , ftcGhcSession = gs_files `Set.union` new_files_set
+        }
+  where
+    new_files_set = Set.fromList new_files
+
+-- | Update the lifetime of files already being tracked. If any files are
+-- not being tracked they will be discarded.
+changeTempFilesLifetime :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()
+changeTempFilesLifetime dflags lifetime files = do
+  FilesToClean
+    { ftcCurrentModule = cm_files
+    , ftcGhcSession = gs_files
+    } <- readIORef (filesToClean dflags)
+  let old_set = case lifetime of
+        TFL_CurrentModule -> gs_files
+        TFL_GhcSession -> cm_files
+      existing_files = [f | f <- files, f `Set.member` old_set]
+  addFilesToClean dflags lifetime existing_files
+
+-- Return a unique numeric temp file suffix
+newTempSuffix :: DynFlags -> IO Int
+newTempSuffix dflags =
+  atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)
+
+-- Find a temporary name that doesn't already exist.
+newTempName :: DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
+newTempName dflags lifetime extn
+  = do d <- getTempDir dflags
+       findTempName (d </> "ghc_") -- See Note [Deterministic base name]
+  where
+    findTempName :: FilePath -> IO FilePath
+    findTempName prefix
+      = do n <- newTempSuffix dflags
+           let filename = prefix ++ show n <.> extn
+           b <- doesFileExist filename
+           if b then findTempName prefix
+                else do -- clean it up later
+                        addFilesToClean dflags lifetime [filename]
+                        return filename
+
+newTempDir :: DynFlags -> IO FilePath
+newTempDir dflags
+  = do d <- getTempDir dflags
+       findTempDir (d </> "ghc_")
+  where
+    findTempDir :: FilePath -> IO FilePath
+    findTempDir prefix
+      = do n <- newTempSuffix dflags
+           let filename = prefix ++ show n
+           b <- doesDirectoryExist filename
+           if b then findTempDir prefix
+                else do createDirectory filename
+                        -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename
+                        return filename
+
+newTempLibName :: DynFlags -> TempFileLifetime -> Suffix
+  -> IO (FilePath, FilePath, String)
+newTempLibName dflags lifetime extn
+  = do d <- getTempDir dflags
+       findTempName d ("ghc_")
+  where
+    findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
+    findTempName dir prefix
+      = do n <- newTempSuffix dflags -- See Note [Deterministic base name]
+           let libname = prefix ++ show n
+               filename = dir </> "lib" ++ libname <.> extn
+           b <- doesFileExist filename
+           if b then findTempName dir prefix
+                else do -- clean it up later
+                        addFilesToClean dflags lifetime [filename]
+                        return (filename, dir, libname)
+
+
+-- Return our temporary directory within tmp_dir, creating one if we
+-- don't have one yet.
+getTempDir :: DynFlags -> IO FilePath
+getTempDir dflags = do
+    mapping <- readIORef dir_ref
+    case Map.lookup tmp_dir mapping of
+        Nothing -> do
+            pid <- getProcessID
+            let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"
+            mask_ $ mkTempDir prefix
+        Just dir -> return dir
+  where
+    tmp_dir = tmpDir dflags
+    dir_ref = dirsToClean dflags
+
+    mkTempDir :: FilePath -> IO FilePath
+    mkTempDir prefix = do
+        n <- newTempSuffix dflags
+        let our_dir = prefix ++ show n
+
+        -- 1. Speculatively create our new directory.
+        createDirectory our_dir
+
+        -- 2. Update the dirsToClean mapping unless an entry already exists
+        -- (i.e. unless another thread beat us to it).
+        their_dir <- atomicModifyIORef' dir_ref $ \mapping ->
+            case Map.lookup tmp_dir mapping of
+                Just dir -> (mapping, Just dir)
+                Nothing  -> (Map.insert tmp_dir our_dir mapping, Nothing)
+
+        -- 3. If there was an existing entry, return it and delete the
+        -- directory we created.  Otherwise return the directory we created.
+        case their_dir of
+            Nothing  -> do
+                debugTraceMsg dflags 2 $
+                    text "Created temporary directory:" <+> text our_dir
+                return our_dir
+            Just dir -> do
+                removeDirectory our_dir
+                return dir
+      `catchIO` \e -> if isAlreadyExistsError e
+                      then mkTempDir prefix else ioError e
+
+{- Note [Deterministic base name]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The filename of temporary files, especially the basename of C files, can end
+up in the output in some form, e.g. as part of linker debug information. In the
+interest of bit-wise exactly reproducible compilation (#4012), the basename of
+the temporary file no longer contains random information (it used to contain
+the process id).
+
+This is ok, as the temporary directory used contains the pid (see getTempDir).
+-}
+removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
+removeTmpDirs dflags ds
+  = traceCmd dflags "Deleting temp dirs"
+             ("Deleting: " ++ unwords ds)
+             (mapM_ (removeWith dflags removeDirectory) ds)
+
+removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
+removeTmpFiles dflags fs
+  = warnNon $
+    traceCmd dflags "Deleting temp files"
+             ("Deleting: " ++ unwords deletees)
+             (mapM_ (removeWith dflags removeFile) deletees)
+  where
+     -- Flat out refuse to delete files that are likely to be source input
+     -- files (is there a worse bug than having a compiler delete your source
+     -- files?)
+     --
+     -- Deleting source files is a sign of a bug elsewhere, so prominently flag
+     -- the condition.
+    warnNon act
+     | null non_deletees = act
+     | otherwise         = do
+        putMsg dflags (text "WARNING - NOT deleting source files:"
+                       <+> hsep (map text non_deletees))
+        act
+
+    (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
+
+removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
+removeWith dflags remover f = remover f `catchIO`
+  (\e ->
+   let msg = if isDoesNotExistError e
+             then text "Warning: deleting non-existent" <+> text f
+             else text "Warning: exception raised when deleting"
+                                            <+> text f <> colon
+               $$ text (show e)
+   in debugTraceMsg dflags 2 msg
+  )
+
+#if defined(mingw32_HOST_OS)
+-- relies on Int == Int32 on Windows
+foreign import ccall unsafe "_getpid" getProcessID :: IO Int
+#else
+getProcessID :: IO Int
+getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
+#endif
+
+-- The following three functions are from the `temporary` package.
+
+-- | Create and use a temporary directory in the system standard temporary
+-- directory.
+--
+-- Behaves exactly the same as 'withTempDirectory', except that the parent
+-- temporary directory will be that returned by 'getTemporaryDirectory'.
+withSystemTempDirectory :: String   -- ^ Directory name template. See 'openTempFile'.
+                        -> (FilePath -> IO a) -- ^ Callback that can use the directory
+                        -> IO a
+withSystemTempDirectory template action =
+  getTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action
+
+
+-- | Create and use a temporary directory.
+--
+-- Creates a new temporary directory inside the given directory, making use
+-- of the template. The temp directory is deleted after use. For example:
+--
+-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...
+--
+-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
+-- @src/sdist.342@.
+withTempDirectory :: FilePath -- ^ Temp directory to create the directory in
+                  -> String   -- ^ Directory name template. See 'openTempFile'.
+                  -> (FilePath -> IO a) -- ^ Callback that can use the directory
+                  -> IO a
+withTempDirectory targetDir template =
+  Exception.bracket
+    (createTempDirectory targetDir template)
+    (ignoringIOErrors . removeDirectoryRecursive)
+
+ignoringIOErrors :: IO () -> IO ()
+ignoringIOErrors ioe = ioe `catch` (\e -> const (return ()) (e :: IOError))
+
+
+createTempDirectory :: FilePath -> String -> IO FilePath
+createTempDirectory dir template = do
+  pid <- getProcessID
+  findTempName pid
+  where findTempName x = do
+            let path = dir </> template ++ show x
+            createDirectory path
+            return path
+          `catchIO` \e -> if isAlreadyExistsError e
+                          then findTempName (x+1) else ioError e
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
new file mode 100644
index 0000000000..8051570755
--- /dev/null
+++ b/compiler/GHC/SysTools/Info.hs
@@ -0,0 +1,262 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+--
+-- Compiler information functions
+--
+-- (c) The GHC Team 2017
+--
+-----------------------------------------------------------------------------
+module GHC.SysTools.Info where
+
+import Exception
+import ErrUtils
+import GHC.Driver.Session
+import Outputable
+import Util
+
+import Data.List
+import Data.IORef
+
+import System.IO
+
+import GHC.Platform
+import GhcPrelude
+
+import GHC.SysTools.Process
+
+{- Note [Run-time linker info]
+
+See also: #5240, #6063, #10110
+
+Before 'runLink', we need to be sure to get the relevant information
+about the linker we're using at runtime to see if we need any extra
+options. For example, GNU ld requires '--reduce-memory-overheads' and
+'--hash-size=31' in order to use reasonable amounts of memory (see
+trac #5240.) But this isn't supported in GNU gold.
+
+Generally, the linker changing from what was detected at ./configure
+time has always been possible using -pgml, but on Linux it can happen
+'transparently' by installing packages like binutils-gold, which
+change what /usr/bin/ld actually points to.
+
+Clang vs GCC notes:
+
+For gcc, 'gcc -Wl,--version' gives a bunch of output about how to
+invoke the linker before the version information string. For 'clang',
+the version information for 'ld' is all that's output. For this
+reason, we typically need to slurp up all of the standard error output
+and look through it.
+
+Other notes:
+
+We cache the LinkerInfo inside DynFlags, since clients may link
+multiple times. The definition of LinkerInfo is there to avoid a
+circular dependency.
+
+-}
+
+{- Note [ELF needed shared libs]
+
+Some distributions change the link editor's default handling of
+ELF DT_NEEDED tags to include only those shared objects that are
+needed to resolve undefined symbols. For Template Haskell we need
+the last temporary shared library also if it is not needed for the
+currently linked temporary shared library. We specify --no-as-needed
+to override the default. This flag exists in GNU ld and GNU gold.
+
+The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
+(Mach-O) the flag is not needed.
+
+-}
+
+{- Note [Windows static libGCC]
+
+The GCC versions being upgraded to in #10726 are configured with
+dynamic linking of libgcc supported. This results in libgcc being
+linked dynamically when a shared library is created.
+
+This introduces thus an extra dependency on GCC dll that was not
+needed before by shared libraries created with GHC. This is a particular
+issue on Windows because you get a non-obvious error due to this missing
+dependency. This dependent dll is also not commonly on your path.
+
+For this reason using the static libgcc is preferred as it preserves
+the same behaviour that existed before. There are however some very good
+reasons to have the shared version as well as described on page 181 of
+https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :
+
+"There are several situations in which an application should use the
+ shared ‘libgcc’ instead of the static version. The most common of these
+ is when the application wishes to throw and catch exceptions across different
+ shared libraries. In that case, each of the libraries as well as the application
+ itself should use the shared ‘libgcc’. "
+
+-}
+
+neededLinkArgs :: LinkerInfo -> [Option]
+neededLinkArgs (GnuLD o)     = o
+neededLinkArgs (GnuGold o)   = o
+neededLinkArgs (LlvmLLD o)   = o
+neededLinkArgs (DarwinLD o)  = o
+neededLinkArgs (SolarisLD o) = o
+neededLinkArgs (AixLD o)     = o
+neededLinkArgs UnknownLD     = []
+
+-- Grab linker info and cache it in DynFlags.
+getLinkerInfo :: DynFlags -> IO LinkerInfo
+getLinkerInfo dflags = do
+  info <- readIORef (rtldInfo dflags)
+  case info of
+    Just v  -> return v
+    Nothing -> do
+      v <- getLinkerInfo' dflags
+      writeIORef (rtldInfo dflags) (Just v)
+      return v
+
+-- See Note [Run-time linker info].
+getLinkerInfo' :: DynFlags -> IO LinkerInfo
+getLinkerInfo' dflags = do
+  let platform = targetPlatform dflags
+      os = platformOS platform
+      (pgm,args0) = pgm_l dflags
+      args1     = map Option (getOpts dflags opt_l)
+      args2     = args0 ++ args1
+      args3     = filter notNull (map showOpt args2)
+
+      -- Try to grab the info from the process output.
+      parseLinkerInfo stdo _stde _exitc
+        | any ("GNU ld" `isPrefixOf`) stdo =
+          -- GNU ld specifically needs to use less memory. This especially
+          -- hurts on small object files. #5240.
+          -- Set DT_NEEDED for all shared libraries. #10110.
+          -- TODO: Investigate if these help or hurt when using split sections.
+          return (GnuLD $ map Option ["-Wl,--hash-size=31",
+                                      "-Wl,--reduce-memory-overheads",
+                                      -- ELF specific flag
+                                      -- see Note [ELF needed shared libs]
+                                      "-Wl,--no-as-needed"])
+
+        | any ("GNU gold" `isPrefixOf`) stdo =
+          -- GNU gold only needs --no-as-needed. #10110.
+          -- ELF specific flag, see Note [ELF needed shared libs]
+          return (GnuGold [Option "-Wl,--no-as-needed"])
+
+        | any ("LLD" `isPrefixOf`) stdo =
+          return (LlvmLLD $ map Option [
+                                      -- see Note [ELF needed shared libs]
+                                      "-Wl,--no-as-needed"])
+
+         -- Unknown linker.
+        | otherwise = fail "invalid --version output, or linker is unsupported"
+
+  -- Process the executable call
+  info <- catchIO (do
+             case os of
+               OSSolaris2 ->
+                 -- Solaris uses its own Solaris linker. Even all
+                 -- GNU C are recommended to configure with Solaris
+                 -- linker instead of using GNU binutils linker. Also
+                 -- all GCC distributed with Solaris follows this rule
+                 -- precisely so we assume here, the Solaris linker is
+                 -- used.
+                 return $ SolarisLD []
+               OSAIX ->
+                 -- IBM AIX uses its own non-binutils linker as well
+                 return $ AixLD []
+               OSDarwin ->
+                 -- Darwin has neither GNU Gold or GNU LD, but a strange linker
+                 -- that doesn't support --version. We can just assume that's
+                 -- what we're using.
+                 return $ DarwinLD []
+               OSMinGW32 ->
+                 -- GHC doesn't support anything but GNU ld on Windows anyway.
+                 -- Process creation is also fairly expensive on win32, so
+                 -- we short-circuit here.
+                 return $ GnuLD $ map Option
+                   [ -- Reduce ld memory usage
+                     "-Wl,--hash-size=31"
+                   , "-Wl,--reduce-memory-overheads"
+                     -- Emit gcc stack checks
+                     -- Note [Windows stack usage]
+                   , "-fstack-check"
+                     -- Force static linking of libGCC
+                     -- Note [Windows static libGCC]
+                   , "-static-libgcc" ]
+               _ -> do
+                 -- In practice, we use the compiler as the linker here. Pass
+                 -- -Wl,--version to get linker version info.
+                 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
+                                        (["-Wl,--version"] ++ args3)
+                                        c_locale_env
+                 -- Split the output by lines to make certain kinds
+                 -- of processing easier. In particular, 'clang' and 'gcc'
+                 -- have slightly different outputs for '-Wl,--version', but
+                 -- it's still easy to figure out.
+                 parseLinkerInfo (lines stdo) (lines stde) exitc
+            )
+            (\err -> do
+                debugTraceMsg dflags 2
+                    (text "Error (figuring out linker information):" <+>
+                     text (show err))
+                errorMsg dflags $ hang (text "Warning:") 9 $
+                  text "Couldn't figure out linker information!" $$
+                  text "Make sure you're using GNU ld, GNU gold" <+>
+                  text "or the built in OS X linker, etc."
+                return UnknownLD)
+  return info
+
+-- Grab compiler info and cache it in DynFlags.
+getCompilerInfo :: DynFlags -> IO CompilerInfo
+getCompilerInfo dflags = do
+  info <- readIORef (rtccInfo dflags)
+  case info of
+    Just v  -> return v
+    Nothing -> do
+      v <- getCompilerInfo' dflags
+      writeIORef (rtccInfo dflags) (Just v)
+      return v
+
+-- See Note [Run-time linker info].
+getCompilerInfo' :: DynFlags -> IO CompilerInfo
+getCompilerInfo' dflags = do
+  let pgm = pgm_c dflags
+      -- Try to grab the info from the process output.
+      parseCompilerInfo _stdo stde _exitc
+        -- Regular GCC
+        | any ("gcc version" `isInfixOf`) stde =
+          return GCC
+        -- Regular clang
+        | any ("clang version" `isInfixOf`) stde =
+          return Clang
+        -- FreeBSD clang
+        | any ("FreeBSD clang version" `isInfixOf`) stde =
+          return Clang
+        -- Xcode 5.1 clang
+        | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
+          return AppleClang51
+        -- Xcode 5 clang
+        | any ("Apple LLVM version" `isPrefixOf`) stde =
+          return AppleClang
+        -- Xcode 4.1 clang
+        | any ("Apple clang version" `isPrefixOf`) stde =
+          return AppleClang
+         -- Unknown linker.
+        | otherwise = fail "invalid -v output, or compiler is unsupported"
+
+  -- Process the executable call
+  info <- catchIO (do
+                (exitc, stdo, stde) <-
+                    readProcessEnvWithExitCode pgm ["-v"] c_locale_env
+                -- Split the output by lines to make certain kinds
+                -- of processing easier.
+                parseCompilerInfo (lines stdo) (lines stde) exitc
+            )
+            (\err -> do
+                debugTraceMsg dflags 2
+                    (text "Error (figuring out C compiler information):" <+>
+                     text (show err))
+                errorMsg dflags $ hang (text "Warning:") 9 $
+                  text "Couldn't figure out C compiler information!" $$
+                  text "Make sure you're using GNU gcc, or clang"
+                return UnknownCC)
+  return info
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
new file mode 100644
index 0000000000..82f7a6d2f0
--- /dev/null
+++ b/compiler/GHC/SysTools/Process.hs
@@ -0,0 +1,387 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+--
+-- Misc process handling code for SysTools
+--
+-- (c) The GHC Team 2017
+--
+-----------------------------------------------------------------------------
+module GHC.SysTools.Process where
+
+#include "HsVersions.h"
+
+import Exception
+import ErrUtils
+import GHC.Driver.Session
+import FastString
+import Outputable
+import Panic
+import GhcPrelude
+import Util
+import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
+
+import Control.Concurrent
+import Data.Char
+
+import System.Exit
+import System.Environment
+import System.FilePath
+import System.IO
+import System.IO.Error as IO
+import System.Process
+
+import GHC.SysTools.FileCleanup
+
+-- | Enable process jobs support on Windows if it can be expected to work (e.g.
+-- @process >= 1.6.8.0@).
+enableProcessJobs :: CreateProcess -> CreateProcess
+#if defined(MIN_VERSION_process)
+enableProcessJobs opts = opts { use_process_jobs = True }
+#else
+enableProcessJobs opts = opts
+#endif
+
+-- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
+-- inherited from the parent process, and output to stderr is not captured.
+readCreateProcessWithExitCode'
+    :: CreateProcess
+    -> IO (ExitCode, String)    -- ^ stdout
+readCreateProcessWithExitCode' proc = do
+    (_, Just outh, _, pid) <-
+        createProcess proc{ std_out = CreatePipe }
+
+    -- fork off a thread to start consuming the output
+    output  <- hGetContents outh
+    outMVar <- newEmptyMVar
+    _ <- forkIO $ evaluate (length output) >> putMVar outMVar ()
+
+    -- wait on the output
+    takeMVar outMVar
+    hClose outh
+
+    -- wait on the process
+    ex <- waitForProcess pid
+
+    return (ex, output)
+
+replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
+replaceVar (var, value) env =
+    (var, value) : filter (\(var',_) -> var /= var') env
+
+-- | Version of @System.Process.readProcessWithExitCode@ that takes a
+-- key-value tuple to insert into the environment.
+readProcessEnvWithExitCode
+    :: String -- ^ program path
+    -> [String] -- ^ program args
+    -> (String, String) -- ^ addition to the environment
+    -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
+readProcessEnvWithExitCode prog args env_update = do
+    current_env <- getEnvironment
+    readCreateProcessWithExitCode (enableProcessJobs $ proc prog args) {
+        env = Just (replaceVar env_update current_env) } ""
+
+-- Don't let gcc localize version info string, #8825
+c_locale_env :: (String, String)
+c_locale_env = ("LANGUAGE", "C")
+
+-- If the -B<dir> option is set, add <dir> to PATH.  This works around
+-- a bug in gcc on Windows Vista where it can't find its auxiliary
+-- binaries (see bug #1110).
+getGccEnv :: [Option] -> IO (Maybe [(String,String)])
+getGccEnv opts =
+  if null b_dirs
+     then return Nothing
+     else do env <- getEnvironment
+             return (Just (mangle_paths env))
+ where
+  (b_dirs, _) = partitionWith get_b_opt opts
+
+  get_b_opt (Option ('-':'B':dir)) = Left dir
+  get_b_opt other = Right other
+
+  -- Work around #1110 on Windows only (lest we stumble into #17266).
+#if defined(mingw32_HOST_OS)
+  mangle_paths = map mangle_path
+  mangle_path (path,paths) | map toUpper path == "PATH"
+        = (path, '\"' : head b_dirs ++ "\";" ++ paths)
+  mangle_path other = other
+#else
+  mangle_paths = id
+#endif
+
+
+-----------------------------------------------------------------------------
+-- Running an external program
+
+runSomething :: DynFlags
+             -> String          -- For -v message
+             -> String          -- Command name (possibly a full path)
+                                --      assumed already dos-ified
+             -> [Option]        -- Arguments
+                                --      runSomething will dos-ify them
+             -> IO ()
+
+runSomething dflags phase_name pgm args =
+  runSomethingFiltered dflags id phase_name pgm args Nothing Nothing
+
+-- | Run a command, placing the arguments in an external response file.
+--
+-- This command is used in order to avoid overlong command line arguments on
+-- Windows. The command line arguments are first written to an external,
+-- temporary response file, and then passed to the linker via @filepath.
+-- response files for passing them in. See:
+--
+--     https://gcc.gnu.org/wiki/Response_Files
+--     https://gitlab.haskell.org/ghc/ghc/issues/10777
+runSomethingResponseFile
+  :: DynFlags -> (String->String) -> String -> String -> [Option]
+  -> Maybe [(String,String)] -> IO ()
+
+runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
+    runSomethingWith dflags phase_name pgm args $ \real_args -> do
+        fp <- getResponseFile real_args
+        let args = ['@':fp]
+        r <- builderMainLoop dflags filter_fn pgm args Nothing mb_env
+        return (r,())
+  where
+    getResponseFile args = do
+      fp <- newTempName dflags TFL_CurrentModule "rsp"
+      withFile fp WriteMode $ \h -> do
+#if defined(mingw32_HOST_OS)
+          hSetEncoding h latin1
+#else
+          hSetEncoding h utf8
+#endif
+          hPutStr h $ unlines $ map escape args
+      return fp
+
+    -- Note: Response files have backslash-escaping, double quoting, and are
+    -- whitespace separated (some implementations use newline, others any
+    -- whitespace character). Therefore, escape any backslashes, newlines, and
+    -- double quotes in the argument, and surround the content with double
+    -- quotes.
+    --
+    -- Another possibility that could be considered would be to convert
+    -- backslashes in the argument to forward slashes. This would generally do
+    -- the right thing, since backslashes in general only appear in arguments
+    -- as part of file paths on Windows, and the forward slash is accepted for
+    -- those. However, escaping is more reliable, in case somehow a backslash
+    -- appears in a non-file.
+    escape x = concat
+        [ "\""
+        , concatMap
+            (\c ->
+                case c of
+                    '\\' -> "\\\\"
+                    '\n' -> "\\n"
+                    '\"' -> "\\\""
+                    _    -> [c])
+            x
+        , "\""
+        ]
+
+runSomethingFiltered
+  :: DynFlags -> (String->String) -> String -> String -> [Option]
+  -> Maybe FilePath -> Maybe [(String,String)] -> IO ()
+
+runSomethingFiltered dflags filter_fn phase_name pgm args mb_cwd mb_env = do
+    runSomethingWith dflags phase_name pgm args $ \real_args -> do
+        r <- builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env
+        return (r,())
+
+runSomethingWith
+  :: DynFlags -> String -> String -> [Option]
+  -> ([String] -> IO (ExitCode, a))
+  -> IO a
+
+runSomethingWith dflags phase_name pgm args io = do
+  let real_args = filter notNull (map showOpt args)
+      cmdLine = showCommandForUser pgm real_args
+  traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
+
+handleProc :: String -> String -> IO (ExitCode, r) -> IO r
+handleProc pgm phase_name proc = do
+    (rc, r) <- proc `catchIO` handler
+    case rc of
+      ExitSuccess{} -> return r
+      ExitFailure n -> throwGhcExceptionIO (
+            ProgramError ("`" ++ takeFileName pgm ++ "'" ++
+                          " failed in phase `" ++ phase_name ++ "'." ++
+                          " (Exit code: " ++ show n ++ ")"))
+  where
+    handler err =
+       if IO.isDoesNotExistError err
+          then does_not_exist
+          else throwGhcExceptionIO (ProgramError $ show err)
+
+    does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
+
+
+builderMainLoop :: DynFlags -> (String -> String) -> FilePath
+                -> [String] -> Maybe FilePath -> Maybe [(String, String)]
+                -> IO ExitCode
+builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
+  chan <- newChan
+
+  -- We use a mask here rather than a bracket because we want
+  -- to distinguish between cleaning up with and without an
+  -- exception. This is to avoid calling terminateProcess
+  -- unless an exception was raised.
+  let safely inner = mask $ \restore -> do
+        -- acquire
+        -- On Windows due to how exec is emulated the old process will exit and
+        -- a new process will be created. This means waiting for termination of
+        -- the parent process will get you in a race condition as the child may
+        -- not have finished yet.  This caused #16450.  To fix this use a
+        -- process job to track all child processes and wait for each one to
+        -- finish.
+        let procdata =
+              enableProcessJobs
+              $ (proc pgm real_args) { cwd = mb_cwd
+                                     , env = mb_env
+                                     , std_in  = CreatePipe
+                                     , std_out = CreatePipe
+                                     , std_err = CreatePipe
+                                     }
+        (Just hStdIn, Just hStdOut, Just hStdErr, hProcess) <- restore $
+          createProcess_ "builderMainLoop" procdata
+        let cleanup_handles = do
+              hClose hStdIn
+              hClose hStdOut
+              hClose hStdErr
+        r <- try $ restore $ do
+          hSetBuffering hStdOut LineBuffering
+          hSetBuffering hStdErr LineBuffering
+          let make_reader_proc h = forkIO $ readerProc chan h filter_fn
+          bracketOnError (make_reader_proc hStdOut) killThread $ \_ ->
+            bracketOnError (make_reader_proc hStdErr) killThread $ \_ ->
+            inner hProcess
+        case r of
+          -- onException
+          Left (SomeException e) -> do
+            terminateProcess hProcess
+            cleanup_handles
+            throw e
+          -- cleanup when there was no exception
+          Right s -> do
+            cleanup_handles
+            return s
+  safely $ \h -> do
+    -- we don't want to finish until 2 streams have been complete
+    -- (stdout and stderr)
+    log_loop chan (2 :: Integer)
+    -- after that, we wait for the process to finish and return the exit code.
+    waitForProcess h
+  where
+    -- t starts at the number of streams we're listening to (2) decrements each
+    -- time a reader process sends EOF. We are safe from looping forever if a
+    -- reader thread dies, because they send EOF in a finally handler.
+    log_loop _ 0 = return ()
+    log_loop chan t = do
+      msg <- readChan chan
+      case msg of
+        BuildMsg msg -> do
+          putLogMsg dflags NoReason SevInfo noSrcSpan
+              (defaultUserStyle dflags) msg
+          log_loop chan t
+        BuildError loc msg -> do
+          putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)
+              (defaultUserStyle dflags) msg
+          log_loop chan t
+        EOF ->
+          log_loop chan  (t-1)
+
+readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
+readerProc chan hdl filter_fn =
+    (do str <- hGetContents hdl
+        loop (linesPlatform (filter_fn str)) Nothing)
+    `finally`
+       writeChan chan EOF
+        -- ToDo: check errors more carefully
+        -- ToDo: in the future, the filter should be implemented as
+        -- a stream transformer.
+    where
+        loop []     Nothing    = return ()
+        loop []     (Just err) = writeChan chan err
+        loop (l:ls) in_err     =
+                case in_err of
+                  Just err@(BuildError srcLoc msg)
+                    | leading_whitespace l -> do
+                        loop ls (Just (BuildError srcLoc (msg $$ text l)))
+                    | otherwise -> do
+                        writeChan chan err
+                        checkError l ls
+                  Nothing -> do
+                        checkError l ls
+                  _ -> panic "readerProc/loop"
+
+        checkError l ls
+           = case parseError l of
+                Nothing -> do
+                    writeChan chan (BuildMsg (text l))
+                    loop ls Nothing
+                Just (file, lineNum, colNum, msg) -> do
+                    let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum
+                    loop ls (Just (BuildError srcLoc (text msg)))
+
+        leading_whitespace []    = False
+        leading_whitespace (x:_) = isSpace x
+
+parseError :: String -> Maybe (String, Int, Int, String)
+parseError s0 = case breakColon s0 of
+                Just (filename, s1) ->
+                    case breakIntColon s1 of
+                    Just (lineNum, s2) ->
+                        case breakIntColon s2 of
+                        Just (columnNum, s3) ->
+                            Just (filename, lineNum, columnNum, s3)
+                        Nothing ->
+                            Just (filename, lineNum, 0, s2)
+                    Nothing -> Nothing
+                Nothing -> Nothing
+
+-- | Break a line of an error message into a filename and the rest of the line,
+-- taking care to ignore colons in Windows drive letters (as noted in #17786).
+-- For instance,
+--
+-- * @"hi.c: ABCD"@ is mapped to @Just ("hi.c", "ABCD")@
+-- * @"C:\hi.c: ABCD"@ is mapped to @Just ("C:\hi.c", "ABCD")@
+breakColon :: String -> Maybe (String, String)
+breakColon = go []
+  where
+    -- Don't break on Windows drive letters (e.g. @C:\@ or @C:/@)
+    go accum  (':':'\\':rest) = go ('\\':':':accum) rest
+    go accum  (':':'/':rest)  = go ('/':':':accum) rest
+    go accum  (':':rest)      = Just (reverse accum, rest)
+    go accum  (c:rest)        = go (c:accum) rest
+    go _accum []              = Nothing
+
+breakIntColon :: String -> Maybe (Int, String)
+breakIntColon xs = case break (':' ==) xs of
+                       (ys, _:zs)
+                        | not (null ys) && all isAscii ys && all isDigit ys ->
+                           Just (read ys, zs)
+                       _ -> Nothing
+
+data BuildMessage
+  = BuildMsg   !SDoc
+  | BuildError !SrcLoc !SDoc
+  | EOF
+
+-- Divvy up text stream into lines, taking platform dependent
+-- line termination into account.
+linesPlatform :: String -> [String]
+#if !defined(mingw32_HOST_OS)
+linesPlatform ls = lines ls
+#else
+linesPlatform "" = []
+linesPlatform xs =
+  case lineBreak xs of
+    (as,xs1) -> as : linesPlatform xs1
+  where
+   lineBreak "" = ("","")
+   lineBreak ('\r':'\n':xs) = ([],xs)
+   lineBreak ('\n':xs) = ([],xs)
+   lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)
+
+#endif
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
new file mode 100644
index 0000000000..9d7b736fee
--- /dev/null
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -0,0 +1,373 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+--
+-- Tasks running external programs for SysTools
+--
+-- (c) The GHC Team 2017
+--
+-----------------------------------------------------------------------------
+module GHC.SysTools.Tasks where
+
+import Exception
+import ErrUtils
+import GHC.Driver.Types
+import GHC.Driver.Session
+import Outputable
+import GHC.Platform
+import Util
+
+import Data.List
+
+import System.IO
+import System.Process
+import GhcPrelude
+
+import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion)
+
+import GHC.SysTools.Process
+import GHC.SysTools.Info
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Running an external program}
+*                                                                      *
+************************************************************************
+-}
+
+runUnlit :: DynFlags -> [Option] -> IO ()
+runUnlit dflags args = traceToolCommand dflags "unlit" $ do
+  let prog = pgm_L dflags
+      opts = getOpts dflags opt_L
+  runSomething dflags "Literate pre-processor" prog
+               (map Option opts ++ args)
+
+runCpp :: DynFlags -> [Option] -> IO ()
+runCpp dflags args = traceToolCommand dflags "cpp" $ do
+  let (p,args0) = pgm_P dflags
+      args1 = map Option (getOpts dflags opt_P)
+      args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
+                ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
+  mb_env <- getGccEnv args2
+  runSomethingFiltered dflags id  "C pre-processor" p
+                       (args0 ++ args1 ++ args2 ++ args) Nothing mb_env
+
+runPp :: DynFlags -> [Option] -> IO ()
+runPp dflags args = traceToolCommand dflags "pp" $ do
+  let prog = pgm_F dflags
+      opts = map Option (getOpts dflags opt_F)
+  runSomething dflags "Haskell pre-processor" prog (args ++ opts)
+
+-- | Run compiler of C-like languages and raw objects (such as gcc or clang).
+runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
+runCc mLanguage dflags args = traceToolCommand dflags "cc" $ do
+  let p = pgm_c dflags
+      args1 = map Option userOpts
+      args2 = languageOptions ++ args ++ args1
+      -- We take care to pass -optc flags in args1 last to ensure that the
+      -- user can override flags passed by GHC. See #14452.
+  mb_env <- getGccEnv args2
+  runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
+ where
+  -- discard some harmless warnings from gcc that we can't turn off
+  cc_filter = unlines . doFilter . lines
+
+  {-
+  gcc gives warnings in chunks like so:
+      In file included from /foo/bar/baz.h:11,
+                       from /foo/bar/baz2.h:22,
+                       from wibble.c:33:
+      /foo/flibble:14: global register variable ...
+      /foo/flibble:15: warning: call-clobbered r...
+  We break it up into its chunks, remove any call-clobbered register
+  warnings from each chunk, and then delete any chunks that we have
+  emptied of warnings.
+  -}
+  doFilter = unChunkWarnings . filterWarnings . chunkWarnings []
+  -- We can't assume that the output will start with an "In file inc..."
+  -- line, so we start off expecting a list of warnings rather than a
+  -- location stack.
+  chunkWarnings :: [String] -- The location stack to use for the next
+                            -- list of warnings
+                -> [String] -- The remaining lines to look at
+                -> [([String], [String])]
+  chunkWarnings loc_stack [] = [(loc_stack, [])]
+  chunkWarnings loc_stack xs
+      = case break loc_stack_start xs of
+        (warnings, lss:xs') ->
+            case span loc_start_continuation xs' of
+            (lsc, xs'') ->
+                (loc_stack, warnings) : chunkWarnings (lss : lsc) xs''
+        _ -> [(loc_stack, xs)]
+
+  filterWarnings :: [([String], [String])] -> [([String], [String])]
+  filterWarnings [] = []
+  -- If the warnings are already empty then we are probably doing
+  -- something wrong, so don't delete anything
+  filterWarnings ((xs, []) : zs) = (xs, []) : filterWarnings zs
+  filterWarnings ((xs, ys) : zs) = case filter wantedWarning ys of
+                                       [] -> filterWarnings zs
+                                       ys' -> (xs, ys') : filterWarnings zs
+
+  unChunkWarnings :: [([String], [String])] -> [String]
+  unChunkWarnings [] = []
+  unChunkWarnings ((xs, ys) : zs) = xs ++ ys ++ unChunkWarnings zs
+
+  loc_stack_start        s = "In file included from " `isPrefixOf` s
+  loc_start_continuation s = "                 from " `isPrefixOf` s
+  wantedWarning w
+   | "warning: call-clobbered register used" `isContainedIn` w = False
+   | otherwise = True
+
+  -- force the C compiler to interpret this file as C when
+  -- compiling .hc files, by adding the -x c option.
+  -- Also useful for plain .c files, just in case GHC saw a
+  -- -x c option.
+  (languageOptions, userOpts) = case mLanguage of
+    Nothing -> ([], userOpts_c)
+    Just language -> ([Option "-x", Option languageName], opts)
+      where
+        (languageName, opts) = case language of
+          LangC      -> ("c",             userOpts_c)
+          LangCxx    -> ("c++",           userOpts_cxx)
+          LangObjc   -> ("objective-c",   userOpts_c)
+          LangObjcxx -> ("objective-c++", userOpts_cxx)
+          LangAsm    -> ("assembler",     [])
+          RawObject  -> ("c",             []) -- claim C for lack of a better idea
+  userOpts_c   = getOpts dflags opt_c
+  userOpts_cxx = getOpts dflags opt_cxx
+
+isContainedIn :: String -> String -> Bool
+xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
+
+-- | Run the linker with some arguments and return the output
+askLd :: DynFlags -> [Option] -> IO String
+askLd dflags args = traceToolCommand dflags "linker" $ do
+  let (p,args0) = pgm_l dflags
+      args1     = map Option (getOpts dflags opt_l)
+      args2     = args0 ++ args1 ++ args
+  mb_env <- getGccEnv args2
+  runSomethingWith dflags "gcc" p args2 $ \real_args ->
+    readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
+
+runAs :: DynFlags -> [Option] -> IO ()
+runAs dflags args = traceToolCommand dflags "as" $ do
+  let (p,args0) = pgm_a dflags
+      args1 = map Option (getOpts dflags opt_a)
+      args2 = args0 ++ args1 ++ args
+  mb_env <- getGccEnv args2
+  runSomethingFiltered dflags id "Assembler" p args2 Nothing mb_env
+
+-- | Run the LLVM Optimiser
+runLlvmOpt :: DynFlags -> [Option] -> IO ()
+runLlvmOpt dflags args = traceToolCommand dflags "opt" $ do
+  let (p,args0) = pgm_lo dflags
+      args1 = map Option (getOpts dflags opt_lo)
+      -- We take care to pass -optlo flags (e.g. args0) last to ensure that the
+      -- user can override flags passed by GHC. See #14821.
+  runSomething dflags "LLVM Optimiser" p (args1 ++ args ++ args0)
+
+-- | Run the LLVM Compiler
+runLlvmLlc :: DynFlags -> [Option] -> IO ()
+runLlvmLlc dflags args = traceToolCommand dflags "llc" $ do
+  let (p,args0) = pgm_lc dflags
+      args1 = map Option (getOpts dflags opt_lc)
+  runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
+
+-- | Run the clang compiler (used as an assembler for the LLVM
+-- backend on OS X as LLVM doesn't support the OS X system
+-- assembler)
+runClang :: DynFlags -> [Option] -> IO ()
+runClang dflags args = traceToolCommand dflags "clang" $ do
+  let (clang,_) = pgm_lcc dflags
+      -- be careful what options we call clang with
+      -- see #5903 and #7617 for bugs caused by this.
+      (_,args0) = pgm_a dflags
+      args1 = map Option (getOpts dflags opt_a)
+      args2 = args0 ++ args1 ++ args
+  mb_env <- getGccEnv args2
+  Exception.catch (do
+        runSomethingFiltered dflags id "Clang (Assembler)" clang args2 Nothing mb_env
+    )
+    (\(err :: SomeException) -> do
+        errorMsg dflags $
+            text ("Error running clang! you need clang installed to use the" ++
+                  " LLVM backend") $+$
+            text "(or GHC tried to execute clang incorrectly)"
+        throwIO err
+    )
+
+-- | Figure out which version of LLVM we are running this session
+figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
+figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
+  let (pgm,opts) = pgm_lc dflags
+      args = filter notNull (map showOpt opts)
+      -- we grab the args even though they should be useless just in
+      -- case the user is using a customised 'llc' that requires some
+      -- of the options they've specified. llc doesn't care what other
+      -- options are specified when '-version' is used.
+      args' = args ++ ["-version"]
+  catchIO (do
+              (pin, pout, perr, _) <- runInteractiveProcess pgm args'
+                                              Nothing Nothing
+              {- > llc -version
+                  LLVM (http://llvm.org/):
+                    LLVM version 3.5.2
+                    ...
+              -}
+              hSetBinaryMode pout False
+              _     <- hGetLine pout
+              vline <- hGetLine pout
+              let mb_ver = parseLlvmVersion vline
+              hClose pin
+              hClose pout
+              hClose perr
+              return mb_ver
+            )
+            (\err -> do
+                debugTraceMsg dflags 2
+                    (text "Error (figuring out LLVM version):" <+>
+                      text (show err))
+                errorMsg dflags $ vcat
+                    [ text "Warning:", nest 9 $
+                          text "Couldn't figure out LLVM version!" $$
+                          text ("Make sure you have installed LLVM " ++
+                                llvmVersionStr supportedLlvmVersion) ]
+                return Nothing)
+
+
+runLink :: DynFlags -> [Option] -> IO ()
+runLink dflags args = traceToolCommand dflags "linker" $ do
+  -- See Note [Run-time linker info]
+  --
+  -- `-optl` args come at the end, so that later `-l` options
+  -- given there manually can fill in symbols needed by
+  -- Haskell libraries coming in via `args`.
+  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
+  let (p,args0) = pgm_l dflags
+      optl_args = map Option (getOpts dflags opt_l)
+      args2     = args0 ++ linkargs ++ args ++ optl_args
+  mb_env <- getGccEnv args2
+  runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
+  where
+    ld_filter = case (platformOS (targetPlatform dflags)) of
+                  OSSolaris2 -> sunos_ld_filter
+                  _ -> id
+{-
+  SunOS/Solaris ld emits harmless warning messages about unresolved
+  symbols in case of compiling into shared library when we do not
+  link against all the required libs. That is the case of GHC which
+  does not link against RTS library explicitly in order to be able to
+  choose the library later based on binary application linking
+  parameters. The warnings look like:
+
+Undefined                       first referenced
+  symbol                             in file
+stg_ap_n_fast                       ./T2386_Lib.o
+stg_upd_frame_info                  ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
+newCAF                              ./T2386_Lib.o
+stg_bh_upd_frame_info               ./T2386_Lib.o
+stg_ap_ppp_fast                     ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
+stg_ap_p_fast                       ./T2386_Lib.o
+stg_ap_pp_fast                      ./T2386_Lib.o
+ld: warning: symbol referencing errors
+
+  this is actually coming from T2386 testcase. The emitting of those
+  warnings is also a reason why so many TH testcases fail on Solaris.
+
+  Following filter code is SunOS/Solaris linker specific and should
+  filter out only linker warnings. Please note that the logic is a
+  little bit more complex due to the simple reason that we need to preserve
+  any other linker emitted messages. If there are any. Simply speaking
+  if we see "Undefined" and later "ld: warning:..." then we omit all
+  text between (including) the marks. Otherwise we copy the whole output.
+-}
+    sunos_ld_filter :: String -> String
+    sunos_ld_filter = unlines . sunos_ld_filter' . lines
+    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
+                          then (ld_prefix x) ++ (ld_postfix x)
+                          else x
+    breakStartsWith x y = break (isPrefixOf x) y
+    ld_prefix = fst . breakStartsWith "Undefined"
+    undefined_found = not . null . snd . breakStartsWith "Undefined"
+    ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
+    ld_postfix = tail . snd . ld_warn_break
+    ld_warning_found = not . null . snd . ld_warn_break
+
+
+runLibtool :: DynFlags -> [Option] -> IO ()
+runLibtool dflags args = traceToolCommand dflags "libtool" $ do
+  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
+  let args1      = map Option (getOpts dflags opt_l)
+      args2      = [Option "-static"] ++ args1 ++ args ++ linkargs
+      libtool    = pgm_libtool dflags
+  mb_env <- getGccEnv args2
+  runSomethingFiltered dflags id "Linker" libtool args2 Nothing mb_env
+
+runAr :: DynFlags -> Maybe FilePath -> [Option] -> IO ()
+runAr dflags cwd args = traceToolCommand dflags "ar" $ do
+  let ar = pgm_ar dflags
+  runSomethingFiltered dflags id "Ar" ar args cwd Nothing
+
+askAr :: DynFlags -> Maybe FilePath -> [Option] -> IO String
+askAr dflags mb_cwd args = traceToolCommand dflags "ar" $ do
+  let ar = pgm_ar dflags
+  runSomethingWith dflags "Ar" ar args $ \real_args ->
+    readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd }
+
+runRanlib :: DynFlags -> [Option] -> IO ()
+runRanlib dflags args = traceToolCommand dflags "ranlib" $ do
+  let ranlib = pgm_ranlib dflags
+  runSomethingFiltered dflags id "Ranlib" ranlib args Nothing Nothing
+
+runMkDLL :: DynFlags -> [Option] -> IO ()
+runMkDLL dflags args = traceToolCommand dflags "mkdll" $ do
+  let (p,args0) = pgm_dll dflags
+      args1 = args0 ++ args
+  mb_env <- getGccEnv (args0++args)
+  runSomethingFiltered dflags id "Make DLL" p args1 Nothing mb_env
+
+runWindres :: DynFlags -> [Option] -> IO ()
+runWindres dflags args = traceToolCommand dflags "windres" $ do
+  let cc = pgm_c dflags
+      cc_args = map Option (sOpt_c (settings dflags))
+      windres = pgm_windres dflags
+      opts = map Option (getOpts dflags opt_windres)
+      quote x = "\"" ++ x ++ "\""
+      args' = -- If windres.exe and gcc.exe are in a directory containing
+              -- spaces then windres fails to run gcc. We therefore need
+              -- to tell it what command to use...
+              Option ("--preprocessor=" ++
+                      unwords (map quote (cc :
+                                          map showOpt opts ++
+                                          ["-E", "-xc", "-DRC_INVOKED"])))
+              -- ...but if we do that then if windres calls popen then
+              -- it can't understand the quoting, so we have to use
+              -- --use-temp-file so that it interprets it correctly.
+              -- See #1828.
+            : Option "--use-temp-file"
+            : args
+  mb_env <- getGccEnv cc_args
+  runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env
+
+touch :: DynFlags -> String -> String -> IO ()
+touch dflags purpose arg = traceToolCommand dflags "touch" $
+  runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
+
+-- * Tracing utility
+
+-- | Record in the eventlog when the given tool command starts
+--   and finishes, prepending the given 'String' with
+--   \"systool:\", to easily be able to collect and process
+--   all the systool events.
+--
+--   For those events to show up in the eventlog, you need
+--   to run GHC with @-v2@ or @-ddump-timings@.
+traceToolCommand :: DynFlags -> String -> IO a -> IO a
+traceToolCommand dflags tool = withTiming
+  dflags (text $ "systool:" ++ tool) (const ())
diff --git a/compiler/GHC/SysTools/Terminal.hs b/compiler/GHC/SysTools/Terminal.hs
new file mode 100644
index 0000000000..69c605bc73
--- /dev/null
+++ b/compiler/GHC/SysTools/Terminal.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where
+
+import GhcPrelude
+
+#if defined(MIN_VERSION_terminfo)
+import Control.Exception (catch)
+import Data.Maybe (fromMaybe)
+import System.Console.Terminfo (SetupTermError, Terminal, getCapability,
+                                setupTermFromEnv, termColors)
+import System.Posix (queryTerminal, stdError)
+#elif defined(mingw32_HOST_OS)
+import Control.Exception (catch, try)
+import Data.Bits ((.|.), (.&.))
+import Foreign (Ptr, peek, with)
+import qualified Graphics.Win32 as Win32
+import qualified System.Win32 as Win32
+#endif
+
+import System.IO.Unsafe
+
+#if defined(mingw32_HOST_OS) && !defined(WINAPI)
+# if defined(i386_HOST_ARCH)
+#  define WINAPI stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINAPI ccall
+# else
+#  error unknown architecture
+# endif
+#endif
+
+-- | Does the controlling terminal support ANSI color sequences?
+-- This memoized to avoid thread-safety issues in ncurses (see #17922).
+stderrSupportsAnsiColors :: Bool
+stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors'
+{-# NOINLINE stderrSupportsAnsiColors #-}
+
+-- | Check if ANSI escape sequences can be used to control color in stderr.
+stderrSupportsAnsiColors' :: IO Bool
+stderrSupportsAnsiColors' = do
+#if defined(MIN_VERSION_terminfo)
+    stderr_available <- queryTerminal stdError
+    if stderr_available then
+      fmap termSupportsColors setupTermFromEnv
+        `catch` \ (_ :: SetupTermError) -> pure False
+    else
+      pure False
+  where
+    termSupportsColors :: Terminal -> Bool
+    termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0
+
+#elif defined(mingw32_HOST_OS)
+  h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE
+         `catch` \ (_ :: IOError) ->
+           pure Win32.nullHANDLE
+  if h == Win32.nullHANDLE
+    then pure False
+    else do
+      eMode <- try (getConsoleMode h)
+      case eMode of
+        Left (_ :: IOError) -> Win32.isMinTTYHandle h
+                                 -- Check if the we're in a MinTTY terminal
+                                 -- (e.g., Cygwin or MSYS2)
+        Right mode
+          | modeHasVTP mode -> pure True
+          | otherwise       -> enableVTP h mode
+
+  where
+
+    enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool
+    enableVTP h mode = do
+        setConsoleMode h (modeAddVTP mode)
+        modeHasVTP <$> getConsoleMode h
+      `catch` \ (_ :: IOError) ->
+        pure False
+
+    modeHasVTP :: Win32.DWORD -> Bool
+    modeHasVTP mode = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0
+
+    modeAddVTP :: Win32.DWORD -> Win32.DWORD
+    modeAddVTP mode = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING
+
+eNABLE_VIRTUAL_TERMINAL_PROCESSING :: Win32.DWORD
+eNABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004
+
+getConsoleMode :: Win32.HANDLE -> IO Win32.DWORD
+getConsoleMode h = with 64 $ \ mode -> do
+  Win32.failIfFalse_ "GetConsoleMode" (c_GetConsoleMode h mode)
+  peek mode
+
+setConsoleMode :: Win32.HANDLE -> Win32.DWORD -> IO ()
+setConsoleMode h mode = do
+  Win32.failIfFalse_ "SetConsoleMode" (c_SetConsoleMode h mode)
+
+foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode
+  :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL
+
+foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode
+  :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL
+
+#else
+   pure False
+#endif
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 5630bde863..6f5d72a51a 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -58,7 +58,7 @@ import GHC.Tc.Utils.TcType
 import GHC.Types.Var as Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 import Util
 import Outputable
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index d727d7bb98..41aa86080d 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -31,7 +31,7 @@ import GHC.Core.DataCon
 import FastString
 import GHC.Hs
 import Outputable
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
 import State
@@ -44,7 +44,7 @@ import Util
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Id.Make (coerceId)
-import TysWiredIn (true_RDR, false_RDR)
+import GHC.Builtin.Types (true_RDR, false_RDR)
 
 import Data.Maybe (catMaybes, isJust)
 
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index d330d76827..4f00de2427 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -50,21 +50,21 @@ import Fingerprint
 import Encoding
 
 import GHC.Driver.Session
-import PrelInfo
+import GHC.Builtin.Utils
 import GHC.Tc.Instance.Family
 import GHC.Core.FamInstEnv
-import PrelNames
-import THNames
+import GHC.Builtin.Names
+import GHC.Builtin.Names.TH
 import GHC.Types.Id.Make ( coerceId )
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.SrcLoc
 import GHC.Core.TyCon
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Validity ( checkValidCoAxBranch )
 import GHC.Core.Coercion.Axiom ( coAxiomSingleBranch )
-import TysPrim
-import TysWiredIn
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
 import GHC.Core.Type
 import GHC.Core.Class
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index d40824e3ea..d4af39d83c 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -36,9 +36,9 @@ import GHC.Iface.Env    ( newGlobalBinder )
 import GHC.Types.Name hiding ( varName )
 import GHC.Types.Name.Reader
 import GHC.Types.Basic
-import TysPrim
-import TysWiredIn
-import PrelNames
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
+import GHC.Builtin.Names
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad
 import GHC.Driver.Types
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index 47257d6b23..a5351fcf86 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -26,7 +26,7 @@ import ErrUtils
 import GHC.Tc.Utils.Instantiate
 import Outputable
 import Pair
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Tc.Deriv.Utils
 import GHC.Tc.Utils.Env
 import GHC.Tc.Deriv.Generate
@@ -44,7 +44,7 @@ import GHC.Core.Type
 import GHC.Tc.Solver
 import GHC.Tc.Validity (validDerivPred)
 import GHC.Tc.Utils.Unify (buildImplicationFor, checkConstraints)
-import TysWiredIn (typeToTypeKind)
+import GHC.Builtin.Types (typeToTypeKind)
 import GHC.Core.Unify (tcUnifyTy)
 import Util
 import GHC.Types.Var
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 5394a09e23..63c0e3002c 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -38,7 +38,7 @@ import GHC.Iface.Load   (loadInterfaceForName)
 import GHC.Types.Module (getModule)
 import GHC.Types.Name
 import Outputable
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 import GHC.Tc.Deriv.Generate
 import GHC.Tc.Deriv.Functor
@@ -46,7 +46,7 @@ import GHC.Tc.Deriv.Generics
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcType
-import THNames (liftClassKey)
+import GHC.Builtin.Names.TH (liftClassKey)
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Ppr (pprSourceTyCon)
 import GHC.Core.Type
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 333e442803..ae08f78443 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -45,7 +45,7 @@ import GHC.Tc.Types.EvTerm
 import GHC.Hs.Binds ( PatSynBind(..) )
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual )
-import PrelNames ( typeableClassName )
+import GHC.Builtin.Names ( typeableClassName )
 import GHC.Types.Id
 import GHC.Types.Var
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index b361ca597d..771765901c 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -30,7 +30,7 @@ import GHC.Core.Type
 import GHC.Core.DataCon
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..), globalRdrEnvElts )
-import PrelNames ( gHC_ERR )
+import GHC.Builtin.Names ( gHC_ERR )
 import GHC.Types.Id
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -59,7 +59,7 @@ import GHC.Hs.Doc      ( unpackHDS, DeclDocMap(..) )
 import GHC.Driver.Types        ( ModIface_(..) )
 import GHC.Iface.Load  ( loadInterfaceForNameMaybe )
 
-import PrelInfo (knownKeyNames)
+import GHC.Builtin.Utils (knownKeyNames)
 
 import GHC.Tc.Errors.Hole.FitTypes
 
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 2cb5427119..58bbb40da2 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -30,9 +30,9 @@ import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Evidence
 import GHC.Types.Id( mkLocalId )
 import GHC.Tc.Utils.Instantiate
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Var.Set
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Types.Basic( Arity )
 import GHC.Types.SrcLoc
 import Outputable
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 8977ff3cd4..0773e943c7 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -45,8 +45,8 @@ import GHC.Tc.Instance.Family( tcGetFamInstEnvs )
 import GHC.Core.TyCon
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy)
-import TysPrim
-import TysWiredIn( mkBoxedTupleTy )
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types( mkBoxedTupleTy )
 import GHC.Types.Id
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
@@ -63,7 +63,7 @@ import Maybes
 import Util
 import GHC.Types.Basic
 import Outputable
-import PrelNames( ipClassName )
+import GHC.Builtin.Names( ipClassName )
 import GHC.Tc.Validity (checkValidType)
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs
index 29fb7ee7e0..bf1132aa3e 100644
--- a/compiler/GHC/Tc/Gen/Default.hs
+++ b/compiler/GHC/Tc/Gen/Default.hs
@@ -19,7 +19,7 @@ import GHC.Tc.Utils.Zonk
 import GHC.Tc.Solver
 import GHC.Tc.Validity
 import GHC.Tc.Utils.TcType
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 import Outputable
 import FastString
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 283bbce728..b384b494e4 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -10,7 +10,7 @@ module GHC.Tc.Gen.Export (tcRnExports, exports_from_avail) where
 import GhcPrelude
 
 import GHC.Hs
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Env
@@ -40,9 +40,9 @@ import FastString (fsLit)
 
 import Control.Monad
 import GHC.Driver.Session
-import GHC.Rename.Doc   ( rnHsDoc )
-import RdrHsSyn         ( setRdrNameSpace )
-import Data.Either      ( partitionEithers )
+import GHC.Rename.Doc         ( rnHsDoc )
+import GHC.Parser.PostProcess ( setRdrNameSpace )
+import Data.Either            ( partitionEithers )
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 3468a015e5..3048b78afa 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -36,7 +36,7 @@ where
 import GhcPrelude
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
-import THNames( liftStringName, liftName )
+import GHC.Builtin.Names.TH( liftStringName, liftName )
 
 import GHC.Hs
 import GHC.Tc.Types.Constraint ( HoleSort(..) )
@@ -77,10 +77,10 @@ import GHC.Core.TyCo.Subst (substTyWithInScope)
 import GHC.Core.Type
 import GHC.Tc.Types.Evidence
 import GHC.Types.Var.Set
-import TysWiredIn
-import TysPrim( intPrimTy )
-import PrimOp( tagToEnumKey )
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim( intPrimTy )
+import GHC.Builtin.PrimOps( tagToEnumKey )
+import GHC.Builtin.Names
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
 import Util
@@ -2013,14 +2013,14 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
                -- just going to flag an error for now
 
         ; lift <- if isStringTy id_ty then
-                     do { sid <- tcLookupId THNames.liftStringName
+                     do { sid <- tcLookupId GHC.Builtin.Names.TH.liftStringName
                                      -- See Note [Lifting strings]
                         ; return (HsVar noExtField (noLoc sid)) }
                   else
                      setConstraintVar lie_var   $
                           -- Put the 'lift' constraint into the right LIE
                      newMethodFromName (OccurrenceOf id_name)
-                                       THNames.liftName
+                                       GHC.Builtin.Names.TH.liftName
                                        [getRuntimeRep id_ty, id_ty]
 
                    -- Update the pending splices
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 050f3b5b89..f1031d6e14 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -54,7 +54,7 @@ import GHC.Types.Name.Reader
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Tc.Utils.TcType
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Driver.Session
 import Outputable
 import GHC.Platform
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 094ed623ac..313ae9cf58 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -89,7 +89,7 @@ import GHC.Tc.Errors      ( reportAllUnsolved )
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder )
 import GHC.Core.Type
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Types.Name.Reader( lookupLocalRdrOcc )
 import GHC.Types.Var
 import GHC.Types.Var.Set
@@ -100,10 +100,10 @@ import GHC.Core.Class
 import GHC.Types.Name
 -- import GHC.Types.Name.Set
 import GHC.Types.Var.Env
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
-import Constants ( mAX_CTUPLE_SIZE )
+import GHC.Settings.Constants ( mAX_CTUPLE_SIZE )
 import ErrUtils( MsgDoc )
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
@@ -111,7 +111,7 @@ import Util
 import GHC.Types.Unique.Supply
 import Outputable
 import FastString
-import PrelNames hiding ( wildCardName )
+import GHC.Builtin.Names hiding ( wildCardName )
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -1014,7 +1014,7 @@ bigConstraintTuple arity
 Note [Ignore unary constraint tuples]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 GHC provides unary tuples and unboxed tuples (see Note [One-tuples] in
-TysWiredIn) but does *not* provide unary constraint tuples. Why? First,
+GHC.Builtin.Types) but does *not* provide unary constraint tuples. Why? First,
 recall the definition of a unary tuple data type:
 
   data Unit a = Unit a
@@ -3311,7 +3311,7 @@ Consider
 An annoying difficulty happens if there are more than 62 inferred
 constraints. Then we need to fill in the TcTyVar with (say) a 70-tuple.
 Where do we find the TyCon?  For good reasons we only have constraint
-tuples up to 62 (see Note [How tuples work] in TysWiredIn).  So how
+tuples up to 62 (see Note [How tuples work] in GHC.Builtin.Types).  So how
 can we make a 70-tuple?  This was the root cause of #14217.
 
 It's incredibly tiresome, because we only need this type to fill
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 8fb7e7da7b..339093b47c 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -50,10 +50,10 @@ import GHC.Tc.Gen.Bind
 import GHC.Tc.Utils.Unify
 import GHC.Tc.Types.Origin
 import GHC.Types.Name
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Id
 import GHC.Core.TyCon
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Tc.Types.Evidence
 import Outputable
 import Util
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index f218b4e1be..9b3318a78f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -47,14 +47,14 @@ import GHC.Core.TyCo.Ppr ( pprTyVars )
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Unify
 import GHC.Tc.Gen.HsType
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Origin
 import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Core.ConLike
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index cf7bd3c51d..83fab20ca5 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -44,7 +44,7 @@ import GHC.Core.Type ( mkTyVarBinders )
 import GHC.Driver.Session
 import GHC.Types.Var ( TyVar, tyVarKind )
 import GHC.Types.Id  ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId )
-import PrelNames( mkUnboundName )
+import GHC.Builtin.Names( mkUnboundName )
 import GHC.Types.Basic
 import GHC.Types.Module( getModule )
 import GHC.Types.Name
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index f60f6682d2..87b23a8b27 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -46,12 +46,12 @@ import GHC.Tc.Utils.TcType
 import Outputable
 import GHC.Tc.Gen.Expr
 import GHC.Types.SrcLoc
-import THNames
+import GHC.Builtin.Names.TH
 import GHC.Tc.Utils.Unify
 import GHC.Tc.Utils.Env
 import GHC.Tc.Types.Origin
 import GHC.Core.Coercion( etaExpandCoAxBranch )
-import FileCleanup ( newTempName, TempFileLifetime(..) )
+import GHC.SysTools.FileCleanup ( newTempName, TempFileLifetime(..) )
 
 import Control.Monad
 
@@ -84,8 +84,8 @@ import GHC.Core.FamInstEnv
 import GHC.Core.InstEnv as InstEnv
 import GHC.Tc.Utils.Instantiate
 import GHC.Types.Name.Env
-import PrelNames
-import TysWiredIn
+import GHC.Builtin.Names
+import GHC.Builtin.Types
 import GHC.Types.Name.Occurrence as OccName
 import GHC.Driver.Hooks
 import GHC.Types.Var
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs
index 81ee5aec71..53054de7f8 100644
--- a/compiler/GHC/Tc/Instance/Class.hs
+++ b/compiler/GHC/Tc/Instance/Class.hs
@@ -26,9 +26,9 @@ import GHC.Core.InstEnv
 import GHC.Tc.Utils.Instantiate( instDFunType )
 import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
 
-import TysWiredIn
-import TysPrim( eqPrimTyCon, eqReprPrimTyCon )
-import PrelNames
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim( eqPrimTyCon, eqReprPrimTyCon )
+import GHC.Builtin.Names
 
 import GHC.Types.Id
 import GHC.Core.Type
@@ -569,7 +569,7 @@ if you'd written
 *                                                                     *
 ***********************************************************************-}
 
--- See also Note [The equality types story] in TysPrim
+-- See also Note [The equality types story] in GHC.Builtin.Types.Prim
 matchHeteroEquality :: [Type] -> TcM ClsInstResult
 -- Solves (t1 ~~ t2)
 matchHeteroEquality args
@@ -585,7 +585,7 @@ matchHomoEquality args@[k,t1,t2]
                     , cir_what      = BuiltinEqInstance })
 matchHomoEquality args = pprPanic "matchHomoEquality" (ppr args)
 
--- See also Note [The equality types story] in TysPrim
+-- See also Note [The equality types story] in GHC.Builtin.Types.Prim
 matchCoercible :: [Type] -> TcM ClsInstResult
 matchCoercible args@[k, t1, t2]
   = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ]
diff --git a/compiler/GHC/Tc/Instance/FunDeps.hs b/compiler/GHC/Tc/Instance/FunDeps.hs
index 73a1317692..40344af9ed 100644
--- a/compiler/GHC/Tc/Instance/FunDeps.hs
+++ b/compiler/GHC/Tc/Instance/FunDeps.hs
@@ -516,7 +516,7 @@ Note [Equality superclasses]
 Suppose we have
   class (a ~ [b]) => C a b
 
-Remember from Note [The equality types story] in TysPrim, that
+Remember from Note [The equality types story] in GHC.Builtin.Types.Prim, that
   * (a ~~ b) is a superclass of (a ~ b)
   * (a ~# b) is a superclass of (a ~~ b)
 
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index 842157a3d4..c3e59b2f4c 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -23,9 +23,10 @@ import GHC.Tc.Types.Evidence ( mkWpTyApps )
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcType
 import GHC.Driver.Types ( lookupId )
-import PrelNames
-import TysPrim ( primTyCons )
-import TysWiredIn ( tupleTyCon, sumTyCon, runtimeRepTyCon
+import GHC.Builtin.Names
+import GHC.Builtin.Types.Prim ( primTyCons )
+import GHC.Builtin.Types
+                  ( tupleTyCon, sumTyCon, runtimeRepTyCon
                   , vecCountTyCon, vecElemTyCon
                   , nilDataCon, consDataCon )
 import GHC.Types.Name
@@ -39,7 +40,7 @@ import GHC.Driver.Session
 import Bag
 import GHC.Types.Var ( VarBndr(..) )
 import GHC.Core.Map
-import Constants
+import GHC.Settings.Constants
 import Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
 import Outputable
 import FastString ( FastString, mkFastString, fsLit )
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 091968ed21..17f2dd69d5 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -62,15 +62,15 @@ import GHC.Rename.HsType
 import GHC.Rename.Expr
 import GHC.Rename.Utils  ( HsDocContext(..) )
 import GHC.Rename.Fixity ( lookupFixityRn )
-import TysWiredIn ( unitTy, mkListTy )
+import GHC.Builtin.Types ( unitTy, mkListTy )
 import GHC.Driver.Plugins
 import GHC.Driver.Session
 import GHC.Hs
 import GHC.Iface.Syntax ( ShowSub(..), showToHeader )
 import GHC.Iface.Type   ( ShowForAllFlag(..) )
 import GHC.Core.PatSyn( pprPatSynType )
-import PrelNames
-import PrelInfo
+import GHC.Builtin.Names
+import GHC.Builtin.Utils
 import GHC.Types.Name.Reader
 import GHC.Tc.Utils.Zonk
 import GHC.Tc.Gen.Expr
@@ -90,7 +90,7 @@ import GHC.Core.FamInstEnv
 import GHC.Tc.Gen.Annotation
 import GHC.Tc.Gen.Bind
 import GHC.Iface.Make   ( coAxiomToIfaceDecl )
-import HeaderInfo       ( mkPrelImports )
+import GHC.Parser.Header       ( mkPrelImports )
 import GHC.Tc.Gen.Default
 import GHC.Tc.Utils.Env
 import GHC.Tc.Gen.Rule
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index ad2c7816d2..c060eac638 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -36,8 +36,8 @@ import GHC.Tc.Utils.Instantiate
 import ListSetOps
 import GHC.Types.Name
 import Outputable
-import PrelInfo
-import PrelNames
+import GHC.Builtin.Utils
+import GHC.Builtin.Names
 import GHC.Tc.Errors
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Solver.Interact
@@ -50,8 +50,8 @@ import GHC.Core.Predicate
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type
-import TysWiredIn     ( liftedRepTy )
-import GHC.Core.Unify ( tcMatchTyKi )
+import GHC.Builtin.Types ( liftedRepTy )
+import GHC.Core.Unify    ( tcMatchTyKi )
 import Util
 import GHC.Types.Var
 import GHC.Types.Var.Set
@@ -665,7 +665,7 @@ tcNormalise given_ids ty
 Expand superclasses before starting, because (Int ~ Bool), has
 (Int ~~ Bool) as a superclass, which in turn has (Int ~N# Bool)
 as a superclass, and it's the latter that is insoluble.  See
-Note [The equality types story] in TysPrim.
+Note [The equality types story] in GHC.Builtin.Types.Prim.
 
 If we fail to prove unsatisfiability we (arbitrarily) try just once to
 find superclasses, using try_harder.  Reason: we might have a type
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs
index f9e0562c7b..acb9ca5543 100644
--- a/compiler/GHC/Tc/Solver/Interact.hs
+++ b/compiler/GHC/Tc/Solver/Interact.hs
@@ -24,7 +24,7 @@ import GHC.Core.Coercion.Axiom  ( sfInteractTop, sfInteractInert )
 
 import GHC.Types.Var
 import GHC.Tc.Utils.TcType
-import PrelNames ( coercibleTyConKey,
+import GHC.Builtin.Names ( coercibleTyConKey,
                    heqTyConKey, eqTyConKey, ipClassKey )
 import GHC.Core.Coercion.Axiom ( TypeEqn, CoAxiom(..), CoAxBranch(..), fromBranches )
 import GHC.Core.Class
@@ -2489,7 +2489,7 @@ matchClassInst dflags inerts clas tys loc
 -- | If a class is "naturally coherent", then we needn't worry at all, in any
 -- way, about overlapping/incoherent instances. Just solve the thing!
 -- See Note [Naturally coherent classes]
--- See also Note [The equality class story] in TysPrim.
+-- See also Note [The equality class story] in GHC.Builtin.Types.Prim.
 naturallyCoherentClass :: Class -> Bool
 naturallyCoherentClass cls
   = isCTupleClass cls
@@ -2590,7 +2590,7 @@ For example, consider (~~), which behaves as if it was defined like
 this:
   class a ~# b => a ~~ b
   instance a ~# b => a ~~ b
-(See Note [The equality types story] in TysPrim.)
+(See Note [The equality types story] in GHC.Builtin.Types.Prim.)
 
 Faced with [W] t1 ~~ t2, it's always OK to reduce it to [W] t1 ~# t2,
 without worrying about Note [Instance and Given overlap].  Why?  Because
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 0aea474320..822ccb2248 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -246,7 +246,7 @@ Note [Prioritise class equalities]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We prioritise equalities in the solver (see selectWorkItem). But class
 constraints like (a ~ b) and (a ~~ b) are actually equalities too;
-see Note [The equality types story] in TysPrim.
+see Note [The equality types story] in GHC.Builtin.Types.Prim.
 
 Failing to prioritise these is inefficient (more kick-outs etc).
 But, worse, it can prevent us spotting a "recursive knot" among
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 612348c4f3..07d1453a5c 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -42,7 +42,7 @@ import GHC.Tc.Utils.Unify ( checkTvConstraints )
 import GHC.Tc.Gen.HsType
 import GHC.Tc.Instance.Class( AssocInstInfo(..) )
 import GHC.Tc.Utils.TcMType
-import TysWiredIn ( unitTy, makeRecoveryTyCon )
+import GHC.Builtin.Types ( unitTy, makeRecoveryTyCon )
 import GHC.Tc.Utils.TcType
 import GHC.Rename.Env( lookupConstructorFields )
 import GHC.Tc.Instance.Family
diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs
index a118630fda..908f1398d7 100644
--- a/compiler/GHC/Tc/TyCl/Build.hs
+++ b/compiler/GHC/Tc/TyCl/Build.hs
@@ -21,8 +21,8 @@ import GhcPrelude
 
 import GHC.Iface.Env
 import GHC.Core.FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
-import TysWiredIn( isCTupleTyConName )
-import TysPrim ( voidPrimTy )
+import GHC.Builtin.Types( isCTupleTyConName )
+import GHC.Builtin.Types.Prim ( voidPrimTy )
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import GHC.Types.Var
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 6bee37fafd..0a719d90d2 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -30,7 +30,7 @@ import GHC.Tc.Gen.Sig( emptyPragEnv, completeSigFromId )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Zonk
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Types.Name
 import GHC.Types.SrcLoc
 import GHC.Core.PatSyn
@@ -47,7 +47,7 @@ import GHC.Types.Basic
 import GHC.Tc.Solver
 import GHC.Tc.Utils.Unify
 import GHC.Core.Predicate
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Origin
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 3101a96ac5..d12e7efce4 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -38,7 +38,7 @@ import GHC.Tc.Gen.Bind( tcValBinds )
 import GHC.Core.TyCo.Rep( Type(..), Coercion(..), MCoercion(..), UnivCoProvenance(..) )
 import GHC.Tc.Utils.TcType
 import GHC.Core.Predicate
-import TysWiredIn( unitTy )
+import GHC.Builtin.Types( unitTy )
 import GHC.Core.Make( rEC_SEL_ERROR_ID )
 import GHC.Hs
 import GHC.Core.Class
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index dcf6fc94b6..e5f5fdbf50 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -120,7 +120,7 @@ import Outputable
 import ListSetOps
 import Fingerprint
 import Util
-import PrelNames ( isUnboundName )
+import GHC.Builtin.Names ( isUnboundName )
 import GHC.Types.CostCentre.State
 
 import Control.Monad (ap)
diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs
index db5c6d1ce1..09f016ca71 100644
--- a/compiler/GHC/Tc/Types/EvTerm.hs
+++ b/compiler/GHC/Tc/Types/EvTerm.hs
@@ -17,7 +17,7 @@ import GHC.Driver.Session
 import GHC.Types.Name
 import GHC.Types.Module
 import GHC.Core.Utils
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 
 -- Used with Opt_DeferTypeErrors
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index cf59896f9d..922055ebf5 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -64,7 +64,7 @@ import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Core.DataCon( DataCon, dataConWrapId )
 import GHC.Core.Class( Class )
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Core.Predicate
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 93cb63812c..fc134817be 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -56,7 +56,7 @@ import Maybes
 import GHC.Tc.Utils.Env
 import GHC.Types.Var
 import GHC.Iface.Syntax
-import PrelNames
+import GHC.Builtin.Names
 import qualified Data.Map as Map
 
 import GHC.Driver.Finder
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 95722733be..cf55316b22 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -79,8 +79,8 @@ import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.TcType
 import GHC.Iface.Load
-import PrelNames
-import TysWiredIn
+import GHC.Builtin.Names
+import GHC.Builtin.Types
 import GHC.Types.Id
 import GHC.Types.Var
 import GHC.Types.Name.Reader
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 563ddff69d..e896c7851e 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -50,7 +50,7 @@ import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.Env
 import GHC.Tc.Types.Evidence
 import GHC.Core.InstEnv
-import TysWiredIn  ( heqDataCon, eqDataCon )
+import GHC.Builtin.Types  ( heqDataCon, eqDataCon )
 import GHC.Core    ( isOrphan )
 import GHC.Tc.Instance.FunDeps
 import GHC.Tc.Utils.TcMType
@@ -67,7 +67,7 @@ import GHC.Types.Name
 import GHC.Types.Var ( EvVar, tyVarName, VarBndr(..) )
 import GHC.Core.DataCon
 import GHC.Types.Var.Env
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
 import Util
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index bd52015c89..0b84f69096 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -161,7 +161,7 @@ import GHC.Core.Type
 import GHC.Tc.Utils.TcType
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
-import PrelNames
+import GHC.Builtin.Names
 
 import GHC.Types.Id
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 1469170847..53b93f51a3 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -114,11 +114,11 @@ import GHC.Tc.Types.Evidence
 import GHC.Types.Id as Id
 import GHC.Types.Name
 import GHC.Types.Var.Set
-import TysWiredIn
-import TysPrim
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
 import GHC.Types.Var.Env
 import GHC.Types.Name.Env
-import PrelNames
+import GHC.Builtin.Names
 import Util
 import Outputable
 import FastString
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 1f076e2101..8e1cef1a86 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -213,9 +213,9 @@ import GHC.Types.Name as Name
             -- Perhaps there's a better way to do this?
 import GHC.Types.Name.Set
 import GHC.Types.Var.Env
-import PrelNames
-import TysWiredIn( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey
-                 , listTyCon, constraintKind )
+import GHC.Builtin.Names
+import GHC.Builtin.Types ( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey
+                         , listTyCon, constraintKind )
 import GHC.Types.Basic
 import Util
 import Maybes
@@ -1115,7 +1115,7 @@ findDupTyVarTvs prs
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Tau, sigma and rho}
+   Tau, sigma and rho
 *                                                                      *
 ************************************************************************
 -}
@@ -1176,7 +1176,7 @@ mkTcCastTy = mkCastTy   -- Do we need a tc version of mkCastTy?
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Expanding and splitting}
+   Expanding and splitting
 *                                                                      *
 ************************************************************************
 
@@ -2119,7 +2119,7 @@ isAlmostFunctionFree (CoercionTy {})   = True
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Misc}
+   Misc
 *                                                                      *
 ************************************************************************
 
@@ -2171,7 +2171,7 @@ end of the compiler.
 {-
 ************************************************************************
 *                                                                      *
-\subsection[TysWiredIn-ext-type]{External types}
+   External types
 *                                                                      *
 ************************************************************************
 
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index f6d934af9a..c6b0f8bae4 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -57,8 +57,8 @@ import GHC.Tc.Types.Origin
 import GHC.Types.Name( isSystemName )
 import GHC.Tc.Utils.Instantiate
 import GHC.Core.TyCon
-import TysWiredIn
-import TysPrim( tYPE )
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim( tYPE )
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 1cbb8415a3..4cf02d41e0 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -53,16 +53,16 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Core.Predicate
 import GHC.Tc.Utils.Monad
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo )
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Env   ( tcLookupGlobalOnly )
 import GHC.Tc.Types.Evidence
 import GHC.Core.TyCo.Ppr ( pprTyVar )
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Core.TyCon
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Core.Type
 import GHC.Core.Coercion
 import GHC.Core.ConLike
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 2fe9d16595..6e44a6c399 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -34,8 +34,8 @@ import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr
 import GHC.Tc.Utils.TcType hiding ( sizeType, sizeTypes )
-import TysWiredIn ( heqTyConName, eqTyConName, coercibleTyConName )
-import PrelNames
+import GHC.Builtin.Types ( heqTyConName, eqTyConName, coercibleTyConName )
+import GHC.Builtin.Names
 import GHC.Core.Type
 import GHC.Core.Unify ( tcMatchTyX_BM, BindFlag(..) )
 import GHC.Core.Coercion
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 920fb8ad0b..7b5e4ce219 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -27,16 +27,16 @@ where
 import GhcPrelude
 
 import GHC.Hs as Hs
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import qualified GHC.Types.Name as Name
 import GHC.Types.Module
-import RdrHsSyn
+import GHC.Parser.PostProcess
 import GHC.Types.Name.Occurrence as OccName
 import GHC.Types.SrcLoc
 import GHC.Core.Type
 import qualified GHC.Core.Coercion as Coercion ( Role(..) )
-import TysWiredIn
+import GHC.Builtin.Types
 import GHC.Types.Basic as Hs
 import GHC.Types.ForeignCall
 import GHC.Types.Unique
@@ -672,7 +672,7 @@ cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs
 cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
 cvtForD (ImportF callconv safety from nm ty)
   -- the prim and javascript calling conventions do not support headers
-  -- and are inserted verbatim, analogous to mkImport in RdrHsSyn
+  -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess
   | callconv == TH.Prim || callconv == TH.JavaScript
   = mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing
                     (CFunction (StaticTarget (SourceText from)
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 03988d9028..103b1940a0 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -619,7 +619,7 @@ instance Outputable Origin where
 --                              @'\{-\# INCOHERENT'@,
 --      'ApiAnnotation.AnnClose' @`\#-\}`@,
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data OverlapFlag = OverlapFlag
   { overlapMode   :: OverlapMode
   , isSafeOverlap :: Bool
@@ -1285,7 +1285,7 @@ data Activation = NeverActive
 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
                    | FunLike
                    deriving( Eq, Data, Show )
-        -- Show needed for Lexer.x
+        -- Show needed for GHC.Parser.Lexer
 
 data InlinePragma            -- Note [InlinePragma]
   = InlinePragma
@@ -1313,7 +1313,7 @@ data InlineSpec   -- What the user's INLINE pragma looked like
   | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE
                  -- e.g. in `defaultInlinePragma` or when created by CSE
   deriving( Eq, Data, Show )
-        -- Show needed for Lexer.x
+        -- Show needed for GHC.Parser.Lexer
 
 {- Note [InlinePragma]
 ~~~~~~~~~~~~~~~~~~~~~~
@@ -1591,7 +1591,7 @@ data FractionalLit
        , fl_value :: Rational      -- Numeric value of the literal
        }
   deriving (Data, Show)
-  -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
+  -- The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
 
 mkFractionalLit :: Real a => a -> FractionalLit
 mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
index b745a6138f..46cdfd2af3 100644
--- a/compiler/GHC/Types/ForeignCall.hs
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -231,7 +231,7 @@ instance Outputable Header where
 --        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',
 --        'ApiAnnotation.AnnClose' @'\#-}'@,
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.Basic
                    (Maybe Header) -- header to include for this type
                    (SourceText,FastString) -- the type itself
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index 000221234d..fab72d23de 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -137,14 +137,14 @@ import qualified GHC.Types.Var as Var
 
 import GHC.Core.Type
 import GHC.Types.RepType
-import TysPrim
+import GHC.Builtin.Types.Prim
 import GHC.Core.DataCon
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Types.Name
 import GHC.Types.Module
 import GHC.Core.Class
-import {-# SOURCE #-} PrimOp (PrimOp)
+import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
 import GHC.Types.ForeignCall
 import Maybes
 import GHC.Types.SrcLoc
@@ -519,7 +519,7 @@ hasNoBinding :: Id -> Bool
 -- they aren't any more.  Instead, we inject a binding for
 -- them at the CorePrep stage.
 --
--- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs.
+-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in GHC.Builtin.PrimOps.
 -- for the history of this.
 --
 -- Note that CorePrep currently eta expands things no-binding things and this
@@ -528,7 +528,7 @@ hasNoBinding :: Id -> Bool
 --
 -- EXCEPT: unboxed tuples, which definitely have no binding
 hasNoBinding id = case Var.idDetails id of
-                        PrimOpId _       -> False   -- See Note [Primop wrappers] in PrimOp.hs
+                        PrimOpId _       -> False   -- See Note [Primop wrappers] in GHC.Builtin.PrimOps
                         FCallId _        -> True
                         DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
                         _                -> isCompulsoryUnfolding (idUnfolding id)
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index af1ebb18cd..a0a3b94ca9 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -90,7 +90,7 @@ import GHC.Core hiding( hasCoreUnfolding )
 import GHC.Core( hasCoreUnfolding )
 
 import GHC.Core.Class
-import {-# SOURCE #-} PrimOp (PrimOp)
+import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
 import GHC.Types.Name
 import GHC.Types.Var.Set
 import GHC.Types.Basic
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index e7e2c0cc8b..ce5012458a 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -42,8 +42,8 @@ module GHC.Types.Id.Make (
 
 import GhcPrelude
 
-import TysPrim
-import TysWiredIn
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Types
 import GHC.Core.Opt.ConstantFold
 import GHC.Core.Type
 import GHC.Core.TyCo.Rep
@@ -59,7 +59,7 @@ import GHC.Core.TyCon
 import GHC.Core.Class
 import GHC.Types.Name.Set
 import GHC.Types.Name
-import PrimOp
+import GHC.Builtin.PrimOps
 import GHC.Types.ForeignCall
 import GHC.Core.DataCon
 import GHC.Types.Id
@@ -69,7 +69,7 @@ import GHC.Types.Cpr
 import GHC.Core
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Types.Basic       hiding ( SuccessFlag(..) )
 import Util
 import GHC.Driver.Session
diff --git a/compiler/GHC/Types/Id/Make.hs-boot b/compiler/GHC/Types/Id/Make.hs-boot
index 25ae32207e..78c4b59583 100644
--- a/compiler/GHC/Types/Id/Make.hs-boot
+++ b/compiler/GHC/Types/Id/Make.hs-boot
@@ -3,7 +3,7 @@ import GHC.Types.Name( Name )
 import GHC.Types.Var( Id )
 import GHC.Core.Class( Class )
 import {-# SOURCE #-} GHC.Core.DataCon( DataCon )
-import {-# SOURCE #-} PrimOp( PrimOp )
+import {-# SOURCE #-} GHC.Builtin.PrimOps( PrimOp )
 
 data DataConBoxer
 
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 3191f006db..9c1d08822d 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -52,15 +52,15 @@ module GHC.Types.Literal
 
 import GhcPrelude
 
-import TysPrim
-import PrelNames
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Names
 import GHC.Core.Type
 import GHC.Core.TyCon
 import Outputable
 import FastString
 import GHC.Types.Basic
 import Binary
-import Constants
+import GHC.Settings.Constants
 import GHC.Platform
 import GHC.Types.Unique.FM
 import Util
diff --git a/compiler/GHC/Types/Module.hs b/compiler/GHC/Types/Module.hs
index 3d73d7b572..80ae18684f 100644
--- a/compiler/GHC/Types/Module.hs
+++ b/compiler/GHC/Types/Module.hs
@@ -1101,7 +1101,7 @@ Make sure you change 'Packages.findWiredInPackages' if you add an entry here.
 
 For `integer-gmp`/`integer-simple` we also change the base name to
 `integer-wired-in`, but this is fundamentally no different.
-See Note [The integer library] in PrelNames.
+See Note [The integer library] in GHC.Builtin.Names.
 -}
 
 integerUnitId, primUnitId,
@@ -1109,7 +1109,7 @@ integerUnitId, primUnitId,
   thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
 primUnitId        = fsToUnitId (fsLit "ghc-prim")
 integerUnitId     = fsToUnitId (fsLit "integer-wired-in")
-   -- See Note [The integer library] in PrelNames
+   -- See Note [The integer library] in GHC.Builtin.Names
 baseUnitId        = fsToUnitId (fsLit "base")
 rtsUnitId         = fsToUnitId (fsLit "rts")
 thUnitId          = fsToUnitId (fsLit "template-haskell")
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
index abf7bc89b5..9cac5eadf1 100644
--- a/compiler/GHC/Types/Name/Cache.hs
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -15,10 +15,10 @@ import GhcPrelude
 import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Unique.Supply
-import TysWiredIn
+import GHC.Builtin.Types
 import Util
 import Outputable
-import PrelNames
+import GHC.Builtin.Names
 
 #include "HsVersions.h"
 
@@ -79,7 +79,7 @@ lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
 lookupOrigNameCache nc mod occ
   | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
   , Just name <- isBuiltInOcc_maybe occ
-  =     -- See Note [Known-key names], 3(c) in PrelNames
+  =     -- See Note [Known-key names], 3(c) in GHC.Builtin.Names
         -- Special case for tuples; there are too many
         -- of them to pre-populate the original-name cache
     Just name
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index e2ef941723..29c427d5f9 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -117,7 +117,7 @@ import Data.List( sortBy )
 --           'ApiAnnotation.AnnVal'
 --           'ApiAnnotation.AnnTilde',
 
--- For details on above see note [Api annotations] in ApiAnnotation
+-- For details on above see note [Api annotations] in GHC.Parser.Annotation
 data RdrName
   = Unqual OccName
         -- ^ Unqualified  name
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 645d2af7c8..c1bcb314d3 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -28,14 +28,14 @@ import GhcPrelude
 import GHC.Types.Basic (Arity, RepArity)
 import GHC.Core.DataCon
 import Outputable
-import PrelNames
+import GHC.Builtin.Names
 import GHC.Core.Coercion
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
 import Util
-import TysPrim
-import {-# SOURCE #-} TysWiredIn ( anyTypeOfKind )
+import GHC.Builtin.Types.Prim
+import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind )
 
 import Data.List (sort)
 import qualified Data.IntSet as IS
@@ -366,7 +366,7 @@ data RuntimeRep = VecRep VecCount VecElem   -- ^ a SIMD vector type
 It's all in 1-1 correspondence with PrimRep except for TupleRep and SumRep,
 which describe unboxed products and sums respectively. RuntimeRep is defined
 in the library ghc-prim:GHC.Types. It is also "wired-in" to GHC: see
-TysWiredIn.runtimeRepTyCon. The unarisation pass, in GHC.Stg.Unarise, transforms the
+GHC.Builtin.Types.runtimeRepTyCon. The unarisation pass, in GHC.Stg.Unarise, transforms the
 program, so that that every variable has a type that has a PrimRep. For
 example, unarisation transforms our utup function above, to take two Int
 arguments instead of one (# Int, Int #) argument.
@@ -425,13 +425,13 @@ runtimeRepPrimRep works by using tyConRuntimeRepInfo. That function
 should be passed the TyCon produced by promoting one of the constructors
 of RuntimeRep into type-level data. The RuntimeRep promoted datacons are
 associated with a RuntimeRepInfo (stored directly in the PromotedDataCon
-constructor of TyCon). This pairing happens in TysWiredIn. A RuntimeRepInfo
+constructor of TyCon). This pairing happens in GHC.Builtin.Types. A RuntimeRepInfo
 usually(*) contains a function from [Type] to [PrimRep]: the [Type] are
 the arguments to the promoted datacon. These arguments are necessary
 for the TupleRep and SumRep constructors, so that this process can recur,
 producing a flattened list of PrimReps. Calling this extracted function
 happens in runtimeRepPrimRep; the functions themselves are defined in
-tupleRepDataCon and sumRepDataCon, both in TysWiredIn.
+tupleRepDataCon and sumRepDataCon, both in GHC.Builtin.Types.
 
 The (*) above is to support vector representations. RuntimeRep refers
 to VecCount and VecElem, whose promoted datacons have nuggets of information
@@ -454,9 +454,9 @@ runtimeRepPrimRep calls tyConRuntimeRepInfo on (PromotedDataCon "IntRep"), resp.
 (PromotedDataCon "TupleRep"), extracting a function that will produce the PrimReps.
 In example 1, this function is passed an empty list (the empty list of args to IntRep)
 and returns the PrimRep IntRep. (See the definition of runtimeRepSimpleDataCons in
-TysWiredIn and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted
+GHC.Builtin.Types and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted
 list as the one argument to the extracted function. The extracted function is defined
-as prim_rep_fun within tupleRepDataCon in TysWiredIn. It takes one argument, decomposes
+as prim_rep_fun within tupleRepDataCon in GHC.Builtin.Types. It takes one argument, decomposes
 the promoted list (with extractPromotedList), and then recurs back to runtimeRepPrimRep
 to process the LiftedRep and WordRep, concatentating the results.
 
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index 0488d4d882..9211104cb3 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -145,7 +145,7 @@ data RealSrcLoc
 --
 -- Unlike 'RealSrcLoc', it is not affected by #line and {-# LINE ... #-}
 -- pragmas. In particular, notice how 'setSrcLoc' and 'resetAlrLastLoc' in
--- Lexer.x update 'PsLoc' preserving 'BufPos'.
+-- GHC.Parser.Lexer update 'PsLoc' preserving 'BufPos'.
 --
 -- The parser guarantees that 'BufPos' are monotonic. See #17632.
 newtype BufPos = BufPos { bufPos :: Int }
@@ -305,7 +305,7 @@ data SrcSpan =
   | UnhelpfulSpan !FastString   -- Just a general indication
                                 -- also used to indicate an empty span
 
-  deriving (Eq, Show) -- Show is used by Lexer.x, because we
+  deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we
                       -- derive Show for Token
 
 {- Note [Why Maybe BufPos]
@@ -530,7 +530,7 @@ instance Show RealSrcLoc where
   show (SrcLoc filename row col)
       = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
 
--- Show is used by Lexer.x, because we derive Show for Token
+-- Show is used by GHC.Parser.Lexer, because we derive Show for Token
 instance Show RealSrcSpan where
   show span@(RealSrcSpan' file sl sc el ec)
     | isPointRealSpan span
diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs
index d031f70072..574d630ca1 100644
--- a/compiler/GHC/Types/Unique.hs
+++ b/compiler/GHC/Types/Unique.hs
@@ -376,7 +376,7 @@ mkPreludeClassUnique   :: Int -> Unique
 mkPreludeTyConUnique   :: Int -> Unique
 mkPreludeDataConUnique :: Arity -> Unique
 mkPrimOpIdUnique       :: Int -> Unique
--- See Note [Primop wrappers] in PrimOp.hs.
+-- See Note [Primop wrappers] in GHC.Builtin.PrimOps.
 mkPrimOpWrapperUnique  :: Int -> Unique
 mkPreludeMiscIdUnique  :: Int -> Unique
 mkCoVarUnique          :: Int -> Unique
diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs
index 2ea773a2f0..44bdbf0895 100644
--- a/compiler/GHC/Utils/Lexeme.hs
+++ b/compiler/GHC/Utils/Lexeme.hs
@@ -2,7 +2,7 @@
 --
 -- Functions to evaluate whether or not a string is a valid identifier.
 -- There is considerable overlap between the logic here and the logic
--- in Lexer.x, but sadly there seems to be no way to merge them.
+-- in GHC.Parser.Lexer, but sadly there seems to be no way to merge them.
 
 module GHC.Utils.Lexeme (
           -- * Lexical characteristics of Haskell names
@@ -208,7 +208,7 @@ okIdOcc str
                           -- of course, `all` says "True" to an empty list
 
 -- | Is this character acceptable in an identifier (after the first letter)?
--- See alexGetByte in Lexer.x
+-- See alexGetByte in GHC.Parser.Lexer
 okIdChar :: Char -> Bool
 okIdChar c = case generalCategory c of
   UppercaseLetter -> True
author	Sylvain Henry <sylvain@haskus.fr>	2020-04-05 17:39:13 +0200
committer	Sylvain Henry <sylvain@haskus.fr>	2020-04-18 20:04:46 +0200
commit	15312bbb53f247c9ed2c5cf75100a9f44c1c7227 (patch)
tree	8306dcc04a5b7c82464f903044dfdd589e7fdcd7 /compiler/GHC
parent	3ca52151881451ce5b3a7740d003e811b586140d (diff)
download	haskell-15312bbb53f247c9ed2c5cf75100a9f44c1c7227.tar.gz