Make -rtsopts more flexible
[ghc-hetmet.git] / compiler / main / DriverPipeline.hs
index 687c435..2b9cd43 100644 (file)
@@ -581,7 +581,9 @@ pipeLoop hsc_env phase stop_phase
            " 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'}
@@ -1511,12 +1513,16 @@ linkBinary dflags o_files dep_packages = do
     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