Commit 0d8a0e7f authored by simonpj's avatar simonpj

[project @ 2002-02-14 14:02:55 by simonpj]

---------------------------------------
	Stop CSE messing up workers annotations
	---------------------------------------

See the comments with CSE.do_one
parent 1f315e01
......@@ -11,7 +11,8 @@ module CSE (
#include "HsVersions.h"
import CmdLineOpts ( DynFlag(..), DynFlags )
import Id ( Id, idType )
import Id ( Id, idType, idWorkerInfo )
import IdInfo ( workerExists )
import CoreUtils ( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr )
import DataCon ( isUnboxedTupleCon )
import Type ( tyConAppArgs )
......@@ -126,12 +127,23 @@ cseBind env (Rec pairs) = let (env', pairs') = mapAccumL do_one env pairs
in (env', Rec pairs')
do_one env (id, rhs) = case lookupCSEnv env rhs' of
Just other_id -> (extendSubst env' id other_id, (id', Var other_id))
Nothing -> (addCSEnvItem env' id' rhs', (id', rhs'))
where
(env', id') = addBinder env id
rhs' = cseExpr env' rhs
do_one env (id, rhs)
= case lookupCSEnv env rhs' of
Just other_id -> (extendSubst env' id other_id, (id', Var other_id))
Nothing -> (addCSEnvItem env' id' rhs', (id', rhs'))
where
(env', id') = addBinder env id
rhs' | not (workerExists (idWorkerInfo id)) = cseExpr env' rhs
-- Hack alert: don't do CSE on wrapper RHSs.
-- Otherwise we find:
-- $wf = h
-- f = \x -> ...$wf...
-- ===>
-- f = \x -> ...h...
-- But the WorkerInfo for f still says $wf, which is now dead!
| otherwise = rhs
tryForCSE :: CSEnv -> CoreExpr -> CoreExpr
tryForCSE env (Type t) = Type t
......
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