[commit: ghc] master: Make -fhistory-size dynamic (892d862)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/892d862144d253bd84e04a3c02be1e4314b1cb46

>---------------------------------------------------------------

commit 892d862144d253bd84e04a3c02be1e4314b1cb46
Author: Ian Lynagh <[email protected]>
Date:   Mon Sep 3 22:22:34 2012 +0100

    Make -fhistory-size dynamic

>---------------------------------------------------------------

 compiler/main/DynFlags.hs         |    3 +++
 compiler/main/StaticFlagParser.hs |    1 -
 compiler/main/StaticFlags.hs      |    4 ----
 compiler/simplCore/CoreMonad.lhs  |   12 +++++++-----
 compiler/simplCore/SimplMonad.lhs |    6 +++---
 docs/users_guide/flags.xml        |    2 +-
 6 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b5d17ca..3451dfd 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -523,6 +523,7 @@ data DynFlags = DynFlags {
   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
   floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating
                                         --   See CoreMonad.FloatOutSwitches
+  historySize           :: Int,
 
   cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
   importPaths           :: [FilePath],
@@ -1104,6 +1105,7 @@ defaultDynFlags mySettings =
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 2000,
         floatLamArgs            = Just 0, -- Default: float only if no fvs
+        historySize             = 20,
         strictnessBefore        = [],
 
         cmdlineHcIncludes       = [],
@@ -2041,6 +2043,7 @@ dynamic_flags = [
   , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
   , Flag "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
   , Flag "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
+  , Flag "fhistory-size"               (intSuffix (\n d -> d{ historySize = n }))
 
         ------ Profiling ----------------------------------------------------
 
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 05a4639..dbf321d 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -142,7 +142,6 @@ isStaticFlag f =
   || any (`isPrefixOf` f) [
     "fliberate-case-threshold",
     "fmax-worker-args",
-    "fhistory-size",
     "funfolding-creation-threshold",
     "funfolding-dict-threshold",
     "funfolding-use-threshold",
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index fac89cf..6b01a95 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -65,7 +65,6 @@ module StaticFlags (
 
 	-- misc opts
 	opt_ErrorSpans,
-	opt_HistorySize,
 
     -- For the parser
     addOpt, removeOpt, v_opt_C_ready,
@@ -246,9 +245,6 @@ opt_CprOff			= lookUp  (fsLit "-fcpr-off")
 opt_MaxWorkerArgs :: Int
 opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)
 
-opt_HistorySize :: Int
-opt_HistorySize			= lookup_def_int "-fhistory-size" 20
-
 -- Simplifier switches
 opt_SimplNoPreInlining :: Bool
 opt_SimplNoPreInlining		= lookUp  (fsLit "-fno-pre-inlining")
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 5c97fbd..9af48b4 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -480,7 +480,8 @@ zeroSimplCount	   :: DynFlags -> SimplCount
 isZeroSimplCount   :: SimplCount -> Bool
 hasDetailedCounts  :: SimplCount -> Bool
 pprSimplCount	   :: SimplCount -> SDoc
-doSimplTick, doFreeSimplTick :: Tick -> SimplCount -> SimplCount
+doSimplTick        :: DynFlags -> Tick -> SimplCount -> SimplCount
+doFreeSimplTick    ::             Tick -> SimplCount -> SimplCount
 plusSimplCount     :: SimplCount -> SimplCount -> SimplCount
 \end{code}
 
@@ -525,13 +526,14 @@ doFreeSimplTick tick sc@SimplCount { details = dts }
   = sc { details = dts `addTick` tick }
 doFreeSimplTick _ sc = sc 
 
-doSimplTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1 }
-  | nl >= opt_HistorySize = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
-  | otherwise		  = sc1 { n_log = nl+1, log1 = tick : l1 }
+doSimplTick dflags tick
+    sc@(SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1 })
+  | nl >= historySize dflags = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
+  | otherwise                = sc1 { n_log = nl+1, log1 = tick : l1 }
   where
     sc1 = sc { ticks = tks+1, details = dts `addTick` tick }
 
-doSimplTick _ (VerySimplCount n) = VerySimplCount (n+1)
+doSimplTick _ _ (VerySimplCount n) = VerySimplCount (n+1)
 
 
 -- Don't use Map.unionWith because that's lazy, and we want to 
diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index 04b8c4e..9d98569 100644
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -182,15 +182,15 @@ getSimplCount :: SimplM SimplCount
 getSimplCount = SM (\_st_env us sc -> return (sc, us, sc))
 
 tick :: Tick -> SimplM ()
-tick t = SM (\_st_env us sc -> let sc' = doSimplTick t sc
-                               in sc' `seq` return ((), us, sc'))
+tick t = SM (\st_env us sc -> let sc' = doSimplTick (st_flags st_env) t sc
+                              in sc' `seq` return ((), us, sc'))
 
 checkedTick :: Tick -> SimplM ()
 -- Try to take a tick, but fail if too many
 checkedTick t 
   = SM (\st_env us sc -> if st_max_ticks st_env <= simplCountN sc
                          then pprPanic "Simplifier ticks exhausted" (msg sc)
-                         else let sc' = doSimplTick t sc 
+                         else let sc' = doSimplTick (st_flags st_env) t sc
                               in sc' `seq` return ((), us, sc'))
   where
     msg sc = vcat [ ptext (sLit "When trying") <+> ppr t
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 7cbeeab..00c9b44 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2864,7 +2864,7 @@
           <row>
             <entry><option>-fhistory-size</option></entry>
             <entry>Set simplification history size</entry>
-            <entry>static</entry>
+            <entry>dynamic</entry>
             <entry>-</entry>
           </row>
           <row>