Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/27024dc4360f0a8c48be53e7d1aecb039ace0fff >--------------------------------------------------------------- commit 27024dc4360f0a8c48be53e7d1aecb039ace0fff Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Tue Jan 3 13:55:34 2012 +0000 Fix free variables when deeply splitting values >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/Split.hs | 7 ++++++- 1 files changed, 6 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Split.hs b/compiler/supercompile/Supercompile/Drive/Split.hs index fe8616d..a24c64a 100644 --- a/compiler/supercompile/Supercompile/Drive/Split.hs +++ b/compiler/supercompile/Supercompile/Drive/Split.hs @@ -402,6 +402,10 @@ instance Accumulatable Bracketed where mapAccumTM f acc (TailsKnown ty mk_shell holes) = liftM (second (TailsKnown ty mk_shell)) $ mapAccumTM (mapAccumTM f) acc holes mapAccumTM f acc (TailsUnknown shell holes) = liftM (second (TailsUnknown shell)) $ mapAccumTM (mapAccumTM f) acc holes +modifyShell :: (Shell -> Shell) -> Bracketed a -> Bracketed a +modifyShell f (TailsKnown ty mk_shell holes) = TailsKnown ty (f . mk_shell) holes +modifyShell f (TailsUnknown shell holes) = TailsUnknown (f shell) holes + noneBracketed :: Tag -> Out FVedTerm -> Bracketed a noneBracketed tg a = TailsUnknown (Shell { shellExtraTags = oneResidTag tg, shellExtraFvs = freeVars a, shellWrapper = \[] -> a }) [] @@ -413,7 +417,8 @@ oneBracketed ctxt_ids ty (ent, (Heap h ids, k, in_e)) [Tagged tg (CastIt co)] -> Just (CastBy co tg) _ -> Nothing , Just anned_a <- termToAnswer ids in_e - = fmap (\(ent, (deeds, Heap h' ids', k', in_e')) -> (ent, (deeds, Heap (h `M.union` h') ids', k', in_e'))) $ -- Push heap of positive information/new lambda-bounds down + = fmap (\(ent, (deeds, Heap h' ids', k', in_e')) -> (ent, (deeds, Heap (h `M.union` h') ids', k', in_e'))) $ -- Push heap of positive information/new lambda-bounds down + modifyShell (\shell -> shell { shellExtraFvs = shellExtraFvs shell `minusVarSet` dataSetToVarSet (M.keysSet h) }) $ -- Take advantage of the fact that this heap is "optional" to fix bracket FVs splitAnswer ctxt_ids ids (annedToTagged (fmap (\a -> castAnswer ids a cast_by) anned_a)) | otherwise = oneBracketed' ty (ent, (emptyDeeds, Heap h ids, k, in_e)) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
