X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FClass.lhs;h=e7bda631767b775503e30d9de093a16715df8650;hb=0e73a9fbdc8555ffb948cfd72401a700b122c395;hp=4e134d40068e5c3b871c564a3b28e4706d0081b9;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index 4e134d4..e7bda63 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -6,26 +6,17 @@ The @Class@ datatype \begin{code} -{-# OPTIONS_GHC -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/WorkingConventions#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" - import {-# SOURCE #-} TyCon ( TyCon ) import {-# SOURCE #-} TypeRep ( PredType ) @@ -34,6 +25,7 @@ import Name import BasicTypes import Unique import Outputable +import FastString \end{code} %************************************************************************ @@ -124,12 +116,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 +174,9 @@ 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] \end{code}