X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcClassDcl.lhs;h=30dfc7c5e72f919ee1e6793d9ccf50a4b5d61e14;hp=25795cef9a6fe3243600f964da8d92a1ee37dea3;hb=49c98d143c382a1341e1046f5ca00819a25691ba;hpb=15cb792d18b1094e98c035dca6ecec5dad516056

diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index 25795ce..30dfc7c 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -1,72 +1,61 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[TcClassDcl]{Typechecking class declarations}
+
+Typechecking class declarations
 
 \begin{code}
 module TcClassDcl ( tcClassSigs, tcClassDecl2, 
 		    getGenericInstances, 
 		    MethodSpec, tcMethodBind, mkMethodBind, 
-		    tcAddDeclCtxt, badMethodErr
+		    tcAddDeclCtxt, badMethodErr, badATErr, omittedATWarn
 		  ) where
 
 #include "HsVersions.h"
 
 import HsSyn
-import RnHsSyn		( maybeGenericMatch, extractHsTyVars )
-import RnExpr		( rnLExpr )
-import RnEnv		( lookupTopBndrRn, lookupImportedName )
-import Inst		( instToId, newDictBndr, newDictBndrs, newMethod, getOverlapFlag )
-import InstEnv		( mkLocalInstance )
-import TcEnv		( tcLookupLocatedClass, 
-			  tcExtendTyVarEnv, tcExtendIdEnv,
-			  InstInfo(..), pprInstInfoDetails,
-			  simpleInstInfoTyCon, simpleInstInfoTy,
-			  InstBindings(..), newDFunName
-			)
-import TcBinds		( TcPragFun, tcMonoBinds, tcPrags, mkPragFun, TcSigInfo(..), 
-			  TcSigFun, mkTcSigFun )
-import TcHsType		( tcHsKindedType, tcHsSigType )
-import TcSimplify	( tcSimplifyCheck )
-import TcUnify		( checkSigTyVars, sigCtxt )
-import TcMType		( tcSkolSigTyVars )
-import TcType		( Type, SkolemInfo(ClsSkol, InstSkol), UserTypeCtxt( GenPatCtxt ),
-			  TcType, TcThetaType, TcTyVar, mkTyVarTys,
-			  mkClassPred, tcSplitSigmaTy, tcSplitFunTys,
-			  tcIsTyVarTy, tcSplitTyConApp_maybe, tcSplitForAllTys, tcSplitPhiTy,
-			  getClassPredTys_maybe, mkPhiTy, mkTyVarTy
-			)
+import RnHsSyn
+import RnExpr
+import RnEnv
+import Inst
+import InstEnv
+import TcEnv
+import TcBinds
+import TcHsType
+import TcSimplify
+import TcUnify
+import TcMType
+import TcType
 import TcRnMonad
-import Generics		( mkGenericRhs, validGenericInstanceType )
-import PrelInfo		( nO_METHOD_BINDING_ERROR_ID )
-import Class		( classTyVars, classBigSig, 
-			  Class, ClassOpItem, DefMeth (..) )
-import TyCon		( TyCon, tyConName, tyConHasGenerics )
-import Type		( substTyWith )
-import MkId		( mkDefaultMethodId, mkDictFunId )
-import Id		( Id, idType, idName, mkUserLocal )
-import Name		( Name, NamedThing(..) )
-import NameEnv		( NameEnv, lookupNameEnv, mkNameEnv )
-import NameSet		( nameSetToList )
-import OccName		( reportIfUnused, mkDefaultMethodOcc )
-import RdrName		( RdrName, mkDerivedRdrName )
+import Generics
+import PrelInfo
+import Class
+import TyCon
+import Type
+import MkId
+import Id
+import Name
+import NameEnv
+import NameSet
+import OccName
+import RdrName
 import Outputable
-import PrelNames	( genericTyConNames )
+import PrelNames
 import DynFlags
-import ErrUtils		( dumpIfSet_dyn )
-import Util		( count, lengthIs, isSingleton, lengthExceeds )
-import Unique		( Uniquable(..) )
-import ListSetOps	( equivClassesByUniq, minusList	)
-import SrcLoc		( Located(..), srcSpanStart, unLoc, noLoc )
-import Maybes		( seqMaybe, isJust, mapCatMaybes )
-import List		( partition )
-import BasicTypes	( RecFlag(..), Boxity(..) )
+import ErrUtils
+import Util
+import Unique
+import ListSetOps
+import SrcLoc
+import Maybes
+import List
+import BasicTypes
 import Bag
 import FastString
 \end{code}
 
 
-
 Dictionary handling
 ~~~~~~~~~~~~~~~~~~~
 Every class implicitly declares a new data type, corresponding to dictionaries
@@ -632,6 +621,8 @@ get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
 	--	f {| a+b |} ... = ...
 	--	f {| x+y |} ... = ...
 	-- Then at this point we'll have an InstInfo for each
+	--
+	-- The class should be unary, which is why simpleInstInfoTyCon should be ok
     let
 	tc_inst_infos :: [(TyCon, InstInfo)]
 	tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
@@ -739,8 +730,12 @@ tcAddDeclCtxt decl thing_inside
      thing = case decl of
 	   	ClassDecl {}		  -> "class"
 		TySynonym {}		  -> "type synonym"
-		TyData {tcdND = NewType}  -> "newtype"
-		TyData {tcdND = DataType} -> "data type"
+		TyFunction {}		  -> "type function signature"
+		TyData {tcdND = NewType}  -> "newtype" ++ maybeSig
+		TyData {tcdND = DataType} -> "data type" ++ maybeSig
+
+     maybeSig | isKindSigDecl decl = " signature"
+	      | otherwise	   = ""
 
      ctxt = hsep [ptext SLIT("In the"), text thing, 
 		  ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
@@ -755,9 +750,16 @@ badMethodErr clas op
   = hsep [ptext SLIT("Class"), quotes (ppr clas), 
 	  ptext SLIT("does not have a method"), quotes (ppr op)]
 
+badATErr clas at
+  = hsep [ptext SLIT("Class"), quotes (ppr clas), 
+	  ptext SLIT("does not have an associated type"), quotes (ppr at)]
+
 omittedMethodWarn sel_id
   = ptext SLIT("No explicit method nor default method for") <+> quotes (ppr sel_id)
 
+omittedATWarn at
+  = ptext SLIT("No explicit AT declaration for") <+> quotes (ppr at)
+
 badGenericInstance sel_id because
   = sep [ptext SLIT("Can't derive generic code for") <+> quotes (ppr sel_id),
 	 because]