projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[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
adfbe51
..
e7630b0
100644
(file)
--- 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,
classSuperDictSelId, classOpId, classDefaultMethodId,
classSig, classBigSig, classInstEnv,
isSuperClassOf,
- classOpTagByString,
+ classOpTagByString, classOpTagByString_maybe,
derivableClassKeys, needsDataDeclCtxtClassKeys,
cCallishClassKeys, isNoDictClass,
derivableClassKeys, needsDataDeclCtxtClassKeys,
cCallishClassKeys, isNoDictClass,
@@
-331,17
+331,23
@@
classOpLocalType (ClassOp _ _ ty) = ty
Rather unsavoury ways of getting ClassOp tags:
\begin{code}
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
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 (map classOpString (classOps clas)) 1
where
+ go [] _ = Nothing
go (n:ns) tag = if n == op
go (n:ns) tag = if n == op
- then tag
+ then Just tag
else go ns (tag+1)
else go ns (tag+1)
-#ifdef DEBUG
- go [] tag = pprPanic "classOpTagByString:" (ppCat (ppPStr op : map (ppPStr . classOpString) (classOps clas)))
-#endif
\end{code}
%************************************************************************
\end{code}
%************************************************************************