\begin{code}
module Class (
- Class,
+ Class, ClassOpItem,
- mkClass,
+ mkClass, classTyVars,
classKey, classSelIds, classTyCon,
- classSuperClassTheta,
- classBigSig, classInstEnv,
-
- ClassInstEnv
+ classBigSig, classExtraBigSig, classInstEnv, classTvsFds
) where
#include "HsVersions.h"
import {-# SOURCE #-} TyCon ( TyCon )
-import {-# SOURCE #-} Type ( Type )
-import {-# SOURCE #-} SpecEnv ( SpecEnv )
+import {-# SOURCE #-} TypeRep ( Type )
+import {-# SOURCE #-} InstEnv ( InstEnv )
import Var ( Id, TyVar )
import Name ( NamedThing(..), Name )
\begin{code}
data Class
- = Class
- Unique -- Key for fast comparison
- Name
-
- [TyVar] -- The class type variables
+ = Class {
+ classKey :: Unique, -- Key for fast comparison
+ className :: Name,
+
+ classTyVars :: [TyVar], -- The class type variables
+ classFunDeps :: [([TyVar], [TyVar])], -- The functional dependencies
- [(Class,[Type])] -- Immediate superclasses, and the
- [Id] -- corresponding selector functions to
- -- extract them from a dictionary of this
- -- class
+ classSCTheta :: [(Class,[Type])], -- Immediate superclasses, and the
+ classSCSels :: [Id], -- corresponding selector functions to
+ -- extract them from a dictionary of this
+ -- class
- [Id] -- * selector functions
- [Maybe Id] -- * default methods
- -- They are all ordered by tag. The
- -- selector ids contain unfoldings.
+ classOpStuff :: [ClassOpItem], -- Ordered by tag
- ClassInstEnv -- All the instances of this class
+ classInstEnv :: InstEnv, -- All the instances of this class
- TyCon -- The data type constructor for dictionaries
- -- of this class
+ classTyCon :: TyCon -- The data type constructor for dictionaries
+ } -- of this class
-type ClassInstEnv = SpecEnv Id -- The Ids are dfuns
+type ClassOpItem = (Id, -- Selector function; contains unfolding
+ Id, -- Default methods
+ Bool) -- True <=> an explicit default method was
+ -- supplied in the class decl
\end{code}
The @mkClass@ function fills in the indirect superclasses.
\begin{code}
mkClass :: Name -> [TyVar]
+ -> [([TyVar], [TyVar])]
-> [(Class,[Type])] -> [Id]
- -> [Id] -> [Maybe Id]
+ -> [(Id, Id, Bool)]
-> TyCon
- -> ClassInstEnv
+ -> InstEnv
-> Class
-mkClass name tyvars super_classes superdict_sels
- dict_sels defms tycon class_insts
- = Class (getUnique name) name tyvars
- super_classes superdict_sels
- dict_sels defms
- class_insts
- tycon
+mkClass name tyvars fds super_classes superdict_sels
+ op_stuff tycon class_insts
+ = Class { classKey = getUnique name,
+ className = name,
+ classTyVars = tyvars,
+ classFunDeps = fds,
+ classSCTheta = super_classes,
+ classSCSels = superdict_sels,
+ classOpStuff = op_stuff,
+ classInstEnv = class_insts,
+ classTyCon = tycon }
\end{code}
%************************************************************************
The rest of these functions are just simple selectors.
\begin{code}
-classKey (Class key _ _ _ _ _ _ _ _) = key
-classSuperClassTheta (Class _ _ _ scs _ _ _ _ _) = scs
-classSelIds (Class _ _ _ _ _ sels _ _ _) = sels
-classTyCon (Class _ _ _ _ _ _ _ _ tc) = tc
-classInstEnv (Class _ _ _ _ _ _ _ env _) = env
-
-classBigSig (Class _ _ tyvars super_classes sdsels sels defms _ _)
- = (tyvars, super_classes, sdsels, sels, defms)
+classSelIds (Class {classSCSels = sc_sels, classOpStuff = op_stuff})
+ = sc_sels ++ [op_sel | (op_sel, _, _) <- op_stuff]
+
+classTvsFds c
+ = (classTyVars c, classFunDeps c)
+
+classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
+ classSCSels = sc_sels, classOpStuff = op_stuff})
+ = (tyvars, sc_theta, sc_sels, op_stuff)
+classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
+ classSCTheta = sc_theta, classSCSels = sc_sels,
+ classOpStuff = op_stuff})
+ = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
\end{code}
getUnique c = classKey c
instance NamedThing Class where
- getName (Class _ n _ _ _ _ _ _ _) = n
+ getName clas = className clas
instance Outputable Class where
ppr c = ppr (getName c)