Commit 7f919dec authored by Joachim Breitner's avatar Joachim Breitner
Browse files

Call Arity: Resurrect fakeBoringCalls

(Otherwise the analysis was wrong, as covered by the new test case.)
parent d793a148
...@@ -348,7 +348,8 @@ callArityTopLvl exported int1 (b:bs) ...@@ -348,7 +348,8 @@ callArityTopLvl exported int1 (b:bs)
exported' = filter isExportedId int2 ++ exported exported' = filter isExportedId int2 ++ exported
int' = int1 `addInterestingBinds` b int' = int1 `addInterestingBinds` b
(ae1, bs') = callArityTopLvl exported' int' bs (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 callArityRHS :: CoreExpr -> CoreExpr
...@@ -434,7 +435,8 @@ callArityAnal arity int (Let bind e) ...@@ -434,7 +435,8 @@ callArityAnal arity int (Let bind e)
where where
int_body = int `addInterestingBinds` bind int_body = int `addInterestingBinds` bind
(ae_body, e') = callArityAnal arity int_body e (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 -- This is a variant of callArityAnal that is additionally told whether
-- the expression is called once or multiple times, and treats thunks appropriately. -- the expression is called once or multiple times, and treats thunks appropriately.
...@@ -468,6 +470,16 @@ addInterestingBinds int bind ...@@ -468,6 +470,16 @@ addInterestingBinds int bind
= int `delVarSetList` bindersOf bind -- Possible shadowing = int `delVarSetList` bindersOf bind -- Possible shadowing
`extendVarSetList` interestingBinds bind `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 -- Used for both local and top-level binds
-- First argument is the demand from the body -- First argument is the demand from the body
callArityBind :: CallArityRes -> VarSet -> CoreBind -> (CallArityRes, CoreBind) callArityBind :: CallArityRes -> VarSet -> CoreBind -> (CallArityRes, CoreBind)
......
...@@ -163,6 +163,10 @@ exprs = ...@@ -163,6 +163,10 @@ exprs =
, (n, Var go `mkApps` [d `mkLApps` [1]]) , (n, Var go `mkApps` [d `mkLApps` [1]])
, (go, mkLams [x] $ mkACase (Var n) (Var go `mkApps` [Var n `mkVarApps` [x]]) ) ]) $ , (go, mkLams [x] $ mkACase (Var n) (Var go `mkApps` [Var n `mkVarApps` [x]]) ) ]) $
Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]] 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 main = do
......
...@@ -78,3 +78,6 @@ a thunk (function type), in mutual recursion, still calls once, d part of mutual ...@@ -78,3 +78,6 @@ a thunk (function type), in mutual recursion, still calls once, d part of mutual
go 1 go 1
d 1 d 1
n 0 n 0
a thunk (non-function-type) co-calls with the body (d 1 would be bad):
x 0
d 0
...@@ -133,7 +133,7 @@ test('T3294', ...@@ -133,7 +133,7 @@ test('T3294',
# 2012-10-08: 1373514844 (x86/Linux) # 2012-10-08: 1373514844 (x86/Linux)
# 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2013-11-13: 1478325844 (x86/Windows, 64bit machine)
# 2014-01-12: 1565185140 (x86/Linux) # 2014-01-12: 1565185140 (x86/Linux)
(wordsize(64), 2897630040, 5)]), (wordsize(64), 2705289664, 5)]),
# old: 1357587088 (amd64/Linux) # old: 1357587088 (amd64/Linux)
# 29/08/2012: 2961778696 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux)
# (^ increase due to new codegen, see #7198) # (^ increase due to new codegen, see #7198)
...@@ -141,6 +141,7 @@ test('T3294', ...@@ -141,6 +141,7 @@ test('T3294',
# 08/06/2013: 2901451552 (amd64/Linux) (reason unknown) # 08/06/2013: 2901451552 (amd64/Linux) (reason unknown)
# 12/12/2013: 3083825616 (amd64/Linux) (reason unknown) # 12/12/2013: 3083825616 (amd64/Linux) (reason unknown)
# 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements) # 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements)
# 12/03/2014: 2705289664 (amd64/Linux) (more call arity improvements)
conf_3294 conf_3294
], ],
compile, compile,
......
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