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

Wibble to arity fix

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}

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