X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPipeline.hs;h=c2d42351868ca246af8241d4f108a8a1190c624b;hb=9b6803a6ec263f81ecfadf303b7dba0d1cd5f97e;hp=f48f9e082680c801cb712d2ee7ef9c3fbfb55ba2;hpb=e853681924c4cf1e1f2dd75276973aedd222d358;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index f48f9e0..c2d4235 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -44,6 +44,9 @@ import CmdLineOpts import Config import Panic import Util +import Maybes ( expectJust ) + +import ParserCoreUtils ( getCoreModuleName ) #ifdef GHCI import Time ( getClockTime ) @@ -187,9 +190,12 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix) -- something has gone wrong. This test carefully avoids the -- case where we aren't supposed to do any compilation, because the file -- is already in linkable form (for example). +-- hPutStrLn stderr (show ((start_phase `elem` pipeline,stop_phase /= Ln,stop_phase `notElem` pipeline), start_phase, stop_phase, pipeline,todo)) +-- hFlush stderr when (start_phase `elem` pipeline && (stop_phase /= Ln && stop_phase `notElem` pipeline)) - (throwDyn (UsageError + (do + throwDyn (UsageError ("flag `" ++ stop_flag ++ "' is incompatible with source file `" ++ filename ++ "'" ++ show pipeline ++ show stop_phase))) @@ -390,12 +396,9 @@ run_phase Cpp basename suff input_fn output_fn ------------------------------------------------------------------------------- -- HsPp phase -run_phase HsPp basename suff input_fn output_fn - = do src_opts <- getOptionsFromSource input_fn - unhandled_flags <- processArgs dynamic_flags src_opts [] - checkProcessArgsResult unhandled_flags basename suff - let orig_fn = basename ++ '.':suff +run_phase HsPp basename suff input_fn output_fn + = do let orig_fn = basename ++ '.':suff do_pp <- dynFlag ppFlag if not do_pp then -- no need to preprocess, just pass input file along @@ -439,17 +442,19 @@ run_phase MkDependHS basename suff input_fn output_fn hdl <- readIORef v_Dep_tmp_hdl -- std dependency of the object(s) on the source file - hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff) + hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++ + escapeSpaces (basename ++ '.':suff)) let genDep (dep, False {- not an hi file -}) = - hPutStrLn hdl (unwords objs ++ " : " ++ dep) + hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++ + escapeSpaces dep) genDep (dep, True {- is an hi file -}) = do hisuf <- readIORef v_Hi_suf let dep_base = remove_suffix '.' dep deps = (dep_base ++ hisuf) : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes -- length objs should be == length deps - sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps) + sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps) sequence_ (map genDep [ d | Just d <- deps ]) return (Just output_fn) @@ -472,6 +477,7 @@ run_phase MkDependHS basename suff input_fn output_fn -- (where .o is $osuf, and the other suffixes come from -- the cmdline -s options). + ----------------------------------------------------------------------------- -- Hsc phase @@ -503,7 +509,14 @@ run_phase Hsc basename suff input_fn output_fn writeIORef v_HCHeader cc_injects -- gather the imports and module name - (srcimps,imps,mod_name) <- getImportsFromFile input_fn + (srcimps,imps,mod_name) <- + if extcoreish_suffix suff + then do + -- no explicit imports in ExtCore input. + m <- getCoreModuleName input_fn + return ([], [], mkModuleName m) + else + getImportsFromFile input_fn -- build a ModuleLocation to pass to hscMain. (mod, location') @@ -526,10 +539,13 @@ run_phase Hsc basename suff input_fn output_fn do_recomp <- readIORef v_Recomp todo <- readIORef v_GhcMode expl_o_file <- readIORef v_Output_file - let o_file = - case expl_o_file of - Nothing -> unJust "source_unchanged" (ml_obj_file location) - Just x -> x + + let o_file -- if the -o option is given and IT IS THE OBJECT FILE FOR + -- THIS COMPILATION, then use that to determine if the + -- source is unchanged. + | Just x <- expl_o_file, todo == StopBefore Ln = x + | otherwise = expectJust "source_unchanged" (ml_obj_file location) + source_unchanged <- if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln )) then return False @@ -712,7 +728,7 @@ run_phase SplitAs basename _suff _input_fn output_fn odir <- readIORef v_Output_dir let real_odir = case odir of - Nothing -> basename + Nothing -> basename ++ "_split" Just d -> d let assemble_file n @@ -848,7 +864,7 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $ -- Complain about non-dynamic flags in OPTIONS pragmas checkProcessArgsResult flags basename suff - = do when (not (null flags)) (throwDyn (ProgramError ( + = do when (notNull flags) (throwDyn (ProgramError ( basename ++ "." ++ suff ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" ++ unwords flags)) (ExitFailure 1)) @@ -879,6 +895,21 @@ doLink o_files = do let lib_opts = map ("-l"++) (reverse libs) -- reverse because they're added in reverse order from the cmd line +#ifdef darwin_TARGET_OS + pkg_framework_paths <- getPackageFrameworkPath + let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths + + framework_paths <- readIORef v_Framework_paths + let framework_path_opts = map ("-F"++) framework_paths + + pkg_frameworks <- getPackageFrameworks + let pkg_framework_opts = map ("-framework " ++) pkg_frameworks + + frameworks <- readIORef v_Cmdline_frameworks + let framework_opts = map ("-framework "++) (reverse frameworks) + -- reverse because they're added in reverse order from the cmd line +#endif + pkg_extra_ld_opts <- getPackageExtraLdOpts -- probably _stub.o files @@ -906,8 +937,16 @@ doLink o_files = do ++ extra_ld_inputs ++ lib_path_opts ++ lib_opts +#ifdef darwin_TARGET_OS + ++ framework_path_opts + ++ framework_opts +#endif ++ pkg_lib_path_opts ++ pkg_lib_opts +#ifdef darwin_TARGET_OS + ++ pkg_framework_path_opts + ++ pkg_framework_opts +#endif ++ pkg_extra_ld_opts ++ extra_ld_opts ++ if static && not no_hs_main then @@ -1048,8 +1087,8 @@ compile ghci_mode summary source_unchanged have_object let verb = verbosity dyn_flags let location = ms_location summary - let input_fn = unJust "compile:hs" (ml_hs_file location) - let input_fnpp = unJust "compile:hspp" (ml_hspp_file location) + let input_fn = expectJust "compile:hs" (ml_hs_file location) + let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location) when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp)) @@ -1115,7 +1154,6 @@ compile ghci_mode summary source_unchanged have_object HscRecomp pcs details iface stub_h_exists stub_c_exists maybe_interpreted_code -> do - let maybe_stub_o <- compileStub dyn_flags' stub_c_exists let stub_unlinked = case maybe_stub_o of