Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/e3cc6d661354a089183f0f9c0411de5000458c85 >--------------------------------------------------------------- commit e3cc6d661354a089183f0f9c0411de5000458c85 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Wed Apr 18 17:51:47 2012 +0100 Addendum to previous free vars fix: the InScopeSet also has to include the added FVs >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process.hs | 20 ++++++++++---------- 1 files changed, 10 insertions(+), 10 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs index 92cc0ea..b60cb4a 100644 --- a/compiler/supercompile/Supercompile/Drive/Process.hs +++ b/compiler/supercompile/Supercompile/Drive/Process.hs @@ -323,16 +323,16 @@ prepareTerm unfoldings e = {-# SCC "prepareTerm" #-} -- I think it would also be OK to zap the IdInfo of environmentally bound stuff, but that isn't -- optimal because the simplifier won't be able to restore the IdInfo of *global* Ids, so we might -- pessimisize all later simplifications. - h_fvs = go tag_ids2 emptyVarSet input_fvs + (input_fvs', h_fvs) = (closure emptyVarSet input_fvs, M.fromDistinctAscList $ snd $ foldToMapAccumL foldVarSet add_one_fv tag_ids2 input_fvs') + -- NB: foldVarSet is a right fold, so this use of fromDistinctAscList is justified where - go tag_ids all_input_fvs these_fvs - | M.null h_these_binds = M.empty - | otherwise = h_these_binds `M.union` go tag_ids' (all_input_fvs `unionVarSet` these_fvs) these_fvs' - where -- NB: foldVarSet is a right fold, so this use of fromDistinctAscList is justified - ((these_fvs', tag_ids'), h_these_binds) = second M.fromDistinctAscList $ foldToMapAccumL foldVarSet add_one_fv (emptyVarSet, tag_ids) (these_fvs `minusVarSet` all_input_fvs) - add_one_fv (these_fvs, tag_ids) x' = ((these_fvs', tag_ids'), (x', environmentallyBound (mkTag (getKey i)))) + closure all_input_fvs new_fvs + | isEmptyVarSet new_fvs = all_input_fvs + | otherwise = closure all_input_fvs' new_fvs' + where all_input_fvs' = all_input_fvs `unionVarSet` new_fvs + new_fvs' = foldVarSet (\x' -> (varBndrFreeVars x' `unionVarSet`)) emptyVarSet new_fvs `minusVarSet` all_input_fvs' + add_one_fv tag_ids x' = (tag_ids', (x', environmentallyBound (mkTag (getKey i)))) where !(i, tag_ids') = takeUniqFromSupply tag_ids - these_fvs' = these_fvs `unionVarSet` varBndrFreeVars x' unfolding_bvs = S.fromDistinctAscList (map fst h_unfoldings) deeds = Deeds { sizeLimit = (bLOAT_FACTOR - 1) * annedSize anned_e, stepLimit = (bLOAT_FACTOR - 1) * annedSize anned_e } @@ -340,8 +340,8 @@ prepareTerm unfoldings e = {-# SCC "prepareTerm" #-} -- FIXME: use speculated -- NB: h_fvs might contain bindings for things also in h_unfoldings, so union them in the right order - rn = mkIdentityRenaming input_fvs - ids = mkInScopeSet input_fvs + rn = mkIdentityRenaming input_fvs' + ids = mkInScopeSet input_fvs' {-# INLINE heap_binding_is_value #-} heap_binding_is_value = maybe True (termIsValue . snd) . heapBindingTerm _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
