Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/07e29c300997db338542f8b7fc4e3f78c2ad023f >--------------------------------------------------------------- commit 07e29c300997db338542f8b7fc4e3f78c2ad023f Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Apr 20 10:16:57 2012 +0100 Add additional check to the common-heap-vars match optimisation >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 6 ++++-- 1 files changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 0d06490..ca56373 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -675,8 +675,10 @@ msgPureHeap mm rn2 msg_s init_h_l init_h_r (k_bvs_l, k_fvs_l) (k_bvs_r, k_fvs_r) -- variable. This allows us to safely use the *right hand* term as the -- *common* HeapBinding without any sort of changes to variables. _ | x_l == x_r, x_r `S.member` msgCommonHeapVars mm - , Right res <- flip runMSG msg_s $ do Foldable.mapM_ (\x -> msgFlexiVar rn2 x x >>= \x' -> guard "msgPureHeap: shortcut" (x' == x) >> return ()) - (inFreeVars annedTermFreeVars in_e_r) + , let l_fvs = inFreeVars annedTermFreeVars in_e_l + r_fvs = inFreeVars annedTermFreeVars in_e_r + , l_fvs == r_fvs + , Right res <- flip runMSG msg_s $ do Foldable.mapM_ (\x -> msgFlexiVar rn2 x x >>= \x' -> guard "msgPureHeap: shortcut" (x' == x) >> return ()) r_fvs return in_e_r -- Right biased -> Right res | otherwise _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
