X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=d4cb66af69cc78814b18d7e4a543ad90d2781c80;hb=29da2cf3011c292bc4261601aff85afb13e24d54;hp=e0aa062a3e5ad7347c39c2052c2312a95d04b2dd;hpb=4e1c7e2de7f7a7983003f19a85363a1e1f0170cc;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index e0aa062..d4cb66a 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -41,6 +41,7 @@ import Module import ErrUtils import CmdLineOpts import Config +import RdrName ( GlobalRdrEnv ) import Panic import Util import BasicTypes ( SuccessFlag(..) ) @@ -69,12 +70,13 @@ import Maybe preprocess :: FilePath -> IO FilePath preprocess filename = - ASSERT(haskellish_src_file filename) + ASSERT(isHaskellSrcFilename filename) do restoreDynFlags -- Restore to state of last save runPipeline (StopBefore Hsc) ("preprocess") False{-temporary output file-} Nothing{-no specific output file-} filename + Nothing{-no ModLocation-} -- --------------------------------------------------------------------------- -- Compile @@ -94,29 +96,29 @@ preprocess filename = -- NB. No old interface can also mean that the source has changed. -compile :: GhciMode -- distinguish batch from interactive +compile :: HscEnv -> Module -> ModLocation -> Bool -- True <=> source unchanged -> Bool -- True <=> have object -> Maybe ModIface -- old interface, if available - -> HomePackageTable -- For home-module stuff - -> PersistentCompilerState -- persistent compiler state -> IO CompResult data CompResult - = CompOK PersistentCompilerState -- Updated PCS - ModDetails -- New details + = CompOK ModDetails -- New details + (Maybe GlobalRdrEnv) -- Lexical environment for the module + -- (Maybe because we may have loaded it from + -- its precompiled interface) ModIface -- New iface (Maybe Linkable) -- New code; Nothing => compilation was not reqd -- (old code is still valid) - | CompErrs PersistentCompilerState -- Updated PCS + | CompErrs -compile ghci_mode this_mod location +compile hsc_env this_mod location source_unchanged have_object - old_iface hpt pcs = do + old_iface = do dyn_flags <- restoreDynFlags -- Restore to the state of the last save @@ -142,7 +144,7 @@ compile ghci_mode this_mod location 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 + output_fn <- get_output_fn next_phase (Just location) let dyn_flags' = dyn_flags { hscLang = hsc_lang, hscOutName = output_fn, @@ -153,20 +155,18 @@ compile ghci_mode this_mod location -- -no-recomp should also work with --make do_recomp <- readIORef v_Recomp let source_unchanged' = source_unchanged && do_recomp - hsc_env = HscEnv { hsc_mode = ghci_mode, - hsc_dflags = dyn_flags', - hsc_HPT = hpt } + hsc_env' = hsc_env { hsc_dflags = dyn_flags' } -- run the compiler - hsc_result <- hscMain hsc_env pcs this_mod location + hsc_result <- hscMain hsc_env' printErrorsAndWarnings this_mod location source_unchanged' have_object old_iface case hsc_result of - HscFail pcs -> return (CompErrs pcs) + HscFail -> return CompErrs - HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing) + HscNoRecomp details iface -> return (CompOK details Nothing iface Nothing) - HscRecomp pcs details iface + HscRecomp details rdr_env iface stub_h_exists stub_c_exists maybe_interpreted_code -> do let maybe_stub_o <- compileStub dyn_flags' stub_c_exists @@ -190,13 +190,10 @@ compile ghci_mode this_mod location -- we're in batch mode: finish the compilation pipeline. _other -> do let object_filename = ml_obj_file location - object_dir = directoryOf object_filename - - -- create the object dir if it doesn't exist - createDirectoryHierarchy object_dir runPipeline (StopBefore Ln) "" - True (Just object_filename) output_fn + True Nothing output_fn (Just location) + -- the object filename comes from the ModLocation o_time <- getModificationTime object_filename return ([DotO object_filename], o_time) @@ -204,7 +201,7 @@ compile ghci_mode this_mod location let linkable = LM unlinked_time mod_name (hs_unlinked ++ stub_unlinked) - return (CompOK pcs details iface (Just linkable)) + return (CompOK details rdr_env iface (Just linkable)) ----------------------------------------------------------------------------- -- stub .h and .c files (for foreign export support) @@ -218,6 +215,7 @@ compileStub dflags stub_c_exists True{-persistent output-} Nothing{-no specific output file-} stub_c + Nothing{-no ModLocation-} return (Just stub_o) @@ -298,9 +296,10 @@ runPipeline -> Bool -- final output is persistent? -> Maybe FilePath -- where to put the output, optionally -> FilePath -- input filename + -> Maybe ModLocation -- a ModLocation for this module, if we have one -> IO FilePath -- output filename -runPipeline todo stop_flag keep_output maybe_output_filename input_fn +runPipeline todo stop_flag keep_output maybe_output_filename input_fn maybe_loc = do split <- readIORef v_Split_object_files let (basename, suffix) = splitFilename input_fn @@ -332,15 +331,16 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_fn stop_phase basename -- and execute the pipeline... - output_fn <- pipeLoop start_phase stop_phase input_fn basename suffix - get_output_fn + (output_fn, maybe_loc) <- + pipeLoop start_phase stop_phase input_fn basename suffix + get_output_fn maybe_loc -- sometimes, a compilation phase doesn't actually generate any output -- (eg. the CPP phase when -fcpp is not turned on). If we end on this -- stage, but we wanted to keep the output, then we have to explicitly -- copy the file. if keep_output - then do final_fn <- get_output_fn stop_phase + then do final_fn <- get_output_fn stop_phase maybe_loc when (final_fn /= output_fn) $ copy ("Copying `" ++ output_fn ++ "' to `" ++ final_fn ++ "'") output_fn final_fn @@ -350,10 +350,13 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_fn pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix - -> (Phase -> IO FilePath) -> IO FilePath + -> (Phase -> Maybe ModLocation -> IO FilePath) + -> Maybe ModLocation -> IO (FilePath, Maybe ModLocation) + +pipeLoop phase stop_phase input_fn orig_basename orig_suff + get_output_fn maybe_loc -pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn - | phase == stop_phase = return input_fn -- all done + | phase == stop_phase = return (input_fn, maybe_loc) -- all done | not (phase `happensBefore` stop_phase) = -- Something has gone wrong. We'll try to cover all the cases when @@ -365,22 +368,25 @@ pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn | otherwise = do maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn - get_output_fn + get_output_fn maybe_loc case maybe_next_phase of - (Nothing, output_fn) -> + (Nothing, maybe_loc, output_fn) -> do -- we stopped early, but return the *final* filename -- (it presumably already exists) - get_output_fn stop_phase - (Just next_phase, output_fn) -> + final_fn <- get_output_fn stop_phase maybe_loc + return (final_fn, maybe_loc) + (Just next_phase, maybe_loc, output_fn) -> pipeLoop next_phase stop_phase output_fn - orig_basename orig_suff get_output_fn + orig_basename orig_suff get_output_fn maybe_loc genOutputFilenameFunc :: Bool -> Maybe FilePath -> Phase -> String - -> IO (Phase{-next phase-} -> IO FilePath) -genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename + -> IO (Phase{-next phase-} -> Maybe ModLocation -> IO FilePath) +genOutputFilenameFunc keep_final_output maybe_output_filename + stop_phase basename = do hcsuf <- readIORef v_HC_suf + odir <- readIORef v_Output_dir osuf <- readIORef v_Object_suf keep_hc <- readIORef v_Keep_hc_files #ifdef ILX @@ -394,24 +400,38 @@ genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename myPhaseInputExt Ln = osuf myPhaseInputExt other = phaseInputExt other - func next_phase - | next_phase == stop_phase - = case maybe_output_filename of - Just file -> return file - Nothing | keep_output -> return persistent - | otherwise -> newTempName suffix - -- sometimes, we keep output from intermediate stages - | otherwise - = case next_phase of - Ln -> return persistent - Mangle | keep_raw_s -> return persistent - As | keep_s -> return persistent - HCc | keep_hc -> return persistent - _other -> newTempName suffix + func next_phase maybe_location + | is_last_phase, Just f <- maybe_output_filename = return f + | is_last_phase && keep_final_output = persistent_fn + | keep_this_output = persistent_fn + | otherwise = newTempName suffix + where + is_last_phase = next_phase == stop_phase + + -- sometimes, we keep output from intermediate stages + keep_this_output = + case next_phase of + Ln -> True + Mangle | keep_raw_s -> True + As | keep_s -> True + HCc | keep_hc -> True + _other -> False + suffix = myPhaseInputExt next_phase + + -- persistent object files get put in odir + persistent_fn + | Ln <- next_phase = return odir_persistent + | otherwise = return persistent + persistent = basename ++ '.':suffix + odir_persistent + | Just loc <- maybe_location = ml_obj_file loc + | Just d <- odir = replaceFilenameDirectory persistent d + | otherwise = persistent + return func @@ -429,17 +449,20 @@ runPhase :: Phase -> String -- basename of original input source -> String -- its extension -> FilePath -- name of file which contains the input to this phase. - -> (Phase -> IO FilePath) -- how to calculate the output filename - -> IO (Maybe Phase, -- next phase - FilePath) -- output filename + -> (Phase -> Maybe ModLocation -> IO FilePath) + -- how to calculate the output filename + -> Maybe ModLocation -- the ModLocation, if we have one + -> IO (Maybe Phase, -- next phase + Maybe ModLocation, -- the ModLocation, if we have one + FilePath) -- output filename ------------------------------------------------------------------------------- -- Unlit phase -runPhase Unlit _basename _suff input_fn get_output_fn +runPhase Unlit _basename _suff input_fn get_output_fn maybe_loc = do unlit_flags <- getOpts opt_L -- The -h option passes the file name for unlit to put in a #line directive - output_fn <- get_output_fn Cpp + output_fn <- get_output_fn Cpp maybe_loc SysTools.runUnlit (map SysTools.Option unlit_flags ++ [ SysTools.Option "-h" @@ -448,12 +471,12 @@ runPhase Unlit _basename _suff input_fn get_output_fn , SysTools.FileOption "" output_fn ]) - return (Just Cpp, output_fn) + return (Just Cpp, maybe_loc, output_fn) ------------------------------------------------------------------------------- -- Cpp phase -runPhase Cpp basename suff input_fn get_output_fn +runPhase Cpp basename suff input_fn get_output_fn maybe_loc = do src_opts <- getOptionsFromSource input_fn unhandled_flags <- processArgs dynamic_flags src_opts [] checkProcessArgsResult unhandled_flags basename suff @@ -462,7 +485,7 @@ runPhase Cpp basename suff input_fn get_output_fn if not do_cpp then -- no need to preprocess CPP, just pass input file along -- to the next phase of the pipeline. - return (Just HsPp, input_fn) + return (Just HsPp, maybe_loc, input_fn) else do hscpp_opts <- getOpts opt_P hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts @@ -476,7 +499,7 @@ runPhase Cpp basename suff input_fn get_output_fn verb <- getVerbFlag (md_c_flags, _) <- machdepCCOpts - output_fn <- get_output_fn HsPp + output_fn <- get_output_fn HsPp maybe_loc SysTools.runCpp ([SysTools.Option verb] ++ map SysTools.Option include_paths @@ -498,22 +521,22 @@ runPhase Cpp basename suff input_fn get_output_fn , SysTools.FileOption "" output_fn ]) - return (Just HsPp, output_fn) + return (Just HsPp, maybe_loc, output_fn) ------------------------------------------------------------------------------- -- HsPp phase -runPhase HsPp basename suff input_fn get_output_fn +runPhase HsPp basename suff input_fn get_output_fn maybe_loc = do do_pp <- dynFlag ppFlag if not do_pp then -- no need to preprocess, just pass input file along -- to the next phase of the pipeline. - return (Just Hsc, input_fn) + return (Just Hsc, maybe_loc, input_fn) else do hspp_opts <- getOpts opt_F hs_src_pp_opts <- readIORef v_Hs_source_pp_opts let orig_fn = basename ++ '.':suff - output_fn <- get_output_fn Hsc + output_fn <- get_output_fn Hsc maybe_loc SysTools.runPp ( [ SysTools.Option orig_fn , SysTools.Option input_fn , SysTools.FileOption "" output_fn @@ -521,18 +544,18 @@ runPhase HsPp basename suff input_fn get_output_fn map SysTools.Option hs_src_pp_opts ++ map SysTools.Option hspp_opts ) - return (Just Hsc, output_fn) + return (Just Hsc, maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Hsc phase -- Compilation of a single module, in "legacy" mode (_not_ under -- the direction of the compilation manager). -runPhase Hsc basename suff input_fn get_output_fn = do +runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do todo <- readIORef v_GhcMode if todo == DoMkDependHS then do - doMkDependHSPhase basename suff input_fn - return (Nothing, input_fn) -- Ln is a dummy stop phase + locn <- doMkDependHSPhase basename suff input_fn + return (Nothing, Just locn, input_fn) -- Ln is a dummy stop phase else do -- normal Hsc mode, not mkdependHS @@ -547,7 +570,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do -- gather the imports and module name (_,_,mod_name) <- - if extcoreish_suffix suff + if isExtCoreFilename ('.':suff) then do -- no explicit imports in ExtCore input. m <- getCoreModuleName input_fn @@ -556,8 +579,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do getImportsFromFile input_fn -- build a ModLocation to pass to hscMain. - let (path,file) = splitFilenameDir basename - (mod, location') <- mkHomeModLocation mod_name True path file suff + (mod, location') <- mkHomeModLocation mod_name (basename ++ '.':suff) -- take -ohi into account if present ohi <- readIORef v_Output_hi @@ -598,21 +620,17 @@ runPhase Hsc basename suff input_fn get_output_fn = do dyn_flags <- getDynFlags hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags) next_phase <- hscNextPhase hsc_lang - output_fn <- get_output_fn next_phase + output_fn <- get_output_fn next_phase (Just location) let dyn_flags' = dyn_flags { hscLang = hsc_lang, hscOutName = output_fn, hscStubCOutName = basename ++ "_stub.c", hscStubHOutName = basename ++ "_stub.h", extCoreName = basename ++ ".hcr" } - hsc_env = HscEnv { hsc_mode = OneShot, - hsc_dflags = dyn_flags', - hsc_HPT = emptyHomePackageTable } - + hsc_env <- newHscEnv OneShot dyn_flags' -- run the compiler! - pcs <- initPersistentCompilerState - result <- hscMain hsc_env pcs mod + result <- hscMain hsc_env printErrorsAndWarnings mod location{ ml_hspp_file=Just input_fn } source_unchanged False @@ -620,13 +638,14 @@ runPhase Hsc basename suff input_fn get_output_fn = do case result of - HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1)) + HscFail -> throwDyn (PhaseFailed "hsc" (ExitFailure 1)) - HscNoRecomp pcs details iface -> do + HscNoRecomp details iface -> do SysTools.touch "Touching object file" o_file - return (Nothing, output_fn) + return (Nothing, Just location, output_fn) - HscRecomp _pcs _details _iface stub_h_exists stub_c_exists + HscRecomp _details _rdr_env _iface + stub_h_exists stub_c_exists _maybe_interpreted_code -> do -- deal with stubs @@ -635,8 +654,8 @@ runPhase Hsc basename suff input_fn get_output_fn = do Nothing -> return () Just stub_o -> add v_Ld_inputs stub_o case hscLang dyn_flags of - HscNothing -> return (Nothing, output_fn) - _ -> return (Just next_phase, output_fn) + HscNothing -> return (Nothing, Just location, output_fn) + _ -> return (Just next_phase, Just location, output_fn) ----------------------------------------------------------------------------- -- Cc phase @@ -644,7 +663,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do -- we don't support preprocessing .c files (with -E) now. Doing so introduces -- way too many hacks, and I can't say I've ever used it anyway. -runPhase cc_phase basename suff input_fn get_output_fn +runPhase cc_phase basename suff input_fn get_output_fn maybe_loc | cc_phase == Cc || cc_phase == HCc = do cc_opts <- getOpts opt_c cmdline_include_paths <- readIORef v_Include_paths @@ -658,7 +677,7 @@ runPhase cc_phase basename suff input_fn get_output_fn | hcc && mangle = Mangle | otherwise = As - output_fn <- get_output_fn next_phase + output_fn <- get_output_fn next_phase maybe_loc -- HC files have the dependent packages stamped into them pkgs <- if hcc then getHCFilePackages input_fn else return [] @@ -675,10 +694,6 @@ runPhase cc_phase basename suff input_fn get_output_fn verb <- getVerbFlag - o2 <- readIORef v_minus_o2_for_C - let opt_flag | o2 = "-O2" - | otherwise = "-O" - pkg_extra_cc_opts <- getPackageExtraCcOpts pkgs split_objs <- readIORef v_Split_object_files @@ -703,7 +718,7 @@ runPhase cc_phase basename suff input_fn get_output_fn ++ (if cc_phase == HCc && mangle then md_regd_c_flags else []) - ++ [ verb, "-S", "-Wimplicit", opt_flag ] + ++ [ verb, "-S", "-Wimplicit", "-O" ] ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ] ++ cc_opts ++ split_opt @@ -712,14 +727,14 @@ runPhase cc_phase basename suff input_fn get_output_fn ++ pkg_extra_cc_opts )) - return (Just next_phase, output_fn) + return (Just next_phase, maybe_loc, output_fn) -- ToDo: postprocess the output from gcc ----------------------------------------------------------------------------- -- Mangle phase -runPhase Mangle _basename _suff input_fn get_output_fn +runPhase Mangle _basename _suff input_fn get_output_fn maybe_loc = do mangler_opts <- getOpts opt_m machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM) then do n_regs <- dynFlag stolen_x86_regs @@ -730,7 +745,7 @@ runPhase Mangle _basename _suff input_fn get_output_fn let next_phase | split = SplitMangle | otherwise = As - output_fn <- get_output_fn next_phase + output_fn <- get_output_fn next_phase maybe_loc SysTools.runMangle (map SysTools.Option mangler_opts ++ [ SysTools.FileOption "" input_fn @@ -738,12 +753,12 @@ runPhase Mangle _basename _suff input_fn get_output_fn ] ++ map SysTools.Option machdep_opts) - return (Just next_phase, output_fn) + return (Just next_phase, maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Splitting phase -runPhase SplitMangle _basename _suff input_fn get_output_fn +runPhase SplitMangle _basename _suff input_fn get_output_fn maybe_loc = 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" @@ -763,16 +778,21 @@ runPhase SplitMangle _basename _suff input_fn get_output_fn addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s" | n <- [1..n_files]] - return (Just SplitAs, "**splitmangle**") -- we don't use the filename + return (Just SplitAs, maybe_loc, "**splitmangle**") + -- we don't use the filename ----------------------------------------------------------------------------- -- As phase -runPhase As _basename _suff input_fn get_output_fn +runPhase As _basename _suff input_fn get_output_fn maybe_loc = do as_opts <- getOpts opt_a cmdline_include_paths <- readIORef v_Include_paths - output_fn <- get_output_fn Ln + output_fn <- get_output_fn Ln maybe_loc + + -- we create directories for the object file, because it + -- might be a hierarchical module. + createDirectoryHierarchy (directoryOf output_fn) SysTools.runAs (map SysTools.Option as_opts ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] @@ -782,10 +802,10 @@ runPhase As _basename _suff input_fn get_output_fn , SysTools.FileOption "" output_fn ]) - return (Just Ln, output_fn) + return (Just Ln, maybe_loc, output_fn) -runPhase SplitAs basename _suff _input_fn get_output_fn +runPhase SplitAs basename _suff _input_fn get_output_fn maybe_loc = do as_opts <- getOpts opt_a (split_s_prefix, n) <- readIORef v_Split_info @@ -810,15 +830,15 @@ runPhase SplitAs basename _suff _input_fn get_output_fn mapM_ assemble_file [1..n] - output_fn <- get_output_fn Ln - return (Just Ln, output_fn) + output_fn <- get_output_fn Ln maybe_loc + return (Just Ln, maybe_loc, output_fn) #ifdef ILX ----------------------------------------------------------------------------- -- Ilx2Il phase -- Run ilx2il over the ILX output, getting an IL file -runPhase Ilx2Il _basename _suff input_fn get_output_fn +runPhase Ilx2Il _basename _suff input_fn get_output_fn maybe_loc = do ilx2il_opts <- getOpts opt_I SysTools.runIlx2il (map SysTools.Option ilx2il_opts ++ [ SysTools.Option "--no-add-suffix-to-assembly", @@ -832,7 +852,7 @@ runPhase Ilx2Il _basename _suff input_fn get_output_fn -- Ilasm phase -- Run ilasm over the IL, getting a DLL -runPhase Ilasm _basename _suff input_fn get_output_fn +runPhase Ilasm _basename _suff input_fn get_output_fn maybe_loc = do ilasm_opts <- getOpts opt_i SysTools.runIlasm (map SysTools.Option ilasm_opts ++ [ SysTools.Option "/QUIET", @@ -1034,9 +1054,7 @@ staticLink o_files dep_packages = do ++ pkg_framework_path_opts ++ pkg_framework_opts #endif - ++ if static && not no_hs_main then - [ "-u", prefixUnderscore "Main_zdmain_closure"] - else [])) + )) -- parallel only: move binary to another dir -- HWL ways_ <- readIORef v_Ways @@ -1048,8 +1066,8 @@ staticLink o_files dep_packages = do ----------------------------------------------------------------------------- -- Making a DLL (only for Win32) -doMkDLL :: [String] -> IO () -doMkDLL o_files = do +doMkDLL :: [String] -> [PackageName] -> IO () +doMkDLL o_files dep_packages = do verb <- getVerbFlag static <- readIORef v_Static no_hs_main <- readIORef v_NoHsMain @@ -1057,13 +1075,13 @@ doMkDLL o_files = do o_file <- readIORef v_Output_file let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; } - pkg_lib_paths <- getPackageLibraryPath [] + pkg_lib_paths <- getPackageLibraryPath dep_packages let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths lib_paths <- readIORef v_Library_paths let lib_path_opts = map ("-L"++) lib_paths - pkg_link_opts <- getPackageLinkOpts [] + pkg_link_opts <- getPackageLinkOpts dep_packages -- probably _stub.o files extra_ld_inputs <- readIORef v_Ld_inputs