Adapt TcRnDriver to moved tyThingToIfaceDecl

[ghc-hetmet.git] / compiler / typecheck / TcDeriv.lhs

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 22168fc..0a8a498 100644 (file)
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -31,10 +31,10 @@ import RnEnv                ( bindLocalNames )
 import HscTypes                ( FixityEnv )
 
 import Class           ( className, classArity, classKey, classTyVars, classSCTheta, Class )
-import Type            ( zipOpenTvSubst, substTheta, pprThetaArrow, pprClassPred )
+import Type            ( zipOpenTvSubst, substTheta, pprThetaArrow, pprClassPred, mkTyVarTy )
 import ErrUtils                ( dumpIfSet_dyn )
 import MkId            ( mkDictFunId )
-import DataCon         ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
+import DataCon         ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys, dataConInstOrigArgTys )
 import Maybes          ( catMaybes )
 import RdrName         ( RdrName )
 import Name            ( Name, getSrcLoc )
@@ -350,6 +350,10 @@ makeDerivEqns overlap_flag tycl_decls
         mk_eqn_help gla_exts new_or_data tycon deriv_tvs clas tys
 
     ------------------------------------------------------------------
+    -- data/newtype T a = ... deriving( C t1 t2 )
+    --   leads to a call to mk_eqn_help with
+    --         tycon = T, deriv_tvs = ftv(t1,t2), clas = C, tys = [t1,t2]
+
     mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys
       | Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
       = bale_out (derivingThingErr clas tys tycon (tyConTyVars tycon) err)
@@ -434,7 +438,7 @@ makeDerivEqns overlap_flag tycl_decls
                -- We must pass the superclasses; the newtype might be an instance
                -- of them in a different way than the representation type
                -- E.g.         newtype Foo a = Foo a deriving( Show, Num, Eq )
-               -- Then the Show instance is not done via isomprphism; it shows
+               -- Then the Show instance is not done via isomorphism; it shows
                --      Foo 3 as "Foo 3"
                -- The Num instance is derived via isomorphism, but the Show superclass
                -- dictionary must the Show instance for Foo, *not* the Show dictionary
@@ -568,7 +572,7 @@ mkDataTypeEqn tycon clas
     ordinary_constraints
       = [ mkClassPred clas [arg_ty] 
         | data_con <- tyConDataCons tycon,
-          arg_ty   <- dataConOrigArgTys data_con,
+          arg_ty <- dataConInstOrigArgTys data_con (map mkTyVarTy (tyConTyVars tycon)),
           not (isUnLiftedType arg_ty)  -- No constraints for unlifted types?
         ]
 
@@ -952,7 +956,7 @@ genTaggeryBinds infos
 \begin{code}
 derivingThingErr clas tys tycon tyvars why
   = sep [hsep [ptext SLIT("Can't make a derived instance of"), quotes (ppr pred)],
-        parens why]
+        nest 2 (parens why)]
   where
     pred = mkClassPred clas (tys ++ [mkTyConApp tycon (mkTyVarTys tyvars)])