[project @ 2001-01-03 11:13:43 by simonmar]

Hopefully fix the driver problems I introduced yesterday.

diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs
index cab7b60..80c2b44 100644 (file)
--- a/ghc/compiler/main/DriverPhases.hs
+++ b/ghc/compiler/main/DriverPhases.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.3 2000/11/16 16:23:04 sewardj Exp $
+-- $Id: DriverPhases.hs,v 1.4 2001/01/03 11:13:43 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -53,7 +53,7 @@ data Phase
 -- by its suffix.
 startPhase "lhs"   = Unlit
 startPhase "hs"    = Cpp
-startPhase "hspp"  = Hsc       -- not sure this will work ...
+startPhase "hspp"  = Hsc
 startPhase "hc"    = HCc
 startPhase "c"     = Cc
 startPhase "raw_s" = Mangle
@@ -66,7 +66,7 @@ startPhase _       = Ln          -- all unknown file types
 -- the input requirements of the next phase.
 phaseInputExt Unlit       = "lhs"
 phaseInputExt Cpp         = "lpp"      -- intermediate only
-phaseInputExt Hsc         = "hspp"     -- intermediate only
+phaseInputExt Hsc         = "hspp"
 phaseInputExt HCc         = "hc"
 phaseInputExt Cc          = "c"
 phaseInputExt Mangle      = "raw_s"
@@ -76,7 +76,7 @@ phaseInputExt SplitAs     = "split_s"   -- not really generated
 phaseInputExt Ln          = "o"
 phaseInputExt MkDependHS  = "dep"
 
-haskellish_suffix = (`elem` [ "hs", "lhs", "hc" ])
+haskellish_suffix = (`elem` [ "hs", "hspp", "lhs", "hc" ])
 cish_suffix       = (`elem` [ "c", "s", "S" ])  -- maybe .cc et al.??
 
 haskellish_file f = haskellish_suffix suf where (_,suf) = splitFilename f

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 5371181..810d1be 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.44 2000/12/20 15:44:29 rrt Exp $
+-- $Id: DriverPipeline.hs,v 1.45 2001/01/03 11:13:43 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -13,7 +13,7 @@ module DriverPipeline (
 
        -- interfaces for the batch-mode driver
    GhcMode(..), getGhcMode, v_GhcMode,
-   genPipeline, runPipeline,
+   genPipeline, runPipeline, pipeLoop,
 
        -- interfaces for the compilation manager (interpreted/batch-mode)
    preprocess, compile, CompResult(..),
@@ -189,18 +189,6 @@ genPipeline todo stop_flag persistent_output lang filename
                                    ++ filename))
        else do
 
-       -- if we can't find the phase we're supposed to stop before,
-       -- something has gone wrong.
-   case todo of
-       StopBefore phase -> 
-          when (phase /= Ln 
-                && phase `notElem` pipeline
-                && not (phase == As && SplitAs `elem` pipeline)) $
-             throwDyn (OtherError 
-               ("flag " ++ stop_flag
-                ++ " is incompatible with source file `" ++ filename ++ "'"))
-       _ -> return ()
-
    let
    ----------- -----  ----   ---   --   --  -  -  -
       myPhaseInputExt Ln = case osuf of Nothing -> phaseInputExt Ln
@@ -242,10 +230,22 @@ genPipeline todo stop_flag persistent_output lang filename
       phase_ne p (p1,_,_) = (p1 /= p)
    ----------- -----  ----   ---   --   --  -  -  -
 
-   return $
-     dropWhile (phase_ne start_phase) . 
-       foldr (\p ps -> if phase_ne stop_phase p then p:ps else [])  []
-               $ annotated_pipeline
+       -- if we can't find the phase we're supposed to stop before,
+       -- something has gone wrong.  This test carefully avoids the
+       -- case where we aren't supposed to do any compilation, because the file
+       -- is already in linkable form (for example).
+   if start_phase `elem` pipeline && 
+       (stop_phase /= Ln && stop_phase `notElem` pipeline)
+      then throwDyn (OtherError 
+               ("flag " ++ stop_flag
+                ++ " is incompatible with source file `" ++ filename ++ "'"))
+      else do
+
+   return (
+     takeWhile (phase_ne stop_phase ) $
+     dropWhile (phase_ne start_phase) $
+     annotated_pipeline
+    )
 
 
 runPipeline

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 3f81b88..5f5024a 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.42 2001/01/02 15:30:57 simonmar Exp $
+-- $Id: Main.hs,v 1.43 2001/01/03 11:13:43 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -264,8 +264,6 @@ main =
 
    if null srcs then throwDyn (UsageError "no input files") else do
 
-   let lang = hscLang init_dyn_flags
-
    let compileFile src = do
          writeIORef v_Driver_state saved_driver_state
          writeIORef v_DynFlags init_dyn_flags
@@ -273,17 +271,20 @@ main =
          -- We compile in two stages, because the file may have an
          -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
 
-         -- preprocess
+         let (basename, suffix) = splitFilename src
+
+         -- just preprocess
          pp <- if mode == StopBefore Hsc then return src else do
-               phases <- genPipeline (StopBefore Hsc) "none" 
+               phases <- genPipeline (StopBefore Hsc) stop_flag
                            False{-not persistent-} defaultHscLang src
-               runPipeline phases src False{-no linking-} False{-no -o flag-}
+               pipeLoop phases src False{-no linking-} False{-no -o flag-}
+                       basename suffix
 
-         -- compile
+         -- rest of compilation
          dyn_flags <- readIORef v_DynFlags
          phases <- genPipeline mode stop_flag True (hscLang dyn_flags) pp
-         r <- runPipeline phases pp False{-no linking-} False{-no -o flag-}
-
+         r <- pipeLoop phases pp (mode==DoLink) True{-use -o flag-}
+                       basename suffix
          return r
 
    o_files <- mapM compileFile srcs