[commit: ghc] supercompiler: Non-preinitialization binds must go outside h functions (8f3fe71)
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/8f3fe7110ceba9422ba5ea96a7dd142350d53718 >--------------------------------------------------------------- commit 8f3fe7110ceba9422ba5ea96a7dd142350d53718 Author: Max Bolingbroke <[email protected]> Date: Thu Mar 1 11:59:31 2012 +0000 Non-preinitialization binds must go outside h functions >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process3.hs | 7 ++++--- 1 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process3.hs b/compiler/supercompile/Supercompile/Drive/Process3.hs index 3d85926..d127ec1 100644 --- a/compiler/supercompile/Supercompile/Drive/Process3.hs +++ b/compiler/supercompile/Supercompile/Drive/Process3.hs @@ -454,10 +454,11 @@ reduceForMatch :: State -> (Bool, State) reduceForMatch state = second gc $ reduceWithFlag (case state of (_, h, k, e) -> (maxBound, h, k, e)) -- Reduce ignoring deeds for better normalisation supercompile :: M.Map Var Term -> Term -> Term -supercompile unfoldings e = fVedTermToTerm $ runScpM (tagAnnotations state) $ start (liftM snd . sc) +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 = preinitalise preinit_with >> withScpEnv (\e -> e { scpAlreadySpeculated = bvs_unfoldings `S.union` scpAlreadySpeculated e }) (k preinit_state) - | otherwise = liftM (bindManyMixedLiftedness fvedTermFreeVars to_bind) $ k state + 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) preinitalise :: [(State, FVedTerm)] -> ScpM () preinitalise states_fulfils = forM_ states_fulfils $ \(state, e') -> do