[commit: ghc] supercompiler: Fixed some missed type renaming in the evaluator primop case (93be0d5)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/93be0d5f8a94bebe11166b944107ee955f4c0248

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

commit 93be0d5f8a94bebe11166b944107ee955f4c0248
Author: Max Bolingbroke <[email protected]>
Date:   Thu Jun 23 11:45:03 2011 +0100

    Fixed some missed type renaming in the evaluator primop case

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

 .../Supercompile/Evaluator/Evaluate.hs             |   12 ++++++------
 1 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
index a66b892..ccd8d86 100644
--- a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
+++ b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs
@@ -25,8 +25,8 @@ import DataCon
 import Pair
 
 
-evaluatePrim :: Tag -> PrimOp -> [Type] -> [Answer] -> Maybe (Anned Answer)
-evaluatePrim tg pop tys args = do
+evaluatePrim :: InScopeSet -> Tag -> PrimOp -> [Type] -> [Answer] -> Maybe (Anned Answer)
+evaluatePrim iss tg pop tys args = do
     args' <- fmap (map CoreSyn.Type tys ++) $ mapM to args
     (res:_) <- return [res | CoreSyn.BuiltinRule { CoreSyn.ru_nargs = nargs, CoreSyn.ru_try = f }
                           <- primOpRules pop (error "evaluatePrim: dummy primop name")
@@ -38,7 +38,7 @@ evaluatePrim tg pop tys args = do
     to (mb_co, (rn, v)) = fmap (maybe id (flip CoreSyn.Cast . fst) mb_co) $ case v of
         Literal l      -> Just (CoreSyn.Lit l)
         Coercion co    -> Just (CoreSyn.Coercion co)
-        Data dc tys xs -> Just (CoreSyn.Var (dataConWrapId dc) `CoreSyn.mkTyApps` tys `CoreSyn.mkVarApps` map (renameId rn) xs)
+        Data dc tys xs -> Just (CoreSyn.Var (dataConWrapId dc) `CoreSyn.mkTyApps` map (renameType iss rn) tys `CoreSyn.mkVarApps` map (renameId rn) xs)
         _              -> Nothing
     
     fro :: CoreSyn.CoreExpr -> Maybe Answer
@@ -262,14 +262,14 @@ step' normalising state =
                                -- NB: we add the *non-dereferenced* value to the heap for a case wildcard, because anything else may duplicate allocation
 
         primop :: Deeds -> Tag -> Heap -> Stack -> Tag -> PrimOp -> [Out Type] -> [Anned Answer] -> Answer -> [In AnnedTerm] -> Maybe UnnormalisedState
-        primop deeds tg_kf h k tg_a pop tys' anned_as a [] = do
+        primop deeds tg_kf heap@(Heap _ ids) k tg_a pop tys' anned_as a [] = do
             guard eVALUATE_PRIMOPS -- NB: this is not faithful to paper 1 because we still turn primop expressions into
                                    -- stack frames.. this is bad because it will impede good specilations (without smart generalisation)
             let as' = map (dereference h) $ map annee anned_as ++ [a]
                 tg_kf' = tg_kf { tagOccurrences = if oCCURRENCE_GENERALISATION then tagOccurrences tg_kf + sum (map tagOccurrences (tg_a : map annedTag anned_as)) else 1 }
-            a' <- evaluatePrim tg_kf' pop tys' as'
+            a' <- evaluatePrim ids tg_kf' pop tys' as'
             deeds <- claimDeeds (deeds + sum (map annedSize anned_as) + answerSize' a + 1) (annedSize a') -- I don't think this can ever fail
-            return (denormalise (deeds, h, k, fmap Answer a'))
+            return (denormalise (deeds, heap, k, fmap Answer a'))
         primop deeds tg_kf h k tg_a pop tys' anned_as a in_es = case in_es of
             (in_e:in_es) -> Just (deeds, h, Tagged tg_kf (PrimApply pop tys' (anned_as ++ [annedAnswer tg_a a]) in_es) : k, in_e)
             []           -> Nothing