X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=03ab8a596ec8d96b03377258f6f734c2a5afdedd;hb=d254a44b8392ff0a4327f1916ef921887ce78769;hp=cc7e80f08e68d1c7eb243e8fcbdfbb452f2e19b4;hpb=0171936c9092666692c69a7f93fa75af976330cb;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index cc7e80f..03ab8a5 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.96 2002/03/04 17:01:30 simonmar Exp $
+-- $Id: Main.hs,v 1.104 2002/04/05 23:24:29 sof Exp $
 --
 -- GHC Driver program
 --
@@ -30,13 +30,13 @@ 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)
@@ -45,10 +45,11 @@ import DriverMkDepend	( beginMkDependHS, endMkDependHS )
 import DriverPhases	( Phase(HsPp, Hsc), haskellish_src_file, objish_file )
 
 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
@@ -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 )
@@ -135,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)))
@@ -163,7 +165,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.")
 
@@ -209,9 +211,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
@@ -278,15 +280,19 @@ main =
 	  let not_hs_file  = not (haskellish_src_file src)
 	  pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
 			then return src_and_suff else do
+--		hPutStrLn stderr "before" >> hFlush stderr
 		phases <- genPipeline (StopBefore Hsc) stop_flag
 				      False{-not persistent-} defaultHscLang
 				      src_and_suff
+--		hPutStrLn stderr "after" >> hFlush stderr
 	  	pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
 			basename suffix
 
 	  -- rest of compilation
 	  hsc_lang <- dynFlag hscLang
+--	  hPutStrLn stderr ("before-1 " ++ show (pp,mode)) >> hFlush stderr
 	  phases   <- genPipeline mode stop_flag True hsc_lang pp
+--	  hPutStrLn stderr "after" >> hFlush stderr
 	  (r,_)    <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
 	  			      True{-use -o flag-} basename suffix
 	  return r
@@ -327,3 +333,14 @@ beginInteractive fileish_args
        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).
+