.gitlab/rel_eng/upload.sh

@@ -6,9 +6,9 @@ set -Eeuo pipefail
 # This is a script for preparing and uploading a release of GHC.
 #
 # Usage,
-#   1. Update $ver
-#   2. Set $SIGNING_KEY to your key id (prefixed with '=')
-#   3. Create a directory and place the source and binary tarballs there
+#   1. Set $SIGNING_KEY to your key id (prefixed with '=')
+#   2. Create a directory named after the release name (e.g. 9.6.1-rc1 or 9.6.1)
+#   3. Place the source and binary tarballs in this directory
 #   4. Run this script from that directory
 #
 # You can also invoke the script with an argument to perform only
@@ -34,10 +34,10 @@ set -Eeuo pipefail
 : ${SIGNING_KEY:="=Benjamin Gamari <ben@well-typed.com>"}
 
 
-# Infer release name from directory name
+# Infer friendly release name from directory name
 : ${rel_name:=$(basename $(pwd))}
 
-# Infer version from tarball names
+# Infer project version from tarball names
 : ${ver:=$(ls ghc-*.tar.* | sed -ne 's/ghc-\([0-9]\+\.[0-9]\+\.[0-9]\+\(\.[0-9]\+\)\?\).\+/\1/p' | head -n1)}
 if [ -z "$ver" ]; then echo "Failed to infer \$ver"; exit 1; fi
 
@@ -59,8 +59,10 @@ usage() {
     echo "  prepare_docs       prepare the documentation directory"
     echo "  upload_docs        upload documentation downloads.haskell.org"
     echo "  upload             upload the tarballs and documentation to downloads.haskell.org"
+    echo "  set_symlink <symlink>"
+    echo "                     set the given symlink (e.g. latest) to the current version"
     echo "  purge_all          purge entire release from the CDN"
-    echo "  purge_file file    purge a given file from the CDN"
+    echo "  purge_file <file>  purge a given file from the CDN"
     echo "  verify             verify the signatures in this directory"
     echo
 }
@@ -78,6 +80,7 @@ function hash_files() {
     echo $(find -maxdepth 1 \
          -iname '*.xz' \
       -o -iname '*.lz' \
+      -o -iname '*.gz' \
       -o -iname '*.bz2' \
       -o -iname '*.zip' \
     )
@@ -136,7 +139,7 @@ function upload() {
 }
 
 function purge_all() {
-    dir="$(echo $rel_name | sed s/-release//)"
+    local dir="$(echo $rel_name | sed s/-release//)"
     # Purge CDN cache
     curl -X PURGE http://downloads.haskell.org/ghc/
     curl -X PURGE http://downloads.haskell.org/~ghc/
@@ -145,77 +148,46 @@ function purge_all() {
     curl -X PURGE http://downloads.haskell.org/~ghc/$dir
     curl -X PURGE http://downloads.haskell.org/~ghc/$dir/
     for i in *; do
-        purge_file $i
+        purge_file "$i"
     done
 }
 
 function purge_file() {
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i/
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i/docs/
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i/
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i/docs/
+    dirs=(
+        "~ghc/$rel_name"
+        "ghc/$rel_name"
+        "~ghc/$ver"
+        "ghc/$ver"
+    )
+
+    for dir in ${dirs[@]}; do
+        curl -X PURGE http://downloads.haskell.org/$dir/$1
+        curl -X PURGE http://downloads.haskell.org/$dir/$1/
+        curl -X PURGE http://downloads.haskell.org/$dir/$1/docs/
+    done
 }
 
 function prepare_docs() {
     echo "THIS COMMAND IS DEPRECATED, THE DOCS FOLDER SHOULD BE PREPARED BY THE FETCH SCRIPT"
-    local tmp
-    rm -Rf docs
-    if [ -z "$GHC_TREE" ]; then
-        tmp="$(mktemp -d)"
-        tar -xf "ghc-$ver-src.tar.xz" -C "$tmp"
-        GHC_TREE="$tmp/ghc-$ver"
-    fi
-    mkdocs="$GHC_TREE/distrib/mkDocs/mkDocs"
-    if [ ! -e "$mkdocs" ]; then
-        echo "Couldn't find GHC mkDocs at $mkdocs."
-        echo "Perhaps you need to override GHC_TREE?"
-        rm -Rf "$tmp"
-        exit 1
-    fi
-    windows_bindist="$(ls ghc-$ver-x86_64-unknown-mingw32.tar.xz | head -n1)"
-    linux_bindist="$(ls ghc-$ver-x86_64-deb9-linux.tar.xz | head -n1)"
-    echo "Windows bindist: $windows_bindist"
-    echo "Linux bindist: $linux_bindist"
-    $ENTER_FHS_ENV $mkdocs $linux_bindist $windows_bindist
-    if [ -d "$tmp" ]; then rm -Rf "$tmp"; fi
-
-    mkdir -p docs/html
-    tar -Jxf "$linux_bindist"
-    cp -R "ghc-$ver/docs/users_guide/build-html/users_guide docs/html/users_guide"
-    #cp -R ghc-$ver/utils/haddock/doc/haddock docs/html/haddock
-    rm -R "ghc-$ver"
-
-    tar -Jxf docs/libraries.html.tar.xz -C docs/html
-    mv docs/index.html docs/html
 }
 
 function recompress() {
     set -Eeuo pipefail
-    combine <(basename -s .xz *.xz) not <(basename -s .lz *.lz) | \
-        parallel 'echo "Recompressing {}.xz to {}.lz"; unxz -c {}.xz | lzip - -o {}.lz'
-
-    for darwin_bindist in $(ls ghc-*-darwin.tar.xz); do
-        local dest="$(basename $darwin_bindist .xz).bz2"
-        if [[ ! -f "$dest" ]]; then
-            echo "Recompressing Darwin bindist to bzip2..."
-            unxz -c "$darwin_bindist" | bzip2 > "$dest"
-        fi
+    needed=()
+
+    for i in ghc-*.tar.xz; do
+        needed+=( "$(basename $i .xz).gz" )
+    done
+
+    for i in ghc-*-darwin.tar.xz; do
+        needed+=( "$(basename $i .xz).bz2" )
     done
 
-    for windows_bindist in $(ls ghc-*-mingw32*.tar.xz); do
-      local tmp="$(mktemp -d tmp.XXX)"
-      local dest="$(realpath $(basename $windows_bindist .tar.xz).zip)"
-      echo $dest
-      if [[ ! -f "$dest" ]]; then
-          echo "Recompressing Windows bindist to zip..."
-          tar -C "$tmp" -xf "$windows_bindist"
-          ls $tmp
-          (cd "$tmp"; zip -9 -r "$dest" *)
-      fi
-      rm -R "$tmp"
+    for i in ghc-*-mingw32.tar.xz; do
+        needed+=( "$(basename $i .tar.xz).zip" )
     done
+
+    recompress-all -j10 ${needed[@]}
 }
 
 function upload_docs() {
@@ -230,6 +202,14 @@ function upload_docs() {
     "$GHC_TREE/.gitlab/rel_eng/upload_ghc_libs.py" upload --docs=hackage_docs ${args[@]}
 }
 
+function set_symlink() {
+    local SYMLINK="$1"
+    # Check to make sure that the indicated version actually exists.
+    curl "https://downloads.haskell.org/ghc/$ver" > /dev/null || (echo "$ver doesn't exist"; exit 1)
+    echo -e "rm ghc/$SYMLINK\nln -s $ver ghc/$SYMLINK" | sftp ghc@downloads-origin.haskell.org
+    curl -X PURGE "http://downloads.haskell.org/~ghc/$SYMLINK"
+}
+
 if [ "x$1" == "x" ]; then
     recompress
     gen_hashes

.gitlab/rel_eng/upload_ghc_libs.py

@@ -49,6 +49,10 @@ def prep_base():
     shutil.copy('config.guess', 'libraries/base')
     shutil.copy('config.sub', 'libraries/base')
 
+def prep_ghc_internal():
+    shutil.copy('config.guess', 'libraries/ghc-internal')
+    shutil.copy('config.sub', 'libraries/ghc-internal')
+
 def build_copy_file(pkg: Package, f: Path):
     target = Path('_build') / 'stage1' / pkg.path / 'build' / f
     dest = pkg.path / f
@@ -89,19 +93,35 @@ def prep_ghc():
     build_copy_file(PACKAGES['ghc'], 'GHC/Platform/Constants.hs')
     build_copy_file(PACKAGES['ghc'], 'GHC/Settings/Config.hs')
 
+def prep_ghc_boot_th():
+    # Drop references to `ghc-internal` from `hs-source-dirs` as Hackage rejects
+    # out-of-sdist references and this packages is only uploaded for documentation
+    # purposes.
+    modify_file(PACKAGES['ghc-boot-th'], 'ghc-boot-th.cabal',
+                lambda s: s.replace('../ghc-internal/src', '')
+                           .replace('GHC.Internal.TH.Lib', '')
+                           .replace('GHC.Internal.TH.Syntax', '')
+                           .replace('GHC.Internal.ForeignSrcLang', '')
+                           .replace('GHC.Internal.LanguageExtensions', '')
+                           .replace('GHC.Internal.Lexeme', '')
+                )
+
 PACKAGES = {
     pkg.name: pkg
     for pkg in [
         Package('base', Path("libraries/base"), prep_base),
+        Package('ghc-internal', Path("libraries/ghc-internal"), prep_ghc_internal),
+        Package('ghc-experimental', Path("libraries/ghc-experimental"), no_prep),
         Package('ghc-prim', Path("libraries/ghc-prim"), prep_ghc_prim),
         Package('integer-gmp', Path("libraries/integer-gmp"), no_prep),
         Package('ghc-bignum', Path("libraries/ghc-bignum"), prep_ghc_bignum),
         Package('template-haskell', Path("libraries/template-haskell"), no_prep),
         Package('ghc-heap', Path("libraries/ghc-heap"), no_prep),
         Package('ghc-boot', Path("libraries/ghc-boot"), prep_ghc_boot),
-        Package('ghc-boot-th', Path("libraries/ghc-boot-th"), no_prep),
+        Package('ghc-boot-th', Path("libraries/ghc-boot-th"), prep_ghc_boot_th),
         Package('ghc-compact', Path("libraries/ghc-compact"), no_prep),
         Package('ghc', Path("compiler"), prep_ghc),
+        Package('ghci', Path("libraries/ghci"), no_prep),
     ]
 }
 # Dict[str, Package]

.gitmodules

@@ -91,11 +91,6 @@
 	path = libraries/stm
 	url = https://gitlab.haskell.org/ghc/packages/stm.git
 	ignore = untracked
-[submodule "utils/haddock"]
-	path = utils/haddock
-	url = https://gitlab.haskell.org/ghc/haddock.git
-	ignore = untracked
-	branch = ghc-head
 [submodule "nofib"]
 	path = nofib
 	url = https://gitlab.haskell.org/ghc/nofib.git
@@ -109,7 +104,7 @@
 	url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
 	ignore = untracked
 [submodule "gmp-tarballs"]
-	path = libraries/ghc-bignum/gmp/gmp-tarballs
+	path = libraries/ghc-internal/gmp/gmp-tarballs
 	url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
 [submodule "libraries/exceptions"]
 	path = libraries/exceptions
@@ -117,3 +112,9 @@
 [submodule "utils/hpc"]
 	path = utils/hpc
 	url = https://gitlab.haskell.org/hpc/hpc-bin.git
+[submodule "libraries/os-string"]
+	path = libraries/os-string
+	url = https://gitlab.haskell.org/ghc/packages/os-string
+[submodule "libraries/file-io"]
+	path = libraries/file-io
+	url = https://gitlab.haskell.org/ghc/packages/file-io.git

CODEOWNERS

 # Confused about what this is? See
-# https://gitlab.haskell.org/help/user/project/code_owners
+# https://docs.gitlab.com/ee/user/project/codeowners/
 
 # Catch-all
 * @bgamari
@@ -37,8 +37,10 @@
 /compiler/GHC/Types/               @simonpj @rae
 /compiler/GHC/HsToCore/            @simonpj @rae
 /compiler/GHC/HsToCore/Pmc*        @sgraf
+/compiler/GHC/HsToCore/Foreign/Wasm.hs @TerrorJack
 /compiler/GHC/Tc/Deriv/            @RyanGlScott
 /compiler/GHC/CmmToAsm/            @simonmar @bgamari @AndreasK
+/compiler/GHC/CmmToAsm/RV64/       @supersven @angerman
 /compiler/GHC/CmmToAsm/Wasm/       @TerrorJack
 /compiler/GHC/CmmToLlvm/           @angerman
 /compiler/GHC/StgToCmm/            @simonmar @osa1
@@ -52,16 +54,22 @@
 /compiler/GHC/Core/Opt/            @simonpj @sgraf
 /compiler/GHC/ThToHs.hs            @rae
 /compiler/GHC/Wasm/                @nrnrnr
+/compiler/GHC/JS/                  @luite @doyougnu @hsyl20 @JoshMeredith
+/compiler/GHC/StgToJS/             @luite @doyougnu @hsyl20 @JoshMeredith
+/compiler/GHC/Runtime/Interpreter/Wasm.hs @TerrorJack
 
 [Core libraries]
 /libraries/base/                  @hvr
 /libraries/ghci/                  @simonmar
 /libraries/template-haskell/      @rae
+/testsuite/tests/interface-stability/ @core-libraries
 
 [Internal utilities and libraries]
 /utils/iserv-proxy/               @angerman @simonmar
 /utils/iserv/                     @angerman @simonmar
 /utils/fs/                        @Phyx
+/utils/jsffi                      @TerrorJack
+/utils/haddock                     @Kleidukos
 
 [WinIO related code]
 /libraries/base/GHC/Event/Windows/                   @Phyx

boot

@@ -66,9 +66,6 @@ def autoreconf():
     for dir_ in ['.', 'rts'] + glob.glob('libraries/*/'):
         if os.path.isfile(os.path.join(dir_, 'configure.ac')):
             print("Booting %s" % dir_)
-            # Update config.sub in submodules
-            if dir_ != '.' and os.path.isfile(os.path.join(dir_, 'config.sub')):
-                shutil.copyfile('config.sub', os.path.join(dir_, 'config.sub'))
             processes[dir_] = subprocess.Popen(['sh', '-c', reconf_cmd], cwd=dir_)
 
     # Wait for all child processes to finish.

cabal.project-reinstall

@@ -12,11 +12,13 @@ packages: ./compiler
           -- ./libraries/deepseq/
           ./libraries/directory/
           ./libraries/exceptions/
+          ./libraries/file-io/
           ./libraries/filepath/
           -- ./libraries/ghc-bignum/
            ./libraries/ghc-boot/
           -- ./libraries/ghc-boot-th/
           ./libraries/ghc-compact
+          ./libraries/ghc-experimental
           ./libraries/ghc-heap
           ./libraries/ghci
           -- ./libraries/ghc-prim
@@ -25,6 +27,7 @@ packages: ./compiler
           ./libraries/hpc
           -- ./libraries/integer-gmp
           ./libraries/mtl/
+          ./libraries/os-string/
           ./libraries/parsec/
           -- ./libraries/pretty/
           ./libraries/process/
@@ -39,7 +42,11 @@ packages: ./compiler
           ./libraries/Win32/
           ./libraries/xhtml/
           ./utils/ghc-pkg
+          ./utils/ghc-toolchain
+          ./utils/ghc-toolchain/exe
           ./utils/haddock
+          ./utils/haddock/haddock-api
+          ./utils/haddock/haddock-library
           ./utils/hp2ps
           ./utils/hpc
           ./utils/hsc2hs
@@ -61,15 +68,10 @@ constraints: ghc +internal-interpreter +dynamic-system-linke,
              any.pretty installed,
              any.template-haskell installed
 
-allow-newer:
-  ghc-paths:Cabal,
-  *:base,
-  *:ghc-prim,
-  tree-diff:time
 
 benchmarks: False
 tests: False
-allow-boot-library-installs: False
+allow-boot-library-installs: True
 
 -- Workaround for https://github.com/haskell/cabal/issues/7297
 package *

compile_flags.txt

--xc
--Irts
+-Wimplicit
+-include
+rts/include/ghcversion.h
 -Irts/include
--I.hie-bios/stage0/lib
--I_build/stage1/rts/build/include/
+-I_build/stage1/rts/build
+-I_build/stage1/rts/build/include
+-Irts
+-Ilibraries/ghc-internal/include
+-I_build/stage1/libraries/ghc-internal/build/include
+-Ilibraries/ghc-bignum/include
+-I_build/stage1/libraries/ghc-bignum/build/include
+-Wno-unknown-pragmas
+-Wall
+-Wextra
+-Wstrict-prototypes
+-Wmissing-prototypes
+-Wmissing-declarations
+-Winline
+-Wpointer-arith
+-Wmissing-noreturn
+-Wnested-externs
+-Wredundant-decls
+-Wundef
+-DFS_NAMESPACE=rts
+-DCOMPILING_RTS
+-DTHREADED_RTS
+-DDEBUG
+-DDYNAMIC
+-DPROFILING

compiler/CodeGen.Platform.h

 
 import GHC.Cmm.Expr
 #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \
-    || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64))
+    || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64) \
+    || defined(MACHREGS_riscv64))
 import GHC.Utils.Panic.Plain
 #endif
 import GHC.Platform.Reg
@@ -1120,6 +1121,105 @@ freeReg REG_D6    = False
 
 freeReg _ = True
 
+#elif defined(MACHREGS_riscv64)
+
+-- zero reg
+freeReg 0 = False
+-- link register
+freeReg 1 = False
+-- stack pointer
+freeReg 2 = False
+-- global pointer
+freeReg 3 = False
+-- thread pointer
+freeReg 4 = False
+-- frame pointer
+freeReg 8 = False
+-- made-up inter-procedural (ip) register
+-- See Note [The made-up RISCV64 TMP (IP) register]
+freeReg 31 = False
+
+# if defined(REG_Base)
+freeReg REG_Base  = False
+# endif
+# if defined(REG_Sp)
+freeReg REG_Sp    = False
+# endif
+# if defined(REG_SpLim)
+freeReg REG_SpLim = False
+# endif
+# if defined(REG_Hp)
+freeReg REG_Hp    = False
+# endif
+# if defined(REG_HpLim)
+freeReg REG_HpLim = False
+# endif
+
+# if defined(REG_R1)
+freeReg REG_R1    = False
+# endif
+# if defined(REG_R2)
+freeReg REG_R2    = False
+# endif
+# if defined(REG_R3)
+freeReg REG_R3    = False
+# endif
+# if defined(REG_R4)
+freeReg REG_R4    = False
+# endif
+# if defined(REG_R5)
+freeReg REG_R5    = False
+# endif
+# if defined(REG_R6)
+freeReg REG_R6    = False
+# endif
+# if defined(REG_R7)
+freeReg REG_R7    = False
+# endif
+# if defined(REG_R8)
+freeReg REG_R8    = False
+# endif
+
+# if defined(REG_F1)
+freeReg REG_F1    = False
+# endif
+# if defined(REG_F2)
+freeReg REG_F2    = False
+# endif
+# if defined(REG_F3)
+freeReg REG_F3    = False
+# endif
+# if defined(REG_F4)
+freeReg REG_F4    = False
+# endif
+# if defined(REG_F5)
+freeReg REG_F5    = False
+# endif
+# if defined(REG_F6)
+freeReg REG_F6    = False
+# endif
+
+# if defined(REG_D1)
+freeReg REG_D1    = False
+# endif
+# if defined(REG_D2)
+freeReg REG_D2    = False
+# endif
+# if defined(REG_D3)
+freeReg REG_D3    = False
+# endif
+# if defined(REG_D4)
+freeReg REG_D4    = False
+# endif
+# if defined(REG_D5)
+freeReg REG_D5    = False
+# endif
+# if defined(REG_D6)
+freeReg REG_D6    = False
+# endif
+
+freeReg _ = True
+
 #else
 
 freeReg = panic "freeReg not defined for this platform"

compiler/GHC.hs

@@ -3,6 +3,8 @@
 {-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections, NamedFieldPuns #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -76,6 +78,7 @@ module GHC (
         ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
         mgLookupModule,
         ModSummary(..), ms_mod_name, ModLocation(..),
+        pattern ModLocation,
         getModSummary,
         getModuleGraph,
         isLoaded,
@@ -86,19 +89,49 @@ module GHC (
         ModuleInfo,
         getModuleInfo,
         modInfoTyThings,
-        modInfoTopLevelScope,
         modInfoExports,
         modInfoExportsWithSelectors,
         modInfoInstances,
         modInfoIsExportedName,
         modInfoLookupName,
         modInfoIface,
-        modInfoRdrEnv,
         modInfoSafe,
         lookupGlobalName,
         findGlobalAnns,
         mkNamePprCtxForModule,
-        ModIface, ModIface_(..),
+        ModIface,
+        ModIface_( mi_mod_info
+                 , mi_module
+                 , mi_sig_of
+                 , mi_hsc_src
+                 , mi_iface_hash
+                 , mi_deps
+                 , mi_public
+                 , mi_exports
+                 , mi_fixities
+                 , mi_warns
+                 , mi_anns
+                 , mi_decls
+                 , mi_defaults
+                 , mi_simplified_core
+                 , mi_top_env
+                 , mi_insts
+                 , mi_fam_insts
+                 , mi_rules
+                 , mi_trust
+                 , mi_trust_pkg
+                 , mi_complete_matches
+                 , mi_docs
+                 , mi_abi_hashes
+                 , mi_ext_fields
+                 , mi_hi_bytes
+                 , mi_self_recomp_info
+                 , mi_fix_fn
+                 , mi_decl_warn_fn
+                 , mi_export_warn_fn
+                 , mi_hash_fn
+                 ),
+        pattern ModIface,
         SafeHaskellMode(..),
 
         -- * Printing
@@ -157,14 +190,14 @@ module GHC (
         -- ** The debugger
         SingleStep(..),
         Resume(..),
-        History(historyBreakInfo, historyEnclosingDecls),
+        History(historyBreakpointId, historyEnclosingDecls),
         GHC.getHistorySpan, getHistoryModule,
         abandon, abandonAll,
         getResumeContext,
         GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
-        BreakInfo(..),
+        BreakpointId(..), InternalBreakpointId(..),
         GHC.Runtime.Eval.back,
         GHC.Runtime.Eval.forward,
         GHC.Runtime.Eval.setupBreakpoint,
@@ -287,11 +320,7 @@ module GHC (
         parser,
 
         -- * API Annotations
-        AnnKeywordId(..),EpaComment(..),
-
-        -- * Miscellaneous
-        --sessionHscEnv,
-        cyclicModuleErr,
+        EpaComment(..)
   ) where
 
 {-
@@ -337,6 +366,7 @@ import GHC.Parser.Lexer
 import GHC.Parser.Annotation
 import GHC.Parser.Utils
 
+import GHC.Iface.Env ( trace_if )
 import GHC.Iface.Load        ( loadSysInterface )
 import GHC.Hs
 import GHC.Builtin.Types.Prim ( alphaTyVars )
@@ -392,11 +422,11 @@ import GHC.Types.TyThing
 import GHC.Types.Name.Env
 import GHC.Types.Name.Ppr
 import GHC.Types.TypeEnv
-import GHC.Types.BreakInfo
+import GHC.Types.Breakpoint
 import GHC.Types.PkgQual
 
 import GHC.Unit
-import GHC.Unit.Env
+import GHC.Unit.Env as UnitEnv
 import GHC.Unit.External
 import GHC.Unit.Finder
 import GHC.Unit.Module.ModIface
@@ -405,6 +435,8 @@ import GHC.Unit.Module.ModDetails
 import GHC.Unit.Module.ModSummary
 import GHC.Unit.Module.Graph
 import GHC.Unit.Home.ModInfo
+import qualified GHC.Unit.Home.Graph as HUG
+import GHC.Settings
 
 import Control.Applicative ((<|>))
 import Control.Concurrent
@@ -426,6 +458,7 @@ import System.Environment ( getEnv, getProgName )
 import System.Exit      ( exitWith, ExitCode(..) )
 import System.FilePath
 import System.IO.Error  ( isDoesNotExistError )
+import GHC.Unit.Home.PackageTable
 
 -- %************************************************************************
 -- %*                                                                      *
@@ -455,6 +488,8 @@ defaultErrorHandler fm (FlushOut flushOut) inner =
                          liftIO $ throwIO UserInterrupt
                      Just StackOverflow ->
                          fm "stack overflow: use +RTS -K<size> to increase it"
+                     Just HeapOverflow ->
+                         fm "heap overflow: use +RTS -M<size> to increase maximum heap size"
                      _ -> case fromException exception of
                           Just (ex :: ExitCode) -> liftIO $ throwIO ex
                           _ ->
@@ -637,7 +672,7 @@ setUnitDynFlagsNoCheck uid dflags1 = do
           , homeUnitEnv_home_unit = Just home_unit
           }
 
-  let unit_env = ue_updateHomeUnitEnv upd uid (hsc_unit_env hsc_env)
+  let unit_env = UnitEnv.ue_updateHomeUnitEnv upd uid (hsc_unit_env hsc_env)
 
   let dflags = updated_dflags
 
@@ -655,7 +690,7 @@ setUnitDynFlagsNoCheck uid dflags1 = do
   let !unit_env1 =
         if homeUnitId_ dflags /= uid
           then
-            ue_renameUnitId
+            UnitEnv.renameUnitId
                   uid
                   (homeUnitId_ dflags)
                   unit_env0
@@ -673,9 +708,60 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m ()
 setTopSessionDynFlags dflags = do
   hsc_env <- getSession
   logger  <- getLogger
+  lookup_cache  <- liftIO $ mkInterpSymbolCache
 
-  -- Interpreter
+  -- see Note [Target code interpreter]
   interp <- if
+    -- Wasm dynamic linker
+    | ArchWasm32 <- platformArch $ targetPlatform dflags
+    -> do
+        s <- liftIO $ newMVar InterpPending
+        loader <- liftIO Loader.uninitializedLoader
+        dyld <- liftIO $ makeAbsolute $ topDir dflags </> "dyld.mjs"
+#if defined(wasm32_HOST_ARCH)
+        let libdir = sorry "cannot spawn child process on wasm"
+#else
+        libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries"
+#endif
+        let profiled = ways dflags `hasWay` WayProf
+            way_tag = if profiled then "_p" else ""
+        let cfg =
+              WasmInterpConfig
+                { wasmInterpDyLD = dyld,
+                  wasmInterpLibDir = libdir,
+                  wasmInterpOpts = getOpts dflags opt_i,
+                  wasmInterpBrowser = gopt Opt_GhciBrowser dflags,
+                  wasmInterpBrowserHost = ghciBrowserHost dflags,
+                  wasmInterpBrowserPort = ghciBrowserPort dflags,
+                  wasmInterpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags,
+                  wasmInterpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags,
+                  wasmInterpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags,
+                  wasmInterpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags,
+                  wasmInterpTargetPlatform = targetPlatform dflags,
+                  wasmInterpProfiled = profiled,
+                  wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags),
+                  wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env
+                }
+        pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
+
+    -- JavaScript interpreter
+    | ArchJavaScript <- platformArch (targetPlatform dflags)
+    -> do
+         s <- liftIO $ newMVar InterpPending
+         loader <- liftIO Loader.uninitializedLoader
+         let cfg = JSInterpConfig
+              { jsInterpNodeConfig  = defaultNodeJsSettings
+              , jsInterpScript      = topDir dflags </> "ghc-interp.js"
+              , jsInterpTmpFs       = hsc_tmpfs hsc_env
+              , jsInterpTmpDir      = tmpDir dflags
+              , jsInterpLogger      = hsc_logger hsc_env
+              , jsInterpCodegenCfg  = initStgToJSConfig dflags
+              , jsInterpUnitEnv     = hsc_unit_env hsc_env
+              , jsInterpFinderOpts  = initFinderOpts dflags
+              , jsInterpFinderCache = hsc_FC hsc_env
+              }
+         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
+
     -- external interpreter
     | gopt Opt_ExternalInterpreter dflags
     -> do
@@ -684,7 +770,8 @@ setTopSessionDynFlags dflags = do
            profiled = ways dflags `hasWay` WayProf
            dynamic  = ways dflags `hasWay` WayDyn
            flavour
-             | profiled  = "-prof" -- FIXME: can't we have both?
+             | profiled && dynamic = "-prof-dyn"
+             | profiled  = "-prof"
              | dynamic   = "-dyn"
              | otherwise = ""
            msg = text "Starting " <> text prog
@@ -702,25 +789,7 @@ setTopSessionDynFlags dflags = do
             }
          s <- liftIO $ newMVar InterpPending
          loader <- liftIO Loader.uninitializedLoader
-         return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader))
-
-    -- JavaScript interpreter
-    | ArchJavaScript <- platformArch (targetPlatform dflags)
-    -> do
-         s <- liftIO $ newMVar InterpPending
-         loader <- liftIO Loader.uninitializedLoader
-         let cfg = JSInterpConfig
-              { jsInterpNodeConfig  = defaultNodeJsSettings
-              , jsInterpScript      = topDir dflags </> "ghc-interp.js"
-              , jsInterpTmpFs       = hsc_tmpfs hsc_env
-              , jsInterpTmpDir      = tmpDir dflags
-              , jsInterpLogger      = hsc_logger hsc_env
-              , jsInterpCodegenCfg  = initStgToJSConfig dflags
-              , jsInterpUnitEnv     = hsc_unit_env hsc_env
-              , jsInterpFinderOpts  = initFinderOpts dflags
-              , jsInterpFinderCache = hsc_FC hsc_env
-              }
-         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader))
+         return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
 
     -- Internal interpreter
     | otherwise
@@ -728,7 +797,7 @@ setTopSessionDynFlags dflags = do
 #if defined(HAVE_INTERNAL_INTERPRETER)
      do
       loader <- liftIO Loader.uninitializedLoader
-      return (Just (Interp InternalInterp loader))
+      return (Just (Interp InternalInterp loader lookup_cache))
 #else
       return Nothing
 #endif
@@ -765,7 +834,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
           let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
               dflags = homeUnitEnv_dflags homeUnitEnv
               old_hpt = homeUnitEnv_hpt homeUnitEnv
-              home_units = unitEnv_keys (ue_home_unit_graph old_unit_env)
+              home_units = HUG.allUnits (ue_home_unit_graph old_unit_env)
 
           (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units
 
@@ -778,7 +847,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
             , homeUnitEnv_home_unit = Just home_unit
             }
 
-        let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup (ue_currentUnit old_unit_env) home_unit_graph
+        let dflags1 = homeUnitEnv_dflags $ HUG.unitEnv_lookup (ue_currentUnit old_unit_env) home_unit_graph
         let unit_env = UnitEnv
               { ue_platform        = targetPlatform dflags1
               , ue_namever         = ghcNameVersion dflags1
@@ -1157,7 +1226,7 @@ instance DesugaredMod DesugaredModule where
 
 type ParsedSource      = Located (HsModule GhcPs)
 type RenamedSource     = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
-                          Maybe (LHsDoc GhcRn))
+                          Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))
 type TypecheckedSource = LHsBinds GhcTc
 
 -- NOTE:
@@ -1223,9 +1292,6 @@ typecheckModule pmod = do
    details <- makeSimpleDetails lcl_logger tc_gbl_env
    safe    <- finalSafeMode lcl_dflags tc_gbl_env
 
-   let !rdr_env = forceGlobalRdrEnv $ tcg_rdr_env tc_gbl_env
-   -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
    return $
      TypecheckedModule {
        tm_internals_          = (tc_gbl_env, details),
@@ -1236,7 +1302,6 @@ typecheckModule pmod = do
          ModuleInfo {
            minf_type_env  = md_types details,
            minf_exports   = md_exports details,
-           minf_rdr_env   = Just rdr_env,
            minf_instances = fixSafeInstances safe $ instEnvElts $ md_insts details,
            minf_iface     = Nothing,
            minf_safe      = safe,
@@ -1363,12 +1428,14 @@ getModuleGraph = liftM hsc_mod_graph getSession
 
 -- | Return @True@ \<==> module is loaded.
 isLoaded :: GhcMonad m => ModuleName -> m Bool
-isLoaded m = withSession $ \hsc_env ->
-  return $! isJust (lookupHpt (hsc_HPT hsc_env) m)
+isLoaded m = withSession $ \hsc_env -> liftIO $ do
+  hmi <- lookupHpt (hsc_HPT hsc_env) m
+  return $! isJust hmi
 
 isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
-isLoadedModule uid m = withSession $ \hsc_env ->
-  return $! isJust (lookupHug (hsc_HUG hsc_env) uid m)
+isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
+  hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m
+  return $! isJust hmi
 
 -- | Return the bindings for the current interactive session.
 getBindings :: GhcMonad m => m [TyThing]
@@ -1389,7 +1456,6 @@ getNamePprCtx = withSession $ \hsc_env -> do
 data ModuleInfo = ModuleInfo {
         minf_type_env  :: TypeEnv,
         minf_exports   :: [AvailInfo],
-        minf_rdr_env   :: Maybe IfGlobalRdrEnv, -- Nothing for a compiled/package mod
         minf_instances :: [ClsInst],
         minf_iface     :: Maybe ModIface,
         minf_safe      :: SafeHaskellMode,
@@ -1416,13 +1482,9 @@ getPackageModuleInfo hsc_env mdl
             tys    = [ ty | name <- concatMap availNames avails,
                             Just ty <- [lookupTypeEnv pte name] ]
 
-        let !rdr_env = availsToGlobalRdrEnv hsc_env mdl avails
-        -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
         return (Just (ModuleInfo {
                         minf_type_env  = mkTypeEnv tys,
                         minf_exports   = avails,
-                        minf_rdr_env   = Just rdr_env,
                         minf_instances = error "getModuleInfo: instances for package module unimplemented",
                         minf_iface     = Just iface,
                         minf_safe      = getSafeMode $ mi_trust iface,
@@ -1439,12 +1501,12 @@ availsToGlobalRdrEnv hsc_env mod avails
       -- all the specified modules into the global interactive module
     imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
     decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
-                         is_qual = False,
+                         is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
                          is_dloc = srcLocSpan interactiveSrcLoc }
 
 getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
 getHomeModuleInfo hsc_env mdl =
-  case lookupHugByModule mdl (hsc_HUG hsc_env) of
+  HUG.lookupHugByModule mdl (hsc_HUG hsc_env) >>= \case
     Nothing  -> return Nothing
     Just hmi -> do
       let details  = hm_details hmi
@@ -1452,7 +1514,6 @@ getHomeModuleInfo hsc_env mdl =
       return (Just (ModuleInfo {
                         minf_type_env  = md_types details,
                         minf_exports   = md_exports details,
-                        minf_rdr_env   = mi_globals $ hm_iface hmi,
                          -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo.
                         minf_instances = instEnvElts $ md_insts details,
                         minf_iface     = Just iface,
@@ -1464,12 +1525,6 @@ getHomeModuleInfo hsc_env mdl =
 modInfoTyThings :: ModuleInfo -> [TyThing]
 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
 
-modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
-modInfoTopLevelScope minf
-  = fmap (map greName . globalRdrEnvElts) (minf_rdr_env minf)
-  -- NB: no need to force this again.
-  -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
 modInfoExports :: ModuleInfo -> [Name]
 modInfoExports minf = concatMap availNames $! minf_exports minf
 
@@ -1486,12 +1541,13 @@ modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_export
 
 mkNamePprCtxForModule ::
   GhcMonad m =>
+  Module     ->
   ModuleInfo ->
-  m (Maybe NamePprCtx) -- XXX: returns a Maybe X
-mkNamePprCtxForModule minf = withSession $ \hsc_env -> do
-  let mk_name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env)
+  m NamePprCtx
+mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do
+  let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf))
       ptc = initPromotionTickContext (hsc_dflags hsc_env)
-  return (fmap mk_name_ppr_ctx (minf_rdr_env minf))
+  return name_ppr_ctx
 
 modInfoLookupName :: GhcMonad m =>
                      ModuleInfo -> Name
@@ -1504,9 +1560,6 @@ modInfoLookupName minf name = withSession $ \hsc_env -> do
 modInfoIface :: ModuleInfo -> Maybe ModIface
 modInfoIface = minf_iface
 
-modInfoRdrEnv :: ModuleInfo -> Maybe IfGlobalRdrEnv
-modInfoRdrEnv = minf_rdr_env
-
 -- | Retrieve module safe haskell mode
 modInfoSafe :: ModuleInfo -> SafeHaskellMode
 modInfoSafe = minf_safe
@@ -1515,9 +1568,7 @@ modInfoModBreaks :: ModuleInfo -> ModBreaks
 modInfoModBreaks = minf_modBreaks
 
 isDictonaryId :: Id -> Bool
-isDictonaryId id
-  = case tcSplitSigmaTy (idType id) of {
-      (_tvs, _theta, tau) -> isDictTy tau }
+isDictonaryId id = isDictTy (idType id)
 
 -- | Looks up a global name: that is, any top-level name in any
 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
@@ -1703,6 +1754,7 @@ findModule mod_name maybe_pkg = do
 
 findQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
 findQualifiedModule pkgqual mod_name = withSession $ \hsc_env -> do
+  liftIO $ trace_if (hsc_logger hsc_env) (text "findQualifiedModule" <+> ppr mod_name <+> ppr pkgqual)
   let mhome_unit = hsc_home_unit_maybe hsc_env
   let dflags    = hsc_dflags hsc_env
   case pkgqual of
@@ -1728,7 +1780,7 @@ modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
 modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $
    text "module is not loaded:" <+>
    quotes (ppr (moduleName m)) <+>
-   parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
+   parens (text (expectJust (ml_hs_file loc)))
 
 renamePkgQualM :: GhcMonad m => ModuleName -> Maybe FastString -> m PkgQual
 renamePkgQualM mn p = withSession $ \hsc_env -> pure (renamePkgQual (hsc_unit_env hsc_env) mn p)
@@ -1765,8 +1817,9 @@ lookupQualifiedModule NoPkgQual mod_name = withSession $ \hsc_env -> do
 lookupQualifiedModule pkgqual mod_name = findQualifiedModule pkgqual mod_name
 
 lookupLoadedHomeModule :: GhcMonad m => UnitId -> ModuleName -> m (Maybe Module)
-lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env ->
-  case lookupHug  (hsc_HUG hsc_env) uid mod_name  of
+lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> liftIO $ do
+  trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModule" <+> ppr mod_name <+> ppr uid)
+  HUG.lookupHug (hsc_HUG hsc_env) uid mod_name >>= \case
     Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
     _not_a_home_module -> return Nothing
 
@@ -1800,8 +1853,7 @@ getGHCiMonad :: GhcMonad m => m Name
 getGHCiMonad = fmap (ic_monad . hsc_IC) getSession
 
 getHistorySpan :: GhcMonad m => History -> m SrcSpan
-getHistorySpan h = withSession $ \hsc_env ->
-    return $ GHC.Runtime.Eval.getHistorySpan hsc_env h
+getHistorySpan h = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.getHistorySpan hsc_env h
 
 obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term
 obtainTermFromVal bound force ty a = withSession $ \hsc_env ->

compiler/GHC/Builtin/Names.hs

@@ -54,14 +54,13 @@ 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
      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.
+     use. For example, when we parse a [] in a type and ListTuplePuns
+     are enabled, we can just insert (Exact listTyConName :: RdrName).
 
-     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).
+     This is just an optimisation: it would be equally valid to output
+     Orig RdrNames that correctly record the module (and package) that
+     we expect the final Name to come from. The name would be looked up
+     in the OrigNameCache (see point 3).
 
   2. The knownKeyNames (which consist of the basicKnownKeyNames from
      the module, and those names reachable via the wired-in stuff from
@@ -78,9 +77,10 @@ This is accomplished through a combination of mechanisms:
   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.
+     used to initialise the OrigNameCache. Instead, lookupOrigNameCache pretends
+     that these names are in the cache by using isInfiniteFamilyOrigName_maybe
+     before the actual lookup.
+     See Note [Infinite families of known-key names] for details.
 
 
 Note [Infinite families of known-key names]
@@ -98,26 +98,15 @@ things,
 
   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.
+     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.
 
+  c) GHC.Iface.Env.lookupOrigNameCache uses isInfiniteFamilyOrigName_maybe to
+     map tuples and sums onto their exact names, rather than trying to find them
+     in the original-name cache.
      See also Note [Built-in syntax and the OrigNameCache]
 
-Note that one-tuples are an exception to the rule, as they do get assigned
-known keys. See
-Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
-in GHC.Builtin.Types.
-
 -}
 
 {-# LANGUAGE CPP #-}
@@ -273,6 +262,9 @@ basicKnownKeyNames
         -- DataToTag
         dataToTagClassName,
 
+        -- seq#
+        seqHashName,
+
         -- Dynamic
         toDynName,
 
@@ -358,6 +350,7 @@ basicKnownKeyNames
         stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
         int8TyConName, int16TyConName, int32TyConName, int64TyConName,
         word8TyConName, word16TyConName, word32TyConName, word64TyConName,
+        jsvalTyConName,
 
         -- Others
         otherwiseIdName, inlineIdName,
@@ -429,7 +422,6 @@ basicKnownKeyNames
         naturalPowModName,
         naturalSizeInBaseName,
 
-        bignatFromWordListName,
         bignatEqName,
 
         -- Float/Double
@@ -455,6 +447,10 @@ basicKnownKeyNames
         -- Overloaded record fields
         hasFieldClassName,
 
+        -- ExceptionContext
+        exceptionContextTyConName,
+        emptyExceptionContextName,
+
         -- Call Stacks
         callStackTyConName,
         emptyCallStackName, pushCallStackName,
@@ -515,6 +511,8 @@ basicKnownKeyNames
         , unsafeEqualityTyConName
         , unsafeReflDataConName
         , unsafeCoercePrimName
+
+        , unsafeUnpackJSStringUtf8ShShName
     ]
 
 genericTyConNames :: [Name]
@@ -547,117 +545,120 @@ genericTyConNames = [
 --MetaHaskell Extension Add a new module here
 -}
 
-pRELUDE :: Module
-pRELUDE         = mkBaseModule_ pRELUDE_NAME
-
 gHC_PRIM, gHC_PRIM_PANIC,
-    gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT,
-    gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
-    gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
-    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE,
-    gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT,
-    gHC_LIST, gHC_TUPLE, gHC_TUPLE_PRIM, 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, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST,
-    cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL,
-    gHC_TYPENATS, gHC_TYPENATS_INTERNAL,
-    dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: Module
-
-gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
-gHC_PRIM_PANIC  = mkPrimModule (fsLit "GHC.Prim.Panic")
-gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
-gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
-gHC_MAGIC_DICT  = mkPrimModule (fsLit "GHC.Magic.Dict")
-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_NUM_INTEGER = mkBignumModule (fsLit "GHC.Num.Integer")
-gHC_NUM_NATURAL = mkBignumModule (fsLit "GHC.Num.Natural")
-gHC_NUM_BIGNAT  = mkBignumModule (fsLit "GHC.Num.BigNat")
-gHC_LIST        = mkBaseModule (fsLit "GHC.List")
-gHC_TUPLE       = mkPrimModule (fsLit "GHC.Tuple")
-gHC_TUPLE_PRIM  = mkPrimModule (fsLit "GHC.Tuple.Prim")
-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")
-gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar")
-rANDOM          = mkBaseModule (fsLit "System.Random")
-gHC_EXTS        = mkBaseModule (fsLit "GHC.Exts")
-gHC_IS_LIST     = mkBaseModule (fsLit "GHC.IsList")
-cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
-gHC_GENERICS    = mkBaseModule (fsLit "GHC.Generics")
-gHC_TYPEERROR   = mkBaseModule (fsLit "GHC.TypeError")
-gHC_TYPELITS    = mkBaseModule (fsLit "GHC.TypeLits")
-gHC_TYPELITS_INTERNAL = mkBaseModule (fsLit "GHC.TypeLits.Internal")
-gHC_TYPENATS    = mkBaseModule (fsLit "GHC.TypeNats")
-gHC_TYPENATS_INTERNAL = mkBaseModule (fsLit "GHC.TypeNats.Internal")
-dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")
-dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")
-uNSAFE_COERCE   = mkBaseModule (fsLit "Unsafe.Coerce")
-fOREIGN_C_CONSTPTR = mkBaseModule (fsLit "Foreign.C.ConstPtr")
-
-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")
+    gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT,
+    gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module
+gHC_PRIM           = mkGhcInternalModule (fsLit "GHC.Internal.Prim")   -- Primitive types and values
+gHC_PRIM_PANIC     = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic")
+gHC_TYPES          = mkGhcInternalModule (fsLit "GHC.Internal.Types")
+gHC_MAGIC          = mkGhcInternalModule (fsLit "GHC.Internal.Magic")
+gHC_MAGIC_DICT     = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict")
+gHC_CSTRING        = mkGhcInternalModule (fsLit "GHC.Internal.CString")
+gHC_CLASSES        = mkGhcInternalModule (fsLit "GHC.Internal.Classes")
+gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers")
+gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple")
+
+gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module
+gHC_INTERNAL_CONTROL_MONAD_ZIP  = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Zip")
+
+gHC_INTERNAL_NUM_INTEGER, gHC_INTERNAL_NUM_NATURAL, gHC_INTERNAL_NUM_BIGNAT :: Module
+gHC_INTERNAL_NUM_INTEGER            = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Integer")
+gHC_INTERNAL_NUM_NATURAL            = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Natural")
+gHC_INTERNAL_NUM_BIGNAT             = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.BigNat")
+
+gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM,
+    gHC_INTERNAL_GHCI, gHC_INTERNAL_GHCI_HELPERS, gHC_CSTRING, gHC_INTERNAL_DATA_STRING,
+    gHC_INTERNAL_SHOW, gHC_INTERNAL_READ, gHC_INTERNAL_NUM, gHC_INTERNAL_MAYBE,
+    gHC_INTERNAL_LIST, gHC_INTERNAL_TUPLE, gHC_INTERNAL_DATA_EITHER,
+    gHC_INTERNAL_DATA_FOLDABLE, gHC_INTERNAL_DATA_TRAVERSABLE,
+    gHC_INTERNAL_EXCEPTION_CONTEXT,
+    gHC_INTERNAL_CONC, gHC_INTERNAL_IO, gHC_INTERNAL_IO_Exception,
+    gHC_INTERNAL_ST, gHC_INTERNAL_IX, gHC_INTERNAL_STABLE, gHC_INTERNAL_PTR, gHC_INTERNAL_ERR, gHC_INTERNAL_REAL,
+    gHC_INTERNAL_FLOAT, gHC_INTERNAL_TOP_HANDLER, gHC_INTERNAL_SYSTEM_IO, gHC_INTERNAL_DYNAMIC,
+    gHC_INTERNAL_TYPEABLE, gHC_INTERNAL_TYPEABLE_INTERNAL, gHC_INTERNAL_GENERICS,
+    gHC_INTERNAL_READ_PREC, gHC_INTERNAL_LEX, gHC_INTERNAL_INT, gHC_INTERNAL_WORD, gHC_INTERNAL_MONAD, gHC_INTERNAL_MONAD_FIX,  gHC_INTERNAL_MONAD_FAIL,
+    gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS, gHC_INTERNAL_IS_LIST,
+    gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL,
+    gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL,
+    gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR,
+    gHC_INTERNAL_JS_PRIM, gHC_INTERNAL_WASM_PRIM_TYPES :: Module
+gHC_INTERNAL_BASE                   = mkGhcInternalModule (fsLit "GHC.Internal.Base")
+gHC_INTERNAL_ENUM                   = mkGhcInternalModule (fsLit "GHC.Internal.Enum")
+gHC_INTERNAL_GHCI                   = mkGhcInternalModule (fsLit "GHC.Internal.GHCi")
+gHC_INTERNAL_GHCI_HELPERS           = mkGhcInternalModule (fsLit "GHC.Internal.GHCi.Helpers")
+gHC_INTERNAL_SHOW                   = mkGhcInternalModule (fsLit "GHC.Internal.Show")
+gHC_INTERNAL_READ                   = mkGhcInternalModule (fsLit "GHC.Internal.Read")
+gHC_INTERNAL_NUM                    = mkGhcInternalModule (fsLit "GHC.Internal.Num")
+gHC_INTERNAL_MAYBE                  = mkGhcInternalModule (fsLit "GHC.Internal.Maybe")
+gHC_INTERNAL_LIST                   = mkGhcInternalModule (fsLit "GHC.Internal.List")
+gHC_INTERNAL_DATA_EITHER            = mkGhcInternalModule (fsLit "GHC.Internal.Data.Either")
+gHC_INTERNAL_DATA_STRING            = mkGhcInternalModule (fsLit "GHC.Internal.Data.String")
+gHC_INTERNAL_DATA_FOLDABLE          = mkGhcInternalModule (fsLit "GHC.Internal.Data.Foldable")
+gHC_INTERNAL_DATA_TRAVERSABLE       = mkGhcInternalModule (fsLit "GHC.Internal.Data.Traversable")
+gHC_INTERNAL_CONC                   = mkGhcInternalModule (fsLit "GHC.Internal.GHC.Conc")
+gHC_INTERNAL_IO                     = mkGhcInternalModule (fsLit "GHC.Internal.IO")
+gHC_INTERNAL_IO_Exception           = mkGhcInternalModule (fsLit "GHC.Internal.IO.Exception")
+gHC_INTERNAL_ST                     = mkGhcInternalModule (fsLit "GHC.Internal.ST")
+gHC_INTERNAL_IX                     = mkGhcInternalModule (fsLit "GHC.Internal.Ix")
+gHC_INTERNAL_STABLE                 = mkGhcInternalModule (fsLit "GHC.Internal.Stable")
+gHC_INTERNAL_PTR                    = mkGhcInternalModule (fsLit "GHC.Internal.Ptr")
+gHC_INTERNAL_ERR                    = mkGhcInternalModule (fsLit "GHC.Internal.Err")
+gHC_INTERNAL_REAL                   = mkGhcInternalModule (fsLit "GHC.Internal.Real")
+gHC_INTERNAL_FLOAT                  = mkGhcInternalModule (fsLit "GHC.Internal.Float")
+gHC_INTERNAL_TOP_HANDLER            = mkGhcInternalModule (fsLit "GHC.Internal.TopHandler")
+gHC_INTERNAL_SYSTEM_IO              = mkGhcInternalModule (fsLit "GHC.Internal.System.IO")
+gHC_INTERNAL_DYNAMIC                = mkGhcInternalModule (fsLit "GHC.Internal.Data.Dynamic")
+gHC_INTERNAL_TYPEABLE               = mkGhcInternalModule (fsLit "GHC.Internal.Data.Typeable")
+gHC_INTERNAL_TYPEABLE_INTERNAL      = mkGhcInternalModule (fsLit "GHC.Internal.Data.Typeable.Internal")
+gHC_INTERNAL_DATA_DATA              = mkGhcInternalModule (fsLit "GHC.Internal.Data.Data")
+gHC_INTERNAL_READ_PREC              = mkGhcInternalModule (fsLit "GHC.Internal.Text.ParserCombinators.ReadPrec")
+gHC_INTERNAL_LEX                    = mkGhcInternalModule (fsLit "GHC.Internal.Text.Read.Lex")
+gHC_INTERNAL_INT                    = mkGhcInternalModule (fsLit "GHC.Internal.Int")
+gHC_INTERNAL_WORD                   = mkGhcInternalModule (fsLit "GHC.Internal.Word")
+gHC_INTERNAL_MONAD                  = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad")
+gHC_INTERNAL_MONAD_FIX              = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Fix")
+gHC_INTERNAL_MONAD_FAIL             = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Fail")
+gHC_INTERNAL_ARROW                  = mkGhcInternalModule (fsLit "GHC.Internal.Control.Arrow")
+gHC_INTERNAL_DESUGAR                = mkGhcInternalModule (fsLit "GHC.Internal.Desugar")
+gHC_INTERNAL_RANDOM                 = mkGhcInternalModule (fsLit "GHC.Internal.System.Random")
+gHC_INTERNAL_EXTS                   = mkGhcInternalModule (fsLit "GHC.Internal.Exts")
+gHC_INTERNAL_IS_LIST                = mkGhcInternalModule (fsLit "GHC.Internal.IsList")
+gHC_INTERNAL_CONTROL_EXCEPTION_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Control.Exception.Base")
+gHC_INTERNAL_EXCEPTION_CONTEXT      = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context")
+gHC_INTERNAL_GENERICS               = mkGhcInternalModule (fsLit "GHC.Internal.Generics")
+gHC_INTERNAL_TYPEERROR              = mkGhcInternalModule (fsLit "GHC.Internal.TypeError")
+gHC_INTERNAL_TYPELITS               = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits")
+gHC_INTERNAL_TYPELITS_INTERNAL      = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits.Internal")
+gHC_INTERNAL_TYPENATS               = mkGhcInternalModule (fsLit "GHC.Internal.TypeNats")
+gHC_INTERNAL_TYPENATS_INTERNAL      = mkGhcInternalModule (fsLit "GHC.Internal.TypeNats.Internal")
+gHC_INTERNAL_DATA_COERCE            = mkGhcInternalModule (fsLit "GHC.Internal.Data.Coerce")
+gHC_INTERNAL_DEBUG_TRACE            = mkGhcInternalModule (fsLit "GHC.Internal.Debug.Trace")
+gHC_INTERNAL_UNSAFE_COERCE          = mkGhcInternalModule (fsLit "GHC.Internal.Unsafe.Coerce")
+gHC_INTERNAL_FOREIGN_C_CONSTPTR     = mkGhcInternalModule (fsLit "GHC.Internal.Foreign.C.ConstPtr")
+gHC_INTERNAL_JS_PRIM                = mkGhcInternalModule (fsLit "GHC.Internal.JS.Prim")
+gHC_INTERNAL_WASM_PRIM_TYPES        = mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")
+
+gHC_INTERNAL_SRCLOC :: Module
+gHC_INTERNAL_SRCLOC = mkGhcInternalModule (fsLit "GHC.Internal.SrcLoc")
+
+gHC_INTERNAL_STACK, gHC_INTERNAL_STACK_TYPES :: Module
+gHC_INTERNAL_STACK = mkGhcInternalModule (fsLit "GHC.Internal.Stack")
+gHC_INTERNAL_STACK_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Stack.Types")
+
+gHC_INTERNAL_STATICPTR :: Module
+gHC_INTERNAL_STATICPTR = mkGhcInternalModule (fsLit "GHC.Internal.StaticPtr")
+
+gHC_INTERNAL_STATICPTR_INTERNAL :: Module
+gHC_INTERNAL_STATICPTR_INTERNAL = mkGhcInternalModule (fsLit "GHC.Internal.StaticPtr.Internal")
+
+gHC_INTERNAL_FINGERPRINT_TYPE :: Module
+gHC_INTERNAL_FINGERPRINT_TYPE = mkGhcInternalModule (fsLit "GHC.Internal.Fingerprint.Type")
+
+gHC_INTERNAL_OVER_LABELS :: Module
+gHC_INTERNAL_OVER_LABELS = mkGhcInternalModule (fsLit "GHC.Internal.OverloadedLabels")
+
+gHC_INTERNAL_RECORDS :: Module
+gHC_INTERNAL_RECORDS = mkGhcInternalModule (fsLit "GHC.Internal.Records")
 
 rOOT_MAIN :: Module
 rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
@@ -670,17 +671,11 @@ pRELUDE_NAME, mAIN_NAME :: ModuleName
 pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
 mAIN_NAME      = mkModuleNameFS (fsLit "Main")
 
-mkPrimModule :: FastString -> Module
-mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
-
-mkBignumModule :: FastString -> Module
-mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m)
+mkGhcInternalModule :: FastString -> Module
+mkGhcInternalModule m = mkGhcInternalModule_ (mkModuleNameFS m)
 
-mkBaseModule :: FastString -> Module
-mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)
-
-mkBaseModule_ :: ModuleName -> Module
-mkBaseModule_ m = mkModule baseUnit m
+mkGhcInternalModule_ :: ModuleName -> Module
+mkGhcInternalModule_ m = mkModule ghcInternalUnit m
 
 mkThisGhcModule :: FastString -> Module
 mkThisGhcModule m = mkThisGhcModule_ (mkModuleNameFS m)
@@ -735,9 +730,13 @@ 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")
+fromEnum_RDR, toEnum_RDR, toEnumError_RDR, succError_RDR, predError_RDR, enumIntToWord_RDR :: RdrName
+fromEnum_RDR            = varQual_RDR gHC_INTERNAL_ENUM (fsLit "fromEnum")
+toEnum_RDR              = varQual_RDR gHC_INTERNAL_ENUM (fsLit "toEnum")
+toEnumError_RDR         = varQual_RDR gHC_INTERNAL_ENUM (fsLit "toEnumError")
+succError_RDR           = varQual_RDR gHC_INTERNAL_ENUM (fsLit "succError")
+predError_RDR           = varQual_RDR gHC_INTERNAL_ENUM (fsLit "predError")
+enumIntToWord_RDR       = varQual_RDR gHC_INTERNAL_ENUM (fsLit "enumIntToWord")
 
 enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName
 enumFrom_RDR            = nameRdrName enumFromName
@@ -746,11 +745,11 @@ enumFromThen_RDR        = nameRdrName enumFromThenName
 enumFromThenTo_RDR      = nameRdrName enumFromThenToName
 
 times_RDR, plus_RDR :: RdrName
-times_RDR               = varQual_RDR  gHC_NUM (fsLit "*")
-plus_RDR                = varQual_RDR gHC_NUM (fsLit "+")
+times_RDR               = varQual_RDR  gHC_INTERNAL_NUM (fsLit "*")
+plus_RDR                = varQual_RDR gHC_INTERNAL_NUM (fsLit "+")
 
 compose_RDR :: RdrName
-compose_RDR             = varQual_RDR gHC_BASE (fsLit ".")
+compose_RDR             = varQual_RDR gHC_INTERNAL_BASE (fsLit ".")
 
 not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
     and_RDR, range_RDR, inRange_RDR, index_RDR,
@@ -758,56 +757,56 @@ not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
 and_RDR                 = varQual_RDR gHC_CLASSES (fsLit "&&")
 not_RDR                 = varQual_RDR gHC_CLASSES (fsLit "not")
 dataToTag_RDR           = varQual_RDR gHC_MAGIC (fsLit "dataToTag#")
-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")
+succ_RDR                = varQual_RDR gHC_INTERNAL_ENUM (fsLit "succ")
+pred_RDR                = varQual_RDR gHC_INTERNAL_ENUM (fsLit "pred")
+minBound_RDR            = varQual_RDR gHC_INTERNAL_ENUM (fsLit "minBound")
+maxBound_RDR            = varQual_RDR gHC_INTERNAL_ENUM (fsLit "maxBound")
+range_RDR               = varQual_RDR gHC_INTERNAL_IX (fsLit "range")
+inRange_RDR             = varQual_RDR gHC_INTERNAL_IX (fsLit "inRange")
+index_RDR               = varQual_RDR gHC_INTERNAL_IX (fsLit "index")
+unsafeIndex_RDR         = varQual_RDR gHC_INTERNAL_IX (fsLit "unsafeIndex")
+unsafeRangeSize_RDR     = varQual_RDR gHC_INTERNAL_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")
+readList_RDR            = varQual_RDR gHC_INTERNAL_READ (fsLit "readList")
+readListDefault_RDR     = varQual_RDR gHC_INTERNAL_READ (fsLit "readListDefault")
+readListPrec_RDR        = varQual_RDR gHC_INTERNAL_READ (fsLit "readListPrec")
+readListPrecDefault_RDR = varQual_RDR gHC_INTERNAL_READ (fsLit "readListPrecDefault")
+readPrec_RDR            = varQual_RDR gHC_INTERNAL_READ (fsLit "readPrec")
+parens_RDR              = varQual_RDR gHC_INTERNAL_READ (fsLit "parens")
+choose_RDR              = varQual_RDR gHC_INTERNAL_READ (fsLit "choose")
+lexP_RDR                = varQual_RDR gHC_INTERNAL_READ (fsLit "lexP")
+expectP_RDR             = varQual_RDR gHC_INTERNAL_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")
+readField_RDR           = varQual_RDR gHC_INTERNAL_READ (fsLit "readField")
+readFieldHash_RDR       = varQual_RDR gHC_INTERNAL_READ (fsLit "readFieldHash")
+readSymField_RDR        = varQual_RDR gHC_INTERNAL_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")
+punc_RDR                = dataQual_RDR gHC_INTERNAL_LEX (fsLit "Punc")
+ident_RDR               = dataQual_RDR gHC_INTERNAL_LEX (fsLit "Ident")
+symbol_RDR              = dataQual_RDR gHC_INTERNAL_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")
+step_RDR                = varQual_RDR  gHC_INTERNAL_READ_PREC (fsLit "step")
+alt_RDR                 = varQual_RDR  gHC_INTERNAL_READ_PREC (fsLit "+++")
+reset_RDR               = varQual_RDR  gHC_INTERNAL_READ_PREC (fsLit "reset")
+prec_RDR                = varQual_RDR  gHC_INTERNAL_READ_PREC (fsLit "prec")
+pfail_RDR               = varQual_RDR  gHC_INTERNAL_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")
+showsPrec_RDR           = varQual_RDR gHC_INTERNAL_SHOW (fsLit "showsPrec")
+shows_RDR               = varQual_RDR gHC_INTERNAL_SHOW (fsLit "shows")
+showString_RDR          = varQual_RDR gHC_INTERNAL_SHOW (fsLit "showString")
+showSpace_RDR           = varQual_RDR gHC_INTERNAL_SHOW (fsLit "showSpace")
+showCommaSpace_RDR      = varQual_RDR gHC_INTERNAL_SHOW (fsLit "showCommaSpace")
+showParen_RDR           = varQual_RDR gHC_INTERNAL_SHOW (fsLit "showParen")
 
 error_RDR :: RdrName
-error_RDR = varQual_RDR gHC_ERR (fsLit "error")
+error_RDR = varQual_RDR gHC_INTERNAL_ERR (fsLit "error")
 
 -- Generics (constructors and functions)
 u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
@@ -824,70 +823,70 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_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  = fieldQual_RDR gHC_GENERICS (fsLit "Par1")  (fsLit "unPar1")
-unRec1_RDR  = fieldQual_RDR gHC_GENERICS (fsLit "Rec1")  (fsLit "unRec1")
-unK1_RDR    = fieldQual_RDR gHC_GENERICS (fsLit "K1")    (fsLit "unK1")
-unComp1_RDR = fieldQual_RDR gHC_GENERICS (fsLit "Comp1") (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")
+u1DataCon_RDR    = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "U1")
+par1DataCon_RDR  = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "Par1")
+rec1DataCon_RDR  = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "Rec1")
+k1DataCon_RDR    = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "K1")
+m1DataCon_RDR    = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "M1")
+
+l1DataCon_RDR     = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "L1")
+r1DataCon_RDR     = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "R1")
+
+prodDataCon_RDR   = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit ":*:")
+comp1DataCon_RDR  = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "Comp1")
+
+unPar1_RDR  = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "Par1")  (fsLit "unPar1")
+unRec1_RDR  = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "Rec1")  (fsLit "unRec1")
+unK1_RDR    = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "K1")    (fsLit "unK1")
+unComp1_RDR = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "Comp1") (fsLit "unComp1")
+
+from_RDR  = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "from")
+from1_RDR = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "from1")
+to_RDR    = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "to")
+to1_RDR   = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "to1")
+
+datatypeName_RDR  = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "datatypeName")
+moduleName_RDR    = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "moduleName")
+packageName_RDR   = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "packageName")
+isNewtypeName_RDR = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "isNewtype")
+selName_RDR       = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "selName")
+conName_RDR       = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "conName")
+conFixity_RDR     = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "conFixity")
+conIsRecord_RDR   = varQual_RDR gHC_INTERNAL_GENERICS (fsLit "conIsRecord")
+
+prefixDataCon_RDR     = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "Prefix")
+infixDataCon_RDR      = dataQual_RDR gHC_INTERNAL_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")
+uAddrDataCon_RDR   = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UAddr")
+uCharDataCon_RDR   = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UChar")
+uDoubleDataCon_RDR = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UDouble")
+uFloatDataCon_RDR  = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UFloat")
+uIntDataCon_RDR    = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UInt")
+uWordDataCon_RDR   = dataQual_RDR gHC_INTERNAL_GENERICS (fsLit "UWord")
 
-uAddrHash_RDR   = fieldQual_RDR gHC_GENERICS (fsLit "UAddr")   (fsLit "uAddr#")
-uCharHash_RDR   = fieldQual_RDR gHC_GENERICS (fsLit "UChar")   (fsLit "uChar#")
-uDoubleHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UDouble") (fsLit "uDouble#")
-uFloatHash_RDR  = fieldQual_RDR gHC_GENERICS (fsLit "UFloat")  (fsLit "uFloat#")
-uIntHash_RDR    = fieldQual_RDR gHC_GENERICS (fsLit "UInt")    (fsLit "uInt#")
-uWordHash_RDR   = fieldQual_RDR gHC_GENERICS (fsLit "UWord")   (fsLit "uWord#")
+uAddrHash_RDR   = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UAddr")   (fsLit "uAddr#")
+uCharHash_RDR   = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UChar")   (fsLit "uChar#")
+uDoubleHash_RDR = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UDouble") (fsLit "uDouble#")
+uFloatHash_RDR  = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UFloat")  (fsLit "uFloat#")
+uIntHash_RDR    = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UInt")    (fsLit "uInt#")
+uWordHash_RDR   = fieldQual_RDR gHC_INTERNAL_GENERICS (fsLit "UWord")   (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 "<$")
+replace_RDR             = varQual_RDR gHC_INTERNAL_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")
+liftA2_RDR              = varQual_RDR gHC_INTERNAL_BASE (fsLit "liftA2")
+foldable_foldr_RDR      = varQual_RDR gHC_INTERNAL_DATA_FOLDABLE       (fsLit "foldr")
+foldMap_RDR             = varQual_RDR gHC_INTERNAL_DATA_FOLDABLE       (fsLit "foldMap")
+null_RDR                = varQual_RDR gHC_INTERNAL_DATA_FOLDABLE       (fsLit "null")
+all_RDR                 = varQual_RDR gHC_INTERNAL_DATA_FOLDABLE       (fsLit "all")
+traverse_RDR            = varQual_RDR gHC_INTERNAL_DATA_TRAVERSABLE    (fsLit "traverse")
 mempty_RDR              = nameRdrName memptyName
 mappend_RDR             = nameRdrName mappendName
 
@@ -918,7 +917,7 @@ wildCardName :: Name
 wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
 
 runMainIOName, runRWName :: Name
-runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
+runMainIOName = varQual gHC_INTERNAL_TOP_HANDLER (fsLit "runMainIO") runMainKey
 runRWName     = varQual gHC_MAGIC       (fsLit "runRW#")    runRWKey
 
 orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
@@ -931,12 +930,12 @@ 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
+eitherTyConName   = tcQual  gHC_INTERNAL_DATA_EITHER (fsLit "Either") eitherTyConKey
+leftDataConName   = dcQual gHC_INTERNAL_DATA_EITHER (fsLit "Left")   leftDataConKey
+rightDataConName  = dcQual gHC_INTERNAL_DATA_EITHER (fsLit "Right")  rightDataConKey
 
 voidTyConName :: Name
-voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey
+voidTyConName = tcQual gHC_INTERNAL_BASE (fsLit "Void") voidTyConKey
 
 -- Generics (types)
 v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
@@ -955,57 +954,57 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
   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
-
-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
+v1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "V1") v1TyConKey
+u1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "U1") u1TyConKey
+par1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Par1") par1TyConKey
+rec1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec1") rec1TyConKey
+k1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "K1") k1TyConKey
+m1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "M1") m1TyConKey
+
+sumTyConName    = tcQual gHC_INTERNAL_GENERICS (fsLit ":+:") sumTyConKey
+prodTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit ":*:") prodTyConKey
+compTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit ":.:") compTyConKey
+
+rTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "R") rTyConKey
+dTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "D") dTyConKey
+cTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "C") cTyConKey
+sTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "S") sTyConKey
+
+rec0TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec0") rec0TyConKey
+d1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "D1") d1TyConKey
+c1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "C1") c1TyConKey
+s1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "S1") s1TyConKey
+
+repTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep")  repTyConKey
+rep1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep1") rep1TyConKey
+
+uRecTyConName      = tcQual gHC_INTERNAL_GENERICS (fsLit "URec") uRecTyConKey
+uAddrTyConName     = tcQual gHC_INTERNAL_GENERICS (fsLit "UAddr") uAddrTyConKey
+uCharTyConName     = tcQual gHC_INTERNAL_GENERICS (fsLit "UChar") uCharTyConKey
+uDoubleTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit "UDouble") uDoubleTyConKey
+uFloatTyConName    = tcQual gHC_INTERNAL_GENERICS (fsLit "UFloat") uFloatTyConKey
+uIntTyConName      = tcQual gHC_INTERNAL_GENERICS (fsLit "UInt") uIntTyConKey
+uWordTyConName     = tcQual gHC_INTERNAL_GENERICS (fsLit "UWord") uWordTyConKey
+
+prefixIDataConName = dcQual gHC_INTERNAL_GENERICS (fsLit "PrefixI")  prefixIDataConKey
+infixIDataConName  = dcQual gHC_INTERNAL_GENERICS (fsLit "InfixI")   infixIDataConKey
+leftAssociativeDataConName  = dcQual gHC_INTERNAL_GENERICS (fsLit "LeftAssociative")   leftAssociativeDataConKey
+rightAssociativeDataConName = dcQual gHC_INTERNAL_GENERICS (fsLit "RightAssociative")  rightAssociativeDataConKey
+notAssociativeDataConName   = dcQual gHC_INTERNAL_GENERICS (fsLit "NotAssociative")    notAssociativeDataConKey
+
+sourceUnpackDataConName         = dcQual gHC_INTERNAL_GENERICS (fsLit "SourceUnpack")         sourceUnpackDataConKey
+sourceNoUnpackDataConName       = dcQual gHC_INTERNAL_GENERICS (fsLit "SourceNoUnpack")       sourceNoUnpackDataConKey
+noSourceUnpackednessDataConName = dcQual gHC_INTERNAL_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey
+sourceLazyDataConName           = dcQual gHC_INTERNAL_GENERICS (fsLit "SourceLazy")           sourceLazyDataConKey
+sourceStrictDataConName         = dcQual gHC_INTERNAL_GENERICS (fsLit "SourceStrict")         sourceStrictDataConKey
+noSourceStrictnessDataConName   = dcQual gHC_INTERNAL_GENERICS (fsLit "NoSourceStrictness")   noSourceStrictnessDataConKey
+decidedLazyDataConName          = dcQual gHC_INTERNAL_GENERICS (fsLit "DecidedLazy")          decidedLazyDataConKey
+decidedStrictDataConName        = dcQual gHC_INTERNAL_GENERICS (fsLit "DecidedStrict")        decidedStrictDataConKey
+decidedUnpackDataConName        = dcQual gHC_INTERNAL_GENERICS (fsLit "DecidedUnpack")        decidedUnpackDataConKey
+
+metaDataDataConName  = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaData")  metaDataDataConKey
+metaConsDataConName  = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaCons")  metaConsDataConKey
+metaSelDataConName   = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaSel")   metaSelDataConKey
 
 -- Primitive Int
 divIntName, modIntName :: Name
@@ -1018,7 +1017,7 @@ unpackCStringName, unpackCStringFoldrName,
     unpackCStringAppendName, unpackCStringAppendUtf8Name,
     eqStringName, cstringLengthName :: Name
 cstringLengthName       = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey
-eqStringName            = varQual gHC_BASE (fsLit "eqString")  eqStringIdKey
+eqStringName            = varQual gHC_INTERNAL_BASE (fsLit "eqString")  eqStringIdKey
 
 unpackCStringName       = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
 unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey
@@ -1039,50 +1038,50 @@ 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
+functorClassName  = clsQual gHC_INTERNAL_BASE    (fsLit "Functor") functorClassKey
+fmapName          = varQual gHC_INTERNAL_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
+monadClassName     = clsQual gHC_INTERNAL_BASE (fsLit "Monad")  monadClassKey
+thenMName          = varQual gHC_INTERNAL_BASE (fsLit ">>")     thenMClassOpKey
+bindMName          = varQual gHC_INTERNAL_BASE (fsLit ">>=")    bindMClassOpKey
+returnMName        = varQual gHC_INTERNAL_BASE (fsLit "return") returnMClassOpKey
 
 -- Class MonadFail
 monadFailClassName, failMName :: Name
-monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey
-failMName          = varQual mONAD_FAIL (fsLit "fail")      failMClassOpKey
+monadFailClassName = clsQual gHC_INTERNAL_MONAD_FAIL (fsLit "MonadFail") monadFailClassKey
+failMName          = varQual gHC_INTERNAL_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
+applicativeClassName = clsQual gHC_INTERNAL_BASE (fsLit "Applicative") applicativeClassKey
+apAName              = varQual gHC_INTERNAL_BASE (fsLit "<*>")         apAClassOpKey
+pureAName            = varQual gHC_INTERNAL_BASE (fsLit "pure")        pureAClassOpKey
+thenAName            = varQual gHC_INTERNAL_BASE (fsLit "*>")          thenAClassOpKey
 
 -- Classes (Foldable, Traversable)
 foldableClassName, traversableClassName :: Name
-foldableClassName     = clsQual  dATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey
-traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey
+foldableClassName     = clsQual  gHC_INTERNAL_DATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey
+traversableClassName  = clsQual  gHC_INTERNAL_DATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey
 
 -- Classes (Semigroup, Monoid)
 semigroupClassName, sappendName :: Name
-semigroupClassName = clsQual gHC_BASE       (fsLit "Semigroup") semigroupClassKey
-sappendName        = varQual gHC_BASE       (fsLit "<>")        sappendClassOpKey
+semigroupClassName = clsQual gHC_INTERNAL_BASE       (fsLit "Semigroup") semigroupClassKey
+sappendName        = varQual gHC_INTERNAL_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
+monoidClassName    = clsQual gHC_INTERNAL_BASE       (fsLit "Monoid")    monoidClassKey
+memptyName         = varQual gHC_INTERNAL_BASE       (fsLit "mempty")    memptyClassOpKey
+mappendName        = varQual gHC_INTERNAL_BASE       (fsLit "mappend")   mappendClassOpKey
+mconcatName        = varQual gHC_INTERNAL_BASE       (fsLit "mconcat")   mconcatClassOpKey
 
 
 
 -- AMP additions
 
 joinMName, alternativeClassName :: Name
-joinMName            = varQual gHC_BASE (fsLit "join")        joinMIdKey
-alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey
+joinMName            = varQual gHC_INTERNAL_BASE (fsLit "join")        joinMIdKey
+alternativeClassName = clsQual gHC_INTERNAL_MONAD (fsLit "Alternative") alternativeClassKey
 
 --
 joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey,
@@ -1096,28 +1095,28 @@ alternativeClassKey = mkPreludeMiscIdUnique 754
 
 -- Functions for GHC extensions
 considerAccessibleName :: Name
-considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerAccessibleIdKey
+considerAccessibleName = varQual gHC_INTERNAL_EXTS (fsLit "considerAccessible") considerAccessibleIdKey
 
--- Random GHC.Base functions
+-- Random GHC.Internal.Base functions
 fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
     mapName, appendName, assertName,
     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
-fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey
-
--- Module GHC.Num
+dollarName        = varQual gHC_INTERNAL_BASE (fsLit "$")          dollarIdKey
+otherwiseIdName   = varQual gHC_INTERNAL_BASE (fsLit "otherwise")  otherwiseIdKey
+foldrName         = varQual gHC_INTERNAL_BASE (fsLit "foldr")      foldrIdKey
+buildName         = varQual gHC_INTERNAL_BASE (fsLit "build")      buildIdKey
+augmentName       = varQual gHC_INTERNAL_BASE (fsLit "augment")    augmentIdKey
+mapName           = varQual gHC_INTERNAL_BASE (fsLit "map")        mapIdKey
+appendName        = varQual gHC_INTERNAL_BASE (fsLit "++")         appendIdKey
+assertName        = varQual gHC_INTERNAL_BASE (fsLit "assert")     assertIdKey
+fromStringName    = varQual gHC_INTERNAL_DATA_STRING (fsLit "fromString") fromStringClassOpKey
+
+-- Module GHC.Internal.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
+numClassName      = clsQual gHC_INTERNAL_NUM (fsLit "Num")         numClassKey
+fromIntegerName   = varQual gHC_INTERNAL_NUM (fsLit "fromInteger") fromIntegerClassOpKey
+minusName         = varQual gHC_INTERNAL_NUM (fsLit "-")           minusClassOpKey
+negateName        = varQual gHC_INTERNAL_NUM (fsLit "negate")      negateClassOpKey
 
 ---------------------------------
 -- ghc-bignum
@@ -1182,19 +1181,17 @@ integerFromNaturalName
    , naturalLogBaseName
    , naturalPowModName
    , naturalSizeInBaseName
-   , bignatFromWordListName
    , bignatEqName
    , bignatCompareName
    , bignatCompareWordName
    :: Name
 
 bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name
-bnbVarQual str key = varQual gHC_NUM_BIGNAT  (fsLit str) key
-bnnVarQual str key = varQual gHC_NUM_NATURAL (fsLit str) key
-bniVarQual str key = varQual gHC_NUM_INTEGER (fsLit str) key
+bnbVarQual str key = varQual gHC_INTERNAL_NUM_BIGNAT  (fsLit str) key
+bnnVarQual str key = varQual gHC_INTERNAL_NUM_NATURAL (fsLit str) key
+bniVarQual str key = varQual gHC_INTERNAL_NUM_INTEGER (fsLit str) key
 
 -- Types and DataCons
-bignatFromWordListName    = bnbVarQual "bigNatFromWordList#"       bignatFromWordListIdKey
 bignatEqName              = bnbVarQual "bigNatEq#"                 bignatEqIdKey
 bignatCompareName         = bnbVarQual "bigNatCompare"             bignatCompareIdKey
 bignatCompareWordName     = bnbVarQual "bigNatCompareWord#"        bignatCompareWordIdKey
@@ -1267,44 +1264,45 @@ integerShiftRName         = bniVarQual "integerShiftR#"            integerShiftR
 -- End of ghc-bignum
 ---------------------------------
 
--- GHC.Real types and classes
+-- GHC.Internal.Real types and classes
 rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
     integralClassName, realFracClassName, fractionalClassName,
     fromRationalName, toIntegerName, toRationalName, fromIntegralName,
     realToFracName, mkRationalBase2Name, mkRationalBase10Name :: 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
-mkRationalBase2Name  = varQual  gHC_REAL  (fsLit "mkRationalBase2")  mkRationalBase2IdKey
-mkRationalBase10Name = varQual  gHC_REAL  (fsLit "mkRationalBase10") mkRationalBase10IdKey
--- GHC.Float classes
+rationalTyConName   = tcQual  gHC_INTERNAL_REAL (fsLit "Rational")     rationalTyConKey
+ratioTyConName      = tcQual  gHC_INTERNAL_REAL (fsLit "Ratio")        ratioTyConKey
+ratioDataConName    = dcQual  gHC_INTERNAL_REAL (fsLit ":%")           ratioDataConKey
+realClassName       = clsQual gHC_INTERNAL_REAL (fsLit "Real")         realClassKey
+integralClassName   = clsQual gHC_INTERNAL_REAL (fsLit "Integral")     integralClassKey
+realFracClassName   = clsQual gHC_INTERNAL_REAL (fsLit "RealFrac")     realFracClassKey
+fractionalClassName = clsQual gHC_INTERNAL_REAL (fsLit "Fractional")   fractionalClassKey
+fromRationalName    = varQual gHC_INTERNAL_REAL (fsLit "fromRational") fromRationalClassOpKey
+toIntegerName       = varQual gHC_INTERNAL_REAL (fsLit "toInteger")    toIntegerClassOpKey
+toRationalName      = varQual gHC_INTERNAL_REAL (fsLit "toRational")   toRationalClassOpKey
+fromIntegralName    = varQual  gHC_INTERNAL_REAL (fsLit "fromIntegral")fromIntegralIdKey
+realToFracName      = varQual  gHC_INTERNAL_REAL (fsLit "realToFrac")  realToFracIdKey
+mkRationalBase2Name  = varQual  gHC_INTERNAL_REAL  (fsLit "mkRationalBase2")  mkRationalBase2IdKey
+mkRationalBase10Name = varQual  gHC_INTERNAL_REAL  (fsLit "mkRationalBase10") mkRationalBase10IdKey
+
+-- GHC.Internal.Float classes
 floatingClassName, realFloatClassName :: Name
-floatingClassName  = clsQual gHC_FLOAT (fsLit "Floating")  floatingClassKey
-realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
+floatingClassName  = clsQual gHC_INTERNAL_FLOAT (fsLit "Floating")  floatingClassKey
+realFloatClassName = clsQual gHC_INTERNAL_FLOAT (fsLit "RealFloat") realFloatClassKey
 
--- other GHC.Float functions
+-- other GHC.Internal.Float functions
 integerToFloatName, integerToDoubleName,
   naturalToFloatName, naturalToDoubleName,
   rationalToFloatName, rationalToDoubleName :: Name
-integerToFloatName   = varQual gHC_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey
-integerToDoubleName  = varQual gHC_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey
-naturalToFloatName   = varQual gHC_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey
-naturalToDoubleName  = varQual gHC_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey
-rationalToFloatName  = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
-rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
+integerToFloatName   = varQual gHC_INTERNAL_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey
+integerToDoubleName  = varQual gHC_INTERNAL_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey
+naturalToFloatName   = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey
+naturalToDoubleName  = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey
+rationalToFloatName  = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
+rationalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
 
 -- Class Ix
 ixClassName :: Name
-ixClassName = clsQual gHC_IX (fsLit "Ix") ixClassKey
+ixClassName = clsQual gHC_INTERNAL_IX (fsLit "Ix") ixClassKey
 
 -- Typeable representation types
 trModuleTyConName
@@ -1366,18 +1364,18 @@ typeableClassName
   , typeCharTypeRepName
   , 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
-typeCharTypeRepName   = varQual tYPEABLE_INTERNAL (fsLit "typeCharTypeRep") typeCharTypeRepKey
+typeableClassName     = clsQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey
+typeRepTyConName      = tcQual  gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey
+someTypeRepTyConName   = tcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepTyConKey
+someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepDataConKey
+typeRepIdName         = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey
+mkTrTypeName          = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey
+mkTrConName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey
+mkTrAppName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrApp")        mkTrAppKey
+mkTrFunName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey
+typeNatTypeRepName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
+typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
+typeCharTypeRepName   = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeCharTypeRep") typeCharTypeRepKey
 -- 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
@@ -1395,12 +1393,16 @@ withDictClassName :: Name
 withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey
 
 nonEmptyTyConName :: Name
-nonEmptyTyConName = tcQual gHC_BASE (fsLit "NonEmpty") nonEmptyTyConKey
+nonEmptyTyConName = tcQual gHC_INTERNAL_BASE (fsLit "NonEmpty") nonEmptyTyConKey
 
 -- DataToTag
 dataToTagClassName :: Name
 dataToTagClassName    = clsQual gHC_MAGIC      (fsLit "DataToTag") dataToTagClassKey
 
+-- seq#
+seqHashName :: Name
+seqHashName = varQual gHC_INTERNAL_IO (fsLit "seq#") seqHashKey
+
 -- Custom type errors
 errorMessageTypeErrorFamName
   , typeErrorTextDataConName
@@ -1410,185 +1412,185 @@ errorMessageTypeErrorFamName
   :: Name
 
 errorMessageTypeErrorFamName =
-  tcQual gHC_TYPEERROR (fsLit "TypeError") errorMessageTypeErrorFamKey
+  tcQual gHC_INTERNAL_TYPEERROR (fsLit "TypeError") errorMessageTypeErrorFamKey
 
 typeErrorTextDataConName =
-  dcQual gHC_TYPEERROR (fsLit "Text") typeErrorTextDataConKey
+  dcQual gHC_INTERNAL_TYPEERROR (fsLit "Text") typeErrorTextDataConKey
 
 typeErrorAppendDataConName =
-  dcQual gHC_TYPEERROR (fsLit ":<>:") typeErrorAppendDataConKey
+  dcQual gHC_INTERNAL_TYPEERROR (fsLit ":<>:") typeErrorAppendDataConKey
 
 typeErrorVAppendDataConName =
-  dcQual gHC_TYPEERROR (fsLit ":$$:") typeErrorVAppendDataConKey
+  dcQual gHC_INTERNAL_TYPEERROR (fsLit ":$$:") typeErrorVAppendDataConKey
 
 typeErrorShowTypeDataConName =
-  dcQual gHC_TYPEERROR (fsLit "ShowType") typeErrorShowTypeDataConKey
+  dcQual gHC_INTERNAL_TYPEERROR (fsLit "ShowType") typeErrorShowTypeDataConKey
 
 -- "Unsatisfiable" constraint
 unsatisfiableClassName, unsatisfiableIdName :: Name
 unsatisfiableClassName =
-  clsQual gHC_TYPEERROR (fsLit "Unsatisfiable") unsatisfiableClassNameKey
+  clsQual gHC_INTERNAL_TYPEERROR (fsLit "Unsatisfiable") unsatisfiableClassNameKey
 unsatisfiableIdName =
-  varQual gHC_TYPEERROR (fsLit "unsatisfiable") unsatisfiableIdNameKey
+  varQual gHC_INTERNAL_TYPEERROR (fsLit "unsatisfiable") unsatisfiableIdNameKey
 
 -- Unsafe coercion proofs
 unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName,
   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
+unsafeEqualityProofName = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey
+unsafeEqualityTyConName = tcQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey
+unsafeReflDataConName   = dcQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "UnsafeRefl")     unsafeReflDataConKey
+unsafeCoercePrimName    = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
 
 -- Dynamic
 toDynName :: Name
-toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey
+toDynName = varQual gHC_INTERNAL_DYNAMIC (fsLit "toDyn") toDynIdKey
 
 -- Class Data
 dataClassName :: Name
-dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey
+dataClassName = clsQual gHC_INTERNAL_DATA_DATA (fsLit "Data") dataClassKey
 
 -- Error module
 assertErrorName    :: Name
-assertErrorName   = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey
+assertErrorName   = varQual gHC_INTERNAL_IO_Exception (fsLit "assertError") assertErrorIdKey
 
--- Debug.Trace
+-- GHC.Internal.Debug.Trace
 traceName          :: Name
-traceName         = varQual dEBUG_TRACE (fsLit "trace") traceKey
+traceName         = varQual gHC_INTERNAL_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
+enumClassName      = clsQual gHC_INTERNAL_ENUM (fsLit "Enum")           enumClassKey
+enumFromName       = varQual gHC_INTERNAL_ENUM (fsLit "enumFrom")       enumFromClassOpKey
+enumFromToName     = varQual gHC_INTERNAL_ENUM (fsLit "enumFromTo")     enumFromToClassOpKey
+enumFromThenName   = varQual gHC_INTERNAL_ENUM (fsLit "enumFromThen")   enumFromThenClassOpKey
+enumFromThenToName = varQual gHC_INTERNAL_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
+boundedClassName   = clsQual gHC_INTERNAL_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
+concatName        = varQual gHC_INTERNAL_LIST (fsLit "concat") concatIdKey
+filterName        = varQual gHC_INTERNAL_LIST (fsLit "filter") filterIdKey
+zipName           = varQual gHC_INTERNAL_LIST (fsLit "zip")    zipIdKey
 
 -- Overloaded lists
 isListClassName, fromListName, fromListNName, toListName :: Name
-isListClassName = clsQual gHC_IS_LIST (fsLit "IsList")    isListClassKey
-fromListName    = varQual gHC_IS_LIST (fsLit "fromList")  fromListClassOpKey
-fromListNName   = varQual gHC_IS_LIST (fsLit "fromListN") fromListNClassOpKey
-toListName      = varQual gHC_IS_LIST (fsLit "toList")    toListClassOpKey
+isListClassName = clsQual gHC_INTERNAL_IS_LIST (fsLit "IsList")    isListClassKey
+fromListName    = varQual gHC_INTERNAL_IS_LIST (fsLit "fromList")  fromListClassOpKey
+fromListNName   = varQual gHC_INTERNAL_IS_LIST (fsLit "fromListN") fromListNClassOpKey
+toListName      = varQual gHC_INTERNAL_IS_LIST (fsLit "toList")    toListClassOpKey
 
 -- HasField class ops
 getFieldName, setFieldName :: Name
-getFieldName   = varQual gHC_RECORDS (fsLit "getField") getFieldClassOpKey
-setFieldName   = varQual gHC_RECORDS (fsLit "setField") setFieldClassOpKey
+getFieldName   = varQual gHC_INTERNAL_RECORDS (fsLit "getField") getFieldClassOpKey
+setFieldName   = varQual gHC_INTERNAL_RECORDS (fsLit "setField") setFieldClassOpKey
 
 -- Class Show
 showClassName :: Name
-showClassName   = clsQual gHC_SHOW (fsLit "Show")      showClassKey
+showClassName   = clsQual gHC_INTERNAL_SHOW (fsLit "Show")      showClassKey
 
 -- Class Read
 readClassName :: Name
-readClassName   = clsQual gHC_READ (fsLit "Read")      readClassKey
+readClassName   = clsQual gHC_INTERNAL_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
+genClassName  = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic")  genClassKey
+gen1ClassName = clsQual gHC_INTERNAL_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
+datatypeClassName    = clsQual gHC_INTERNAL_GENERICS (fsLit "Datatype")    datatypeClassKey
+constructorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Constructor") constructorClassKey
+selectorClassName    = clsQual gHC_INTERNAL_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
+ghciIoClassName = clsQual gHC_INTERNAL_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
+ghciStepIoMName = varQual gHC_INTERNAL_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
+thenIOName        = varQual gHC_INTERNAL_BASE  (fsLit "thenIO")   thenIOIdKey
+bindIOName        = varQual gHC_INTERNAL_BASE  (fsLit "bindIO")   bindIOIdKey
+returnIOName      = varQual gHC_INTERNAL_BASE  (fsLit "returnIO") returnIOIdKey
+failIOName        = varQual gHC_INTERNAL_IO    (fsLit "failIO")   failIOIdKey
 
 -- IO things
 printName :: Name
-printName         = varQual sYSTEM_IO (fsLit "print") printIdKey
+printName         = varQual gHC_INTERNAL_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
+int8TyConName     = tcQual gHC_INTERNAL_INT  (fsLit "Int8")  int8TyConKey
+int16TyConName    = tcQual gHC_INTERNAL_INT  (fsLit "Int16") int16TyConKey
+int32TyConName    = tcQual gHC_INTERNAL_INT  (fsLit "Int32") int32TyConKey
+int64TyConName    = tcQual gHC_INTERNAL_INT  (fsLit "Int64") int64TyConKey
 
 -- Word module
 word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name
-word8TyConName    = tcQual  gHC_WORD (fsLit "Word8")  word8TyConKey
-word16TyConName   = tcQual  gHC_WORD (fsLit "Word16") word16TyConKey
-word32TyConName   = tcQual  gHC_WORD (fsLit "Word32") word32TyConKey
-word64TyConName   = tcQual  gHC_WORD (fsLit "Word64") word64TyConKey
+word8TyConName    = tcQual  gHC_INTERNAL_WORD (fsLit "Word8")  word8TyConKey
+word16TyConName   = tcQual  gHC_INTERNAL_WORD (fsLit "Word16") word16TyConKey
+word32TyConName   = tcQual  gHC_INTERNAL_WORD (fsLit "Word32") word32TyConKey
+word64TyConName   = tcQual  gHC_INTERNAL_WORD (fsLit "Word64") word64TyConKey
 
 -- PrelPtr module
 ptrTyConName, funPtrTyConName :: Name
-ptrTyConName      = tcQual   gHC_PTR (fsLit "Ptr")    ptrTyConKey
-funPtrTyConName   = tcQual   gHC_PTR (fsLit "FunPtr") funPtrTyConKey
+ptrTyConName      = tcQual   gHC_INTERNAL_PTR (fsLit "Ptr")    ptrTyConKey
+funPtrTyConName   = tcQual   gHC_INTERNAL_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
+stablePtrTyConName    = tcQual   gHC_INTERNAL_STABLE (fsLit "StablePtr")    stablePtrTyConKey
+newStablePtrName      = varQual  gHC_INTERNAL_STABLE (fsLit "newStablePtr") newStablePtrIdKey
 
 -- Recursive-do notation
 monadFixClassName, mfixName :: Name
-monadFixClassName  = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey
-mfixName           = varQual mONAD_FIX (fsLit "mfix")     mfixIdKey
+monadFixClassName  = clsQual gHC_INTERNAL_MONAD_FIX (fsLit "MonadFix") monadFixClassKey
+mfixName           = varQual gHC_INTERNAL_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
+arrAName           = varQual gHC_INTERNAL_ARROW (fsLit "arr")       arrAIdKey
+composeAName       = varQual gHC_INTERNAL_DESUGAR (fsLit ">>>") composeAIdKey
+firstAName         = varQual gHC_INTERNAL_ARROW (fsLit "first")     firstAIdKey
+appAName           = varQual gHC_INTERNAL_ARROW (fsLit "app")       appAIdKey
+choiceAName        = varQual gHC_INTERNAL_ARROW (fsLit "|||")       choiceAIdKey
+loopAName          = varQual gHC_INTERNAL_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
+guardMName         = varQual gHC_INTERNAL_MONAD (fsLit "guard")    guardMIdKey
+liftMName          = varQual gHC_INTERNAL_MONAD (fsLit "liftM")    liftMIdKey
+mzipName           = varQual gHC_INTERNAL_CONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey
 
 
 -- Annotation type checking
 toAnnotationWrapperName :: Name
-toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey
+toAnnotationWrapperName = varQual gHC_INTERNAL_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey
 
 -- Other classes, needed for type defaulting
 monadPlusClassName, isStringClassName :: Name
-monadPlusClassName  = clsQual mONAD (fsLit "MonadPlus")      monadPlusClassKey
-isStringClassName   = clsQual dATA_STRING (fsLit "IsString") isStringClassKey
+monadPlusClassName  = clsQual gHC_INTERNAL_MONAD (fsLit "MonadPlus")      monadPlusClassKey
+isStringClassName   = clsQual gHC_INTERNAL_DATA_STRING (fsLit "IsString") isStringClassKey
 
 -- Type-level naturals
 knownNatClassName :: Name
-knownNatClassName     = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey
+knownNatClassName     = clsQual gHC_INTERNAL_TYPENATS (fsLit "KnownNat") knownNatClassNameKey
 knownSymbolClassName :: Name
-knownSymbolClassName  = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey
+knownSymbolClassName  = clsQual gHC_INTERNAL_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey
 knownCharClassName :: Name
-knownCharClassName  = clsQual gHC_TYPELITS (fsLit "KnownChar") knownCharClassNameKey
+knownCharClassName  = clsQual gHC_INTERNAL_TYPELITS (fsLit "KnownChar") knownCharClassNameKey
 
 -- Overloaded labels
 fromLabelClassOpName :: Name
 fromLabelClassOpName
- = varQual gHC_OVER_LABELS (fsLit "fromLabel") fromLabelClassOpKey
+ = varQual gHC_INTERNAL_OVER_LABELS (fsLit "fromLabel") fromLabelClassOpKey
 
 -- Implicit Parameters
 ipClassName :: Name
@@ -1598,19 +1600,26 @@ ipClassName
 -- Overloaded record fields
 hasFieldClassName :: Name
 hasFieldClassName
- = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey
+ = clsQual gHC_INTERNAL_RECORDS (fsLit "HasField") hasFieldClassNameKey
+
+-- ExceptionContext
+exceptionContextTyConName, emptyExceptionContextName :: Name
+exceptionContextTyConName =
+    tcQual gHC_INTERNAL_EXCEPTION_CONTEXT (fsLit "ExceptionContext") exceptionContextTyConKey
+emptyExceptionContextName
+  = varQual gHC_INTERNAL_EXCEPTION_CONTEXT (fsLit "emptyExceptionContext") emptyExceptionContextKey
 
 -- Source Locations
 callStackTyConName, emptyCallStackName, pushCallStackName,
   srcLocDataConName :: Name
 callStackTyConName
-  = tcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackTyConKey
+  = tcQual gHC_INTERNAL_STACK_TYPES  (fsLit "CallStack") callStackTyConKey
 emptyCallStackName
-  = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey
+  = varQual gHC_INTERNAL_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey
 pushCallStackName
-  = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey
+  = varQual gHC_INTERNAL_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey
 srcLocDataConName
-  = dcQual gHC_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey
+  = dcQual gHC_INTERNAL_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey
 
 -- plugins
 pLUGINS :: Module
@@ -1623,35 +1632,41 @@ frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPlugin
 -- Static pointers
 makeStaticName :: Name
 makeStaticName =
-    varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey
+    varQual gHC_INTERNAL_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey
 
 staticPtrInfoTyConName :: Name
 staticPtrInfoTyConName =
-    tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey
+    tcQual gHC_INTERNAL_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey
 
 staticPtrInfoDataConName :: Name
 staticPtrInfoDataConName =
-    dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey
+    dcQual gHC_INTERNAL_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey
 
 staticPtrTyConName :: Name
 staticPtrTyConName =
-    tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey
+    tcQual gHC_INTERNAL_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey
 
 staticPtrDataConName :: Name
 staticPtrDataConName =
-    dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey
+    dcQual gHC_INTERNAL_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey
 
 fromStaticPtrName :: Name
 fromStaticPtrName =
-    varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
+    varQual gHC_INTERNAL_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
 
 fingerprintDataConName :: Name
 fingerprintDataConName =
-    dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
+    dcQual gHC_INTERNAL_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
 
 constPtrConName :: Name
 constPtrConName =
-    tcQual fOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
+    tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
+
+jsvalTyConName :: Name
+jsvalTyConName = tcQual gHC_INTERNAL_WASM_PRIM_TYPES (fsLit "JSVal") jsvalTyConKey
+
+unsafeUnpackJSStringUtf8ShShName :: Name
+unsafeUnpackJSStringUtf8ShShName = varQual gHC_INTERNAL_JS_PRIM (fsLit "unsafeUnpackJSStringUtf8##") unsafeUnpackJSStringUtf8ShShKey
 
 {-
 ************************************************************************
@@ -1857,7 +1872,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
     eqReprPrimTyConKey, eqPhantPrimTyConKey,
     compactPrimTyConKey, stackSnapshotPrimTyConKey,
-    promptTagPrimTyConKey, constPtrTyConKey :: Unique
+    promptTagPrimTyConKey, constPtrTyConKey, jsvalTyConKey :: Unique
 statePrimTyConKey                       = mkPreludeTyConUnique 50
 stableNamePrimTyConKey                  = mkPreludeTyConUnique 51
 stableNameTyConKey                      = mkPreludeTyConUnique 52
@@ -1979,6 +1994,12 @@ uWordTyConKey   = mkPreludeTyConUnique 163
 unsatisfiableClassNameKey :: Unique
 unsatisfiableClassNameKey = mkPreludeTyConUnique 170
 
+anyTyConKey :: Unique
+anyTyConKey = mkPreludeTyConUnique 171
+
+zonkAnyTyConKey :: Unique
+zonkAnyTyConKey = mkPreludeTyConUnique 172
+
 -- Custom user type-errors
 errorMessageTypeErrorFamKey :: Unique
 errorMessageTypeErrorFamKey = mkPreludeTyConUnique 181
@@ -1992,9 +2013,6 @@ proxyPrimTyConKey = mkPreludeTyConUnique 184
 specTyConKey :: Unique
 specTyConKey = mkPreludeTyConUnique 185
 
-anyTyConKey :: Unique
-anyTyConKey = mkPreludeTyConUnique 186
-
 smallArrayPrimTyConKey        = mkPreludeTyConUnique  187
 smallMutableArrayPrimTyConKey = mkPreludeTyConUnique  188
 
@@ -2054,6 +2072,7 @@ typeSymbolKindConNameKey, typeCharKindConNameKey,
   , typeNatLogTyFamNameKey
   , typeConsSymbolTyFamNameKey, typeUnconsSymbolTyFamNameKey
   , typeCharToNatTyFamNameKey, typeNatToCharTyFamNameKey
+  , exceptionContextTyConKey, unsafeUnpackJSStringUtf8ShShKey
   :: Unique
 typeSymbolKindConNameKey  = mkPreludeTyConUnique 400
 typeCharKindConNameKey    = mkPreludeTyConUnique 401
@@ -2074,6 +2093,12 @@ typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415
 typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416
 constPtrTyConKey = mkPreludeTyConUnique 417
 
+jsvalTyConKey = mkPreludeTyConUnique 418
+
+exceptionContextTyConKey = mkPreludeTyConUnique 420
+
+unsafeUnpackJSStringUtf8ShShKey  = mkPreludeMiscIdUnique 805
+
 {-
 ************************************************************************
 *                                                                      *
@@ -2340,7 +2365,7 @@ rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 101
 runMainKey                    = mkPreludeMiscIdUnique 102
 
-thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique
+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey, seqHashKey :: Unique
 thenIOIdKey                   = mkPreludeMiscIdUnique 103
 lazyIdKey                     = mkPreludeMiscIdUnique 104
 assertErrorIdKey              = mkPreludeMiscIdUnique 105
@@ -2375,6 +2400,8 @@ rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
 rationalToFloatIdKey   = mkPreludeMiscIdUnique 132
 rationalToDoubleIdKey  = mkPreludeMiscIdUnique 133
 
+seqHashKey             = mkPreludeMiscIdUnique 134
+
 coerceKey :: Unique
 coerceKey                     = mkPreludeMiscIdUnique 157
 
@@ -2524,6 +2551,9 @@ fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560
 makeStaticKey :: Unique
 makeStaticKey = mkPreludeMiscIdUnique 561
 
+emptyExceptionContextKey :: Unique
+emptyExceptionContextKey = mkPreludeMiscIdUnique 562
+
 -- Unsafe coercion proofs
 unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
 unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
@@ -2602,7 +2632,6 @@ integerFromNaturalIdKey
    , naturalLogBaseIdKey
    , naturalPowModIdKey
    , naturalSizeInBaseIdKey
-   , bignatFromWordListIdKey
    , bignatEqIdKey
    , bignatCompareIdKey
    , bignatCompareWordIdKey
@@ -2670,7 +2699,6 @@ naturalLogBaseIdKey        = mkPreludeMiscIdUnique 682
 naturalPowModIdKey         = mkPreludeMiscIdUnique 683
 naturalSizeInBaseIdKey     = mkPreludeMiscIdUnique 684
 
-bignatFromWordListIdKey    = mkPreludeMiscIdUnique 690
 bignatEqIdKey              = mkPreludeMiscIdUnique 691
 bignatCompareIdKey         = mkPreludeMiscIdUnique 692
 bignatCompareWordIdKey     = mkPreludeMiscIdUnique 693
@@ -2747,57 +2775,3 @@ interactiveClassNames
 
 interactiveClassKeys :: [Unique]
 interactiveClassKeys = map getUnique interactiveClassNames
-
-{-
-************************************************************************
-*                                                                      *
-   Semi-builtin names
-*                                                                      *
-************************************************************************
-
-Note [pretendNameIsInScope]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In general, we filter out instances that mention types whose names are
-not in scope. However, in the situations listed below, we make an exception
-for some commonly used names, such as Data.Kind.Type, which may not actually
-be in scope but should be treated as though they were in scope.
-This includes built-in names, as well as a few extra names such as
-'Type', 'TYPE', 'BoxedRep', etc.
-
-Situations in which we apply this special logic:
-
-  - GHCi's :info command, see GHC.Runtime.Eval.getInfo.
-    This fixes #1581.
-
-  - When reporting instance overlap errors. Not doing so could mean
-    that we would omit instances for typeclasses like
-
-      type Cls :: k -> Constraint
-      class Cls a
-
-    because BoxedRep/Lifted were not in scope.
-    See GHC.Tc.Errors.potentialInstancesErrMsg.
-    This fixes one of the issues reported in #20465.
--}
-
--- | Should this name be considered in-scope, even though it technically isn't?
---
--- This ensures that we don't filter out information because, e.g.,
--- Data.Kind.Type isn't imported.
---
--- See Note [pretendNameIsInScope].
-pretendNameIsInScope :: Name -> Bool
-pretendNameIsInScope n
-  = isBuiltInSyntax n
-  || isTupleTyConName n
-  || any (n `hasKey`)
-    [ liftedTypeKindTyConKey, unliftedTypeKindTyConKey
-    , liftedDataConKey, unliftedDataConKey
-    , tYPETyConKey
-    , cONSTRAINTTyConKey
-    , runtimeRepTyConKey, boxedRepDataConKey
-    , eqTyConKey
-    , listTyConKey
-    , oneDataConKey
-    , manyDataConKey
-    , fUNTyConKey, unrestrictedFunTyConKey ]

compiler/GHC/Builtin/Names/TH.hs

@@ -47,7 +47,7 @@ templateHaskellNames = [
     litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName,
     conPName, tildePName, bangPName, infixPName,
     asPName, wildPName, recPName, listPName, sigPName, viewPName,
-    typePName,
+    typePName, invisPName, orPName,
     -- FieldPat
     fieldPatName,
     -- Match
@@ -62,7 +62,7 @@ templateHaskellNames = [
     fromEName, fromThenEName, fromToEName, fromThenToEName,
     listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,
     labelEName, implicitParamVarEName, getFieldEName, projectionEName,
-    typeEName,
+    typeEName, forallEName, forallVisEName, constrainedEName,
     -- FieldExp
     fieldExpName,
     -- Body
@@ -75,11 +75,14 @@ templateHaskellNames = [
     funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName,
     classDName, instanceWithOverlapDName,
     standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName,
-    pragInlDName, pragOpaqueDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
-    pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, defaultDName,
+    pragInlDName, pragOpaqueDName,
+    pragSpecDName, pragSpecInlDName, pragSpecEDName, pragSpecInlEDName,
+    pragSpecInstDName,
+    pragRuleDName, pragCompleteDName, pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName,
+    defaultSigDName, defaultDName,
     dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,
     dataInstDName, newtypeInstDName, tySynInstDName,
-    infixLDName, infixRDName, infixNDName,
+    infixLWithSpecDName, infixRWithSpecDName, infixNWithSpecDName,
     roleAnnotDName, patSynDName, patSynSigDName,
     implicitParamBindDName,
     -- Cxt
@@ -140,6 +143,9 @@ templateHaskellNames = [
     -- Overlap
     overlappableDataConName, overlappingDataConName, overlapsDataConName,
     incoherentDataConName,
+    -- NamespaceSpecifier
+    noNamespaceSpecifierDataConName, typeNamespaceSpecifierDataConName,
+    dataNamespaceSpecifierDataConName,
     -- DerivStrategy
     stockStrategyName, anyclassStrategyName,
     newtypeStrategyName, viaStrategyName,
@@ -158,7 +164,8 @@ templateHaskellNames = [
     liftClassName, quoteClassName,
 
     -- And the tycons
-    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchTyConName,
+    qTyConName, nameTyConName, patTyConName,
+    fieldPatTyConName, matchTyConName,
     expQTyConName, fieldExpTyConName, predTyConName,
     stmtTyConName,  decsTyConName, conTyConName, bangTypeTyConName,
     varBangTypeTyConName, typeQTyConName, expTyConName, decTyConName,
@@ -174,21 +181,23 @@ templateHaskellNames = [
     -- 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")
+thSyn, thLib, qqLib, liftLib :: Module
+thSyn = mkTHModule (fsLit "GHC.Internal.TH.Syntax")
+thLib = mkTHModule (fsLit "GHC.Internal.TH.Lib")
+qqLib = mkTHModule (fsLit "GHC.Internal.TH.Quote")
+liftLib = mkTHModule (fsLit "GHC.Internal.TH.Lift")
 
 mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thUnit (mkModuleNameFS m)
+mkTHModule m = mkModule ghcInternalUnit (mkModuleNameFS m)
 
-libFun, libTc, thFun, thTc, thCls, thCon :: FastString -> Unique -> Name
+libFun, libTc, thFun, thTc, thCls, thCon, liftFun :: 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
+liftFun = mk_known_key_name varName liftLib
 
 thFld :: FastString -> FastString -> Unique -> Name
 thFld con = mk_known_key_name (fieldName con) thSyn
@@ -198,7 +207,7 @@ qqFld = mk_known_key_name (fieldName (fsLit "QuasiQuoter")) qqLib
 
 -------------------- TH.Syntax -----------------------
 liftClassName :: Name
-liftClassName = thCls (fsLit "Lift") liftClassKey
+liftClassName = mk_known_key_name clsName liftLib (fsLit "Lift") liftClassKey
 
 quoteClassName :: Name
 quoteClassName = thCls (fsLit "Quote") quoteClassKey
@@ -234,8 +243,6 @@ 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
@@ -248,7 +255,9 @@ mkModNameName  = thFun (fsLit "mkModName")  mkModNameIdKey
 unTypeName     = thFld (fsLit "TExp") (fsLit "unType") unTypeIdKey
 unTypeCodeName    = thFun (fsLit "unTypeCode") unTypeCodeIdKey
 unsafeCodeCoerceName = thFun (fsLit "unsafeCodeCoerce") unsafeCodeCoerceIdKey
-liftTypedName = thFun (fsLit "liftTyped") liftTypedIdKey
+liftName       = liftFun (fsLit "lift")      liftIdKey
+liftStringName = liftFun (fsLit "liftString")  liftStringIdKey
+liftTypedName = liftFun (fsLit "liftTyped") liftTypedIdKey
 
 
 -------------------- TH.Lib -----------------------
@@ -270,7 +279,7 @@ charPrimLName   = libFun (fsLit "charPrimL")   charPrimLIdKey
 -- data Pat = ...
 litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName,
     infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName,
-    sigPName, viewPName, typePName :: Name
+    sigPName, viewPName, typePName, invisPName, orPName :: Name
 litPName   = libFun (fsLit "litP")   litPIdKey
 varPName   = libFun (fsLit "varP")   varPIdKey
 tupPName   = libFun (fsLit "tupP")   tupPIdKey
@@ -286,7 +295,9 @@ recPName   = libFun (fsLit "recP")   recPIdKey
 listPName  = libFun (fsLit "listP")  listPIdKey
 sigPName   = libFun (fsLit "sigP")   sigPIdKey
 viewPName  = libFun (fsLit "viewP")  viewPIdKey
+orPName    = libFun (fsLit "orP")    orPIdKey
 typePName  = libFun (fsLit "typeP")  typePIdKey
+invisPName = libFun (fsLit "invisP") invisPIdKey
 
 -- type FieldPat = ...
 fieldPatName :: Name
@@ -305,7 +316,8 @@ varEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName,
     sectionLName, sectionRName, lamEName, lamCaseEName, lamCasesEName, tupEName,
     unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,
     caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName,
-    labelEName, implicitParamVarEName, getFieldEName, projectionEName, typeEName :: Name
+    labelEName, implicitParamVarEName, getFieldEName, projectionEName, typeEName,
+    forallEName, forallVisEName, constrainedEName :: Name
 varEName              = libFun (fsLit "varE")              varEIdKey
 conEName              = libFun (fsLit "conE")              conEIdKey
 litEName              = libFun (fsLit "litE")              litEIdKey
@@ -347,6 +359,9 @@ implicitParamVarEName = libFun (fsLit "implicitParamVarE") implicitParamVarEIdKe
 getFieldEName         = libFun (fsLit "getFieldE")         getFieldEIdKey
 projectionEName       = libFun (fsLit "projectionE")       projectionEIdKey
 typeEName             = libFun (fsLit "typeE")             typeEIdKey
+forallEName           = libFun (fsLit "forallE")           forallEIdKey
+forallVisEName        = libFun (fsLit "forallVisE")        forallVisEIdKey
+constrainedEName      = libFun (fsLit "constrainedE")      constrainedEIdKey
 
 -- type FieldExp = ...
 fieldExpName :: Name
@@ -373,12 +388,14 @@ recSName    = libFun (fsLit "recS")    recSIdKey
 -- data Dec = ...
 funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName, classDName,
     instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName,
-    pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,
-    pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, defaultDName,
+    pragSpecDName, pragSpecInlDName, pragSpecEDName, pragSpecInlEDName,
+    pragSpecInstDName, pragRuleDName,
+    pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName,
+    standaloneDerivWithStrategyDName, defaultSigDName, defaultDName,
     dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,
-    openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,
-    infixNDName, roleAnnotDName, patSynDName, patSynSigDName,
-    pragCompleteDName, implicitParamBindDName, pragOpaqueDName :: Name
+    openTypeFamilyDName, closedTypeFamilyDName, infixLWithSpecDName,
+    infixRWithSpecDName, infixNWithSpecDName, roleAnnotDName, patSynDName,
+    patSynSigDName, pragCompleteDName, implicitParamBindDName, pragOpaqueDName :: Name
 funDName                         = libFun (fsLit "funD")                         funDIdKey
 valDName                         = libFun (fsLit "valD")                         valDIdKey
 dataDName                        = libFun (fsLit "dataD")                        dataDIdKey
@@ -397,19 +414,23 @@ pragInlDName                     = libFun (fsLit "pragInlD")
 pragOpaqueDName                  = libFun (fsLit "pragOpaqueD")                  pragOpaqueDIdKey
 pragSpecDName                    = libFun (fsLit "pragSpecD")                    pragSpecDIdKey
 pragSpecInlDName                 = libFun (fsLit "pragSpecInlD")                 pragSpecInlDIdKey
+pragSpecEDName                   = libFun (fsLit "pragSpecED")                   pragSpecEDIdKey
+pragSpecInlEDName                = libFun (fsLit "pragSpecInlED")                pragSpecInlEDIdKey
 pragSpecInstDName                = libFun (fsLit "pragSpecInstD")                pragSpecInstDIdKey
 pragRuleDName                    = libFun (fsLit "pragRuleD")                    pragRuleDIdKey
 pragCompleteDName                = libFun (fsLit "pragCompleteD")                pragCompleteDIdKey
 pragAnnDName                     = libFun (fsLit "pragAnnD")                     pragAnnDIdKey
+pragSCCFunDName                  = libFun (fsLit "pragSCCFunD")                  pragSCCFunDKey
+pragSCCFunNamedDName             = libFun (fsLit "pragSCCFunNamedD")             pragSCCFunNamedDKey
 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
+infixLWithSpecDName              = libFun (fsLit "infixLWithSpecD")              infixLWithSpecDIdKey
+infixRWithSpecDName              = libFun (fsLit "infixRWithSpecD")              infixRWithSpecDIdKey
+infixNWithSpecDName              = libFun (fsLit "infixNWithSpecD")              infixNWithSpecDIdKey
 roleAnnotDName                   = libFun (fsLit "roleAnnotD")                   roleAnnotDIdKey
 patSynDName                      = libFun (fsLit "patSynD")                      patSynDIdKey
 patSynSigDName                   = libFun (fsLit "patSynSigD")                   patSynSigDIdKey
@@ -651,6 +672,17 @@ overlappingDataConName  = thCon (fsLit "Overlapping")  overlappingDataConKey
 overlapsDataConName     = thCon (fsLit "Overlaps")     overlapsDataConKey
 incoherentDataConName   = thCon (fsLit "Incoherent")   incoherentDataConKey
 
+-- data NamespaceSpecifier = ...
+noNamespaceSpecifierDataConName,
+  typeNamespaceSpecifierDataConName,
+  dataNamespaceSpecifierDataConName :: Name
+noNamespaceSpecifierDataConName =
+  thCon (fsLit "NoNamespaceSpecifier") noNamespaceSpecifierDataConKey
+typeNamespaceSpecifierDataConName =
+  thCon (fsLit "TypeNamespaceSpecifier") typeNamespaceSpecifierDataConKey
+dataNamespaceSpecifierDataConName =
+  thCon (fsLit "DataNamespaceSpecifier") dataNamespaceSpecifierDataConKey
+
 {- *********************************************************************
 *                                                                      *
                      Class keys
@@ -758,6 +790,13 @@ overlappingDataConKey  = mkPreludeDataConUnique 210
 overlapsDataConKey     = mkPreludeDataConUnique 211
 incoherentDataConKey   = mkPreludeDataConUnique 212
 
+-- data NamespaceSpecifier = ...
+noNamespaceSpecifierDataConKey,
+  typeNamespaceSpecifierDataConKey,
+  dataNamespaceSpecifierDataConKey :: Unique
+noNamespaceSpecifierDataConKey = mkPreludeDataConUnique 213
+typeNamespaceSpecifierDataConKey = mkPreludeDataConUnique 214
+dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215
 {- *********************************************************************
 *                                                                      *
                      Id keys
@@ -812,7 +851,7 @@ liftStringIdKey     = mkPreludeMiscIdUnique 230
 -- data Pat = ...
 litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey,
   infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey,
-  listPIdKey, sigPIdKey, viewPIdKey, typePIdKey :: Unique
+  listPIdKey, sigPIdKey, viewPIdKey, typePIdKey, invisPIdKey, orPIdKey :: Unique
 litPIdKey         = mkPreludeMiscIdUnique 240
 varPIdKey         = mkPreludeMiscIdUnique 241
 tupPIdKey         = mkPreludeMiscIdUnique 242
@@ -829,6 +868,8 @@ listPIdKey        = mkPreludeMiscIdUnique 252
 sigPIdKey         = mkPreludeMiscIdUnique 253
 viewPIdKey        = mkPreludeMiscIdUnique 254
 typePIdKey        = mkPreludeMiscIdUnique 255
+invisPIdKey       = mkPreludeMiscIdUnique 256
+orPIdKey          = mkPreludeMiscIdUnique 257
 
 -- type FieldPat = ...
 fieldPatIdKey :: Unique
@@ -851,7 +892,8 @@ varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey,
     fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
     listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,
     unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey,
-    getFieldEIdKey, projectionEIdKey, typeEIdKey :: Unique
+    getFieldEIdKey, projectionEIdKey, typeEIdKey, forallEIdKey,
+    forallVisEIdKey, constrainedEIdKey :: Unique
 varEIdKey              = mkPreludeMiscIdUnique 270
 conEIdKey              = mkPreludeMiscIdUnique 271
 litEIdKey              = mkPreludeMiscIdUnique 272
@@ -889,6 +931,9 @@ mdoEIdKey              = mkPreludeMiscIdUnique 303
 getFieldEIdKey         = mkPreludeMiscIdUnique 304
 projectionEIdKey       = mkPreludeMiscIdUnique 305
 typeEIdKey             = mkPreludeMiscIdUnique 306
+forallEIdKey           = mkPreludeMiscIdUnique 802
+forallVisEIdKey        = mkPreludeMiscIdUnique 803
+constrainedEIdKey      = mkPreludeMiscIdUnique 804
 
 -- type FieldExp = ...
 fieldExpIdKey :: Unique
@@ -919,9 +964,11 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,
     pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey,
     openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey,
     newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,
-    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,
-    patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,
-    kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, typeDataDIdKey :: Unique
+    infixLWithSpecDIdKey, infixRWithSpecDIdKey, infixNWithSpecDIdKey,
+    roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey,
+    implicitParamBindDIdKey, kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey,
+    typeDataDIdKey, pragSCCFunDKey, pragSCCFunNamedDKey,
+    pragSpecEDIdKey, pragSpecInlEDIdKey :: Unique
 funDIdKey                         = mkPreludeMiscIdUnique 320
 valDIdKey                         = mkPreludeMiscIdUnique 321
 dataDIdKey                        = mkPreludeMiscIdUnique 322
@@ -944,9 +991,9 @@ dataInstDIdKey                    = mkPreludeMiscIdUnique 338
 newtypeInstDIdKey                 = mkPreludeMiscIdUnique 339
 tySynInstDIdKey                   = mkPreludeMiscIdUnique 340
 closedTypeFamilyDIdKey            = mkPreludeMiscIdUnique 341
-infixLDIdKey                      = mkPreludeMiscIdUnique 342
-infixRDIdKey                      = mkPreludeMiscIdUnique 343
-infixNDIdKey                      = mkPreludeMiscIdUnique 344
+infixLWithSpecDIdKey              = mkPreludeMiscIdUnique 342
+infixRWithSpecDIdKey              = mkPreludeMiscIdUnique 343
+infixNWithSpecDIdKey              = mkPreludeMiscIdUnique 344
 roleAnnotDIdKey                   = mkPreludeMiscIdUnique 345
 standaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346
 defaultSigDIdKey                  = mkPreludeMiscIdUnique 347
@@ -958,6 +1005,10 @@ kiSigDIdKey                       = mkPreludeMiscIdUnique 352
 defaultDIdKey                     = mkPreludeMiscIdUnique 353
 pragOpaqueDIdKey                  = mkPreludeMiscIdUnique 354
 typeDataDIdKey                    = mkPreludeMiscIdUnique 355
+pragSCCFunDKey                    = mkPreludeMiscIdUnique 356
+pragSCCFunNamedDKey               = mkPreludeMiscIdUnique 357
+pragSpecEDIdKey                   = mkPreludeMiscIdUnique 358
+pragSpecInlEDIdKey                = mkPreludeMiscIdUnique 359
 
 -- type Cxt = ...
 cxtIdKey :: Unique

compiler/GHC/Builtin/PrimOps.hs

@@ -18,7 +18,7 @@ module GHC.Builtin.PrimOps (
 
         primOpOutOfLine, primOpCodeSize,
         primOpOkForSpeculation, primOpOkToDiscard,
-        primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs,
+        primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs, primOpDeprecations,
         primOpIsDiv, primOpIsReallyInline,
 
         PrimOpEffect(..), primOpEffect,
@@ -44,12 +44,11 @@ import GHC.Types.Demand
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Name
-import GHC.Types.RepType ( tyConPrimRep1 )
+import GHC.Types.RepType ( tyConPrimRep )
 import GHC.Types.Basic
 import GHC.Types.Fixity  ( Fixity(..), FixityDirection(..) )
 import GHC.Types.SrcLoc  ( wiredInSrcSpan )
 import GHC.Types.ForeignCall ( CLabelString )
-import GHC.Types.SourceText  ( SourceText(..) )
 import GHC.Types.Unique  ( Unique )
 
 import GHC.Unit.Types    ( Unit )
@@ -163,12 +162,15 @@ primOpFixity :: PrimOp -> Maybe Fixity
 *                                                                      *
 ************************************************************************
 
-See Note [GHC.Prim Docs]
+See Note [GHC.Prim Docs] in GHC.Builtin.Utils
 -}
 
-primOpDocs :: [(String, String)]
+primOpDocs :: [(FastString, String)]
 #include "primop-docs.hs-incl"
 
+primOpDeprecations :: [(OccName, FastString)]
+#include "primop-deprecations.hs-incl"
+
 {-
 ************************************************************************
 *                                                                      *
@@ -857,7 +859,8 @@ primOpSig op
         GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty   )
 
 data PrimOpResultInfo
-  = ReturnsPrim     PrimRep
+  = ReturnsVoid
+  | ReturnsPrim     PrimRep
   | ReturnsTuple
 
 -- Some PrimOps need not return a manifest primitive or algebraic value
@@ -867,8 +870,11 @@ data PrimOpResultInfo
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
 getPrimOpResultInfo op
   = case (primOpInfo op) of
-      Compare _ _                         -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)
-      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)
+      Compare _ _                         -> ReturnsPrim IntRep
+      GenPrimOp _ _ _ ty | isPrimTyCon tc -> case tyConPrimRep tc of
+                                               [] -> ReturnsVoid
+                                               [rep] -> ReturnsPrim rep
+                                               _ -> pprPanic "getPrimOpResultInfo" (ppr op)
                          | isUnboxedTupleTyCon tc -> ReturnsTuple
                          | otherwise      -> pprPanic "getPrimOpResultInfo" (ppr op)
                          where
@@ -916,10 +922,10 @@ instance Outputable PrimCall where
         = text "__primcall" <+> ppr pkgId <+> ppr lbl
 
 -- | Indicate if a primop is really inline: that is, it isn't out-of-line and it
--- isn't SeqOp/DataToTagOp which are two primops that evaluate their argument
+-- isn't DataToTagOp which are two primops that evaluate their argument
 -- hence induce thread/stack/heap changes.
 primOpIsReallyInline :: PrimOp -> Bool
 primOpIsReallyInline = \case
-  SeqOp       -> False
-  DataToTagOp -> False
-  p           -> not (primOpOutOfLine p)
+  DataToTagSmallOp -> False
+  DataToTagLargeOp -> False
+  p                -> not (primOpOutOfLine p)

compiler/GHC/Builtin/PrimOps.hs-boot

 module GHC.Builtin.PrimOps where
 
-import GHC.Prelude ()
+-- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
+import GHC.Base ()
 
 data PrimOp

compiler/GHC/Builtin/PrimOps/Ids.hs

@@ -16,6 +16,7 @@ import GHC.Prelude
 import {-# SOURCE #-} GHC.Core.Opt.ConstantFold (primOpRules)
 import GHC.Core.TyCo.Rep ( scaledThing )
 import GHC.Core.Type
+import GHC.Core.Predicate( tyCoVarsOfTypeWellScoped )
 import GHC.Core.FVs (mkRuleInfo)
 
 import GHC.Builtin.PrimOps

compiler/GHC/Builtin/Types.hs

@@ -6,6 +6,7 @@ Wired-in knowledge about {\em non-primitive} types
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ParallelListComp #-}
+{-# LANGUAGE MultiWayIf #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -19,7 +20,9 @@ module GHC.Builtin.Types (
         mkWiredInIdName,    -- used in GHC.Types.Id.Make
 
         -- * All wired in things
-        wiredInTyCons, isBuiltInOcc_maybe, isTupleTyOcc_maybe, isPunOcc_maybe,
+        wiredInTyCons, isBuiltInOcc, isBuiltInOcc_maybe,
+        isTupleTyOrigName_maybe, isSumTyOrigName_maybe,
+        isInfiniteFamilyOrigName_maybe,
 
         -- * Bool
         boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
@@ -62,7 +65,7 @@ module GHC.Builtin.Types (
         nilDataCon, nilDataConName, nilDataConKey,
         consDataCon_RDR, consDataCon, consDataConName,
         promotedNilDataCon, promotedConsDataCon,
-        mkListTy, mkPromotedListTy,
+        mkListTy, mkPromotedListTy, extractPromotedList,
 
         -- * Maybe
         maybeTyCon, maybeTyConName,
@@ -76,26 +79,28 @@ module GHC.Builtin.Types (
         promotedTupleDataCon,
         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
         soloTyCon,
+        soloDataConName,
         pairTyCon, mkPromotedPairTy, isPromotedPairType,
         unboxedUnitTy,
         unboxedUnitTyCon, unboxedUnitDataCon,
+        unboxedSoloTyCon, unboxedSoloTyConName, unboxedSoloDataConName,
         unboxedTupleKind, unboxedSumKind,
-        filterCTuple, mkConstraintTupleTy,
+        mkConstraintTupleTy,
 
         -- ** Constraint tuples
         cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
-        cTupleTyConNameArity_maybe,
         cTupleDataCon, cTupleDataConName, cTupleDataConNames,
         cTupleSelId, cTupleSelIdName,
 
         -- * Any
-        anyTyCon, anyTy, anyTypeOfKind,
+        anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon,
 
         -- * Recovery TyCon
         makeRecoveryTyCon,
 
         -- * Sums
         mkSumTy, sumTyCon, sumDataCon,
+        unboxedSumTyConName, unboxedSumDataConName,
 
         -- * Kinds
         typeSymbolKindCon, typeSymbolKind,
@@ -158,7 +163,9 @@ module GHC.Builtin.Types (
         integerINDataCon, integerINDataConName,
         naturalTy, naturalTyCon, naturalTyConName,
         naturalNSDataCon, naturalNSDataConName,
-        naturalNBDataCon, naturalNBDataConName
+        naturalNBDataCon, naturalNBDataConName,
+
+         pretendNameIsInScope,
     ) where
 
 import GHC.Prelude
@@ -180,7 +187,7 @@ import GHC.Core.ConLike
 import GHC.Core.TyCon
 import GHC.Core.Class     ( Class, mkClass )
 import GHC.Core.Map.Type  ( TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap )
-import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
+import qualified GHC.Core.TyCo.Rep as TyCoRep ( Type(TyConApp) )
 
 import GHC.Types.TyThing
 import GHC.Types.SourceText
@@ -201,6 +208,7 @@ import {-# SOURCE #-} GHC.Tc.Utils.TcType
 import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
 import GHC.Unit.Module        ( Module )
 
+import Data.Maybe
 import Data.Array
 import GHC.Data.FastString
 import GHC.Data.BooleanFormula ( mkAnd )
@@ -209,14 +217,15 @@ import GHC.Utils.Outputable
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 
-import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Short as SBS
+import qualified Data.ByteString.Short.Internal as SBS (unsafeIndex)
 
 import Data.Foldable
-import Data.List        ( elemIndex, intersperse )
+import Data.List        ( intersperse )
 import Numeric          ( showInt )
 
-import Text.Read (readMaybe)
-import Data.Char (ord, isDigit)
+import Data.Word (Word8)
+import Control.Applicative ((<|>))
 
 alpha_tyvar :: [TyVar]
 alpha_tyvar = [alphaTyVar]
@@ -273,38 +282,23 @@ 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
+-- This list is used only to define GHC.Builtin.Utils.knownKeyNames. 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, including boxed, unboxed and constraint tuples
----       (mkTupleTyCon, unitTyCon, pairTyCon)
---   * unboxed sums (sumTyCon)
+--   * Tuples of all sorts (boxed, unboxed, constraint) (mkTupleTyCon)
+--   * Unboxed sums (sumTyCon)
 -- See Note [Infinite families of known-key names] in GHC.Builtin.Names
 --
 -- See also Note [Known-key names]
 wiredInTyCons :: [TyCon]
 
 wiredInTyCons = map (dataConTyCon . snd) boxingDataCons
-             ++ [ -- 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
-
-                -- Solo (i.e., the boxed 1-tuple) is also not treated
-                -- like other tuples (i.e. we /do/ include it here),
-                -- since it does not use special syntax like other tuples
-                -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names
-                -- have known keys) in GHC.Builtin.Types.
-                , soloTyCon
-
-                , anyTyCon
+             ++ [ anyTyCon
+                , zonkAnyTyCon
                 , boolTyCon
                 , charTyCon
                 , stringTyCon
@@ -326,6 +320,7 @@ wiredInTyCons = map (dataConTyCon . snd) boxingDataCons
                 , constraintKindTyCon
                 , liftedTypeKindTyCon
                 , unliftedTypeKindTyCon
+                , unrestrictedFunTyCon
                 , multiplicityTyCon
                 , naturalTyCon
                 , integerTyCon
@@ -377,7 +372,7 @@ coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercib
 charTyConName, charDataConName, intTyConName, intDataConName, stringTyConName :: Name
 charTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Char")   charTyConKey charTyCon
 charDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#")     charDataConKey charDataCon
-stringTyConName   = mkWiredInTyConName   UserSyntax gHC_BASE  (fsLit "String") stringTyConKey stringTyCon
+stringTyConName   = mkWiredInTyConName   UserSyntax gHC_INTERNAL_BASE  (fsLit "String") stringTyConKey stringTyCon
 intTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int")    intTyConKey   intTyCon
 intDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#")     intDataConKey  intDataCon
 
@@ -392,17 +387,17 @@ nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") ni
 consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
 
 maybeTyConName, nothingDataConName, justDataConName :: Name
-maybeTyConName     = mkWiredInTyConName   UserSyntax gHC_MAYBE (fsLit "Maybe")
+maybeTyConName     = mkWiredInTyConName   UserSyntax gHC_INTERNAL_MAYBE (fsLit "Maybe")
                                           maybeTyConKey maybeTyCon
-nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
+nothingDataConName = mkWiredInDataConName UserSyntax gHC_INTERNAL_MAYBE (fsLit "Nothing")
                                           nothingDataConKey nothingDataCon
-justDataConName    = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
+justDataConName    = mkWiredInDataConName UserSyntax gHC_INTERNAL_MAYBE (fsLit "Just")
                                           justDataConKey justDataCon
 
 wordTyConName, wordDataConName, word8DataConName :: Name
 wordTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Word")   wordTyConKey     wordTyCon
 wordDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#")     wordDataConKey   wordDataCon
-word8DataConName   = mkWiredInDataConName UserSyntax gHC_WORD  (fsLit "W8#")    word8DataConKey  word8DataCon
+word8DataConName   = mkWiredInDataConName UserSyntax gHC_INTERNAL_WORD  (fsLit "W8#")    word8DataConKey  word8DataCon
 
 floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
 floatTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Float")  floatTyConKey    floatTyCon
@@ -415,57 +410,105 @@ doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")
 {-
 Note [Any types]
 ~~~~~~~~~~~~~~~~
-The type constructor Any,
+The type constructors `Any` and `ZonkAny` are closed type families declared thus:
 
-    type family Any :: k where { }
+    type family Any     :: forall k.        k where { }
+    type family ZonkAny :: forall k. Nat -> k where { }
 
-It has these properties:
+They are used when we want a type of a particular kind, but we don't really care
+what that type is.  The leading example is this: `ZonkAny` is used to instantiate
+un-constrained type variables after type checking. For example, consider the
+term (length [] :: Int), where
 
-  * 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``.
+  length :: forall a. [a] -> Int
+  []     :: forall a. [a]
 
-  * 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
+We must type-apply `length` and `[]`, but to what type? It doesn't matter!
+The typechecker will end up with
 
-  * 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.
+  length @alpha ([] @alpha)
 
-  * When instantiated at a lifted type it is inhabited by at least one value,
-    namely bottom
+where `alpha` is an un-constrained unification variable.  The "zonking" process zaps
+that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is
+arbitrary (see wrinkle (Any5) below).  This is done in `GHC.Tc.Zonk.Type.commitFlexi`.
+So we end up with
 
-  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.
+  length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3))
 
-  * 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.
+`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see
+wrinkle (Any4).
 
-  * 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)
+Wrinkles:
 
-It's used to instantiate un-constrained type variables after type checking. For
-example, 'length' has type
+(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may
+   need to use `ZonkAny` to fill in a type variable of some kind other than *
+   (see #959 for examples).
 
-  length :: forall a. [a] -> Int
+(Any2) They are /closed/ type families, with no instances.  For example, suppose that
+   with  alpha :: '(k1, k2)  we add a given coercion
+             g :: alpha ~ (Fst alpha, Snd alpha)
+   and we zonked alpha = ZonkAny @(k1,k2) n.  Then, if `ZonkAny` was a /data/ type,
+   we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one
+   side and '(,) on the other. See also #9097 and #9636.
+
+   See #25244 for a suggestion that we instead use an /open/ type family for which
+   you cannot provide instances.  Probably the difference is not very important.
+
+(Any3) They do not claim to be /data/ types, and that's important for
+   the code generator, because the code gen may /enter/ a data value
+   but never enters a function value.
 
-and the list datacon for the empty list has type
+(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/
+   types (#24817).  Consider
 
-  [] :: forall a. [a]
+     data SBool a where { STrue :: SBool True; SFalse :: SBool False }
 
-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',
+     foo :: forall a b. (SBool a, SBool b)
 
-> length @(Any @Type) ([] @(Any @Type))
+     bar :: Bool
+     bar = case foo @alpha @beta of
+             (STrue, SFalse) -> True   -- This branch is not inaccessible!
+             _               -> False
+
+   Now, what are `alpha` and `beta`? If we zonk both of them to the same type
+   `Any @Type`, the pattern-match checker will (wrongly) report that the first
+   branch is inaccessible.  So we zonk them to two /different/ types:
+       alpha :=  ZonkAny @Type 4   and   beta :=  ZonkAny @Type k 5
+   (The actual numbers are arbitrary; they just need to differ.)
+
+   The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and
+   `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to
+   make up a fresh type.
+
+   If this example seems unconvincing (e.g. in this case foo must be bottom)
+   see #24817 for larger but more compelling examples.
+
+(Any5) `Any` and `ZonkAny` are 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)
+
+(Any6) `Any` is defined in library module ghc-prim: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
+    Currently `ZonkAny` is not available to users; but it could easily be.
 
-Above, we print kinds explicitly, as if with -fprint-explicit-kinds.
+(Any7) Properties of `Any`:
+  * When `Any` is 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`.
+
+  * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`.
+
+  * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when
+    the kinds of both the type and `Any` match.
+
+  * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over
+    `unsafeCoerce#` as they prevent accidentally coercing between types with kinds
+    that don't match.
+
+    See examples in ghc-prim:GHC.Types
 
 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
@@ -478,6 +521,7 @@ anyTyConName =
     mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon
 
 anyTyCon :: TyCon
+-- See Note [Any types]
 anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing
                          (ClosedSynFamilyTyCon Nothing)
                          Nothing
@@ -492,6 +536,24 @@ anyTy = mkTyConTy anyTyCon
 anyTypeOfKind :: Kind -> Type
 anyTypeOfKind kind = mkTyConApp anyTyCon [kind]
 
+zonkAnyTyConName :: Name
+zonkAnyTyConName =
+    mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon
+
+zonkAnyTyCon :: TyCon
+-- ZonkAnyTyCon :: forall k. Nat -> k
+-- See Note [Any types]
+zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName
+                         [ mkNamedTyConBinder Specified kv
+                         , mkAnonTyConBinder nat_kv ]
+                         (mkTyVarTy kv)
+                         Nothing
+                         (ClosedSynFamilyTyCon Nothing)
+                         Nothing
+                         NotInjective
+  where
+    [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy]
+
 -- | Make a fake, recovery 'TyCon' from an existing one.
 -- Used when recovering from errors in type declarations
 makeRecoveryTyCon :: TyCon -> TyCon
@@ -636,6 +698,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri
     -- See Note [Constructor tag allocation] and #14657
     data_con = mkDataCon dc_name declared_infix prom_info
                 (map (const no_bang) arg_tys)
+                (map (const HsLazy) arg_tys)
+                (map (const NotMarkedStrict) arg_tys)
                 []      -- No labelled fields
                 tyvars ex_tyvars
                 conc_tyvars
@@ -706,37 +770,35 @@ Note [How tuples work]
 
 * UnboxedTuples
     - A wired-in type
-    - Have a pretend DataCon, defined in GHC.Prim,
+    - Data type declarations in GHC.Types
       but no actual declaration and no info table
 
 * ConstraintTuples
     - A wired-in type.
     - Declared as classes in GHC.Classes, e.g.
-         class (c1,c2) => (c1,c2)
+         class (c1,c2) => CTuple2 c1 c2
     - Given constraints: the superclasses automatically become available
     - Wanted constraints: there is a built-in instance
-         instance (c1,c2) => (c1,c2)
+         instance (c1,c2) => CTuple2 c1 c2
       See GHC.Tc.Instance.Class.matchCTuple
     - Currently just go up to 64; 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.
     - Unlike BoxedTuples and UnboxedTuples, which only wire
       in type constructors and data constructors, ConstraintTuples also wire in
-      superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are
+      superclass selector functions. For instance, $p1CTuple2 and $p2CTuple2 are
       the selectors for the binary constraint tuple.
+    - The parenthesis syntax for grouping constraints in contexts is not treated
+      as a constraint tuple. The parser starts with a tuple type, then a
+      postprocessing action extracts the individual constraints as a list and
+      stores them in the context field of types like HsQualTy.
 
 * 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.
+  (GHC.Types.Name.Cache.lookupOrigNameCache), we spot the tuple OccName to make
+  sure we get the right wired-in name.
 
 * Serialization to interface files works via the usual mechanism for known-key
   things: instead of serializing the OccName we just serialize the key. During
@@ -776,141 +838,466 @@ They can, however, be written using other methods:
 There is nothing special about one-tuples in Core; in particular, they have no
 custom pretty-printing, just using `Solo`.
 
-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.
 
------
--- Wrinkle: Make boxed one-tuple names have known keys
------
-
-We make boxed one-tuple names have known keys so that `data Solo a = MkSolo a`,
-defined in GHC.Tuple, will be used when one-tuples are spliced in through
-Template Haskell. This program (from #18097) crucially relies on this:
-
-  case $( tupE [ [| "ok" |] ] ) of Solo x -> putStrLn x
-
-Unless Solo has a known key, the type of `$( tupE [ [| "ok" |] ] )` (an
-ExplicitTuple of length 1) will not match the type of Solo (an ordinary
-data constructor used in a pattern). Making Solo known-key allows GHC to make
-this connection.
-
-Unlike Solo, every other tuple is /not/ known-key
-(see Note [Infinite families of known-key names] in GHC.Builtin.Names). The
-main reason for this exception is that other tuples are written with special
-syntax, and as a result, they are renamed using a special `isBuiltInOcc_maybe`
-function (see Note [Built-in syntax and the OrigNameCache] in GHC.Types.Name.Cache).
-In contrast, Solo is just an ordinary data type with no special syntax, so it
-doesn't really make sense to handle it in `isBuiltInOcc_maybe`. Making Solo
-known-key is the next-best way to teach the internals of the compiler about it.
+Note [isBuiltInOcc_maybe]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+`isBuiltInOcc_maybe` matches and resolves names that are occurrences of built-in
+syntax, i.e. unqualified names that can be unambiguously resolved even without
+knowing what's currently in scope (such names also can't be imported, exported,
+or redefined in another module).
+More on that in Note [Built-in syntax and the OrigNameCache] in GHC.Types.Name.Cache.
+
+In GHC, there are two use cases for `isBuiltInOcc_maybe`:
+
+1. Making TH's `mkName` work with built-in syntax,
+   e.g. $(conT (mkName "[]")) is the same as []
+
+2. Detecting bulit-in syntax in `infix` declarations,
+   e.g. users can't write `infixl 6 :` (#15233)
+
+The parser takes a shortcut and produces Exact RdrNames directly,
+so it doesn't need to match on an OccName with isBuiltInOcc_maybe.
+
+And here are the properties of `isBuiltInOcc_maybe`:
+
+* The set of names recognized by `isBuiltInOcc_maybe` is essentialy the
+  same as the set of names that the parser resolves to Exact RdrNames,
+  e.g. "[]", "(,)", or "->".
+
+  We could leave it at that, but we also recognize unboxed sum syntax
+  "(#|#)" even though the parser can't handle it. This makes TH's `mkName`
+  more permissive than the parser.
+
+* The namespace of the input OccName is treated as a hint, not a
+  requirement. For example,
+
+    mkOccName dataName  ":"          maps to  consDataConName
+    mkOccName tcClsName ":"   /also/ maps to  consDataConName
+
+  The rationale behind this is that with DataKind or RequiredTypeArguments
+  we may get an OccName with the wrong namespace and need to fallback to the
+  other one.
+
+* There is a `listTuplePuns :: Bool` parameter to account for the
+  ListTuplePuns extension. It has /no/ effect on whether the predicate
+  matches (i.e. if the result is Just or Nothing), but it can influence
+  which name is returned (TyCon name or DataCon name). For example,
+
+    isBuiltInOcc_maybe False (mkOccName dataName  "[]")  ==  Just nilDataConName
+    isBuiltInOcc_maybe False (mkOccName tcClsName "[]")  ==  Just nilDataConName
+    isBuiltInOcc_maybe True  (mkOccName dataName  "[]")  ==  Just nilDataConName
+    isBuiltInOcc_maybe True  (mkOccName tcClsName "[]")  ==  Just listTyConName
+
+* There is no `Module` parameter because we are matching unqualified
+  occurrences of built-in names. It is illegal to qualify built-in syntax,
+  e.g. GHC.Types.(,) is a parse error.
+
+* The /input/ to `isBuiltInOcc_maybe` needs to be built-in syntax for the
+  predicate to match, but the /output/ is not necessarily built-in syntax.
+  For example,
+
+    1) input:   mkTcOcc "[]"          -- built-in syntax
+       output:  Just listTyConName    -- user syntax (GHC.Types.List)
+
+    2) input:   mkDataOcc "[]"        -- built-in syntax
+       output:  Just nilDataConName   -- built-in syntax []
+
+    3) input:   mkTcOcc "List"        -- user syntax
+       output:  Nothing               -- no match
+
+    4) input:   mkTcOcc "(,)"                       -- built-in syntax
+       output:  Just (tupleTyConName BoxedTuple 2)  -- user syntax (GHC.Types.Tuple2)
+
+    5) input:   mkTcOcc "(#|#)"               -- built-in syntax
+       output:  Just (unboxedSumTyConName 2)  -- user syntax (GHC.Types.Sum2#)
+
+  Therefore, `GHC.Types.Name.isBuiltInSyntax` may or may not hold for the name
+  returned by `isBuiltInOcc_maybe`.
 -}
 
--- | 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
-
-      -- function tycon
-      "FUN"  -> Just fUNTyConName
-      "->"  -> Just unrestrictedFunTyConName
-
-      -- boxed tuple data/tycon
-      -- We deliberately exclude Solo (the boxed 1-tuple).
-      -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)
-      "()"    -> 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
-      "Solo#" -> 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
-        , (nb_pipes, rest') <- span_pipes rest
-        , "#)" <- rest'
-             -> Just $ tyConName $ sumTyCon (1+nb_pipes)
-
-      -- unboxed sum datacon
-      _ | Just rest <- "(#" `BS.stripPrefix` name
-        , (nb_pipes1, rest') <- span_pipes rest
-        , Just rest'' <- "_" `BS.stripPrefix` rest'
-        , (nb_pipes2, rest''') <- span_pipes rest''
-        , "#)" <- rest'''
-             -> let arity = nb_pipes1 + nb_pipes2 + 1
-                    alt = nb_pipes1 + 1
-                in Just $ dataConName $ sumDataCon alt arity
-      _ -> Nothing
+-- | Match on built-in syntax as it occurs at use sites.
+-- See Note [isBuiltInOcc_maybe]
+isBuiltInOcc_maybe :: Bool -> OccName -> Maybe Name
+isBuiltInOcc_maybe listTuplePuns occ
+  | fs == "->" = Just unrestrictedFunTyConName
+  | fs == "[]" = Just (pun listTyConName nilDataConName)
+  | fs == ":"  = Just consDataConName
+  | Just n <- (is_boxed_tup_syntax fs) = Just (tup_name Boxed n)
+  | Just n <- (is_unboxed_tup_syntax fs) = Just (tup_name Unboxed n)
+  | Just n <- (is_unboxed_sum_type_syntax fs) = Just (unboxedSumTyConName n)
+  | Just (k, n) <- (is_unboxed_sum_data_syntax fs) = Just (unboxedSumDataConName k n)
+  | otherwise = Nothing
   where
-    name = bytesFS $ occNameFS occ
+    fs = occNameFS occ
+    ns = occNameSpace occ
 
-    span_pipes :: BS.ByteString -> (Int, BS.ByteString)
-    span_pipes = go 0
-      where
-        go nb_pipes bs = case BS.uncons bs of
-          Just ('|',rest) -> go (nb_pipes + 1) rest
-          Just (' ',rest) -> go nb_pipes       rest
-          _               -> (nb_pipes, bs)
-
-    choose_ns :: Name -> Name -> Name
-    choose_ns tc dc
-      | isTcClsNameSpace ns   = tc
-      | isDataConNameSpace ns = dc
-      | otherwise             = pprPanic "tup_name" (ppr occ <+> parens (pprNameSpace ns))
-      where ns = occNameSpace occ
+    pun :: Name -> Name -> Name
+    pun p n
+      | listTuplePuns, isTcClsNameSpace ns = p
+      | otherwise = n
 
+    tup_name :: Boxity -> Arity -> Name
     tup_name boxity arity
-      = choose_ns (getName (tupleTyCon   boxity arity))
-                  (getName (tupleDataCon boxity arity))
+      = pun (tyConName   (tupleTyCon   boxity arity))
+            (dataConName (tupleDataCon boxity arity))
 
-isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name
-isTupleTyOcc_maybe mod occ
-  | mod == gHC_TUPLE_PRIM
-  = match_occ
+-- | Check if the OccName is an occurrence of built-in syntax.
+--
+-- This is a variant of `isBuiltInOcc_maybe` that returns a `Bool`.
+-- See Note [isBuiltInOcc_maybe]
+--
+-- `isBuiltInOcc` holds for:
+--   * function arrow `->`
+--   * list syntax `[]`, `:`
+--   * boxed tuple syntax `()`, `(,)`, `(,,)`, `(,,,)`, ...
+--   * unboxed tuple syntax `(##)`, `(#,#)`, `(#,,#)`, ...
+--   * unboxed sum type syntax `(#|#)`, `(#||#)`, `(#|||#)`, ...
+--   * unboxed sum data syntax `(#_|#)`, `(#|_#)`, `(#_||#), ...
+isBuiltInOcc :: OccName -> Bool
+isBuiltInOcc = isJust . isBuiltInOcc_maybe listTuplePuns
   where
-    match_occ
+    listTuplePuns = False
+      -- True/False here is inconsequential because ListTuplePuns doesn't affect
+      -- whether isBuiltInOcc_maybe matches. See Note [isBuiltInOcc_maybe]
+
+-- Match on original names of infinite families (tuples and sums).
+-- See Note [Infinite families of known-key names] in GHC.Builtin.Names
+isInfiniteFamilyOrigName_maybe :: Module -> OccName -> Maybe Name
+isInfiniteFamilyOrigName_maybe mod occ =
+
+  -- Tuples, boxed and unboxed
+  isTupleTyOrigName_maybe mod occ
+  <|> isTupleDataOrigName_maybe mod occ
+
+  -- Constraint tuples
+  <|> isCTupleOrigName_maybe mod occ
+
+  -- Unboxed sums
+  <|> isSumTyOrigName_maybe mod occ
+  <|> isSumDataOrigName_maybe mod occ
+
+-- Check if the string has form "()", "(,)", "(,,)", etc,
+-- and return the corresponding tuple arity.
+is_boxed_tup_syntax :: FastString -> Maybe Arity
+is_boxed_tup_syntax fs
+  | fs == "()" = Just 0
+  | n >= 2
+  , SBS.unsafeIndex sbs 0     == 40  -- ord '('
+  , SBS.unsafeIndex sbs (n-1) == 41  -- ord ')'
+  , sbs_all sbs 1 (n-1)          44  -- ord ','
+  = Just (n-1)
+  where
+    n   = SBS.length sbs                   -- O(1)
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+is_boxed_tup_syntax _ = Nothing
+
+-- Check if the string has form "(##)", "(# #)", (#,#)", "(#,,#)", etc,
+-- and return the corresponding tuple arity.
+is_unboxed_tup_syntax :: FastString -> Maybe Arity
+is_unboxed_tup_syntax fs
+  | fs == "(##)"  = Just 0
+  | fs == "(# #)" = Just 1
+  | sbs_unboxed sbs
+  , sbs_all sbs 2 (n-2) 44  -- ord ','
+  = Just (n-3)
+  where
+    n   = SBS.length sbs                   -- O(1)
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+is_unboxed_tup_syntax _ = Nothing
+
+-- Check if the string has form "(#|#)", "(#||#)", (#|||#)", etc,
+-- and return the corresponding sum arity.
+is_unboxed_sum_type_syntax :: FastString -> Maybe Arity
+is_unboxed_sum_type_syntax fs
+  | sbs_unboxed sbs
+  , Just k <- sbs_pipes sbs 2 (n-2)
+  , k > 0
+  = Just (k+1)
+  where
+    n   = SBS.length sbs                   -- O(1)
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+is_unboxed_sum_type_syntax _ = Nothing
+
+-- Check if the string has form "(#_|#)", "(#_||#)", (#|_|#)", etc,
+-- and return the corresponding sum tag and sum arity.
+is_unboxed_sum_data_syntax :: FastString -> Maybe (ConTag, Arity)
+is_unboxed_sum_data_syntax fs
+  | sbs_unboxed sbs
+  , Just u <- SBS.elemIndex 95 sbs        -- ord '_'
+  , Just k1 <- sbs_pipes sbs 2 u          -- pipes to the left  of '_'
+  , Just k2 <- sbs_pipes sbs (u+1) (n-2)  -- pipes to the right of '_'
+  = Just (k1+1, k1+k2+1)
+  where
+    n   = SBS.length sbs                   -- O(1)
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+is_unboxed_sum_data_syntax _ = Nothing
+
+-- (sbs_all sbs i n x) checks if all bytes in the slice [i..n) are equal to x.
+sbs_all :: SBS.ShortByteString -> Int -> Int -> Word8 -> Bool
+sbs_all !sbs !i !n !x
+  | i < n     = SBS.unsafeIndex sbs i == x && sbs_all sbs (i+1) n x
+  | otherwise = True
+
+-- (sbs_pipes sbs i n) checks if all bytes in the slice [i..n) are equal to '|'
+-- or ' ', and returns the number of encountered '|'.
+sbs_pipes :: SBS.ShortByteString -> Int -> Int -> Maybe Int
+sbs_pipes !sbs = go 0
+  where
+    go :: Int -> Int -> Int -> Maybe Int
+    go !k !i !n
+      | i < n =
+        if | SBS.unsafeIndex sbs i == 124 -> go (k+1) (i+1) n -- ord '|'
+           | SBS.unsafeIndex sbs i == 32  -> go k     (i+1) n -- ord ' '
+           | otherwise                    -> Nothing
+      | otherwise = Just k
+
+-- (sbs_unboxed sbs) checks if the string starts with "(#" and ends with "#)".
+sbs_unboxed :: SBS.ShortByteString -> Bool
+sbs_unboxed !sbs =
+  n >= 4 && SBS.unsafeIndex sbs 0     == 40  -- ord '('
+         && SBS.unsafeIndex sbs 1     == 35  -- ord '#'
+         && SBS.unsafeIndex sbs (n-2) == 35  -- ord '#'
+         && SBS.unsafeIndex sbs (n-1) == 41  -- ord ')'
+  where
+    n = SBS.length sbs -- O(1)
+
+-- (sbs_Sum sbs) checks if the string has form "SumN#" or "SumNM#",
+-- where "N" or "NM" is a decimal numeral in the [2..mAX_SUM_SIZE] range.
+sbs_Sum :: SBS.ShortByteString -> Maybe Arity
+sbs_Sum !sbs
+  | n >= 3 && SBS.unsafeIndex sbs 0 == 83   -- ord 'S'
+           && SBS.unsafeIndex sbs 1 == 117  -- ord 'u'
+           && SBS.unsafeIndex sbs 2 == 109  -- ord 'm'
+  , Just (Unboxed, arity) <- sbs_arity_boxity sbs 3
+  , arity >= 2, arity <= mAX_SUM_SIZE
+  = Just arity
+  | otherwise = Nothing
+  where
+    n = SBS.length sbs -- O(1)
+
+-- (sbs_Tuple sbs) checks if the string has form "TupleN", "TupleNM", "TupleN#" or "TupleNM#",
+-- where "N" or "NM" is a decimal numeral in the [2..mAX_TUPLE_SIZE] range.
+sbs_Tuple :: SBS.ShortByteString -> Maybe (Boxity, Arity)
+sbs_Tuple !sbs
+  | n >= 5 && SBS.unsafeIndex sbs 0 == 84   -- ord 'T'
+           && SBS.unsafeIndex sbs 1 == 117  -- ord 'u'
+           && SBS.unsafeIndex sbs 2 == 112  -- ord 'p'
+           && SBS.unsafeIndex sbs 3 == 108  -- ord 'l'
+           && SBS.unsafeIndex sbs 4 == 101  -- ord 'e'
+  , Just r@(_, arity) <- sbs_arity_boxity sbs 5
+  , arity >= 2, arity <= mAX_TUPLE_SIZE
+  = Just r
+  | otherwise = Nothing
+  where
+    n = SBS.length sbs -- O(1)
+
+-- (sbs_CTuple sbs) checks if the string has form "CTupleN" or "CTupleNM",
+-- where "N" or "NM" is a decimal numeral in the [2..mAX_CTUPLE_SIZE] range.
+sbs_CTuple :: SBS.ShortByteString -> Maybe Arity
+sbs_CTuple !sbs
+  | n >= 6 && SBS.unsafeIndex sbs 0 == 67   -- ord 'C'
+           && SBS.unsafeIndex sbs 1 == 84   -- ord 'T'
+           && SBS.unsafeIndex sbs 2 == 117  -- ord 'u'
+           && SBS.unsafeIndex sbs 3 == 112  -- ord 'p'
+           && SBS.unsafeIndex sbs 4 == 108  -- ord 'l'
+           && SBS.unsafeIndex sbs 5 == 101  -- ord 'e'
+  , Just (Boxed, arity) <- sbs_arity_boxity sbs 6
+  , arity >= 2, arity <= mAX_CTUPLE_SIZE
+  = Just arity
+  | otherwise = Nothing
+  where
+    n = SBS.length sbs -- O(1)
+
+-- (sbs_arity_boxity sbs i) parses bytes from position `i` to the end,
+-- matching single- and double-digit decimals numerals (i.e. from 0 to 99)
+-- possibly followed by '#'. See Note [Small Ints parsing]
+sbs_arity_boxity :: SBS.ShortByteString -> Int -> Maybe (Boxity, Arity)
+sbs_arity_boxity !sbs !i =
+  case n - i of  -- bytes to parse
+    1 -> parse1 (SBS.unsafeIndex sbs i)
+    2 -> parse2 (SBS.unsafeIndex sbs i) (SBS.unsafeIndex sbs (i+1))
+    3 -> parse3 (SBS.unsafeIndex sbs i) (SBS.unsafeIndex sbs (i+1)) (SBS.unsafeIndex sbs (i+2))
+    _ -> Nothing
+  where
+    n = SBS.length sbs -- O(1)
+
+    is_digit :: Word8 -> Bool
+    is_digit x = x >= 48 && x <= 57  -- between (ord '0') and (ord '9')
+
+    from_digit :: Word8 -> Int
+    from_digit x = fromIntegral (x - 48)
+
+    -- single-digit number
+    parse1 :: Word8 -> Maybe (Boxity, Arity)
+    parse1 x1 | is_digit x1 = Just (Boxed, from_digit x1)
+    parse1 _ = Nothing
+
+    -- double-digit number, or a single-digit number followed by '#'
+    parse2 :: Word8 -> Word8 -> Maybe (Boxity, Arity)
+    parse2 x1 35  -- ord '#'
+      | is_digit x1 = Just (Unboxed, from_digit x1)
+    parse2 x1 x2
+      | is_digit x1, is_digit x2
+      = Just (Boxed, from_digit x1 * 10 + from_digit x2)
+    parse2 _ _ = Nothing
+
+    -- double-digit number followed by '#'
+    parse3 :: Word8 -> Word8 -> Word8 -> Maybe (Boxity, Arity)
+    parse3 x1 x2 35 -- ord '#'
+      | is_digit x1, is_digit x2
+      = Just (Unboxed, from_digit x1 * 10 + from_digit x2)
+    parse3 _ _ _ = Nothing
+
+-- Identify original names of boxed and unboxed tuple type constructors.
+-- Examples:
+--   0b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Unit")    =  Just <wired-in Name for 0-tuples>
+--   1b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Solo")    =  Just <wired-in Name for 1-tuples>
+--   2b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Tuple2")  =  Just <wired-in Name for 2-tuples>
+--   0u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Unit#")   =  Just <wired-in Name for unboxed 0-tuples>
+--   1u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Solo#")   =  Just <wired-in Name for unboxed 1-tuples>
+--   2u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Tuple2#") =  Just <wired-in Name for unboxed 2-tuples>
+--   ...
+--   64b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Tuple64")  =  Just <wired-in Name for 64-tuples>
+--   64u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Tuple64#") =  Just <wired-in Name for unboxed 64-tuples>
+--
+-- Non-examples: "()", "(##)", "(,)", "(#,#)", "(,,)", "(#,,#)", etc.
+-- As far as tuple /types/ are concerned, these are not the original names
+-- but rather punned names under ListTuplePuns.
+--
+-- Also non-examples: "Tuple0", "Tuple0#", "Tuple1", and "Tuple1#".
+-- These are merely type synonyms for "Unit", "Unit#", "Solo", and "Solo#".
+isTupleTyOrigName_maybe :: Module -> OccName -> Maybe Name
+isTupleTyOrigName_maybe mod occ
+  | mod == gHC_INTERNAL_TUPLE = match_occ_boxed
+  | mod == gHC_TYPES          = match_occ_unboxed
+  where
+    fs  = occNameFS occ
+    ns  = occNameSpace occ
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+
+    match_occ_boxed
       | occ == occName unitTyConName = Just unitTyConName
       | occ == occName soloTyConName = Just soloTyConName
-      | otherwise = isTupleNTyOcc_maybe occ
-isTupleTyOcc_maybe _ _ = Nothing
+      | isTcClsNameSpace ns, Just (boxity@Boxed, n) <- sbs_Tuple sbs, n >= 2
+      = Just (tyConName (tupleTyCon boxity n))
+      | otherwise = Nothing
+
+    match_occ_unboxed
+      | occ == occName unboxedUnitTyConName = Just unboxedUnitTyConName
+      | occ == occName unboxedSoloTyConName = Just unboxedSoloTyConName
+      | isTcClsNameSpace ns, Just (boxity@Unboxed, n) <- sbs_Tuple sbs, n >= 2
+      = Just (tyConName (tupleTyCon boxity n))
+      | otherwise = Nothing
+
+isTupleTyOrigName_maybe _ _ = Nothing
+
+-- Identify original names of boxed and unboxed tuple data constructors.
+-- Examples:
+--   0b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "()")      =  Just <wired-in Name for 0-tuples>
+--   1b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "MkSolo")  =  Just <wired-in Name for 1-tuples>
+--   2b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "(,)")     =  Just <wired-in Name for 2-tuples>
+--   ...
+--   0u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "(##)")    =  Just <wired-in Name for unboxed 0-tuples>
+--   1u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "MkSolo#") =  Just <wired-in Name for unboxed 1-tuples>
+--   2u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "(#,#)")   =  Just <wired-in Name for unboxed 2-tuples>
+--   ...
+--
+-- Non-examples: Tuple<n> or Tuple<n>#, as this is the name format of tuple /type/ constructors.
+isTupleDataOrigName_maybe :: Module -> OccName -> Maybe Name
+isTupleDataOrigName_maybe mod occ
+  | mod == gHC_INTERNAL_TUPLE = match_occ_boxed
+  | mod == gHC_TYPES          = match_occ_unboxed
+  where
+    match_occ_boxed
+      | occ == occName soloDataConName = Just soloDataConName
+      | isDataConNameSpace ns, Just n <- (is_boxed_tup_syntax fs)
+      = Just (tupleDataConName Boxed n)
+      | otherwise = Nothing
+    match_occ_unboxed
+      | occ == occName unboxedSoloDataConName = Just unboxedSoloDataConName
+      | isDataConNameSpace ns, Just n <- (is_unboxed_tup_syntax fs)
+      = Just (tupleDataConName Unboxed n)
+      | otherwise = Nothing
+    fs = occNameFS occ
+    ns = occNameSpace occ
+isTupleDataOrigName_maybe _ _ = Nothing
+
+-- Identify original names of constraint tuples.
+-- Examples:
+--   0) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CUnit")    =  Just <wired-in Name for 0-ctuples>
+--   1) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CSolo")    =  Just <wired-in Name for 1-ctuples>
+--   2) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CTuple2")  =  Just <wired-in Name for 2-ctuples>
+--   ...
+--   64) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CTuple64")  =  Just <wired-in Name for 64-ctuples>
+--
+-- Non-examples: "()", "(,)", "(,,)", etc.
+-- As far as constraint tuples are concerned, these are not the original names
+-- but rather punned names under ListTuplePuns.
+--
+-- Also non-examples: "CTuple0" and "CTuple1".
+-- These are merely type synonyms for "CUnit" and "CSolo".
+isCTupleOrigName_maybe :: Module -> OccName -> Maybe Name
+isCTupleOrigName_maybe mod occ
+  | mod == gHC_CLASSES
+  = match_occ
+  where
+    fs  = occNameFS occ
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+    match_occ
+      | occ == occName (cTupleTyConName 0) = Just (cTupleTyConName 0)  -- CUnit
+      | occ == occName (cTupleTyConName 1) = Just (cTupleTyConName 1)  -- CSolo
 
+      | Just num <- sbs_CTuple sbs, num >= 2
+      = Just $ cTupleTyConName num
 
--- | This is only for Tuple<n>, not for Unit or Solo
-isTupleNTyOcc_maybe :: OccName -> Maybe Name
-isTupleNTyOcc_maybe occ =
-  case occNameString occ of
-    'T':'u':'p':'l':'e':str | Just n <- readInt str, n > 1
-      -> Just (tupleTyConName BoxedTuple n)
-    _ -> Nothing
+      | otherwise = Nothing
 
--- | See Note [Small Ints parsing]
-readInt :: String -> Maybe Int
-readInt s = case s of
-  [c] | isDigit c -> Just (digit_to_int c)
-  [c1, c2] | isDigit c1, isDigit c2
-    -> Just (digit_to_int c1 * 10 + digit_to_int c2)
-  _ -> readMaybe s
+isCTupleOrigName_maybe _ _ = Nothing
+
+-- Identify original names of unboxed sum type constructors.
+-- Examples:
+--   2) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum2#") =  Just <wired-in Name for unboxed 2-sums>
+--   3) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum3#") =  Just <wired-in Name for unboxed 3-sums>
+--   4) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum4#") =  Just <wired-in Name for unboxed 4-sums>
+--   ...
+--   64) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum64#") =  Just <wired-in Name for unboxed 64-sums>
+--
+-- Non-examples: "(#|#)", "(#||#)", "(#|||#)", etc. These are not valid syntax.
+-- Also non-examples: "Sum0#", "Sum1#". These do not exist.
+isSumTyOrigName_maybe :: Module -> OccName -> Maybe Name
+isSumTyOrigName_maybe mod occ
+  | mod == gHC_TYPES
+  , isTcClsNameSpace ns
+  , Just n <- sbs_Sum sbs
+  , n >= 2
+  = Just (tyConName (sumTyCon n))
   where
-    digit_to_int :: Char -> Int
-    digit_to_int c = ord c - ord '0'
+    fs  = occNameFS occ
+    ns  = occNameSpace occ
+    sbs = fastStringToShortByteString fs   -- O(1) field access
+isSumTyOrigName_maybe _ _ = Nothing
+
+-- Identify original names of unboxed sum data constructors.
+-- "(#_|#)", "(#_||#)", (#|_|#)"
+--
+-- Examples:
+--   1/2) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#_|#)")  =  Just <wired-in Name for 1st alt of unboxed 2-sums>
+--   1/3) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#_||#)") =  Just <wired-in Name for 1st alt of unboxed 3-sums>
+--   2/3) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#|_|#)") =  Just <wired-in Name for 2nd alt of unboxed 3-sums>
+--   ...
+--
+-- Non-examples: Sum<n>#, as this is the name format of unboxed sum /type/ constructors.
+isSumDataOrigName_maybe :: Module -> OccName -> Maybe Name
+isSumDataOrigName_maybe mod occ
+  | mod == gHC_TYPES
+  , isDataConNameSpace ns
+  , Just (k,n) <- (is_unboxed_sum_data_syntax fs)
+  = Just (unboxedSumDataConName k n)
+  where fs = occNameFS occ
+        ns = occNameSpace occ
+isSumDataOrigName_maybe _ _ = Nothing
 
 {-
 Note [Small Ints parsing]
@@ -922,57 +1309,41 @@ This results in a speedup of up to 40 times compared to using
 `readMaybe @Int` on my machine.
 -}
 
--- When resolving names produced by Template Haskell (see thOrigRdrName
--- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not
--- an Orig name.
---
--- This matters for pretty-printing under ListTuplePuns. If we don't do it,
--- then -ddump-splices will print ''[] as ''GHC.Types.List.
---
--- Test case: th/T13776
---
-isPunOcc_maybe :: Module -> OccName -> Maybe Name
-isPunOcc_maybe mod occ
-  | mod == gHC_TYPES, occ == occName listTyConName
-  = Just listTyConName
-  | mod == gHC_TUPLE_PRIM, occ == occName unitTyConName
-  = Just unitTyConName
-  | mod == gHC_TUPLE_PRIM
-  = isTupleNTyOcc_maybe occ
-isPunOcc_maybe _ _ = Nothing
-
-mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
--- No need to cache these, the caching is done in mk_tuple
-mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr ns ar)
-mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar)
+mkTupleOcc :: NameSpace -> Boxity -> Arity -> (OccName, BuiltInSyntax)
+mkTupleOcc ns b ar = (mkOccName ns str, built_in)
+  where (str, built_in) = mkTupleStr' ns b ar
 
 mkCTupleOcc :: NameSpace -> Arity -> OccName
 mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)
 
 mkTupleStr :: Boxity -> NameSpace -> Arity -> String
-mkTupleStr Boxed   = mkBoxedTupleStr
-mkTupleStr Unboxed = const mkUnboxedTupleStr
-
-mkBoxedTupleStr :: NameSpace -> Arity -> String
-mkBoxedTupleStr ns 0
-  | isDataConNameSpace ns = "()"
-  | otherwise             = "Unit"
-mkBoxedTupleStr ns 1
-  | isDataConNameSpace ns = "MkSolo"  -- See Note [One-tuples]
-  | otherwise             = "Solo"
-mkBoxedTupleStr ns ar
-  | isDataConNameSpace ns = '(' : commas ar ++ ")"
-  | otherwise             = "Tuple" ++ showInt ar ""
-
-mkUnboxedTupleStr :: Arity -> String
-mkUnboxedTupleStr 0  = "(##)"
-mkUnboxedTupleStr 1  = "Solo#"  -- See Note [One-tuples]
-mkUnboxedTupleStr ar = "(#" ++ commas ar ++ "#)"
+mkTupleStr b ns ar = str
+  where (str, _) = mkTupleStr' ns b ar
+
+mkTupleStr' :: NameSpace -> Boxity -> Arity -> (String, BuiltInSyntax)
+mkTupleStr' ns Boxed 0
+  | isDataConNameSpace ns = ("()", BuiltInSyntax)
+  | otherwise             = ("Unit", UserSyntax)
+mkTupleStr' ns Boxed 1
+  | isDataConNameSpace ns = ("MkSolo", UserSyntax)  -- See Note [One-tuples]
+  | otherwise             = ("Solo",   UserSyntax)
+mkTupleStr' ns Boxed ar
+  | isDataConNameSpace ns = ('(' : commas ar ++ ")", BuiltInSyntax)
+  | otherwise             = ("Tuple" ++ showInt ar "", UserSyntax)
+mkTupleStr' ns Unboxed 0
+  | isDataConNameSpace ns = ("(##)",  BuiltInSyntax)
+  | otherwise             = ("Unit#", UserSyntax)
+mkTupleStr' ns Unboxed 1
+  | isDataConNameSpace ns = ("MkSolo#", UserSyntax) -- See Note [One-tuples]
+  | otherwise             = ("Solo#",   UserSyntax)
+mkTupleStr' ns Unboxed ar
+  | isDataConNameSpace ns = ("(#" ++ commas ar ++ "#)", BuiltInSyntax)
+  | otherwise             = ("Tuple" ++ show ar ++ "#", UserSyntax)
 
 mkConstraintTupleStr :: Arity -> String
-mkConstraintTupleStr 0  = "(%%)"
-mkConstraintTupleStr 1  = "Solo%"   -- See Note [One-tuples]
-mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"
+mkConstraintTupleStr 0 = "CUnit"
+mkConstraintTupleStr 1 = "CSolo"
+mkConstraintTupleStr ar = "CTuple" ++ show ar
 
 commas :: Arity -> String
 commas ar = replicate (ar-1) ','
@@ -988,23 +1359,13 @@ cTupleTyConName a = tyConName (cTupleTyCon a)
 cTupleTyConNames :: [Name]
 cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
 
-cTupleTyConKeys :: UniqSet Unique
-cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames
+cTupleTyConKeys :: UniqueSet
+cTupleTyConKeys = fromListUniqueSet $ map getUnique cTupleTyConNames
 
 isCTupleTyConName :: Name -> Bool
 isCTupleTyConName n
  = assertPpr (isExternalName n) (ppr n) $
-   getUnique n `elementOfUniqSet` cTupleTyConKeys
-
--- | If the given name is that of a constraint tuple, return its arity.
-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
+   getUnique n `memberUniqueSet` cTupleTyConKeys
 
 cTupleDataCon :: Arity -> DataCon
 cTupleDataCon i
@@ -1030,8 +1391,8 @@ cTupleSelId sc_pos arity
            ++ "(superclass position: " ++ show sc_pos
            ++ ", arity: " ++ show arity ++ ")")
 
-  | arity < 2
-  = panic ("cTupleSelId: Arity starts from 2. "
+  | arity < 1
+  = panic ("cTupleSelId: Arity starts from 1. "
            ++ "(superclass position: " ++ show sc_pos
            ++ ", arity: " ++ show arity ++ ")")
 
@@ -1086,14 +1447,6 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA
 -- tuple and the inner array is indexed by the superclass position.
 cTupleArr :: Array Int (TyCon, DataCon, Array Int Id)
 cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]]
-  -- Although GHC does not make use of unary constraint tuples
-  -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType),
-  -- this array creates one anyway. This is primarily motivated by the fact
-  -- that (1) the indices of an Array must be contiguous, and (2) we would like
-  -- the index of a constraint tuple in this Array to correspond to its Arity.
-  -- We could envision skipping over the unary constraint tuple and having index
-  -- 1 correspond to a 2-constraint tuple (and so on), but that's more
-  -- complicated than it's worth.
 
 -- | 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
@@ -1122,11 +1475,11 @@ mk_tuple Boxed arity = (tycon, tuple_con)
     tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon
 
     boxity  = Boxed
-    modu    = gHC_TUPLE_PRIM
-    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
-                         (ATyCon tycon) UserSyntax
-    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
-                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    modu    = gHC_INTERNAL_TUPLE
+    tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in
+      where (occ, built_in) = mkTupleOcc tcName boxity arity
+    dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in
+      where (occ, built_in) = mkTupleOcc dataName boxity arity
     tc_uniq = mkTupleTyConUnique   boxity arity
     dc_uniq = mkTupleDataConUnique boxity arity
 
@@ -1156,11 +1509,11 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
         | pos <- [1..arity] ]
 
     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
+    modu    = gHC_TYPES
+    tc_name = mkWiredInName modu occ tc_uniq (ATyCon tycon) built_in
+      where (occ, built_in) = mkTupleOcc tcName boxity arity
+    dc_name = mkWiredInName modu occ dc_uniq (AConLike (RealDataCon tuple_con)) built_in
+      where (occ, built_in) = mkTupleOcc dataName boxity arity
     tc_uniq = mkTupleTyConUnique   boxity arity
     dc_uniq = mkTupleDataConUnique boxity arity
 
@@ -1180,7 +1533,7 @@ mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr)
 
     modu    = gHC_CLASSES
     tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq
-                         (ATyCon tycon) BuiltInSyntax
+                         (ATyCon tycon) UserSyntax
     dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq
                             (AConLike (RealDataCon tuple_con)) BuiltInSyntax
     tc_uniq = mkCTupleTyConUnique   arity
@@ -1224,6 +1577,9 @@ soloTyCon = tupleTyCon Boxed 1
 soloTyConName :: Name
 soloTyConName = tyConName soloTyCon
 
+soloDataConName :: Name
+soloDataConName = tupleDataConName Boxed 1
+
 pairTyCon :: TyCon
 pairTyCon = tupleTyCon Boxed 2
 
@@ -1233,9 +1589,21 @@ unboxedUnitTy = mkTyConTy unboxedUnitTyCon
 unboxedUnitTyCon :: TyCon
 unboxedUnitTyCon = tupleTyCon Unboxed 0
 
+unboxedUnitTyConName :: Name
+unboxedUnitTyConName = tyConName unboxedUnitTyCon
+
 unboxedUnitDataCon :: DataCon
 unboxedUnitDataCon = tupleDataCon Unboxed 0
 
+unboxedSoloTyCon :: TyCon
+unboxedSoloTyCon = tupleTyCon Unboxed 1
+
+unboxedSoloTyConName :: Name
+unboxedSoloTyConName = tyConName unboxedSoloTyCon
+
+unboxedSoloDataConName :: Name
+unboxedSoloDataConName = tupleDataConName Unboxed 1
+
 {- *********************************************************************
 *                                                                      *
       Unboxed sums
@@ -1247,8 +1615,7 @@ mkSumTyConOcc :: Arity -> OccName
 mkSumTyConOcc n = mkOccName tcName str
   where
     -- No need to cache these, the caching is done in mk_sum
-    str = '(' : '#' : ' ' : bars ++ " #)"
-    bars = intersperse ' ' $ replicate (n-1) '|'
+    str = "Sum" ++ show n ++ "#"
 
 -- | OccName for i-th alternative of n-ary unboxed sum data constructor.
 mkSumDataConOcc :: ConTag -> Arity -> OccName
@@ -1270,6 +1637,9 @@ sumTyCon arity
   | otherwise
   = fst (unboxedSumArr ! arity)
 
+unboxedSumTyConName :: Arity -> Name
+unboxedSumTyConName arity = tyConName (sumTyCon arity)
+
 -- | Data constructor for i-th alternative of a n-ary unboxed sum.
 sumDataCon :: ConTag -- Alternative
            -> Arity  -- Arity
@@ -1293,6 +1663,9 @@ sumDataCon alt arity
   | otherwise
   = snd (unboxedSumArr ! arity) ! (alt - 1)
 
+unboxedSumDataConName :: ConTag -> Arity -> Name
+unboxedSumDataConName alt arity = dataConName (sumDataCon alt arity)
+
 -- | 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.
@@ -1328,8 +1701,8 @@ mk_sum arity = (tycon, sum_cons)
         | ty <- dc_arg_tys
         | pos <- [1..arity] ]
 
-    tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq
-                            (ATyCon tycon) BuiltInSyntax
+    tc_name = mkWiredInName gHC_TYPES (mkSumTyConOcc arity) tc_uniq
+                            (ATyCon tycon) UserSyntax
 
     sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]]
     sum_con i =
@@ -1339,11 +1712,11 @@ mk_sum arity = (tycon, sum_cons)
                   [dc_arg_tys !! i] -- arg types
                   tycon
 
-          dc_name = mkWiredInName gHC_PRIM
-                      (mkSumDataConOcc i arity)
-                      (dc_uniq i)
-                      (AConLike (RealDataCon dc))
-                      BuiltInSyntax
+          dc_name = mkWiredInName gHC_TYPES
+                                  (mkSumDataConOcc i arity)
+                                  (dc_uniq i)
+                                  (AConLike (RealDataCon dc))
+                                  BuiltInSyntax
       in dc
 
     tc_uniq   = mkSumTyConUnique   arity
@@ -2422,28 +2795,28 @@ integerTyConName
 integerTyConName
    = mkWiredInTyConName
       UserSyntax
-      gHC_NUM_INTEGER
+      gHC_INTERNAL_NUM_INTEGER
       (fsLit "Integer")
       integerTyConKey
       integerTyCon
 integerISDataConName
    = mkWiredInDataConName
       UserSyntax
-      gHC_NUM_INTEGER
+      gHC_INTERNAL_NUM_INTEGER
       (fsLit "IS")
       integerISDataConKey
       integerISDataCon
 integerIPDataConName
    = mkWiredInDataConName
       UserSyntax
-      gHC_NUM_INTEGER
+      gHC_INTERNAL_NUM_INTEGER
       (fsLit "IP")
       integerIPDataConKey
       integerIPDataCon
 integerINDataConName
    = mkWiredInDataConName
       UserSyntax
-      gHC_NUM_INTEGER
+      gHC_INTERNAL_NUM_INTEGER
       (fsLit "IN")
       integerINDataConKey
       integerINDataCon
@@ -2471,21 +2844,21 @@ naturalTyConName
 naturalTyConName
    = mkWiredInTyConName
       UserSyntax
-      gHC_NUM_NATURAL
+      gHC_INTERNAL_NUM_NATURAL
       (fsLit "Natural")
       naturalTyConKey
       naturalTyCon
 naturalNSDataConName
    = mkWiredInDataConName
       UserSyntax
-      gHC_NUM_NATURAL
+      gHC_INTERNAL_NUM_NATURAL
       (fsLit "NS")
       naturalNSDataConKey
       naturalNSDataCon
 naturalNBDataConName
    = mkWiredInDataConName
       UserSyntax
-      gHC_NUM_NATURAL
+      gHC_INTERNAL_NUM_NATURAL
       (fsLit "NB")
       naturalNBDataConKey
       naturalNBDataCon
@@ -2504,9 +2877,58 @@ naturalNBDataCon :: DataCon
 naturalNBDataCon = pcDataCon naturalNBDataConName [] [byteArrayPrimTy] naturalTyCon
 
 
--- | 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
+{-
+************************************************************************
+*                                                                      *
+   Semi-builtin names
+*                                                                      *
+************************************************************************
+
+Note [pretendNameIsInScope]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In general, we filter out instances that mention types whose names are
+not in scope. However, in the situations listed below, we make an exception
+for some commonly used names, such as Data.Kind.Type, which may not actually
+be in scope but should be treated as though they were in scope.
+This includes built-in names, as well as a few extra names such as
+'Type', 'TYPE', 'BoxedRep', etc.
+
+Situations in which we apply this special logic:
+
+  - GHCi's :info command, see GHC.Runtime.Eval.getInfo.
+    This fixes #1581.
+
+  - When reporting instance overlap errors. Not doing so could mean
+    that we would omit instances for typeclasses like
+
+      type Cls :: k -> Constraint
+      class Cls a
+
+    because BoxedRep/Lifted were not in scope.
+    See GHC.Tc.Errors.potentialInstancesErrMsg.
+    This fixes one of the issues reported in #20465.
+-}
+
+-- | Should this name be considered in-scope, even though it technically isn't?
+--
+-- This ensures that we don't filter out information because, e.g.,
+-- Data.Kind.Type isn't imported.
+--
+-- See Note [pretendNameIsInScope].
+pretendNameIsInScope :: Name -> Bool
+pretendNameIsInScope n
+  = isBuiltInSyntax n
+  || isTupleTyConName n
+  || isSumTyConName n
+  || isCTupleTyConName n
+  || any (n `hasKey`)
+    [ liftedTypeKindTyConKey, unliftedTypeKindTyConKey
+    , liftedDataConKey, unliftedDataConKey
+    , tYPETyConKey
+    , cONSTRAINTTyConKey
+    , runtimeRepTyConKey, boxedRepDataConKey
+    , eqTyConKey
+    , listTyConKey
+    , oneDataConKey
+    , manyDataConKey
+    , fUNTyConKey, unrestrictedFunTyConKey ]

compiler/GHC/Builtin/Types.hs-boot

@@ -15,6 +15,7 @@ mkBoxedTupleTy :: [Type] -> Type
 coercibleTyCon, heqTyCon :: TyCon
 
 unitTy :: Type
+unitTyCon :: TyCon
 
 liftedTypeKindTyConName :: Name
 constraintKindTyConName :: Name

compiler/GHC/Builtin/Types/Literals.hs

 {-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}   -- See calls to mkTemplateTyVars
 
 module GHC.Builtin.Types.Literals
-  ( typeNatTyCons
+  ( tryInteractInertFam, tryInteractTopFam, tryMatchFam
+
+  , typeNatTyCons
   , typeNatCoAxiomRules
   , BuiltInSynFamily(..)
 
@@ -28,22 +31,21 @@ module GHC.Builtin.Types.Literals
 import GHC.Prelude
 
 import GHC.Core.Type
+import GHC.Core.Unify      ( tcMatchTys )
 import GHC.Data.Pair
-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.Core.TyCon    ( TyCon, FamTyConFlav(..), mkFamilyTyCon, tyConArity
+                         , Injectivity(..), isBuiltInSynFamTyCon_maybe )
+import GHC.Core.Coercion.Axiom
 import GHC.Core.TyCo.Compare   ( tcEqType )
 import GHC.Types.Name          ( Name, BuiltInSyntax(..) )
 import GHC.Types.Unique.FM
 import GHC.Builtin.Types
-import GHC.Builtin.Types.Prim  ( mkTemplateAnonTyConBinders )
+import GHC.Builtin.Types.Prim  ( mkTemplateAnonTyConBinders, mkTemplateTyVars )
 import GHC.Builtin.Names
-                  ( gHC_TYPELITS
-                  , gHC_TYPELITS_INTERNAL
-                  , gHC_TYPENATS
-                  , gHC_TYPENATS_INTERNAL
+                  ( gHC_INTERNAL_TYPELITS
+                  , gHC_INTERNAL_TYPELITS_INTERNAL
+                  , gHC_INTERNAL_TYPENATS
+                  , gHC_INTERNAL_TYPENATS_INTERNAL
                   , typeNatAddTyFamNameKey
                   , typeNatMulTyFamNameKey
                   , typeNatExpTyFamNameKey
@@ -61,8 +63,12 @@ import GHC.Builtin.Names
                   , typeNatToCharTyFamNameKey
                   )
 import GHC.Data.FastString
+import GHC.Utils.Panic
+import GHC.Utils.Outputable
+
 import Control.Monad ( guard )
 import Data.List  ( isPrefixOf, isSuffixOf )
+import Data.Maybe ( listToMaybe )
 import qualified Data.Char as Char
 
 {-
@@ -94,24 +100,13 @@ There are a few steps to adding a built-in type family:
 * 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.
+  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@.
@@ -136,12 +131,237 @@ There are a few steps to adding a built-in type family:
     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
+Note [Inlining axiom constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have a number of constructor functions with types like
+   mkUnaryConstFoldAxiom :: TyCon -> String
+                         -> (Type -> Maybe a)
+                         -> (a -> Maybe Type)
+                         -> BuiltInFamRewrite
+
+For very type-family-heavy code, these higher order argument are inefficient;
+e.g. the fourth argument might always return (Just ty) in the above. Inlining
+them is a bit brutal, but not bad, makes a few-percent difference in, say
+perf test T13386.
+
+These functions aren't exported, so the effect is very local.
+
 -}
 
+-------------------------------------------------------------------------------
+--     Key utility functions
+-------------------------------------------------------------------------------
+
+tryInteractTopFam :: BuiltInSynFamily -> TyCon -> [Type] -> Type
+                  -> [(CoAxiomRule, TypeEqn)]
+-- The returned CoAxiomRule is always unary
+tryInteractTopFam fam fam_tc tys r
+  = [(bifinj_axr bif, eqn_out) | bif  <- sfInteract fam
+                               , Just eqn_out <- [bifinj_proves bif eqn_in] ]
+  where
+    eqn_in :: TypeEqn
+    eqn_in = Pair (mkTyConApp fam_tc tys) r
+
+tryInteractInertFam :: BuiltInSynFamily -> TyCon
+                    -> [Type] -> [Type] -- F tys1 ~ F tys2
+                    -> [(CoAxiomRule, TypeEqn)]
+tryInteractInertFam builtin_fam fam_tc tys1 tys2
+  = [(bifinj_axr bif, eqn_out) | bif <- sfInteract builtin_fam
+                               , Just eqn_out <- [bifinj_proves bif eqn_in] ]
+  where
+    eqn_in = Pair (mkTyConApp fam_tc tys1) (mkTyConApp fam_tc tys2)
+
+tryMatchFam :: BuiltInSynFamily -> [Type]
+            -> Maybe (CoAxiomRule, [Type], Type)
+-- Does this reduce on the given arguments?
+-- If it does, returns (CoAxiomRule, types to instantiate the rule at, rhs type)
+-- That is: mkAxiomCo (BuiltInFamRew ax) (map mkNomReflCo ts)
+--              :: F tys ~r rhs,
+tryMatchFam builtin_fam arg_tys
+  = listToMaybe $   -- Pick first rule to match
+    [ (bifrw_axr rw_ax, inst_tys, res_ty)
+    | rw_ax <- sfMatchFam builtin_fam
+    , Just (inst_tys,res_ty) <- [bifrw_match rw_ax arg_tys] ]
+
+-------------------------------------------------------------------------------
+--          Constructing BuiltInFamInjectivity, BuiltInFamRewrite
+-------------------------------------------------------------------------------
+
+mkUnaryConstFoldAxiom :: TyCon -> String
+                      -> (Type -> Maybe a)
+                      -> (a -> Maybe Type)
+                      -> BuiltInFamRewrite
+-- For the definitional axioms, like  (3+4 --> 7)
+{-# INLINE mkUnaryConstFoldAxiom #-}  -- See Note [Inlining axiom constructors]
+mkUnaryConstFoldAxiom fam_tc str isReqTy f
+  = bif
+  where
+    bif = BIF_Rewrite
+      { bifrw_name   = fsLit str
+      , bifrw_axr    = BuiltInFamRew bif
+      , bifrw_fam_tc = fam_tc
+      , bifrw_arity  = 1
+      , bifrw_match  = \ts -> do { [t1] <- return ts
+                                 ; t1' <- isReqTy t1
+                                 ; res <- f t1'
+                                 ; return ([t1], res) }
+      , bifrw_proves = \cs -> do { [Pair s1 s2] <- return cs
+                                 ; s2' <- isReqTy s2
+                                 ; z   <- f s2'
+                                 ; return (mkTyConApp fam_tc [s1] === z) }
+      }
+
+mkBinConstFoldAxiom :: TyCon -> String
+                    -> (Type -> Maybe a)
+                    -> (Type -> Maybe b)
+                    -> (a -> b -> Maybe Type)
+                    -> BuiltInFamRewrite
+-- For the definitional axioms, like  (3+4 --> 7)
+{-# INLINE mkBinConstFoldAxiom #-}  -- See Note [Inlining axiom constructors]
+mkBinConstFoldAxiom fam_tc str isReqTy1 isReqTy2 f
+  = bif
+  where
+    bif = BIF_Rewrite
+      { bifrw_name   = fsLit str
+      , bifrw_axr    = BuiltInFamRew bif
+      , bifrw_fam_tc = fam_tc
+      , bifrw_arity  = 2
+      , bifrw_match  = \ts -> do { [t1,t2] <- return ts
+                                 ; t1' <- isReqTy1 t1
+                                 ; t2' <- isReqTy2 t2
+                                 ; res <- f t1' t2'
+                                 ; return ([t1,t2], res) }
+      , bifrw_proves = \cs -> do { [Pair s1 s2, Pair t1 t2] <- return cs
+                                 ; s2' <- isReqTy1 s2
+                                 ; t2' <- isReqTy2 t2
+                                 ; z   <- f s2' t2'
+                                 ; return (mkTyConApp fam_tc [s1,t1] === z) }
+      }
+
+mkRewriteAxiom :: TyCon -> String
+               -> [TyVar] -> [Type]  -- LHS of axiom
+               -> Type               -- RHS of axiom
+               -> BuiltInFamRewrite
+-- Not higher order, no benefit in inlining
+-- See Note [Inlining axiom constructors]
+mkRewriteAxiom fam_tc str tpl_tvs lhs_tys rhs_ty
+  = assertPpr (tyConArity fam_tc == length lhs_tys) (text str <+> ppr lhs_tys) $
+    bif
+  where
+    bif = BIF_Rewrite
+      { bifrw_name   = fsLit str
+      , bifrw_axr    = BuiltInFamRew bif
+      , bifrw_fam_tc = fam_tc
+      , bifrw_arity  = bif_arity
+      , bifrw_match  = match_fn
+      , bifrw_proves = inst_fn }
+
+    bif_arity = length tpl_tvs
+
+    match_fn :: [Type] -> Maybe ([Type],Type)
+    match_fn arg_tys
+      = assertPpr (tyConArity fam_tc == length arg_tys) (text str <+> ppr arg_tys) $
+        case tcMatchTys lhs_tys arg_tys of
+          Nothing    -> Nothing
+          Just subst -> Just (substTyVars subst tpl_tvs, substTy subst rhs_ty)
+
+    inst_fn :: [TypeEqn] -> Maybe TypeEqn
+    inst_fn inst_eqns
+      = assertPpr (length inst_eqns == bif_arity) (text str $$ ppr inst_eqns) $
+        Just (mkTyConApp fam_tc (substTys (zipTCvSubst tpl_tvs tys1) lhs_tys)
+              ===
+              substTy (zipTCvSubst tpl_tvs tys2) rhs_ty)
+      where
+        (tys1, tys2) = unzipPairs inst_eqns
+
+mkTopUnaryFamDeduction :: String -> TyCon
+                     -> (Type -> Type -> Maybe TypeEqn)
+                     -> BuiltInFamInjectivity
+-- Deduction from (F s ~ r) where `F` is a unary type function
+{-# INLINE mkTopUnaryFamDeduction #-}  -- See Note [Inlining axiom constructors]
+mkTopUnaryFamDeduction str fam_tc f
+  = bif
+  where
+    bif = BIF_Interact
+      { bifinj_name   = fsLit str
+      , bifinj_axr    = BuiltInFamInj bif
+      , bifinj_proves = \(Pair lhs rhs)
+                        -> do { (tc, [a]) <- splitTyConApp_maybe lhs
+                              ; massertPpr (tc == fam_tc) (ppr tc $$ ppr fam_tc)
+                              ; f a rhs } }
+
+mkTopBinFamDeduction :: String -> TyCon
+                     -> (Type -> Type -> Type -> Maybe TypeEqn)
+                     -> BuiltInFamInjectivity
+-- Deduction from (F s t  ~ r) where `F` is a binary type function
+{-# INLINE mkTopBinFamDeduction #-}  -- See Note [Inlining axiom constructors]
+mkTopBinFamDeduction str fam_tc f
+  = bif
+  where
+    bif = BIF_Interact
+      { bifinj_name   = fsLit str
+      , bifinj_axr    = BuiltInFamInj bif
+      , bifinj_proves = \(Pair lhs rhs) ->
+                        do { (tc, [a,b]) <- splitTyConApp_maybe lhs
+                           ; massertPpr (tc == fam_tc) (ppr tc $$ ppr fam_tc)
+                           ; f a b rhs } }
+
+mkUnaryBIF :: String -> TyCon -> BuiltInFamInjectivity
+-- Not higher order, no benefit in inlining
+-- See Note [Inlining axiom constructors]
+mkUnaryBIF str fam_tc
+  = bif
+  where
+    bif = BIF_Interact { bifinj_name   = fsLit str
+                       , bifinj_axr    = BuiltInFamInj bif
+                       , bifinj_proves = proves }
+    proves (Pair lhs rhs)
+      = do { (tc2, [x2]) <- splitTyConApp_maybe rhs
+           ; guard (tc2 == fam_tc)
+           ; (tc1, [x1]) <- splitTyConApp_maybe lhs
+           ; massertPpr (tc1 == fam_tc) (ppr tc1 $$ ppr fam_tc)
+           ; return (Pair x1 x2) }
+
+mkBinBIF :: String -> TyCon
+         -> WhichArg -> WhichArg
+         -> (Type -> Bool)         -- The guard on the equal args, if any
+         -> BuiltInFamInjectivity
+{-# INLINE mkBinBIF #-}  -- See Note [Inlining axiom constructors]
+mkBinBIF str fam_tc eq1 eq2 check_me
+  = bif
+  where
+    bif = BIF_Interact { bifinj_name   = fsLit str
+                       , bifinj_axr    = BuiltInFamInj bif
+                       , bifinj_proves = proves }
+    proves (Pair lhs rhs)
+      = do { (tc2, [x2,y2]) <- splitTyConApp_maybe rhs
+           ; guard (tc2 == fam_tc)
+           ; (tc1, [x1,y1]) <- splitTyConApp_maybe lhs
+           ; massertPpr (tc1 == fam_tc) (ppr tc1 $$ ppr fam_tc)
+           ; case (eq1, eq2) of
+               (ArgX,ArgX) -> do_it x1 x2 y1 y2
+               (ArgX,ArgY) -> do_it x1 y2 x2 y1
+               (ArgY,ArgX) -> do_it y1 x2 y2 x1
+               (ArgY,ArgY) -> do_it y1 y2 x1 x2 }
+
+    do_it a1 a2 b1 b2 = do { same a1 a2; guard (check_me a1); return (Pair b1 b2) }
+
+noGuard :: Type -> Bool
+noGuard _ = True
+
+numGuard :: (Integer -> Bool) -> Type -> Bool
+numGuard pred ty = case isNumLitTy ty of
+                      Just n  -> pred n
+                      Nothing -> False
+
+data WhichArg = ArgX | ArgY
+
+
+-------------------------------------------------------------------------------
+--     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]
@@ -164,108 +384,324 @@ typeNatTyCons =
   , typeNatToCharTyCon
   ]
 
+
+-- 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 :: UniqFM FastString CoAxiomRule
+typeNatCoAxiomRules
+  = listToUFM $
+    [ pr | tc <- typeNatTyCons
+         , Just ops <- [isBuiltInSynFamTyCon_maybe tc]
+         , pr <- [ (bifinj_name bif, bifinj_axr bif) | bif <- sfInteract ops ]
+              ++ [ (bifrw_name bif,  bifrw_axr bif)  | bif <- sfMatchFam ops ] ]
+
+-------------------------------------------------------------------------------
+--                   Addition (+)
+-------------------------------------------------------------------------------
+
 typeNatAddTyCon :: TyCon
 typeNatAddTyCon = mkTypeNatFunTyCon2 name
   BuiltInSynFamily
-    { sfMatchFam      = matchFamAdd
-    , sfInteractTop   = interactTopAdd
-    , sfInteractInert = interactInertAdd
+    { sfMatchFam  = axAddRewrites
+    , sfInteract  = axAddInjectivity
     }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "+")
-            typeNatAddTyFamNameKey typeNatAddTyCon
+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "+")
+              typeNatAddTyFamNameKey typeNatAddTyCon
+
+
+sn,tn :: TyVar  -- Of kind Natural
+(sn: tn: _) = mkTemplateTyVars (repeat typeSymbolKind)
+
+axAddRewrites :: [BuiltInFamRewrite]
+axAddRewrites
+  = [ mkRewriteAxiom   tc "Add0L" [tn] [num 0, var tn] (var tn)   -- 0 + t --> t
+    , mkRewriteAxiom   tc "Add0R" [sn] [var sn, num 0] (var sn)   -- s + 0 --> s
+    , mkBinConstFoldAxiom tc "AddDef" isNumLitTy isNumLitTy $     -- 3 + 4 --> 7
+      \x y -> Just $ num (x + y) ]
+  where
+    tc = typeNatAddTyCon
+
+axAddInjectivity :: [BuiltInFamInjectivity]
+axAddInjectivity
+  = [ -- (s + t ~ 0) => (s ~ 0)
+      mkTopBinFamDeduction "AddT-0L" tc $ \ a _b r ->
+      do { _ <- known r (== 0); return (Pair a (num 0)) }
+
+    , -- (s + t ~ 0) => (t ~ 0)
+      mkTopBinFamDeduction "AddT-0R" tc $ \ _a b r ->
+      do { _ <- known r (== 0); return (Pair b (num 0)) }
+
+    , -- (5 + t ~ 8) => (t ~ 3)
+      mkTopBinFamDeduction "AddT-KKL" tc $ \ a b r ->
+      do { na <- isNumLitTy a; nr <- known r (>= na); return (Pair b (num (nr-na))) }
+
+    , -- (s + 5 ~ 8) => (s ~ 3)
+      mkTopBinFamDeduction "AddT-KKR" tc $ \ a b r ->
+      do { nb <- isNumLitTy b; nr <- known r (>= nb); return (Pair a (num (nr-nb))) }
+
+    , mkBinBIF "AddI-xx" tc ArgX ArgX noGuard  -- x1+y1~x2+y2 {x1=x2}=> (y1 ~ y2)
+    , mkBinBIF "AddI-xy" tc ArgX ArgY noGuard  -- x1+y1~x2+y2 {x1=y2}=> (x2 ~ y1)
+    , mkBinBIF "AddI-yx" tc ArgY ArgX noGuard  -- x1+y1~x2+y2 {y1=x2}=> (x1 ~ y2)
+    , mkBinBIF "AddI-yy" tc ArgY ArgY noGuard  -- x1+y1~x2+y2 {y1=y2}=> (x1 ~ x2)
+    ]
+  where
+    tc = typeNatAddTyCon
+
+-------------------------------------------------------------------------------
+--                   Subtraction (-)
+-------------------------------------------------------------------------------
 
 typeNatSubTyCon :: TyCon
 typeNatSubTyCon = mkTypeNatFunTyCon2 name
   BuiltInSynFamily
-    { sfMatchFam      = matchFamSub
-    , sfInteractTop   = interactTopSub
-    , sfInteractInert = interactInertSub
+    { sfMatchFam = axSubRewrites
+    , sfInteract = axSubInjectivity
     }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "-")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "-")
             typeNatSubTyFamNameKey typeNatSubTyCon
 
+axSubRewrites :: [BuiltInFamRewrite]
+axSubRewrites
+  = [ mkRewriteAxiom   tc "Sub0R" [sn] [var sn, num 0] (var sn)   -- s - 0 --> s
+    , mkBinConstFoldAxiom tc "SubDef" isNumLitTy isNumLitTy $     -- 4 - 3 --> 1  if x>=y
+      \x y -> fmap num (minus x y) ]
+  where
+    tc = typeNatSubTyCon
+
+axSubInjectivity :: [BuiltInFamInjectivity]
+axSubInjectivity
+  = [ -- (a - b ~ 5) => (5 + b ~ a)
+      mkTopBinFamDeduction "SubT" tc $ \ a b r ->
+      do { _ <- isNumLitTy r; return (Pair (r .+. b) a) }
+
+    , mkBinBIF "SubI-xx" tc ArgX ArgX noGuard -- (x-y1 ~ x-y2) => (y1 ~ y2)
+    , mkBinBIF "SubI-yy" tc ArgY ArgY noGuard -- (x1-y ~ x2-y) => (x1 ~ x2)
+    ]
+  where
+    tc = typeNatSubTyCon
+
+{-
+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.
+-}
+
+
+-------------------------------------------------------------------------------
+--                   Multiplication (*)
+-------------------------------------------------------------------------------
+
 typeNatMulTyCon :: TyCon
 typeNatMulTyCon = mkTypeNatFunTyCon2 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamMul
-    , sfInteractTop   = interactTopMul
-    , sfInteractInert = interactInertMul
-    }
+  BuiltInSynFamily { sfMatchFam = axMulRewrites
+                   , sfInteract = axMulInjectivity  }
+  where
+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "*")
+              typeNatMulTyFamNameKey typeNatMulTyCon
+
+axMulRewrites :: [BuiltInFamRewrite]
+axMulRewrites
+  = [ mkRewriteAxiom   tc "Mul0L" [tn] [num 0, var tn] (num 0)   -- 0 * t --> 0
+    , mkRewriteAxiom   tc "Mul0R" [sn] [var sn, num 0] (num 0)   -- s * 0 --> 0
+    , mkRewriteAxiom   tc "Mul1L" [tn] [num 1, var tn] (var tn)  -- 1 * t --> t
+    , mkRewriteAxiom   tc "Mul1R" [sn] [var sn, num 1] (var sn)  -- s * 1 --> s
+    , mkBinConstFoldAxiom tc "MulDef" isNumLitTy isNumLitTy $    -- 3 + 4 --> 12
+      \x y -> Just $ num (x * y) ]
+  where
+    tc = typeNatMulTyCon
+
+axMulInjectivity :: [BuiltInFamInjectivity]
+axMulInjectivity
+  = [ -- (s * t ~ 1)  => (s ~ 1)
+      mkTopBinFamDeduction "MulT1" tc $ \ s _t r ->
+      do { _ <- known r (== 1); return (Pair s r) }
+
+    , -- (s * t ~ 1)  => (t ~ 1)
+      mkTopBinFamDeduction "MulT2" tc $ \ _s t r ->
+      do { _ <- known r (== 1); return (Pair t r) }
+
+    , -- (3 * t ~ 15) => (t ~ 5)
+      mkTopBinFamDeduction "MulT3" tc $ \ s t r ->
+      do { ns <- isNumLitTy s; nr <- isNumLitTy r; y <- divide nr ns; return (Pair t (num y)) }
+
+    , -- (s * 3 ~ 15) => (s ~ 5)
+      mkTopBinFamDeduction "MulT4" tc $ \ s t r ->
+      do { nt <- isNumLitTy t; nr <- isNumLitTy r; y <- divide nr nt; return (Pair s (num y)) }
+
+    , mkBinBIF "MulI-xx" tc ArgX ArgX (numGuard (/= 0))    -- (x*y1 ~ x*y2) {x/=0}=> (y1 ~ y2)
+    , mkBinBIF "MulI-yy" tc ArgY ArgY (numGuard (/= 0))    -- (x1*y ~ x2*y) {y/=0}=> (x1 ~ x2)
+    ]
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "*")
-            typeNatMulTyFamNameKey typeNatMulTyCon
+    tc = typeNatMulTyCon
+
+
+-------------------------------------------------------------------------------
+--                   Division: Div and Mod
+-------------------------------------------------------------------------------
 
 typeNatDivTyCon :: TyCon
 typeNatDivTyCon = mkTypeNatFunTyCon2 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamDiv
-    , sfInteractTop   = interactTopDiv
-    , sfInteractInert = interactInertDiv
-    }
+  BuiltInSynFamily { sfMatchFam = axDivRewrites
+                   , sfInteract = [] }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Div")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Div")
             typeNatDivTyFamNameKey typeNatDivTyCon
 
 typeNatModTyCon :: TyCon
 typeNatModTyCon = mkTypeNatFunTyCon2 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamMod
-    , sfInteractTop   = interactTopMod
-    , sfInteractInert = interactInertMod
-    }
+  BuiltInSynFamily { sfMatchFam = axModRewrites
+                   , sfInteract = [] }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Mod")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Mod")
             typeNatModTyFamNameKey typeNatModTyCon
 
-typeNatExpTyCon :: TyCon
+axDivRewrites :: [BuiltInFamRewrite]
+axDivRewrites
+  = [ mkRewriteAxiom   tc "Div1" [sn] [var sn, num 1] (var sn)   -- s `div` 1 --> s
+    , mkBinConstFoldAxiom tc "DivDef" isNumLitTy isNumLitTy $    -- 8 `div` 4 --> 2
+      \x y -> do { guard (y /= 0); return (num (div x y)) } ]
+  where
+    tc = typeNatDivTyCon
+
+axModRewrites :: [BuiltInFamRewrite]
+axModRewrites
+  = [ mkRewriteAxiom   tc "Mod1" [sn] [var sn, num 1] (num 0)   -- s `mod` 1 --> 0
+    , mkBinConstFoldAxiom tc "ModDef" isNumLitTy isNumLitTy $   -- 8 `mod` 3 --> 2
+      \x y -> do { guard (y /= 0); return (num (mod x y)) } ]
+  where
+    tc = typeNatModTyCon
+
+-------------------------------------------------------------------------------
+--                   Exponentiation: Exp
+-------------------------------------------------------------------------------
+
+typeNatExpTyCon :: TyCon  -- Exponentiation
 typeNatExpTyCon = mkTypeNatFunTyCon2 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamExp
-    , sfInteractTop   = interactTopExp
-    , sfInteractInert = interactInertExp
-    }
+  BuiltInSynFamily { sfMatchFam = axExpRewrites
+                   , sfInteract = axExpInjectivity }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "^")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "^")
                 typeNatExpTyFamNameKey typeNatExpTyCon
 
+axExpRewrites :: [BuiltInFamRewrite]
+axExpRewrites
+  = [ mkRewriteAxiom   tc "Exp0R" [sn] [var sn, num 0] (num 1)   -- s ^ 0 --> 1
+    , mkRewriteAxiom   tc "Exp1L" [tn] [num 1, var tn] (num 1)   -- 1 ^ t --> 1
+    , mkRewriteAxiom   tc "Exp1R" [sn] [var sn, num 1] (var sn)  -- s ^ 1 --> s
+    , mkBinConstFoldAxiom tc "ExpDef" isNumLitTy isNumLitTy $    -- 2 ^ 3 --> 8
+      \x y -> Just (num (x ^ y)) ]
+  where
+    tc = typeNatExpTyCon
+
+axExpInjectivity :: [BuiltInFamInjectivity]
+axExpInjectivity
+  = [ -- (s ^ t ~ 0) => (s ~ 0)
+      mkTopBinFamDeduction "ExpT1" tc $ \ s _t r ->
+      do { 0 <- isNumLitTy r; return (Pair s r) }
+
+    , -- (2 ^ t ~ 8) => (t ~ 3)
+      mkTopBinFamDeduction "ExpT2" tc $ \ s t r ->
+      do { ns <- isNumLitTy s; nr <- isNumLitTy r; y <- logExact nr ns; return (Pair t (num y)) }
+
+    , -- (s ^ 2 ~ 9) => (s ~ 3)
+      mkTopBinFamDeduction "ExpT3" tc $ \ s t r ->
+      do { nt <- isNumLitTy t; nr <- isNumLitTy r; y <- rootExact nr nt; return (Pair s (num y)) }
+
+    , mkBinBIF "ExpI-xx" tc ArgX ArgX (numGuard (> 1))    -- (x^y1 ~ x^y2) {x>1}=> (y1 ~ y2)
+    , mkBinBIF "ExpI-yy" tc ArgY ArgY (numGuard (/= 0))   -- (x1*y ~ x2*y) {y/=0}=> (x1 ~ x2)
+    ]
+  where
+    tc = typeNatExpTyCon
+
+-------------------------------------------------------------------------------
+--                   Logarithm: Log2
+-------------------------------------------------------------------------------
+
 typeNatLogTyCon :: TyCon
 typeNatLogTyCon = mkTypeNatFunTyCon1 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamLog
-    , sfInteractTop   = interactTopLog
-    , sfInteractInert = interactInertLog
-    }
+  BuiltInSynFamily { sfMatchFam = axLogRewrites
+                   , sfInteract = [] }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Log2")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Log2")
             typeNatLogTyFamNameKey typeNatLogTyCon
 
+axLogRewrites :: [BuiltInFamRewrite]
+axLogRewrites
+  = [ mkUnaryConstFoldAxiom tc "LogDef" isNumLitTy $       -- log 8 --> 3
+      \x -> do { (a,_) <- genLog x 2; return (num a) } ]
+  where
+    tc = typeNatLogTyCon
 
+-------------------------------------------------------------------------------
+--               Comparision of Nats: CmpNat
+-------------------------------------------------------------------------------
 
 typeNatCmpTyCon :: TyCon
-typeNatCmpTyCon =
-  mkFamilyTyCon name
-    (mkTemplateAnonTyConBinders [ naturalTy, naturalTy ])
-    orderingKind
-    Nothing
-    (BuiltInSynFamTyCon ops)
-    Nothing
-    NotInjective
+typeNatCmpTyCon
+  = mkFamilyTyCon name
+      (mkTemplateAnonTyConBinders [ naturalTy, naturalTy ])
+      orderingKind
+      Nothing
+      (BuiltInSynFamTyCon ops)
+      Nothing
+      NotInjective
 
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPENATS_INTERNAL (fsLit "CmpNat")
-                typeNatCmpTyFamNameKey typeNatCmpTyCon
-  ops = BuiltInSynFamily
-    { sfMatchFam      = matchFamCmpNat
-    , sfInteractTop   = interactTopCmpNat
-    , sfInteractInert = \_ _ _ _ -> []
-    }
+    name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS_INTERNAL (fsLit "CmpNat")
+                  typeNatCmpTyFamNameKey typeNatCmpTyCon
+    ops = BuiltInSynFamily { sfMatchFam = axCmpNatRewrites
+                           , sfInteract = axCmpNatInjectivity }
+
+axCmpNatRewrites :: [BuiltInFamRewrite]
+axCmpNatRewrites
+  = [ mkRewriteAxiom   tc "CmpNatRefl" [sn] [var sn, var sn] (ordering EQ)    -- s `cmp` s --> EQ
+    , mkBinConstFoldAxiom tc "CmpNatDef" isNumLitTy isNumLitTy $              -- 2 `cmp` 3 --> LT
+      \x y -> Just (ordering (compare x y)) ]
+  where
+    tc = typeNatCmpTyCon
+
+axCmpNatInjectivity :: [BuiltInFamInjectivity]
+axCmpNatInjectivity
+  = [ -- s `cmp` t ~ EQ   ==>   s ~ t
+      mkTopBinFamDeduction "CmpNatT3" typeNatCmpTyCon $ \ s t r ->
+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]
+
+-------------------------------------------------------------------------------
+--              Comparsion of Symbols: CmpSymbol
+-------------------------------------------------------------------------------
 
 typeSymbolCmpTyCon :: TyCon
 typeSymbolCmpTyCon =
   mkFamilyTyCon name
-    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])
+    (mkTemplateAnonTyConBinders [typeSymbolKind, typeSymbolKind])
     orderingKind
     Nothing
     (BuiltInSynFamTyCon ops)
@@ -273,25 +709,79 @@ typeSymbolCmpTyCon =
     NotInjective
 
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS_INTERNAL (fsLit "CmpSymbol")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS_INTERNAL (fsLit "CmpSymbol")
                 typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon
-  ops = BuiltInSynFamily
-    { sfMatchFam      = matchFamCmpSymbol
-    , sfInteractTop   = interactTopCmpSymbol
-    , sfInteractInert = \_ _ _ _ -> []
-    }
+  ops = BuiltInSynFamily { sfMatchFam = axSymbolCmpRewrites
+                         , sfInteract = axSymbolCmpInjectivity }
+
+ss,ts :: TyVar  -- Of kind Symbol
+(ss: ts: _) = mkTemplateTyVars (repeat typeSymbolKind)
+
+axSymbolCmpRewrites :: [BuiltInFamRewrite]
+axSymbolCmpRewrites
+  = [ mkRewriteAxiom   tc "CmpSymbolRefl" [ss] [var ss, var ss] (ordering EQ) -- s `cmp` s --> EQ
+    , mkBinConstFoldAxiom tc "CmpSymbolDef" isStrLitTy isStrLitTy $           -- "a" `cmp` "b" --> LT
+      \x y -> Just (ordering (lexicalCompareFS x y)) ]
+  where
+    tc = typeSymbolCmpTyCon
+
+axSymbolCmpInjectivity :: [BuiltInFamInjectivity]
+axSymbolCmpInjectivity
+  = [ mkTopBinFamDeduction "CmpSymbolT" typeSymbolCmpTyCon $ \ s t r ->
+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]
+
+
+-------------------------------------------------------------------------------
+--            AppendSymbol
+-------------------------------------------------------------------------------
 
 typeSymbolAppendTyCon :: TyCon
 typeSymbolAppendTyCon = mkTypeSymbolFunTyCon2 name
-  BuiltInSynFamily
-    { sfMatchFam      = matchFamAppendSymbol
-    , sfInteractTop   = interactTopAppendSymbol
-    , sfInteractInert = interactInertAppendSymbol
-    }
+  BuiltInSynFamily { sfMatchFam = axAppendRewrites
+                   , sfInteract = axAppendInjectivity }
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "AppendSymbol")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "AppendSymbol")
                 typeSymbolAppendFamNameKey typeSymbolAppendTyCon
 
+axAppendRewrites :: [BuiltInFamRewrite]
+axAppendRewrites
+  = [ mkRewriteAxiom   tc "Concat0R" [ts] [nullStrLitTy, var ts] (var ts) -- "" ++ t --> t
+    , mkRewriteAxiom   tc "Concat0L" [ss] [var ss, nullStrLitTy] (var ss) -- s ++ "" --> s
+    , mkBinConstFoldAxiom tc "AppendSymbolDef" isStrLitTy isStrLitTy $    -- "a" ++ "b" --> "ab"
+      \x y -> Just (mkStrLitTy (appendFS x y)) ]
+  where
+    tc = typeSymbolAppendTyCon
+
+axAppendInjectivity :: [BuiltInFamInjectivity]
+axAppendInjectivity
+ = [ -- (AppendSymbol a b ~ "") => (a ~ "")
+     mkTopBinFamDeduction "AppendSymbolT1" tc $ \ a _b r ->
+     do { rs <- isStrLitTy r; guard (nullFS rs); return (Pair a nullStrLitTy) }
+
+   , -- (AppendSymbol a b ~ "") => (b ~ "")
+     mkTopBinFamDeduction "AppendSymbolT2" tc $ \ _a b r ->
+     do { rs <- isStrLitTy r; guard (nullFS rs); return (Pair b nullStrLitTy) }
+
+   , -- (AppendSymbol "foo" b ~ "foobar") => (b ~ "bar")
+     mkTopBinFamDeduction "AppendSymbolT3" tc $ \ a b r ->
+     do { as <- isStrLitTyS a; rs <- isStrLitTyS r; guard (as `isPrefixOf` rs)
+        ; return (Pair b (mkStrLitTyS (drop (length as) rs))) }
+
+   , -- (AppendSymbol f "bar" ~ "foobar") => (f ~ "foo")
+     mkTopBinFamDeduction "AppendSymbolT3" tc $ \ a b r ->
+     do { bs <- isStrLitTyS b; rs <- isStrLitTyS r; guard (bs `isSuffixOf` rs)
+        ; return (Pair a (mkStrLitTyS (take (length rs - length bs) rs))) }
+
+    , mkBinBIF "AppI-xx" tc ArgX ArgX noGuard  -- (x++y1 ~ x++y2) => (y1 ~ y2)
+    , mkBinBIF "AppI-yy" tc ArgY ArgY noGuard  -- (x1++y ~ x2++y) => (x1 ~ x2)
+    ]
+  where
+    tc = typeSymbolAppendTyCon
+
+-------------------------------------------------------------------------------
+--            ConsSymbol
+-------------------------------------------------------------------------------
+
 typeConsSymbolTyCon :: TyCon
 typeConsSymbolTyCon =
   mkFamilyTyCon name
@@ -302,13 +792,38 @@ typeConsSymbolTyCon =
     Nothing
     (Injective [True, True])
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "ConsSymbol")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "ConsSymbol")
                   typeConsSymbolTyFamNameKey typeConsSymbolTyCon
-  ops = BuiltInSynFamily
-      { sfMatchFam      = matchFamConsSymbol
-      , sfInteractTop   = interactTopConsSymbol
-      , sfInteractInert = interactInertConsSymbol
-      }
+  ops = BuiltInSynFamily  { sfMatchFam = axConsRewrites
+                          , sfInteract = axConsInjectivity }
+
+axConsRewrites :: [BuiltInFamRewrite]
+axConsRewrites
+  = [ mkBinConstFoldAxiom tc "ConsSymbolDef" isCharLitTy isStrLitTy $    -- 'a' : "bc" --> "abc"
+      \x y -> Just $ mkStrLitTy (consFS x y) ]
+  where
+    tc = typeConsSymbolTyCon
+
+axConsInjectivity :: [BuiltInFamInjectivity]
+axConsInjectivity
+  = [ -- ConsSymbol a b ~ "blah" => (a ~ 'b')
+      mkTopBinFamDeduction "ConsSymbolT1" tc $ \ a _b r ->
+      do { rs <- isStrLitTy r; (x,_) <- unconsFS rs; return (Pair a (mkCharLitTy x)) }
+
+    , -- ConsSymbol a b ~ "blah" => (b ~ "lah")
+      mkTopBinFamDeduction "ConsSymbolT2" tc $ \ _a b r ->
+      do { rs <- isStrLitTy r; (_,xs) <- unconsFS rs; return (Pair b (mkStrLitTy xs)) }
+
+
+    , mkBinBIF "ConsI-xx" tc ArgX ArgX noGuard  -- (x:y1 ~ x:y2) => (y1 ~ y2)
+    , mkBinBIF "ConsI-yy" tc ArgY ArgY noGuard  -- (x1:y ~ x2:y) => (x1 ~ x2)
+    ]
+  where
+    tc = typeConsSymbolTyCon
+
+-------------------------------------------------------------------------------
+--            UnconsSymbol
+-------------------------------------------------------------------------------
 
 typeUnconsSymbolTyCon :: TyCon
 typeUnconsSymbolTyCon =
@@ -320,13 +835,47 @@ typeUnconsSymbolTyCon =
     Nothing
     (Injective [True])
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "UnconsSymbol")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "UnconsSymbol")
                   typeUnconsSymbolTyFamNameKey typeUnconsSymbolTyCon
-  ops = BuiltInSynFamily
-      { sfMatchFam      = matchFamUnconsSymbol
-      , sfInteractTop   = interactTopUnconsSymbol
-      , sfInteractInert = interactInertUnconsSymbol
-      }
+  ops = BuiltInSynFamily { sfMatchFam = axUnconsRewrites
+                         , sfInteract = axUnconsInjectivity }
+
+computeUncons :: FastString -> Type
+computeUncons str
+  = mkPromotedMaybeTy charSymbolPairKind (fmap reify (unconsFS str))
+  where
+    reify :: (Char, FastString) -> Type
+    reify (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s)
+
+axUnconsRewrites :: [BuiltInFamRewrite]
+axUnconsRewrites
+  = [ mkUnaryConstFoldAxiom tc "ConsSymbolDef" isStrLitTy $    -- 'a' : "bc" --> "abc"
+      \x -> Just $ computeUncons x ]
+  where
+    tc = typeUnconsSymbolTyCon
+
+axUnconsInjectivity :: [BuiltInFamInjectivity]
+axUnconsInjectivity
+  = [ -- (UnconsSymbol b ~ Nothing) => (b ~ "")
+      mkTopUnaryFamDeduction "UnconsSymbolT1" tc $ \b r ->
+      do { Nothing  <- isPromotedMaybeTy r; return (Pair b nullStrLitTy) }
+
+    , -- (UnconsSymbol b ~ Just ('f',"oobar")) => (b ~ "foobar")
+      mkTopUnaryFamDeduction "UnconsSymbolT2" tc $ \b r ->
+      do { Just pr <- isPromotedMaybeTy r
+         ; (c,s) <- isPromotedPairType pr
+         ; chr <- isCharLitTy c
+         ; str <- isStrLitTy s
+         ; return (Pair b (mkStrLitTy (consFS chr str))) }
+
+    , mkUnaryBIF "UnconsI1" tc  -- (UnconsSymbol x1 ~ z, UnconsSymbol x2 ~ z) => (x1 ~ x2)
+    ]
+  where
+    tc = typeUnconsSymbolTyCon
+
+-------------------------------------------------------------------------------
+--            CharToNat
+-------------------------------------------------------------------------------
 
 typeCharToNatTyCon :: TyCon
 typeCharToNatTyCon =
@@ -338,14 +887,27 @@ typeCharToNatTyCon =
     Nothing
     (Injective [True])
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "CharToNat")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "CharToNat")
                   typeCharToNatTyFamNameKey typeCharToNatTyCon
-  ops = BuiltInSynFamily
-      { sfMatchFam      = matchFamCharToNat
-      , sfInteractTop   = interactTopCharToNat
-      , sfInteractInert = \_ _ _ _ -> []
-      }
+  ops = BuiltInSynFamily { sfMatchFam = axCharToNatRewrites
+                         , sfInteract = axCharToNatInjectivity }
 
+axCharToNatRewrites :: [BuiltInFamRewrite]
+axCharToNatRewrites
+  = [ mkUnaryConstFoldAxiom tc "CharToNatDef" isCharLitTy $    -- CharToNat 'a' --> 97
+      \x -> Just $ num (charToInteger x) ]
+  where
+    tc = typeCharToNatTyCon
+
+axCharToNatInjectivity :: [BuiltInFamInjectivity]
+axCharToNatInjectivity
+  = [ -- (CharToNat c ~ 122) => (c ~ 'z')
+      mkTopUnaryFamDeduction "CharToNatT1" typeCharToNatTyCon $ \c r ->
+      do { nr <- isNumLitTy r; chr <- integerToChar nr; return (Pair c (mkCharLitTy chr)) } ]
+
+-------------------------------------------------------------------------------
+--            NatToChar
+-------------------------------------------------------------------------------
 
 typeNatToCharTyCon :: TyCon
 typeNatToCharTyCon =
@@ -357,223 +919,79 @@ typeNatToCharTyCon =
     Nothing
     (Injective [True])
   where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "NatToChar")
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS (fsLit "NatToChar")
                   typeNatToCharTyFamNameKey typeNatToCharTyCon
-  ops = BuiltInSynFamily
-      { sfMatchFam      = matchFamNatToChar
-      , sfInteractTop   = interactTopNatToChar
-      , sfInteractInert = \_ _ _ _ -> []
-      }
+  ops = BuiltInSynFamily { sfMatchFam = axNatToCharRewrites
+                         , sfInteract = axNatToCharInjectivity }
 
--- Make a unary built-in constructor of kind: Nat -> Nat
-mkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon
-mkTypeNatFunTyCon1 op tcb =
-  mkFamilyTyCon op
-    (mkTemplateAnonTyConBinders [ naturalTy ])
-    naturalTy
-    Nothing
-    (BuiltInSynFamTyCon tcb)
-    Nothing
-    NotInjective
+axNatToCharRewrites :: [BuiltInFamRewrite]
+axNatToCharRewrites
+  = [ mkUnaryConstFoldAxiom tc "NatToCharDef" isNumLitTy $    -- NatToChar 97 --> 'a'
+      \n -> fmap mkCharLitTy (integerToChar n) ]
+  where
+    tc = typeNatToCharTyCon
 
--- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
-mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
-mkTypeNatFunTyCon2 op tcb =
-  mkFamilyTyCon op
-    (mkTemplateAnonTyConBinders [ naturalTy, naturalTy ])
-    naturalTy
-    Nothing
-    (BuiltInSynFamTyCon tcb)
-    Nothing
-    NotInjective
+axNatToCharInjectivity :: [BuiltInFamInjectivity]
+axNatToCharInjectivity
+  = [ -- (NatToChar n ~ 'z') => (n ~ 122)
+      mkTopUnaryFamDeduction "CharToNatT1" typeNatToCharTyCon $ \n r ->
+      do { c <- isCharLitTy r; return (Pair n (mkNumLitTy (charToInteger c))) } ]
 
--- Make a binary built-in constructor of kind: Symbol -> Symbol -> Symbol
-mkTypeSymbolFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
-mkTypeSymbolFunTyCon2 op tcb =
-  mkFamilyTyCon op
-    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])
-    typeSymbolKind
+
+-----------------------------------------------------------------------------
+--                       CmpChar
+-----------------------------------------------------------------------------
+
+typeCharCmpTyCon :: TyCon
+typeCharCmpTyCon =
+  mkFamilyTyCon name
+    (mkTemplateAnonTyConBinders [ charTy, charTy ])
+    orderingKind
     Nothing
-    (BuiltInSynFamTyCon tcb)
+    (BuiltInSynFamTyCon ops)
     Nothing
     NotInjective
+  where
+  name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPELITS_INTERNAL (fsLit "CmpChar")
+                  typeCharCmpTyFamNameKey typeCharCmpTyCon
+  ops = BuiltInSynFamily { sfMatchFam = axCharCmpRewrites
+                         , sfInteract = axCharCmpInjectivity }
 
-{-------------------------------------------------------------------------------
-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
-  , axCmpNatDef
-  , axCmpSymbolDef
-  , axAppendSymbolDef
-  , axConsSymbolDef
-  , axUnconsSymbolDef
-  , axCharToNatDef
-  , axNatToCharDef
-  , axAdd0L
-  , axAdd0R
-  , axMul0L
-  , axMul0R
-  , axMul1L
-  , axMul1R
-  , axExp1L
-  , axExp0R
-  , axExp1R
-  , axCmpNatRefl
-  , axCmpSymbolRefl
-  , axSubDef
-  , axSub0R
-  , axAppendSymbol0R
-  , axAppendSymbol0L
-  , axDivDef
-  , axDiv1
-  , axModDef
-  , axMod1
-  , axLogDef
-  :: CoAxiomRule
-
-axAddDef = mkBinAxiom "AddDef" typeNatAddTyCon isNumLitTy isNumLitTy $
-              \x y -> Just $ num (x + y)
-
-axMulDef = mkBinAxiom "MulDef" typeNatMulTyCon isNumLitTy isNumLitTy $
-              \x y -> Just $ num (x * y)
-
-axExpDef = mkBinAxiom "ExpDef" typeNatExpTyCon isNumLitTy isNumLitTy $
-              \x y -> Just $ num (x ^ y)
-
-axCmpNatDef   = mkBinAxiom "CmpNatDef" typeNatCmpTyCon isNumLitTy isNumLitTy
-              $ \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 (lexicalCompareFS 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)
-    }
-
-axConsSymbolDef =
-  mkBinAxiom "ConsSymbolDef" typeConsSymbolTyCon isCharLitTy isStrLitTy $
-    \c str -> Just $ mkStrLitTy (consFS c str)
-
-axUnconsSymbolDef =
-  mkUnAxiom "UnconsSymbolDef" typeUnconsSymbolTyCon isStrLitTy $
-    \str -> Just $ computeUncons str
-
-axCharToNatDef =
-  mkUnAxiom "CharToNatDef" typeCharToNatTyCon isCharLitTy $
-    \c -> Just $ num (charToInteger c)
-
-axNatToCharDef =
-  mkUnAxiom "NatToCharDef" typeNatToCharTyCon isNumLitTy $
-    \n -> fmap mkCharLitTy (integerToChar n)
-
-axSubDef = mkBinAxiom "SubDef" typeNatSubTyCon isNumLitTy isNumLitTy $
-              \x y -> fmap num (minus x y)
-
-axDivDef = mkBinAxiom "DivDef" typeNatDivTyCon isNumLitTy isNumLitTy $
-              \x y -> do guard (y /= 0)
-                         return (num (div x y))
-
-axModDef = mkBinAxiom "ModDef" typeNatModTyCon isNumLitTy isNumLitTy $
-              \x y -> do guard (y /= 0)
-                         return (num (mod x y))
-
-axLogDef = mkUnAxiom "LogDef" typeNatLogTyCon isNumLitTy $
-              \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
-axCmpNatRefl    = mkAxiom1 "CmpNatRefl"
-                $ \(Pair s _) -> (cmpNat s s) === ordering EQ
-axCmpSymbolRefl = mkAxiom1 "CmpSymbolRefl"
-                $ \(Pair s _) -> (cmpSymbol s s) === ordering EQ
-axAppendSymbol0R  = mkAxiom1 "Concat0R"
-            $ \(Pair s t) -> (mkStrLitTy nilFS `appendSymbol` s) === t
-axAppendSymbol0L  = mkAxiom1 "Concat0L"
-            $ \(Pair s t) -> (s `appendSymbol` mkStrLitTy nilFS) === t
+sc :: TyVar  -- Of kind Char
+(sc: _) = mkTemplateTyVars (repeat charTy)
 
--- 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 :: UniqFM FastString CoAxiomRule
-typeNatCoAxiomRules = listToUFM $ map (\x -> (coaxrName x, x))
-  [ axAddDef
-  , axMulDef
-  , axExpDef
-  , axCmpNatDef
-  , axCmpSymbolDef
-  , axCmpCharDef
-  , axAppendSymbolDef
-  , axConsSymbolDef
-  , axUnconsSymbolDef
-  , axCharToNatDef
-  , axNatToCharDef
-  , axAdd0L
-  , axAdd0R
-  , axMul0L
-  , axMul0R
-  , axMul1L
-  , axMul1R
-  , axExp1L
-  , axExp0R
-  , axExp1R
-  , axCmpNatRefl
-  , axCmpSymbolRefl
-  , axCmpCharRefl
-  , axSubDef
-  , axSub0R
-  , axAppendSymbol0R
-  , axAppendSymbol0L
-  , axDivDef
-  , axDiv1
-  , axModDef
-  , axMod1
-  , axLogDef
-  ]
+axCharCmpRewrites :: [BuiltInFamRewrite]
+axCharCmpRewrites
+  = [ mkRewriteAxiom   tc "CmpCharRefl" [sc] [var sc, var sc] (ordering EQ) -- s `cmp` s --> EQ
+    , mkBinConstFoldAxiom tc "CmpCharDef" isCharLitTy isCharLitTy $         -- 'a' `cmp` 'b' --> LT
+      \chr1 chr2 -> Just $ ordering $ compare chr1 chr2 ]
+  where
+    tc = typeCharCmpTyCon
 
+axCharCmpInjectivity :: [BuiltInFamInjectivity]
+axCharCmpInjectivity
+  = [  -- (CmpChar s t ~ EQ) => s ~ t
+      mkTopBinFamDeduction "CmpCharT" typeCharCmpTyCon $ \ s t r ->
+      do { EQ <- isOrderingLitTy r; return (Pair s t) } ]
 
 
 {-------------------------------------------------------------------------------
 Various utilities for making axioms and types
 -------------------------------------------------------------------------------}
 
+(===) :: Type -> Type -> Pair Type
+x === y = Pair x y
+
+num :: Integer -> Type
+num = mkNumLitTy
+
+var :: TyVar -> Type
+var = mkTyVarTy
+
 (.+.) :: Type -> Type -> Type
 s .+. t = mkTyConApp typeNatAddTyCon [s,t]
 
+{-
 (.-.) :: Type -> Type -> Type
 s .-. t = mkTyConApp typeNatSubTyCon [s,t]
 
@@ -597,12 +1015,17 @@ 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
+nullStrLitTy :: Type  -- The type ""
+nullStrLitTy = mkStrLitTy nilFS
+
+isStrLitTyS :: Type -> Maybe String
+isStrLitTyS ty = do { fs <- isStrLitTy ty; return (unpackFS fs) }
+
+mkStrLitTyS :: String -> Type
+mkStrLitTyS s = mkStrLitTy (mkFastString s)
 
 charSymbolPair :: Type -> Type -> Type
 charSymbolPair = mkPromotedPairTy charTy typeSymbolKind
@@ -629,186 +1052,44 @@ isOrderingLitTy tc =
          | tc1 == promotedGTDataCon -> return GT
          | otherwise                -> Nothing
 
-known :: (Integer -> Bool) -> Type -> Bool
-known p x = case isNumLitTy x of
-              Just a  -> p a
-              Nothing -> False
-
-mkUnAxiom :: String -> TyCon -> (Type -> Maybe a) -> (a -> Maybe Type) -> CoAxiomRule
-mkUnAxiom str tc isReqTy f =
-  CoAxiomRule
-    { coaxrName      = fsLit str
-    , coaxrAsmpRoles = [Nominal]
-    , coaxrRole      = Nominal
-    , coaxrProves    = \cs ->
-        do [Pair s1 s2] <- return cs
-           s2' <- isReqTy s2
-           z   <- f s2'
-           return (mkTyConApp tc [s1] === z)
-    }
-
--- For the definitional axioms
-mkBinAxiom :: String -> TyCon ->
-              (Type -> Maybe a) ->
-              (Type -> Maybe b) ->
-              (a -> b -> Maybe Type) -> CoAxiomRule
-mkBinAxiom str tc isReqTy1 isReqTy2 f =
-  CoAxiomRule
-    { coaxrName      = fsLit str
-    , coaxrAsmpRoles = [Nominal, Nominal]
-    , coaxrRole      = Nominal
-    , coaxrProves    = \cs ->
-        do [Pair s1 s2, Pair t1 t2] <- return cs
-           s2' <- isReqTy1 s2
-           t2' <- isReqTy2 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
-    }
+-- Make a unary built-in constructor of kind: Nat -> Nat
+mkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon
+mkTypeNatFunTyCon1 op tcb =
+  mkFamilyTyCon op
+    (mkTemplateAnonTyConBinders [ naturalTy ])
+    naturalTy
+    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 [ naturalTy, naturalTy ])
+    naturalTy
+    Nothing
+    (BuiltInSynFamTyCon tcb)
+    Nothing
+    NotInjective
 
-{-------------------------------------------------------------------------------
-Evaluation
--------------------------------------------------------------------------------}
+-- 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
 
-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
-
-
-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 (lexicalCompareFS 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
-
-matchFamConsSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
-matchFamConsSymbol [s,t]
-  | Just x <- mbX, Just y <- mbY =
-    Just (axConsSymbolDef, [s,t], mkStrLitTy (consFS x y))
-  where
-  mbX = isCharLitTy s
-  mbY = isStrLitTy t
-matchFamConsSymbol _ = Nothing
+same :: Type -> Type -> Maybe ()
+same ty1 ty2 = guard (ty1 `tcEqType` ty2)
 
-computeUncons :: FastString -> Type
-computeUncons str = mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS str))
-  where reifyCharSymbolPairTy :: (Char, FastString) -> Type
-        reifyCharSymbolPairTy (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s)
-
-matchFamUnconsSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
-matchFamUnconsSymbol [s]
-  | Just x <- mbX =
-    Just (axUnconsSymbolDef, [s], computeUncons x)
-  where
-  mbX = isStrLitTy s
-matchFamUnconsSymbol _ = Nothing
-
-matchFamCharToNat :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
-matchFamCharToNat [c]
-  | Just c' <- isCharLitTy c, n <- charToInteger c'
-  = Just (axCharToNatDef, [c], mkNumLitTy n)
-  | otherwise = Nothing
-matchFamCharToNat _ = Nothing
-
-matchFamNatToChar :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
-matchFamNatToChar [n]
-  | Just n' <- isNumLitTy n, Just c <- integerToChar n'
-  = Just (axNatToCharDef, [n], mkCharLitTy c)
-  | otherwise = Nothing
-matchFamNatToChar _ = Nothing
+known :: Type -> (Integer -> Bool) -> Maybe Integer
+known x p = do { nx <- isNumLitTy x; guard (p nx); return nx }
 
 charToInteger :: Char -> Integer
 charToInteger c = fromIntegral (Char.ord c)
@@ -819,231 +1100,6 @@ integerToChar n | inBounds = Just (Char.chr (fromInteger n))
                    n <= charToInteger maxBound
 integerToChar _ = 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...
-
-
-
-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 _ _ = []
-
-interactTopConsSymbol :: [Xi] -> Xi -> [Pair Type]
-interactTopConsSymbol [s,t] r
-  -- ConsSymbol a b ~ "blah" => (a ~ 'b', b ~ "lah")
-  | Just fs <- isStrLitTy r
-  , Just (x, xs) <- unconsFS fs =
-    [ s === mkCharLitTy x, t === mkStrLitTy xs ]
-
-interactTopConsSymbol _ _ = []
-
-interactTopUnconsSymbol :: [Xi] -> Xi -> [Pair Type]
-interactTopUnconsSymbol [s] r
-  -- (UnconsSymbol b ~ Nothing) => (b ~ "")
-  | Just Nothing <- mbX =
-    [ s === mkStrLitTy nilFS ]
-  -- (UnconsSymbol b ~ Just ('f',"oobar")) => (b ~ "foobar")
-  | Just (Just r) <- mbX
-  , Just (c, str) <- isPromotedPairType r
-  , Just chr <- isCharLitTy c
-  , Just str1 <- isStrLitTy str =
-    [ s === (mkStrLitTy $ consFS chr str1) ]
-
-  where
-  mbX = isPromotedMaybeTy r
-
-interactTopUnconsSymbol _ _ = []
-
-interactTopCharToNat :: [Xi] -> Xi -> [Pair Type]
-interactTopCharToNat [s] r
-  -- (CharToNat c ~ 122) => (c ~ 'z')
-  | Just n <- isNumLitTy r
-  , Just c <- integerToChar n
-  = [ s === mkCharLitTy c ]
-interactTopCharToNat _ _ = []
-
-interactTopNatToChar :: [Xi] -> Xi -> [Pair Type]
-interactTopNatToChar [s] r
-  -- (NatToChar n ~ 'z') => (n ~ 122)
-  | Just c <- isCharLitTy r
-  = [ s === mkNumLitTy (charToInteger c) ]
-interactTopNatToChar _ _ = []
-
-{-------------------------------------------------------------------------------
-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 _ _ _ _ = []
-
-
-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 _ _ _ _ = []
-
-
-interactInertConsSymbol :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
-interactInertConsSymbol [x1, y1] z1 [x2, y2] z2
-  | sameZ         = [ x1 === x2, y1 === y2 ]
-  where sameZ = tcEqType z1 z2
-interactInertConsSymbol _ _ _ _ = []
-
-interactInertUnconsSymbol :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]
-interactInertUnconsSymbol [x1] z1 [x2] z2
-  | tcEqType z1 z2 = [ x1 === x2 ]
-interactInertUnconsSymbol _ _ _ _ = []
-
 
 {- -----------------------------------------------------------------------------
 These inverse functions are used for simplifying propositions using
@@ -1118,46 +1174,3 @@ genLog x base = Just (exactLoop 0 x)
     | i < base  = s
     | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)
 
------------------------------------------------------------------------------
-
-typeCharCmpTyCon :: TyCon
-typeCharCmpTyCon =
-  mkFamilyTyCon name
-    (mkTemplateAnonTyConBinders [ charTy, charTy ])
-    orderingKind
-    Nothing
-    (BuiltInSynFamTyCon ops)
-    Nothing
-    NotInjective
-  where
-  name = mkWiredInTyConName UserSyntax gHC_TYPELITS_INTERNAL (fsLit "CmpChar")
-                  typeCharCmpTyFamNameKey typeCharCmpTyCon
-  ops = BuiltInSynFamily
-      { sfMatchFam      = matchFamCmpChar
-      , sfInteractTop   = interactTopCmpChar
-      , sfInteractInert = \_ _ _ _ -> []
-      }
-
-interactTopCmpChar :: [Xi] -> Xi -> [Pair Type]
-interactTopCmpChar [s,t] r
-  | Just EQ <- isOrderingLitTy r = [ s === t ]
-interactTopCmpChar _ _ = []
-
-cmpChar :: Type -> Type -> Type
-cmpChar s t = mkTyConApp typeCharCmpTyCon [s,t]
-
-axCmpCharDef, axCmpCharRefl :: CoAxiomRule
-axCmpCharDef =
-  mkBinAxiom "CmpCharDef" typeCharCmpTyCon isCharLitTy isCharLitTy $
-    \chr1 chr2 -> Just $ ordering $ compare chr1 chr2
-axCmpCharRefl = mkAxiom1 "CmpCharRefl"
-  $ \(Pair s _) -> (cmpChar s s) === ordering EQ
-
-matchFamCmpChar :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
-matchFamCmpChar [s,t]
-  | Just x <- mbX, Just y <- mbY =
-    Just (axCmpCharDef, [s,t], ordering (compare x y))
-  | tcEqType s t = Just (axCmpCharRefl, [s], ordering EQ)
-  where mbX = isCharLitTy s
-        mbY = isCharLitTy t
-matchFamCmpChar _ = Nothing

compiler/GHC/Builtin/Types/Prim.hs

@@ -63,7 +63,8 @@ module GHC.Builtin.Types.Prim(
         doublePrimTyCon,        doublePrimTy, doublePrimTyConName,
 
         statePrimTyCon,         mkStatePrimTy,
-        realWorldTyCon,         realWorldTy, realWorldStatePrimTy,
+        realWorldTyCon,         realWorldTy,
+        realWorldStatePrimTy,   realWorldMutableByteArrayPrimTy,
 
         proxyPrimTyCon,         mkProxyPrimTy,
 
@@ -1016,7 +1017,7 @@ Let's take these one at a time:
     --------------------------
 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
+It responds "yes" to Type.isEqPred and classifies as an EqPred in
 Type.classifyPredType.
 
 All wanted constraints of this type are built with coercion holes.
@@ -1178,7 +1179,9 @@ realWorldTy :: Type
 realWorldTy          = mkTyConTy realWorldTyCon
 realWorldStatePrimTy :: Type
 realWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld
-
+realWorldMutableByteArrayPrimTy :: Type
+realWorldMutableByteArrayPrimTy
+  = mkMutableByteArrayPrimTy realWorldTy -- MutableByteArray# RealWorld
 
 mkProxyPrimTy :: Type -> Type -> Type
 mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]

compiler/GHC/Builtin/Uniques.hs

@@ -14,16 +14,19 @@ module GHC.Builtin.Uniques
       -- * Getting the 'Unique's of 'Name's
       -- ** Anonymous sums
     , mkSumTyConUnique, mkSumDataConUnique
+    , isSumTyConUnique
 
       -- ** Tuples
       -- *** Vanilla
     , mkTupleTyConUnique
     , mkTupleDataConUnique
     , isTupleTyConUnique
+    , isTupleDataConLikeUnique
       -- *** Constraint
     , mkCTupleTyConUnique
     , mkCTupleDataConUnique
     , mkCTupleSelIdUnique
+    , isCTupleTyConUnique
 
       -- ** Making built-in uniques
     , mkAlphaTyVarUnique
@@ -120,6 +123,15 @@ mkSumTyConUnique arity =
               -- alternative
     mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc)
 
+-- | Inverse of 'mkSumTyConUnique'
+isSumTyConUnique :: Unique -> Maybe Arity
+isSumTyConUnique u =
+  case (tag, n .&. 0xfc) of
+    ('z', 0xfc) -> Just (word64ToInt n `shiftR` 8)
+    _ -> Nothing
+  where
+    (tag, n) = unpkUnique u
+
 mkSumDataConUnique :: ConTagZ -> Arity -> Unique
 mkSumDataConUnique alt arity
   | alt >= arity
@@ -224,6 +236,17 @@ mkCTupleSelIdUnique sc_pos arity
   | otherwise
   = mkUniqueInt 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos)
 
+-- | Inverse of 'mkCTupleTyConUnique'
+isCTupleTyConUnique :: Unique -> Maybe Arity
+isCTupleTyConUnique u =
+  case (tag, i) of
+    ('k', 0) -> Just arity
+    _        -> Nothing
+  where
+    (tag, n) = unpkUnique u
+    (arity', i) = quotRem n 2
+    arity = word64ToInt arity'
+
 getCTupleTyConName :: Int -> Name
 getCTupleTyConName n =
     case n `divMod` 2 of
@@ -272,7 +295,7 @@ mkTupleTyConUnique :: Boxity -> Arity -> Unique
 mkTupleTyConUnique Boxed           a  = mkUniqueInt '4' (2*a)
 mkTupleTyConUnique Unboxed         a  = mkUniqueInt '5' (2*a)
 
--- | This function is an inverse of `mkTupleTyConUnique`
+-- | Inverse of 'mkTupleTyConUnique'
 isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity)
 isTupleTyConUnique u =
   case (tag, i) of
@@ -284,6 +307,18 @@ isTupleTyConUnique u =
     (arity', i) = quotRem n 2
     arity = word64ToInt arity'
 
+-- | Inverse of 'mkTupleTyDataUnique' that also matches the worker and promoted tycon.
+isTupleDataConLikeUnique :: Unique -> Maybe (Boxity, Arity)
+isTupleDataConLikeUnique u =
+  case tag of
+    '7' -> Just (Boxed,   arity)
+    '8' -> Just (Unboxed, arity)
+    _ -> Nothing
+  where
+    (tag,   n) = unpkUnique u
+    (arity', _) = quotRem n 3
+    arity = word64ToInt arity'
+
 getTupleTyConName :: Boxity -> Int -> Name
 getTupleTyConName boxity n =
     case n `divMod` 2 of

compiler/GHC/Builtin/Utils.hs

@@ -34,6 +34,8 @@ module GHC.Builtin.Utils (
 
         ghcPrimExports,
         ghcPrimDeclDocs,
+        ghcPrimWarns,
+        ghcPrimFixities,
 
         -- * Random other things
         maybeCharLikeCon, maybeIntLikeCon,
@@ -61,9 +63,11 @@ import GHC.Core.TyCon
 
 import GHC.Types.Avail
 import GHC.Types.Id
+import GHC.Types.Fixity
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Id.Make
+import GHC.Types.SourceText
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Map
 import GHC.Types.TyThing
@@ -73,13 +77,14 @@ import GHC.Utils.Outputable
 import GHC.Utils.Misc as Utils
 import GHC.Utils.Panic
 import GHC.Utils.Constants (debugIsOn)
+import GHC.Parser.Annotation
 import GHC.Hs.Doc
 import GHC.Unit.Module.ModIface (IfaceExport)
+import GHC.Unit.Module.Warnings
 
 import GHC.Data.List.SetOps
 
 import Control.Applicative ((<|>))
-import Data.List        ( find )
 import Data.Maybe
 
 {-
@@ -242,14 +247,69 @@ ghcPrimExports
 ghcPrimDeclDocs :: Docs
 ghcPrimDeclDocs = emptyDocs { docs_decls = listToUniqMap $ mapMaybe findName primOpDocs }
   where
-    names = map idName ghcPrimIds ++
-            map idName allThePrimOpIds ++
-            map tyConName exposedPrimTyCons
     findName (nameStr, doc)
-      | Just name <- find ((nameStr ==) . getOccString) names
+      | Just name <- lookupFsEnv ghcPrimNames nameStr
       = Just (name, [WithHsDocIdentifiers (mkGeneratedHsDocString doc) []])
       | otherwise = Nothing
 
+ghcPrimNames :: FastStringEnv Name
+ghcPrimNames
+  = mkFsEnv
+    [ (occNameFS $ nameOccName name, name)
+    | name <-
+        map idName ghcPrimIds ++
+        map idName allThePrimOpIds ++
+        map tyConName exposedPrimTyCons
+    ]
+
+-- See Note [GHC.Prim Deprecations]
+ghcPrimWarns :: Warnings a
+ghcPrimWarns = WarnSome
+  -- declaration warnings
+  (map mk_decl_dep primOpDeprecations)
+  -- export warnings
+  []
+  where
+    mk_txt msg =
+      DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText msg Nothing) []]
+    mk_decl_dep (occ, msg) = (occ, mk_txt msg)
+
+ghcPrimFixities :: [(OccName,Fixity)]
+ghcPrimFixities = fixities
+  where
+    -- The fixity listed here for @`seq`@ should match
+    -- those in primops.txt.pp (from which Haddock docs are generated).
+    fixities = (getOccName seqId, Fixity 0 InfixR)
+             : mapMaybe mkFixity allThePrimOps
+    mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
+
+{-
+Note [GHC.Prim Docs]
+~~~~~~~~~~~~~~~~~~~~
+For haddocks of GHC.Prim we generate a dummy haskell file (gen_hs_source) that
+contains the type signatures and the comments (but no implementations)
+specifically for consumption by haddock.
+
+GHCi's :doc command reads directly from ModIface's though, and GHC.Prim has a
+wired-in iface that has nothing to do with the above haskell file. The code
+below converts primops.txt into an intermediate form that would later be turned
+into a proper DeclDocMap.
+
+We output the docs as a list of pairs (name, docs). We use stringy names here
+because mapping names to "Name"s is difficult for things like primtypes and
+pseudoops.
+
+Note [GHC.Prim Deprecations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Like Haddock documentation, we must record deprecation pragmas in two places:
+in the GHC.Prim source module consumed by Haddock, and in the
+declarations wired-in to GHC. To do the following we generate
+GHC.Builtin.PrimOps.primOpDeprecations, a list of (OccName, DeprecationMessage)
+pairs. We insert these deprecations into the mi_warns field of GHC.Prim's ModIface,
+as though they were written in a source module.
+-}
+
+
 {-
 ************************************************************************
 *                                                                      *