[commit: ghc] supercompiler: Due to evaluator change we can remove some ugliness from split cheap heap construction (feb653c)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/feb653c2936b2bd0e714b818a1c7680b01497806

>---------------------------------------------------------------

commit feb653c2936b2bd0e714b818a1c7680b01497806
Author: Max Bolingbroke <[email protected]>
Date:   Mon Aug 13 18:09:50 2012 +0100

    Due to evaluator change we can remove some ugliness from split cheap heap construction

>---------------------------------------------------------------

 compiler/supercompile/Supercompile/Drive/Split2.hs |   18 ++++--------------
 1 files changed, 4 insertions(+), 14 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Split2.hs b/compiler/supercompile/Supercompile/Drive/Split2.hs
index ccb45fd..6f4eed6 100644
--- a/compiler/supercompile/Supercompile/Drive/Split2.hs
+++ b/compiler/supercompile/Supercompile/Drive/Split2.hs
@@ -454,24 +454,14 @@ push :: S.Set Context
      -> (Heap, Stack, PushFocus (Anned QA) (In AnnedTerm))
      -> (PushedHeap, PushedStack, PushedFocus)
 push generalised (Heap h ids, k, focus) = (h', k', focus')
-  where -- NB: values or variables in focus which are immediately updated are a pain. We:
-        --  1. Construct a bit of graph from the update frame which overwrites the normal HeapContext binding from splitStack to ensure
-        --     that there is no edge from the variable to its update frame (we can just push the definition down, not the frame)
-        --  2. Explicitly ensure that the thing bound by the update frame is considered cheap and hence shorcutted through in the graph
-        --
-        -- NB: in this case we may end up marking the y' bound by the update frame but not the frame itself (at index 0 or 1)
-        (cheap_marked_k_head, h_k_head) = case fst (peelUpdateStack k) of
-          Just (cast_by, Tagged _tg_y' y') | QAFocus qa <- focus -> (S.singleton (HeapContext y'), M.singleton y' (internallyBound (castAnnedQAToInAnnedTerm ids qa cast_by)))
-          _                                                      -> (S.empty, M.empty)
-
-        -- TODO: arguably I should try to get a QA for the thing in the focus. This will help in cases like where we MSG together:
+  where -- TODO: arguably I should try to get a QA for the thing in the focus. This will help in cases like where we MSG together:
         --  < H | v | >
         -- and:
         --  < H, H' | v | update f >
         -- Since ideally instance splitting the second state should allow us to drive H' with the value binding f |-> v. A similar argument applies to questions in focus.
         mb_scrut = case focus of QAFocus qa | Question x' <- annee qa -> Just x'; _ -> Nothing
 
-        (verts_h,     prepare_h, mk_h)     = splitPureHeap ids (h `unionDisjoint` h_k_head)
+        (verts_h,     prepare_h, mk_h)     = splitPureHeap ids h
         (verts_k,     prepare_k, mk_k)     = splitStack    ids k     mb_scrut
         (verts_focus,            mk_focus) = splitFocus    ids focus (FocusContext `S.member` generalised)
 
@@ -494,11 +484,11 @@ push generalised (Heap h ids, k, focus) = (h', k', focus')
         -- forcing more things to be unmarked. In particular, we have to watch out for:
         --   1. Vertices originating from dead heap bindings
         --   2. Heap verticies originating from on-stack updates that bind dead variables
-        cheap_marked = (cheap_marked_k_head `S.union` S.fromDistinctAscList [HeapContext x' | (x', hb) <- M.toAscList h, maybe True (termIsCheap . snd) (heapBindingTerm hb)]) S.\\ generalised
+        cheap_marked = S.fromDistinctAscList [HeapContext x' | (x', hb) <- M.toAscList h, maybe True (termIsCheap . snd) (heapBindingTerm hb)] S.\\ generalised
         verts = trimUnreachable FocusContext $
                 shortcutEdges (`S.member` cheap_marked)
                               plusEntries (\ent1 _ ent2 -> ent1 `plusEntries` ent2)
-                              (verts_h `M.union` (verts_k `unionDisjoint` verts_focus)) -- NB: verts_h might mention a heap binding bound by a leading update frame in verts_k: h takes precedence
+                              (verts_h `unionDisjoint` (verts_k `unionDisjoint` verts_focus))
         extra_marked = solve generalised verts
         marked = cheap_marked `S.union` extra_marked