X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FClass.lhs;h=5e8a4d4bddd7c7a6f7a13fff43622349b04fa0d1;hp=29ce00cfbc389a650b420bb3a8ac964214bb6a28;hb=f278f0676579f67075033a4f9857715909c4b71e;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index 29ce00c..5e8a4d4 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -6,25 +6,18 @@ 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 (..), - FunDep, pprFundeps, + FunDep, pprFundeps, pprFunDep, mkClass, classTyVars, classArity, classKey, className, classATs, classSelIds, classTyCon, classMethods, classBigSig, classExtraBigSig, classTvsFds, classSCTheta ) where -#include "HsVersions.h" +#include "Typeable.h" import {-# SOURCE #-} TyCon ( TyCon ) import {-# SOURCE #-} TypeRep ( PredType ) @@ -33,7 +26,11 @@ import Var import Name import BasicTypes import Unique +import Util import Outputable +import FastString + +import qualified Data.Data as Data \end{code} %************************************************************************ @@ -124,12 +121,16 @@ classMethods :: Class -> [Id] classMethods (Class {classOpStuff = op_stuff}) = [op_sel | (op_sel, _) <- op_stuff] +classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) +classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem]) classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta, classSCSels = sc_sels, classOpStuff = op_stuff}) = (tyvars, sc_theta, sc_sels, op_stuff) + +classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [TyCon], [ClassOpItem]) classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps, classSCTheta = sc_theta, classSCSels = sc_sels, classATs = ats, classOpStuff = op_stuff}) @@ -178,9 +179,18 @@ instance Outputable DefMeth where pprFundeps :: Outputable a => [FunDep a] -> SDoc pprFundeps [] = empty -pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds)) - where - ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), - interppSP vs] +pprFundeps fds = hsep (ptext (sLit "|") : punctuate comma (map pprFunDep fds)) + +pprFunDep :: Outputable a => FunDep a -> SDoc +pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs] + +instance Data.Typeable Class where + typeOf _ = Data.mkTyConApp (Data.mkTyCon "Class") [] + +instance Data.Data Class where + -- don't traverse? + toConstr _ = abstractConstr "Class" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNoRepType "Class" \end{code}