.gitlab-ci.yml

@@ -603,7 +603,7 @@ validate-x86_64-linux-deb9-integer-simple:
   stage: full-build
   variables:
     BUILD_FLAVOUR: validate
-    INTEGER_LIBRARY: integer-simple
+    BIGNUM_BACKEND: native
     TEST_ENV: "x86_64-linux-deb9-integer-simple-validate"
     BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-integer-simple.tar.xz"
 
@@ -612,7 +612,7 @@ nightly-x86_64-linux-deb9-integer-simple:
   extends: .build-x86_64-linux-deb9
   stage: full-build
   variables:
-    INTEGER_LIBRARY: integer-simple
+    BIGNUM_BACKEND: native
     TEST_ENV: "x86_64-linux-deb9-integer-simple"
     TEST_TYPE: slowtest
 
@@ -879,7 +879,7 @@ release-x86_64-windows-integer-simple:
   <<: *release
   extends: validate-x86_64-windows
   variables:
-    INTEGER_LIBRARY: integer-simple
+    BIGNUM_BACKEND: native
     BUILD_FLAVOUR: "perf"
 
 

.gitlab/ci.sh

@@ -285,7 +285,7 @@ function prepare_build_mk() {
   if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi
   if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi
   if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi
-  if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi
+  if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi
 
   cat > mk/build.mk <<EOF
 V=1
@@ -295,7 +295,7 @@ HSCOLOUR_SRCS=YES
 BUILD_SPHINX_HTML=$BUILD_SPHINX_HTML
 BUILD_SPHINX_PDF=$BUILD_SPHINX_PDF
 BeConservative=YES
-INTEGER_LIBRARY=$INTEGER_LIBRARY
+BIGNUM_BACKEND=$BIGNUM_BACKEND
 XZ_CMD=$XZ
 
 BuildFlavour=$BUILD_FLAVOUR

.gitlab/test-metrics.sh

@@ -24,9 +24,10 @@ function pull() {
 
 function setup_ssh() {
   # Add gitlab as a known host.
+  # This can be generated with `ssh-keyscan -H gitlab.haskell.org`
   mkdir -p ~/.ssh
-  echo "|1|+AUrMGS1elvPeLNt+NHGa5+c6pU=|4XvfRsQftO1OgZD4c0JJ7oNaii8= ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDXilA5l4kOZPx0nM6xDATF+t4fS6te0eYPDwBI/jLWD9cJVtCnsrwMl5ar+/NfmcD0jnCYztUiVHuXyTaWPJYSQpwltfpTeqpo9/z/0MxkPtSl1uMP2cLbDiqA01OWveChktOXwU6hRQ+7MmO+dNRS/iXrRmYrGv/p1W811QgLBLS9fefEdF25n+0dP71L7Ov7riOawlDmd0C11FraE/R8HX6gs6lbXta1kisdxGyKojYSiCtobUaJxRoatMfUP0a9rwTAyl8tf56LgB+igjMky879VAbL7eQ/AmfHYPrSGJ/YlWP6Jj23Dnos5nOVlWL/rVTs9Y/NakLpPwMs75KTC0Pd74hdf2e3folDdAi2kLrQgO2SI6so7rOYZ+mFkCM751QdDVy4DzjmDvSgSIVf9SV7RQf7e7unE7pSZ/ILupZqz9KhR1MOwVO+ePa5qJMNSdC204PIsRWkIO5KP0QLl507NI9Ri84+aODoHD7gDIWNhU08J2P8/E6r0wcC8uWaxh+HaOjI9BkHjqRYsrgfn54BAuO9kw1cDvyi3c8n7VFlNtvQP15lANwim3gr9upV+r95KEPJCgZMYWJBDPIVtp4GdYxCfXxWj5oMXbA5pf0tNixwNJjAsY7I6RN2htHbuySH36JybOZk+gCj6mQkxpCT/tKaUn14hBJWLq7Q+Q==" >> ~/.ssh/known_hosts
-  echo "|1|JZkdAPJmpX6SzGeqhmQLfMWLGQA=|4vTELroOlbFxbCr0WX+PK9EcpD0= ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIJknufU+I6A5Nm58lmse4/o11Ai2UzYbYe7782J1+kRk" >> ~/.ssh/known_hosts
+  echo "|1|cta91z3DoAGdpX2Epe9WF+sr+Rk=|1qlsbqiTTa8YsDyQBjVnzANFQ3Y= ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDSzzl8mwY6ohtW6MftKaQfta8yTL8cTxtA7lcueo2mkPpwBBQ7FA6z3nFATx25QwdV7fa7DuNRDX57f/a/W7+wMhXZ6yyQr+gwr0h4vdZ8Nt4XNfNdkdGw4fZKRApWxyvfSkxjs/E9+G0o3eQLspxjVohBkmkcsowpFUI5Aazv/K6QIf1gKt+4iPvYcB/dBJ1yF1qmpayz4htrKyUC5l3GCBEwvMdAjIQ2bX8pyjTtqcJDLosAVzQ5wprkdgkL29MgJXEbM+B1d1log0hnX4AsbOlL7tWhTO1Je2hSuEeiVaDDPFUyCoGQRFDrisQU5lb8NrzuN3jpNc+PxOHbXHfaTppAoED/++UepvgtLF1zUM13cRk56YmpmABOa48W72VJuzLLm8DF+KBWBs6TDuVk3y9z/SS6zDS0VGkHotldopW2kpsjErJIdWVKIL3RP/Flay7mzl3l/izIMTHXXKMxV3/+XaBjG/gDOCld3JjORQXah2hvJfvXeNaePE1RKAMS63cj3XTE77fsYH7VmEdE34RTBDtsZR5WhEjdf29hjEcQDPf0vDphxRHr6IqUSwVcd7ps6nVoccTfaepJm62IIXDgOsc2piWl2xXNZJVtph6U+MzsPDSSbu1MTwalwgqpApcYK7ZzUjGHA7+NBhjjSuUZO6eHzwxjAn0FXZyrpQ==" >> ~/.ssh/known_hosts
+  echo "|1|uZkjsBS2bmdh7L/8zBquxJd/F20=|by/tpuDAPT6BpEXrDOiOv1/Zx/A= ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIA7ltOZyaULDgxE3Vw6RgQVp+OPKQi79ssUenbhdWy36" >> ~/.ssh/known_hosts
 
   # Setup ssh keys.
   eval `ssh-agent`

.gitmodules

@@ -105,7 +105,7 @@
 	url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
 	ignore = untracked
 [submodule "gmp-tarballs"]
-	path = libraries/integer-gmp/gmp/gmp-tarballs
+	path = libraries/ghc-bignum/gmp/gmp-tarballs
 	url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
 [submodule "libraries/exceptions"]
 	path = libraries/exceptions

aclocal.m4

@@ -1333,7 +1333,7 @@ AC_DEFUN([FP_GCC_VERSION], [
     AC_MSG_ERROR([C compiler is required])
   fi
 
-  if $CC --version | grep --quiet gcc; then
+  if $CC --version | grep -q gcc; then
     AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version],
     [
         # Be sure only to look at the first occurrence of the "version " string;
@@ -1875,7 +1875,6 @@ AC_DEFUN([FP_CURSES],
       [directory containing curses libraries])],
       [CURSES_LIB_DIRS=$withval])
 
-  AC_SUBST(CURSES_INCLUDE_DIRS)
   AC_SUBST(CURSES_LIB_DIRS)
 ])# FP_CURSES
 
@@ -1919,7 +1918,9 @@ AC_MSG_CHECKING(for path to top of build tree)
 
 # GHC_CONVERT_CPU(cpu, target_var)
 # --------------------------------
-# converts cpu from gnu to ghc naming, and assigns the result to $target_var
+# Converts cpu from gnu to ghc naming, and assigns the result to $target_var.
+# Should you modify this list, you are invited to reflect the changes in 
+# `libraries/base/System/Info.hs`'s documentation.
 AC_DEFUN([GHC_CONVERT_CPU],[
 case "$1" in
   aarch64*)

compiler/GHC.hs

@@ -197,7 +197,7 @@ module GHC (
         -- ** Data constructors
         DataCon,
         dataConType, dataConTyCon, dataConFieldLabels,
-        dataConIsInfix, isVanillaDataCon, dataConUserType,
+        dataConIsInfix, isVanillaDataCon, dataConWrapperType,
         dataConSrcBangs,
         StrictnessMark(..), isMarkedStrict,
 
@@ -545,7 +545,7 @@ checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
 checkBrokenTablesNextToCode' dflags
   | not (isARM arch)                 = return False
   | WayDyn `S.notMember` ways dflags = return False
-  | not (tablesNextToCode dflags)    = return False
+  | not tablesNextToCode             = return False
   | otherwise                        = do
     linkerInfo <- liftIO $ getLinkerInfo dflags
     case linkerInfo of
@@ -553,6 +553,7 @@ checkBrokenTablesNextToCode' dflags
       _        -> return False
   where platform = targetPlatform dflags
         arch = platformArch platform
+        tablesNextToCode = platformTablesNextToCode platform
 
 
 -- %************************************************************************
@@ -604,10 +605,12 @@ setSessionDynFlags dflags = do
     then do
          let
            prog = pgm_i dflags ++ flavour
+           profiled = ways dflags `hasWay` WayProf
+           dynamic  = ways dflags `hasWay` WayDyn
            flavour
-             | WayProf `S.member` ways dflags = "-prof"
-             | WayDyn `S.member` ways dflags  = "-dyn"
-             | otherwise                      = ""
+             | profiled  = "-prof" -- FIXME: can't we have both?
+             | dynamic   = "-dyn"
+             | otherwise = ""
            msg = text "Starting " <> text prog
          tr <- if verbosity dflags >= 3
                 then return (logInfo dflags $ withPprStyle defaultDumpStyle msg)
@@ -616,8 +619,8 @@ setSessionDynFlags dflags = do
           conf = IServConfig
             { iservConfProgram  = prog
             , iservConfOpts     = getOpts dflags opt_i
-            , iservConfProfiled = gopt Opt_SccProfilingOn dflags
-            , iservConfDynamic  = WayDyn `S.member` ways dflags
+            , iservConfProfiled = profiled
+            , iservConfDynamic  = dynamic
             , iservConfHook     = createIservProcessHook (hooks dflags)
             , iservConfTrace    = tr
             }
@@ -1009,7 +1012,7 @@ desugarModule tcm = do
 --
 -- A module must be loaded before dependent modules can be typechecked.  This
 -- always includes generating a 'ModIface' and, depending on the
--- 'DynFlags.hscTarget', may also include code generation.
+-- @DynFlags@\'s 'GHC.Driver.Session.hscTarget', may also include code generation.
 --
 -- This function will always cause recompilation and will always overwrite
 -- previous compilation results (potentially files on disk).
@@ -1144,7 +1147,7 @@ compileCore simplify fn = do
 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
 getModuleGraph = liftM hsc_mod_graph getSession
 
--- | Return @True@ <==> module is loaded.
+-- | Return @True@ \<==> module is loaded.
 isLoaded :: GhcMonad m => ModuleName -> m Bool
 isLoaded m = withSession $ \hsc_env ->
   return $! isJust (lookupHpt (hsc_HPT hsc_env) m)

compiler/GHC/Builtin/Names.hs

@@ -374,31 +374,57 @@ basicKnownKeyNames
         printName, fstName, sndName,
         dollarName,
 
-        -- Integer
-        integerTyConName, mkIntegerName,
-        integerToWord64Name, integerToInt64Name,
-        word64ToIntegerName, int64ToIntegerName,
-        plusIntegerName, timesIntegerName, smallIntegerName,
-        wordToIntegerName,
-        integerToWordName, integerToIntName, minusIntegerName,
-        negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
-        absIntegerName, signumIntegerName,
-        leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
-        compareIntegerName, quotRemIntegerName, divModIntegerName,
-        quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
-        floatFromIntegerName, doubleFromIntegerName,
-        encodeFloatIntegerName, encodeDoubleIntegerName,
-        decodeDoubleIntegerName,
-        gcdIntegerName, lcmIntegerName,
-        andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
-        shiftLIntegerName, shiftRIntegerName, bitIntegerName,
-        integerSDataConName,naturalSDataConName,
-
-        -- Natural
-        naturalTyConName,
-        naturalFromIntegerName, naturalToIntegerName,
-        plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName,
-        wordToNaturalName,
+        -- ghc-bignum
+        integerFromNaturalName,
+        integerToNaturalClampName,
+        integerToWordName,
+        integerToIntName,
+        integerToWord64Name,
+        integerToInt64Name,
+        integerFromWordName,
+        integerFromWord64Name,
+        integerFromInt64Name,
+        integerAddName,
+        integerMulName,
+        integerSubName,
+        integerNegateName,
+        integerEqPrimName,
+        integerNePrimName,
+        integerLePrimName,
+        integerGtPrimName,
+        integerLtPrimName,
+        integerGePrimName,
+        integerAbsName,
+        integerSignumName,
+        integerCompareName,
+        integerQuotName,
+        integerRemName,
+        integerDivName,
+        integerModName,
+        integerDivModName,
+        integerQuotRemName,
+        integerToFloatName,
+        integerToDoubleName,
+        integerEncodeFloatName,
+        integerEncodeDoubleName,
+        integerDecodeDoubleName,
+        integerGcdName,
+        integerLcmName,
+        integerAndName,
+        integerOrName,
+        integerXorName,
+        integerComplementName,
+        integerBitName,
+        integerShiftLName,
+        integerShiftRName,
+        naturalToWordName,
+        naturalAddName,
+        naturalSubName,
+        naturalMulName,
+        naturalQuotName,
+        naturalRemName,
+        naturalQuotRemName,
+        bignatFromWordListName,
 
         -- Float/Double
         rationalToFloatName,
@@ -507,10 +533,12 @@ genericTyConNames = [
 pRELUDE :: Module
 pRELUDE         = mkBaseModule_ pRELUDE_NAME
 
-gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
+gHC_PRIM, gHC_PRIM_PANIC, gHC_PRIM_EXCEPTION,
+    gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
     gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
     gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
-    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
+    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE,
+    gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT,
     gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING,
     dATA_FOLDABLE, dATA_TRAVERSABLE,
     gHC_CONC, gHC_IO, gHC_IO_Exception,
@@ -524,6 +552,7 @@ gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
 
 gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
 gHC_PRIM_PANIC  = mkPrimModule (fsLit "GHC.Prim.Panic")
+gHC_PRIM_EXCEPTION = mkPrimModule (fsLit "GHC.Prim.Exception")
 gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
 gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
 gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")
@@ -538,8 +567,9 @@ gHC_SHOW        = mkBaseModule (fsLit "GHC.Show")
 gHC_READ        = mkBaseModule (fsLit "GHC.Read")
 gHC_NUM         = mkBaseModule (fsLit "GHC.Num")
 gHC_MAYBE       = mkBaseModule (fsLit "GHC.Maybe")
-gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type")
-gHC_NATURAL     = mkBaseModule (fsLit "GHC.Natural")
+gHC_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")
 dATA_TUPLE      = mkBaseModule (fsLit "Data.Tuple")
@@ -627,8 +657,8 @@ dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim"
 mkPrimModule :: FastString -> Module
 mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
 
-mkIntegerModule :: FastString -> Module
-mkIntegerModule m = mkModule integerUnit (mkModuleNameFS m)
+mkBignumModule :: FastString -> Module
+mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m)
 
 mkBaseModule :: FastString -> Module
 mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)
@@ -707,10 +737,10 @@ enumFromTo_RDR          = nameRdrName enumFromToName
 enumFromThen_RDR        = nameRdrName enumFromThenName
 enumFromThenTo_RDR      = nameRdrName enumFromThenToName
 
-ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName
+ratioDataCon_RDR, integerAdd_RDR, integerMul_RDR :: RdrName
 ratioDataCon_RDR        = nameRdrName ratioDataConName
-plusInteger_RDR         = nameRdrName plusIntegerName
-timesInteger_RDR        = nameRdrName timesIntegerName
+integerAdd_RDR          = nameRdrName integerAddName
+integerMul_RDR          = nameRdrName integerMulName
 
 ioDataCon_RDR :: RdrName
 ioDataCon_RDR           = nameRdrName ioDataConName
@@ -1118,84 +1148,125 @@ fromIntegerName   = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
 minusName         = varQual gHC_NUM (fsLit "-")           minusClassOpKey
 negateName        = varQual gHC_NUM (fsLit "negate")      negateClassOpKey
 
-integerTyConName, mkIntegerName, integerSDataConName,
-    integerToWord64Name, integerToInt64Name,
-    word64ToIntegerName, int64ToIntegerName,
-    plusIntegerName, timesIntegerName, smallIntegerName,
-    wordToIntegerName,
-    integerToWordName, integerToIntName, minusIntegerName,
-    negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
-    absIntegerName, signumIntegerName,
-    leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
-    compareIntegerName, quotRemIntegerName, divModIntegerName,
-    quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
-    floatFromIntegerName, doubleFromIntegerName,
-    encodeFloatIntegerName, encodeDoubleIntegerName,
-    decodeDoubleIntegerName,
-    gcdIntegerName, lcmIntegerName,
-    andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
-    shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name
-integerTyConName      = tcQual gHC_INTEGER_TYPE (fsLit "Integer")           integerTyConKey
-integerSDataConName   = dcQual gHC_INTEGER_TYPE (fsLit "S#")                integerSDataConKey
-mkIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "mkInteger")         mkIntegerIdKey
-integerToWord64Name   = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64")   integerToWord64IdKey
-integerToInt64Name    = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64")    integerToInt64IdKey
-word64ToIntegerName   = varQual gHC_INTEGER_TYPE (fsLit "word64ToInteger")   word64ToIntegerIdKey
-int64ToIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "int64ToInteger")    int64ToIntegerIdKey
-plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey
-timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey
-smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey
-wordToIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger")     wordToIntegerIdKey
-integerToWordName     = varQual gHC_INTEGER_TYPE (fsLit "integerToWord")     integerToWordIdKey
-integerToIntName      = varQual gHC_INTEGER_TYPE (fsLit "integerToInt")      integerToIntIdKey
-minusIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "minusInteger")      minusIntegerIdKey
-negateIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "negateInteger")     negateIntegerIdKey
-eqIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "eqInteger#")        eqIntegerPrimIdKey
-neqIntegerPrimName    = varQual gHC_INTEGER_TYPE (fsLit "neqInteger#")       neqIntegerPrimIdKey
-absIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "absInteger")        absIntegerIdKey
-signumIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "signumInteger")     signumIntegerIdKey
-leIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "leInteger#")        leIntegerPrimIdKey
-gtIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "gtInteger#")        gtIntegerPrimIdKey
-ltIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "ltInteger#")        ltIntegerPrimIdKey
-geIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "geInteger#")        geIntegerPrimIdKey
-compareIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "compareInteger")    compareIntegerIdKey
-quotRemIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger")    quotRemIntegerIdKey
-divModIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "divModInteger")     divModIntegerIdKey
-quotIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "quotInteger")       quotIntegerIdKey
-remIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "remInteger")        remIntegerIdKey
-divIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "divInteger")        divIntegerIdKey
-modIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "modInteger")        modIntegerIdKey
-floatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger")      floatFromIntegerIdKey
-doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger")     doubleFromIntegerIdKey
-encodeFloatIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger")  encodeFloatIntegerIdKey
-encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey
-decodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "decodeDoubleInteger") decodeDoubleIntegerIdKey
-gcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger")        gcdIntegerIdKey
-lcmIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger")        lcmIntegerIdKey
-andIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "andInteger")        andIntegerIdKey
-orIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "orInteger")         orIntegerIdKey
-xorIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "xorInteger")        xorIntegerIdKey
-complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey
-shiftLIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger")     shiftLIntegerIdKey
-shiftRIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger")     shiftRIntegerIdKey
-bitIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "bitInteger")        bitIntegerIdKey
-
--- GHC.Natural types
-naturalTyConName, naturalSDataConName :: Name
-naturalTyConName     = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey
-naturalSDataConName  = dcQual gHC_NATURAL (fsLit "NatS#")   naturalSDataConKey
-
-naturalFromIntegerName :: Name
-naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey
-
-naturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName,
-   mkNaturalName, wordToNaturalName :: Name
-naturalToIntegerName  = varQual gHC_NATURAL (fsLit "naturalToInteger")  naturalToIntegerIdKey
-plusNaturalName       = varQual gHC_NATURAL (fsLit "plusNatural")       plusNaturalIdKey
-minusNaturalName      = varQual gHC_NATURAL (fsLit "minusNatural")      minusNaturalIdKey
-timesNaturalName      = varQual gHC_NATURAL (fsLit "timesNatural")      timesNaturalIdKey
-mkNaturalName         = varQual gHC_NATURAL (fsLit "mkNatural")         mkNaturalIdKey
-wordToNaturalName     = varQual gHC_NATURAL (fsLit "wordToNatural#")    wordToNaturalIdKey
+---------------------------------
+-- ghc-bignum
+---------------------------------
+integerFromNaturalName
+   , integerToNaturalClampName
+   , integerToWordName
+   , integerToIntName
+   , integerToWord64Name
+   , integerToInt64Name
+   , integerFromWordName
+   , integerFromWord64Name
+   , integerFromInt64Name
+   , integerAddName
+   , integerMulName
+   , integerSubName
+   , integerNegateName
+   , integerEqPrimName
+   , integerNePrimName
+   , integerLePrimName
+   , integerGtPrimName
+   , integerLtPrimName
+   , integerGePrimName
+   , integerAbsName
+   , integerSignumName
+   , integerCompareName
+   , integerQuotName
+   , integerRemName
+   , integerDivName
+   , integerModName
+   , integerDivModName
+   , integerQuotRemName
+   , integerToFloatName
+   , integerToDoubleName
+   , integerEncodeFloatName
+   , integerEncodeDoubleName
+   , integerDecodeDoubleName
+   , integerGcdName
+   , integerLcmName
+   , integerAndName
+   , integerOrName
+   , integerXorName
+   , integerComplementName
+   , integerBitName
+   , integerShiftLName
+   , integerShiftRName
+   , naturalToWordName
+   , naturalAddName
+   , naturalSubName
+   , naturalMulName
+   , naturalQuotName
+   , naturalRemName
+   , naturalQuotRemName
+   , bignatFromWordListName
+   :: 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
+
+-- Types and DataCons
+bignatFromWordListName    = bnbVarQual "bigNatFromWordList#"       bignatFromWordListIdKey
+
+naturalToWordName         = bnnVarQual "naturalToWord#"            naturalToWordIdKey
+naturalAddName            = bnnVarQual "naturalAdd"                naturalAddIdKey
+naturalSubName            = bnnVarQual "naturalSubUnsafe"          naturalSubIdKey
+naturalMulName            = bnnVarQual "naturalMul"                naturalMulIdKey
+naturalQuotName           = bnnVarQual "naturalQuot"               naturalQuotIdKey
+naturalRemName            = bnnVarQual "naturalRem"                naturalRemIdKey
+naturalQuotRemName        = bnnVarQual "naturalQuotRem"            naturalQuotRemIdKey
+
+integerFromNaturalName    = bniVarQual "integerFromNatural"        integerFromNaturalIdKey
+integerToNaturalClampName = bniVarQual "integerToNaturalClamp"     integerToNaturalClampIdKey
+integerToWordName         = bniVarQual "integerToWord#"            integerToWordIdKey
+integerToIntName          = bniVarQual "integerToInt#"             integerToIntIdKey
+integerToWord64Name       = bniVarQual "integerToWord64#"          integerToWord64IdKey
+integerToInt64Name        = bniVarQual "integerToInt64#"           integerToInt64IdKey
+integerFromWordName       = bniVarQual "integerFromWord#"          integerFromWordIdKey
+integerFromWord64Name     = bniVarQual "integerFromWord64#"        integerFromWord64IdKey
+integerFromInt64Name      = bniVarQual "integerFromInt64#"         integerFromInt64IdKey
+integerAddName            = bniVarQual "integerAdd"                integerAddIdKey
+integerMulName            = bniVarQual "integerMul"                integerMulIdKey
+integerSubName            = bniVarQual "integerSub"                integerSubIdKey
+integerNegateName         = bniVarQual "integerNegate"             integerNegateIdKey
+integerEqPrimName         = bniVarQual "integerEq#"                integerEqPrimIdKey
+integerNePrimName         = bniVarQual "integerNe#"                integerNePrimIdKey
+integerLePrimName         = bniVarQual "integerLe#"                integerLePrimIdKey
+integerGtPrimName         = bniVarQual "integerGt#"                integerGtPrimIdKey
+integerLtPrimName         = bniVarQual "integerLt#"                integerLtPrimIdKey
+integerGePrimName         = bniVarQual "integerGe#"                integerGePrimIdKey
+integerAbsName            = bniVarQual "integerAbs"                integerAbsIdKey
+integerSignumName         = bniVarQual "integerSignum"             integerSignumIdKey
+integerCompareName        = bniVarQual "integerCompare"            integerCompareIdKey
+integerQuotName           = bniVarQual "integerQuot"               integerQuotIdKey
+integerRemName            = bniVarQual "integerRem"                integerRemIdKey
+integerDivName            = bniVarQual "integerDiv"                integerDivIdKey
+integerModName            = bniVarQual "integerMod"                integerModIdKey
+integerDivModName         = bniVarQual "integerDivMod#"            integerDivModIdKey
+integerQuotRemName        = bniVarQual "integerQuotRem#"           integerQuotRemIdKey
+integerToFloatName        = bniVarQual "integerToFloat#"           integerToFloatIdKey
+integerToDoubleName       = bniVarQual "integerToDouble#"          integerToDoubleIdKey
+integerEncodeFloatName    = bniVarQual "integerEncodeFloat#"       integerEncodeFloatIdKey
+integerEncodeDoubleName   = bniVarQual "integerEncodeDouble#"      integerEncodeDoubleIdKey
+integerDecodeDoubleName   = bniVarQual "integerDecodeDouble#"      integerDecodeDoubleIdKey
+integerGcdName            = bniVarQual "integerGcd"                integerGcdIdKey
+integerLcmName            = bniVarQual "integerLcm"                integerLcmIdKey
+integerAndName            = bniVarQual "integerAnd"                integerAndIdKey
+integerOrName             = bniVarQual "integerOr"                 integerOrIdKey
+integerXorName            = bniVarQual "integerXor"                integerXorIdKey
+integerComplementName     = bniVarQual "integerComplement"         integerComplementIdKey
+integerBitName            = bniVarQual "integerBit#"               integerBitIdKey
+integerShiftLName         = bniVarQual "integerShiftL#"            integerShiftLIdKey
+integerShiftRName         = bniVarQual "integerShiftR#"            integerShiftRIdKey
+
+
+
+---------------------------------
+-- End of ghc-bignum
+---------------------------------
 
 -- GHC.Real types and classes
 rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
@@ -1901,6 +1972,15 @@ typeSymbolAppendFamNameKey = mkPreludeTyConUnique 190
 unsafeEqualityTyConKey :: Unique
 unsafeEqualityTyConKey = mkPreludeTyConUnique 191
 
+-- Linear types
+multiplicityTyConKey :: Unique
+multiplicityTyConKey = mkPreludeTyConUnique 192
+
+unrestrictedFunTyConKey :: Unique
+unrestrictedFunTyConKey = mkPreludeTyConUnique 193
+
+multMulTyConKey :: Unique
+multMulTyConKey = mkPreludeTyConUnique 194
 
 ---------------- Template Haskell -------------------
 --      GHC.Builtin.Names.TH: USES TyConUniques 200-299
@@ -1921,9 +2001,9 @@ unsafeEqualityTyConKey = mkPreludeTyConUnique 191
 -}
 
 charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,
-    floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,
+    floatDataConKey, intDataConKey, nilDataConKey,
     ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,
-    word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,
+    word8DataConKey, ioDataConKey, heqDataConKey,
     coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique
 
 charDataConKey                          = mkPreludeDataConUnique  1
@@ -1932,19 +2012,17 @@ doubleDataConKey                        = mkPreludeDataConUnique  3
 falseDataConKey                         = mkPreludeDataConUnique  4
 floatDataConKey                         = mkPreludeDataConUnique  5
 intDataConKey                           = mkPreludeDataConUnique  6
-integerSDataConKey                      = mkPreludeDataConUnique  7
-nothingDataConKey                       = mkPreludeDataConUnique  8
-justDataConKey                          = mkPreludeDataConUnique  9
-eqDataConKey                            = mkPreludeDataConUnique 10
-nilDataConKey                           = mkPreludeDataConUnique 11
-ratioDataConKey                         = mkPreludeDataConUnique 12
-word8DataConKey                         = mkPreludeDataConUnique 13
-stableNameDataConKey                    = mkPreludeDataConUnique 14
-trueDataConKey                          = mkPreludeDataConUnique 15
-wordDataConKey                          = mkPreludeDataConUnique 16
-ioDataConKey                            = mkPreludeDataConUnique 17
-integerDataConKey                       = mkPreludeDataConUnique 18
-heqDataConKey                           = mkPreludeDataConUnique 19
+nothingDataConKey                       = mkPreludeDataConUnique  7
+justDataConKey                          = mkPreludeDataConUnique  8
+eqDataConKey                            = mkPreludeDataConUnique  9
+nilDataConKey                           = mkPreludeDataConUnique 10
+ratioDataConKey                         = mkPreludeDataConUnique 11
+word8DataConKey                         = mkPreludeDataConUnique 12
+stableNameDataConKey                    = mkPreludeDataConUnique 13
+trueDataConKey                          = mkPreludeDataConUnique 14
+wordDataConKey                          = mkPreludeDataConUnique 15
+ioDataConKey                            = mkPreludeDataConUnique 16
+heqDataConKey                           = mkPreludeDataConUnique 18
 
 -- Generic data constructors
 crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique
@@ -2075,6 +2153,22 @@ typeLitNatDataConKey      = mkPreludeDataConUnique 113
 unsafeReflDataConKey :: Unique
 unsafeReflDataConKey      = mkPreludeDataConUnique 114
 
+-- Multiplicity
+
+oneDataConKey, manyDataConKey :: Unique
+oneDataConKey = mkPreludeDataConUnique 115
+manyDataConKey = mkPreludeDataConUnique 116
+
+-- ghc-bignum
+integerISDataConKey, integerINDataConKey, integerIPDataConKey,
+   naturalNSDataConKey, naturalNBDataConKey :: Unique
+integerISDataConKey       = mkPreludeDataConUnique 120
+integerINDataConKey       = mkPreludeDataConUnique 121
+integerIPDataConKey       = mkPreludeDataConUnique 122
+naturalNSDataConKey       = mkPreludeDataConUnique 123
+naturalNBDataConKey       = mkPreludeDataConUnique 124
+
+
 ---------------- Template Haskell -------------------
 --      GHC.Builtin.Names.TH: USES DataUniques 200-250
 -----------------------------------------------------
@@ -2098,7 +2192,9 @@ wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,
     unpackCStringFoldrIdKey, unpackCStringFoldrUtf8IdKey,
     unpackCStringIdKey,
     typeErrorIdKey, divIntIdKey, modIntIdKey,
-    absentSumFieldErrorIdKey, cstringLengthIdKey :: Unique
+    absentSumFieldErrorIdKey, cstringLengthIdKey,
+    raiseOverflowIdKey, raiseUnderflowIdKey, raiseDivZeroIdKey
+    :: Unique
 
 wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]
 absentErrorIdKey              = mkPreludeMiscIdUnique  1
@@ -2128,6 +2224,9 @@ typeErrorIdKey                = mkPreludeMiscIdUnique 23
 divIntIdKey                   = mkPreludeMiscIdUnique 24
 modIntIdKey                   = mkPreludeMiscIdUnique 25
 cstringLengthIdKey            = mkPreludeMiscIdUnique 26
+raiseOverflowIdKey            = mkPreludeMiscIdUnique 27
+raiseUnderflowIdKey           = mkPreludeMiscIdUnique 28
+raiseDivZeroIdKey             = mkPreludeMiscIdUnique 29
 
 concatIdKey, filterIdKey, zipIdKey,
     bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
@@ -2148,63 +2247,6 @@ sndIdKey                      = mkPreludeMiscIdUnique 42
 otherwiseIdKey                = mkPreludeMiscIdUnique 43
 assertIdKey                   = mkPreludeMiscIdUnique 44
 
-mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,
-    integerToWordIdKey, integerToIntIdKey,
-    integerToWord64IdKey, integerToInt64IdKey,
-    word64ToIntegerIdKey, int64ToIntegerIdKey,
-    plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,
-    negateIntegerIdKey,
-    eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey,
-    leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey,
-    compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
-    quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey,
-    floatFromIntegerIdKey, doubleFromIntegerIdKey,
-    encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,
-    decodeDoubleIntegerIdKey,
-    gcdIntegerIdKey, lcmIntegerIdKey,
-    andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
-    shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
-mkIntegerIdKey                = mkPreludeMiscIdUnique 60
-smallIntegerIdKey             = mkPreludeMiscIdUnique 61
-integerToWordIdKey            = mkPreludeMiscIdUnique 62
-integerToIntIdKey             = mkPreludeMiscIdUnique 63
-integerToWord64IdKey          = mkPreludeMiscIdUnique 64
-integerToInt64IdKey           = mkPreludeMiscIdUnique 65
-plusIntegerIdKey              = mkPreludeMiscIdUnique 66
-timesIntegerIdKey             = mkPreludeMiscIdUnique 67
-minusIntegerIdKey             = mkPreludeMiscIdUnique 68
-negateIntegerIdKey            = mkPreludeMiscIdUnique 69
-eqIntegerPrimIdKey            = mkPreludeMiscIdUnique 70
-neqIntegerPrimIdKey           = mkPreludeMiscIdUnique 71
-absIntegerIdKey               = mkPreludeMiscIdUnique 72
-signumIntegerIdKey            = mkPreludeMiscIdUnique 73
-leIntegerPrimIdKey            = mkPreludeMiscIdUnique 74
-gtIntegerPrimIdKey            = mkPreludeMiscIdUnique 75
-ltIntegerPrimIdKey            = mkPreludeMiscIdUnique 76
-geIntegerPrimIdKey            = mkPreludeMiscIdUnique 77
-compareIntegerIdKey           = mkPreludeMiscIdUnique 78
-quotIntegerIdKey              = mkPreludeMiscIdUnique 79
-remIntegerIdKey               = mkPreludeMiscIdUnique 80
-divIntegerIdKey               = mkPreludeMiscIdUnique 81
-modIntegerIdKey               = mkPreludeMiscIdUnique 82
-divModIntegerIdKey            = mkPreludeMiscIdUnique 83
-quotRemIntegerIdKey           = mkPreludeMiscIdUnique 84
-floatFromIntegerIdKey         = mkPreludeMiscIdUnique 85
-doubleFromIntegerIdKey        = mkPreludeMiscIdUnique 86
-encodeFloatIntegerIdKey       = mkPreludeMiscIdUnique 87
-encodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 88
-gcdIntegerIdKey               = mkPreludeMiscIdUnique 89
-lcmIntegerIdKey               = mkPreludeMiscIdUnique 90
-andIntegerIdKey               = mkPreludeMiscIdUnique 91
-orIntegerIdKey                = mkPreludeMiscIdUnique 92
-xorIntegerIdKey               = mkPreludeMiscIdUnique 93
-complementIntegerIdKey        = mkPreludeMiscIdUnique 94
-shiftLIntegerIdKey            = mkPreludeMiscIdUnique 95
-shiftRIntegerIdKey            = mkPreludeMiscIdUnique 96
-wordToIntegerIdKey            = mkPreludeMiscIdUnique 97
-word64ToIntegerIdKey          = mkPreludeMiscIdUnique 98
-int64ToIntegerIdKey           = mkPreludeMiscIdUnique 99
-decodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 100
 
 rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 101
@@ -2401,24 +2443,121 @@ fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560
 makeStaticKey :: Unique
 makeStaticKey = mkPreludeMiscIdUnique 561
 
--- Natural
-naturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey,
-   minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey,
-   naturalSDataConKey, wordToNaturalIdKey :: Unique
-naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562
-naturalToIntegerIdKey   = mkPreludeMiscIdUnique 563
-plusNaturalIdKey        = mkPreludeMiscIdUnique 564
-minusNaturalIdKey       = mkPreludeMiscIdUnique 565
-timesNaturalIdKey       = mkPreludeMiscIdUnique 566
-mkNaturalIdKey          = mkPreludeMiscIdUnique 567
-naturalSDataConKey      = mkPreludeMiscIdUnique 568
-wordToNaturalIdKey      = mkPreludeMiscIdUnique 569
-
 -- Unsafe coercion proofs
 unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
 unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
 unsafeCoercePrimIdKey    = mkPreludeMiscIdUnique 571
 
+
+------------------------------------------------------
+-- ghc-bignum uses 600-699 uniques
+------------------------------------------------------
+
+integerFromNaturalIdKey
+   , integerToNaturalClampIdKey
+   , integerToWordIdKey
+   , integerToIntIdKey
+   , integerToWord64IdKey
+   , integerToInt64IdKey
+   , integerAddIdKey
+   , integerMulIdKey
+   , integerSubIdKey
+   , integerNegateIdKey
+   , integerEqPrimIdKey
+   , integerNePrimIdKey
+   , integerLePrimIdKey
+   , integerGtPrimIdKey
+   , integerLtPrimIdKey
+   , integerGePrimIdKey
+   , integerAbsIdKey
+   , integerSignumIdKey
+   , integerCompareIdKey
+   , integerQuotIdKey
+   , integerRemIdKey
+   , integerDivIdKey
+   , integerModIdKey
+   , integerDivModIdKey
+   , integerQuotRemIdKey
+   , integerToFloatIdKey
+   , integerToDoubleIdKey
+   , integerEncodeFloatIdKey
+   , integerEncodeDoubleIdKey
+   , integerGcdIdKey
+   , integerLcmIdKey
+   , integerAndIdKey
+   , integerOrIdKey
+   , integerXorIdKey
+   , integerComplementIdKey
+   , integerBitIdKey
+   , integerShiftLIdKey
+   , integerShiftRIdKey
+   , integerFromWordIdKey
+   , integerFromWord64IdKey
+   , integerFromInt64IdKey
+   , integerDecodeDoubleIdKey
+   , naturalToWordIdKey
+   , naturalAddIdKey
+   , naturalSubIdKey
+   , naturalMulIdKey
+   , naturalQuotIdKey
+   , naturalRemIdKey
+   , naturalQuotRemIdKey
+   , bignatFromWordListIdKey
+   :: Unique
+
+integerFromNaturalIdKey    = mkPreludeMiscIdUnique 600
+integerToNaturalClampIdKey = mkPreludeMiscIdUnique 601
+integerToWordIdKey         = mkPreludeMiscIdUnique 602
+integerToIntIdKey          = mkPreludeMiscIdUnique 603
+integerToWord64IdKey       = mkPreludeMiscIdUnique 604
+integerToInt64IdKey        = mkPreludeMiscIdUnique 605
+integerAddIdKey            = mkPreludeMiscIdUnique 606
+integerMulIdKey            = mkPreludeMiscIdUnique 607
+integerSubIdKey            = mkPreludeMiscIdUnique 608
+integerNegateIdKey         = mkPreludeMiscIdUnique 609
+integerEqPrimIdKey         = mkPreludeMiscIdUnique 610
+integerNePrimIdKey         = mkPreludeMiscIdUnique 611
+integerLePrimIdKey         = mkPreludeMiscIdUnique 612
+integerGtPrimIdKey         = mkPreludeMiscIdUnique 613
+integerLtPrimIdKey         = mkPreludeMiscIdUnique 614
+integerGePrimIdKey         = mkPreludeMiscIdUnique 615
+integerAbsIdKey            = mkPreludeMiscIdUnique 616
+integerSignumIdKey         = mkPreludeMiscIdUnique 617
+integerCompareIdKey        = mkPreludeMiscIdUnique 618
+integerQuotIdKey           = mkPreludeMiscIdUnique 619
+integerRemIdKey            = mkPreludeMiscIdUnique 620
+integerDivIdKey            = mkPreludeMiscIdUnique 621
+integerModIdKey            = mkPreludeMiscIdUnique 622
+integerDivModIdKey         = mkPreludeMiscIdUnique 623
+integerQuotRemIdKey        = mkPreludeMiscIdUnique 624
+integerToFloatIdKey        = mkPreludeMiscIdUnique 625
+integerToDoubleIdKey       = mkPreludeMiscIdUnique 626
+integerEncodeFloatIdKey    = mkPreludeMiscIdUnique 627
+integerEncodeDoubleIdKey   = mkPreludeMiscIdUnique 628
+integerGcdIdKey            = mkPreludeMiscIdUnique 629
+integerLcmIdKey            = mkPreludeMiscIdUnique 630
+integerAndIdKey            = mkPreludeMiscIdUnique 631
+integerOrIdKey             = mkPreludeMiscIdUnique 632
+integerXorIdKey            = mkPreludeMiscIdUnique 633
+integerComplementIdKey     = mkPreludeMiscIdUnique 634
+integerBitIdKey            = mkPreludeMiscIdUnique 635
+integerShiftLIdKey         = mkPreludeMiscIdUnique 636
+integerShiftRIdKey         = mkPreludeMiscIdUnique 637
+integerFromWordIdKey       = mkPreludeMiscIdUnique 638
+integerFromWord64IdKey     = mkPreludeMiscIdUnique 639
+integerFromInt64IdKey      = mkPreludeMiscIdUnique 640
+integerDecodeDoubleIdKey   = mkPreludeMiscIdUnique 641
+
+naturalToWordIdKey         = mkPreludeMiscIdUnique 650
+naturalAddIdKey            = mkPreludeMiscIdUnique 651
+naturalSubIdKey            = mkPreludeMiscIdUnique 652
+naturalMulIdKey            = mkPreludeMiscIdUnique 653
+naturalQuotIdKey           = mkPreludeMiscIdUnique 654
+naturalRemIdKey            = mkPreludeMiscIdUnique 655
+naturalQuotRemIdKey        = mkPreludeMiscIdUnique 656
+
+bignatFromWordListIdKey    = mkPreludeMiscIdUnique 670
+
 {-
 ************************************************************************
 *                                                                      *

compiler/GHC/Builtin/Names/TH.hs

@@ -30,6 +30,7 @@ templateHaskellNames = [
     returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
     mkNameSName,
+    mkModNameName,
     liftStringName,
     unTypeName,
     unTypeQName,
@@ -98,7 +99,7 @@ templateHaskellNames = [
     -- Type
     forallTName, forallVisTName, varTName, conTName, infixTName, appTName,
     appKindTName, equalityTName, tupleTName, unboxedTupleTName,
-    unboxedSumTName, arrowTName, listTName, sigTName, litTName,
+    unboxedSumTName, arrowTName, mulArrowTName, listTName, sigTName, litTName,
     promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
     wildCardTName, implicitParamTName,
     -- TyLit
@@ -160,6 +161,7 @@ templateHaskellNames = [
     ruleBndrTyConName, tySynEqnTyConName,
     roleTyConName, tExpTyConName, injAnnTyConName, kindTyConName,
     overlapTyConName, derivClauseTyConName, derivStrategyTyConName,
+    modNameTyConName,
 
     -- Quasiquoting
     quoteDecName, quoteTypeName, quoteExpName, quotePatName]
@@ -191,7 +193,8 @@ quoteClassName = thCls (fsLit "Quote") quoteClassKey
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
     matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
-    tExpTyConName, injAnnTyConName, overlapTyConName, decsTyConName :: Name
+    tExpTyConName, injAnnTyConName, overlapTyConName, decsTyConName,
+    modNameTyConName :: Name
 qTyConName             = thTc (fsLit "Q")              qTyConKey
 nameTyConName          = thTc (fsLit "Name")           nameTyConKey
 fieldExpTyConName      = thTc (fsLit "FieldExp")       fieldExpTyConKey
@@ -208,11 +211,12 @@ predTyConName          = thTc (fsLit "Pred")           predTyConKey
 tExpTyConName          = thTc (fsLit "TExp")           tExpTyConKey
 injAnnTyConName        = thTc (fsLit "InjectivityAnn") injAnnTyConKey
 overlapTyConName       = thTc (fsLit "Overlap")        overlapTyConKey
+modNameTyConName       = thTc (fsLit "ModName")        modNameTyConKey
 
 returnQName, bindQName, sequenceQName, newNameName, liftName,
     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
     mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,
-    unsafeTExpCoerceName, liftTypedName :: Name
+    unsafeTExpCoerceName, liftTypedName, mkModNameName :: Name
 returnQName    = thFun (fsLit "returnQ")   returnQIdKey
 bindQName      = thFun (fsLit "bindQ")     bindQIdKey
 sequenceQName  = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -225,6 +229,7 @@ mkNameG_dName  = thFun (fsLit "mkNameG_d")  mkNameG_dIdKey
 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
 mkNameLName    = thFun (fsLit "mkNameL")    mkNameLIdKey
 mkNameSName    = thFun (fsLit "mkNameS")    mkNameSIdKey
+mkModNameName  = thFun (fsLit "mkModName")  mkModNameIdKey
 unTypeName     = thFun (fsLit "unType")     unTypeIdKey
 unTypeQName    = thFun (fsLit "unTypeQ")    unTypeQIdKey
 unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
@@ -438,8 +443,8 @@ recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
 
 -- data Type = ...
 forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
-    unboxedTupleTName, unboxedSumTName, arrowTName, listTName, appTName,
-    appKindTName, sigTName, equalityTName, litTName, promotedTName,
+    unboxedTupleTName, unboxedSumTName, arrowTName, mulArrowTName, listTName,
+    appTName, appKindTName, sigTName, equalityTName, litTName, promotedTName,
     promotedTupleTName, promotedNilTName, promotedConsTName,
     wildCardTName, implicitParamTName :: Name
 forallTName         = libFun (fsLit "forallT")        forallTIdKey
@@ -450,6 +455,7 @@ tupleTName          = libFun (fsLit "tupleT")         tupleTIdKey
 unboxedTupleTName   = libFun (fsLit "unboxedTupleT")  unboxedTupleTIdKey
 unboxedSumTName     = libFun (fsLit "unboxedSumT")    unboxedSumTIdKey
 arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
+mulArrowTName       = libFun (fsLit "mulArrowT")      mulArrowTIdKey
 listTName           = libFun (fsLit "listT")          listTIdKey
 appTName            = libFun (fsLit "appT")           appTIdKey
 appKindTName        = libFun (fsLit "appKindT")       appKindTIdKey
@@ -648,8 +654,8 @@ expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     funDepTyConKey, predTyConKey,
     predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey,
     roleTyConKey, tExpTyConKey, injAnnTyConKey, kindTyConKey,
-    overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey
-      :: Unique
+    overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey,
+    modNameTyConKey  :: Unique
 expTyConKey             = mkPreludeTyConUnique 200
 matchTyConKey           = mkPreludeTyConUnique 201
 clauseTyConKey          = mkPreludeTyConUnique 202
@@ -683,6 +689,7 @@ overlapTyConKey         = mkPreludeTyConUnique 233
 derivClauseTyConKey    = mkPreludeTyConUnique 234
 derivStrategyTyConKey  = mkPreludeTyConUnique 235
 decsTyConKey            = mkPreludeTyConUnique 236
+modNameTyConKey         = mkPreludeTyConUnique 238
 
 {- *********************************************************************
 *                                                                      *
@@ -736,7 +743,7 @@ incoherentDataConKey   = mkPreludeDataConUnique 212
 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
     mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
     mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,
-    unsafeTExpCoerceIdKey, liftTypedIdKey :: Unique
+    unsafeTExpCoerceIdKey, liftTypedIdKey, mkModNameIdKey :: Unique
 returnQIdKey        = mkPreludeMiscIdUnique 200
 bindQIdKey          = mkPreludeMiscIdUnique 201
 sequenceQIdKey      = mkPreludeMiscIdUnique 202
@@ -752,6 +759,7 @@ unTypeIdKey          = mkPreludeMiscIdUnique 211
 unTypeQIdKey         = mkPreludeMiscIdUnique 212
 unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213
 liftTypedIdKey        = mkPreludeMiscIdUnique 214
+mkModNameIdKey        = mkPreludeMiscIdUnique 215
 
 
 -- data Lit = ...
@@ -1046,6 +1054,10 @@ interruptibleIdKey = mkPreludeMiscIdUnique 442
 funDepIdKey :: Unique
 funDepIdKey = mkPreludeMiscIdUnique 445
 
+-- mulArrow
+mulArrowTIdKey :: Unique
+mulArrowTIdKey = mkPreludeMiscIdUnique 446
+
 -- data TySynEqn = ...
 tySynEqnIdKey :: Unique
 tySynEqnIdKey = mkPreludeMiscIdUnique 460

compiler/GHC/Builtin/PrimOps.hs

@@ -8,7 +8,7 @@
 
 module GHC.Builtin.PrimOps (
         PrimOp(..), PrimOpVecCat(..), allThePrimOps,
-        primOpType, primOpSig,
+        primOpType, primOpSig, primOpResultType,
         primOpTag, maxPrimOpTag, primOpOcc,
         primOpWrapperId,
 
@@ -453,7 +453,7 @@ Duplicate      YES           NO
   just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get
   something like this
         p = case readMutVar# s v of
-              (# s', r #) -> (S# s', r)
+              (# s', r #) -> (State# s', r)
         s' = case p of (s', r) -> s'
         r  = case p of (s', r) -> r
 
@@ -467,7 +467,7 @@ Duplicate      YES           NO
 
 Note [Implementation: how can_fail/has_side_effects affect transformations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-How do we ensure that that floating/duplication/discarding are done right
+How do we ensure that floating/duplication/discarding are done right
 in the simplifier?
 
 Two main predicates on primpops test these flags:
@@ -579,7 +579,15 @@ primOpType op
     Compare _occ ty -> compare_fun_ty ty
 
     GenPrimOp _occ tyvars arg_tys res_ty ->
-        mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)
+        mkSpecForAllTys tyvars (mkVisFunTysMany arg_tys res_ty)
+
+primOpResultType :: PrimOp -> Type
+primOpResultType op
+  = case primOpInfo op of
+    Dyadic  _occ ty  -> ty
+    Monadic _occ ty  -> ty
+    Compare _occ _ty -> intPrimTy
+    GenPrimOp _occ _tyvars _arg_tys res_ty -> res_ty
 
 primOpOcc :: PrimOp -> OccName
 primOpOcc op = case primOpInfo op of
@@ -739,9 +747,9 @@ commutableOp :: PrimOp -> Bool
 -- Utils:
 
 dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
-dyadic_fun_ty  ty = mkVisFunTys [ty, ty] ty
-monadic_fun_ty ty = mkVisFunTy  ty ty
-compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy
+dyadic_fun_ty  ty = mkVisFunTysMany [ty, ty] ty
+monadic_fun_ty ty = mkVisFunTyMany  ty ty
+compare_fun_ty ty = mkVisFunTysMany [ty, ty] intPrimTy
 
 -- Output stuff:
 

compiler/GHC/Builtin/RebindableNames.hs

+module GHC.Builtin.RebindableNames where
+
+import GHC.Data.FastString
+
+reboundIfSymbol :: FastString
+reboundIfSymbol = fsLit "ifThenElse"

compiler/GHC/Builtin/Types.hs

@@ -10,7 +10,7 @@ Wired-in knowledge about {\em non-primitive} types
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- | This module is about types that can be defined in Haskell, but which
---   must be wired into the compiler nonetheless.  C.f module GHC.Builtin.Types.Prim
+--   must be wired into the compiler nonetheless.  C.f module "GHC.Builtin.Types.Prim"
 module GHC.Builtin.Types (
         -- * Helper functions defined here
         mkWiredInTyConName, -- This is used in GHC.Builtin.Types.Literals to define the
@@ -125,7 +125,26 @@ module GHC.Builtin.Types (
         int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
         int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
         word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
-        doubleElemRepDataConTy
+
+        doubleElemRepDataConTy,
+
+        -- * Multiplicity and friends
+        multiplicityTyConName, oneDataConName, manyDataConName, multiplicityTy,
+        multiplicityTyCon, oneDataCon, manyDataCon, oneDataConTy, manyDataConTy,
+        oneDataConTyCon, manyDataConTyCon,
+        multMulTyCon,
+
+        unrestrictedFunTyCon, unrestrictedFunTyConName,
+
+        -- * Bignum
+        integerTy, integerTyCon, integerTyConName,
+        integerISDataCon, integerISDataConName,
+        integerIPDataCon, integerIPDataConName,
+        integerINDataCon, integerINDataConName,
+        naturalTy, naturalTyCon, naturalTyConName,
+        naturalNSDataCon, naturalNSDataConName,
+        naturalNBDataCon, naturalNBDataConName
+
     ) where
 
 #include "HsVersions.h"
@@ -142,6 +161,7 @@ import {-# SOURCE #-} GHC.Builtin.Uniques
 -- others:
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Id
+import GHC.Types.Var (VarBndr (Bndr))
 import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
 import GHC.Unit.Module        ( Module )
 import GHC.Core.Type
@@ -240,6 +260,9 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
                 , vecElemTyCon
                 , constraintKindTyCon
                 , liftedTypeKindTyCon
+                , multiplicityTyCon
+                , naturalTyCon
+                , integerTyCon
                 ]
 
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -278,7 +301,7 @@ syntax. This has a few consequences:
 * Writing (a ~ b) does not require enabling -XTypeOperators. It does, however,
   require -XGADTs or -XTypeFamilies.
 
-* The (~) type operator is always in scope. It doesn't need to be be imported,
+* The (~) type operator is always in scope. It doesn't need to be imported,
   and it cannot be hidden.
 
 * We have a bunch of special cases in the compiler to arrange all of the above.
@@ -461,6 +484,20 @@ constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constr
 liftedTypeKindTyConName :: Name
 liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
 
+multiplicityTyConName :: Name
+multiplicityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Multiplicity")
+                          multiplicityTyConKey multiplicityTyCon
+
+oneDataConName, manyDataConName :: Name
+oneDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "One") oneDataConKey oneDataCon
+manyDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "Many") manyDataConKey manyDataCon
+ -- It feels wrong to have One and Many be BuiltInSyntax. But otherwise,
+ -- `Many`, in particular, is considered out of scope unless an appropriate
+ -- file is open. The problem with this is that `Many` appears implicitly in
+ -- types every time there is an `(->)`, hence out-of-scope errors get
+ -- reported. Making them built-in make it so that they are always considered in
+ -- scope.
+
 runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
 runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
 vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
@@ -544,16 +581,20 @@ pcTyCon name cType tyvars cons
                 False           -- Not in GADT syntax
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
-pcDataCon n univs = pcDataConWithFixity False n univs
+pcDataCon n univs tys = pcDataConW n univs (map linear tys)
+
+pcDataConW :: Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
+pcDataConW n univs tys = pcDataConWithFixity False n univs
                       []    -- no ex_tvs
                       univs -- the univs are precisely the user-written tyvars
+                      tys
 
 pcDataConWithFixity :: Bool      -- ^ declared infix?
                     -> Name      -- ^ datacon name
                     -> [TyVar]   -- ^ univ tyvars
                     -> [TyCoVar] -- ^ ex tycovars
                     -> [TyCoVar] -- ^ user-written tycovars
-                    -> [Type]    -- ^ args
+                    -> [Scaled Type]    -- ^ args
                     -> TyCon
                     -> DataCon
 pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))
@@ -567,7 +608,7 @@ pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (n
 
 pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
                      -> [TyVar] -> [TyCoVar] -> [TyCoVar]
-                     -> [Type] -> TyCon -> DataCon
+                     -> [Scaled Type] -> TyCon -> DataCon
 -- The Name should be in the DataName name space; it's the name
 -- of the DataCon itself.
 --
@@ -625,7 +666,7 @@ mkDataConWorkerName data_con wrk_key =
 pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
 pcSpecialDataCon dc_name arg_tys tycon rri
   = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri
-                         [] [] [] arg_tys tycon
+                         [] [] [] (map linear arg_tys) tycon
 
 {-
 ************************************************************************
@@ -651,7 +692,7 @@ constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
 
 liftedTypeKind, typeToTypeKind, constraintKind :: Kind
 liftedTypeKind   = tYPE liftedRepTy
-typeToTypeKind   = liftedTypeKind `mkVisFunTy` liftedTypeKind
+typeToTypeKind   = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
 constraintKind   = mkTyConApp constraintKindTyCon []
 
 {-
@@ -791,7 +832,8 @@ isBuiltInOcc_maybe occ =
       "~"    -> Just eqTyConName
 
       -- function tycon
-      "->"   -> Just funTyConName
+      "FUN"  -> Just funTyConName
+      "->"  -> Just unrestrictedFunTyConName
 
       -- boxed tuple data/tycon
       -- We deliberately exclude Solo (the boxed 1-tuple).
@@ -1149,7 +1191,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
                              rhs klass
                              (mkPrelTyConRepName eqTyConName)
     klass     = mk_class tycon sc_pred sc_sel_id
-    datacon   = pcDataCon eqDataConName tvs [sc_pred] tycon
+    datacon   = pcDataConW eqDataConName tvs [unrestricted sc_pred] tycon
 
     -- Kind: forall k. k -> k -> Constraint
     binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
@@ -1167,7 +1209,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
                              rhs klass
                              (mkPrelTyConRepName heqTyConName)
     klass     = mk_class tycon sc_pred sc_sel_id
-    datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon
+    datacon   = pcDataConW heqDataConName tvs [unrestricted sc_pred] tycon
 
     -- Kind: forall k1 k2. k1 -> k2 -> Constraint
     binders   = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
@@ -1185,7 +1227,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
                              rhs klass
                              (mkPrelTyConRepName coercibleTyConName)
     klass     = mk_class tycon sc_pred sc_sel_id
-    datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon
+    datacon   = pcDataConW coercibleDataConName tvs [unrestricted sc_pred] tycon
 
     -- Kind: forall k. k -> k -> Constraint
     binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
@@ -1203,6 +1245,67 @@ mk_class tycon sc_pred sc_sel_id
 
 
 
+{- *********************************************************************
+*                                                                      *
+                Multiplicity Polymorphism
+*                                                                      *
+********************************************************************* -}
+
+{- Multiplicity polymorphism is implemented very similarly to levity
+ polymorphism. We write in the multiplicity kind and the One and Many
+ types which can appear in user programs. These are defined properly in GHC.Types.
+
+data Multiplicity = One | Many
+-}
+
+multiplicityTy :: Type
+multiplicityTy = mkTyConTy multiplicityTyCon
+
+multiplicityTyCon :: TyCon
+multiplicityTyCon = pcTyCon multiplicityTyConName Nothing []
+                          [oneDataCon, manyDataCon]
+
+oneDataCon, manyDataCon :: DataCon
+oneDataCon = pcDataCon oneDataConName [] [] multiplicityTyCon
+manyDataCon = pcDataCon manyDataConName [] [] multiplicityTyCon
+
+oneDataConTy, manyDataConTy :: Type
+oneDataConTy = mkTyConTy oneDataConTyCon
+manyDataConTy = mkTyConTy manyDataConTyCon
+
+oneDataConTyCon, manyDataConTyCon :: TyCon
+oneDataConTyCon = promoteDataCon oneDataCon
+manyDataConTyCon = promoteDataCon manyDataCon
+
+multMulTyConName :: Name
+multMulTyConName =
+    mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "MultMul") multMulTyConKey multMulTyCon
+
+multMulTyCon :: TyCon
+multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing
+                         (BuiltInSynFamTyCon trivialBuiltInFamily)
+                         Nothing
+                         NotInjective
+  where
+    binders = mkTemplateAnonTyConBinders [multiplicityTy, multiplicityTy]
+
+unrestrictedFunTy :: Type
+unrestrictedFunTy = functionWithMultiplicity manyDataConTy
+
+unrestrictedFunTyCon :: TyCon
+unrestrictedFunTyCon = buildSynTyCon unrestrictedFunTyConName [] arrowKind [] unrestrictedFunTy
+  where arrowKind = mkTyConKind binders liftedTypeKind
+        -- See also funTyCon
+        binders = [ Bndr runtimeRep1TyVar (NamedTCB Inferred)
+                  , Bndr runtimeRep2TyVar (NamedTCB Inferred)
+                  ]
+                  ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
+                                                , tYPE runtimeRep2Ty
+                                                ]
+
+unrestrictedFunTyConName :: Name
+unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "->") unrestrictedFunTyConKey unrestrictedFunTyCon
+
 {- *********************************************************************
 *                                                                      *
                 Kinds and RuntimeRep
@@ -1576,7 +1679,7 @@ consDataCon :: DataCon
 consDataCon = pcDataConWithFixity True {- Declared infix -}
                consDataConName
                alpha_tyvar [] alpha_tyvar
-               [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
+               (map linear [alphaTy, mkTyConApp listTyCon alpha_ty]) listTyCon
 -- Interesting: polymorphic recursion would help here.
 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
 -- gets the over-specific type (Type -> Type)
@@ -1652,7 +1755,7 @@ mkTupleTy boxity  tys  = mkTupleTy1 boxity tys
 -- | Make a tuple type. The list of types should /not/ include any
 -- RuntimeRep specifications. Boxed 1-tuples are *not* flattened.
 -- See Note [One-tuples] and Note [Don't flatten tuples from HsSyn]
--- in GHC.Core.Make
+-- in "GHC.Core.Make"
 mkTupleTy1 :: Boxity -> [Type] -> Type
 mkTupleTy1 Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys
 mkTupleTy1 Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))
@@ -1735,3 +1838,98 @@ extractPromotedList tys = go tys
 
       | otherwise
       = pprPanic "extractPromotedList" (ppr tys)
+
+
+
+---------------------------------------
+-- ghc-bignum
+---------------------------------------
+
+integerTyConName
+   , integerISDataConName
+   , integerIPDataConName
+   , integerINDataConName
+   :: Name
+integerTyConName
+   = mkWiredInTyConName
+      UserSyntax
+      gHC_NUM_INTEGER
+      (fsLit "Integer")
+      integerTyConKey
+      integerTyCon
+integerISDataConName
+   = mkWiredInDataConName
+      UserSyntax
+      gHC_NUM_INTEGER
+      (fsLit "IS")
+      integerISDataConKey
+      integerISDataCon
+integerIPDataConName
+   = mkWiredInDataConName
+      UserSyntax
+      gHC_NUM_INTEGER
+      (fsLit "IP")
+      integerIPDataConKey
+      integerIPDataCon
+integerINDataConName
+   = mkWiredInDataConName
+      UserSyntax
+      gHC_NUM_INTEGER
+      (fsLit "IN")
+      integerINDataConKey
+      integerINDataCon
+
+integerTy :: Type
+integerTy = mkTyConTy integerTyCon
+
+integerTyCon :: TyCon
+integerTyCon = pcTyCon integerTyConName Nothing []
+                  [integerISDataCon, integerIPDataCon, integerINDataCon]
+
+integerISDataCon :: DataCon
+integerISDataCon = pcDataCon integerISDataConName [] [intPrimTy] integerTyCon
+
+integerIPDataCon :: DataCon
+integerIPDataCon = pcDataCon integerIPDataConName [] [byteArrayPrimTy] integerTyCon
+
+integerINDataCon :: DataCon
+integerINDataCon = pcDataCon integerINDataConName [] [byteArrayPrimTy] integerTyCon
+
+naturalTyConName
+   , naturalNSDataConName
+   , naturalNBDataConName
+   :: Name
+naturalTyConName
+   = mkWiredInTyConName
+      UserSyntax
+      gHC_NUM_NATURAL
+      (fsLit "Natural")
+      naturalTyConKey
+      naturalTyCon
+naturalNSDataConName
+   = mkWiredInDataConName
+      UserSyntax
+      gHC_NUM_NATURAL
+      (fsLit "NS")
+      naturalNSDataConKey
+      naturalNSDataCon
+naturalNBDataConName
+   = mkWiredInDataConName
+      UserSyntax
+      gHC_NUM_NATURAL
+      (fsLit "NB")
+      naturalNBDataConKey
+      naturalNBDataCon
+
+naturalTy :: Type
+naturalTy = mkTyConTy naturalTyCon
+
+naturalTyCon :: TyCon
+naturalTyCon = pcTyCon naturalTyConName Nothing []
+                  [naturalNSDataCon, naturalNBDataCon]
+
+naturalNSDataCon :: DataCon
+naturalNSDataCon = pcDataCon naturalNSDataConName [] [wordPrimTy] naturalTyCon
+
+naturalNBDataCon :: DataCon
+naturalNBDataCon = pcDataCon naturalNBDataConName [] [byteArrayPrimTy] naturalTyCon

compiler/GHC/Builtin/Types.hs-boot

@@ -44,4 +44,15 @@ anyTypeOfKind :: Kind -> Type
 unboxedTupleKind :: [Type] -> Type
 mkPromotedListTy :: Type -> [Type] -> Type
 
+multiplicityTyCon :: TyCon
+multiplicityTy :: Type
+oneDataConTy :: Type
+oneDataConTyCon :: TyCon
+manyDataConTy :: Type
+manyDataConTyCon :: TyCon
+unrestrictedFunTyCon :: TyCon
+multMulTyCon :: TyCon
+
 tupleTyConName :: TupleSort -> Arity -> Name
+
+integerTy, naturalTy :: Type

compiler/GHC/Builtin/Types/Prim.hs

@@ -9,7 +9,7 @@ Wired-in knowledge about primitive types
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- | This module defines TyCons that can't be expressed in Haskell.
---   They are all, therefore, wired-in TyCons.  C.f module GHC.Builtin.Types
+--   They are all, therefore, wired-in TyCons.  C.f module "GHC.Builtin.Types"
 module GHC.Builtin.Types.Prim(
         mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
 
@@ -26,12 +26,15 @@ module GHC.Builtin.Types.Prim(
         runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
         openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
 
+        multiplicityTyVar,
+
         -- Kind constructors...
         tYPETyCon, tYPETyConName,
 
         -- Kinds
         tYPE, primRepToRuntimeRep,
 
+        functionWithMultiplicity,
         funTyCon, funTyConName,
         unexposedPrimTyCons, exposedPrimTyCons, primTyCons,
 
@@ -108,7 +111,7 @@ import {-# SOURCE #-} GHC.Builtin.Types
   , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
   , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
   , doubleElemRepDataConTy
-  , mkPromotedListTy )
+  , mkPromotedListTy, multiplicityTy )
 
 import GHC.Types.Var    ( TyVar, mkTyVar )
 import GHC.Types.Name
@@ -134,7 +137,7 @@ import Data.Char
 primTyCons :: [TyCon]
 primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons
 
--- | Primitive 'TyCon's that are defined in "GHC.Prim" but not exposed.
+-- | Primitive 'TyCon's that are defined in GHC.Prim but not exposed.
 -- It's important to keep these separate as we don't want users to be able to
 -- write them (see #15209) or see them in GHCi's @:browse@ output
 -- (see #12023).
@@ -145,7 +148,7 @@ unexposedPrimTyCons
     , eqPhantPrimTyCon
     ]
 
--- | Primitive 'TyCon's that are defined in, and exported from, "GHC.Prim".
+-- | Primitive 'TyCon's that are defined in, and exported from, GHC.Prim.
 exposedPrimTyCons :: [TyCon]
 exposedPrimTyCons
   = [ addrPrimTyCon
@@ -228,7 +231,7 @@ eqPhantPrimTyConName          = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKe
 realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
 arrayPrimTyConName            = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
 byteArrayPrimTyConName        = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
-arrayArrayPrimTyConName           = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
+arrayArrayPrimTyConName       = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
 smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
 mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
@@ -385,6 +388,9 @@ openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
 openBetaTy  = mkTyVarTy openBetaTyVar
 
+multiplicityTyVar :: TyVar
+multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13  -- selects 'n'
+
 {-
 ************************************************************************
 *                                                                      *
@@ -394,13 +400,13 @@ openBetaTy  = mkTyVarTy openBetaTyVar
 -}
 
 funTyConName :: Name
-funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
+funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon
 
--- | The @(->)@ type constructor.
+-- | The @FUN@ type constructor.
 --
 -- @
--- (->) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
---         TYPE rep1 -> TYPE rep2 -> Type
+-- FUN :: forall {m :: Multiplicity} {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
+--         TYPE rep1 -> TYPE rep2 -> *
 -- @
 --
 -- The runtime representations quantification is left inferred. This
@@ -413,13 +419,15 @@ funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
 -- @
 -- type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
 --             TYPE rep1 -> TYPE rep2 -> Type
--- type Arr = (->)
+-- type Arr = FUN
 -- @
 --
 funTyCon :: TyCon
 funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
   where
-    tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
+    -- See also unrestrictedFunTyCon
+    tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar
+               , mkNamedTyConBinder Inferred runtimeRep1TyVar
                , mkNamedTyConBinder Inferred runtimeRep2TyVar ]
                ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
                                              , tYPE runtimeRep2Ty
@@ -464,7 +472,7 @@ The 'rr' parameter tells us how the value is represented at runtime.
 Generally speaking, you can't be polymorphic in 'rr'.  E.g
    f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]
    f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ...
-This is no good: we could not generate code code for 'f', because the
+This is no good: we could not generate code for 'f', because the
 calling convention for 'f' varies depending on whether the argument is
 a a Int, Int#, or Float#.  (You could imagine generating specialised
 code, one for each instantiation of 'rr', but we don't do that.)
@@ -543,6 +551,10 @@ mkPrimTcName built_in_syntax occ key tycon
 tYPE :: Type -> Type
 tYPE rr = TyConApp tYPETyCon [rr]
 
+-- Given a Multiplicity, applies FUN to it.
+functionWithMultiplicity :: Type -> Type
+functionWithMultiplicity mul = TyConApp funTyCon [mul]
+
 {-
 ************************************************************************
 *                                                                      *

compiler/GHC/Builtin/Utils.hs

@@ -111,7 +111,7 @@ Note [About wired-in things]
 
 -- | This list is used to ensure that when you say "Prelude.map" in your source
 -- code, or in an interface file, you get a Name with the correct known key (See
--- Note [Known-key names] in GHC.Builtin.Names)
+-- Note [Known-key names] in "GHC.Builtin.Names")
 knownKeyNames :: [Name]
 knownKeyNames
   | debugIsOn
@@ -198,15 +198,20 @@ knownKeyNamesOkay all_names
 -- known-key thing.
 lookupKnownKeyName :: Unique -> Maybe Name
 lookupKnownKeyName u =
-    knownUniqueName u <|> lookupUFM knownKeysMap u
+    knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
 
 -- | Is a 'Name' known-key?
 isKnownKeyName :: Name -> Bool
 isKnownKeyName n =
     isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
 
-knownKeysMap :: UniqFM Name
-knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]
+-- | Maps 'Unique's to known-key names.
+--
+-- The type is @UniqFM Name Name@ to denote that the 'Unique's used
+-- in the domain are 'Unique's associated with 'Name's (as opposed
+-- to some other namespace of 'Unique's).
+knownKeysMap :: UniqFM Name Name
+knownKeysMap = listToIdentityUFM knownKeyNames
 
 -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
 -- GHCi's ':info' command.

compiler/GHC/Builtin/primops.txt.pp

@@ -194,17 +194,15 @@ section "The word size story."
 -- This type won't be exported directly (since there is no concrete
 -- syntax for this sort of export) so we'll have to manually patch
 -- export lists in both GHC and Haddock.
-primtype (->) a b
-  {The builtin function type, written in infix form as {\tt a -> b} and
-   in prefix form as {\tt (->) a b}. Values of this type are functions
-   taking inputs of type {\tt a} and producing outputs of type {\tt b}.
+primtype FUN m a b
+  {The builtin function type, written in infix form as {\tt a # m -> b}.
+   Values of this type are functions taking inputs of type {\tt a} and
+   producing outputs of type {\tt b}. The multiplicity of the input is
+   {\tt m}.
 
-   Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and
+   Note that {\tt FUN m a b} permits levity-polymorphism in both {\tt a} and
    {\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded.
   }
-  with fixity = infixr -1
-         -- This fixity is only the one picked up by Haddock. If you
-         -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'.
 
 ------------------------------------------------------------------------
 section "Char#"
@@ -2619,49 +2617,6 @@ primop  RaiseOp "raise#" GenPrimOp
    out_of_line = True
    can_fail = True
 
--- Note [Arithmetic exception primops]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- The RTS provides several primops to raise specific exceptions (raiseDivZero#,
--- raiseUnderflow#, raiseOverflow#). These primops are meant to be used by the
--- package implementing arbitrary precision numbers (Natural,Integer). It can't
--- depend on `base` package to raise exceptions in a normal way because it would
--- create a package dependency circle (base <-> bignum package).
---
--- See #14664
-
-primtype Void#
-
-primop  RaiseDivZeroOp "raiseDivZero#" GenPrimOp
-   Void# -> o
-   {Raise a 'DivideByZero' arithmetic exception.}
-      -- NB: the type variable "o" is "a", but with OpenKind
-      -- See Note [Arithmetic exception primops]
-   with
-   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
-   out_of_line = True
-   has_side_effects = True
-
-primop  RaiseUnderflowOp "raiseUnderflow#" GenPrimOp
-   Void# -> o
-   {Raise an 'Underflow' arithmetic exception.}
-      -- NB: the type variable "o" is "a", but with OpenKind
-      -- See Note [Arithmetic exception primops]
-   with
-   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
-   out_of_line = True
-   has_side_effects = True
-
-primop  RaiseOverflowOp "raiseOverflow#" GenPrimOp
-   Void# -> o
-   {Raise an 'Overflow' arithmetic exception.}
-      -- NB: the type variable "o" is "a", but with OpenKind
-      -- See Note [Arithmetic exception primops]
-   with
-   strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
-   out_of_line = True
-   has_side_effects = True
-
 primop  RaiseIOOp "raiseIO#" GenPrimOp
    a -> State# RealWorld -> (# State# RealWorld, b #)
    with
@@ -3361,6 +3316,8 @@ section "Misc"
         {These aren't nearly as wired in as Etc...}
 ------------------------------------------------------------------------
 
+primtype Void#
+
 primop  GetCCSOfOp "getCCSOf#" GenPrimOp
    a -> State# s -> (# State# s, Addr# #)
 
@@ -3473,7 +3430,7 @@ primop  TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp
    Addr# -> Int# -> State# s -> State# s
    { Emits an event via the RTS tracing framework.  The contents
      of the event is the binary object passed as the first argument with
-     the the given length passed as the second argument. The event will be
+     the given length passed as the second argument. The event will be
      emitted to the {\tt .eventlog} file. }
    with
    has_side_effects = True

compiler/GHC/ByteCode/Asm.hs

@@ -453,7 +453,7 @@ assembleI platform i = case i of
     literal (LitChar c)       = int (ord c)
     literal (LitString bs)    = lit [BCONPtrStr bs]
        -- LitString requires a zero-terminator when emitted
-    literal (LitNumber nt i _) = case nt of
+    literal (LitNumber nt i) = case nt of
       LitNumInt     -> int (fromIntegral i)
       LitNumWord    -> int (fromIntegral i)
       LitNumInt64   -> int64 (fromIntegral i)

compiler/GHC/ByteCode/InfoTable.hs

@@ -11,6 +11,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where
 
 import GHC.Prelude
 
+import GHC.Platform
 import GHC.ByteCode.Types
 import GHC.Runtime.Interpreter
 import GHC.Driver.Session
@@ -19,6 +20,7 @@ import GHC.Types.Name       ( Name, getName )
 import GHC.Types.Name.Env
 import GHC.Core.DataCon     ( DataCon, dataConRepArgTys, dataConIdentity )
 import GHC.Core.TyCon       ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
+import GHC.Core.Multiplicity     ( scaledThing )
 import GHC.Types.RepType
 import GHC.StgToCmm.Layout  ( mkVirtConstrSizes )
 import GHC.StgToCmm.Closure ( tagForCon, NonVoid (..) )
@@ -58,7 +60,7 @@ make_constr_itbls hsc_env cons =
   mk_itbl dcon conNo = do
      let rep_args = [ NonVoid prim_rep
                     | arg <- dataConRepArgTys dcon
-                    , prim_rep <- typePrimRep arg ]
+                    , prim_rep <- typePrimRep (scaledThing arg) ]
 
          (tot_wds, ptr_wds) =
              mkVirtConstrSizes dflags rep_args
@@ -71,7 +73,8 @@ make_constr_itbls hsc_env cons =
 
          descr = dataConIdentity dcon
 
-         tables_next_to_code = tablesNextToCode dflags
+         platform = targetPlatform dflags
+         tables_next_to_code = platformTablesNextToCode platform
 
      r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really
                               conNo (tagForCon dflags dcon) descr)

compiler/GHC/ByteCode/Types.hs

@@ -154,6 +154,7 @@ data ModBreaks
         -- ^ An array giving the names of the free variables at each breakpoint.
    , modBreaks_decls :: !(Array BreakIndex [String])
         -- ^ An array giving the names of the declarations enclosing each breakpoint.
+        -- See Note [Field modBreaks_decls]
    , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
         -- ^ Array pointing to cost centre for each breakpoint
    , modBreaks_breakInfo :: IntMap CgBreakInfo
@@ -180,3 +181,12 @@ emptyModBreaks = ModBreaks
    , modBreaks_ccs = array (0,-1) []
    , modBreaks_breakInfo = IntMap.empty
    }
+
+{-
+Note [Field modBreaks_decls]
+~~~~~~~~~~~~~~~~~~~~~~
+A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
+The breakpoint is in the function called "baz" that is declared in a `let`
+or `where` clause of a declaration called "bar", which itself is declared
+in a `let` or `where` clause of the top-level function called "foo".
+-}

compiler/GHC/Cmm/CLabel.hs

@@ -12,6 +12,7 @@
 
 module GHC.Cmm.CLabel (
         CLabel, -- abstract type
+        NeedExternDecl (..),
         ForeignLabelSource(..),
         pprDebugCLabel,
 
@@ -71,6 +72,7 @@ module GHC.Cmm.CLabel (
         mkCmmRetLabel,
         mkCmmCodeLabel,
         mkCmmDataLabel,
+        mkRtsCmmDataLabel,
         mkCmmClosureLabel,
 
         mkRtsApFastLabel,
@@ -162,7 +164,7 @@ import GHC.CmmToAsm.Config
 
   - By the C-- AST to identify labels
 
-  - By the unregisterised C code generator ("PprC") for naming functions (hence
+  - By the unregisterised C code generator (\"PprC\") for naming functions (hence
     the name 'CLabel')
 
   - By the native and LLVM code generators to identify labels
@@ -182,13 +184,14 @@ data CLabel
     IdLabel
         Name
         CafInfo
-        IdLabelInfo             -- encodes the suffix of the label
+        IdLabelInfo             -- ^ encodes the suffix of the label
 
   -- | A label from a .cmm file that is not associated with a .hs level Id.
   | CmmLabel
-        UnitId                  -- what package the label belongs to.
-        FastString              -- identifier giving the prefix of the label
-        CmmLabelInfo            -- encodes the suffix of the label
+        UnitId                  -- ^ what package the label belongs to.
+        NeedExternDecl          -- ^ does the label need an "extern .." declaration
+        FastString              -- ^ identifier giving the prefix of the label
+        CmmLabelInfo            -- ^ encodes the suffix of the label
 
   -- | A label with a baked-in \/ algorithmically generated name that definitely
   --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
@@ -208,13 +211,13 @@ data CLabel
   -- | A 'C' (or otherwise foreign) label.
   --
   | ForeignLabel
-        FastString              -- name of the imported label.
+        FastString              -- ^ name of the imported label.
 
-        (Maybe Int)             -- possible '@n' suffix for stdcall functions
+        (Maybe Int)             -- ^ possible '@n' suffix for stdcall functions
                                 -- When generating C, the '@n' suffix is omitted, but when
                                 -- generating assembler we must add it to the label.
 
-        ForeignLabelSource      -- what package the foreign label is in.
+        ForeignLabelSource      -- ^ what package the foreign label is in.
 
         FunctionOrData
 
@@ -227,7 +230,7 @@ data CLabel
   -- Must not occur outside of the NCG or LLVM code generators.
   | AsmTempDerivedLabel
         CLabel
-        FastString              -- suffix
+        FastString              -- ^ suffix
 
   | StringLitLabel
         {-# UNPACK #-} !Unique
@@ -275,6 +278,24 @@ isTickyLabel :: CLabel -> Bool
 isTickyLabel (IdLabel _ _ RednCounts) = True
 isTickyLabel _ = False
 
+-- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
+-- label (e.g. "extern StgWordArray(foo)").  The type is fixed to StgWordArray.
+--
+-- Symbols from the RTS don't need "extern" declarations because they are
+-- exposed via "includes/Stg.h" with the appropriate type. See 'needsCDecl'.
+--
+-- The fixed StgWordArray type led to "conflicting types" issues with user
+-- provided Cmm files (not in the RTS) that declare data of another type (#15467
+-- and test for #17920).  Hence the Cmm parser considers that labels in data
+-- sections don't need the "extern" declaration (just add one explicitly if you
+-- need it).
+--
+-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
+-- for why extern declaration are needed at all.
+newtype NeedExternDecl
+   = NeedExternDecl Bool
+   deriving (Ord,Eq)
+
 -- This is laborious, but necessary. We can't derive Ord because
 -- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
 -- implementation. See Note [No Ord for Unique]
@@ -285,10 +306,11 @@ instance Ord CLabel where
     compare a1 a2 `thenCmp`
     compare b1 b2 `thenCmp`
     compare c1 c2
-  compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =
+  compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
     compare a1 a2 `thenCmp`
     compare b1 b2 `thenCmp`
-    compare c1 c2
+    compare c1 c2 `thenCmp`
+    compare d1 d2
   compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
   compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
   compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
@@ -380,7 +402,7 @@ pprDebugCLabel lbl
  = case lbl of
         IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
                                        <> whenPprDebug (text ":" <> text (show info)))
-        CmmLabel pkg _name _info
+        CmmLabel pkg _ext _name _info
          -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
         RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
@@ -510,24 +532,24 @@ mkDirty_MUT_VAR_Label,
     mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
 mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
 mkNonmovingWriteBarrierEnabledLabel
-                                = CmmLabel rtsUnitId (fsLit "nonmoving_write_barrier_enabled") CmmData
-mkUpdInfoLabel                  = CmmLabel rtsUnitId (fsLit "stg_upd_frame")         CmmInfo
-mkBHUpdInfoLabel                = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" )     CmmInfo
-mkIndStaticInfoLabel            = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC")        CmmInfo
-mkMainCapabilityLabel           = CmmLabel rtsUnitId (fsLit "MainCapability")        CmmData
-mkMAP_FROZEN_CLEAN_infoLabel    = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
-mkMAP_FROZEN_DIRTY_infoLabel    = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
-mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkTopTickyCtrLabel              = CmmLabel rtsUnitId (fsLit "top_ct")                CmmData
-mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
-mkArrWords_infoLabel            = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS")         CmmInfo
-mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
-mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
-mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkBadAlignmentLabel             = CmmLabel rtsUnitId (fsLit "stg_badAlignment")      CmmEntry
+                                = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
+mkUpdInfoLabel                  = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame")         CmmInfo
+mkBHUpdInfoLabel                = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" )     CmmInfo
+mkIndStaticInfoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC")        CmmInfo
+mkMainCapabilityLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "MainCapability")        CmmData
+mkMAP_FROZEN_CLEAN_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
+mkMAP_FROZEN_DIRTY_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
+mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkTopTickyCtrLabel              = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct")                CmmData
+mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
+mkArrWords_infoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS")         CmmInfo
+mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
+mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
+mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry
 
 mkSRTInfoLabel :: Int -> CLabel
-mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
+mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
  where
    lbl =
      case n of
@@ -551,39 +573,56 @@ mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
 
 -----
 mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
-  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel
+  mkCmmCodeLabel, mkCmmClosureLabel
         :: UnitId -> FastString -> CLabel
 
-mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
-mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
-mkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo
-mkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet
-mkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode
-mkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData
-mkCmmClosureLabel   pkg str     = CmmLabel pkg str CmmClosure
+mkCmmDataLabel    :: UnitId -> NeedExternDecl -> FastString -> CLabel
+mkRtsCmmDataLabel :: FastString -> CLabel
+
+mkCmmInfoLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmInfo
+mkCmmEntryLabel      pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmEntry
+mkCmmRetInfoLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRetInfo
+mkCmmRetLabel        pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRet
+mkCmmCodeLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmCode
+mkCmmClosureLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmClosure
+mkCmmDataLabel       pkg ext str = CmmLabel pkg ext  str CmmData
+mkRtsCmmDataLabel    str         = CmmLabel rtsUnitId (NeedExternDecl False)  str CmmData
+                                    -- RTS symbols don't need "GHC.CmmToC" to
+                                    -- generate \"extern\" declaration (they are
+                                    -- exposed via includes/Stg.h)
 
 mkLocalBlockLabel :: Unique -> CLabel
 mkLocalBlockLabel u = LocalBlockLabel u
 
 -- Constructing RtsLabels
 mkRtsPrimOpLabel :: PrimOp -> CLabel
-mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
+mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
+
+mkSelectorInfoLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorInfoLabel dflags upd offset =
+   ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+   RtsLabel (RtsSelectorInfoTable upd offset)
+
+mkSelectorEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorEntryLabel dflags upd offset =
+   ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+   RtsLabel (RtsSelectorEntry upd offset)
 
-mkSelectorInfoLabel  :: Bool -> Int -> CLabel
-mkSelectorEntryLabel :: Bool -> Int -> CLabel
-mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
+mkApInfoTableLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApInfoTableLabel dflags upd arity =
+   ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+   RtsLabel (RtsApInfoTable upd arity)
 
-mkApInfoTableLabel :: Bool -> Int -> CLabel
-mkApEntryLabel     :: Bool -> Int -> CLabel
-mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
-mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
+mkApEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApEntryLabel dflags upd arity =
+   ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+   RtsLabel (RtsApEntry upd arity)
 
 
 -- A call to some primitive hand written Cmm code
 mkPrimCallLabel :: PrimCall -> CLabel
 mkPrimCallLabel (PrimCall str pkg)
-        = CmmLabel (toUnitId pkg) str CmmPrimCall
+        = CmmLabel (toUnitId pkg) (NeedExternDecl True) str CmmPrimCall
 
 
 -- Constructing ForeignLabels
@@ -621,7 +660,7 @@ isStaticClosureLabel :: CLabel -> Bool
 -- Closure defined in haskell (.hs)
 isStaticClosureLabel (IdLabel _ _ Closure) = True
 -- Closure defined in cmm
-isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True
+isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True
 isStaticClosureLabel _lbl = False
 
 -- | Whether label is a .rodata label
@@ -633,7 +672,7 @@ isSomeRODataLabel (IdLabel _ _ InfoTable) = True
 isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
 isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
 -- info table defined in cmm (.cmm)
-isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
+isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True
 isSomeRODataLabel _lbl = False
 
 -- | Whether label is points to some kind of info table
@@ -715,7 +754,7 @@ mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
 
 toClosureLbl :: CLabel -> CLabel
 toClosureLbl (IdLabel n c _) = IdLabel n c Closure
-toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
+toClosureLbl (CmmLabel m ext str _) = CmmLabel m ext str CmmClosure
 toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
 
 toSlowEntryLbl :: CLabel -> CLabel
@@ -730,16 +769,16 @@ toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
 toEntryLbl (IdLabel n _ BlockInfoTable)  = mkLocalBlockLabel (nameUnique n)
                               -- See Note [Proc-point local block entry-point].
 toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
-toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
-toEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
+toEntryLbl (CmmLabel m ext str CmmInfo)    = CmmLabel m ext str CmmEntry
+toEntryLbl (CmmLabel m ext str CmmRetInfo) = CmmLabel m ext str CmmRet
 toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
 
 toInfoLbl :: CLabel -> CLabel
 toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
 toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
 toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
-toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
-toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
+toInfoLbl (CmmLabel m ext str CmmEntry)= CmmLabel m ext str CmmInfo
+toInfoLbl (CmmLabel m ext str CmmRet)  = CmmLabel m ext str CmmRetInfo
 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
 
 hasHaskellName :: CLabel -> Maybe Name
@@ -791,10 +830,13 @@ needsCDecl (AsmTempLabel _)             = False
 needsCDecl (AsmTempDerivedLabel _ _)    = False
 needsCDecl (RtsLabel _)                 = False
 
-needsCDecl (CmmLabel pkgId _ _)
+needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _)
+        -- local labels mustn't have it
+        | not external                  = False
+
         -- Prototypes for labels defined in the runtime system are imported
         --      into HC files via includes/Stg.h.
-        | pkgId == rtsUnitId         = False
+        | pkgId == rtsUnitId            = False
 
         -- For other labels we inline one into the HC file directly.
         | otherwise                     = True
@@ -919,7 +961,7 @@ externallyVisibleCLabel (AsmTempLabel _)        = False
 externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
 externallyVisibleCLabel (RtsLabel _)            = True
 externallyVisibleCLabel (LocalBlockLabel _)     = False
-externallyVisibleCLabel (CmmLabel _ _ _)        = True
+externallyVisibleCLabel (CmmLabel _ _ _ _)      = True
 externallyVisibleCLabel (ForeignLabel{})        = True
 externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
 externallyVisibleCLabel (CC_Label _)            = True
@@ -962,14 +1004,14 @@ isGcPtrLabel lbl = case labelType lbl of
 --    whether it be code, data, or static GC object.
 labelType :: CLabel -> CLabelType
 labelType (IdLabel _ _ info)                    = idInfoLabelType info
-labelType (CmmLabel _ _ CmmData)                = DataLabel
-labelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel
-labelType (CmmLabel _ _ CmmCode)                = CodeLabel
-labelType (CmmLabel _ _ CmmInfo)                = DataLabel
-labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
-labelType (CmmLabel _ _ CmmPrimCall)            = CodeLabel
-labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
-labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
+labelType (CmmLabel _ _ _ CmmData)              = DataLabel
+labelType (CmmLabel _ _ _ CmmClosure)           = GcPtrLabel
+labelType (CmmLabel _ _ _ CmmCode)              = CodeLabel
+labelType (CmmLabel _ _ _ CmmInfo)              = DataLabel
+labelType (CmmLabel _ _ _ CmmEntry)             = CodeLabel
+labelType (CmmLabel _ _ _ CmmPrimCall)          = CodeLabel
+labelType (CmmLabel _ _ _ CmmRetInfo)           = DataLabel
+labelType (CmmLabel _ _ _ CmmRet)               = CodeLabel
 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsApFast _))              = CodeLabel
@@ -1039,7 +1081,7 @@ labelDynamic config this_mod lbl =
 
    -- When compiling in the "dyn" way, each package is to be linked into
    -- its own shared library.
-   CmmLabel pkg _ _
+   CmmLabel pkg _ _ _
     | os == OSMinGW32 -> externalDynamicRefs && (toUnitId this_pkg /= pkg)
     | otherwise       -> externalDynamicRefs
 
@@ -1209,7 +1251,7 @@ pprCLabel dflags = \case
    lbl -> getPprStyle $ \sty ->
             if useNCG && asmStyle sty
             then maybe_underscore $ pprAsmCLbl lbl
-            else pprCLbl dflags lbl
+            else pprCLbl platform lbl
 
   where
     platform = targetPlatform dflags
@@ -1226,10 +1268,10 @@ pprCLabel dflags = \case
         -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
         -- (The C compiler does this itself).
         = ftext fs <> char '@' <> int sz
-    pprAsmCLbl lbl = pprCLbl dflags lbl
+    pprAsmCLbl lbl = pprCLbl platform lbl
 
-pprCLbl :: DynFlags -> CLabel -> SDoc
-pprCLbl dflags = \case
+pprCLbl :: Platform -> CLabel -> SDoc
+pprCLbl platform = \case
    (StringLitLabel u)   -> pprUniqueAlways u <> text "_str"
    (SRTLabel u)         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
    (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
@@ -1238,16 +1280,15 @@ pprCLbl dflags = \case
                            -- until that gets resolved we'll just force them to start
                            -- with a letter so the label will be legal assembly code.
 
-   (CmmLabel _ str CmmCode)     -> ftext str
-   (CmmLabel _ str CmmData)     -> ftext str
-   (CmmLabel _ str CmmPrimCall) -> ftext str
+   (CmmLabel _ _ str CmmCode)     -> ftext str
+   (CmmLabel _ _ str CmmData)     -> ftext str
+   (CmmLabel _ _ str CmmPrimCall) -> ftext str
 
    (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
 
    (RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
 
    (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) ->
-    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
     hcat [text "stg_sel_", text (show offset),
           ptext (if upd_reqd
                  then (sLit "_upd_info")
@@ -1255,7 +1296,6 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsSelectorEntry upd_reqd offset)) ->
-    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
     hcat [text "stg_sel_", text (show offset),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
@@ -1263,7 +1303,6 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsApInfoTable upd_reqd arity)) ->
-    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
     hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_info")
@@ -1271,18 +1310,17 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsApEntry upd_reqd arity)) ->
-    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
     hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
                         else (sLit "_noupd_entry"))
         ]
 
-   (CmmLabel _ fs CmmInfo)    -> ftext fs <> text "_info"
-   (CmmLabel _ fs CmmEntry)   -> ftext fs <> text "_entry"
-   (CmmLabel _ fs CmmRetInfo) -> ftext fs <> text "_info"
-   (CmmLabel _ fs CmmRet)     -> ftext fs <> text "_ret"
-   (CmmLabel _ fs CmmClosure) -> ftext fs <> text "_closure"
+   (CmmLabel _ _ fs CmmInfo)    -> ftext fs <> text "_info"
+   (CmmLabel _ _ fs CmmEntry)   -> ftext fs <> text "_entry"
+   (CmmLabel _ _ fs CmmRetInfo) -> ftext fs <> text "_info"
+   (CmmLabel _ _ fs CmmRet)     -> ftext fs <> text "_ret"
+   (CmmLabel _ _ fs CmmClosure) -> ftext fs <> text "_closure"
 
    (RtsLabel (RtsPrimOp primop)) -> text "stg_" <> ppr primop
    (RtsLabel (RtsSlowFastTickyCtr pat)) ->
@@ -1301,8 +1339,6 @@ pprCLbl dflags = \case
    (DynamicLinkerLabel {})  -> panic "pprCLbl DynamicLinkerLabel"
    (PicBaseLabel {})        -> panic "pprCLbl PicBaseLabel"
    (DeadStripPreventer {})  -> panic "pprCLbl DeadStripPreventer"
-  where
-   platform = targetPlatform dflags
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <> text

compiler/GHC/Cmm/CallConv.hs

@@ -206,9 +206,13 @@ realArgRegsCover dflags
     | passFloatArgsInXmm (targetPlatform dflags)
     = map ($VGcPtr) (realVanillaRegs dflags) ++
       realLongRegs dflags ++
-      map XmmReg (realXmmRegNos dflags)
-    | otherwise                 = map ($VGcPtr) (realVanillaRegs dflags) ++
-                                  realFloatRegs dflags ++
-                                  realDoubleRegs dflags ++
-                                  realLongRegs dflags ++
-                                  map XmmReg (realXmmRegNos dflags)
+      realDoubleRegs dflags -- we only need to save the low Double part of XMM registers.
+                            -- Moreover, the NCG can't load/store full XMM
+                            -- registers for now...
+
+    | otherwise
+    = map ($VGcPtr) (realVanillaRegs dflags) ++
+      realFloatRegs dflags ++
+      realDoubleRegs dflags ++
+      realLongRegs dflags
+      -- we don't save XMM registers if they are not used for parameter passing