From: simonpj <unknown>
Date: Fri, 18 May 2001 07:51:42 +0000 (+0000)
Subject: [project @ 2001-05-18 07:51:42 by simonpj]
X-Git-Tag: Approximately_9120_patches~1943
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=740b4461248bc55706b49214edbec026ab2bc38f;p=ghc-hetmet.git

[project @ 2001-05-18 07:51:42 by simonpj]
**** MERGE WITH 5.00.1 BRANCH *****

Fix an obscure core-to-stg bug.  Type arguments were
being counted as value arguments when computing whether
a function was saturated, with consequent confusion.
---

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 59135df..9772179 100644
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -520,7 +520,7 @@ coreToStgApp maybe_thunk_body f args
     lookupVarLne f		`thenLne` \ how_bound ->
 
     let
-	n_args		 = length args
+	n_val_args	 = valArgCount args
 	not_letrec_bound = not (isLetBound how_bound)
 	fun_fvs	 	 = singletonFVInfo f how_bound fun_occ
 
@@ -529,13 +529,13 @@ coreToStgApp maybe_thunk_body f args
 			_                  -> 0
 
 	fun_occ 
-	 | not_letrec_bound		    = noBinderInfo	-- Uninteresting variable
-	 | f_arity > 0 && f_arity <= n_args = stgSatOcc		-- Saturated or over-saturated function call
-	 | otherwise			    = stgUnsatOcc	-- Unsaturated function or thunk
+	 | not_letrec_bound		        = noBinderInfo	-- Uninteresting variable
+	 | f_arity > 0 && f_arity <= n_val_args = stgSatOcc	-- Saturated or over-saturated function call
+	 | otherwise			        = stgUnsatOcc	-- Unsaturated function or thunk
 
 	fun_escs
-	 | not_letrec_bound  = emptyVarSet	-- Only letrec-bound escapees are interesting
-	 | f_arity == n_args = emptyVarSet	-- A function *or thunk* with an exactly
+	 | not_letrec_bound      = emptyVarSet	-- Only letrec-bound escapees are interesting
+	 | f_arity == n_val_args = emptyVarSet	-- A function *or thunk* with an exactly
 						-- saturated call doesn't escape
 						-- (let-no-escape applies to 'thunks' too)