X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=529d62488ac50d348ddad62ec47119e69f4db678;hb=25bff7fe1a22edbafa188af8d844c67057fa5eb8;hp=2b9838bcc7ed3421608f69bebaddcee1329e9486;hpb=67ed735fab12c12a1d48878d7bda33588c67fb78;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 2b9838b..529d624 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -30,7 +30,6 @@ import TypeRep
 
 import TcErrors	( typeExtraInfoMsg, unifyCtxt )
 import TcMType
-import TcEnv
 import TcIface
 import TcRnMonad
 import TcType
@@ -412,16 +411,16 @@ checkConstraints skol_info free_tvs skol_tvs given thing_inside
 newImplication :: SkolemInfo -> TcTyVarSet -> [TcTyVar]
 	       -> [EvVar] -> TcM result
                -> TcM (TcEvBinds, WantedConstraints, result)
-newImplication skol_info free_tvs skol_tvs given thing_inside
+newImplication skol_info _free_tvs skol_tvs given thing_inside
   = ASSERT2( all isTcTyVar skol_tvs, ppr skol_tvs )
     ASSERT2( all isSkolemTyVar skol_tvs, ppr skol_tvs )
-    do { gbl_tvs  <- tcGetGlobalTyVars
-       ; free_tvs <- zonkTcTyVarsAndFV free_tvs
-       ; let untch = gbl_tvs `unionVarSet` free_tvs
+    do { --   gbl_tvs  <- tcGetGlobalTyVars
+         -- ; free_tvs <- zonkTcTyVarsAndFV free_tvs
+         -- ; let untch = gbl_tvs `unionVarSet` free_tvs
 
-       ; (result, wanted) <- getConstraints               $ 
-                             setUntouchables untch $
-                             thing_inside
+       ; ((result, untch), wanted) <- captureConstraints  $ 
+                                      captureUntouchables $
+                                      thing_inside
 
        ; if isEmptyBag wanted && not (hasEqualities given) 
        	    -- Optimisation : if there are no wanteds, and the givens
@@ -619,7 +618,6 @@ uType_np origin orig_ty1 orig_ty2
 
     go _ ty1 ty2
       | tcIsForAllTy ty1 || tcIsForAllTy ty2 
-{--      | isSigmaTy ty1 || isSigmaTy ty2 --} 
       = unifySigmaTy origin ty1 ty2
 
         -- Anything else fails
@@ -636,12 +634,11 @@ unifySigmaTy origin ty1 ty2
              in_scope = mkInScopeSet (mkVarSet skol_tvs)
              phi1     = substTy (mkTvSubst in_scope (zipTyEnv tvs1 tys)) body1
              phi2     = substTy (mkTvSubst in_scope (zipTyEnv tvs2 tys)) body2
-             untch = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
-
-       ; (coi, lie) <- getConstraints $ 
-                       setUntouchables untch $ 
-                       uType origin phi1 phi2
+--             untch = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
 
+       ; ((coi, _untch), lie) <- captureConstraints $ 
+                                 captureUntouchables $ 
+                       		 uType origin phi1 phi2
           -- Check for escape; e.g. (forall a. a->b) ~ (forall a. a->a)
        ; let bad_lie  = filterBag is_bad lie
              is_bad w = any (`elemVarSet` tyVarsOfWanted w) skol_tvs