diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-12-11 18:20:21 +0000 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2013-12-12 11:26:58 +0000 |
| commit | b24e0c4b3f19f87b80b7e23f722bef63018dc7f6 (patch) | |
| tree | 4f6706827805c6dd63c1a41da9ef86a93c9e70a3 | |
| parent | 80989de947dc7edb55999456d1c1e8c337efc951 (diff) | |
| download | haskell-wip/exprArity.tar.gz | |
Return exprArity, not manifestAritywip/exprArity
This patch was authored by SPJ, and extracted from "Improve the handling
of used-once stuff" by Joachim.
| -rw-r--r-- | compiler/simplCore/SimplUtils.lhs | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 6c7dcc2042..36f292deb3 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -1195,8 +1195,11 @@ tryEtaExpandRhs env bndr rhs = do { dflags <- getDynFlags ; (new_arity, new_rhs) <- try_expand dflags - ; WARN( new_arity < old_arity || new_arity < _dmd_arity, - (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_arity + ; WARN( new_arity < old_arity, + (ptext (sLit "Arity decrease:") <+> (ppr bndr + <+> ppr old_arity <+> ppr new_arity) $$ ppr new_rhs) ) + WARN( new_arity < _dmd_arity, + (ptext (sLit "Arity less than dmd sig arity:") <+> (ppr bndr <+> ppr new_arity <+> ppr _dmd_arity) $$ ppr new_rhs) ) -- Note [Arity decrease] return (new_arity, new_rhs) } @@ -1211,13 +1214,23 @@ tryEtaExpandRhs env bndr rhs = do { tick (EtaExpansion bndr) ; return (new_arity, etaExpand new_arity rhs) } | otherwise - = return (manifest_arity, rhs) + = return (exprArity rhs, rhs) -- See Note [Return exprArity, not manifestArity] manifest_arity = manifestArity rhs old_arity = idArity bndr _dmd_arity = length $ fst $ splitStrictSig $ idStrictness bndr \end{code} +Note [Return exprArity, not manifestArity] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f = \xy. blah + g = f 2 +The f will get arity 2, and we want g to get arity 1, even though +exprEtaExpandArity (and hence findArity) may not eta-expand it. +Hence tryEtaExpand should return (exprArity (f 2)), not its +manifest arity (which is zero). + Note [Eta-expanding at let bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We now eta expand at let-bindings, which is where the payoff comes. |