[commit: ghc] supercompiler: I was accidentally duplicating coercions on indirections (d981ac3)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/d981ac3b9d4e8708f124a2297a1c6b4a4063ffd9

>---------------------------------------------------------------

commit d981ac3b9d4e8708f124a2297a1c6b4a4063ffd9
Author: Max Bolingbroke <[email protected]>
Date:   Mon Aug 1 16:34:09 2011 +0100

    I was accidentally duplicating coercions on indirections

>---------------------------------------------------------------

 .../Supercompile/Evaluator/Evaluate.hs             |    8 +++++---
 1 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
index ddc1c32..cb75377 100644
--- a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
+++ b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
@@ -121,10 +121,11 @@ step' normalising state =
                   -> Answer  -- ^ Bound value, which we have *exactly* 1 deed for already that is not recorded in the Deeds itself
                   -> Maybe (Deeds, Answer) -- Outgoing deeds have that 1 latent deed included in them, and we have claimed deeds for the outgoing value
     prepareAnswer deeds x' a
-      | dUPLICATE_VALUES_EVALUATOR = fmap (flip (,) a) $ claimDeeds (deeds + 1) (answerSize' a)
+      | dUPLICATE_VALUES_EVALUATOR      = fmap (flip (,) a) $ claimDeeds (deeds + 1) (answerSize' a)
        -- Avoid creating indirections to indirections: implements indirection compression
-      | (_, (_, Indirect _)) <- a  = return (deeds, a)
-      | otherwise                  = return (deeds, (Nothing, (mkIdentityRenaming (unitVarSet x'), Indirect x')))
+       -- FIXME: for cast things as well?
+      | (Nothing, (_, Indirect _)) <- a = return (deeds, a)
+      | otherwise                       = return (deeds, (Nothing, (mkIdentityRenaming (unitVarSet x'), Indirect x')))
 
     -- We have not yet claimed deeds for the result of this function
     lookupAnswer :: Heap -> Out Var -> Maybe (Anned Answer)
@@ -150,6 +151,7 @@ step' normalising state =
         in_e <- heapBindingTerm hb
         return $ case k of
              -- Avoid creating consecutive update frames: implements "stack squeezing"
+             -- FIXME: squeeze through casts as well?
             kf : _ | Update y' <- tagee kf -> (deeds, Heap (M.insert x' (internallyBound (mkIdentityRenaming (unitVarSet y'), annedTerm (tag kf) (Var y'))) h) ids,                         k, in_e)
             _                              -> (deeds, Heap (M.delete x' h)                                                                                     ids, Tagged tg (Update x') : k, in_e)