diff options
| author | simonpj <unknown> | 2001-05-18 07:51:42 +0000 |
|---|---|---|
| committer | simonpj <unknown> | 2001-05-18 07:51:42 +0000 |
| commit | 740b4461248bc55706b49214edbec026ab2bc38f (patch) | |
| tree | a963582d8dda923d8d4bb49c5e4dc9b05dde3fb2 | |
| parent | 5cf73eab6ec5df0abe330e107cbe969d41e38d30 (diff) | |
| download | haskell-740b4461248bc55706b49214edbec026ab2bc38f.tar.gz | |
[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.
| -rw-r--r-- | ghc/compiler/stgSyn/CoreToStg.lhs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs index 59135df3fd..97721797ad 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) |