%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[Class]{The @Class@ datatype}
+
+The @Class@ datatype
\begin{code}
module Class (
Class, ClassOpItem,
DefMeth (..),
- FunDep, pprFundeps,
+ FunDep, pprFundeps, pprFunDep,
mkClass, classTyVars, classArity,
- classKey, className, classSelIds, classTyCon, classMethods,
+ classKey, className, classATs, classSelIds, classTyCon, classMethods,
classBigSig, classExtraBigSig, classTvsFds, classSCTheta
) where
-#include "HsVersions.h"
-
import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} TypeRep ( PredType )
-import Var ( Id, TyVar )
-import Name ( NamedThing(..), Name )
-import BasicTypes ( Arity )
-import Unique ( Unique, Uniquable(..) )
+import Var
+import Name
+import BasicTypes
+import Unique
import Outputable
+import FastString
\end{code}
%************************************************************************
\begin{code}
data Class
= Class {
- classKey :: Unique, -- Key for fast comparison
+ classKey :: Unique, -- Key for fast comparison
className :: Name,
- classTyVars :: [TyVar], -- The class type variables
- classFunDeps :: [FunDep TyVar], -- The functional dependencies
+ classTyVars :: [TyVar], -- The class type variables
+ classFunDeps :: [FunDep TyVar], -- The functional dependencies
+
+ classSCTheta :: [PredType], -- Immediate superclasses, and the
+ classSCSels :: [Id], -- corresponding selector functions
+ -- to extract them from a dictionary
+ -- of this class
- classSCTheta :: [PredType], -- Immediate superclasses, and the
- classSCSels :: [Id], -- corresponding selector functions to
- -- extract them from a dictionary of this
- -- class
+ classATs :: [TyCon], -- Associated type families
- classOpStuff :: [ClassOpItem], -- Ordered by tag
+ classOpStuff :: [ClassOpItem], -- Ordered by tag
- classTyCon :: TyCon -- The data type constructor for dictionaries
- } -- of this class
+ classTyCon :: TyCon -- The data type constructor for
+ -- dictionaries of this class
+ }
-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 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)
-- Selector function; contains unfolding
mkClass :: Name -> [TyVar]
-> [([TyVar], [TyVar])]
-> [PredType] -> [Id]
+ -> [TyCon]
-> [ClassOpItem]
-> TyCon
-> Class
-mkClass name tyvars fds super_classes superdict_sels
+mkClass name tyvars fds super_classes superdict_sels ats
op_stuff tycon
= Class { classKey = getUnique name,
className = name,
classFunDeps = fds,
classSCTheta = super_classes,
classSCSels = superdict_sels,
+ classATs = ats,
classOpStuff = op_stuff,
classTyCon = tycon }
\end{code}
classMethods (Class {classOpStuff = op_stuff})
= [op_sel | (op_sel, _) <- op_stuff]
+classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
classTvsFds c
= (classTyVars c, classFunDeps c)
+classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])
classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
classSCSels = sc_sels, classOpStuff = op_stuff})
= (tyvars, sc_theta, sc_sels, op_stuff)
+
+classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [TyCon], [ClassOpItem])
classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
classSCTheta = sc_theta, classSCSels = sc_sels,
- classOpStuff = op_stuff})
- = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
+ classATs = ats, classOpStuff = op_stuff})
+ = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
\end{code}
pprFundeps :: Outputable a => [FunDep a] -> SDoc
pprFundeps [] = empty
-pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
- where
- ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"),
- interppSP vs]
+pprFundeps fds = hsep (ptext (sLit "|") : punctuate comma (map pprFunDep fds))
+
+pprFunDep :: Outputable a => FunDep a -> SDoc
+pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs]
\end{code}