[commit: ghc] master: Call Arity: Resurrect fakeBoringCalls (7f919de)
Simon Peyton Jones
simonpj at microsoft.com
Wed Mar 12 13:40:01 UTC 2014
Could we please have a Note to explain what is going on here? It clearly isn't obvious, or it would have been right the first time!
Everyone: practically *whenever* you fix a bug, please add a Note. By definition something subtle is happening.
Thanks
Simon
| -----Original Message-----
| From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of
| git at git.haskell.org
| Sent: 12 March 2014 12:23
| To: ghc-commits at haskell.org
| Subject: [commit: ghc] master: Call Arity: Resurrect fakeBoringCalls
| (7f919de)
|
| Repository : ssh://git@git.haskell.org/ghc
|
| On branch : master
| Link :
| http://ghc.haskell.org/trac/ghc/changeset/7f919dec1579641bbcd02978a0038c8
| a3723d8b7/ghc
|
| >---------------------------------------------------------------
|
| commit 7f919dec1579641bbcd02978a0038c8a3723d8b7
| Author: Joachim Breitner <mail at joachim-breitner.de>
| Date: Wed Mar 12 11:15:16 2014 +0100
|
| Call Arity: Resurrect fakeBoringCalls
|
| (Otherwise the analysis was wrong, as covered by the new test case.)
|
|
| >---------------------------------------------------------------
|
| 7f919dec1579641bbcd02978a0038c8a3723d8b7
| compiler/simplCore/CallArity.hs | 16
| ++++++++++++++--
| testsuite/tests/callarity/unittest/CallArity1.hs | 4 ++++
| testsuite/tests/callarity/unittest/CallArity1.stderr | 3 +++
| testsuite/tests/perf/compiler/all.T | 3 ++-
| 4 files changed, 23 insertions(+), 3 deletions(-)
|
| diff --git a/compiler/simplCore/CallArity.hs
| b/compiler/simplCore/CallArity.hs
| index 6334d8d..db0406d 100644
| --- a/compiler/simplCore/CallArity.hs
| +++ b/compiler/simplCore/CallArity.hs
| @@ -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)
| diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs
| b/testsuite/tests/callarity/unittest/CallArity1.hs
| index 8a142d5..6dd6182 100644
| --- a/testsuite/tests/callarity/unittest/CallArity1.hs
| +++ b/testsuite/tests/callarity/unittest/CallArity1.hs
| @@ -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
| diff --git a/testsuite/tests/callarity/unittest/CallArity1.stderr
| b/testsuite/tests/callarity/unittest/CallArity1.stderr
| index d5d7d91..c331a64 100644
| --- a/testsuite/tests/callarity/unittest/CallArity1.stderr
| +++ b/testsuite/tests/callarity/unittest/CallArity1.stderr
| @@ -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
| diff --git a/testsuite/tests/perf/compiler/all.T
| b/testsuite/tests/perf/compiler/all.T
| index fc0abc9..b03a48f 100644
| --- a/testsuite/tests/perf/compiler/all.T
| +++ b/testsuite/tests/perf/compiler/all.T
| @@ -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), 2897630040, 5)]),
| + (wordsize(64), 2705289664, 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,
|
| _______________________________________________
| ghc-commits mailing list
| ghc-commits at haskell.org
| http://www.haskell.org/mailman/listinfo/ghc-commits
More information about the ghc-devs
mailing list