X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=479bd670be57296dd9ee7dd03c1c7e7f42887b3e;hb=ee2571bd2a80683d33cf65a01942bc8be50a5e33;hp=c35e2d64b2feff238af48adeb1c2399a80cff567;hpb=aa0c0de94e25aa64139688f8e4c4ba51ddca6f54;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index c35e2d6..479bd67 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -600,9 +600,10 @@ tc_inst_decl2 :: Id -> InstBindings Name -> TcM (LHsBinds Id)
 -- see Note [Newtype deriving superclasses] in TcDeriv.lhs
 
 tc_inst_decl2 dfun_id (NewTypeDerived coi)
-  = do  { let rigid_info   = InstSkol
-              origin       = SigOrigin rigid_info
-              inst_ty      = idType dfun_id
+  = do  { let rigid_info = InstSkol
+              origin     = SigOrigin rigid_info
+              inst_ty    = idType dfun_id
+	      inst_tvs   = fst (tcSplitForAllTys inst_ty)
         ; (inst_tvs', theta, inst_head_ty) <- tcSkolSigType rigid_info inst_ty
                 -- inst_head_ty is a PredType
 
@@ -615,7 +616,13 @@ tc_inst_decl2 dfun_id (NewTypeDerived coi)
               (rep_ty, wrapper) 
 	         = case coi of
 	      	     IdCo   -> (last_ty, idHsWrapper)
-		     ACo co -> (snd (coercionKind co), WpCast (mk_full_coercion co))
+		     ACo co -> (snd (coercionKind co'), WpCast (mk_full_coercion co'))
+			    where
+			       co' = substTyWith inst_tvs (mkTyVarTys inst_tvs') co
+				-- NB: the free variable of coi are bound by the
+				-- universally quantified variables of the dfun_id
+				-- This is weird, and maybe we should make NewTypeDerived
+				-- carry a type-variable list too; but it works fine
 
 		 -----------------------
 		 --        mk_full_coercion
@@ -736,7 +743,7 @@ tc_inst_decl2 dfun_id (VanillaInst monobinds uprags standalone_deriv)
 	     			 this_dict dfun_id
                              	 prag_fn monobinds
        ; (meth_exprs, meth_binds) <- tcExtendTyVarEnv inst_tyvars'  $
-				mapAndUnzipM tc_meth op_items 
+				     mapAndUnzipM tc_meth op_items 
 
          -- Figure out bindings for the superclass context
          -- Don't include this_dict in the 'givens', else