Commit f4a6a413 authored by simonmar's avatar simonmar
Browse files

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

Hopefully fix the driver problems I introduced yesterday.
parent 11b6ad6c
-----------------------------------------------------------------------------
-- $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
......
-----------------------------------------------------------------------------
-- $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
......
{-# 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment