X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=72b99c5f7021b90834e783a8981d329699e3658a;hb=6ddfe9b18d4d280676aab2fa797ddbe6f8a09d6b;hp=2988f08a38f76aa6718907368a9d29788a2bd3c3;hpb=03edcb58482b016a8ee019a06e114c8e8c996400;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 2988f08..72b99c5 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1282,7 +1282,7 @@ inferInstanceContexts oflag infer_specs
     gen_soln (DS { ds_loc = loc, ds_orig = orig, ds_tvs = tyvars 
 		 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
       = setSrcSpan loc	$
-	addErrCtxt (derivInstCtxt clas inst_tys) $ 
+	addErrCtxt (derivInstCtxt the_pred) $ 
 	do {      -- Check for a bizarre corner case, when the derived instance decl should
 		  -- have form 	instance C a b => D (T a) where ...
 		  -- Note that 'b' isn't a parameter of T.  This gives rise to all sorts
@@ -1294,10 +1294,10 @@ inferInstanceContexts oflag infer_specs
 		  
  	   ; let tv_set = mkVarSet tyvars
 	         weird_preds = [pred | pred <- deriv_rhs
-                                     , not (tyVarsOfPred pred `subVarSet` tv_set)]  
+                                     , not (tyVarsOfPred pred `subVarSet` tv_set)]
 	   ; mapM_ (addErrTc . badDerivedPred) weird_preds	
 
-           ; theta <- simplifyDeriv orig tyvars deriv_rhs
+           ; theta <- simplifyDeriv orig the_pred tyvars deriv_rhs
 	   	-- checkValidInstance tyvars theta clas inst_tys
 		-- Not necessary; see Note [Exotic derived instance contexts]
 		-- 		  in TcSimplify
@@ -1307,6 +1307,8 @@ inferInstanceContexts oflag infer_specs
 		-- Hence no need to call:
 		--   checkValidInstance tyvars theta clas inst_tys
 	   ; return (sortLe (<=) theta) }	-- Canonicalise before returning the solution
+      where
+        the_pred = mkClassPred clas inst_tys
 
 ------------------------------------------------------------------
 mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
@@ -1423,14 +1425,12 @@ genInst standalone_deriv oflag
   where
     inst_spec = mkInstance oflag theta spec
     co1 = case tyConFamilyCoercion_maybe rep_tycon of
-	      Just co_con -> ACo (mkTyConApp co_con rep_tc_args)
+              Just co_con -> mkAxInstCo co_con rep_tc_args
     	      Nothing     -> id_co
 	      -- Not a family => rep_tycon = main tycon
-    co2 = case newTyConCo_maybe rep_tycon of
-	      Just co_con -> ACo (mkTyConApp co_con rep_tc_args)
-              Nothing     -> id_co  -- The newtype is transparent; no need for a cast
-    co = co1 `mkTransCoI` co2
-    id_co = IdCo (mkTyConApp rep_tycon rep_tc_args)
+    co2 = mkAxInstCo (newTyConCo rep_tycon) rep_tc_args
+    co  = co1 `mkTransCo` co2
+    id_co = mkReflCo (mkTyConApp rep_tycon rep_tc_args)
 
 -- Example: newtype instance N [a] = N1 (Tree a) 
 --          deriving instance Eq b => Eq (N [(b,b)])
@@ -1511,9 +1511,9 @@ standaloneCtxt :: LHsType Name -> SDoc
 standaloneCtxt ty = hang (ptext (sLit "In the stand-alone deriving instance for")) 
 		       2 (quotes (ppr ty))
 
-derivInstCtxt :: Class -> [Type] -> Message
-derivInstCtxt clas inst_tys
-  = ptext (sLit "When deriving the instance for") <+> parens (pprClassPred clas inst_tys)
+derivInstCtxt :: PredType -> Message
+derivInstCtxt pred
+  = ptext (sLit "When deriving the instance for") <+> parens (ppr pred)
 
 badDerivedPred :: PredType -> Message
 badDerivedPred pred