Commit 51a33924 authored by Simon Marlow's avatar Simon Marlow

sizeExpr: fix a bug in the size calculation

There were two bugs here:

* We weren't ignoring Cast in size_up_app
* An application of a non-variable wasn't being charged correct

The result was that some things looked too cheap.  In my case I had
things like

    ((f x) `cast` ...) y

which was given size 21 instead of 30, and this had knock-on effects
elsewhere that caused some large code bloat.

Test Plan:
* nofib runs (todo)
* validate

Reviewers: simonpj, austin, bgamari, erikd

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1900

GHC Trac Issues: #11564
parent 023bf8d4
...@@ -578,13 +578,18 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr ...@@ -578,13 +578,18 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
size_up_app fun (arg:args) voids size_up_app fun (arg:args) voids
size_up_app (Var fun) args voids = size_up_call fun args voids size_up_app (Var fun) args voids = size_up_call fun args voids
size_up_app (Tick _ expr) args voids = size_up_app expr args voids size_up_app (Tick _ expr) args voids = size_up_app expr args voids
size_up_app other args voids = size_up other `addSizeN` (length args - voids) size_up_app (Cast expr _) args voids = size_up_app expr args voids
size_up_app other args voids = size_up other `addSizeN`
callSize (length args) voids
-- if the lhs is not an App or a Var, or an invisible thing like a
-- Tick or Cast, then we should charge for a complete call plus the
-- size of the lhs itself.
------------ ------------
size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
size_up_call fun val_args voids size_up_call fun val_args voids
= case idDetails fun of = case idDetails fun of
FCallId _ -> sizeN (10 * (1 + length val_args)) FCallId _ -> sizeN (callSize (length val_args) voids)
DataConWorkId dc -> conSize dc (length val_args) DataConWorkId dc -> conSize dc (length val_args)
PrimOpId op -> primOpSize op (length val_args) PrimOpId op -> primOpSize op (length val_args)
ClassOpId _ -> classOpSize dflags top_args val_args ClassOpId _ -> classOpSize dflags top_args val_args
...@@ -657,6 +662,13 @@ classOpSize dflags top_args (arg1 : other_args) ...@@ -657,6 +662,13 @@ classOpSize dflags top_args (arg1 : other_args)
-> unitBag (dict, ufDictDiscount dflags) -> unitBag (dict, ufDictDiscount dflags)
_other -> emptyBag _other -> emptyBag
-- | The size of a function call
callSize
:: Int -- ^ number of value args
-> Int -- ^ number of value args that are void
-> Int
callSize n_val_args voids = 10 * (1 + n_val_args - voids)
funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize
-- Size for functions that are not constructors or primops -- Size for functions that are not constructors or primops
-- Note [Function applications] -- Note [Function applications]
...@@ -667,7 +679,7 @@ funSize dflags top_args fun n_val_args voids ...@@ -667,7 +679,7 @@ funSize dflags top_args fun n_val_args voids
where where
some_val_args = n_val_args > 0 some_val_args = n_val_args > 0
size | some_val_args = 10 * (1 + n_val_args - voids) size | some_val_args = callSize n_val_args voids
| otherwise = 0 | otherwise = 0
-- The 1+ is for the function itself -- The 1+ is for the function itself
-- Add 1 for each non-trivial arg; -- Add 1 for each non-trivial arg;
......
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