X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=75ef178d6d881b70d411c03709500f03e4e8b897;hb=b7a226fdc7a003677fef20652d5a4597f6b29c62;hp=101471a2c5c63f9f00f45411795871b26fa6c477;hpb=045a18db20c0b7f2942e151dd8fa59dc9476d0bf;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 101471a..75ef178 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.85 2001/06/29 12:58:20 rrt Exp $ +-- $Id: DriverPipeline.hs,v 1.92 2001/07/23 20:19:53 sof Exp $ -- -- GHC Driver -- @@ -34,7 +34,7 @@ import DriverUtil import DriverMkDepend import DriverPhases import DriverFlags -import SysTools ( newTempName, addFilesToClean, getSysMan ) +import SysTools ( newTempName, addFilesToClean, getSysMan, unDosifyPath ) import qualified SysTools import HscMain import Finder @@ -120,18 +120,18 @@ data IntermediateFileType deriving (Eq, Show) genPipeline - :: GhcMode -- when to stop - -> String -- "stop after" flag (for error messages) - -> Bool -- True => output is persistent - -> HscLang -- preferred output language for hsc - -> String -- original filename + :: GhcMode -- when to stop + -> String -- "stop after" flag (for error messages) + -> Bool -- True => output is persistent + -> HscLang -- preferred output language for hsc + -> (FilePath, String) -- original filename & its suffix -> IO [ -- list of phases to run for this file (Phase, IntermediateFileType, -- keep the output from this phase? String) -- output file suffix ] -genPipeline todo stop_flag persistent_output lang filename +genPipeline todo stop_flag persistent_output lang (filename,suffix) = do split <- readIORef v_Split_object_files mangle <- readIORef v_Do_asm_mangling @@ -143,8 +143,6 @@ genPipeline todo stop_flag persistent_output lang filename let ----------- ----- ---- --- -- -- - - - - (_basename, suffix) = splitFilename filename - start = startPhase suffix -- special case for mkdependHS: .hspp files go through MkDependHS @@ -256,33 +254,51 @@ genPipeline todo stop_flag persistent_output lang filename runPipeline :: [ (Phase, IntermediateFileType, String) ] -- phases to run - -> String -- input file + -> (String,String) -- input file -> Bool -- doing linking afterward? -> Bool -- take into account -o when generating output? - -> IO String -- return final filename + -> IO (String, String) -- return final filename -runPipeline pipeline input_fn do_linking use_ofile - = pipeLoop pipeline input_fn do_linking use_ofile basename suffix - where (basename, suffix) = splitFilename input_fn +runPipeline pipeline (input_fn,suffix) do_linking use_ofile + = pipeLoop pipeline (input_fn,suffix) do_linking use_ofile basename suffix + where (basename, _) = splitFilename input_fn pipeLoop [] input_fn _ _ _ _ = return input_fn pipeLoop ((phase, keep, o_suffix):phases) - input_fn do_linking use_ofile orig_basename orig_suffix + (input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix = do output_fn <- outputFileName (null phases) keep o_suffix - carry_on <- run_phase phase orig_basename orig_suffix input_fn output_fn + mbCarryOn <- run_phase phase orig_basename orig_suffix input_fn output_fn -- sometimes we bail out early, eg. when the compiler's recompilation -- checker has determined that recompilation isn't necessary. - if not carry_on - then do let (_,keep,final_suffix) = last phases - ofile <- outputFileName True keep final_suffix - return ofile - else do -- carry on ... - - pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix - + case mbCarryOn of + Nothing -> do + let (_,keep,final_suffix) = last phases + ofile <- outputFileName True keep final_suffix + return (ofile, final_suffix) + -- carry on ... + Just fn -> + {- + Notice that in order to keep the invariant that we can + determine a compilation pipeline's 'start phase' just + by looking at the input filename, the input filename + to the next stage/phase is associated here with the suffix + of the output file, *even* if it does not have that + suffix in reality. + + Why is this important? Because we may run a compilation + pipeline in stages (cf. Main.main.compileFile's two stages), + so when generating the next stage we need to be precise + about what kind of file (=> suffix) is given as input. + + [Not having to generate a pipeline in stages seems like + the right way to go, but I've punted on this for now --sof] + + -} + pipeLoop phases (fn, o_suffix) do_linking use_ofile + orig_basename orig_suffix where outputFileName last_phase keep suffix = do o_file <- readIORef v_Output_file @@ -294,13 +310,25 @@ pipeLoop ((phase, keep, o_suffix):phases) then odir_ify (orig_basename ++ '.':suffix) else newTempName suffix +run_phase :: Phase + -> String -- basename of original input source + -> String -- its extension + -> FilePath -- name of file which contains the input to this phase. + -> FilePath -- where to stick the result. + -> IO (Maybe FilePath) + -- Nothing => stop the compilation pipeline + -- Just fn => the result of this phase can be found in 'fn' + -- (this can either be 'input_fn' or 'output_fn'). ------------------------------------------------------------------------------- -- Unlit phase run_phase Unlit _basename _suff input_fn output_fn = do unlit_flags <- getOpts opt_L - SysTools.runUnlit (unlit_flags ++ ["-h", input_fn, input_fn, output_fn]) - return True + -- The -h option passes the file name for unlit to put in a #line directive; + -- we undosify it so that it doesn't contain backslashes in Windows, which + -- would disappear in error messages + SysTools.runUnlit (unlit_flags ++ ["-h", unDosifyPath input_fn, input_fn, output_fn]) + return (Just output_fn) ------------------------------------------------------------------------------- -- Cpp phase @@ -311,15 +339,18 @@ run_phase Cpp basename suff input_fn output_fn checkProcessArgsResult unhandled_flags basename suff do_cpp <- dynFlag cppFlag - if do_cpp - then do + if not do_cpp then + -- no need to preprocess CPP, just pass input file along + -- to the next phase of the pipeline. + return (Just input_fn) + else do hscpp_opts <- getOpts opt_P hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts cmdline_include_paths <- readIORef v_Include_paths pkg_include_dirs <- getPackageIncludePath - let include_paths = map (\p -> "-I"++p) (cmdline_include_paths - ++ pkg_include_dirs) + let include_paths = foldr (\ x xs -> "-I" : x : xs) [] + (cmdline_include_paths ++ pkg_include_dirs) verb <- getVerbFlag (md_c_flags, _) <- machdepCCOpts @@ -330,30 +361,12 @@ run_phase Cpp basename suff input_fn output_fn ++ hscpp_opts ++ md_c_flags ++ [ "-x", "c", input_fn, "-o", output_fn ]) - - -- ToDo: switch away from using 'echo' altogether (but need - -- a faster alternative than what's done below). -#if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS) - else do - h <- openFile output_fn WriteMode - hPutStrLn h ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}") - ls <- readFile input_fn -- inefficient, but it'll do for now. - -- ToDo: speed up via slurping. - hPutStrLn h ls - hClose h -#else - else do - SysTools.runSomething "Ineffective C pre-processor" - ("echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}' > " - ++ output_fn ++ " && cat " ++ input_fn - ++ " >> " ++ output_fn) [] -#endif - return True + return (Just output_fn) ----------------------------------------------------------------------------- -- MkDependHS phase -run_phase MkDependHS basename suff input_fn _output_fn = do +run_phase MkDependHS basename suff input_fn output_fn = do src <- readFile input_fn let (import_sources, import_normals, _) = getImports src @@ -391,7 +404,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do mapM genDep [ d | Just d <- deps ] - return True + return (Just output_fn) -- add the lines to dep_makefile: -- always: @@ -506,7 +519,7 @@ run_phase Hsc basename suff input_fn output_fn HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1)); HscNoRecomp pcs details iface -> do { SysTools.touch "Touching object file" o_file - ; return False } ; + ; return Nothing } ; HscRecomp pcs details iface stub_h_exists stub_c_exists _maybe_interpreted_code -> do @@ -517,7 +530,7 @@ run_phase Hsc basename suff input_fn output_fn Nothing -> return () Just stub_o -> add v_Ld_inputs stub_o - return True + return (Just output_fn) } ----------------------------------------------------------------------------- @@ -529,7 +542,7 @@ run_phase Hsc basename suff input_fn output_fn run_phase cc_phase basename suff input_fn output_fn | cc_phase == Cc || cc_phase == HCc = do cc_opts <- getOpts opt_c - cmdline_include_dirs <- readIORef v_Include_paths + cmdline_include_paths <- readIORef v_Include_paths let hcc = cc_phase == HCc @@ -537,8 +550,8 @@ run_phase cc_phase basename suff input_fn output_fn -- .c files; this is the Value Add(TM) that using -- ghc instead of gcc gives you :) pkg_include_dirs <- getPackageIncludePath - let include_paths = map (\p -> "-I"++p) (cmdline_include_dirs - ++ pkg_include_dirs) + let include_paths = foldr (\ x xs -> "-I" : x : xs) [] + (cmdline_include_paths ++ pkg_include_dirs) mangle <- readIORef v_Do_asm_mangling (md_c_flags, md_regd_c_flags) <- machdepCCOpts @@ -569,7 +582,7 @@ run_phase cc_phase basename suff input_fn output_fn ++ include_paths ++ pkg_extra_cc_opts ) - return True + return (Just output_fn) -- ToDo: postprocess the output from gcc @@ -586,12 +599,12 @@ run_phase Mangle _basename _suff input_fn output_fn SysTools.runMangle (mangler_opts ++ [ input_fn, output_fn ] ++ machdep_opts) - return True + return (Just output_fn) ----------------------------------------------------------------------------- -- Splitting phase -run_phase SplitMangle _basename _suff input_fn _output_fn +run_phase SplitMangle _basename _suff input_fn output_fn = do -- tmp_pfx is the prefix used for the split .s files -- We also use it as the file to contain the no. of split .s files (sigh) split_s_prefix <- SysTools.newTempName "split" @@ -608,7 +621,7 @@ run_phase SplitMangle _basename _suff input_fn _output_fn addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s" | n <- [1..n_files]] - return True + return (Just output_fn) ----------------------------------------------------------------------------- -- As phase @@ -620,9 +633,9 @@ run_phase As _basename _suff input_fn output_fn SysTools.runAs (as_opts ++ [ "-I" ++ p | p <- cmdline_include_paths ] ++ [ "-c", input_fn, "-o", output_fn ]) - return True + return (Just output_fn) -run_phase SplitAs basename _suff _input_fn _output_fn +run_phase SplitAs basename _suff _input_fn output_fn = do as_opts <- getOpts opt_a (split_s_prefix, n) <- readIORef v_Split_info @@ -640,7 +653,7 @@ run_phase SplitAs basename _suff _input_fn _output_fn SysTools.runAs (as_opts ++ ["-c", "-o", real_o, input_s]) mapM_ assemble_file [1..n] - return True + return (Just output_fn) ----------------------------------------------------------------------------- -- MoveBinary sort-of-phase @@ -790,11 +803,11 @@ doLink o_files = do ++ extra_ld_opts ++ if static && not no_hs_main then #ifdef LEADING_UNDERSCORE - [ "-u _PrelMain_mainIO_closure" , - "-u ___init_PrelMain"] + [ "-u", "_PrelMain_mainIO_closure" , + "-u", "___init_PrelMain"] #else - [ "-u PrelMain_mainIO_closure" , - "-u __init_PrelMain"] + [ "-u", prefixUnderscore "PrelMain_mainIO_closure" , + "-u", prefixUnderscore "__init_PrelMain"] #endif else []) @@ -875,8 +888,10 @@ preprocess filename = ASSERT(haskellish_src_file filename) do restoreDynFlags -- Restore to state of last save pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False - defaultHscLang filename - runPipeline pipeline filename False{-no linking-} False{-no -o flag-} + defaultHscLang (filename, getFileSuffix filename) + (fn,_) <- runPipeline pipeline (filename,getFileSuffix filename) + False{-no linking-} False{-no -o flag-} + return fn ----------------------------------------------------------------------------- -- Compile a single module, under the control of the compilation manager. @@ -995,13 +1010,15 @@ compile ghci_mode summary source_unchanged have_object -- we're in batch mode: finish the compilation pipeline. _other -> do pipe <- genPipeline (StopBefore Ln) "" True - hsc_lang output_fn + hsc_lang (output_fn, getFileSuffix output_fn) -- runPipeline takes input_fn so it can split off -- the base name and use it as the base of -- the output object file. let (basename, suffix) = splitFilename input_fn - o_file <- pipeLoop pipe output_fn False False - basename suffix + (o_file,_) <- + pipeLoop pipe (output_fn, getFileSuffix output_fn) + False False + basename suffix o_time <- getModificationTime o_file return ([DotO o_file], o_time) @@ -1019,8 +1036,7 @@ compileStub dflags stub_c_exists | stub_c_exists = do -- compile the _stub.c file w/ gcc let stub_c = hscStubCOutName dflags - pipeline <- genPipeline (StopBefore Ln) "" True defaultHscLang stub_c - stub_o <- runPipeline pipeline stub_c False{-no linking-} - False{-no -o option-} - + pipeline <- genPipeline (StopBefore Ln) "" True defaultHscLang (stub_c,"c") + (stub_o,_) <- runPipeline pipeline (stub_c,"c") False{-no linking-} + False{-no -o option-} return (Just stub_o)