[commit: ghc] supercompiler: Don't pull on prepareTerm result unless needed (f89af0c)
Max Bolingbroke <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler http://hackage.haskell.org/trac/ghc/changeset/f89af0cc364255f77fb0ab9f2109ee54821be850 >--------------------------------------------------------------- commit f89af0cc364255f77fb0ab9f2109ee54821be850 Author: Max Bolingbroke <[email protected]> Date: Fri Oct 19 10:45:35 2012 +0100 Don't pull on prepareTerm result unless needed >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process3.hs | 10 ++++++---- 1 files changed, 6 insertions(+), 4 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process3.hs b/compiler/supercompile/Supercompile/Drive/Process3.hs index 19e6532..a335986 100644 --- a/compiler/supercompile/Supercompile/Drive/Process3.hs +++ b/compiler/supercompile/Supercompile/Drive/Process3.hs @@ -756,10 +756,12 @@ reduceForMatch state | rEDUCE_BEFORE_MATCH = {- second gc $ -} reduceWithFlag (c supercompile :: M.Map Var Term -> Term -> Term supercompile unfoldings e = fVedTermToTerm $ start (liftM snd . sc) - where (bvs_unfoldings, (to_bind, state), (preinit_with, preinit_state)) = prepareTerm unfoldings e - start k | pREINITALIZE_MEMO_TABLE = run $ preinitalise preinit_with >> withScpEnv (\e -> e { scpAlreadySpeculated = bvs_unfoldings `S.union` scpAlreadySpeculated e }) (k preinit_state) - | otherwise = bindManyMixedLiftedness fvedTermFreeVars to_bind $ run $ k state - run = runScpM (tagAnnotations state) + where (bvs_unfoldings, no_preinit, preinit) = prepareTerm unfoldings e + (to_bind, state) = no_preinit -- Delay forcing these to suppress + (preinit_with, preinit_state) = preinit -- prepareTerm debug prints + start k | pREINITALIZE_MEMO_TABLE = run preinit_state $ preinitalise preinit_with >> withScpEnv (\e -> e { scpAlreadySpeculated = bvs_unfoldings `S.union` scpAlreadySpeculated e }) (k preinit_state) + | otherwise = bindManyMixedLiftedness fvedTermFreeVars to_bind $ run state $ k state + run tags_state = runScpM (tagAnnotations tags_state) preinitalise :: [(State, FVedTerm)] -> ScpM () preinitalise states_fulfils = forM_ states_fulfils $ \(state, e') -> do