X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FClass.lhs;h=adfbe516f2bb17d98ef985bf6bb5f2cc7501f984;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=e5db71fc2ff82e31d727b4105804165faf7e1915;hpb=a77abe6a30ea2763cfa1c0ca83cdce9b7200ced2;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs
index e5db71f..adfbe51 100644
--- a/ghc/compiler/types/Class.lhs
+++ b/ghc/compiler/types/Class.lhs
@@ -7,7 +7,7 @@
 #include "HsVersions.h"
 
 module Class (
-	GenClass(..), Class(..),
+	GenClass(..), SYN_IE(Class),
 
 	mkClass,
 	classKey, classOps, classSelIds,
@@ -16,29 +16,32 @@ module Class (
 	isSuperClassOf,
 	classOpTagByString,
 
-	derivableClassKeys, cCallishClassKeys,
+	derivableClassKeys, needsDataDeclCtxtClassKeys,
+	cCallishClassKeys, isNoDictClass,
 	isNumericClass, isStandardClass, isCcallishClass,
 
-	GenClassOp(..), ClassOp(..),
+	GenClassOp(..), SYN_IE(ClassOp),
 	mkClassOp,
 	classOpTag, classOpString,
 	classOpLocalType,
 
-	ClassInstEnv(..)
+	SYN_IE(ClassInstEnv)
     ) where
 
 CHK_Ubiq() -- debugging consistency check
 
-import TyLoop
+IMPORT_DELOOPER(TyLoop)
 
 import TyCon		( TyCon )
-import TyVar		( TyVar(..), GenTyVar )
-import Usage		( GenUsage, Usage(..), UVar(..) )
+import TyVar		( SYN_IE(TyVar), GenTyVar )
+import Usage		( GenUsage, SYN_IE(Usage), SYN_IE(UVar) )
 
-import Maybes		( assocMaybe, Maybe )
+import MatchEnv		( MatchEnv )
+import Maybes		( assocMaybe )
+import Name		( changeUnique, Name )
 import Unique		-- Keys for built-in classes
-import Pretty		( Pretty(..), ppCat{-ToDo:rm-}, ppPStr{-ditto-} )
-import PprStyle		( PprStyle )
+import Pretty		( SYN_IE(Pretty), ppCat, ppPStr )
+--import PprStyle		( PprStyle )
 import SrcLoc		( SrcLoc )
 import Util
 \end{code}
@@ -117,7 +120,7 @@ mkClass :: Unique -> Name -> TyVar
 
 mkClass uniq full_name tyvar super_classes superdict_sels
 	class_ops dict_sels defms class_insts
-  = Class uniq full_name tyvar
+  = Class uniq (changeUnique full_name uniq) tyvar
 		super_classes superdict_sels
 		class_ops dict_sels defms
 		class_insts
@@ -190,25 +193,33 @@ isNumericClass   (Class key _ _ _ _ _ _ _ _ _) = --pprTrace "isNum:" (ppCat (map
 						 key `is_elem` numericClassKeys
 isStandardClass  (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` standardClassKeys
 isCcallishClass	 (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` cCallishClassKeys
+isNoDictClass    (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` noDictClassKeys
 is_elem = isIn "is_X_Class"
 
 numericClassKeys
-  = [ numClassKey,
-      realClassKey,
-      integralClassKey,
-      fractionalClassKey,
-      floatingClassKey,
-      realFracClassKey,
-      realFloatClassKey ]
+  = [ numClassKey
+    , realClassKey
+    , integralClassKey
+    , fractionalClassKey
+    , floatingClassKey
+    , realFracClassKey
+    , realFloatClassKey
+    ]
 
 derivableClassKeys
-  = [ eqClassKey,
-      showClassKey,
-      ordClassKey,
-      boundedClassKey,
-      enumClassKey,
-      ixClassKey,
-      readClassKey ]
+  = [ eqClassKey
+    , ordClassKey
+    , enumClassKey
+    , evalClassKey
+    , boundedClassKey
+    , showClassKey
+    , readClassKey
+    , ixClassKey
+    ]
+
+needsDataDeclCtxtClassKeys -- see comments in TcDeriv
+  = [ readClassKey
+    ]
 
 cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
 
@@ -221,6 +232,16 @@ standardClassKeys
     --	    _ccall_ foo ... 93{-numeric literal-} ...
     --
     -- ... it can do The Right Thing on the 93.
+
+noDictClassKeys 	-- These classes are used only for type annotations;
+			-- they are not implemented by dictionaries, ever.
+  = cCallishClassKeys
+	-- I used to think that class Eval belonged in here, but
+	-- we really want functions with type (Eval a => ...) and that
+	-- means that we really want to pass a placeholder for an Eval
+	-- dictionary.  The unit tuple is what we'll get if we leave things
+	-- alone, and that'll do for now.  Could arrange to drop that parameter
+	-- in the end.
 \end{code}
 
 %************************************************************************
@@ -233,8 +254,7 @@ We compare @Classes@ by their keys (which include @Uniques@).
 
 \begin{code}
 instance Ord3 (GenClass tyvar uvar) where
-  cmp (Class k1 _ _ _ _ _ _ _ _ _) (Class k2 _ _ _ _ _ _ _ _ _)
-    = cmp k1 k2
+  cmp (Class k1 _ _ _ _ _ _ _ _ _) (Class k2 _ _ _ _ _ _ _ _ _)  = cmp k1 k2
 
 instance Eq (GenClass tyvar uvar) where
     (Class k1 _ _ _ _ _ _ _ _ _) == (Class k2 _ _ _ _ _ _ _ _ _) = k1 == k2