[project @ 2002-08-29 15:44:11 by simonmar]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index ed21b0c..5687bfb 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.97 2002/03/05 11:22:44 simonmar Exp $
+-- $Id: Main.hs,v 1.109 2002/08/29 15:44:15 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -18,7 +18,7 @@ module Main (main) where
 
 
 #ifdef GHCI
-import InteractiveUI(ghciWelcomeMsg, interactiveUI)
+import InteractiveUI
 #endif
 
 
@@ -30,54 +30,57 @@ 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,
                          v_OptLevel, v_Output_file, v_Output_hi, 
                          v_Package_details, v_Ways, getPackageExtraGhcOpts,
-                         readPackageConf
+                         readPackageConf, verifyOutputFiles
                        )
 import DriverFlags     ( buildStaticHscOpts,
                          dynamic_flags, processArgs, static_flags)
 
 import DriverMkDepend  ( beginMkDependHS, endMkDependHS )
-import DriverPhases    ( Phase(HsPp, Hsc), haskellish_src_file, objish_file )
+import DriverPhases    ( Phase(HsPp, Hsc), haskellish_src_file, objish_file,
+                         isSourceFile )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
-                         unknownFlagErr, getFileSuffix )
+                         unknownFlagsErr, 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
 import Panic           ( GhcException(..), panic )
 
+import DATA_IOREF      ( readIORef, writeIORef )
+import EXCEPTION       ( throwDyn, Exception(..), 
+                         AsyncException(StackOverflow) )
+
+#ifndef mingw32_HOST_OS
+import CONCURRENT      ( myThreadId )
+# if __GLASGOW_HASKELL__ < 500
+import EXCEPTION        ( raiseInThread )
+#define throwTo  raiseInThread
+# else
+import EXCEPTION       ( throwTo )
+# endif
+
+import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
+import DYNAMIC         ( toDyn )
+#endif
+
 -- Standard Haskell libraries
 import IO
 import Directory       ( doesFileExist )
-import IOExts          ( readIORef, writeIORef )
-import Exception       ( throwDyn, Exception(..), 
-                         AsyncException(StackOverflow) )
 import System          ( getArgs, exitWith, ExitCode(..) )
 import Monad
 import List
 import Maybe
 
-#ifndef mingw32_TARGET_OS
-import Concurrent      ( myThreadId )
-#if __GLASGOW_HASKELL__ < 500
-import Exception        ( raiseInThread )
-#define throwTo  raiseInThread
-#else
-import Exception       ( throwTo )
-#endif
-
-import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
-import Dynamic         ( toDyn )
-#endif
-
 -----------------------------------------------------------------------------
 -- ToDo:
 
@@ -108,7 +111,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
 
@@ -133,7 +139,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)))
@@ -161,7 +167,7 @@ main =
       do putStr "warning: -O conflicts with --interactive; -O turned off.\n"
          writeIORef v_OptLevel 0
    orig_ways <- readIORef v_Ways
-   when (not (null orig_ways) && mode == DoInteractive) $
+   when (notNull orig_ways && mode == DoInteractive) $
       do throwDyn (UsageError 
                    "--interactive can't be used with -prof, -ticky, -unreg or -smp.")
 
@@ -207,9 +213,9 @@ main =
        -- save the "initial DynFlags" away
    saveDynFlags
 
-       -- complain about any unknown flags
-   mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
-
+        -- perform some checks of the options set / report unknowns.
+   checkOptions srcs
+   
    verb <- dynFlag verbosity
 
        -- Show the GHCi banner
@@ -253,8 +259,9 @@ main =
    if (mode == DoInteractive) then beginInteractive srcs else do
 
        -- -o sanity checking
+   let real_srcs = filter isSourceFile srcs -- filters out .a and .o that might appear
    o_file <- readIORef v_Output_file
-   if (srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
+   if (real_srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
        then throwDyn (UsageError "can't apply -o to multiple source files")
        else do
 
@@ -300,7 +307,7 @@ main =
 beginMake :: [String] -> IO ()
 beginMake fileish_args
   = do let (objs, mods) = partition objish_file fileish_args
-       mapM (add v_Ld_inputs) objs
+       mapM_ (add v_Ld_inputs) objs
 
        case mods of
         []    -> throwDyn (UsageError "no input files")
@@ -320,8 +327,19 @@ beginInteractive fileish_args
   = do minus_ls <- readIORef v_Cmdline_libraries
 
        let (objs, mods) = partition objish_file fileish_args
-          libs = map Left objs ++ map Right minus_ls
+          libs = map Object objs ++ map DLL minus_ls
 
        state <- cmInit Interactive
        interactiveUI state mods libs
 #endif
+
+checkOptions :: [String] -> IO ()
+checkOptions srcs = do
+     -- complain about any unknown flags
+   let unknown_opts = [ f | f@('-':_) <- srcs ]
+   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+     -- verify that output files point somewhere sensible.
+   verifyOutputFiles
+     -- and anything else that it might be worth checking for
+     -- before kicking of a compilation (pipeline).
+