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, FunDep,
   9         DefMeth (..),
  10
  11         mkClass, classTyVars, classArity,
  12         classKey, className, classSelIds, classTyCon, classMethods,
  13         classBigSig, classExtraBigSig, classTvsFds, classSCTheta
  14     ) where
  15
  16 #include "HsVersions.h"
  17
  18 import {-# SOURCE #-} TyCon     ( TyCon )
  19 import {-# SOURCE #-} TypeRep   ( PredType )
  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 :: [PredType],             -- 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 FunDep a     = ([a],[a])   --  e.g. class C a b c |  a b -> c, a c -> b  where ...
  56                                 --  Here fun-deps are [([a,b],[c]), ([a,c],[b])]
  57
  58 type ClassOpItem = (Id, DefMeth)
  59         -- Selector function; contains unfolding
  60         -- Default-method info
  61
  62 data DefMeth = NoDefMeth                -- No default method
  63              | DefMeth                  -- A polymorphic default method
  64              | GenDefMeth               -- A generic default method
  65              deriving Eq
  66 \end{code}
  67
  68 The @mkClass@ function fills in the indirect superclasses.
  69
  70 \begin{code}
  71 mkClass :: Name -> [TyVar]
  72         -> [([TyVar], [TyVar])]
  73         -> [PredType] -> [Id]
  74         -> [ClassOpItem]
  75         -> TyCon
  76         -> Class
  77
  78 mkClass name tyvars fds super_classes superdict_sels
  79         op_stuff tycon
  80   = Class {     classKey = getUnique name,
  81                 className = name,
  82                 classTyVars = tyvars,
  83                 classFunDeps = fds,
  84                 classSCTheta = super_classes,
  85                 classSCSels = superdict_sels,
  86                 classOpStuff = op_stuff,
  87                 classTyCon = tycon }
  88 \end{code}
  89
  90 %************************************************************************
  91 %*                                                                      *
  92 \subsection[Class-selectors]{@Class@: simple selectors}
  93 %*                                                                      *
  94 %************************************************************************
  95
  96 The rest of these functions are just simple selectors.
  97
  98 \begin{code}
  99 classArity :: Class -> Arity
 100 classArity clas = length (classTyVars clas)
 101         -- Could memoise this
 102
 103 classSelIds :: Class -> [Id]
 104 classSelIds c@(Class {classSCSels = sc_sels})
 105   = sc_sels ++ classMethods c
 106
 107 classMethods :: Class -> [Id]
 108 classMethods (Class {classOpStuff = op_stuff})
 109   = [op_sel | (op_sel, _) <- op_stuff]
 110
 111 classTvsFds c
 112   = (classTyVars c, classFunDeps c)
 113
 114 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
 115                     classSCSels = sc_sels, classOpStuff = op_stuff})
 116   = (tyvars, sc_theta, sc_sels, op_stuff)
 117 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
 118                          classSCTheta = sc_theta, classSCSels = sc_sels,
 119                          classOpStuff = op_stuff})
 120   = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
 121 \end{code}
 122
 123
 124 %************************************************************************
 125 %*                                                                      *
 126 \subsection[Class-instances]{Instance declarations for @Class@}
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 We compare @Classes@ by their keys (which include @Uniques@).
 131
 132 \begin{code}
 133 instance Eq Class where
 134     c1 == c2 = classKey c1 == classKey c2
 135     c1 /= c2 = classKey c1 /= classKey c2
 136
 137 instance Ord Class where
 138     c1 <= c2 = classKey c1 <= classKey c2
 139     c1 <  c2 = classKey c1 <  classKey c2
 140     c1 >= c2 = classKey c1 >= classKey c2
 141     c1 >  c2 = classKey c1 >  classKey c2
 142     compare c1 c2 = classKey c1 `compare` classKey c2
 143 \end{code}
 144
 145 \begin{code}
 146 instance Uniquable Class where
 147     getUnique c = classKey c
 148
 149 instance NamedThing Class where
 150     getName clas = className clas
 151
 152 instance Outputable Class where
 153     ppr c = ppr (getName c)
 154
 155 instance Show Class where
 156     showsPrec p c = showsPrecSDoc p (ppr c)
 157
 158 instance Outputable DefMeth where
 159     ppr DefMeth     =  text "{- has default method -}"
 160     ppr GenDefMeth  =  text "{- has generic method -}"
 161     ppr NoDefMeth   =  empty   -- No default method
 162 \end{code}
 163
 164