[project @ 2001-07-11 19:48:07 by sof]

Prev commit which tried to get rid of the 'ineffective CPP'
stage broke an invariant/assumption made by DriverPipeline.genPipeline,
I'm afraid.

The invariant being that from the input filename to a compilation
pipeline, the start stage/phase can be uniquely determined
(via DriverPhases.startPhase). run_phase no longer guarantees
this, its result filename may now be equal to the input filename.
[This resulted in -M not working properly when -cpp wasn't also used].

Patch this up by having the input filename to a compilation pipeline
stage be tagged with the assumed suffix of the output. This is
really just papering over the cracks, the proper way to tidy this
up is to avoid having to do the two-stage compilation pipeline in
Main.main.compileFile, i.e., reconsider how OPTIONS pragmas are
handled. I decided not to try to do this now for fear of destabilising
HEAD even further.

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 5685bc4..606e089 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.88 2001/07/11 14:50:49 sof Exp $
+-- $Id: DriverPipeline.hs,v 1.89 2001/07/11 19:48:07 sof Exp $
 --
 -- GHC Driver
 --
@@ -120,18 +120,18 @@ data IntermediateFileType
   deriving (Eq, Show)
 
 genPipeline
-   :: GhcMode          -- when to stop
-   -> String           -- "stop after" flag (for error messages)
-   -> Bool             -- True => output is persistent
-   -> HscLang          -- preferred output language for hsc
-   -> String           -- original filename
+   :: GhcMode           -- when to stop
+   -> String            -- "stop after" flag (for error messages)
+   -> Bool              -- True => output is persistent
+   -> HscLang           -- preferred output language for hsc
+   -> (FilePath, String) -- original filename & its suffix 
    -> IO [             -- list of phases to run for this file
             (Phase,
              IntermediateFileType,  -- keep the output from this phase?
              String)                -- output file suffix
          ]     
 
-genPipeline todo stop_flag persistent_output lang filename 
+genPipeline todo stop_flag persistent_output lang (filename,suffix)
  = do
    split      <- readIORef v_Split_object_files
    mangle     <- readIORef v_Do_asm_mangling
@@ -143,8 +143,6 @@ genPipeline todo stop_flag persistent_output lang filename
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
-    (_basename, suffix) = splitFilename filename
-
     start = startPhase suffix
 
       -- special case for mkdependHS: .hspp files go through MkDependHS
@@ -256,18 +254,18 @@ genPipeline todo stop_flag persistent_output lang filename
 
 runPipeline
   :: [ (Phase, IntermediateFileType, String) ] -- phases to run
-  -> String                    -- input file
+  -> (String,String)           -- input file
   -> Bool                      -- doing linking afterward?
   -> Bool                      -- take into account -o when generating output?
-  -> IO String                 -- return final filename
+  -> IO (String, String)       -- return final filename
 
-runPipeline pipeline input_fn do_linking use_ofile
-  = pipeLoop pipeline input_fn do_linking use_ofile basename suffix
-  where (basename, suffix) = splitFilename input_fn
+runPipeline pipeline (input_fn,suffix) do_linking use_ofile
+  = pipeLoop pipeline (input_fn,suffix) do_linking use_ofile basename suffix
+  where (basename, _) = splitFilename input_fn
 
 pipeLoop [] input_fn _ _ _ _ = return input_fn
 pipeLoop ((phase, keep, o_suffix):phases) 
-       input_fn do_linking use_ofile orig_basename orig_suffix
+       (input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix
   = do
 
      output_fn <- outputFileName (null phases) keep o_suffix
@@ -279,9 +277,28 @@ pipeLoop ((phase, keep, o_suffix):phases)
        Nothing -> do
              let (_,keep,final_suffix) = last phases
              ofile <- outputFileName True keep final_suffix
-             return ofile
+             return (ofile, final_suffix)
           -- carry on ...
-       Just fn -> pipeLoop phases fn do_linking use_ofile orig_basename orig_suffix
+       Just fn -> 
+              {-
+              Notice that in order to keep the invariant that we can
+              determine a compilation pipeline's 'start phase' just
+              by looking at the input filename, the input filename
+              to the next stage/phase is associated here with the suffix
+              of the output file, *even* if it does not have that
+              suffix in reality.
+              
+              Why is this important? Because we may run a compilation
+              pipeline in stages (cf. Main.main.compileFile's two stages),
+              so when generating the next stage we need to be precise
+              about what kind of file (=> suffix) is given as input.
+
+              [Not having to generate a pipeline in stages seems like
+               the right way to go, but I've punted on this for now --sof]
+              
+             -}
+              pipeLoop phases (fn, o_suffix) do_linking use_ofile
+                               orig_basename orig_suffix
   where
      outputFileName last_phase keep suffix
        = do o_file <- readIORef v_Output_file
@@ -868,8 +885,10 @@ preprocess filename =
   ASSERT(haskellish_src_file filename) 
   do restoreDynFlags   -- Restore to state of last save
      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
-                            defaultHscLang filename
-     runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
+                            defaultHscLang (filename, getFileSuffix filename)
+     (fn,_)   <- runPipeline pipeline (filename,getFileSuffix filename)
+                            False{-no linking-} False{-no -o flag-}
+     return fn
 
 -----------------------------------------------------------------------------
 -- Compile a single module, under the control of the compilation manager.
@@ -988,13 +1007,15 @@ compile ghci_mode summary source_unchanged have_object
 
                -- we're in batch mode: finish the compilation pipeline.
                _other -> do pipe <- genPipeline (StopBefore Ln) "" True 
-                                       hsc_lang output_fn
+                                       hsc_lang (output_fn, getFileSuffix output_fn)
                              -- runPipeline takes input_fn so it can split off 
                              -- the base name and use it as the base of 
                              -- the output object file.
                              let (basename, suffix) = splitFilename input_fn
-                            o_file <- pipeLoop pipe output_fn False False 
-                                                basename suffix
+                            (o_file,_) <- 
+                                pipeLoop pipe (output_fn, getFileSuffix output_fn)
+                                              False False 
+                                               basename suffix
                              o_time <- getModificationTime o_file
                             return ([DotO o_file], o_time)
 
@@ -1012,8 +1033,7 @@ compileStub dflags stub_c_exists
   | stub_c_exists = do
        -- compile the _stub.c file w/ gcc
        let stub_c = hscStubCOutName dflags
-       pipeline <- genPipeline (StopBefore Ln) "" True defaultHscLang stub_c
-       stub_o <- runPipeline pipeline stub_c False{-no linking-} 
-                       False{-no -o option-}
-
+       pipeline   <- genPipeline (StopBefore Ln) "" True defaultHscLang (stub_c,"c")
+       (stub_o,_) <- runPipeline pipeline (stub_c,"c") False{-no linking-} 
+                                 False{-no -o option-}
        return (Just stub_o)

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5d59167..984245f 100644 (file)
--- 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.80 2001/07/04 15:43:38 simonmar Exp $
+-- $Id: Main.hs,v 1.81 2001/07/11 19:48:07 sof Exp $
 --
 -- GHC Driver program
 --
@@ -45,7 +45,7 @@ import DriverMkDepend ( beginMkDependHS, endMkDependHS )
 import DriverPhases    ( Phase(Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
-                         unknownFlagErr )
+                         unknownFlagErr, getFileSuffix )
 import CmdLineOpts     ( dynFlag, defaultDynFlags, restoreDynFlags,
                          saveDynFlags, setDynFlags, 
                          DynFlags(..), HscLang(..), v_Static_hsc_opts
@@ -288,18 +288,20 @@ main =
          let (basename, suffix) = splitFilename src
 
          -- just preprocess (Haskell source only)
+         let src_and_suff = (src, getFileSuffix src)
          pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
-                       then return src else do
+                       then return src_and_suff else do
                phases <- genPipeline (StopBefore Hsc) stop_flag
-                           False{-not persistent-} defaultHscLang src
-               pipeLoop phases src False{-no linking-} False{-no -o flag-}
+                           False{-not persistent-} defaultHscLang
+                           src_and_suff
+               pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
                        basename suffix
 
          -- rest of compilation
          hsc_lang <- dynFlag hscLang
-         phases <- genPipeline mode stop_flag True hsc_lang pp
-         r <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-}
-                       basename suffix
+         phases   <- genPipeline mode stop_flag True hsc_lang pp
+         (r,_)    <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
+                                     True{-use -o flag-} basename suffix
          return r
 
    o_files <- mapM compileFile srcs