DefMeth (..),
mkClass, classTyVars, classArity,
- classKey, className, classSelIds, classTyCon,
- classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
- classHasFDs
+ classKey, className, classSelIds, classTyCon, classMethods,
+ classBigSig, classExtraBigSig, classTvsFds, classSCTheta
) where
#include "HsVersions.h"
type FunDep a = ([a],[a]) -- e.g. class C a b c | a b -> c, a c -> b where ...
-- Here fun-deps are [([a,b],[c]), ([a,c],[b])]
-type ClassOpItem = (Id, DefMeth Id)
+type ClassOpItem = (Id, DefMeth)
-- Selector function; contains unfolding
-- Default-method info
-data DefMeth id = NoDefMeth -- No default method
- | DefMeth id -- A polymorphic default method (named id)
- | GenDefMeth -- A generic default method
- deriving Eq
+data DefMeth = NoDefMeth -- No default method
+ | DefMeth -- A polymorphic default method
+ | GenDefMeth -- A generic default method
+ deriving Eq
\end{code}
The @mkClass@ function fills in the indirect superclasses.
classArity clas = length (classTyVars clas)
-- Could memoise this
-classSelIds (Class {classSCSels = sc_sels, classOpStuff = op_stuff})
- = sc_sels ++ [op_sel | (op_sel, _) <- op_stuff]
+classSelIds :: Class -> [Id]
+classSelIds c@(Class {classSCSels = sc_sels})
+ = sc_sels ++ classMethods c
+
+classMethods :: Class -> [Id]
+classMethods (Class {classOpStuff = op_stuff})
+ = [op_sel | (op_sel, _) <- op_stuff]
classTvsFds c
= (classTyVars c, classFunDeps c)
classSCTheta = sc_theta, classSCSels = sc_sels,
classOpStuff = op_stuff})
= (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
-
-classHasFDs :: Class -> Bool
-classHasFDs (Class {classFunDeps = fundeps}) = not (null fundeps)
\end{code}
instance Show Class where
showsPrec p c = showsPrecSDoc p (ppr c)
+
+instance Outputable DefMeth where
+ ppr DefMeth = text "{- has default method -}"
+ ppr GenDefMeth = text "{- has generic method -}"
+ ppr NoDefMeth = empty -- No default method
\end{code}