[project @ 1996-07-19 18:36:04 by partain]

[ghc-hetmet.git] / ghc / compiler / types / Class.lhs

diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs
index e5db71f..adfbe51 100644 (file)
--- 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