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-boun...@haskell.org] On Behalf Of | g...@git.haskell.org | Sent: 12 March 2014 12:23 | To: ghc-comm...@haskell.org | Subject: [commit: ghc] master: Call Arity: Resurrect fakeBoringCalls | (7f919de) | | Repository : ssh://g...@git.haskell.org/ghc | | On branch : master | Link : | http://ghc.haskell.org/trac/ghc/changeset/7f919dec1579641bbcd02978a0038c8 | a3723d8b7/ghc | | >--------------------------------------------------------------- | | commit 7f919dec1579641bbcd02978a0038c8a3723d8b7 | Author: Joachim Breitner <m...@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-comm...@haskell.org | http://www.haskell.org/mailman/listinfo/ghc-commits _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://www.haskell.org/mailman/listinfo/ghc-devs
