Commit 2ce1b8d7 authored by simonmar's avatar simonmar

[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.
parent 3a47678a
-----------------------------------------------------------------------------
-- $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
......
......@@ -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
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