Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
7f919dec
Commit
7f919dec
authored
Mar 12, 2014
by
Joachim Breitner
Browse files
Call Arity: Resurrect fakeBoringCalls
(Otherwise the analysis was wrong, as covered by the new test case.)
parent
d793a148
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/simplCore/CallArity.hs
View file @
7f919dec
...
...
@@ -348,7 +348,8 @@ callArityTopLvl exported int1 (b:bs)
exported'
=
filter
isExportedId
int2
++
exported
int'
=
int1
`
addInterestingBinds
`
b
(
ae1
,
bs'
)
=
callArityTopLvl
exported'
int'
bs
(
ae2
,
b'
)
=
callArityBind
ae1
int1
b
ae1'
=
fakeBoringCalls
int'
b
ae1
(
ae2
,
b'
)
=
callArityBind
ae1'
int1
b
callArityRHS
::
CoreExpr
->
CoreExpr
...
...
@@ -434,7 +435,8 @@ callArityAnal arity int (Let bind e)
where
int_body
=
int
`
addInterestingBinds
`
bind
(
ae_body
,
e'
)
=
callArityAnal
arity
int_body
e
(
final_ae
,
bind'
)
=
callArityBind
ae_body
int
bind
ae_body'
=
fakeBoringCalls
int_body
bind
ae_body
(
final_ae
,
bind'
)
=
callArityBind
ae_body'
int
bind
-- This is a variant of callArityAnal that is additionally told whether
-- the expression is called once or multiple times, and treats thunks appropriately.
...
...
@@ -468,6 +470,16 @@ addInterestingBinds int bind
=
int
`
delVarSetList
`
bindersOf
bind
-- Possible shadowing
`
extendVarSetList
`
interestingBinds
bind
-- For every boring variable in the binder, this amends the CallArityRes to
-- report safe information about them (co-called with everything else, arity 0).
fakeBoringCalls
::
VarSet
->
CoreBind
->
CallArityRes
->
CallArityRes
fakeBoringCalls
int
bind
res
=
addCrossCoCalls
(
domRes
boring
)
(
domRes
res
)
$
(
boring
`
lubRes
`
res
)
where
boring
=
(
emptyUnVarGraph
,
mkVarEnv
[
(
v
,
0
)
|
v
<-
bindersOf
bind
,
not
(
v
`
elemVarSet
`
int
)])
-- Used for both local and top-level binds
-- First argument is the demand from the body
callArityBind
::
CallArityRes
->
VarSet
->
CoreBind
->
(
CallArityRes
,
CoreBind
)
...
...
testsuite/tests/callarity/unittest/CallArity1.hs
View file @
7f919dec
...
...
@@ -163,6 +163,10 @@ exprs =
,
(
n
,
Var
go
`
mkApps
`
[
d
`
mkLApps
`
[
1
]])
,
(
go
,
mkLams
[
x
]
$
mkACase
(
Var
n
)
(
Var
go
`
mkApps
`
[
Var
n
`
mkVarApps
`
[
x
]])
)
])
$
Var
go
`
mkApps
`
[
mkLit
0
,
go
`
mkLApps
`
[
0
,
1
]]
,
(
"a thunk (non-function-type) co-calls with the body (d 1 would be bad)"
,)
$
mkLet
d
(
f
`
mkLApps
`
[
0
])
$
mkLet
x
(
d
`
mkLApps
`
[
1
])
$
Var
d
`
mkVarApps
`
[
x
]
]
main
=
do
...
...
testsuite/tests/callarity/unittest/CallArity1.stderr
View file @
7f919dec
...
...
@@ -78,3 +78,6 @@ a thunk (function type), in mutual recursion, still calls once, d part of mutual
go 1
d 1
n 0
a thunk (non-function-type) co-calls with the body (d 1 would be bad):
x 0
d 0
testsuite/tests/perf/compiler/all.T
View file @
7f919dec
...
...
@@ -133,7 +133,7 @@ test('T3294',
# 2012-10-08: 1373514844 (x86/Linux)
# 2013-11-13: 1478325844 (x86/Windows, 64bit machine)
# 2014-01-12: 1565185140 (x86/Linux)
(
wordsize
(
64
),
2
897630040
,
5
)]),
(
wordsize
(
64
),
2
705289664
,
5
)]),
# old: 1357587088 (amd64/Linux)
# 29/08/2012: 2961778696 (amd64/Linux)
# (^ increase due to new codegen, see #7198)
...
...
@@ -141,6 +141,7 @@ test('T3294',
# 08/06/2013: 2901451552 (amd64/Linux) (reason unknown)
# 12/12/2013: 3083825616 (amd64/Linux) (reason unknown)
# 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements)
# 12/03/2014: 2705289664 (amd64/Linux) (more call arity improvements)
conf_3294
],
compile
,
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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