Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
8da6a162
Commit
8da6a162
authored
Feb 12, 2016
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Revert "sizeExpr: fix a bug in the size calculation"
This reverts commit
51a33924
.
parent
b7dfbb45
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
3 additions
and
15 deletions
+3
-15
compiler/coreSyn/CoreUnfold.hs
compiler/coreSyn/CoreUnfold.hs
+3
-15
No files found.
compiler/coreSyn/CoreUnfold.hs
View file @
8da6a162
...
@@ -578,18 +578,13 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
...
@@ -578,18 +578,13 @@ 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
(
Cast
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
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
(
callSize
(
length
val_args
)
voids
)
FCallId
_
->
sizeN
(
10
*
(
1
+
length
val_args
))
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
...
@@ -662,13 +657,6 @@ classOpSize dflags top_args (arg1 : other_args)
...
@@ -662,13 +657,6 @@ 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]
...
@@ -679,7 +667,7 @@ funSize dflags top_args fun n_val_args voids
...
@@ -679,7 +667,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
=
callSize
n_val_args
voids
size
|
some_val_args
=
10
*
(
1
+
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;
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment