Move absentError into ghc-prim.

When using -fdicts-strict we generate references to absentError while
compiling ghc-prim. However we always load ghc-prim before base so this
caused linker errors.

We simply solve this by moving absentError into ghc-prim. This does mean
it's now a panic instead of an exception which can no longer be caught.
But given that it should only be thrown if there is a compiler error
that seems acceptable, and in fact we already do this for
absentSumFieldError which has similar constraints.

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"