summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--compiler/main/StaticFlagParser.hs1
-rw-r--r--compiler/main/StaticFlags.hs15
-rw-r--r--compiler/stranal/DmdAnal.lhs154
-rw-r--r--docs/users_guide/flags.xml2
5 files changed, 91 insertions, 87 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index dfbc9da287..881d263e90 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -672,6 +672,8 @@ data DynFlags = DynFlags {
ufKeenessFactor :: Float,
ufDearOp :: Int,
+ maxWorkerArgs :: Int,
+
-- | MsgDoc output action: use "ErrUtils" instead of this if you can
log_action :: LogAction,
flushOut :: FlushOut,
@@ -1214,6 +1216,8 @@ defaultDynFlags mySettings =
ufKeenessFactor = 1.5,
ufDearOp = 40,
+ maxWorkerArgs = 10,
+
log_action = defaultLogAction,
flushOut = defaultFlushOut,
flushErr = defaultFlushErr,
@@ -2083,6 +2087,8 @@ dynamic_flags = [
, Flag "funfolding-dict-discount" (intSuffix (\n d -> d {ufDictDiscount = n}))
, Flag "funfolding-keeness-factor" (floatSuffix (\n d -> d {ufKeenessFactor = n}))
+ , Flag "fmax-worker-args" (intSuffix (\n d -> d {maxWorkerArgs = n}))
+
------ Profiling ----------------------------------------------------
-- OLD profiling flags
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index cbdeb60d90..465f0d619e 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -129,7 +129,6 @@ isStaticFlag f =
"fcpr-off"
]
|| any (`isPrefixOf` f) [
- "fmax-worker-args"
]
-----------------------------------------------------------------------------
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index e7dbdb02c2..913241e692 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -39,7 +39,6 @@ module StaticFlags (
opt_SimplNoPreInlining,
opt_SimplExcessPrecision,
opt_NoOptCoercion,
- opt_MaxWorkerArgs,
opt_NoFlatCache,
-- For the parser
@@ -55,13 +54,13 @@ import {-# SOURCE #-} DynFlags (DynFlags)
import FastString
import Util
-import Maybes ( firstJusts )
+-- import Maybes ( firstJusts )
import Panic
import Control.Monad
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
-import Data.List
+-- import Data.List
--------------------------------------------------------------------------
-- Do not use unsafeGlobalDynFlags!
@@ -95,8 +94,6 @@ removeOpt f = do
writeIORef v_opt_C $! filter (/= f) fs
lookUp :: FastString -> Bool
-lookup_def_int :: String -> Int -> Int
-lookup_str :: String -> Maybe String
-- holds the static opts while they're being collected, before
-- being unsafely read by unpacked_static_opts below.
@@ -115,24 +112,25 @@ packed_static_opts = map mkFastString staticFlags
lookUp sw = sw `elem` packed_static_opts
+{-
-- (lookup_str "foo") looks for the flag -foo=X or -fooX,
-- and returns the string X
+lookup_str :: String -> Maybe String
lookup_str sw
= case firstJusts (map (stripPrefix sw) staticFlags) of
Just ('=' : str) -> Just str
Just str -> Just str
Nothing -> Nothing
+lookup_def_int :: String -> Int -> Int
lookup_def_int sw def = case (lookup_str sw) of
Nothing -> def -- Use default
Just xx -> try_read sw xx
-{-
lookup_def_float :: String -> Float -> Float
lookup_def_float sw def = case (lookup_str sw) of
Nothing -> def -- Use default
Just xx -> try_read sw xx
--}
try_read :: Read a => String -> String -> a
-- (try_read sw str) tries to read s; if it fails, it
@@ -143,6 +141,7 @@ try_read sw str
[] -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
-- ToDo: hack alert. We should really parse the arguments
-- and announce errors in a more civilised way.
+-}
{-
@@ -182,8 +181,6 @@ opt_NoStateHack = lookUp (fsLit "-fno-state-hack")
opt_CprOff :: Bool
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)
-- Simplifier switches
opt_SimplNoPreInlining :: Bool
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index ddeb1aa864..a8ee825e40 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -20,8 +20,7 @@ module DmdAnal ( dmdAnalPgm, dmdAnalTopRhs,
#include "HsVersions.h"
-import DynFlags ( DynFlags )
-import StaticFlags ( opt_MaxWorkerArgs )
+import DynFlags
import Demand -- All of it
import CoreSyn
import PprCore
@@ -70,47 +69,48 @@ To think about
\begin{code}
dmdAnalPgm :: DynFlags -> CoreProgram -> IO CoreProgram
-dmdAnalPgm _ binds
+dmdAnalPgm dflags binds
= do {
let { binds_plus_dmds = do_prog binds } ;
return binds_plus_dmds
}
where
do_prog :: CoreProgram -> CoreProgram
- do_prog binds = snd $ mapAccumL dmdAnalTopBind emptySigEnv binds
+ do_prog binds = snd $ mapAccumL (dmdAnalTopBind dflags) emptySigEnv binds
-dmdAnalTopBind :: SigEnv
+dmdAnalTopBind :: DynFlags
+ -> SigEnv
-> CoreBind
-> (SigEnv, CoreBind)
-dmdAnalTopBind sigs (NonRec id rhs)
+dmdAnalTopBind dflags sigs (NonRec id rhs)
= (sigs2, NonRec id2 rhs2)
where
- ( _, _, (_, rhs1)) = dmdAnalRhs TopLevel NonRecursive (virgin sigs) (id, rhs)
- (sigs2, _, (id2, rhs2)) = dmdAnalRhs TopLevel NonRecursive (nonVirgin sigs) (id, rhs1)
+ ( _, _, (_, rhs1)) = dmdAnalRhs dflags TopLevel NonRecursive (virgin sigs) (id, rhs)
+ (sigs2, _, (id2, rhs2)) = dmdAnalRhs dflags TopLevel NonRecursive (nonVirgin sigs) (id, rhs1)
-- Do two passes to improve CPR information
-- See comments with ignore_cpr_info in mk_sig_ty
-- and with extendSigsWithLam
-dmdAnalTopBind sigs (Rec pairs)
+dmdAnalTopBind dflags sigs (Rec pairs)
= (sigs', Rec pairs')
where
- (sigs', _, pairs') = dmdFix TopLevel (virgin sigs) pairs
+ (sigs', _, pairs') = dmdFix dflags TopLevel (virgin sigs) pairs
-- We get two iterations automatically
-- c.f. the NonRec case above
\end{code}
\begin{code}
-dmdAnalTopRhs :: CoreExpr -> (StrictSig, CoreExpr)
+dmdAnalTopRhs :: DynFlags -> CoreExpr -> (StrictSig, CoreExpr)
-- Analyse the RHS and return
-- a) appropriate strictness info
-- b) the unfolding (decorated with strictness info)
-dmdAnalTopRhs rhs
+dmdAnalTopRhs dflags rhs
= (sig, rhs2)
where
call_dmd = vanillaCall (exprArity rhs)
- (_, rhs1) = dmdAnal (virgin emptySigEnv) call_dmd rhs
- (rhs_ty, rhs2) = dmdAnal (nonVirgin emptySigEnv) call_dmd rhs1
- sig = mkTopSigTy rhs rhs_ty
+ (_, rhs1) = dmdAnal dflags (virgin emptySigEnv) call_dmd rhs
+ (rhs_ty, rhs2) = dmdAnal dflags (nonVirgin emptySigEnv) call_dmd rhs1
+ sig = mkTopSigTy dflags rhs rhs_ty
-- Do two passes; see notes with extendSigsWithLam
-- Otherwise we get bogus CPR info for constructors like
-- newtype T a = MkT a
@@ -126,14 +126,14 @@ dmdAnalTopRhs rhs
%************************************************************************
\begin{code}
-dmdAnal :: AnalEnv -> Demand -> CoreExpr -> (DmdType, CoreExpr)
+dmdAnal :: DynFlags -> AnalEnv -> Demand -> CoreExpr -> (DmdType, CoreExpr)
-dmdAnal _ Abs e = (topDmdType, e)
+dmdAnal _ _ Abs e = (topDmdType, e)
-dmdAnal env dmd e
+dmdAnal dflags env dmd e
| not (isStrictDmd dmd)
= let
- (res_ty, e') = dmdAnal env evalDmd e
+ (res_ty, e') = dmdAnal dflags env evalDmd e
in
(deferType res_ty, e')
-- It's important not to analyse e with a lazy demand because
@@ -151,17 +151,17 @@ dmdAnal env dmd e
-- evaluation of f in a C(L) demand!
-dmdAnal _ _ (Lit lit) = (topDmdType, Lit lit)
-dmdAnal _ _ (Type ty) = (topDmdType, Type ty) -- Doesn't happen, in fact
-dmdAnal _ _ (Coercion co) = (topDmdType, Coercion co)
+dmdAnal _ _ _ (Lit lit) = (topDmdType, Lit lit)
+dmdAnal _ _ _ (Type ty) = (topDmdType, Type ty) -- Doesn't happen, in fact
+dmdAnal _ _ _ (Coercion co) = (topDmdType, Coercion co)
-dmdAnal env dmd (Var var)
+dmdAnal _ env dmd (Var var)
= (dmdTransform env var dmd, Var var)
-dmdAnal env dmd (Cast e co)
+dmdAnal dflags env dmd (Cast e co)
= (dmd_ty, Cast e' co)
where
- (dmd_ty, e') = dmdAnal env dmd' e
+ (dmd_ty, e') = dmdAnal dflags env dmd' e
to_co = pSnd (coercionKind co)
dmd'
| Just tc <- tyConAppTyCon_maybe to_co
@@ -173,60 +173,60 @@ dmdAnal env dmd (Cast e co)
-- inside recursive products -- we might not reach
-- a fixpoint. So revert to a vanilla Eval demand
-dmdAnal env dmd (Tick t e)
+dmdAnal dflags env dmd (Tick t e)
= (dmd_ty, Tick t e')
where
- (dmd_ty, e') = dmdAnal env dmd e
+ (dmd_ty, e') = dmdAnal dflags env dmd e
-dmdAnal env dmd (App fun (Type ty))
+dmdAnal dflags env dmd (App fun (Type ty))
= (fun_ty, App fun' (Type ty))
where
- (fun_ty, fun') = dmdAnal env dmd fun
+ (fun_ty, fun') = dmdAnal dflags env dmd fun
-dmdAnal sigs dmd (App fun (Coercion co))
+dmdAnal dflags sigs dmd (App fun (Coercion co))
= (fun_ty, App fun' (Coercion co))
where
- (fun_ty, fun') = dmdAnal sigs dmd fun
+ (fun_ty, fun') = dmdAnal dflags sigs dmd fun
-- Lots of the other code is there to make this
-- beautiful, compositional, application rule :-)
-dmdAnal env dmd (App fun arg) -- Non-type arguments
+dmdAnal dflags env dmd (App fun arg) -- Non-type arguments
= let -- [Type arg handled above]
- (fun_ty, fun') = dmdAnal env (Call dmd) fun
- (arg_ty, arg') = dmdAnal env arg_dmd arg
+ (fun_ty, fun') = dmdAnal dflags env (Call dmd) fun
+ (arg_ty, arg') = dmdAnal dflags env arg_dmd arg
(arg_dmd, res_ty) = splitDmdTy fun_ty
in
(res_ty `bothType` arg_ty, App fun' arg')
-dmdAnal env dmd (Lam var body)
+dmdAnal dflags env dmd (Lam var body)
| isTyVar var
= let
- (body_ty, body') = dmdAnal env dmd body
+ (body_ty, body') = dmdAnal dflags env dmd body
in
(body_ty, Lam var body')
| Call body_dmd <- dmd -- A call demand: good!
= let
env' = extendSigsWithLam env var
- (body_ty, body') = dmdAnal env' body_dmd body
- (lam_ty, var') = annotateLamIdBndr env body_ty var
+ (body_ty, body') = dmdAnal dflags env' body_dmd body
+ (lam_ty, var') = annotateLamIdBndr dflags env body_ty var
in
(lam_ty, Lam var' body')
| otherwise -- Not enough demand on the lambda; but do the body
= let -- anyway to annotate it and gather free var info
- (body_ty, body') = dmdAnal env evalDmd body
- (lam_ty, var') = annotateLamIdBndr env body_ty var
+ (body_ty, body') = dmdAnal dflags env evalDmd body
+ (lam_ty, var') = annotateLamIdBndr dflags env body_ty var
in
(deferType lam_ty, Lam var' body')
-dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
+dmdAnal dflags env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
| let tycon = dataConTyCon dc
, isProductTyCon tycon
, not (isRecursiveTyCon tycon)
= let
env_alt = extendAnalEnv NotTopLevel env case_bndr case_bndr_sig
- (alt_ty, alt') = dmdAnalAlt env_alt dmd alt
+ (alt_ty, alt') = dmdAnalAlt dflags env_alt dmd alt
(alt_ty1, case_bndr') = annotateBndr alt_ty case_bndr
(_, bndrs', _) = alt'
case_bndr_sig = cprSig
@@ -264,7 +264,7 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
scrut_dmd = alt_dmd `both`
idDemandInfo case_bndr'
- (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut
+ (scrut_ty, scrut') = dmdAnal dflags env scrut_dmd scrut
res_ty = alt_ty1 `bothType` scrut_ty
in
-- pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
@@ -273,10 +273,10 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
-- , text "res_ty" <+> ppr res_ty ]) $
(res_ty, Case scrut' case_bndr' ty [alt'])
-dmdAnal env dmd (Case scrut case_bndr ty alts)
+dmdAnal dflags env dmd (Case scrut case_bndr ty alts)
= let
- (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd) alts
- (scrut_ty, scrut') = dmdAnal env evalDmd scrut
+ (alt_tys, alts') = mapAndUnzip (dmdAnalAlt dflags env dmd) alts
+ (scrut_ty, scrut') = dmdAnal dflags env evalDmd scrut
(alt_ty, case_bndr') = annotateBndr (foldr lubType botDmdType alt_tys) case_bndr
res_ty = alt_ty `bothType` scrut_ty
in
@@ -286,10 +286,10 @@ dmdAnal env dmd (Case scrut case_bndr ty alts)
-- , text "res_ty" <+> ppr res_ty ]) $
(res_ty, Case scrut' case_bndr' ty alts')
-dmdAnal env dmd (Let (NonRec id rhs) body)
+dmdAnal dflags env dmd (Let (NonRec id rhs) body)
= let
- (sigs', lazy_fv, (id1, rhs')) = dmdAnalRhs NotTopLevel NonRecursive env (id, rhs)
- (body_ty, body') = dmdAnal (updSigEnv env sigs') dmd body
+ (sigs', lazy_fv, (id1, rhs')) = dmdAnalRhs dflags NotTopLevel NonRecursive env (id, rhs)
+ (body_ty, body') = dmdAnal dflags (updSigEnv env sigs') dmd body
(body_ty1, id2) = annotateBndr body_ty id1
body_ty2 = addLazyFVs body_ty1 lazy_fv
in
@@ -307,11 +307,11 @@ dmdAnal env dmd (Let (NonRec id rhs) body)
-- bother to re-analyse the RHS.
(body_ty2, Let (NonRec id2 rhs') body')
-dmdAnal env dmd (Let (Rec pairs) body)
+dmdAnal dflags env dmd (Let (Rec pairs) body)
= let
bndrs = map fst pairs
- (sigs', lazy_fv, pairs') = dmdFix NotTopLevel env pairs
- (body_ty, body') = dmdAnal (updSigEnv env sigs') dmd body
+ (sigs', lazy_fv, pairs') = dmdFix dflags NotTopLevel env pairs
+ (body_ty, body') = dmdAnal dflags (updSigEnv env sigs') dmd body
body_ty1 = addLazyFVs body_ty lazy_fv
in
sigs' `seq` body_ty `seq`
@@ -325,10 +325,10 @@ dmdAnal env dmd (Let (Rec pairs) body)
(body_ty2, Let (Rec pairs') body')
-dmdAnalAlt :: AnalEnv -> Demand -> Alt Var -> (DmdType, Alt Var)
-dmdAnalAlt env dmd (con,bndrs,rhs)
+dmdAnalAlt :: DynFlags -> AnalEnv -> Demand -> Alt Var -> (DmdType, Alt Var)
+dmdAnalAlt dflags env dmd (con,bndrs,rhs)
= let
- (rhs_ty, rhs') = dmdAnal env dmd rhs
+ (rhs_ty, rhs') = dmdAnal dflags env dmd rhs
rhs_ty' = addDataConPatDmds con bndrs rhs_ty
(alt_ty, bndrs') = annotateBndrs rhs_ty' bndrs
final_alt_ty | io_hack_reqd = alt_ty `lubType` topDmdType
@@ -488,13 +488,14 @@ dmdTransform env var dmd
%************************************************************************
\begin{code}
-dmdFix :: TopLevelFlag
+dmdFix :: DynFlags
+ -> TopLevelFlag
-> AnalEnv -- Does not include bindings for this binding
-> [(Id,CoreExpr)]
-> (SigEnv, DmdEnv,
[(Id,CoreExpr)]) -- Binders annotated with stricness info
-dmdFix top_lvl env orig_pairs
+dmdFix dflags top_lvl env orig_pairs
= loop 1 initial_env orig_pairs
where
bndrs = map fst orig_pairs
@@ -543,7 +544,7 @@ dmdFix top_lvl env orig_pairs
my_downRhs (sigs,lazy_fv) (id,rhs)
= ((sigs', lazy_fv'), pair')
where
- (sigs', lazy_fv1, pair') = dmdAnalRhs top_lvl Recursive (updSigEnv env sigs) (id,rhs)
+ (sigs', lazy_fv1, pair') = dmdAnalRhs dflags top_lvl Recursive (updSigEnv env sigs) (id,rhs)
lazy_fv' = plusVarEnv_C both lazy_fv lazy_fv1
same_sig sigs sigs' var = lookup sigs var == lookup sigs' var
@@ -551,22 +552,22 @@ dmdFix top_lvl env orig_pairs
Just (sig,_) -> sig
Nothing -> pprPanic "dmdFix" (ppr var)
-dmdAnalRhs :: TopLevelFlag -> RecFlag
+dmdAnalRhs :: DynFlags -> TopLevelFlag -> RecFlag
-> AnalEnv -> (Id, CoreExpr)
-> (SigEnv, DmdEnv, (Id, CoreExpr))
-- Process the RHS of the binding, add the strictness signature
-- to the Id, and augment the environment with the signature as well.
-dmdAnalRhs top_lvl rec_flag env (id, rhs)
+dmdAnalRhs dflags top_lvl rec_flag env (id, rhs)
= (sigs', lazy_fv, (id', rhs'))
where
arity = idArity id -- The idArity should be up to date
-- The simplifier was run just beforehand
- (rhs_dmd_ty, rhs') = dmdAnal env (vanillaCall arity) rhs
+ (rhs_dmd_ty, rhs') = dmdAnal dflags env (vanillaCall arity) rhs
(lazy_fv, sig_ty) = WARN( arity /= dmdTypeDepth rhs_dmd_ty && not (exprIsTrivial rhs), ppr id )
-- The RHS can be eta-reduced to just a variable,
-- in which case we should not complain.
- mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty
+ mkSigTy dflags top_lvl rec_flag id rhs rhs_dmd_ty
id' = id `setIdStrictness` sig_ty
sigs' = extendSigEnv top_lvl (sigEnv env) id sig_ty
\end{code}
@@ -579,14 +580,14 @@ dmdAnalRhs top_lvl rec_flag env (id, rhs)
%************************************************************************
\begin{code}
-mkTopSigTy :: CoreExpr -> DmdType -> StrictSig
+mkTopSigTy :: DynFlags -> CoreExpr -> DmdType -> StrictSig
-- Take a DmdType and turn it into a StrictSig
-- NB: not used for never-inline things; hence False
-mkTopSigTy rhs dmd_ty = snd (mk_sig_ty False False rhs dmd_ty)
+mkTopSigTy dflags rhs dmd_ty = snd (mk_sig_ty dflags False False rhs dmd_ty)
-mkSigTy :: TopLevelFlag -> RecFlag -> Id -> CoreExpr -> DmdType -> (DmdEnv, StrictSig)
-mkSigTy top_lvl rec_flag id rhs dmd_ty
- = mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty
+mkSigTy :: DynFlags -> TopLevelFlag -> RecFlag -> Id -> CoreExpr -> DmdType -> (DmdEnv, StrictSig)
+mkSigTy dflags top_lvl rec_flag id rhs dmd_ty
+ = mk_sig_ty dflags never_inline thunk_cpr_ok rhs dmd_ty
where
never_inline = isNeverActive (idInlineActivation id)
maybe_id_dmd = idDemandInfo_maybe id
@@ -727,9 +728,9 @@ in favour of error!
\begin{code}
-mk_sig_ty :: Bool -> Bool -> CoreExpr
+mk_sig_ty :: DynFlags -> Bool -> Bool -> CoreExpr
-> DmdType -> (DmdEnv, StrictSig)
-mk_sig_ty _never_inline thunk_cpr_ok rhs (DmdType fv dmds res)
+mk_sig_ty dflags _never_inline thunk_cpr_ok rhs (DmdType fv dmds res)
= (lazy_fv, mkStrictSig dmd_ty)
-- Re unused never_inline, see Note [NOINLINE and strictness]
where
@@ -767,7 +768,7 @@ mk_sig_ty _never_inline thunk_cpr_ok rhs (DmdType fv dmds res)
-- DmdType, because that makes fixpointing very slow --- the
-- DmdType gets full of lazy demands that are slow to converge.
- final_dmds = setUnpackStrategy dmds
+ final_dmds = setUnpackStrategy dflags dmds
-- Set the unpacking strategy
res' = case res of
@@ -781,9 +782,9 @@ or whether we'll just remember its strictness. If unpacking would give
rise to a *lot* of worker args, we may decide not to unpack after all.
\begin{code}
-setUnpackStrategy :: [Demand] -> [Demand]
-setUnpackStrategy ds
- = snd (go (opt_MaxWorkerArgs - nonAbsentArgs ds) ds)
+setUnpackStrategy :: DynFlags -> [Demand] -> [Demand]
+setUnpackStrategy dflags ds
+ = snd (go (maxWorkerArgs dflags - nonAbsentArgs ds) ds)
where
go :: Int -- Max number of args available for sub-components of [Demand]
-> [Demand]
@@ -870,13 +871,14 @@ annotateBndr dmd_ty@(DmdType fv ds res) var
annotateBndrs :: DmdType -> [Var] -> (DmdType, [Var])
annotateBndrs = mapAccumR annotateBndr
-annotateLamIdBndr :: AnalEnv
+annotateLamIdBndr :: DynFlags
+ -> AnalEnv
-> DmdType -- Demand type of body
-> Id -- Lambda binder
-> (DmdType, -- Demand type of lambda
Id) -- and binder annotated with demand
-annotateLamIdBndr env (DmdType fv ds res) id
+annotateLamIdBndr dflags env (DmdType fv ds res) id
-- For lambdas we add the demand to the argument demands
-- Only called for Ids
= ASSERT( isId id )
@@ -887,7 +889,7 @@ annotateLamIdBndr env (DmdType fv ds res) id
Nothing -> main_ty
Just unf -> main_ty `bothType` unf_ty
where
- (unf_ty, _) = dmdAnal env dmd unf
+ (unf_ty, _) = dmdAnal dflags env dmd unf
main_ty = DmdType fv' (hacked_dmd:ds) res
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 0714fa6c3d..f2d34e3016 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1613,7 +1613,7 @@
<entry><option>-fmax-worker-args</option></entry>
<entry>If a worker has that many arguments, none will be
unpacked anymore (default: 10)</entry>
- <entry>static</entry>
+ <entry>dynamic</entry>
<entry>-</entry>
</row>
View Lorry Controller Status