From 7dd06806e9f293f280a215e3fdf37a1dd277c660 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 24 Oct 2001 13:47:22 +0000
Subject: [PATCH] [project @ 2001-10-24 13:47:22 by simonpj] Robustify arity
 calculation

---
 ghc/compiler/coreSyn/CoreTidy.lhs |   26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 77f989b..5180c41 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -17,6 +17,7 @@ import CoreUnfold	( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
 import CoreFVs		( ruleSomeFreeVars, exprSomeFreeVars )
 import PprCore		( pprIdCoreRule )
 import CoreLint		( showPass, endPass )
+import CoreUtils	( exprArity )
 import VarEnv
 import VarSet
 import Var		( Id, Var )
@@ -434,7 +435,7 @@ tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs
 					       (idName id)
     ty'	   = tidyTopType (idType id)
     idinfo = tidyTopIdInfo rec_tidy_env is_external 
-			   (idInfo id) unfold_info
+			   (idInfo id) unfolding arity
 			   (lookupCgInfo cg_info_env name')
 
     id' = mkVanillaGlobal name' ty' idinfo
@@ -444,18 +445,21 @@ tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs
     maybe_external = lookupVarEnv ext_ids id
     is_external    = isJust maybe_external
 
-    -- Expose an unfolding if ext_ids tells us to
-    show_unfold = maybe_external `orElse` False
-    unfold_info | show_unfold = mkTopUnfolding rhs
-		| otherwise   = noUnfolding
+    -- Usually the Id will have an accurate arity on it, because
+    -- the simplifier has just run, but not always. 
+    -- One case I found was when the last thing the simplifier
+    -- did was to let-bind a non-atomic argument and then float
+    -- it to the top level. So it seems more robust just to
+    -- fix it here.
+    arity     = exprArity rhs
+    unfolding = mkTopUnfolding rhs
+
 
 
 -- tidyTopIdInfo creates the final IdInfo for top-level
 -- binders.  There are two delicate pieces:
 --
---  * Arity.  We assume that the simplifier has just run, so
--- 	that there is a reasonable arity on each binder.
---	After CoreTidy, this arity must not change any more.
+--  * Arity.  After CoreTidy, this arity must not change any more.
 --	Indeed, CorePrep must eta expand where necessary to make
 --	the manifest arity equal to the claimed arity.
 --
@@ -471,7 +475,7 @@ tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs
 -- 	An alterative would be to do a second pass over the unfoldings 
 -- 	of Ids, and rules, right at the top, but that would be a pain.
 
-tidyTopIdInfo tidy_env is_external idinfo unfold_info cg_info
+tidyTopIdInfo tidy_env is_external idinfo unfold_info arity cg_info
   | opt_OmitInterfacePragmas || not is_external
 	-- Only basic info if the Id isn't external, or if we don't have -O
   = basic_info
@@ -488,7 +492,7 @@ tidyTopIdInfo tidy_env is_external idinfo unfold_info cg_info
 	-- baasic_info is attached to every top-level binder
     basic_info = vanillaIdInfo 
 			`setCgInfo` 	       cg_info
-			`setArityInfo`	       arityInfo idinfo
+			`setArityInfo`	       arity
 			`setNewStrictnessInfo` newStrictnessInfo idinfo
 
 -- This is where we set names to local/global based on whether they really are 
@@ -651,7 +655,7 @@ tidyLetBndr env (id,rhs)
     final_id = new_id `setIdInfo` new_info
     idinfo   = idInfo id
     new_info = vanillaIdInfo 
-		`setArityInfo`		arityInfo idinfo
+		`setArityInfo`		exprArity rhs
 		`setNewStrictnessInfo`	newStrictnessInfo idinfo
 		`setNewDemandInfo`	newDemandInfo idinfo
 
-- 
1.7.10.4