Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/4c432616b7f1244f03c15d9c4718e37ac8880ff2 >--------------------------------------------------------------- commit 4c432616b7f1244f03c15d9c4718e37ac8880ff2 Author: Max Bolingbroke <batterseapo...@hotmail.com> 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') _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
