X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;fp=compiler%2FdeSugar%2FDsUtils.lhs;h=553b4688322f3d361cc6135d1c4e5aafb289909a;hp=4334a12803431e1b55031c96806a2140a8714428;hb=1b1190e01d0c65043628d2532988d9b1b4a78384;hpb=628ca41da974b157a374280b7abfe550e12b22b0

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 4334a12..553b468 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -347,10 +347,10 @@ wrapBinds [] e = e
 wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)
 
 wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
-wrapBind new old body
+wrapBind new old body	-- Can deal with term variables *or* type variables
   | new==old    = body
-  | isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
-  | otherwise   = Let (NonRec new (Var old)) body
+  | isTyVar new = Let (mkTyBind new (mkTyVarTy old)) body
+  | otherwise   = Let (NonRec new (Var old))         body
 
 seqVar :: Var -> CoreExpr -> CoreExpr
 seqVar var body = Case (Var var) var (exprType body)