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