X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FClass.lhs;h=29ce00cfbc389a650b420bb3a8ac964214bb6a28;hb=34429d31b0d48352e4ffd29186e919b6248cdd5c;hp=fb6b901cf300c8f32cf35fee5422329605d321ff;hpb=c76c69c5b62f1ca4fa52d75b0dfbd37b7eddbb09;p=ghc-hetmet.git diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index fb6b901..29ce00c 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -1,9 +1,18 @@ % +% (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} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module Class ( Class, ClassOpItem, DefMeth (..), @@ -11,7 +20,7 @@ module Class ( FunDep, pprFundeps, mkClass, classTyVars, classArity, - classKey, className, classSelIds, classTyCon, classMethods, + classKey, className, classATs, classSelIds, classTyCon, classMethods, classBigSig, classExtraBigSig, classTvsFds, classSCTheta ) where @@ -20,10 +29,10 @@ module Class ( 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 \end{code} @@ -38,24 +47,27 @@ A @Class@ corresponds to a Greek kappa in the static semantics: \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 @@ -73,11 +85,12 @@ The @mkClass@ function fills in the indirect superclasses. 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, @@ -85,6 +98,7 @@ mkClass name tyvars fds super_classes superdict_sels classFunDeps = fds, classSCTheta = super_classes, classSCSels = superdict_sels, + classATs = ats, classOpStuff = op_stuff, classTyCon = tycon } \end{code} @@ -118,8 +132,8 @@ classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta, = (tyvars, sc_theta, sc_sels, op_stuff) 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}