summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/coreSyn/MkCore.hs56
-rw-r--r--compiler/iface/IfaceType.hs4
-rw-r--r--compiler/main/HscTypes.hs2
-rw-r--r--compiler/prelude/PrelNames.hs35
-rw-r--r--compiler/prelude/TysWiredIn.hs66
-rw-r--r--compiler/typecheck/TcBinds.hs6
-rw-r--r--compiler/typecheck/TcExpr.hs1
-rw-r--r--compiler/typecheck/TcGenDeriv.hs6
-rw-r--r--compiler/typecheck/TcHsType.hs1
-rw-r--r--compiler/typecheck/TcInteract.hs6
-rw-r--r--compiler/typecheck/TcRnTypes.hs7
-rw-r--r--compiler/types/TyCoRep.hs2
-rw-r--r--compiler/types/Type.hs6
-rw-r--r--libraries/base/GHC/Err.hs14
m---------utils/haddock0
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
View Lorry Controller Status