Use a proper datatype, rather than pairs, for flags
[ghc-hetmet.git] / compiler / main / StaticFlags.hs
index a2362d9..dd5754c 100644 (file)
@@ -21,6 +21,7 @@ module StaticFlags (
        opt_PprUserLength,
        opt_SuppressUniques,
        opt_PprStyle_Debug,
+        opt_NoDebugOutput,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
@@ -36,10 +37,9 @@ module StaticFlags (
        opt_DictsStrict,
        opt_IrrefutableTuples,
        opt_Parallel,
-       opt_RuntimeTypes,
 
        -- optimisation opts
-       opt_NoMethodSharing, 
+       opt_DsMultiTyVar,
        opt_NoStateHack,
        opt_SpecInlineJoinPoints,
        opt_CprOff,
@@ -54,6 +54,9 @@ module StaticFlags (
        opt_UF_KeenessFactor,
        opt_UF_DearOp,
 
+       -- Optimization fuel controls
+       opt_Fuel,
+
        -- Related to linking
        opt_PIC,
        opt_Static,
@@ -130,7 +133,7 @@ parseStaticFlags args = do
 initStaticOpts :: IO ()
 initStaticOpts = writeIORef v_opt_C_ready True
 
-static_flags :: [(String, OptKind IO)]
+static_flags :: [Flag IO]
 -- All the static flags should appear in this list.  It describes how each
 -- static flag should be processed.  Two main purposes:
 -- (a) if a command-line flag doesn't appear in the list, GHC can complain
@@ -138,63 +141,62 @@ static_flags :: [(String, OptKind IO)]
 --
 -- The common (PassFlag addOpt) action puts the static flag into the bunch of
 -- things that are searched up by the top-level definitions like
---     opt_foo = lookUp FSLIT("-dfoo")
+--     opt_foo = lookUp (fsLit "-dfoo")
 
 -- Note that ordering is important in the following list: any flag which
 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 -- flags further down the list with the same prefix.
 
 static_flags = [
-       ------- GHCi -------------------------------------------------------
-     ( "ignore-dot-ghci", PassFlag addOpt )
-  ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )
-
-       ------- ways --------------------------------------------------------
-  ,  ( "prof"          , NoArg (addWay WayProf) )
-  ,  ( "ticky"         , NoArg (addWay WayTicky) )
-  ,  ( "parallel"      , NoArg (addWay WayPar) )
-  ,  ( "gransim"       , NoArg (addWay WayGran) )
-  ,  ( "smp"           , NoArg (addWay WayThreaded) ) -- backwards compat.
-  ,  ( "debug"         , NoArg (addWay WayDebug) )
-  ,  ( "ndp"           , NoArg (addWay WayNDP) )
-  ,  ( "threaded"      , NoArg (addWay WayThreaded) )
-       -- ToDo: user ways
-
-       ------ Debugging ----------------------------------------------------
-  ,  ( "dppr-debug",        PassFlag addOpt )
-  ,  ( "dsuppress-uniques", PassFlag addOpt )
-  ,  ( "dppr-user-length",  AnySuffix addOpt )
+        ------- GHCi -------------------------------------------------------
+    Flag "ignore-dot-ghci" (PassFlag addOpt)
+  , Flag "read-dot-ghci"   (NoArg (removeOpt "-ignore-dot-ghci"))
+
+        ------- ways --------------------------------------------------------
+  , Flag "prof"           (NoArg (addWay WayProf))
+  , Flag "ticky"          (NoArg (addWay WayTicky))
+  , Flag "parallel"       (NoArg (addWay WayPar))
+  , Flag "gransim"        (NoArg (addWay WayGran))
+  , Flag "smp"            (NoArg (addWay WayThreaded)) -- backwards compat.
+  , Flag "debug"          (NoArg (addWay WayDebug))
+  , Flag "ndp"            (NoArg (addWay WayNDP))
+  , Flag "threaded"       (NoArg (addWay WayThreaded))
+        -- ToDo: user ways
+
+        ------ Debugging ----------------------------------------------------
+  , Flag "dppr-debug"        (PassFlag addOpt)
+  , Flag "dsuppress-uniques" (PassFlag addOpt)
+  , Flag "dppr-user-length"  (AnySuffix addOpt)
+  , Flag "dopt-fuel"         (AnySuffix addOpt)
+  , Flag "dno-debug-output"  (PassFlag addOpt)
       -- rest of the debugging flags are dynamic
 
-       --------- Profiling --------------------------------------------------
-  ,  ( "auto-all"      , NoArg (addOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "auto"          , NoArg (addOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "caf-all"       , NoArg (addOpt "-fauto-sccs-on-individual-cafs") )
+        --------- Profiling --------------------------------------------------
+  , Flag "auto-all"       (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
+  , Flag "auto"           (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
+  , Flag "caf-all"        (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
          -- "ignore-sccs"  doesn't work  (ToDo)
 
-  ,  ( "no-auto-all"   , NoArg (removeOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "no-auto"       , NoArg (removeOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "no-caf-all"    , NoArg (removeOpt "-fauto-sccs-on-individual-cafs") )
-
-       ------- Miscellaneous -----------------------------------------------
-  ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
+  , Flag "no-auto-all"    (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
+  , Flag "no-auto"        (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
+  , Flag "no-caf-all"     (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
 
-       ----- Linker --------------------------------------------------------
-  ,  ( "static"        , PassFlag addOpt )
-  ,  ( "dynamic"        , NoArg (removeOpt "-static") )
-  ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
+        ----- Linker --------------------------------------------------------
+  , Flag "static"         (PassFlag addOpt)
+  , Flag "dynamic"        (NoArg (removeOpt "-static"))
+  , Flag "rdynamic"       (NoArg (return ())) -- ignored for compat w/ gcc
 
-       ----- RTS opts ------------------------------------------------------
-  ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
-  ,  ( "Rghc-timing"      , NoArg  (enableTimingStats) )
+        ----- RTS opts ------------------------------------------------------
+  , Flag "H"              (HasArg (setHeapSize . fromIntegral . decodeSize))
+  , Flag "Rghc-timing"    (NoArg  (enableTimingStats))
 
         ------ Compiler flags -----------------------------------------------
-       -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
-  ,  ( "fno-",                 PrefixPred (\s -> isStaticFlag ("f"++s))
-                                   (\s -> removeOpt ("-f"++s)) )
+        -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
+  , Flag "fno-"
+         (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
 
-       -- Pass all remaining "-f<blah>" options to hsc
-  ,  ( "f",                    AnySuffixPred (isStaticFlag) addOpt )
+        -- Pass all remaining "-f<blah>" options to hsc
+  , Flag "f"                      (AnySuffixPred (isStaticFlag) addOpt)
   ]
 
 addOpt :: String -> IO ()
@@ -279,71 +281,77 @@ unpacked_opts =
 -}
 
 opt_IgnoreDotGhci :: Bool
-opt_IgnoreDotGhci              = lookUp FSLIT("-ignore-dot-ghci")
+opt_IgnoreDotGhci              = lookUp (fsLit "-ignore-dot-ghci")
 
 -- debugging opts
 opt_SuppressUniques :: Bool
-opt_SuppressUniques            = lookUp  FSLIT("-dsuppress-uniques")
-opt_PprStyle_Debug :: Bool
-opt_PprStyle_Debug             = lookUp  FSLIT("-dppr-debug")
-opt_PprUserLength :: Int
+opt_SuppressUniques            = lookUp  (fsLit "-dsuppress-uniques")
+opt_PprStyle_Debug  :: Bool
+opt_PprStyle_Debug             = lookUp  (fsLit "-dppr-debug")
+opt_PprUserLength   :: Int
 opt_PprUserLength              = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
+opt_Fuel            :: Int
+opt_Fuel                        = lookup_def_int "-dopt-fuel" maxBound
+opt_NoDebugOutput   :: Bool
+opt_NoDebugOutput               = lookUp  (fsLit "-dno-debug-output")
+
 
 -- profiling opts
 opt_AutoSccsOnAllToplevs :: Bool
-opt_AutoSccsOnAllToplevs       = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
+opt_AutoSccsOnAllToplevs       = lookUp  (fsLit "-fauto-sccs-on-all-toplevs")
 opt_AutoSccsOnExportedToplevs :: Bool
-opt_AutoSccsOnExportedToplevs  = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
+opt_AutoSccsOnExportedToplevs  = lookUp  (fsLit "-fauto-sccs-on-exported-toplevs")
 opt_AutoSccsOnIndividualCafs :: Bool
-opt_AutoSccsOnIndividualCafs   = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
+opt_AutoSccsOnIndividualCafs   = lookUp  (fsLit "-fauto-sccs-on-individual-cafs")
 opt_SccProfilingOn :: Bool
-opt_SccProfilingOn             = lookUp  FSLIT("-fscc-profiling")
+opt_SccProfilingOn             = lookUp  (fsLit "-fscc-profiling")
 opt_DoTickyProfiling :: Bool
 opt_DoTickyProfiling            = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways)
 
 -- Hpc opts
 opt_Hpc :: Bool
-opt_Hpc                                = lookUp FSLIT("-fhpc")  
+opt_Hpc                                = lookUp (fsLit "-fhpc")  
 
 -- language opts
 opt_DictsStrict :: Bool
-opt_DictsStrict                        = lookUp  FSLIT("-fdicts-strict")
+opt_DictsStrict                        = lookUp  (fsLit "-fdicts-strict")
 opt_IrrefutableTuples :: Bool
-opt_IrrefutableTuples          = lookUp  FSLIT("-firrefutable-tuples")
+opt_IrrefutableTuples          = lookUp  (fsLit "-firrefutable-tuples")
 opt_Parallel :: Bool
-opt_Parallel                   = lookUp  FSLIT("-fparallel")
+opt_Parallel                   = lookUp  (fsLit "-fparallel")
 
 -- optimisation opts
+opt_DsMultiTyVar :: Bool
+opt_DsMultiTyVar               = not (lookUp (fsLit "-fno-ds-multi-tyvar"))
+       -- On by default
+
 opt_SpecInlineJoinPoints :: Bool
-opt_SpecInlineJoinPoints       = lookUp  FSLIT("-fspec-inline-join-points")
+opt_SpecInlineJoinPoints       = lookUp  (fsLit "-fspec-inline-join-points")
+
 opt_NoStateHack :: Bool
-opt_NoStateHack                        = lookUp  FSLIT("-fno-state-hack")
-opt_NoMethodSharing :: Bool
-opt_NoMethodSharing            = lookUp  FSLIT("-fno-method-sharing")
+opt_NoStateHack                        = lookUp  (fsLit "-fno-state-hack")
 opt_CprOff :: Bool
-opt_CprOff                     = lookUp  FSLIT("-fcpr-off")
+opt_CprOff                     = lookUp  (fsLit "-fcpr-off")
        -- Switch off CPR analysis in the new demand analyser
 opt_MaxWorkerArgs :: Int
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
 opt_GranMacros :: Bool
-opt_GranMacros                 = lookUp  FSLIT("-fgransim")
+opt_GranMacros                 = lookUp  (fsLit "-fgransim")
 opt_HiVersion :: Integer
 opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
 opt_HistorySize :: Int
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
 opt_OmitBlackHoling :: Bool
-opt_OmitBlackHoling            = lookUp  FSLIT("-dno-black-holing")
-opt_RuntimeTypes :: Bool
-opt_RuntimeTypes               = lookUp  FSLIT("-fruntime-types")
+opt_OmitBlackHoling            = lookUp  (fsLit "-dno-black-holing")
 
 -- Simplifier switches
 opt_SimplNoPreInlining :: Bool
-opt_SimplNoPreInlining         = lookUp  FSLIT("-fno-pre-inlining")
+opt_SimplNoPreInlining         = lookUp  (fsLit "-fno-pre-inlining")
        -- NoPreInlining is there just to see how bad things
        -- get if you don't do it!
 opt_SimplExcessPrecision :: Bool
-opt_SimplExcessPrecision       = lookUp  FSLIT("-fexcess-precision")
+opt_SimplExcessPrecision       = lookUp  (fsLit "-fexcess-precision")
 
 -- Unfolding control
 opt_UF_CreationThreshold :: Int
@@ -358,16 +366,18 @@ opt_UF_KeenessFactor              = lookup_def_float "-funfolding-keeness-factor"    (1.5::F
 opt_UF_DearOp :: Int
 opt_UF_DearOp   = ( 4 :: Int)
 
+
+-- Related to linking
 opt_PIC :: Bool
 #if darwin_TARGET_OS && x86_64_TARGET_ARCH
 opt_PIC                         = True
 #else
-opt_PIC                         = lookUp FSLIT("-fPIC")
+opt_PIC                         = lookUp (fsLit "-fPIC")
 #endif
 opt_Static :: Bool
-opt_Static                     = lookUp  FSLIT("-static")
+opt_Static                     = lookUp  (fsLit "-static")
 opt_Unregisterised :: Bool
-opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
+opt_Unregisterised             = lookUp  (fsLit "-funregisterised")
 
 -- Derived, not a real option.  Determines whether we will be compiling
 -- info tables that reside just before the entry code, or with an
@@ -378,11 +388,11 @@ tablesNextToCode          = not opt_Unregisterised
                                  && cGhcEnableTablesNextToCode == "YES"
 
 opt_EmitExternalCore :: Bool
-opt_EmitExternalCore           = lookUp  FSLIT("-fext-core")
+opt_EmitExternalCore           = lookUp  (fsLit "-fext-core")
 
 -- Include full span info in error messages, instead of just the start position.
 opt_ErrorSpans :: Bool
-opt_ErrorSpans                 = lookUp FSLIT("-ferror-spans")
+opt_ErrorSpans                 = lookUp (fsLit "-ferror-spans")
 
 
 -- object files and libraries to be linked in are collected here.
@@ -406,6 +416,7 @@ isStaticFlag f =
        "dno-black-holing",
        "fno-method-sharing",
        "fno-state-hack",
+       "fno-ds-multi-tyvar",
        "fruntime-types",
        "fno-pre-inlining",
        "fexcess-precision",