[commit: ghc] : sc-rollback was totally busted in my porting effort (4c43261)

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/4c432616b7f1244f03c15d9c4718e37ac8880ff2

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

commit 4c432616b7f1244f03c15d9c4718e37ac8880ff2
Author: Max Bolingbroke <[email protected]>
Date:   Mon Aug 1 09:35:48 2011 +0100

    sc-rollback was totally busted in my porting effort

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

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

diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs
index 5fcfba2..b1c2913 100644
--- a/compiler/supercompile/Supercompile/Drive/Process.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process.hs
@@ -515,18 +515,19 @@ addStats :: SCStats -> ScpM ()
 addStats scstats = ScpM $ \_e s k -> k () (let scstats' = stats s `mappend` scstats in scstats' `seqSCStats` s { stats = scstats' })
 
 
-type RollbackScpM = (State, State) -> ScpM (Deeds, Out FVedTerm)
+type RollbackScpM = Generaliser -> ScpM (Deeds, Out FVedTerm)
 
 sc  :: History (State, RollbackScpM) -> AlreadySpeculated -> State -> ScpM (Deeds, Out FVedTerm)
 sc' :: History (State, RollbackScpM) -> AlreadySpeculated -> State -> ScpM (Deeds, Out FVedTerm)
 sc  hist = rollbackBig (memo (sc' hist))
-sc' hist speculated state = (\raise -> check raise) `catchScpM` \(old_state, state) -> stop old_state state hist -- TODO: I want to use the original history here, but I think doing so leads to non-term as it contains rollbacks from "below us" (try DigitsOfE2)
+sc' hist speculated state = (\raise -> check raise) `catchScpM` \gen -> stop gen state hist -- TODO: I want to use the original history here, but I think doing so leads to non-term as it contains rollbacks from "below us" (try DigitsOfE2)
   where
     check this_rb = case terminate hist (state, this_rb) of
                       Continue hist' -> continue hist'
-                      Stop (old_state, rb) -> maybe (stop old_state state hist) ($ (old_state, state)) $ guard sC_ROLLBACK >> Just rb
-    stop old_state state hist = do addStats $ mempty { stat_sc_stops = 1 }
-                                   maybe (trace "sc-stop: no generalisation" $ split state) (trace "sc-stop: generalisation") (generalise (mK_GENERALISER old_state state) state) (sc hist speculated) -- Keep the trace exactly here or it gets floated out by GHC
+                      Stop (shallower_state, rb) -> maybe (stop gen state hist) ($ gen) $ guard sC_ROLLBACK >> Just rb
+                        where gen = mK_GENERALISER shallower_state state
+    stop gen state hist = do addStats $ mempty { stat_sc_stops = 1 }
+                             maybe (trace "sc-stop: no generalisation" $ split state) (trace "sc-stop: generalisation") (generalise gen state) (sc hist speculated) -- Keep the trace exactly here or it gets floated out by GHC
     continue hist = do traceRenderScpM "reduce end (continue)" (PrettyDoc (pPrintFullState state'))
                        addStats stats
                        split state' (sc hist speculated')