X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=e058a6fd1e4383ae1bff38c06f6d34118a2e41e3;hp=2b9838bcc7ed3421608f69bebaddcee1329e9486;hb=debb7b80e707c343a3a7d8993ffab19b83e5c52b;hpb=cd2f5397bc1345fc37706168c268a8bd37af7f2f

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 2b9838b..e058a6f 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -412,16 +412,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 +619,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 +635,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