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