X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=5d1e63ae0e6f4f38ba1e76e94036568e62aeab21;hp=7b2ca5888883ccaca8254413f667ffce9165613c;hb=6d2b0ae3ae3296cb6cdd496cbf85b897c7ce150b;hpb=bbd67a5f4f3515ea5c37711815b2f6ad58cbd655

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 7b2ca58..5d1e63a 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -688,23 +688,16 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = VanillaInst monobinds uprags })
     returnM (unitBag main_bind)
 
 mkCoVars :: [PredType] -> TcM [TyVar]
-mkCoVars [] = return []
-mkCoVars (pred:preds) = 
-	do { uniq <- newUnique
-	   ; let name = mkSysTvName uniq FSLIT("mkCoVars")
-	   ; let tv = mkCoVar name (PredTy pred)
-	   ; tvs <- mkCoVars preds
-	   ; return (tv:tvs)
-	   }
+mkCoVars = newCoVars . map unEqPred
+  where
+    unEqPred (EqPred ty1 ty2) = (ty1, ty2)
+    unEqPred _                = panic "TcInstDcls.mkCoVars"
 
 mkMetaCoVars :: [PredType] -> TcM [TyVar]
-mkMetaCoVars [] = return []
-mkMetaCoVars (EqPred ty1 ty2:preds) = 
-	do { tv <- newMetaTyVar TauTv (mkCoKind ty1 ty2) 	  
-	   ; tvs <- mkMetaCoVars preds
-	   ; return (tv:tvs)
-	   }
-
+mkMetaCoVars = mappM eqPredToCoVar
+  where
+    eqPredToCoVar (EqPred ty1 ty2) = newMetaCoVar ty1 ty2
+    eqPredToCoVar _                = panic "TcInstDcls.mkMetaCoVars"
 
 tcMethods origin clas inst_tyvars' dfun_theta' inst_tys' 
 	  avail_insts op_items monobinds uprags