X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=8c55d4420e020de707fa8b2c6e7fcc4903c02bbd;hb=b3e4cb91c4386c4d1456b896da1abb964f2124a6;hp=0c60aff47f00b92e464835a1a6ceb6e4cef4d660;hpb=950c1ecaffcb6e8d7cefb20b8372691182c6c304;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 0c60aff..8c55d44 100644
--- 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.100 2002/03/13 13:51:35 simonmar Exp $
+-- $Id: Main.hs,v 1.110 2002/09/06 14:35:44 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -18,7 +18,7 @@ module Main (main) where
 
 
 #ifdef GHCI
-import InteractiveUI(ghciWelcomeMsg, interactiveUI)
+import InteractiveUI
 #endif
 
 
@@ -36,16 +36,17 @@ import DriverState	( buildCoreToDo, buildStgToDo,
 			  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,
@@ -55,30 +56,36 @@ import Outputable
 import Util
 import Panic		( GhcException(..), panic )
 
--- Standard Haskell libraries
-import IO
-import Directory	( doesFileExist )
-import IOExts		( readIORef, writeIORef )
-import Exception	( throwDyn, Exception(..), 
+import DATA_IOREF	( 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 )
+#ifndef mingw32_HOST_OS
+import CONCURRENT	( myThreadId )
+# if __GLASGOW_HASKELL__ < 500
+import EXCEPTION        ( raiseInThread )
 #define throwTo  raiseInThread
+# else
+import EXCEPTION	( throwTo )
+# endif
+
+#if __GLASGOW_HASKELL__ > 504
+import System.Posix.Signals
 #else
-import Exception	( throwTo )
+import Posix		( Handler(Catch), installHandler, sigINT, sigQUIT )
 #endif
 
-import Posix		( Handler(Catch), installHandler, sigINT, sigQUIT )
-import Dynamic		( toDyn )
+import DYNAMIC		( toDyn )
 #endif
 
+-- Standard Haskell libraries
+import IO
+import Directory	( doesFileExist )
+import System		( getArgs, exitWith, ExitCode(..) )
+import Monad
+import List
+import Maybe
+
 -----------------------------------------------------------------------------
 -- ToDo:
 
@@ -137,7 +144,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)))
@@ -165,7 +172,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.")
 
@@ -211,9 +218,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
@@ -257,8 +264,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
 
@@ -304,7 +312,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")
@@ -324,8 +332,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).
+