X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=5f5024abb421ab094387d20ca3f0e8d3c570e034;hb=f4a6a4134b8ba3f2fc7a193ed5b91313046b775a;hp=23d82e866209b1b3c1ddb9048fc3997ae72b3b16;hpb=7752abc1008b633fdc7a0b9f283ceca40747b609;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 23d82e8..5f5024a 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.38 2000/12/12 14:35:08 simonmar Exp $
+-- $Id: Main.hs,v 1.43 2001/01/03 11:13:43 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -84,23 +84,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 :: GhcException))
 			          exitWith (ExitFailure 1)
-	      ) $ do
-
-  -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> panic (show exception)) $ do
+	    ) $ do
 
    -- make sure we clean up after ourselves
    later (do  forget_it <- readIORef v_Keep_tmp_files
@@ -254,11 +255,6 @@ 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
@@ -268,13 +264,30 @@ main =
 
    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 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) 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)