" but I wanted to stop at phase " ++ show stop_phase)
| otherwise
- = do (next_phase, dflags', maybe_loc, output_fn)
+ = do liftIO $ debugTraceMsg (hsc_dflags hsc_env) 4
+ (ptext (sLit "Running phase") <+> ppr phase)
+ (next_phase, dflags', maybe_loc, output_fn)
<- runPhase phase stop_phase hsc_env orig_basename
orig_suff input_fn orig_get_output_fn maybe_loc
let hsc_env' = hsc_env {hsc_dflags = dflags'}
runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do let dflags0 = hsc_dflags hsc_env
- let dflags0' = flattenLanguageFlags dflags0
+ let dflags0' = flattenExtensionFlags dflags0
src_opts <- liftIO $ getOptionsFromFile dflags0' input_fn
(dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
checkProcessArgsResult unhandled_flags
- let dflags1' = flattenLanguageFlags dflags1
+ let dflags1' = flattenExtensionFlags dflags1
if not (dopt Opt_Cpp dflags1') then do
-- we have to be careful to emit warnings only once.
src_opts <- liftIO $ getOptionsFromFile dflags0' output_fn
(dflags2, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts
- let dflags2' = flattenLanguageFlags dflags2
+ let dflags2' = flattenExtensionFlags dflags2
unless (dopt Opt_Pp dflags2') $ handleFlagWarnings dflags2' warns
-- the HsPp pass below will emit warnings
checkProcessArgsResult unhandled_flags
runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
= do let dflags = hsc_dflags hsc_env
- dflags' = flattenLanguageFlags dflags
+ dflags' = flattenExtensionFlags dflags
if not (dopt Opt_Pp dflags) then
-- no need to preprocess, just pass input file along
-- to the next phase of the pipeline.
src_opts <- liftIO $ getOptionsFromFile dflags' output_fn
(dflags1, unhandled_flags, warns)
<- liftIO $ parseDynamicNoPackageFlags dflags src_opts
- let dflags1' = flattenLanguageFlags dflags1
+ let dflags1' = flattenExtensionFlags dflags1
handleFlagWarnings dflags1' warns
checkProcessArgsResult unhandled_flags
runPhase CmmCpp _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
= do
let dflags = hsc_dflags hsc_env
- dflags' = flattenLanguageFlags dflags
+ dflags' = flattenExtensionFlags dflags
output_fn <- liftIO $ get_output_fn dflags' Cmm maybe_loc
liftIO $ doCpp dflags' False{-not raw-} True{-include CC opts-} input_fn output_fn
return (Cmm, dflags', maybe_loc, output_fn)
runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc
= do
- let dflags = hsc_dflags hsc_env
+ let dflags = ensureFlattenedExtensionFlags $ hsc_dflags hsc_env
let hsc_lang = hscMaybeAdjustTarget dflags stop HsSrcFile (hscTarget dflags)
let next_phase = hscNextPhase dflags HsSrcFile hsc_lang
output_fn <- liftIO $ get_output_fn dflags next_phase maybe_loc
let dflags = hsc_dflags hsc_env
let lo_opts = getOpts dflags opt_lo
let opt_lvl = max 0 (min 2 $ optLevel dflags)
+ -- don't specify anything if user has specified commands. We do this for
+ -- opt but not llc since opt is very specifically for optimisation passes
+ -- only, so if the user is passing us extra options we assume they know
+ -- what they are doing and don't get in the way.
+ let optFlag = if null lo_opts
+ then [SysTools.Option (llvmOpts !! opt_lvl)]
+ else []
output_fn <- get_output_fn dflags LlvmLlc maybe_loc
SysTools.runLlvmOpt dflags
([ SysTools.FileOption "" input_fn,
- SysTools.Option (llvmOpts !! opt_lvl),
SysTools.Option "-o",
SysTools.FileOption "" output_fn]
- ++ map SysTools.Option lo_opts)
+ ++ optFlag
+ ++ map SysTools.Option lo_opts)
return (LlvmLlc, dflags, maybe_loc, output_fn)
where
- -- we always run Opt since we rely on it to fix up some pretty
- -- big deficiencies in the code we generate
+ -- we always (unless -optlo specified) run Opt since we rely on it to
+ -- fix up some pretty big deficiencies in the code we generate
llvmOpts = ["-mem2reg", "-O1", "-O2"]
let no_hs_main = dopt Opt_NoHsMain dflags
let main_lib | no_hs_main = []
| otherwise = [ "-lHSrtsmain" ]
- rtsEnabledObj <- if dopt Opt_RtsOptsEnabled dflags
- then do fn <- mkExtraCObj dflags
- ["#include \"Rts.h\"",
- "const rtsBool rtsOptsEnabled = rtsTrue;"]
- return [fn]
- else return []
+ let mkRtsEnabledObj val = do fn <- mkExtraCObj dflags
+ ["#include \"Rts.h\"",
+ "#include \"RtsOpts.h\"",
+ "const rtsOptsEnabledEnum rtsOptsEnabled = "
+ ++ val ++ ";"]
+ return [fn]
+ rtsEnabledObj <- case rtsOptsEnabled dflags of
+ RtsOptsNone -> mkRtsEnabledObj "rtsOptsNone"
+ RtsOptsSafeOnly -> return []
+ RtsOptsAll -> mkRtsEnabledObj "rtsOptsAll"
rtsOptsObj <- case rtsOpts dflags of
Just opts ->
do fn <- mkExtraCObj dflags