[commit: ghc] new-demand: arity bug fixed (401f370)

[Ilya Sergey]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : new-demand

http://hackage.haskell.org/trac/ghc/changeset/401f370e366b1f84e92ee0b8541a73485b8cd58d

>---------------------------------------------------------------

commit 401f370e366b1f84e92ee0b8541a73485b8cd58d
Author: Ilya Sergey <Ilya.Sergey at cs.kuleuven.be>
Date:   Mon Aug 20 18:24:44 2012 +0100

    arity bug fixed

>---------------------------------------------------------------

 compiler/coreSyn/CoreArity.lhs |   13 +++++++------
 1 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs
index 5e8ea67..5e4a797 100644
--- a/compiler/coreSyn/CoreArity.lhs
+++ b/compiler/coreSyn/CoreArity.lhs
@@ -628,12 +628,13 @@ arityType env (Cast e co)
     --   Casts don't affect that part. Getting this wrong provoked #5475
 
 arityType _ (Var v)
-  -- | Just strict_sig <- idStrictness_maybe v
-  -- , (ds, res) <- splitStrictSig strict_sig
-  -- , let arity = length ds
-  -- = if isBotRes res then ABot arity
-  --                   else ATop (take arity one_shots)
-  -- | otherwise
+  | strict_sig <- nd_idStrictness v
+  , not $ ND.isTopSig strict_sig
+  , (ds, res) <- ND.splitStrictSig strict_sig
+  , let arity = length ds
+  = if ND.isBotRes res then ABot arity
+                    else ATop (take arity one_shots)
+  | otherwise
   = ATop (take (idArity v) one_shots)
   where
     one_shots :: [Bool]	    -- One-shot-ness derived from the type