[project @ 2001-05-18 07:51:42 by simonpj]
authorsimonpj <unknown>
Fri, 18 May 2001 07:51:42 +0000 (07:51 +0000)
committersimonpj <unknown>
Fri, 18 May 2001 07:51:42 +0000 (07:51 +0000)
**** 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.

ghc/compiler/stgSyn/CoreToStg.lhs

index 59135df..9772179 100644 (file)
@@ -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)