From: simonmar <unknown>
Date: Mon, 21 May 2001 14:07:31 +0000 (+0000)
Subject: [project @ 2001-05-21 14:07:31 by simonmar]
X-Git-Tag: Approximately_9120_patches~1913
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4488f35748cdd166f6c85ef0a91eb2d7237e1c5b;p=ghc-hetmet.git

[project @ 2001-05-21 14:07:31 by simonmar]
Move topHandler and friends into a module on their own.  They can't go
in PrelMain, because PrelMain isn't included in HSstd.o (because
PrelMain depends on Main, which doesn't exist yet...)
---

diff --git a/ghc/lib/std/PrelMain.lhs b/ghc/lib/std/PrelMain.lhs
index 6674dc3..d484482 100644
--- a/ghc/lib/std/PrelMain.lhs
+++ b/ghc/lib/std/PrelMain.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelMain.lhs,v 1.8 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelMain.lhs,v 1.9 2001/05/21 14:07:31 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -7,69 +7,16 @@
 \section[PrelMain]{Module @PrelMain@}
 
 \begin{code}
-module PrelMain( mainIO, reportStackOverflow, reportError ) where
+module PrelMain( mainIO ) where
 
-import Prelude
 import {-# SOURCE #-} qualified Main	-- for type of "Main.main"
 
 import IO
-import PrelCString
-import PrelPtr
 import PrelException
-\end{code}
+import PrelTopHandler
 
-\begin{code}
 mainIO :: IO ()		-- It must be of type (IO t) because that's what
 			-- the RTS expects.  GHC doesn't check this, so
 			-- make sure this type signature stays!
 mainIO = catchException Main.main topHandler
-
--- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and 
--- PrelMain.mainIO) and report them - topHandler is the exception
--- handler they should use for this:
-
--- make sure we handle errors while reporting the error!
--- (e.g. evaluating the string passed to 'error' might generate
---  another error, etc.)
-topHandler :: Exception -> IO ()
-topHandler err = catchException (real_handler err) topHandler
-
-real_handler :: Exception -> IO ()
-real_handler ex =
-  case ex of
-	AsyncException StackOverflow -> reportStackOverflow True
-	ErrorCall s -> reportError True s
-	other       -> reportError True (showsPrec 0 other "\n")
-
-reportStackOverflow :: Bool -> IO ()
-reportStackOverflow bombOut = do
-   (hFlush stdout) `catchException` (\ _ -> return ())
-   callStackOverflowHook
-   if bombOut then
-     stg_exit 2
-    else
-     return ()
-
-reportError :: Bool -> String -> IO ()
-reportError bombOut str = do
-   (hFlush stdout) `catchException` (\ _ -> return ())
-   withCStringLen str $ \(cstr,len) -> do
-     writeErrString addrOf_ErrorHdrHook cstr len
-     if bombOut 
-	then stg_exit 1
-        else return ()
-
-foreign import ccall "addrOf_ErrorHdrHook" unsafe
-        addrOf_ErrorHdrHook :: Ptr ()
-
-foreign import ccall "writeErrString__" unsafe
-	writeErrString :: Ptr () -> CString -> Int -> IO ()
-
--- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
--- the unsafe below.
-foreign import ccall "stackOverflow" unsafe
-	callStackOverflowHook :: IO ()
-
-foreign import ccall "stg_exit" unsafe
-	stg_exit :: Int -> IO ()
 \end{code}
diff --git a/ghc/lib/std/PrelTopHandler.lhs b/ghc/lib/std/PrelTopHandler.lhs
new file mode 100644
index 0000000..ad0f9af
--- /dev/null
+++ b/ghc/lib/std/PrelTopHandler.lhs
@@ -0,0 +1,73 @@
+-- -----------------------------------------------------------------------------
+-- $Id: PrelTopHandler.lhs,v 1.1 2001/05/21 14:07:31 simonmar Exp $
+--
+-- (c) The University of Glasgow, 2001
+--
+-- PrelTopHandler
+--
+-- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and 
+-- PrelMain.mainIO) and report them - topHandler is the exception
+-- handler they should use for this:
+
+-- make sure we handle errors while reporting the error!
+-- (e.g. evaluating the string passed to 'error' might generate
+--  another error, etc.)
+
+-- These functions can't go in PrelMain, because PrelMain isn't
+-- included in HSstd.o (because PrelMain depends on Main, which
+-- doesn't exist yet...).
+
+\begin{code}
+module PrelTopHandler (
+   topHandler, reportStackOverflow, reportError 
+  ) where
+
+import IO
+
+import PrelCString
+import PrelPtr
+import PrelIOBase
+import PrelException
+
+topHandler :: Exception -> IO ()
+topHandler err = catchException (real_handler err) topHandler
+
+real_handler :: Exception -> IO ()
+real_handler ex =
+  case ex of
+	AsyncException StackOverflow -> reportStackOverflow True
+	ErrorCall s -> reportError True s
+	other       -> reportError True (showsPrec 0 other "\n")
+
+reportStackOverflow :: Bool -> IO ()
+reportStackOverflow bombOut = do
+   (hFlush stdout) `catchException` (\ _ -> return ())
+   callStackOverflowHook
+   if bombOut then
+     stg_exit 2
+    else
+     return ()
+
+reportError :: Bool -> String -> IO ()
+reportError bombOut str = do
+   (hFlush stdout) `catchException` (\ _ -> return ())
+   withCStringLen str $ \(cstr,len) -> do
+     writeErrString addrOf_ErrorHdrHook cstr len
+     if bombOut 
+	then stg_exit 1
+        else return ()
+
+foreign import ccall "addrOf_ErrorHdrHook" unsafe
+        addrOf_ErrorHdrHook :: Ptr ()
+
+foreign import ccall "writeErrString__" unsafe
+	writeErrString :: Ptr () -> CString -> Int -> IO ()
+
+-- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
+-- the unsafe below.
+foreign import ccall "stackOverflow" unsafe
+	callStackOverflowHook :: IO ()
+
+foreign import ccall "stg_exit" unsafe
+	stg_exit :: Int -> IO ()
+\end{code}