[commit: ghc] : Fix Entered information when eager splitting (7ced16b)
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 : http://hackage.haskell.org/trac/ghc/changeset/7ced16b54634deb51458f5d69e64aafa47cf8f6e >--------------------------------------------------------------- commit 7ced16b54634deb51458f5d69e64aafa47cf8f6e Author: Max Bolingbroke <[email protected]> Date: Tue Jan 3 14:14:22 2012 +0000 Fix Entered information when eager splitting >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/Split.hs | 4 ++-- 1 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Split.hs b/compiler/supercompile/Supercompile/Drive/Split.hs index a24c64a..f1e3bad 100644 --- a/compiler/supercompile/Supercompile/Drive/Split.hs +++ b/compiler/supercompile/Supercompile/Drive/Split.hs @@ -417,8 +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 - 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 + = fmap (\(ent', (deeds, Heap h' ids', k', in_e')) -> (if isOnce ent then ent' else Many, (deeds, Heap (h `M.union` h') ids', k', in_e'))) $ -- Push heap of positive information/new lambda-bounds down + fix hole Entereds + 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))