Commit 892d8621 authored by ian@well-typed.com's avatar ian@well-typed.com

Make -fhistory-size dynamic

parent 3d3fef8c
......@@ -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 ----------------------------------------------------
......
......@@ -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",
......
......@@ -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")
......
......@@ -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
......
......@@ -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
......
......@@ -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>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment