From 2ce1b8d7517ca54f4b84a6636a1661a56871856f Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 5 Jun 2003 10:11:22 +0000 Subject: [PATCH] [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. --- ghc/compiler/main/DriverPhases.hs | 4 +- ghc/compiler/main/DriverPipeline.hs | 94 +++++++++++++++++++++-------------- 2 files changed, 60 insertions(+), 38 deletions(-) diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs index 2efe293..14cf635 100644 --- a/ghc/compiler/main/DriverPhases.hs +++ b/ghc/compiler/main/DriverPhases.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 2c20376..51267d9 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -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 -- 1.7.10.4