Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/8d23383d5ca4192e5e791ddb35b5c0598ae36852 >--------------------------------------------------------------- commit 8d23383d5ca4192e5e791ddb35b5c0598ae36852 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Thu Apr 26 23:39:47 2012 +0100 My MSG common-binder knot was too knotty >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 17 +++++++++-------- 1 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 1c8ffbc..f5756c4 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -155,8 +155,8 @@ data MSGState = MSGState { -- INVARIANT: incoming base variable has *no* extra information beyond Name and Type/Kind (which will be anyway overwritten) msgPend :: RnEnv2 -> Var -> Pending -> MSG Var -msgPend rn2 x0 pending = MSG $ \e s -> case lookupUpdatePending s of - Right x -> Right (s, x) +msgPend rn2 x0 pending = MSG $ \e s0 -> case lookupUpdatePending s0 of + Right x -> Right (s0, x) Left (mb_eq, binderise, mk_s) -> res where -- This use of rn2 is 1/2 of the story necessary to ensure new common vars don't clash with rigid binders x1 = uniqAway (rnInScopeSet rn2) x0 @@ -165,22 +165,23 @@ msgPend rn2 x0 pending = MSG $ \e s -> case lookupUpdatePending s of , eq `elemInScopeSet` msgCommonHeapVars (msgMode e) = eq | otherwise - = uniqAway (msgInScopeSet s) x1 + = uniqAway (msgInScopeSet s0) x1 -- We *don't* need to uniqAway with the set of common variables (in e) because the msgInScopeSet -- was initialized to contain them all. -- NB: we make use of lazy programming to ensure that we can see the currently-pended common variable -- in the state even as we are binderising it. This is important since the variable's IdInfo might mention itself, -- as x_l and x_r will in fact be bound by the top-level letrec. - s = (mk_s x) { msgInScopeSet = extendInScopeSet (msgInScopeSet s) x2, -- NB: binderization *never* changes the unique -- exploit that to avoid a loop - msgPending = (x, pending) : msgPending s } - res = unMSG (binderise x2) (e { msgLostWorkSharing = False }) s -- This thing will be bound in the top letrec, outside any lambdas - Right (_, x) = res + s1 = mk_s x + s2 = s1 { msgInScopeSet = extendInScopeSet (msgInScopeSet s1) x2, -- NB: binderization *never* changes the unique -- exploit that to avoid a loop + msgPending = (x, pending) : msgPending s1 } + res = unMSG (binderise x2) (e { msgLostWorkSharing = False }) s2 -- This thing will be bound in the top letrec, outside any lambdas + Right (_, x) = trace "forcing knot" res where lookupUpdatePending :: MSGState -> Either (Maybe Var, -- Are both sides equal vars, and if so what are they equal to? Var -> MSG Var, -- Produce a version of the variable suitable for use as a heap binder (with generalised info/type/kind) - Var -> MSGState) -- How to update the initial state with the variable for this pending item + Var -> MSGState) -- How to update the initial state with the variable for this pending item (only the "known" maps change) Var lookupUpdatePending s = case pending of -- TODO: binder matching can legitimately fail, in which case we might want to create a common "vanilla" _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
