Add DoAndIfThenElse support

[ghc-hetmet.git] / compiler / main / DynFlags.hs

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 6524ba6..85554cb 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -19,6 +19,7 @@ module DynFlags (
         lopt_set_flattened,
         lopt_unset_flattened,
         DynFlags(..),
+        RtsOptsEnabled(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
@@ -234,7 +235,6 @@ data DynFlag
    | Opt_EagerBlackHoling
    | Opt_ReadUserPackageConf
    | Opt_NoHsMain
-   | Opt_RtsOptsEnabled
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_HideAllPackages
@@ -305,6 +305,7 @@ data ExtensionFlag
    | Opt_GADTs
    | Opt_RelaxedPolyRec
    | Opt_NPlusKPatterns
+   | Opt_DoAndIfThenElse
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
@@ -418,6 +419,7 @@ data DynFlags = DynFlags {
   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
   ghciUsagePath         :: FilePath,    -- ditto
   rtsOpts               :: Maybe String,
+  rtsOptsEnabled        :: RtsOptsEnabled,
 
   hpcDir                :: String,      -- ^ Path to store the .mix files
 
@@ -592,6 +594,8 @@ data DynLibLoader
   | SystemDependent
   deriving Eq
 
+data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+
 -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
 initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
@@ -662,6 +666,7 @@ defaultDynFlags =
         cmdlineFrameworks       = [],
         tmpDir                  = cDEFAULT_TMPDIR,
         rtsOpts                 = Nothing,
+        rtsOptsEnabled          = RtsOptsSafeOnly,
 
         hpcDir                  = ".hpc",
 
@@ -738,9 +743,10 @@ defaultDynFlags =
 
         log_action = \severity srcSpan style msg ->
                         case severity of
-                          SevInfo  -> printErrs (msg style)
-                          SevFatal -> printErrs (msg style)
-                          _        -> do 
+                          SevOutput -> printOutput (msg style)
+                          SevInfo   -> printErrs (msg style)
+                          SevFatal  -> printErrs (msg style)
+                          _         -> do 
                                 hPutChar stderr '\n'
                                 printErrs ((mkLocMessage srcSpan msg) style)
                      -- careful (#2302): printErrs prints in UTF-8, whereas
@@ -809,6 +815,7 @@ languageExtensions (Just Haskell2010)
        Opt_EmptyDataDecls,
        Opt_ForeignFunctionInterface,
        Opt_PatternGuards,
+       Opt_DoAndIfThenElse,
        Opt_RelaxedPolyRec]
 
 -- The DOpt class is a temporary workaround, to avoid having to do
@@ -1247,8 +1254,11 @@ dynamic_flags = [
   , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
   , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain)) Supported
   , Flag "with-rtsopts"   (HasArg setRtsOpts) Supported
-  , Flag "rtsopts"        (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported
-  , Flag "no-rtsopts"     (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported
+  , Flag "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+  , Flag "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+  , Flag "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) Supported
+  , Flag "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
+  , Flag "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
   , Flag "main-is"        (SepArg setMainIs ) Supported
   , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock)) Supported
   , Flag "haddock-opts"   (HasArg (upd . addHaddockOpts)) Supported
@@ -1765,6 +1775,7 @@ xFlags = [
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
   ( "NPlusKPatterns",                   Opt_NPlusKPatterns, const Supported ),
+  ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, const Supported ),
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
   ( "ExplicitForAll",                   Opt_ExplicitForAll, const Supported ),
   ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, const Supported ),
@@ -2198,6 +2209,9 @@ setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
 setRtsOpts :: String -> DynP ()
 setRtsOpts arg  = upd $ \ d -> d {rtsOpts = Just arg}
 
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg  = upd $ \ d -> d {rtsOptsEnabled = arg}
+
 -----------------------------------------------------------------------------
 -- Hpc stuff