[project @ 2003-04-10 16:52:26 by simonpj]

Wibble to arity fix

diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs
index 212e914..7fe9b6e 100644 (file)
--- a/ghc/compiler/coreSyn/Subst.lhs
+++ b/ghc/compiler/coreSyn/Subst.lhs
@@ -56,6 +56,7 @@ import Id             ( idType, idInfo, setIdInfo, setIdType,
 import IdInfo          ( IdInfo, vanillaIdInfo,
                          occInfo, isFragileOcc, setOccInfo, 
                          specInfo, setSpecInfo, 
+                         setArityInfo, unknownArity,
                          unfoldingInfo, setUnfoldingInfo,
                          WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo,
                           lbvarInfo, LBVarInfo(..), setLBVarInfo, hasNoLBVarInfo
@@ -621,9 +622,13 @@ simplIdInfo :: Subst -> IdInfo -> IdInfo
   -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
   -- subsequent to simplLetId having zapped its IdInfo
 simplIdInfo subst old_info
-  = case substIdInfo subst isFragileOcc old_info of 
+  = case substIdInfo subst isFragileOcc zapped_old_info of 
        Just new_info -> new_info
        Nothing       -> old_info
+  where
+    zapped_old_info = old_info `setArityInfo` unknownArity
+       -- Like unfolding, arity gets set later
+       -- Maybe we should do this in substIdInfo?
 \end{code}
 
 \begin{code}

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 2cb43e4..7a75c05 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -305,17 +305,17 @@ simplNonRecBind env bndr rhs rhs_se cont_ty thing_inside
   | isStrictDmd (idNewDemandInfo bndr) || isStrictType (idType bndr)   -- A strict let
   =    -- Don't use simplBinder because that doesn't keep 
        -- fragile occurrence info in the substitution
-    simplLetBndr env bndr                                      `thenSmpl` \ (env, bndr') ->
+    simplLetBndr env bndr                                      `thenSmpl` \ (env, bndr1) ->
+    simplStrictArg AnRhs env rhs rhs_se (idType bndr1) cont_ty $ \ env1 rhs1 ->
+
+       -- Now complete the binding and simplify the body
     let
        -- simplLetBndr doesn't deal with the IdInfo, so we must
        -- do so here (c.f. simplLazyBind)
-       bndr''  = bndr' `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr)
-       env1    = modifyInScope env bndr'' bndr''
+       bndr2  = bndr1 `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr)
+       env2   = modifyInScope env1 bndr2 bndr2
     in
-    simplStrictArg AnRhs env1 rhs rhs_se (idType bndr') cont_ty        $ \ env rhs1 ->
-
-       -- Now complete the binding and simplify the body
-    completeNonRecX env True {- strict -} bndr bndr'' rhs1 thing_inside
+    completeNonRecX env2 True {- strict -} bndr bndr2 rhs1 thing_inside
 
   | otherwise                                                  -- Normal, lazy case
   =    -- Don't use simplBinder because that doesn't keep 
@@ -473,8 +473,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
        -- which isn't sound.  And it makes the arity in f's IdInfo greater than
        -- the manifest arity, which isn't good.
     let
-       rules             = idSpecialisation bndr
-       bndr2             = bndr1 `setIdSpecialisation` substRules (getSubst env) rules
+       bndr2             = bndr1 `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr)
        env1              = modifyInScope env bndr2 bndr2
        rhs_env           = setInScope rhs_se env1
        is_top_level      = isTopLevel top_lvl