A bottoming function should have infinite arity

I can't think how this one escaped for so long, but
	(error "foo")
should have arityType ABot, just as 'error' itself does.

This improves eta expansion.  I spotted it when looking at the function

  Data.Array.Parallel.Arr.BBArr.writeMBB

in the ndp package.

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index fcd5999..80885de 100644 (file)
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -1019,9 +1019,13 @@ arityType dflags (Lam x e)
 
        -- Applications; decrease arity
 arityType dflags (App f (Type _)) = arityType dflags f
-arityType dflags (App f a)       = case arityType dflags f of
-                                       AFun one_shot xs | exprIsCheap a -> xs
-                                       other                            -> ATop
+arityType dflags (App f a)
+   = case arityType dflags f of
+       ABot -> ABot    -- If function diverges, ignore argument
+       ATop -> ATop    -- No no info about function
+       AFun one_shot xs 
+               | exprIsCheap a -> xs
+               | otherwise     -> ATop
                                                           
        -- Case/Let; keep arity if either the expression is cheap
        -- or it's a 1-shot lambda