X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=d4cb66af69cc78814b18d7e4a543ad90d2781c80;hb=29da2cf3011c292bc4261601aff85afb13e24d54;hp=81ef08da225fd1f88a8821780cd4c69ca90825fd;hpb=2d532e45924dfdb5b5157caf4d3fc3541497d86c;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 81ef08d..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,7 +70,7 @@ 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-} @@ -95,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 @@ -154,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 @@ -191,10 +190,6 @@ 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 Nothing output_fn (Just location) @@ -206,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) @@ -387,7 +382,8 @@ pipeLoop phase stop_phase input_fn orig_basename orig_suff genOutputFilenameFunc :: Bool -> Maybe FilePath -> Phase -> String -> IO (Phase{-next phase-} -> Maybe ModLocation -> IO FilePath) -genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename +genOutputFilenameFunc keep_final_output maybe_output_filename + stop_phase basename = do hcsuf <- readIORef v_HC_suf odir <- readIORef v_Output_dir @@ -405,23 +401,30 @@ genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename myPhaseInputExt other = phaseInputExt other func next_phase maybe_location - | next_phase == stop_phase - = case maybe_output_filename of - Just file -> return file - Nothing - | Ln <- next_phase -> return odir_persistent - | keep_output -> return persistent - | otherwise -> newTempName suffix - -- sometimes, we keep output from intermediate stages - | otherwise - = case next_phase of - Ln -> return odir_persistent - Mangle | keep_raw_s -> return persistent - As | keep_s -> return persistent - HCc | keep_hc -> return persistent - _other -> newTempName suffix + | 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 @@ -567,7 +570,7 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = 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 @@ -624,14 +627,10 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do 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 @@ -639,13 +638,14 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = 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, 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 @@ -694,10 +694,6 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc 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 @@ -722,7 +718,7 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc ++ (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 @@ -794,6 +790,10 @@ runPhase As _basename _suff input_fn get_output_fn maybe_loc 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 ] ++ [ SysTools.Option "-c" @@ -1054,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