Commit ab061892 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-09-20 12:14:31 by simonpj]

------------------------------------------------
	Make code generation ignore isLocalId/isGlobalId
	------------------------------------------------

	MERGE WITH STABLE BRANCH

CorePrep may introduce some new, top-level LocalIds.  This
breaks an invariant that the core2stg/code generator passes
occasionally used, namely that LocalIds are not top-level bound.

This commit fixes that problem.

It also removes an assert from CodeGen.cgTopRhs that asks
for the CgInfo of such new LocalIds -- but they may (legitimately)
not have any, so it was a bad ASSERT.  [Showed up in George
Russel's system.]
parent 2c250999
......@@ -266,8 +266,6 @@ cgTopRhs bndr (StgRhsCon cc con args) srt
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag args body) srt
= -- There should be no free variables
ASSERT(null fvs)
-- If the closure is a thunk, then the binder must be recorded as such.
ASSERT2(not (isUpdatable upd_flag) || mayHaveCafRefs (idCafInfo bndr), ppr bndr)
getSRTLabel `thenFC` \srt_label ->
let lf_info =
......
......@@ -788,7 +788,8 @@ type LneM a = IdEnv HowBound
-> a
data HowBound
= ImportBound
= ImportBound -- Used only as a response to lookupBinding; never
-- exists in the range of the (IdEnv HowBound)
| CaseBound
| LambdaBound
| LetBound
......@@ -873,12 +874,13 @@ extendVarEnvLne ids_w_howbound expr env lvs_cont
= expr (extendVarEnvList env ids_w_howbound) lvs_cont
lookupVarLne :: Id -> LneM HowBound
lookupVarLne v env lvs_cont
= returnLne (
case (lookupVarEnv env v) of
Just xx -> xx
Nothing -> ImportBound
) env lvs_cont
lookupVarLne v env lvs_cont = returnLne (lookupBinding env v) env lvs_cont
lookupBinding :: IdEnv HowBound -> Id -> HowBound
lookupBinding env v = case lookupVarEnv env v of
Just xx -> xx
Nothing -> ASSERT( isGlobalId v ) ImportBound
-- The result of lookupLiveVarsForSet, a set of live variables, is
-- only ever tacked onto a decorated expression. It is never used as
......@@ -889,29 +891,24 @@ freeVarsToLiveVars fvs env live_in_cont
= returnLne (lvs, cafs) env live_in_cont
where
(lvs_cont, cafs_cont) = live_in_cont -- not a strict pattern match!
(local, global) = partition isLocalId (allFreeIds fvs)
(lvs_from_fvs, caf_extras) = unzip (map do_one local)
lvs = unionVarSets lvs_from_fvs
`unionVarSet` lvs_cont
(lvs_from_fvs, caf_from_fvs) = unzip (map do_one (allFreeIds fvs))
cafs = mkVarSet (filter is_caf_one global)
`unionVarSet` (unionVarSets caf_extras)
`unionVarSet` cafs_cont
lvs = unionVarSets lvs_from_fvs `unionVarSet` lvs_cont
cafs = unionVarSets caf_from_fvs `unionVarSet` cafs_cont
do_one v
= case (lookupVarEnv env v) of
Just (LetBound _ (lvs,cafs) _) -> (extendVarSet lvs v, cafs)
Just _ -> (unitVarSet v, emptyVarSet)
Nothing -> pprPanic "lookupLiveVarsForSet/do_one:" (ppr v)
is_caf_one v
= case lookupVarEnv env v of
Just (LetBound TopLevelHasCafs (lvs,_) _) ->
ASSERT( isEmptyVarSet lvs ) True
Just (LetBound _ _ _) -> False
_otherwise -> mayHaveCafRefs (idCafInfo v)
= case lookupBinding env v of
LetBound caf_ness (lvs,cafs) _ ->
case caf_ness of
TopLevelHasCafs -> ASSERT( isEmptyVarSet lvs ) (emptyVarSet, unitVarSet v)
TopLevelNoCafs -> ASSERT( isEmptyVarSet lvs ) (emptyVarSet, emptyVarSet)
NotTopLevelBound -> (extendVarSet lvs v, cafs)
ImportBound | mayHaveCafRefs (idCafInfo v) -> (emptyVarSet, unitVarSet v)
| otherwise -> (emptyVarSet, emptyVarSet)
_nested_binding -> (unitVarSet v, emptyVarSet) -- Bound by lambda or case
\end{code}
%************************************************************************
......@@ -1080,12 +1077,10 @@ hasCafRefss p exprs
-- cafRefs compiles to beautiful code :)
cafRefs p (Var id)
| isLocalId id = fastBool False
| otherwise =
case lookupVarEnv p id of
Just (LetBound TopLevelHasCafs _ _) -> fastBool True
Just (LetBound _ _ _) -> fastBool False
Nothing -> fastBool (cgMayHaveCafRefs (idCgInfo id)) -- imported Ids
= case lookupBinding p id of
ImportBound -> fastBool (mayHaveCafRefs (idCafInfo id))
LetBound TopLevelHasCafs _ _ -> fastBool True
other -> fastBool False
cafRefs p (Lit l) = fastBool False
cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment