[project @ 2002-03-26 22:08:44 by sof]

[ghc-hetmet.git] / ghc / compiler / main / Main.hs

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 1e7e16a..a5d8c64 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.95 2002/03/04 14:40:54 simonmar Exp $
+-- $Id: Main.hs,v 1.101 2002/03/26 22:08:44 sof Exp $
 --
 -- GHC Driver program
 --
@@ -30,7 +30,7 @@ import SysTools               ( getPackageConfigPath, initSysTools, cleanTempFiles )
 import Packages                ( showPackages )
 
 import DriverPipeline  ( doLink, doMkDLL, genPipeline, pipeLoop )
-import DriverState     ( buildCoreToDo, buildStgToDo, defaultHscLang,
+import DriverState     ( buildCoreToDo, buildStgToDo,
                          findBuildTag, getPackageInfo, unregFlags, 
                          v_GhcMode, v_GhcModeFlag, GhcMode(..),
                          v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs,
@@ -48,7 +48,8 @@ import DriverUtil     ( add, handle, handleDyn, later, splitFilename,
                          unknownFlagErr, getFileSuffix )
 import CmdLineOpts     ( dynFlag, restoreDynFlags,
                          saveDynFlags, setDynFlags, getDynFlags, dynFlag,
-                         DynFlags(..), HscLang(..), v_Static_hsc_opts
+                         DynFlags(..), HscLang(..), v_Static_hsc_opts,
+                         defaultHscLang
                        )
 import Outputable
 import Util
@@ -58,20 +59,21 @@ import Panic                ( GhcException(..), panic )
 import IO
 import Directory       ( doesFileExist )
 import IOExts          ( readIORef, writeIORef )
-import Exception       ( throwDyn, Exception(..) )
+import Exception       ( throwDyn, Exception(..), 
+                         AsyncException(StackOverflow) )
 import System          ( getArgs, exitWith, ExitCode(..) )
 import Monad
 import List
 import Maybe
 
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
 import Concurrent      ( myThreadId )
-#if __GLASGOW_HASKELL__ < 500
+# if __GLASGOW_HASKELL__ < 500
 import Exception        ( raiseInThread )
 #define throwTo  raiseInThread
-#else
+# else
 import Exception       ( throwTo )
-#endif
+# endif
 
 import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
 import Dynamic         ( toDyn )
@@ -107,7 +109,10 @@ main =
           case exception of
                -- an IO exception probably isn't our fault, so don't panic
                IOException _ ->  hPutStr stderr (show exception)
-               _other        ->  hPutStr stderr (show (Panic (show exception)))
+               AsyncException StackOverflow ->
+                       hPutStrLn stderr "stack overflow: use +RTS -K<size> \ 
+                                        \to increase it"
+               _other ->  hPutStr stderr (show (Panic (show exception)))
           exitWith (ExitFailure 1)
          ) $ do
 
@@ -132,7 +137,7 @@ main =
        -- signals.
 
        -- install signal handlers
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
    main_thread <- myThreadId
    let sig_handler = Catch (throwTo main_thread 
                                (DynException (toDyn Interrupted)))