[project @ 1996-07-25 20:43:49 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 2a38d47..e7630b0 100644 (file)
--- a/ghc/compiler/types/Class.lhs
+++ b/ghc/compiler/types/Class.lhs
@@ -7,25 +7,25 @@
 #include "HsVersions.h"
 
 module Class (
-       GenClass(..), Class(..),
+       GenClass(..), SYN_IE(Class),
 
        mkClass,
        classKey, classOps, classSelIds,
        classSuperDictSelId, classOpId, classDefaultMethodId,
        classSig, classBigSig, classInstEnv,
        isSuperClassOf,
-       classOpTagByString,
+       classOpTagByString, classOpTagByString_maybe,
 
        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
@@ -33,14 +33,15 @@ CHK_Ubiq() -- debugging consistency check
 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 Name            ( changeUnique )
+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}
@@ -330,17 +331,23 @@ classOpLocalType (ClassOp _ _ ty) = ty
 
 Rather unsavoury ways of getting ClassOp tags:
 \begin{code}
-classOpTagByString :: Class -> FAST_STRING -> Int
+classOpTagByString_maybe :: Class -> FAST_STRING -> Maybe Int
+classOpTagByString       :: Class -> FAST_STRING -> Int
 
 classOpTagByString clas op
+  = case (classOpTagByString_maybe clas op) of
+      Just tag -> tag
+#ifdef DEBUG
+      Nothing  -> pprPanic "classOpTagByString:" (ppCat (ppPStr op : map (ppPStr . classOpString) (classOps clas)))
+#endif
+
+classOpTagByString_maybe clas op
   = go (map classOpString (classOps clas)) 1
   where
+    go []     _   = Nothing
     go (n:ns) tag = if n == op
-                   then tag
+                   then Just tag
                    else go ns (tag+1)
-#ifdef DEBUG
-    go []     tag = pprPanic "classOpTagByString:" (ppCat (ppPStr op : map (ppPStr . classOpString) (classOps clas)))
-#endif
 \end{code}
 
 %************************************************************************