Commit 81de68e6 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Separate and optional size thresholds for SpecConstr and LiberateCase

This patch replaces -fspec-threshold by -fspec-constr-threshold and
-fliberate-case-threshold. The thresholds can be disabled by
-fno-spec-constr-threshold and -fno-liberate-case-threshold.
parent 6effb9e6
......@@ -301,7 +301,8 @@ data DynFlags = DynFlags {
maxSimplIterations :: Int, -- max simplifier iterations
ruleCheck :: Maybe String,
specThreshold :: Int, -- Threshold for function specialisation
specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr
liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase
stolen_x86_regs :: Int,
cmdlineHcIncludes :: [String], -- -#includes
......@@ -478,7 +479,8 @@ defaultDynFlags =
optLevel = 0,
maxSimplIterations = 4,
ruleCheck = Nothing,
specThreshold = 200,
specConstrThreshold = Just 200,
liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
importPaths = ["."],
......@@ -1140,9 +1142,14 @@ dynamic_flags = [
, ( "fmax-simplifier-iterations", IntSuffix (\n ->
upd (\dfs -> dfs{ maxSimplIterations = n })) )
-- liberate-case-threshold is an old flag for '-fspec-threshold'
, ( "fspec-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
, ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
, ( "fspec-constr-threshold", IntSuffix (\n ->
upd (\dfs -> dfs{ specConstrThreshold = Just n })))
, ( "fno-spec-constr-threshold", NoArg (
upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
, ( "fliberate-case-threshold", IntSuffix (\n ->
upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
, ( "fno-liberate-case-threshold", NoArg (
upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
, ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
, ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
......
......@@ -195,7 +195,8 @@ libCaseBind env (Rec pairs)
rhs_small_enough (id,rhs)
= idArity id > 0 -- Note [Only functions!]
&& couldBeSmallEnoughToInline (bombOutSize env) rhs
&& maybe True (\size -> couldBeSmallEnoughToInline size rhs)
(bombOutSize env)
\end{code}
......@@ -349,7 +350,7 @@ topLevel = 0
\begin{code}
data LibCaseEnv
= LibCaseEnv {
lc_size :: Int, -- Bomb-out size for deciding if
lc_size :: Maybe Int, -- Bomb-out size for deciding if
-- potential liberatees are too big.
-- (passed in from cmd-line args)
......@@ -377,7 +378,7 @@ data LibCaseEnv
initEnv :: DynFlags -> LibCaseEnv
initEnv dflags
= LibCaseEnv { lc_size = specThreshold dflags,
= LibCaseEnv { lc_size = liberateCaseThreshold dflags,
lc_lvl = 0,
lc_lvl_env = emptyVarEnv,
lc_rec_env = emptyVarEnv,
......
......@@ -456,9 +456,9 @@ specConstrProgram dflags us binds
%************************************************************************
\begin{code}
data ScEnv = SCE { sc_size :: Int, -- Size threshold
data ScEnv = SCE { sc_size :: Maybe Int, -- Size threshold
sc_subst :: Subst, -- Current substitution
sc_subst :: Subst, -- Current substitution
sc_how_bound :: HowBoundEnv,
-- Binds interesting non-top-level variables
......@@ -491,7 +491,7 @@ instance Outputable Value where
---------------------
initScEnv dflags
= SCE { sc_size = specThreshold dflags,
= SCE { sc_size = specConstrThreshold dflags,
sc_subst = emptySubst,
sc_how_bound = emptyVarEnv,
sc_vals = emptyVarEnv }
......@@ -824,7 +824,8 @@ scExpr' env e@(App _ _)
----------------------
scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
scBind env (Rec prs)
| not (all (couldBeSmallEnoughToInline (sc_size env)) rhss)
| Just threshold <- sc_size env
, not (all (couldBeSmallEnoughToInline threshold) rhss)
-- No specialisation
= do { let (rhs_env,bndrs') = extendRecBndrs env bndrs
; (rhs_usgs, rhss') <- mapAndUnzipUs (scExpr rhs_env) rhss
......
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