[commit: ghc] supercompiler: Use new insertVarRenaming when constructing renaming in MSG (94c7d82)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/94c7d820f0fc6393fd83942f19d12a509d1abf0b

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

commit 94c7d820f0fc6393fd83942f19d12a509d1abf0b
Author: Max Bolingbroke <[email protected]>
Date:   Fri May 11 08:39:34 2012 +0100

    Use new insertVarRenaming when constructing renaming in MSG

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

 .../supercompile/Supercompile/Core/Renaming.hs     |    7 +++++++
 compiler/supercompile/Supercompile/Drive/MSG.hs    |    2 +-
 2 files changed, 8 insertions(+), 1 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Core/Renaming.hs b/compiler/supercompile/Supercompile/Core/Renaming.hs
index 2a81d4b..21fe136 100644
--- a/compiler/supercompile/Supercompile/Core/Renaming.hs
+++ b/compiler/supercompile/Supercompile/Core/Renaming.hs
@@ -10,6 +10,7 @@ module Supercompile.Core.Renaming (
     PreRenaming, invertRenaming, composeRenamings,
 
     -- | Extending the renaming
+    insertVarRenaming,
     insertIdRenaming, insertIdRenamings,
     insertTypeSubst, insertTypeSubsts,
     insertCoercionSubst, insertCoercionSubsts,
@@ -200,6 +201,12 @@ getId_maybe _                = Nothing
 coreSynToVar :: CoreSyn.CoreExpr -> Var
 coreSynToVar = fromMaybe (panic "renameId" empty) . getId_maybe
 
+insertVarRenaming :: Renaming -> Var -> Out Var -> Renaming
+insertVarRenaming rn x y
+  | isTyVar x = insertTypeSubst     rn x (mkTyVarTy x)
+  | isCoVar x = insertCoercionSubst rn x (mkCoVarCo x)
+  | otherwise = insertIdRenaming    rn x y
+
 insertIdRenaming :: Renaming -> Id -> Out Id -> Renaming
 insertIdRenaming (id_subst, tv_subst, co_subst) x x'
   = (extendVarEnv id_subst x (mkIdExpr x'), tv_subst, co_subst)
diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs
index 7a0d7c3..87a55f6 100644
--- a/compiler/supercompile/Supercompile/Drive/MSG.hs
+++ b/compiler/supercompile/Supercompile/Drive/MSG.hs
@@ -1015,7 +1015,7 @@ msgPureHeap mm rn2 msg_e msg_s (Heap init_h_l init_ids_l) (Heap init_h_r init_id
                  -- that binding refers to. If that is not possible, we have to fail.
                  (used_l', h_l') <- mb_individual_l >>= suck init_h_l k_bvs_l h_l x_l
                  (used_r', h_r') <- mb_individual_r >>= suck init_h_r k_bvs_r h_r x_r
-                 return $ go (insertIdRenaming rn_l x_common x_l) (insertIdRenaming rn_r x_common x_r) used_l' used_r' init_h_l init_h_r
+                 return $ go (insertVarRenaming rn_l x_common x_l) (insertVarRenaming rn_r x_common x_r) used_l' used_r' init_h_l init_h_r
                              (Heap h_l' ids_l) (Heap h_r' ids_r) (M.insert x_common generalised h) msg_s) -- FIXME: only mark as generalised if *right hand side* was not e.g. a lambda bound
       where
         (mb_common_l, mb_individual_l) = find init_h_l k_bvs_l h_l used_l x_l