Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/8402d155db039b701814785c4466fdfbe5306e91 >--------------------------------------------------------------- commit 8402d155db039b701814785c4466fdfbe5306e91 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Thu Mar 1 11:12:00 2012 +0000 The to_binds when not preinitalizing are of mixed liftedness >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process1.hs | 2 +- .../supercompile/Supercompile/Drive/Process2.hs | 2 +- .../supercompile/Supercompile/Drive/Process3.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process1.hs b/compiler/supercompile/Supercompile/Drive/Process1.hs index 23619ce..a0e0bcd 100644 --- a/compiler/supercompile/Supercompile/Drive/Process1.hs +++ b/compiler/supercompile/Supercompile/Drive/Process1.hs @@ -54,7 +54,7 @@ ifThenElse False _ y = y supercompile :: M.Map Var Term -> Term -> IO (SCStats, Term) -supercompile unfoldings e = liftM (second (fVedTermToTerm . letRec to_bind)) $ runScpM $ fmap snd $ sc (mkLinearHistory (cofmap fst wQO)) S.empty state +supercompile unfoldings e = liftM (second (fVedTermToTerm . bindManyMixedLiftedness fvedTermFreeVars to_bind)) $ runScpM $ fmap snd $ sc (mkLinearHistory (cofmap fst wQO)) S.empty state where (_, (to_bind, state), _) = prepareTerm unfoldings e -- diff --git a/compiler/supercompile/Supercompile/Drive/Process2.hs b/compiler/supercompile/Supercompile/Drive/Process2.hs index a1461f5..555c72d 100644 --- a/compiler/supercompile/Supercompile/Drive/Process2.hs +++ b/compiler/supercompile/Supercompile/Drive/Process2.hs @@ -329,5 +329,5 @@ foo :: LevelM (Out FVedTerm) -> ScpM (FulfilmentT Identity (Out FVedTerm)) foo = undefined supercompile :: M.Map Var Term -> Term -> Term -supercompile unfoldings e = fVedTermToTerm $ letRec to_bind $ unI $ runFulfilmentT $ runHistoryThreadM $ runMemoT $ runContT $ runScpM $ liftM (foo . fmap snd) $ sc 0 state +supercompile unfoldings e = fVedTermToTerm $ bindManyMixedLiftedness fvedTermFreeVars to_bind $ unI $ runFulfilmentT $ runHistoryThreadM $ runMemoT $ runContT $ runScpM $ liftM (foo . fmap snd) $ sc 0 state where (_, (to_bind, state), _) = prepareTerm unfoldings e diff --git a/compiler/supercompile/Supercompile/Drive/Process3.hs b/compiler/supercompile/Supercompile/Drive/Process3.hs index c050f5c..3d85926 100644 --- a/compiler/supercompile/Supercompile/Drive/Process3.hs +++ b/compiler/supercompile/Supercompile/Drive/Process3.hs @@ -457,7 +457,7 @@ supercompile :: M.Map Var Term -> Term -> Term supercompile unfoldings e = fVedTermToTerm $ runScpM (tagAnnotations state) $ 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 (letRec to_bind) $ k state + | otherwise = liftM (bindManyMixedLiftedness fvedTermFreeVars to_bind) $ k state preinitalise :: [(State, FVedTerm)] -> ScpM () preinitalise states_fulfils = forM_ states_fulfils $ \(state, e') -> do _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
