import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding )
import Subst ( mkTopTyVarSubst, substTheta )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isDataTyCon )
-import Class ( Class, classBigSig, classTyCon )
+import Class ( Class, classBigSig, classTyCon, classTyVars, classSelIds )
import Var ( Id, TyVar )
import VarSet ( isEmptyVarSet )
import Const ( Con(..) )
where
sel_id = mkId name ty info
field_lbl = mkFieldLabel name ty tag
- tag = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id
+ tag = assoc "MkId.mkDictSelId" (classSelIds clas `zip` allFieldLabelTags) sel_id
info = mkIdInfo (RecordSelId field_lbl)
`setUnfoldingInfo` unfolding
unfolding = mkTopUnfolding rhs
- (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
+ tyvars = classTyVars clas
tycon = classTyCon clas
[data_con] = tyConDataCons tycon
mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
= mkVanillaId dfun_name dfun_ty
where
- (class_tyvars, sc_theta, _, _, _) = classBigSig clas
+ (class_tyvars, sc_theta, _, _) = classBigSig clas
sc_theta' = substTheta (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
dfun_theta = case inst_decl_theta of
SrcLoc
| ClassOpSig name -- Selector name
- (Maybe name) -- Default-method name (if any)
+ name -- Default-method name (if any)
+ Bool -- True <=> there is an explicit, programmer-supplied
+ -- default declaration in the class decl
(HsType name)
SrcLoc
= filter sig_for_me sigs
where
sig_for_me (Sig n _ _) = f n
- sig_for_me (ClassOpSig n _ _ _) = f n
+ sig_for_me (ClassOpSig n _ _ _ _) = f n
sig_for_me (SpecSig n _ _) = f n
sig_for_me (InlineSig n _ _) = f n
sig_for_me (NoInlineSig n _ _) = f n
isFixitySig _ = False
isClassOpSig :: Sig name -> Bool
-isClassOpSig (ClassOpSig _ _ _ _) = True
-isClassOpSig _ = False
+isClassOpSig (ClassOpSig _ _ _ _ _) = True
+isClassOpSig _ = False
isPragSig :: Sig name -> Bool
-- Identifies pragmas
ppr_sig (Sig var ty _)
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
-ppr_sig (ClassOpSig var _ ty _)
+ppr_sig (ClassOpSig var _ _ ty _)
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
ppr_sig (SpecSig var ty _)
count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs)
- sig_info (Sig _ _ _) = (1,0,0,0)
- sig_info (ClassOpSig _ _ _ _) = (0,1,0,0)
- sig_info (SpecSig _ _ _) = (0,0,1,0)
- sig_info (InlineSig _ _ _) = (0,0,0,1)
- sig_info (NoInlineSig _ _ _) = (0,0,0,1)
- sig_info _ = (0,0,0,0)
+ sig_info (Sig _ _ _) = (1,0,0,0)
+ sig_info (ClassOpSig _ _ _ _ _) = (0,1,0,0)
+ sig_info (SpecSig _ _ _) = (0,0,1,0)
+ sig_info (InlineSig _ _ _) = (0,0,0,1)
+ sig_info (NoInlineSig _ _ _) = (0,0,0,1)
+ sig_info _ = (0,0,0,0)
import_info (ImportDecl _ _ qual as spec _)
= add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
semi
]
where
- (clas_tyvars, sc_theta, _, sel_ids, defms) = classBigSig clas
+ (clas_tyvars, sc_theta, _, op_stuff) = classBigSig clas
- pp_ops | null sel_ids = empty
- | otherwise = hsep [ptext SLIT("where"),
- braces (hsep (punctuate semi (zipWith ppr_classop sel_ids defms)))
- ]
+ pp_ops | null op_stuff = empty
+ | otherwise = hsep [ptext SLIT("where"),
+ braces (hsep (punctuate semi (map ppr_classop op_stuff)))
+ ]
- ppr_classop sel_id maybe_defm
+ ppr_classop (sel_id, dm_id, explicit_dm)
= ASSERT( sel_tyvars == clas_tyvars)
hsep [ppr (getOccName sel_id),
- if maybeToBool maybe_defm then equals else empty,
+ if explicit_dm then equals else empty,
dcolon,
ppr op_ty
]
-- superclasses both called C!)
mkClassOpSig has_default_method op ty loc
- | not has_default_method = ClassOpSig op Nothing ty loc
- | otherwise = ClassOpSig op (Just dm_rn) ty loc
+ = ClassOpSig op dm_rn has_default_method ty loc
where
dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
\end{code}
cvInstDeclSig sig = sig
-cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var Nothing poly_ty src_loc
+cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var (panic "cvClassOpSig:dm_name")
+ (panic "cvClassOpSig:dm_present")
+ poly_ty src_loc
cvClassOpSig sig = sig
\end{code}
(map getTyVarName tvs)
`addOneToNameSet` cls
where
- get (ClassOpSig n _ ty _)
+ get (ClassOpSig n _ _ ty _)
| n `elemNameSet` source_fvs = extractHsTyNames ty
| otherwise = emptyFVs
(what_it_is, loc) = sig_doc sig
sig_doc (Sig _ _ loc) = (SLIT("type signature"),loc)
-sig_doc (ClassOpSig _ _ _ loc) = (SLIT("class-method type signature"), loc)
+sig_doc (ClassOpSig _ _ _ _ loc) = (SLIT("class-method type signature"), loc)
sig_doc (SpecSig _ _ loc) = (SLIT("SPECIALISE pragma"),loc)
sig_doc (InlineSig _ _ loc) = (SLIT("INLINE pragma"),loc)
sig_doc (NoInlineSig _ _ loc) = (SLIT("NOINLINE pragma"),loc)
getConFieldNames new_name [] = returnRn []
-getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
+getClassOpNames new_name (ClassOpSig op _ _ _ src_loc) = new_name op src_loc
\end{code}
@getDeclSysBinders@ gets the implicit binders introduced by a decl.
)
import NameSet
import RdrName ( RdrName, dummyRdrVarName, rdrNameOcc )
-import CmdLineOpts ( opt_D_dump_rn_trace, opt_IgnoreIfacePragmas, opt_HiMap )
+import CmdLineOpts ( opt_D_dump_rn_trace, opt_HiMap )
import PrelInfo ( builtinNames )
import TysWiredIn ( boolTyCon )
import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
`thenRn` \ (sigs', sig_fvs) ->
mapRn_ (unknownSigErr) non_sigs `thenRn_`
let
- binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
+ binders = mkNameSet [ nm | (ClassOpSig nm _ _ _ _) <- sigs' ]
in
renameSigs False binders lookupOccRn fix_sigs
`thenRn` \ (fixs', fix_fvs) ->
sig_doc = text "the signatures for class" <+> ppr cname
meth_doc = text "the default-methods for class" <+> ppr cname
- sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
+ sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ _ locn <- sigs]
meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
meth_rdr_names = map fst meth_rdr_names_w_locs
- rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
+ rn_op clas clas_tyvars sig@(ClassOpSig op dm_rdr_name explicit_dm ty locn)
= pushSrcLocRn locn $
lookupBndrRn op `thenRn` \ op_name ->
-- Make the default-method name
getModeRn `thenRn` \ mode ->
- (case (mode, maybe_dm) of
- (SourceMode, _)
- | op `elem` meth_rdr_names
- -> -- Source class decl with an explicit method decl
- newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn
- `thenRn` \ dm_name ->
- returnRn (Just dm_name, emptyFVs)
-
- | otherwise
- -> -- Source class dec, no explicit method decl
- returnRn (Nothing, emptyFVs)
-
- (InterfaceMode, Just dm_rdr_name)
+ (case mode of
+ SourceMode -> -- Source class decl
+ newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn `thenRn` \ dm_name ->
+ returnRn (dm_name, op `elem` meth_rdr_names, emptyFVs)
+
+ InterfaceMode
-> -- Imported class that has a default method decl
-- See comments with tname, snames, above
lookupImplicitOccRn dm_rdr_name `thenRn` \ dm_name ->
- returnRn (Just dm_name, unitFV dm_name)
- -- An imported class decl mentions, rather than defines,
- -- the default method, so we must arrange to pull it in
-
- (InterfaceMode, Nothing)
- -- Imported class with no default metho
- -> returnRn (Nothing, emptyFVs)
- ) `thenRn` \ (maybe_dm_name, dm_fvs) ->
+ returnRn (dm_name, explicit_dm, if explicit_dm then unitFV dm_name else emptyFVs)
+ -- An imported class decl for a class decl that had an explicit default
+ -- method, mentions, rather than defines,
+ -- the default method, so we must arrange to pull it in
+ ) `thenRn` \ (dm_name, final_explicit_dm, dm_fvs) ->
- returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs `plusFV` dm_fvs)
+ returnRn (ClassOpSig op_name dm_name final_explicit_dm new_ty locn, op_ty_fvs `plusFV` dm_fvs)
\end{code}
import PrelInfo ( nO_METHOD_BINDING_ERROR_ID )
import FieldLabel ( firstFieldLabelTag )
import Bag ( unionManyBags, bagToList )
-import Class ( mkClass, classBigSig, Class )
+import Class ( mkClass, classBigSig, classSelIds, Class, ClassOpItem )
import CmdLineOpts ( opt_GlasgowExts, opt_WarnMissingMethods )
import MkId ( mkDictSelId, mkDataConId, mkDefaultMethodId )
import DataCon ( mkDataCon, notMarkedStrict )
where
the_class_sigs = filter isClassOpSig class_sigs
- kc_sig (ClassOpSig _ _ op_ty loc) = tcAddSrcLoc loc (tcHsType op_ty)
+ kc_sig (ClassOpSig _ _ _ op_ty loc) = tcAddSrcLoc loc (tcHsType op_ty)
\end{code}
-- MAKE THE CLASS OBJECT ITSELF
let
- (op_tys, op_sel_ids, defm_ids) = unzip3 sig_stuff
+ (op_tys, op_items) = unzip sig_stuff
rec_class_inst_env = rec_inst_mapper rec_class
clas = mkClass class_name tyvars
- sc_theta sc_sel_ids op_sel_ids defm_ids
+ sc_theta sc_sel_ids op_items
tycon
rec_class_inst_env
-> [TyVar] -- The class type variable, used for error check only
-> RenamedClassOpSig
-> TcM s (Type, -- Type of the method
- Id, -- selector id
- Maybe Id) -- default-method ids
+ ClassOpItem) -- Selector Id, default-method Id, True if explicit default binding
+
tcClassSig rec_env rec_clas rec_clas_tyvars
- (ClassOpSig op_name maybe_dm_name
- op_ty
- src_loc)
+ (ClassOpSig op_name dm_name explicit_dm
+ op_ty src_loc)
= tcAddSrcLoc src_loc $
-- Check the type signature. NB that the envt *already has*
-- Build the selector id and default method id
sel_id = mkDictSelId op_name rec_clas global_ty
- maybe_dm_id = case maybe_dm_name of
- Nothing -> Nothing
- Just dm_name -> let
- dm_id = mkDefaultMethodId dm_name rec_clas global_ty
- in
- Just (tcAddImportedIdInfo rec_env dm_id)
+ dm_id = mkDefaultMethodId dm_name rec_clas global_ty
+ final_dm_id = tcAddImportedIdInfo rec_env dm_id
in
-- traceTc (text "tcClassSig done" <+> ppr op_name) `thenTc_`
- returnTc (local_ty, sel_id, maybe_dm_id)
+ returnTc (local_ty, (sel_id, final_dm_id, explicit_dm))
\end{code}
-- Get the relevant class
tcLookupClass class_name `thenNF_Tc` \ clas ->
let
- (tyvars, sc_theta, sc_sel_ids, op_sel_ids, defm_ids) = classBigSig clas
-
-- The selector binds are already in the selector Id's unfoldings
sel_binds = [ CoreMonoBind sel_id (unfoldingTemplate (getIdUnfolding sel_id))
- | sel_id <- sc_sel_ids ++ op_sel_ids
+ | sel_id <- classSelIds clas
]
in
-- Generate bindings for the default methods
tcDefaultMethodBinds clas default_binds sigs
= -- Check that the default bindings come from this class
- checkFromThisClass clas op_sel_ids default_binds `thenNF_Tc_`
+ checkFromThisClass clas op_items default_binds `thenNF_Tc_`
-- Do each default method separately
- mapAndUnzipTc tc_dm sel_ids_w_dms `thenTc` \ (defm_binds, const_lies) ->
+ -- For Hugs compatibility we make a default-method for every
+ -- class op, regardless of whether or not the programmer supplied an
+ -- explicit default decl for the class. GHC will actually never
+ -- call the default method for such operations, because it'll whip up
+ -- a more-informative default method at each instance decl.
+ mapAndUnzipTc tc_dm op_items `thenTc` \ (defm_binds, const_lies) ->
returnTc (plusLIEs const_lies, andMonoBindList defm_binds)
where
prags = filter isPragSig sigs
- (tyvars, sc_theta, sc_sel_ids, op_sel_ids, defm_ids) = classBigSig clas
-
- sel_ids_w_dms = [pair | pair@(_, Just _) <- op_sel_ids `zip` defm_ids]
- -- Just the ones for which there is an explicit
- -- user default declaration
+ (tyvars, _, _, op_items) = classBigSig clas
origin = ClassDeclOrigin
-- And since ds is big, it doesn't get inlined, so we don't get good
-- default methods. Better to make separate AbsBinds for each
- tc_dm sel_id_w_dm@(_, Just dm_id)
+ tc_dm op_item@(_, dm_id, _)
= tcInstTyVars tyvars `thenNF_Tc` \ (clas_tyvars, inst_tys, _) ->
let
theta = [(clas,inst_tys)]
tcExtendTyVarEnvForMeths tyvars clas_tyvars (
tcMethodBind clas origin clas_tyvars inst_tys theta
default_binds prags False
- sel_id_w_dm
+ op_item
) `thenTc` \ (defm_bind, insts_needed, (_, local_dm_id)) ->
tcAddErrCtxt (defltMethCtxt clas) $
\end{code}
\begin{code}
-checkFromThisClass :: Class -> [Id] -> RenamedMonoBinds -> NF_TcM s ()
-checkFromThisClass clas op_sel_ids mono_binds
+checkFromThisClass :: Class -> [ClassOpItem] -> RenamedMonoBinds -> NF_TcM s ()
+checkFromThisClass clas op_items mono_binds
= mapNF_Tc check_from_this_class bndrs `thenNF_Tc_`
returnNF_Tc ()
where
| nameOccName bndr `elem` sel_names = returnNF_Tc ()
| otherwise = tcAddSrcLoc loc $
addErrTc (badMethodErr bndr clas)
- sel_names = map getOccName op_sel_ids
+ sel_names = [getOccName sel_id | (sel_id,_,_) <- op_items]
bndrs = bagToList (collectMonoBinders mono_binds)
\end{code}
-- the caller; here, it's just used for the error message
-> RenamedMonoBinds -- Method binding (pick the right one from in here)
-> [RenamedSig] -- Pramgas (just for this one)
- -> Bool -- True <=> supply default decl if no explicit decl
- -- This is true for instance decls,
- -- false for class decls
- -> (Id, Maybe Id) -- The method selector and default-method Id
+ -> Bool -- True <=> This method is from an instance declaration
+ -> ClassOpItem -- The method selector and default-method Id
-> TcM s (TcMonoBinds, LIE, (LIE, TcId))
tcMethodBind clas origin inst_tyvars inst_tys inst_theta
- meth_binds prags supply_default_bind
- (sel_id, maybe_dm_id)
+ meth_binds prags is_inst_decl
+ (sel_id, dm_id, explicit_dm)
= tcGetSrcLoc `thenNF_Tc` \ loc ->
newMethod origin sel_id inst_tys `thenNF_Tc` \ meth@(_, meth_id) ->
maybe_user_bind = find_bind meth_name meth_binds
no_user_bind = case maybe_user_bind of {Nothing -> True; other -> False}
- no_user_default = case maybe_dm_id of {Nothing -> True; other -> False}
meth_bind = case maybe_user_bind of
Just bind -> bind
in
-- Warn if no method binding, only if -fwarn-missing-methods
- if no_user_bind && not supply_default_bind then
- pprPanic "tcMethodBind" (ppr clas <+> ppr inst_tys)
- else
- warnTc (opt_WarnMissingMethods && no_user_bind && no_user_default)
+ warnTc (is_inst_decl && opt_WarnMissingMethods && no_user_bind && not explicit_dm)
(omittedMethodWarn sel_id clas) `thenNF_Tc_`
-- Check the bindings; first add inst_tyvars to the envt
loc
default_expr loc
- = case maybe_dm_id of
- Just dm_id -> HsVar (getName dm_id) -- There's a default method
- Nothing -> error_expr loc -- No default method
+ | explicit_dm = HsVar (getName dm_id) -- There's a default method
+ | otherwise = error_expr loc -- No default method
error_expr loc = HsApp (HsVar (getName nO_METHOD_BINDING_ERROR_ID))
(HsLit (HsString (_PK_ (error_msg loc))))
origin = InstanceDeclOrigin
- (class_tyvars,
- sc_theta, sc_sel_ids,
- op_sel_ids, defm_ids) = classBigSig clas
+ (class_tyvars, sc_theta, sc_sel_ids, op_items) = classBigSig clas
+
+ dm_ids = [dm_id | (_, dm_id, _) <- op_items]
-- Instantiate the theta found in the original instance decl
inst_decl_theta' = substTheta (mkTopTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars'))
newDicts origin [(clas,inst_tys')] `thenNF_Tc` \ (this_dict, [this_dict_id]) ->
-- Check that all the method bindings come from this class
- checkFromThisClass clas op_sel_ids monobinds `thenNF_Tc_`
+ checkFromThisClass clas op_items monobinds `thenNF_Tc_`
tcExtendTyVarEnvForMeths inst_tyvars inst_tyvars' (
- tcExtendGlobalValEnv (catMaybes defm_ids) (
+ tcExtendGlobalValEnv dm_ids (
-- Default-method Ids may be mentioned in synthesised RHSs
mapAndUnzip3Tc (tcMethodBind clas origin inst_tyvars' inst_tys' inst_decl_theta'
monobinds uprags True)
- (op_sel_ids `zip` defm_ids)
+ op_items
)) `thenTc` \ (method_binds_s, insts_needed_s, meth_lies_w_ids) ->
-- Deal with SPECIALISE instance pragmas by making them
where
(clas, tys) = getDictClassTys dict
- (tyvars, sc_theta, sc_sels, _, _) = classBigSig clas
+ (tyvars, sc_theta, sc_sels, _) = classBigSig clas
sc_theta' = substTheta (mkTopTyVarSubst tyvars tys) sc_theta
add_sc avails ((super_clas, super_tys), sc_sel)
addSCs givens ct@(clas,tys)
= foldl add givens sc_theta
where
- (tyvars, sc_theta_tmpl, _, _, _) = classBigSig clas
+ (tyvars, sc_theta_tmpl, _, _) = classBigSig clas
sc_theta = substTheta (mkTopTyVarSubst tyvars tys) sc_theta_tmpl
add givens ct = case lookupFM givens ct of
import Type ( mkArrowKind, boxedTypeKind, mkDictTy )
-import Class ( Class, classBigSig )
+import Class ( Class )
import Var ( TyVar, tyVarKind )
import FiniteMap
import Bag
get_sigs sigs
= unionManyUniqSets (map get_sig sigs)
where
- get_sig (ClassOpSig _ _ ty _) = get_ty ty
- get_sig (FixSig _) = emptyUniqSet
+ get_sig (ClassOpSig _ _ _ ty _) = get_ty ty
+ get_sig (FixSig _) = emptyUniqSet
get_sig other = panic "TcTyClsDecls:get_sig"
----------------------------------------------------
\begin{code}
module Class (
- Class,
+ Class, ClassOpItem,
- mkClass,
+ mkClass, classTyVars,
classKey, classSelIds, classTyCon,
- classSuperClassTheta,
classBigSig, classInstEnv
) where
\begin{code}
data Class
- = Class
- Unique -- Key for fast comparison
- Name
+ = Class {
+ classKey :: Unique, -- Key for fast comparison
+ className :: Name,
+
+ classTyVars :: [TyVar], -- The class type variables
- [TyVar] -- The class type variables
+ classSCTheta :: [(Class,[Type])], -- Immediate superclasses, and the
+ classSCSels :: [Id], -- corresponding selector functions to
+ -- extract them from a dictionary of this
+ -- class
- [(Class,[Type])] -- Immediate superclasses, and the
- [Id] -- corresponding selector functions to
- -- extract them from a dictionary of this
- -- class
+ classOpStuff :: [ClassOpItem], -- Ordered by tag
- [Id] -- * selector functions
- [Maybe Id] -- * default methods
- -- They are all ordered by tag. The
- -- selector ids contain unfoldings.
+ classInstEnv :: InstEnv, -- All the instances of this class
- InstEnv -- All the instances of this class
+ classTyCon :: TyCon -- The data type constructor for dictionaries
+ } -- of this class
- TyCon -- The data type constructor for dictionaries
- -- of this class
+type ClassOpItem = (Id, -- Selector function; contains unfolding
+ Id, -- Default methods
+ Bool) -- True <=> an explicit default method was
+ -- supplied in the class decl
\end{code}
The @mkClass@ function fills in the indirect superclasses.
\begin{code}
mkClass :: Name -> [TyVar]
-> [(Class,[Type])] -> [Id]
- -> [Id] -> [Maybe Id]
+ -> [(Id, Id, Bool)]
-> TyCon
-> InstEnv
-> Class
mkClass name tyvars super_classes superdict_sels
- dict_sels defms tycon class_insts
- = Class (getUnique name) name tyvars
- super_classes superdict_sels
- dict_sels defms
- class_insts
- tycon
+ op_stuff tycon class_insts
+ = Class { classKey = getUnique name,
+ className = name,
+ classTyVars = tyvars,
+ classSCTheta = super_classes,
+ classSCSels = superdict_sels,
+ classOpStuff = op_stuff,
+ classInstEnv = class_insts,
+ classTyCon = tycon }
\end{code}
%************************************************************************
The rest of these functions are just simple selectors.
\begin{code}
-classKey (Class key _ _ _ _ _ _ _ _) = key
-classSuperClassTheta (Class _ _ _ scs _ _ _ _ _) = scs
-classSelIds (Class _ _ _ _ sc_sels op_sels _ _ _) = sc_sels ++ op_sels
-classTyCon (Class _ _ _ _ _ _ _ _ tc) = tc
-classInstEnv (Class _ _ _ _ _ _ _ env _) = env
-
-classBigSig (Class _ _ tyvars super_classes sdsels sels defms _ _)
- = (tyvars, super_classes, sdsels, sels, defms)
+classSelIds (Class {classSCSels = sc_sels, classOpStuff = op_stuff})
+ = sc_sels ++ [op_sel | (op_sel, _, _) <- op_stuff]
+
+classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
+ classSCSels = sc_sels, classOpStuff = op_stuff})
+ = (tyvars, sc_theta, sc_sels, op_stuff)
\end{code}
getUnique c = classKey c
instance NamedThing Class where
- getName (Class _ n _ _ _ _ _ _ _) = n
+ getName clas = className clas
instance Outputable Class where
ppr c = ppr (getName c)
projects / ghc-hetmet.git / commitdiff