Commit af12cf66 authored by nfrisby's avatar nfrisby

ignore RealWorld in size_expr; flag to keep w/w from creating sharing

size_expr now ignores RealWorld lambdas, arguments, and applications.

Worker-wrapper previously removed all lambdas from a function, if they
were all unused. Removing *all* value lambdas is no longer
allowed. Instead (\_ -> E) will become (\_void -> E), where it used to
become E. The previous behavior can be recovered via the new
-ffun-to-thunk flag.

Nofib notables:

----------------------------------------------------------------
        Program               O2          O2 newly ignoring RealWorld
                                          and not turning function
                                          closures into thunks
----------------------------------------------------------------

 Allocations

  comp_lab_zift            333090392%           -5.0%
reverse-complem            155188304%           -3.2%

        rewrite             15380888%           +4.0%
         boyer2              3901064%           +7.5%

rewrite previously benefited from fortunate LoopBreaker choice that is
now disrupted.

A function in boyer2 goes from $wonewayunify1 size 700 to size 650,
thus gets inlined into rewritelemmas, thus exposing a parameter
scrutinisation, thus allowing SpecConstr, which unfortunately involves
reboxing.

Run Time

 fannkuch-redux                 7.89%          -15.9%

            hpg                 0.25%           +5.6%
           wang                 0.21%           +5.8%

/shrug
parent 155d943c
......@@ -61,6 +61,7 @@ import IdInfo
import BasicTypes ( Arity )
import Type
import PrelNames
import TysPrim ( realWorldStatePrimTy )
import Bag
import Util
import FastTypes
......@@ -395,16 +396,19 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
size_up (Type _) = sizeZero -- Types cost nothing
size_up (Coercion _) = sizeZero
size_up (Lit lit) = sizeN (litSize lit)
size_up (Var f) = size_up_call f [] -- Make sure we get constructor
-- discounts even on nullary constructors
size_up (Var f) | isRealWorldId f = sizeZero
-- Make sure we get constructor discounts even
-- on nullary constructors
| otherwise = size_up_call f [] 0
size_up (App fun (Type _)) = size_up fun
size_up (App fun (Coercion _)) = size_up fun
size_up (App fun arg) = size_up arg `addSizeNSD`
size_up_app fun [arg]
size_up (App fun arg)
| isTyCoArg arg = size_up fun
| otherwise = size_up arg `addSizeNSD`
size_up_app fun [arg] (if isRealWorldExpr arg then 1 else 0)
size_up (Lam b e) | isId b = lamScrutDiscount dflags (size_up e `addSizeN` 10)
| otherwise = size_up e
size_up (Lam b e)
| isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up e `addSizeN` 10)
| otherwise = size_up e
size_up (Let (NonRec binder rhs) body)
= size_up rhs `addSizeNSD`
......@@ -480,22 +484,23 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
------------
-- size_up_app is used when there's ONE OR MORE value args
size_up_app (App fun arg) args
| isTyCoArg arg = size_up_app fun args
| otherwise = size_up arg `addSizeNSD`
size_up_app fun (arg:args)
size_up_app (Var fun) args = size_up_call fun args
size_up_app other args = size_up other `addSizeN` length args
size_up_app (App fun arg) args voids
| isTyCoArg arg = size_up_app fun args voids
| isRealWorldExpr arg = size_up_app fun (arg:args) (voids + 1)
| otherwise = size_up arg `addSizeNSD`
size_up_app fun (arg:args) voids
size_up_app (Var fun) args voids = size_up_call fun args voids
size_up_app other args voids = size_up other `addSizeN` (length args - voids)
------------
size_up_call :: Id -> [CoreExpr] -> ExprSize
size_up_call fun val_args
size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
size_up_call fun val_args voids
= case idDetails fun of
FCallId _ -> sizeN (10 * (1 + length val_args))
DataConWorkId dc -> conSize dc (length val_args)
PrimOpId op -> primOpSize op (length val_args)
ClassOpId _ -> classOpSize dflags top_args val_args
_ -> funSize dflags top_args fun (length val_args)
_ -> funSize dflags top_args fun (length val_args) voids
------------
size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10
......@@ -528,6 +533,12 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
= mkSizeIs bOMB_OUT_SIZE (n1 +# n2)
(xs `unionBags` ys)
d2 -- Ignore d1
isRealWorldId id = idType id `eqType` realWorldStatePrimTy
-- an expression of type State# RealWorld must be a variable
isRealWorldExpr (Var id) = isRealWorldId id
isRealWorldExpr _ = False
\end{code}
......@@ -560,17 +571,17 @@ classOpSize dflags top_args (arg1 : other_args)
-> unitBag (dict, ufDictDiscount dflags)
_other -> emptyBag
funSize :: DynFlags -> [Id] -> Id -> Int -> ExprSize
funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize
-- Size for functions that are not constructors or primops
-- Note [Function applications]
funSize dflags top_args fun n_val_args
funSize dflags top_args fun n_val_args voids
| fun `hasKey` buildIdKey = buildSize
| fun `hasKey` augmentIdKey = augmentSize
| otherwise = SizeIs (iUnbox size) arg_discount (iUnbox res_discount)
where
some_val_args = n_val_args > 0
size | some_val_args = 10 * (1 + n_val_args)
size | some_val_args = 10 * (1 + n_val_args - voids)
| otherwise = 0
-- The 1+ is for the function itself
-- Add 1 for each non-trivial arg;
......
......@@ -299,6 +299,7 @@ data GeneralFlag
| Opt_CmmElimCommonBlocks
| Opt_OmitYields
| Opt_SimpleListLiterals
| Opt_FunToThunk -- allow WwLib.mkWorkerArgs to remove all value lambdas
-- Interface files
| Opt_IgnoreInterfacePragmas
......@@ -2487,6 +2488,7 @@ fFlags = [
( "cmm-elim-common-blocks", Opt_CmmElimCommonBlocks, nop ),
( "omit-yields", Opt_OmitYields, nop ),
( "simple-list-literals", Opt_SimpleListLiterals, nop ),
( "fun-to-thunk", Opt_FunToThunk, nop ),
( "gen-manifest", Opt_GenManifest, nop ),
( "embed-manifest", Opt_EmbedManifest, nop ),
( "ext-core", Opt_EmitExternalCore, nop ),
......
......@@ -1409,7 +1409,7 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
`setIdArity` count isId spec_lam_args
spec_str = calcSpecStrictness fn spec_lam_args pats
-- Conditionally use result of new worker-wrapper transform
(spec_lam_args, spec_call_args) = mkWorkerArgs qvars False body_ty
(spec_lam_args, spec_call_args) = mkWorkerArgs (sc_dflags env) qvars False body_ty
-- Usual w/w hack to avoid generating
-- a spec_rhs of unlifted type and no args
......
......@@ -140,7 +140,7 @@ mkWwBodies dflags fun_ty demands res_info one_shots
-- Do CPR w/w. See Note [Always do CPR w/w]
; (wrap_fn_cpr, work_fn_cpr, cpr_res_ty) <- mkWWcpr res_ty res_info
; let (work_lam_args, work_call_args) = mkWorkerArgs work_args all_one_shots cpr_res_ty
; let (work_lam_args, work_call_args) = mkWorkerArgs dflags work_args all_one_shots cpr_res_ty
; return ([idDemandInfo v | v <- work_call_args, isId v],
wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args) }
......@@ -184,23 +184,39 @@ add a void argument. E.g.
We use the state-token type which generates no code.
\begin{code}
mkWorkerArgs :: [Var]
mkWorkerArgs :: DynFlags -> [Var]
-> Bool -- Whether all arguments are one-shot
-> Type -- Type of body
-> ([Var], -- Lambda bound args
[Var]) -- Args at call site
mkWorkerArgs args all_one_shot res_ty
| any isId args || not (isUnLiftedType res_ty)
mkWorkerArgs dflags args all_one_shot res_ty
| any isId args || not needsAValueLambda
= (args, args)
| otherwise
= (args ++ [newArg], args ++ [realWorldPrimId])
where
needsAValueLambda =
isUnLiftedType res_ty
|| not (gopt Opt_FunToThunk dflags)
-- see Note [Protecting the last value argument]
-- see Note [All One-Shot Arguments of a Worker]
newArg = if all_one_shot
then setOneShotLambda voidArgId
else voidArgId
\end{code}
Note [Protecting the last value argument]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the user writes (\_ -> E), they might be intentionally disallowing
the sharing of E. Since absence analysis and worker-wrapper are keen
to remove such unused arguments, we add in a void argument to prevent
the function from becoming a thunk.
The user can avoid that argument with the -ffun-to-thunk
flag. However, removing all the value argus may introduce space leaks.
Note [All One-Shot Arguments of a Worker]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -1550,6 +1550,17 @@
<entry><option>-fno-dicts-strict</option></entry>
</row>
<row>
<entry><option>-ffun-to-thunk</option></entry>
<entry>Worker-wrapper removes unused arguments; this flag
lets it thusly remove all value lambdas. Doing so creates
a thunk where it was previously a function closure, which
may save recomputation but also risks a space leak. Off by
default.</entry>
<entry>dynamic</entry>
<entry><option>-fno-fun-to-thunk</option></entry>
</row>
<row>
<entry><option>-fdo-eta-reduction</option></entry>
<entry>Enable eta-reduction. Implied by <option>-O</option>.</entry>
......
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