diff options
| -rw-r--r-- | compiler/GHC/Core/Make.hs | 8 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 1 | ||||
| -rw-r--r-- | libraries/base/Control/Exception/Base.hs | 6 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Prim/Panic.hs | 58 | ||||
| -rw-r--r-- | rts/Exception.cmm | 6 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 1 | ||||
| -rw-r--r-- | rts/linker/PEi386.c | 2 | ||||
| -rw-r--r-- | utils/genprimopcode/Main.hs | 2 |
8 files changed, 78 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 35428156b9..42a1b78c0c 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -769,7 +769,6 @@ absentSumFieldErrorName :: Name raiseOverflowName, raiseUnderflowName, raiseDivZeroName :: Name recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID -absentErrorName = err_nm "absentError" absentErrorIdKey aBSENT_ERROR_ID runtimeErrorName = err_nm "runtimeError" runtimeErrorIdKey rUNTIME_ERROR_ID recConErrorName = err_nm "recConError" recConErrorIdKey rEC_CON_ERROR_ID patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID @@ -860,6 +859,13 @@ absentSumFieldErrorName absentSumFieldErrorIdKey aBSENT_SUM_FIELD_ERROR_ID +absentErrorName + = mkWiredInIdName + gHC_PRIM_PANIC + (fsLit "absentError") + absentErrorIdKey + aBSENT_ERROR_ID + raiseOverflowName = mkWiredInIdName gHC_PRIM_EXCEPTION diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 5ffdd5cd7b..66fe9663ba 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -423,6 +423,7 @@ RTS_FUN_DECL(stg_raiseUnderflowzh); RTS_FUN_DECL(stg_raiseOverflowzh); RTS_FUN_DECL(stg_raiseIOzh); RTS_FUN_DECL(stg_paniczh); +RTS_FUN_DECL(stg_absentErrorzh); RTS_FUN_DECL(stg_makeStableNamezh); RTS_FUN_DECL(stg_makeStablePtrzh); diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index 0b8d822b58..35218c4ffb 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -95,7 +95,7 @@ module Control.Exception.Base ( -- * Calls for GHC runtime recSelError, recConError, runtimeError, nonExhaustiveGuardsError, patError, noMethodBindingError, - absentError, typeError, + typeError, nonTermination, nestedAtomically, ) where @@ -391,15 +391,15 @@ instance Exception NestedAtomically ----- +-- See Note [Compiler error functions] in ghc-prim:GHC.Prim.Panic recSelError, recConError, runtimeError, nonExhaustiveGuardsError, patError, noMethodBindingError, - absentError, typeError + typeError :: Addr# -> a -- All take a UTF8-encoded C string recSelError s = throw (RecSelError ("No match in record selector " ++ unpackCStringUtf8# s)) -- No location info unfortunately runtimeError s = errorWithoutStackTrace (unpackCStringUtf8# s) -- No location info unfortunately -absentError s = errorWithoutStackTrace ("Oops! Entered absent arg " ++ unpackCStringUtf8# s) nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) recConError s = throw (RecConError (untangle s "Missing field in record construction")) diff --git a/libraries/ghc-prim/GHC/Prim/Panic.hs b/libraries/ghc-prim/GHC/Prim/Panic.hs index 21ebc56a88..0aa07813c1 100644 --- a/libraries/ghc-prim/GHC/Prim/Panic.hs +++ b/libraries/ghc-prim/GHC/Prim/Panic.hs @@ -9,6 +9,7 @@ module GHC.Prim.Panic ( absentSumFieldError , panicError + , absentError ) where @@ -17,10 +18,56 @@ import GHC.Magic default () -- Double and Integer aren't available yet +{- +Note [Compiler error functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Most error functions (such as pattern match failure) are defined +in base:Control.Exception.Base. But absentError# and absentSumFieldError# +are defined here in the ghc-prim package for two reasons: + +* GHC itself generates calls to these functions as a result of + strictness analysis, over which the programmer has no control. So + it is hard to ensure that no such calls exist in the modules + compiled "before" Control.Base.Exception. (E.g. when compiling + with -fdicts-strict.) + +* A consequence of defining them in ghc-prim is that the libraries + defining exceptions have not yet been built, so we can't make them + into proper Haskell exceptions. + + However, if these functions are ever called, it's a /compiler/ error, + not a user error, so it seems acceptable that they cannot be caught. + +One might wonder why absentError doesn't just call panic#. +For absent error we want to combine two parts, one static, one call site +dependent into one error message. While for absentSumFieldError it's a +static string. + +The easiest way to combine the two parts for absentError is to use a +format string with `barf` in the RTS passing the *dynamic* part of the +error as argument. There is no need to do any of this for +absentSumFieldError as it's a static string there. + +The alternatives would be to: +* Drop the call site specific information from absentError. + The call site specific information is at times very helpful for debugging + so I don't consider this an option. +* Remove the common prefix. We would then need to include the prefix + in the call site specific string we pass to absentError. Increasing + code size for no good reason. + +Both of which seem worse than having an stg_absentError function specific to +absentError to me. +-} + -- `stg_panic#` never returns but it can't just return `State# RealWorld` so we -- indicate that it returns `(# #)` too to make the compiler happy. +-- See Note [Compiler error functions] foreign import prim "stg_paniczh" panic# :: Addr# -> State# RealWorld -> (# State# RealWorld, (# #) #) +-- See Note [Compiler error functions] +foreign import prim "stg_absentErrorzh" stg_absentError# :: Addr# -> State# RealWorld -> (# State# RealWorld, (# #) #) + -- | Display the CString whose address is given as an argument and exit. panicError :: Addr# -> a panicError errmsg = @@ -43,3 +90,14 @@ absentSumFieldError = panicError "entered absent sum field!"# -- introduced in Stg.Unarise, long after inlining has stopped, but it seems -- more direct simply to give it a NOINLINE pragma {-# NOINLINE absentSumFieldError #-} + +-- | Displays "Oops! Entered absent arg" ++ errormsg and exits the program. +{-# NOINLINE absentError #-} +absentError :: Addr# -> a +absentError errmsg = + runRW# (\s -> + case stg_absentError# errmsg s of + (# _, _ #) -> -- This bottom is unreachable but we can't + -- use an empty case lest the pattern match + -- checker squawks. + let x = x in x) diff --git a/rts/Exception.cmm b/rts/Exception.cmm index 3216edbcc4..edbd657251 100644 --- a/rts/Exception.cmm +++ b/rts/Exception.cmm @@ -660,3 +660,9 @@ stg_paniczh (W_ str) { ccall barf(str) never returns; } + +// See Note [Compiler error functions] in GHC.Prim.Panic +stg_absentErrorzh (W_ str) +{ + ccall barf("Oops! Entered absent arg %s", str) never returns; +} diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index a3ee8505ae..7ea833ce55 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -747,6 +747,7 @@ SymI_HasProto(stg_raiseOverflowzh) \ SymI_HasProto(stg_raiseIOzh) \ SymI_HasProto(stg_paniczh) \ + SymI_HasProto(stg_absentErrorzh) \ SymI_HasProto(stg_readTVarzh) \ SymI_HasProto(stg_readTVarIOzh) \ SymI_HasProto(resumeThread) \ diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 32efdec471..f39930c8c5 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -1836,7 +1836,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) /* ToDo: should be variable-sized? But is at least safe in the sense of buffer-overrun-proof. */ uint8_t symbol[1000]; - /* debugBelch("resolving for %s\n", oc->fileName); */ + /* debugBelch("resolving for %"PATH_FMT "\n", oc->fileName); */ /* Such libraries have been partially freed and can't be resolved. */ if (oc->status == OBJECT_DONT_RESOLVE) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index e6e89735e5..7fe672387c 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -622,7 +622,7 @@ gen_wrappers (Info _ entries) -- Performing WW on this module is harmful even, two reasons: -- 1. Inferred strictness signatures are all bottom, which is a lie -- 2. Doing the worker/wrapper split based on that information will - -- introduce references to Control.Exception.Base.absentError, + -- introduce references to absentError, -- which isn't available at this point. ++ "module GHC.PrimopWrappers where\n" ++ "import qualified GHC.Prim\n" |