[commit: ghc] supercompiler: GC state in speculator to make termination check more lenient (324b1eb)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/324b1eb93518a041c12cc5a56e01545331ee4952

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

commit 324b1eb93518a041c12cc5a56e01545331ee4952
Author: Max Bolingbroke <[email protected]>
Date:   Tue Jan 31 17:30:07 2012 +0000

    GC state in speculator to make termination check more lenient

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

 .../supercompile/Supercompile/Drive/Process.hs     |    6 +++++-
 1 files changed, 5 insertions(+), 1 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs
index 5ca5dd1..52f33bd 100644
--- a/compiler/supercompile/Supercompile/Drive/Process.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process.hs
@@ -478,7 +478,11 @@ speculate speculated (stats, (deeds, Heap h ids, k, in_e)) = (M.keysSet h, (stat
                                 in_e' = annedAnswerToInAnnedTerm (mkInScopeSet (annedFreeVars a)) a
                           -> ((stats `mappend` extra_stats, deeds, M.insert x' (internallyBound in_e') h_speculated_ok, h_speculated_failure, ids), speculateManyMap hist h_unspeculated)
                         _ -> (no_change, speculation_failure)
-                  where state = normalise (deeds, Heap h_speculated_ok ids, [], in_e)
+                  where state = gc (normalise (deeds, Heap h_speculated_ok ids, [], in_e))
+                        -- NB: try to avoid dead bindings in the state using 'gc' so that the termination condition
+                        -- is more lenient. This showed up in practice, in a version of LetRec.hs where we had:
+                        --   let dead = xs in 1 : xs `embed` let ys = 1 : ys in ys
+                        -- (Because the tag on the ys/xs indirections was the cons-cell tag)
 
 type SpecState = (SCStats, Deeds, PureHeap, PureHeap, InScopeSet)
 newtype SpecM a = SpecM { unSpecM :: SpecState -> (SpecState -> a -> SpecState) -> SpecState }