ghc/compiler/types/Class.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[Class]{The @Class@ datatype}
   5
   6 \begin{code}
   7 module Class (
   8         Class, ClassOpItem, ClassPred, ClassContext, FunDep,
   9         DefMeth (..),
  10
  11         mkClass, classTyVars, classArity,
  12         classKey, className, classSelIds, classTyCon,
  13         classBigSig, classExtraBigSig, classTvsFds
  14     ) where
  15
  16 #include "HsVersions.h"
  17
  18 import {-# SOURCE #-} TyCon     ( TyCon )
  19 import {-# SOURCE #-} TypeRep   ( Type )
  20
  21 import Var              ( Id, TyVar )
  22 import Name             ( NamedThing(..), Name )
  23 import BasicTypes       ( Arity )
  24 import Unique           ( Unique, Uniquable(..) )
  25 import Outputable
  26 \end{code}
  27
  28 %************************************************************************
  29 %*                                                                      *
  30 \subsection[Class-basic]{@Class@: basic definition}
  31 %*                                                                      *
  32 %************************************************************************
  33
  34 A @Class@ corresponds to a Greek kappa in the static semantics:
  35
  36 \begin{code}
  37 data Class
  38   = Class {
  39         classKey  :: Unique,                    -- Key for fast comparison
  40         className :: Name,
  41
  42         classTyVars  :: [TyVar],                -- The class type variables
  43         classFunDeps :: [FunDep TyVar],         -- The functional dependencies
  44
  45         classSCTheta :: [(Class,[Type])],       -- Immediate superclasses, and the
  46         classSCSels  :: [Id],                   -- corresponding selector functions to
  47                                                 -- extract them from a dictionary of this
  48                                                 -- class
  49
  50         classOpStuff :: [ClassOpItem],          -- Ordered by tag
  51
  52         classTyCon :: TyCon             -- The data type constructor for dictionaries
  53   }                                     -- of this class
  54
  55 type ClassPred    = (Class, [Type])
  56 type ClassContext = [ClassPred]
  57
  58 type FunDep a     = ([a],[a])   --  e.g. class C a b c |  a b -> c, a c -> b  where ...
  59                                 --  Here fun-deps are [([a,b],[c]), ([a,c],[b])]
  60
  61 type ClassOpItem = (Id, DefMeth Id)
  62         -- Selector function; contains unfolding
  63         -- Default-method info
  64
  65 data DefMeth id = NoDefMeth             -- No default method
  66                 | DefMeth id            -- A polymorphic default method (named id)
  67                 | GenDefMeth            -- A generic default method
  68                 deriving Eq
  69 \end{code}
  70
  71 The @mkClass@ function fills in the indirect superclasses.
  72
  73 \begin{code}
  74 mkClass :: Name -> [TyVar]
  75         -> [([TyVar], [TyVar])]
  76         -> [(Class,[Type])] -> [Id]
  77         -> [ClassOpItem]
  78         -> TyCon
  79         -> Class
  80
  81 mkClass name tyvars fds super_classes superdict_sels
  82         op_stuff tycon
  83   = Class {     classKey = getUnique name,
  84                 className = name,
  85                 classTyVars = tyvars,
  86                 classFunDeps = fds,
  87                 classSCTheta = super_classes,
  88                 classSCSels = superdict_sels,
  89                 classOpStuff = op_stuff,
  90                 classTyCon = tycon }
  91 \end{code}
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[Class-selectors]{@Class@: simple selectors}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 The rest of these functions are just simple selectors.
 100
 101 \begin{code}
 102 classArity :: Class -> Arity
 103 classArity clas = length (classTyVars clas)
 104         -- Could memoise this
 105
 106 classSelIds (Class {classSCSels = sc_sels, classOpStuff = op_stuff})
 107   = sc_sels ++ [op_sel | (op_sel, _) <- op_stuff]
 108
 109 classTvsFds c
 110   = (classTyVars c, classFunDeps c)
 111
 112 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
 113                     classSCSels = sc_sels, classOpStuff = op_stuff})
 114   = (tyvars, sc_theta, sc_sels, op_stuff)
 115 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
 116                          classSCTheta = sc_theta, classSCSels = sc_sels,
 117                          classOpStuff = op_stuff})
 118   = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
 119 \end{code}
 120
 121
 122 %************************************************************************
 123 %*                                                                      *
 124 \subsection[Class-instances]{Instance declarations for @Class@}
 125 %*                                                                      *
 126 %************************************************************************
 127
 128 We compare @Classes@ by their keys (which include @Uniques@).
 129
 130 \begin{code}
 131 instance Eq Class where
 132     c1 == c2 = classKey c1 == classKey c2
 133     c1 /= c2 = classKey c1 /= classKey c2
 134
 135 instance Ord Class where
 136     c1 <= c2 = classKey c1 <= classKey c2
 137     c1 <  c2 = classKey c1 <  classKey c2
 138     c1 >= c2 = classKey c1 >= classKey c2
 139     c1 >  c2 = classKey c1 >  classKey c2
 140     compare c1 c2 = classKey c1 `compare` classKey c2
 141 \end{code}
 142
 143 \begin{code}
 144 instance Uniquable Class where
 145     getUnique c = classKey c
 146
 147 instance NamedThing Class where
 148     getName clas = className clas
 149
 150 instance Outputable Class where
 151     ppr c = ppr (getName c)
 152
 153 instance Show Class where
 154     showsPrec p c = showsPrecSDoc p (ppr c)
 155 \end{code}
 156
 157