Finish #3439: -ticky implies -debug at link time; the ticky "way" has gone

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index adee723..ab9d821 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -246,6 +246,7 @@ data DynFlag
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
+   | Opt_DoRec
    | Opt_PostfixOperators
    | Opt_TupleSections
    | Opt_PatternGuards
@@ -350,6 +351,7 @@ data DynFlags = DynFlags {
   maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
   ruleCheck             :: Maybe String,
+  strictnessBefore      :: [Int],       -- ^ Additional demand analysis
 
   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
@@ -544,7 +546,9 @@ isNoLink _      = False
 -- Is it worth evaluating this Bool and caching it in the DynFlags value
 -- during initDynFlags?
 doingTickyProfiling :: DynFlags -> Bool
-doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
+doingTickyProfiling _ = opt_Ticky
+  -- XXX -ticky is a static flag, because it implies -debug which is also
+  -- static.  If the way flags were made dynamic, we could fix this.
 
 data PackageFlag
   = ExposePackage  String
@@ -605,6 +609,8 @@ defaultDynFlags =
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
+        strictnessBefore        = [],
+
 #ifndef OMIT_NATIVE_CODEGEN
         targetPlatform          = defaultTargetPlatform,
 #endif
@@ -1065,9 +1071,13 @@ getCoreToDo dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
+    maybe_strictness_before phase
+      = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
+
     simpl_phase phase names iter
       = CoreDoPasses
-          [ CoreDoSimplify (SimplPhase phase names) [
+          [ maybe_strictness_before phase,
+            CoreDoSimplify (SimplPhase phase names) [
               MaxSimplifierIterations iter
             ],
             maybe_rule_check phase
@@ -1558,6 +1568,10 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
+  , Flag "fstrictness-before"
+         (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs })))
+         Supported
+
         ------ Profiling ----------------------------------------------------
 
   -- XXX Should the -f* flags be deprecated?
@@ -1650,7 +1664,7 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
 
 deprecatedForLanguage :: String -> Bool -> Deprecated
 deprecatedForLanguage lang turn_on
-    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
     where 
       flag | turn_on    = lang
            | otherwise = "No"++lang
@@ -1799,9 +1813,12 @@ xFlags = [
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
-  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, const Supported ),
+  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, 
+        const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
   ( "TypeOperators",                    Opt_TypeOperators, const Supported ),
-  ( "RecursiveDo",                      Opt_RecursiveDo, const Supported ),
+  ( "RecursiveDo",                      Opt_RecursiveDo,
+    deprecatedForLanguage "DoRec"),
+  ( "DoRec",                            Opt_DoRec, const Supported ),
   ( "Arrows",                           Opt_Arrows, const Supported ),
   ( "PArr",                             Opt_PArr, const Supported ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
@@ -1911,7 +1928,7 @@ glasgowExtsFlags = [
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_TypeOperators
-           , Opt_RecursiveDo
+           , Opt_DoRec
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures