X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=a3ad5169305178be91951f4c0c51e343cbc7479c;hb=26b8a5b3feab9d556c92f495a6775acf8cf9f3ec;hp=5786dec2885e1178e3ba4138a7be7a2f403f4365;hpb=4d1b970fe7ae5e25a54a7bce03c2501f07f27211;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5786dec..a3ad516 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.36 2000/12/11 16:42:26 sewardj Exp $
+-- $Id: Main.hs,v 1.46 2001/01/12 11:04:45 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -33,7 +33,7 @@ import DriverFlags
 import DriverMkDepend
 import DriverUtil
 import Panic
-import DriverPhases	( Phase(..) )
+import DriverPhases	( Phase(..), haskellish_file )
 import CmdLineOpts	( HscLang(..), DynFlags(..), v_Static_hsc_opts )
 import TmpFiles
 import Finder		( initFinder )
@@ -74,9 +74,7 @@ import Maybe
 -- Win32 support: proper signal handling
 -- make sure OPTIONS in .hs file propogate to .hc file if -C or -keep-hc-file-too
 -- reading the package configuration file is too slow
--- -H, -K, -Rghc-timing
--- hi-diffs
--- -ddump-all doesn't do anything
+-- -K<size>
 
 -----------------------------------------------------------------------------
 -- Differences vs. old driver:
@@ -84,20 +82,24 @@ import Maybe
 -- No more "Enter your Haskell program, end with ^D (on a line of its own):"
 -- consistency checking removed (may do this properly later)
 -- removed -noC
--- no hi diffs (could be added later)
 -- no -Ofile
 
 -----------------------------------------------------------------------------
 -- Main loop
 
 main =
+  -- top-level exception handler: any unrecognised exception is a compiler bug.
+  handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
+			   exitWith (ExitFailure 1)
+         ) $ do
+
   -- all error messages are propagated as exceptions
   handleDyn (\dyn -> case dyn of
 			  PhaseFailed _phase code -> exitWith code
 			  Interrupted -> exitWith (ExitFailure 1)
-			  _ -> do hPutStrLn stderr (show (dyn :: BarfKind))
+			  _ -> do hPutStrLn stderr (show (dyn :: GhcException))
 			          exitWith (ExitFailure 1)
-	      ) $ do
+	    ) $ do
 
    -- make sure we clean up after ourselves
    later (do  forget_it <- readIORef v_Keep_tmp_files
@@ -240,6 +242,9 @@ main =
    when (verb >= 2) 
 	(hPutStrLn stderr ("Using package config file: " ++ conf_file))
 
+   when (verb >= 3) 
+	(hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
+
 	-- initialise the finder
    pkg_avails <- getPackageInfo
    initFinder pkg_avails
@@ -251,30 +256,44 @@ main =
    if (mode == DoMake)        then beginMake srcs        else do
    if (mode == DoInteractive) then beginInteractive srcs else do
 
-	-- for each source file, find which phases to run
-   let lang = hscLang init_dyn_flags
-   pipelines <- mapM (genPipeline mode stop_flag True lang) srcs
-   let src_pipelines = zip srcs pipelines
-
 	-- sanity checking
    o_file <- readIORef v_Output_file
    ohi    <- readIORef v_Output_hi
-   if length srcs > 1 && (isJust ohi || (isJust o_file && mode /= DoLink))
+   if length srcs > 1 && (isJust ohi || (isJust o_file && mode /= DoLink && mode /= DoMkDLL))
 	then throwDyn (UsageError "can't apply -o or -ohi options to multiple source files")
 	else do
 
    if null srcs then throwDyn (UsageError "no input files") else do
 
-   let compileFile (src, phases) = do
+   let compileFile src = do
 	  writeIORef v_Driver_state saved_driver_state
 	  writeIORef v_DynFlags init_dyn_flags
-	  r <- runPipeline phases src (mode==DoLink) True
+
+	  -- We compile in two stages, because the file may have an
+	  -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
+
+	  let (basename, suffix) = splitFilename src
+
+	  -- just preprocess
+	  pp <- if not (haskellish_file src) || mode == StopBefore Hsc
+			then return src else do
+		phases <- genPipeline (StopBefore Hsc) stop_flag
+			    False{-not persistent-} defaultHscLang src
+	  	pipeLoop phases src False{-no linking-} False{-no -o flag-}
+			basename suffix
+
+	  -- rest of compilation
+	  dyn_flags <- readIORef v_DynFlags
+	  phases <- genPipeline mode stop_flag True (hscLang dyn_flags) pp
+	  r <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-}
+			basename suffix
 	  return r
 
-   o_files <- mapM compileFile src_pipelines
+   o_files <- mapM compileFile srcs
 
    when (mode == DoMkDependHS) endMkDependHS
    when (mode == DoLink) (doLink o_files)
+   when (mode == DoMkDLL) (doMkDLL o_files)
 
 	-- grab the last -B option on the command line, and
 	-- set topDir to its value.