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

diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs
index adfbe51..e7630b0 100644
--- a/ghc/compiler/types/Class.lhs
+++ b/ghc/compiler/types/Class.lhs
@@ -14,7 +14,7 @@ module Class (
 	classSuperDictSelId, classOpId, classDefaultMethodId,
 	classSig, classBigSig, classInstEnv,
 	isSuperClassOf,
-	classOpTagByString,
+	classOpTagByString, classOpTagByString_maybe,
 
 	derivableClassKeys, needsDataDeclCtxtClassKeys,
 	cCallishClassKeys, isNoDictClass,
@@ -331,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}
 
 %************************************************************************