[commit: ghc] master: Revert "sizeExpr: fix a bug in the size calculation" (8da6a16)
git at git.haskell.org
git at git.haskell.org
Fri Feb 12 09:51:06 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8da6a162416d448309ced16b00f54a32b5ee750b/ghc
>---------------------------------------------------------------
commit 8da6a162416d448309ced16b00f54a32b5ee750b
Author: Simon Marlow <marlowsd at gmail.com>
Date: Fri Feb 12 09:52:21 2016 +0000
Revert "sizeExpr: fix a bug in the size calculation"
This reverts commit 51a33924fc118d9b6c1db556c75c0d010ef95e18.
>---------------------------------------------------------------
8da6a162416d448309ced16b00f54a32b5ee750b
compiler/coreSyn/CoreUnfold.hs | 18 +++---------------
1 file changed, 3 insertions(+), 15 deletions(-)
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index a03b427..48cdb5e 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -578,18 +578,13 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
size_up_app fun (arg: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 (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_app other args voids = size_up other `addSizeN` (length args - voids)
------------
size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
size_up_call fun val_args voids
= case idDetails fun of
- FCallId _ -> sizeN (callSize (length val_args) voids)
+ 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
@@ -662,13 +657,6 @@ classOpSize dflags top_args (arg1 : other_args)
-> unitBag (dict, ufDictDiscount dflags)
_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
-- Size for functions that are not constructors or primops
-- Note [Function applications]
@@ -679,7 +667,7 @@ funSize dflags top_args fun n_val_args voids
where
some_val_args = n_val_args > 0
- size | some_val_args = callSize n_val_args voids
+ 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;
More information about the ghc-commits
mailing list