Commit b8abb31f authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix Trac #5475: another bug in exprArity

As usual it was to do with the handling of bottoms,
but this time it wasn't terribly subtle; I was using
andArityType (which is designed for case branches) as
a cheap short cut for the arity trimming needed with
a cast.  That did the Wrong Thing for bottoming
expressions.  Sigh.
parent f647fd53
...@@ -139,18 +139,18 @@ Note [exprArity invariant] ...@@ -139,18 +139,18 @@ Note [exprArity invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~
exprArity has the following invariant: exprArity has the following invariant:
* If typeArity (exprType e) = n, (1) If typeArity (exprType e) = n,
then manifestArity (etaExpand e n) = n then manifestArity (etaExpand e n) = n
That is, etaExpand can always expand as much as typeArity says That is, etaExpand can always expand as much as typeArity says
So the case analysis in etaExpand and in typeArity must match So the case analysis in etaExpand and in typeArity must match
* exprArity e <= typeArity (exprType e) (2) exprArity e <= typeArity (exprType e)
* Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n (3) Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n
That is, if exprArity says "the arity is n" then etaExpand really That is, if exprArity says "the arity is n" then etaExpand really
can get "n" manifest lambdas to the top. can get "n" manifest lambdas to the top.
Why is this important? Because Why is this important? Because
- In TidyPgm we use exprArity to fix the *final arity* of - In TidyPgm we use exprArity to fix the *final arity* of
...@@ -561,12 +561,17 @@ type CheapFun = CoreExpr -> Maybe Type -> Bool ...@@ -561,12 +561,17 @@ type CheapFun = CoreExpr -> Maybe Type -> Bool
arityType :: CheapFun -> CoreExpr -> ArityType arityType :: CheapFun -> CoreExpr -> ArityType
arityType cheap_fn (Cast e co) arityType cheap_fn (Cast e co)
= arityType cheap_fn e = case arityType cheap_fn e of
`andArityType` ATop (typeArity (pSnd (coercionKind co))) ATop os -> ATop (take co_arity os)
-- See Note [exprArity invariant]; must be true of ABot n -> ABot (n `min` co_arity)
where
co_arity = length (typeArity (pSnd (coercionKind co)))
-- See Note [exprArity invariant] (2); must be true of
-- arityType too, since that is how we compute the arity -- arityType too, since that is how we compute the arity
-- of variables, and they in turn affect result of exprArity -- of variables, and they in turn affect result of exprArity
-- Trac #5441 is a nice demo -- Trac #5441 is a nice demo
-- However, do make sure that ATop -> ATop and ABot -> ABot!
-- Casts don't affect that part. Getting this wrong provoked #5475
arityType _ (Var v) arityType _ (Var v)
| Just strict_sig <- idStrictness_maybe v | Just strict_sig <- idStrictness_maybe v
......
...@@ -1181,7 +1181,7 @@ findArity dicts_cheap bndr rhs old_arity ...@@ -1181,7 +1181,7 @@ findArity dicts_cheap bndr rhs old_arity
init_cheap_app :: CheapAppFun init_cheap_app :: CheapAppFun
init_cheap_app fn n_val_args init_cheap_app fn n_val_args
| fn == bndr = True | fn == bndr = True -- On the first pass, this binder gets infinite arity
| otherwise = isCheapApp fn n_val_args | otherwise = isCheapApp fn n_val_args
mk_cheap_fn :: Bool -> CheapAppFun -> CheapFun mk_cheap_fn :: Bool -> CheapAppFun -> CheapFun
......
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