Hopefully fix the driver problems I introduced yesterday.
-----------------------------------------------------------------------------
--- $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
--
-- 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
-- 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"
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
-----------------------------------------------------------------------------
--- $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
--
-- 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(..),
++ 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
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
{-# 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
--
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
-- 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