[commit: ghc] supercompiler: Rename free variables in annotation correctly in termToAnswer (e2b3fa1)

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

On branch  : supercompiler

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

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

commit e2b3fa1166ce440d426e7ebc6180df3a2bb30bdf
Author: Max Bolingbroke <[email protected]>
Date:   Wed Jul 27 18:34:37 2011 +0100

    Rename free variables in annotation correctly in termToAnswer

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

 .../supercompile/Supercompile/Evaluator/Syntax.hs  |   12 +++++-------
 1 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Evaluator/Syntax.hs b/compiler/supercompile/Supercompile/Evaluator/Syntax.hs
index 466e7a0..515e8ca 100644
--- a/compiler/supercompile/Supercompile/Evaluator/Syntax.hs
+++ b/compiler/supercompile/Supercompile/Evaluator/Syntax.hs
@@ -42,6 +42,10 @@ annedFreeVars = freeVars . sizee . unComp . tagee . unComp
 annedTag :: Anned a -> Tag
 annedTag = tag . unComp
 
+renameAnned :: In (Anned a) -> Anned (In a)
+renameAnned (rn, Comp (Tagged tg (Comp (Sized sz (FVed fvs x)))))
+  = Comp (Tagged tg (Comp (Sized sz (FVed (renameFreeVars rn fvs) (rn, x)))))
+
 
 annedVarFreeVars' = taggedSizedFVedVarFreeVars'
 annedTermFreeVars = taggedSizedFVedTermFreeVars
@@ -95,7 +99,7 @@ answerFreeVars' :: Answer -> FreeVars
 answerFreeVars' = annedTermFreeVars' . answerToAnnedTerm' emptyInScopeSet
 
 termToAnswer :: InScopeSet -> In AnnedTerm -> Maybe (Anned Answer)
-termToAnswer iss (rn, anned_e) = flip traverse anned_e $ \e -> case e of
+termToAnswer iss in_anned_e = flip traverse (renameAnned in_anned_e) $ \(rn, e) -> case e of
     Value v          -> Just (Nothing, (rn, v))
     Cast anned_e' co -> case extract anned_e' of
         Value v -> Just (Just (renameCoercion iss rn co, annedTag anned_e'), (rn, v))
@@ -217,12 +221,6 @@ instance Outputable StackFrame where
         CastIt co'                     -> pPrintPrecCast prec (PrettyDoc $ text "[_]") co'
 
 
-renameAnned :: (InScopeSet -> Renaming -> a -> a)
-            -> Anned (In a) -> a
-renameAnned rename in_x = x'
-  where (rn, x) = annee in_x
-        x' = rename (mkInScopeSet (annedFreeVars in_x)) rn x
-
 stateType :: State -> Type
 stateType (_, _, k, qa) = stackType k (qaType qa)