X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=c31e6aaf0fba2e205d24fc8319814395a0d2fa74;hb=aa2c486e51caa0386aaff0d1b866a60316500b41;hp=472ce6b94d3942ba706c186acbff3ea569ba2a05;hpb=04e62d08f6681d1c456af9437073db0b3e7d045c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 472ce6b..c31e6aa 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -44,8 +44,8 @@ import TyCon		( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
 			  isEnumerationTyCon, isRecursiveTyCon, TyCon
 			)
 import TcType		( TcType, ThetaType, mkTyVarTys, mkTyConApp, tcTyConAppTyCon,
-			  isUnLiftedType, mkClassPred, tyVarsOfTypes, isArgTypeKind,
-			  tcEqTypes, tcSplitAppTys, mkAppTys )
+			  isUnLiftedType, mkClassPred, tyVarsOfType,
+			  isArgTypeKind, tcEqTypes, tcSplitAppTys, mkAppTys )
 import Var		( TyVar, tyVarKind, varName )
 import VarSet		( mkVarSet, subVarSet )
 import PrelNames
@@ -419,7 +419,8 @@ makeDerivEqns overlap_flag tycl_decls
 	args_to_drop   = drop n_args_to_keep rep_ty_args
  	args_to_keep   = take n_args_to_keep rep_ty_args
 
-	rep_tys  = tys ++ [mkAppTys rep_fn args_to_keep]
+	rep_fn'  = mkAppTys rep_fn args_to_keep
+	rep_tys  = tys ++ [rep_fn']
 	rep_pred = mkClassPred clas rep_tys
 		-- rep_pred is the representation dictionary, from where
 		-- we are gong to get all the methods for the newtype dictionary
@@ -494,7 +495,7 @@ makeDerivEqns overlap_flag tycl_decls
 	--	(b) the remaining type args mention 
 	--	    only the remaining type variables
 	eta_ok = (args_to_drop `tcEqTypes` mkTyVarTys tyvars_to_drop)
-	      && (tyVarsOfTypes args_to_keep `subVarSet` mkVarSet tyvars_to_keep) 
+	      && (tyVarsOfType rep_fn' `subVarSet` mkVarSet tyvars_to_keep) 
 
 	cant_derive_err = derivingThingErr clas tys tycon tyvars_to_keep
 				(vcat [ptext SLIT("even with cunning newtype deriving:"),