un-wire-in error, undefined, CallStack, and IP

I missed a crucial step in the wiring-in process of `CallStack` in D861,
the bit where you actually wire-in the Name... This led to a nasty bug
where GHC thought `CallStack` was not wired-in and tried to fingerprint
it, which failed because the defining module was not loaded.

But we don't need `CallStack` to be wired-in anymore since `error` and
`undefined` no longer need to be wired-in. So we just remove them all.

Updates haddock submodule.

Test Plan: `./validate` and `make slowtest TEST=tc198`

Reviewers: simonpj, goldfire, austin, hvr, bgamari

Reviewed By: simonpj, bgamari

Subscribers: goldfire, thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D1739

GHC Trac Issues: #11331

15 files changed, 52 insertions, 160 deletions

diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs
index 05c1f38755..e869ebede6 100644
--- a/compiler/coreSyn/MkCore.hs
+++ b/compiler/coreSyn/MkCore.hs
@@ -44,8 +44,8 @@ module MkCore (
         mkRuntimeErrorApp, mkImpossibleExpr, errorIds,
         rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
         nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
-        pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,
-        uNDEFINED_ID, tYPE_ERROR_ID, undefinedName
+        pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,
+        tYPE_ERROR_ID
     ) where
 
 #include "HsVersions.h"
@@ -621,16 +621,7 @@ templates, but we don't ever expect to generate code for it.
 
 errorIds :: [Id]
 errorIds
-  = [ eRROR_ID,   -- This one isn't used anywhere else in the compiler
-                  -- But we still need it in wiredInIds so that when GHC
-                  -- compiles a program that mentions 'error' we don't
-                  -- import its type from the interface file; we just get
-                  -- the Id defined here.  Which has an 'open-tyvar' type.
-
-      uNDEFINED_ID,   -- Ditto for 'undefined'. The big deal is to give it
-                      -- an 'open-tyvar' type.
-
-      rUNTIME_ERROR_ID,
+  = [ rUNTIME_ERROR_ID,
       iRREFUT_PAT_ERROR_ID,
       nON_EXHAUSTIVE_GUARDS_ERROR_ID,
       nO_METHOD_BINDING_ERROR_ID,
@@ -684,35 +675,6 @@ runtimeErrorTy :: Type
 runtimeErrorTy = mkSpecSigmaTy [levity1TyVar, openAlphaTyVar] []
                                (mkFunTy addrPrimTy openAlphaTy)
 
-errorName :: Name
-errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID
-
-eRROR_ID :: Id
-eRROR_ID = pc_bottoming_Id2 errorName errorTy
-
-errorTy  :: Type   -- See Note [Error and friends have an "open-tyvar" forall]
-errorTy  = mkSpecSigmaTy [levity1TyVar, openAlphaTyVar] []
-             (mkFunTys [ mkClassPred
-                           ipClass
-                           [ mkStrLitTy (fsLit "callStack")
-                           , mkTyConTy callStackTyCon ]
-                       , mkListTy charTy]
-                       openAlphaTy)
-
-undefinedName :: Name
-undefinedName = mkWiredInIdName gHC_ERR (fsLit "undefined") undefinedKey uNDEFINED_ID
-
-uNDEFINED_ID :: Id
-uNDEFINED_ID = pc_bottoming_Id1 undefinedName undefinedTy
-
-undefinedTy  :: Type   -- See Note [Error and friends have an "open-tyvar" forall]
-undefinedTy  = mkSpecSigmaTy [levity1TyVar, openAlphaTyVar] []
-                 (mkFunTy (mkClassPred
-                             ipClass
-                             [ mkStrLitTy (fsLit "callStack")
-                             , mkTyConTy callStackTyCon ])
-                          openAlphaTy)
-
 {-
 Note [Error and friends have an "open-tyvar" forall]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -753,14 +715,4 @@ pc_bottoming_Id1 name ty
         -- SRTs.
 
     strict_sig = mkClosedStrictSig [evalDmd] exnRes
-                 -- exnRes: these throw an exception, not just diverge
-
-pc_bottoming_Id2 :: Name -> Type -> Id
--- Same but arity two
-pc_bottoming_Id2 name ty
- = mkVanillaGlobalWithInfo name ty bottoming_info
- where
-    bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig
-                                   `setArityInfo`      2
-    strict_sig = mkClosedStrictSig [evalDmd, evalDmd] exnRes
-                 -- exnRes: these throw an exception, not just diverge
+              -- exnRes: these throw an exception, not just diverge
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 154b7c46d8..ac3f1b65db 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -67,7 +67,7 @@ import Var
 -- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
 import TysWiredIn
 import TysPrim
-import PrelNames( funTyConKey )
+import PrelNames( funTyConKey, ipClassKey )
 import Name
 import BasicTypes
 import Binary
@@ -776,7 +776,7 @@ pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)
 
 pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
 pprTyTcApp ctxt_prec tc tys dflags
-  | ifaceTyConName tc == getName ipTyCon
+  | ifaceTyConName tc `hasKey` ipClassKey
   , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
   = char '?' <> ftext n <> ptext (sLit "::") <> ppr_ty TopPrec ty
 
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index bb978d63ab..e8d6d23c0d 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1626,7 +1626,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
         forceUnqualNames :: [Name]
         forceUnqualNames =
           map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon
-                        , starKindTyCon, unicodeStarKindTyCon, ipTyCon ]
+                        , starKindTyCon, unicodeStarKindTyCon ]
           ++ [ eqTyConName ]
 
         right_name gre = nameModule_maybe (gre_name gre) == Just mod
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index cc5c854260..bc7951a5ec 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -326,9 +326,14 @@ basicKnownKeyNames
         -- Overloaded labels
         isLabelClassName,
 
-        -- Source locations
-        callStackDataConName, callStackTyConName,
+        -- Implicit Parameters
+        ipClassName,
+
+        -- Call Stacks
+        callStackTyConName,
         emptyCallStackName, pushCallStackName,
+
+        -- Source Locations
         srcLocDataConName,
 
         -- Annotation type checking
@@ -1327,11 +1332,14 @@ isLabelClassName :: Name
 isLabelClassName
  = clsQual gHC_OVER_LABELS (fsLit "IsLabel") isLabelClassNameKey
 
+-- Implicit Parameters
+ipClassName :: Name
+ipClassName
+  = clsQual gHC_CLASSES (fsLit "IP") ipClassKey
+
 -- Source Locations
-callStackDataConName, callStackTyConName, emptyCallStackName, pushCallStackName,
+callStackTyConName, emptyCallStackName, pushCallStackName,
   srcLocDataConName :: Name
-callStackDataConName
-  = dcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackDataConKey
 callStackTyConName
   = tcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackTyConKey
 emptyCallStackName
@@ -1484,6 +1492,10 @@ semigroupClassKey, monoidClassKey :: Unique
 semigroupClassKey = mkPreludeClassUnique 46
 monoidClassKey    = mkPreludeClassUnique 47
 
+-- Implicit Parameters
+ipClassKey :: Unique
+ipClassKey = mkPreludeClassUnique 48
+
 ---------------- Template Haskell -------------------
 --      THNames.hs: USES ClassUniques 200-299
 -----------------------------------------------------
@@ -1711,13 +1723,6 @@ callStackTyConKey = mkPreludeTyConUnique 182
 typeRepTyConKey :: Unique
 typeRepTyConKey = mkPreludeTyConUnique 183
 
--- Implicit Parameters
-ipTyConKey :: Unique
-ipTyConKey = mkPreludeTyConUnique 184
-
-ipCoNameKey :: Unique
-ipCoNameKey = mkPreludeTyConUnique 185
-
 ---------------- Template Haskell -------------------
 --      THNames.hs: USES TyConUniques 200-299
 -----------------------------------------------------
@@ -1792,13 +1797,9 @@ staticPtrInfoDataConKey                 = mkPreludeDataConUnique 34
 fingerprintDataConKey :: Unique
 fingerprintDataConKey                   = mkPreludeDataConUnique 35
 
-callStackDataConKey, srcLocDataConKey :: Unique
-callStackDataConKey                     = mkPreludeDataConUnique 36
+srcLocDataConKey :: Unique
 srcLocDataConKey                        = mkPreludeDataConUnique 37
 
-ipDataConKey :: Unique
-ipDataConKey                            = mkPreludeDataConUnique 38
-
 -- Levity
 liftedDataConKey, unliftedDataConKey :: Unique
 liftedDataConKey                        = mkPreludeDataConUnique 39
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 49655b46fe..3b2213d359 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -83,11 +83,6 @@ module TysWiredIn (
         heqTyCon, heqClass, heqDataCon,
         coercibleTyCon, coercibleDataCon, coercibleClass,
 
-        -- * Implicit Parameters
-        ipTyCon, ipDataCon, ipClass,
-
-        callStackTyCon,
-
         mkWiredInTyConName, -- This is used in TcTypeNats to define the
                             -- built-in functions for evaluation.
 
@@ -112,7 +107,6 @@ import PrelNames
 import TysPrim
 
 -- others:
-import FamInstEnv( mkNewTypeCoAxiom )
 import CoAxiom
 import Id
 import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
@@ -233,7 +227,6 @@ wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
               , liftedTypeKindTyCon
               , starKindTyCon
               , unicodeStarKindTyCon
-              , ipTyCon
               ]
 
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -248,13 +241,6 @@ mkWiredInDataConName built_in modu fs unique datacon
                   (AConLike (RealDataCon datacon))    -- Relevant DataCon
                   built_in
 
-mkWiredInCoAxiomName :: BuiltInSyntax -> Module -> FastString -> Unique
-                     -> CoAxiom Branched -> Name
-mkWiredInCoAxiomName built_in modu fs unique ax
-  = mkWiredInName modu (mkTcOccFS fs) unique
-                  (ACoAxiom ax)        -- Relevant CoAxiom
-                  built_in
-
 mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
 mkWiredInIdName mod fs uniq id
  = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax
@@ -1113,55 +1099,3 @@ promotedGTDataCon     = promoteDataCon gtDataCon
 promotedConsDataCon, promotedNilDataCon :: TyCon
 promotedConsDataCon   = promoteDataCon consDataCon
 promotedNilDataCon    = promoteDataCon nilDataCon
-
-{-
-Note [The Implicit Parameter class]
-
-Implicit parameters `?x :: a` are desugared into dictionaries for the
-class `IP "x" a`, which is defined (in GHC.Classes) as
-
-  class IP (x :: Symbol) a | x -> a
-
-This class is wired-in so that `error` and `undefined`, which have
-wired-in types, can use the implicit-call-stack feature to provide
-a call-stack alongside the error message.
--}
-
-ipDataConName, ipTyConName, ipCoName :: Name
-ipDataConName = mkWiredInDataConName UserSyntax gHC_CLASSES (fsLit "IP")
-                  ipDataConKey ipDataCon
-ipTyConName   = mkWiredInTyConName UserSyntax gHC_CLASSES (fsLit "IP")
-                  ipTyConKey ipTyCon
-ipCoName      = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP")
-                  ipCoNameKey (toBranchedAxiom ipCoAxiom)
-
--- See Note [The Implicit Parameter class]
-ipTyCon :: TyCon
-ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive
-                       (mkPrelTyConRepName ipTyConName)
-  where
-    kind = mkFunTys [typeSymbolKind, liftedTypeKind] constraintKind
-    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
-    rhs = NewTyCon ipDataCon (mkTyVarTy a) ([], mkTyVarTy a) ipCoAxiom
-
-ipCoAxiom :: CoAxiom Unbranched
-ipCoAxiom = mkNewTypeCoAxiom ipCoName ipTyCon [ip,a] [Nominal, Nominal] (mkTyVarTy a)
-  where
-    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
-
-ipDataCon :: DataCon
-ipDataCon = pcDataCon ipDataConName [ip,a] ts ipTyCon
-  where
-    [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
-    ts  = [mkTyVarTy a]
-
-ipClass :: Class
-ipClass = mkClass (tyConTyVars ipTyCon) [([ip], [a])] [] [] [] [] (mkAnd [])
-            ipTyCon
-  where
-    [ip, a] = tyConTyVars ipTyCon
-
--- this is a fake version of the CallStack TyCon so we can refer to it
--- in MkCore.errorTy
-callStackTyCon :: TyCon
-callStackTyCon = pcNonRecDataTyCon callStackTyConName Nothing [] []
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 905d9c71f0..c955dea238 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -38,7 +38,6 @@ import FamInst( tcGetFamInstEnvs )
 import TyCon
 import TcType
 import TysPrim
-import TysWiredIn
 import Id
 import Var
 import VarSet
@@ -58,7 +57,7 @@ import BasicTypes
 import Outputable
 import FastString
 import Type(mkStrLitTy, tidyOpenType)
-import PrelNames( mkUnboundName, gHC_PRIM )
+import PrelNames( mkUnboundName, gHC_PRIM, ipClassName )
 import TcValidity (checkValidType)
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -233,7 +232,8 @@ tcLocalBinds (HsValBinds (ValBindsOut binds sigs)) thing_inside
 tcLocalBinds (HsValBinds (ValBindsIn {})) _ = panic "tcLocalBinds"
 
 tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
-  = do  { (given_ips, ip_binds') <-
+  = do  { ipClass <- tcLookupClass ipClassName
+        ; (given_ips, ip_binds') <-
             mapAndUnzipM (wrapLocSndM (tc_ip_bind ipClass)) ip_binds
 
         -- If the binding binds ?x = E, we  must now
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 592b0bfbf7..575e1920fc 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -199,6 +199,7 @@ tcExpr e@(HsIPVar x) res_ty
               be a tau-type.) -}
          ip_ty <- newOpenFlexiTyVarTy
        ; let ip_name = mkStrLitTy (hsIPNameFS x)
+       ; ipClass <- tcLookupClass ipClassName
        ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])
        ; tcWrapResult e (fromDict ipClass ip_name ip_ty (HsVar (noLoc ip_var)))
                       ip_ty res_ty }
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 2990e18f10..c4279a7698 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -41,8 +41,7 @@ import Encoding
 import DynFlags
 import PrelInfo
 import FamInstEnv( FamInst )
-import MkCore ( eRROR_ID )
-import PrelNames hiding (error_RDR)
+import PrelNames
 import THNames
 import Module ( moduleName, moduleNameString
               , moduleUnitId, unitIdString )
@@ -2384,10 +2383,9 @@ f_Pat           = nlVarPat f_RDR
 k_Pat           = nlVarPat k_RDR
 z_Pat           = nlVarPat z_RDR
 
-minusInt_RDR, tagToEnum_RDR, error_RDR :: RdrName
+minusInt_RDR, tagToEnum_RDR :: RdrName
 minusInt_RDR  = getRdrName (primOpId IntSubOp   )
 tagToEnum_RDR = getRdrName (primOpId TagToEnumOp)
-error_RDR     = getRdrName eRROR_ID
 
 con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
 -- Generates Orig s RdrName, for the binding positions
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index f8bf291d5d..421df69a53 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -616,6 +616,7 @@ tc_hs_type mode (HsIParamTy n ty) exp_kind
   = do { MASSERT( isTypeLevel (mode_level mode) )
        ; ty' <- tc_lhs_type mode ty liftedTypeKind
        ; let n' = mkStrLitTy $ hsIPNameFS n
+       ; ipClass <- tcLookupClass ipClassName
        ; checkExpectedKind (mkClassPred ipClass [n',ty'])
            constraintKind exp_kind }
 
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 37b86149c6..9722166565 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -24,8 +24,8 @@ import TcType
 import Name
 import PrelNames ( knownNatClassName, knownSymbolClassName,
                    typeableClassName, coercibleTyConKey,
-                   heqTyConKey )
-import TysWiredIn ( ipClass, typeNatKind, typeSymbolKind, heqDataCon,
+                   heqTyConKey, ipClassKey )
+import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon,
                     coercibleDataCon )
 import TysPrim    ( eqPrimTyCon, eqReprPrimTyCon )
 import Id( idType )
@@ -716,7 +716,7 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
          else
             continueWith workItem }
 
-  | cls == ipClass
+  | cls `hasKey` ipClassKey
   , isGiven ev_w
   = interactGivenIP inerts workItem
 
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 6f2f2e3bdd..a2f40454a0 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -130,7 +130,6 @@ import HsSyn
 import CoreSyn
 import HscTypes
 import TcEvidence
-import TysWiredIn ( callStackTyCon, ipClass )
 import Type
 import Class    ( Class )
 import TyCon    ( TyCon )
@@ -139,6 +138,8 @@ import ConLike  ( ConLike(..) )
 import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )
 import PatSyn   ( PatSyn, patSynType )
 import Id       ( idName )
+import PrelNames ( callStackTyConKey, ipClassKey )
+import Unique ( hasKey )
 import FieldLabel ( FieldLabel )
 import TcType
 import Annotations
@@ -1757,10 +1758,10 @@ isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of
 -- If so, returns @Just "name"@.
 isCallStackCt :: Ct -> Maybe FastString
 isCallStackCt CDictCan { cc_class = cls, cc_tyargs = tys }
-  | cls == ipClass
+  | cls `hasKey` ipClassKey
   , [ip_name_ty, ty] <- tys
   , Just (tc, _) <- splitTyConApp_maybe ty
-  , tc == callStackTyCon
+  , tc `hasKey` callStackTyConKey
   = isStrLitTy ip_name_ty
 isCallStackCt _
   = Nothing
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index d9bbfdb42c..0013b0523a 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -2367,7 +2367,7 @@ pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc
 -- Used for types only; so that we can make a
 -- special case for type-level lists
 pprTyTcApp p tc tys
-  | tc `hasKey` ipTyConKey
+  | tc `hasKey` ipClassKey
   , [LitTy (StrTyLit n),ty] <- tys
   = maybeParen p FunPrec $
     char '?' <> ftext n <> ptext (sLit "::") <> ppr_type TopPrec ty
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 3572434345..3dcc3d79a5 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1554,11 +1554,11 @@ isIPPred ty = case tyConAppTyCon_maybe ty of
     _       -> False
 
 isIPTyCon :: TyCon -> Bool
-isIPTyCon tc = tc `hasKey` ipTyConKey
+isIPTyCon tc = tc `hasKey` ipClassKey
+  -- Class and its corresponding TyCon have the same Unique
 
 isIPClass :: Class -> Bool
-isIPClass cls = cls `hasKey` ipTyConKey
-  -- Class and it corresponding TyCon have the same Unique
+isIPClass cls = cls `hasKey` ipClassKey
 
 isCTupleClass :: Class -> Bool
 isCTupleClass cls = isTupleTyCon (classTyCon cls)
diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs
index af6d119ff1..f786359ba2 100644
--- a/libraries/base/GHC/Err.hs
+++ b/libraries/base/GHC/Err.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}
+{-# LANGUAGE RankNTypes, TypeInType #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -23,7 +24,7 @@
 
 module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where
 import GHC.CString ()
-import GHC.Types (Char)
+import GHC.Types (Char, Levity)
 import GHC.Stack.Types
 import GHC.Prim
 import GHC.Integer ()   -- Make sure Integer is compiled first
@@ -32,13 +33,15 @@ import GHC.Integer ()   -- Make sure Integer is compiled first
 import {-# SOURCE #-} GHC.Exception( errorCallWithCallStackException )
 
 -- | 'error' stops execution and displays an error message.
-error :: (?callStack :: CallStack) => [Char] -> a
+error :: forall (v :: Levity). forall (a :: TYPE v).
+         (?callStack :: CallStack) => [Char] -> a
 error s = raise# (errorCallWithCallStackException s ?callStack)
 
 -- | A variant of 'error' that does not produce a stack trace.
 --
 -- @since 4.9.0.0
-errorWithoutStackTrace :: [Char] -> a
+errorWithoutStackTrace :: forall (v :: Levity). forall (a :: TYPE v).
+                          [Char] -> a
 errorWithoutStackTrace s
   = let ?callStack = freezeCallStack ?callStack
     in error s
@@ -59,14 +62,15 @@ errorWithoutStackTrace s
 -- name of the offending partial function, so the partial stack-trace
 -- does not provide any extra information, just noise. Thus, we export
 -- the callstack-aware error, but within base we use the
--- errorWithoutStackTrace variant for more hygienic erorr messages.
+-- errorWithoutStackTrace variant for more hygienic error messages.
 
 
 -- | A special case of 'error'.
 -- It is expected that compilers will recognize this and insert error
 -- messages which are more appropriate to the context in which 'undefined'
 -- appears.
-undefined :: (?callStack :: CallStack) => a
+undefined :: forall (v :: Levity). forall (a :: TYPE v).
+             (?callStack :: CallStack) => a
 undefined =  error "Prelude.undefined"
 
 -- | Used for compiler-generated error message;
diff --git a/utils/haddock b/utils/haddock
-Subproject c2e89153c0aaf2dc4e3908701f19d739eb0d8b9
+Subproject 8269b349dd04f7561f9fe6c9e4ba514d3a7d21a