[project @ 2003-06-05 10:11:22 by simonmar]

- Fix a couple of bugs in yesterday's pipeline cleanup.

- Do some more tidying: share the code for filename generation between
  the two entry points to HscMain, and also share some of the other
  machinery in the Hsc phase.  This fixes some wibbles (things that
  were done in --make mode but not in one-shot, and vice-versa).

  One thing that works now is that if you say 'ghc -keep-hc-files Foo.hs',
  then it automatically switches to -fvia-C mode to generate the .hc file.

diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs
index 2efe293..14cf635 100644 (file)
--- a/ghc/compiler/main/DriverPhases.hs
+++ b/ghc/compiler/main/DriverPhases.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.25 2003/06/04 15:47:59 simonmar Exp $
+-- $Id: DriverPhases.hs,v 1.26 2003/06/05 10:11:22 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -66,7 +66,7 @@ x `happensBefore` y
        | x `elem` c_pipe       = y `elem` tail (dropWhile (/= x) c_pipe)
        | otherwise = False
 
-haskell_pipe = [Unlit,Cpp,HsPp,Hsc,HCc,Mangle,As,Ln]
+haskell_pipe = [Unlit,Cpp,HsPp,Hsc,HCc,Mangle,SplitMangle,As,SplitAs,Ln]
 c_pipe       = [Cc,As,Ln]
 
 -- the first compilation phase for a given file is determined

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 2c20376..51267d9 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -134,30 +134,18 @@ compile ghci_mode this_mod location
    processArgs dynamic_flags opts []
    dyn_flags <- getDynFlags
 
-   let hsc_lang      = hscLang dyn_flags
-       (basename, _) = splitFilename input_fn
+   let (basename, _) = splitFilename input_fn
        
-   keep_hc <- readIORef v_Keep_hc_files
-#ifdef ILX
-   keep_il <- readIORef v_Keep_il_files
-#endif
-   keep_s  <- readIORef v_Keep_s_files
-
-   output_fn <- 
-       case hsc_lang of
-          HscAsm  | keep_s    -> return (basename ++ '.':phaseInputExt As)
-                  | otherwise -> newTempName (phaseInputExt As)
-          HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
-                  | otherwise -> newTempName (phaseInputExt HCc)
-           HscJava             -> newTempName "java" -- ToDo
-#ifdef ILX
-          HscILX  | keep_il   -> return (basename ++ '.':phaseInputExt Ilasm)
-                   | otherwise -> newTempName (phaseInputExt Ilx2Il)   
-#endif
-          HscInterpreted      -> return (error "no output file")
-           HscNothing         -> return (error "no output file")
-
-   let dyn_flags' = dyn_flags { hscOutName = output_fn,
+   -- figure out what lang we're generating
+   hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags)
+   -- figure out what the next phase should be
+   next_phase <- hscNextPhase hsc_lang
+   -- figure out what file to generate the output into
+   get_output_fn <- genOutputFilenameFunc False Nothing next_phase basename
+   output_fn <- get_output_fn next_phase
+
+   let dyn_flags' = dyn_flags { hscLang = hsc_lang,
+                               hscOutName = output_fn,
                                hscStubCOutName = basename ++ "_stub.c",
                                hscStubHOutName = basename ++ "_stub.h",
                                extCoreName = basename ++ ".hcr" }
@@ -363,14 +351,27 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_fn
 
 pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix
   -> (Phase -> IO FilePath) -> IO FilePath
+
 pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn
   | phase == stop_phase  =  return input_fn  -- all done
+
+  | not (phase `happensBefore` stop_phase)  = 
+       -- Something has gone wrong.  We'll try to cover all the cases when
+       -- this could happen, so if we reach here it is a panic.
+       -- eg. it might happen if the -C flag is used on a source file that
+       -- has {-# OPTIONS -fasm #-}.
+       panic ("pipeLoop: at phase " ++ show phase ++ 
+               " but I wanted to stop at phase " ++ show stop_phase)
+
   | otherwise = do
        maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn
                                get_output_fn
        case maybe_next_phase of
-         (Nothing, output_fn) -> return output_fn
-         (Just next_phase, output_fn) -> 
+         (Nothing, output_fn) -> 
+               -- we stopped early, but return the *final* filename
+               -- (it presumably already exists)
+               get_output_fn stop_phase
+         (Just next_phase, output_fn) ->
                pipeLoop next_phase stop_phase output_fn
                        orig_basename orig_suff get_output_fn
 
@@ -595,18 +596,12 @@ runPhase Hsc basename suff input_fn get_output_fn = do
 
   -- get the DynFlags
         dyn_flags <- getDynFlags
-       let hsc_lang = hscLang dyn_flags
-       split <- readIORef v_Split_object_files
-
-       let next_phase = case hsc_lang of
-                               HscC -> HCc
-                               HscAsm | split -> SplitMangle
-                                      | otherwise -> As
-                               HscNothing -> HCc
-
+       hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags)
+       next_phase <- hscNextPhase hsc_lang
        output_fn <- get_output_fn next_phase
 
-        let dyn_flags' = dyn_flags { hscOutName = output_fn,
+        let dyn_flags' = dyn_flags { hscLang = hsc_lang,
+                                    hscOutName = output_fn,
                                     hscStubCOutName = basename ++ "_stub.c",
                                     hscStubHOutName = basename ++ "_stub.h",
                                     extCoreName = basename ++ ".hcr" }
@@ -815,7 +810,8 @@ runPhase SplitAs basename _suff _input_fn get_output_fn
        
        mapM_ assemble_file [1..n]
 
-       return (Just Ln, "**split_as**") -- we don't use the output file
+       output_fn <- get_output_fn Ln
+       return (Just Ln, output_fn)
 
 #ifdef ILX
 -----------------------------------------------------------------------------
@@ -1102,3 +1098,29 @@ doMkDLL o_files = do
               then [ "" ]
                else [ "--export-all" ])
        ))
+
+-- -----------------------------------------------------------------------------
+-- Misc.
+
+hscNextPhase :: HscLang -> IO Phase
+hscNextPhase hsc_lang = do
+  split <- readIORef v_Split_object_files
+  return (case hsc_lang of
+               HscC -> HCc
+               HscAsm | split -> SplitMangle
+                      | otherwise -> As
+               HscNothing -> HCc
+       )
+
+hscMaybeAdjustLang :: HscLang -> IO HscLang
+hscMaybeAdjustLang current_hsc_lang = do
+  todo    <- readIORef v_GhcMode
+  keep_hc <- readIORef v_Keep_hc_files
+  let hsc_lang
+       -- don't change the lang if we're interpreting
+        | current_hsc_lang == HscInterpreted = current_hsc_lang
+       -- force -fvia-C if we are being asked for a .hc file
+        | todo == StopBefore HCc  || keep_hc = HscC
+       -- otherwise, stick to the plan
+        | otherwise = current_hsc_lang
+  return hsc_lang