diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2022-10-19 21:25:19 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2023-03-15 22:55:06 -0400 |
| commit | 5c3418850c47cf1389ac2331191c458b8eb81d90 (patch) | |
| tree | d5a3dc917e0948913650d5fbc4ec466e7c7e7f40 | |
| parent | a58c028a181106312e1a783e82a37fc657ce9cfe (diff) | |
| download | haskell-5c3418850c47cf1389ac2331191c458b8eb81d90.tar.gz | |
base: Factor out errorBelch
This was useful when debugging
| -rw-r--r-- | libraries/base/GHC/TopHandler.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs index a2354175e4..3d2bce6b7a 100644 --- a/libraries/base/GHC/TopHandler.hs +++ b/libraries/base/GHC/TopHandler.hs @@ -208,13 +208,17 @@ real_handler exit se = do -- don't use errorBelch() directly, because we cannot call varargs functions -- using the FFI. foreign import ccall unsafe "HsBase.h errorBelch2" - errorBelch :: CString -> CString -> IO () + c_errorBelch :: CString -> CString -> IO () + +errorBelch :: String -> IO () +errorBelch msg = + withCAString "%s" $ \fmt -> + withCAString msg $ \msg' -> + c_errorBelch fmt msg' disasterHandler :: (Int -> IO a) -> IOError -> IO a disasterHandler exit _ = - withCAString "%s" $ \fmt -> - withCAString msgStr $ \msg -> - errorBelch fmt msg >> exit 1 + errorBelch msgStr >> exit 1 where msgStr = "encountered an exception while trying to report an exception.\n" ++ |