From: simonpj@microsoft.com <unknown>
Date: Wed, 15 Sep 2010 07:03:25 +0000 (+0000)
Subject: Fix egregious bug in deeplyInstantiate
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=6c5637803d14fd1035c38235123b4c112d1c2b00

Fix egregious bug in deeplyInstantiate

This resulted in an infinite loop in applyTypeToArgs, in syb
---

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index c1801d6..cee4b89 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -143,7 +143,7 @@ deeplySkolemise
 
 deeplySkolemise skol_info ty
   | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty
-  = do { ids1 <- newSysLocalIds (fsLit "dsk") arg_tys
+  = do { ids1 <- newSysLocalIds (fsLit "dk") arg_tys
        ; tvs1 <- mapM (tcInstSkolTyVar skol_info) tvs
        ; let subst = zipTopTvSubst tvs (mkTyVarTys tvs1)
        ; ev_vars1 <- newEvVars (substTheta subst theta)
@@ -170,14 +170,14 @@ deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
 deeplyInstantiate orig ty
   | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty
   = do { (_, tys, subst) <- tcInstTyVars tvs
-       ; ids1  <- newSysLocalIds (fsLit "dsk") (substTys subst arg_tys)
+       ; ids1  <- newSysLocalIds (fsLit "di") (substTys subst arg_tys)
        ; wrap1 <- instCall orig tys (substTheta subst theta)
-       ; (wrap2, rho) <- deeplyInstantiate orig (substTy subst rho)
+       ; (wrap2, rho2) <- deeplyInstantiate orig (substTy subst rho)
        ; return (mkWpLams ids1 
+                    <.> wrap2
                     <.> wrap1 
-                    <.> mkWpEvVarApps ids1
-                    <.> wrap2,
-                 mkFunTys arg_tys rho) }
+                    <.> mkWpEvVarApps ids1,
+                 mkFunTys arg_tys rho2) }
 
   | otherwise = return (idHsWrapper, ty)
 \end{code}