X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcClassDcl.lhs;h=8e38983d1255e66a3db94280f287c16f7aab6c79;hb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;hp=264776abc2fe80dc40128ef8503babce64ba10d9;hpb=acaa2124a9427aec9ccc96e0c8b6e067a85916e0;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs index 264776a..8e38983 100644 --- a/ghc/compiler/typecheck/TcClassDcl.lhs +++ b/ghc/compiler/typecheck/TcClassDcl.lhs @@ -4,7 +4,7 @@ \section[TcClassDcl]{Typechecking class declarations} \begin{code} -module TcClassDcl ( kcClassDecl, tcClassDecl1, tcClassDecls2, +module TcClassDcl ( kcClassDecl, tcClassDecl1, tcClassDecls2, mkImplicitClassBinds, tcMethodBind, checkFromThisClass ) where @@ -12,8 +12,9 @@ module TcClassDcl ( kcClassDecl, tcClassDecl1, tcClassDecls2, import HsSyn ( HsDecl(..), TyClDecl(..), Sig(..), MonoBinds(..), InPat(..), HsBinds(..), GRHSs(..), - HsExpr(..), HsLit(..), HsType(..), pprClassAssertion, - unguardedRHS, andMonoBinds, andMonoBindList, getTyVarName, + HsExpr(..), HsLit(..), HsType(..), HsPred(..), + mkSimpleMatch, + andMonoBinds, andMonoBindList, getTyVarName, isClassDecl, isClassOpSig, isPragSig, collectMonoBinders ) import HsPragmas ( ClassPragmas(..) ) @@ -22,41 +23,44 @@ import RnHsSyn ( RenamedTyClDecl, RenamedClassPragmas, RenamedClassOpSig, RenamedMonoBinds, RenamedContext, RenamedHsDecl, RenamedSig ) -import TcHsSyn ( TcMonoBinds ) +import TcHsSyn ( TcMonoBinds, idsToMonoBinds ) import Inst ( Inst, InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, newDicts, newMethod ) import TcEnv ( TcId, ValueEnv, TcTyThing(..), tcAddImportedIdInfo, - tcLookupClass, tcLookupTy, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars, + tcLookupTy, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars, tcExtendLocalValEnv ) import TcBinds ( tcBindWithSigs, tcSpecSigs ) +import TcTyDecls ( mkNewTyConRep ) import TcUnify ( unifyKinds ) import TcMonad -import TcMonoType ( tcHsType, tcHsTopType, tcExtendTopTyVarScope, +import TcMonoType ( kcHsType, tcHsTopType, tcExtendTopTyVarScope, tcContext, checkSigTyVars, sigCtxt, mkTcSig ) import TcSimplify ( tcSimplifyAndCheck, bindInstsOfLocalFuns ) import TcType ( TcType, TcTyVar, tcInstTyVars, zonkTcTyVarBndr, tcGetTyVar ) +import TcInstUtil ( classDataCon ) 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 ) -import Id ( Id, setInlinePragma, getIdUnfolding, idType, idName ) +import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId ) +import DataCon ( mkDataCon, dataConId, dataConWrapId, notMarkedStrict ) +import Id ( Id, setInlinePragma, idUnfolding, idType, idName ) import CoreUnfold ( unfoldingTemplate ) import IdInfo import Name ( Name, nameOccName, isLocallyDefined, NamedThing(..) ) import NameSet ( emptyNameSet ) import Outputable -import Type ( mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy, - mkSigmaTy, mkForAllTys, Type, ThetaType, +import Type ( Type, ThetaType, ClassContext, + mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy, mkDictTys, + mkSigmaTy, mkForAllTys, mkClassPred, classesOfPreds, boxedTypeKind, mkArrowKind ) import Var ( tyVarKind, TyVar ) -import VarSet ( mkVarSet ) -import TyCon ( mkAlgTyCon ) +import VarSet ( mkVarSet, emptyVarSet ) +import TyCon ( AlgTyConFlavour(..), mkClassTyCon ) import Unique ( Unique, Uniquable(..) ) import Util import Maybes ( seqMaybe ) @@ -106,14 +110,14 @@ Death to "ExpandingDicts". \begin{code} kcClassDecl (ClassDecl context class_name - tyvar_names class_sigs def_methods pragmas - tycon_name datacon_name sc_sel_names src_loc) + tyvar_names fundeps class_sigs def_methods pragmas + _ _ _ _ src_loc) = -- CHECK ARITY 1 FOR HASKELL 1.4 checkTc (opt_GlasgowExts || length tyvar_names == 1) (classArityErr class_name) `thenTc_` -- Get the (mutable) class kind - tcLookupTy class_name `thenNF_Tc` \ (kind, _, _) -> + tcLookupTy class_name `thenNF_Tc` \ (kind, _) -> -- Make suitable tyvars and do kind checking -- The net effect is to mutate the class kind @@ -125,7 +129,7 @@ kcClassDecl (ClassDecl context class_name 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 (kcHsType op_ty) \end{code} @@ -138,10 +142,10 @@ kcClassDecl (ClassDecl context class_name \begin{code} tcClassDecl1 rec_env rec_inst_mapper rec_vrcs (ClassDecl context class_name - tyvar_names class_sigs def_methods pragmas - tycon_name datacon_name sc_sel_names src_loc) + tyvar_names fundeps class_sigs def_methods pragmas + tycon_name datacon_name datacon_wkr_name sc_sel_names src_loc) = -- LOOK THINGS UP IN THE ENVIRONMENT - tcLookupTy class_name `thenTc` \ (class_kind, _, AClass rec_class) -> + tcLookupTy class_name `thenTc` \ (class_kind, AClass rec_class arity) -> tcExtendTopTyVarScope class_kind tyvar_names $ \ tyvars _ -> -- The class kind is by now immutable @@ -151,6 +155,9 @@ tcClassDecl1 rec_env rec_inst_mapper rec_vrcs `thenTc` \ (sc_theta, sc_tys, sc_sel_ids) -> -- traceTc (text "tcClassCtxt done" <+> ppr class_name) `thenTc_` + -- CHECK THE FUNCTIONAL DEPENDENCIES, + tcFundeps fundeps `thenTc` \ fds -> + -- CHECK THE CLASS SIGNATURES, mapTc (tcClassSig rec_env rec_class tyvars) (filter isClassOpSig class_sigs) @@ -158,17 +165,17 @@ tcClassDecl1 rec_env rec_inst_mapper rec_vrcs -- 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 + clas = mkClass class_name tyvars fds + sc_theta sc_sel_ids op_items tycon rec_class_inst_env dict_component_tys = sc_tys ++ op_tys new_or_data = case dict_component_tys of - [_] -> NewType - other -> DataType + [_] -> NewTyCon (mkNewTyConRep tycon) + other -> DataTyCon dict_con = mkDataCon datacon_name [notMarkedStrict | _ <- dict_component_tys] @@ -177,37 +184,42 @@ tcClassDecl1 rec_env rec_inst_mapper rec_vrcs [{-No context-}] [{-No existential tyvars-}] [{-Or context-}] dict_component_tys - tycon dict_con_id + tycon dict_con_id dict_wrap_id - -- In general, constructors don't have to be inlined, but this one - -- does, because we don't make a top level binding for it. - dict_con_id = mkDataConId dict_con - `setInlinePragma` IMustBeINLINEd + dict_con_id = mkDataConId datacon_wkr_name dict_con + dict_wrap_id = mkDataConWrapId dict_con argvrcs = lookupWithDefaultFM rec_vrcs (pprPanic "tcClassDecl1: argvrcs:" $ ppr tycon_name) tycon_name - tycon = mkAlgTyCon tycon_name - class_kind - tyvars - [] -- No context - argvrcs - [dict_con] -- Constructors - [] -- No derivings - (Just clas) -- Yes! It's a dictionary - new_or_data - NonRecursive + tycon = mkClassTyCon tycon_name + class_kind + tyvars + argvrcs + dict_con -- Constructors + clas -- Yes! It's a dictionary + new_or_data in - returnTc clas + returnTc (class_name, AClass clas arity) \end{code} +\begin{code} +tcFundeps = mapTc tc_fundep +tc_fundep (us, vs) = + mapTc tc_fd_tyvar us `thenTc` \ us' -> + mapTc tc_fd_tyvar vs `thenTc` \ vs' -> + returnTc (us', vs') +tc_fd_tyvar v = + tcLookupTy v `thenTc` \(_, ATyVar tv) -> + returnTc tv +\end{code} \begin{code} tcClassContext :: Name -> Class -> [TyVar] -> RenamedContext -- class context -> [Name] -- Names for superclass selectors - -> TcM s (ThetaType, -- the superclass context + -> TcM s (ClassContext, -- the superclass context [Type], -- types of the superclass dictionaries [Id]) -- superclass selector Ids @@ -226,26 +238,19 @@ tcClassContext class_name rec_class rec_tyvars context sc_sel_names tcContext context `thenTc` \ sc_theta -> let - sc_tys = [mkDictTy sc tys | (sc,tys) <- sc_theta] - sc_sel_ids = zipWithEqual "tcClassContext" mk_super_id sc_sel_names sc_tys + sc_theta' = classesOfPreds sc_theta + sc_tys = mkDictTys sc_theta' + sc_sel_ids = [mkDictSelId sc_name rec_class | sc_name <- sc_sel_names] in -- Done - returnTc (sc_theta, sc_tys, sc_sel_ids) + returnTc (sc_theta', sc_tys, sc_sel_ids) where - rec_tyvar_tys = mkTyVarTys rec_tyvars - - mk_super_id name dict_ty - = mkDictSelId name rec_class ty - where - ty = mkForAllTys rec_tyvars $ - mkFunTy (mkDictTy rec_class rec_tyvar_tys) dict_ty + check_constraint sc@(HsPClass c tys) = checkTc (all is_tyvar tys) + (superClassErr class_name sc) - check_constraint (c, tys) = checkTc (all is_tyvar tys) - (superClassErr class_name (c, tys)) - - is_tyvar (MonoTyVar _) = True - is_tyvar other = False + is_tyvar (HsTyVar _) = True + is_tyvar other = False tcClassSig :: ValueEnv -- Knot tying only! @@ -253,13 +258,12 @@ tcClassSig :: ValueEnv -- Knot tying only! -> [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* @@ -271,20 +275,16 @@ tcClassSig rec_env rec_clas rec_clas_tyvars tcHsTopType op_ty `thenTc` \ local_ty -> let global_ty = mkSigmaTy rec_clas_tyvars - [(rec_clas, mkTyVarTys rec_clas_tyvars)] + [mkClassPred rec_clas (mkTyVarTys rec_clas_tyvars)] local_ty -- 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) + sel_id = mkDictSelId op_name rec_clas + 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} @@ -332,7 +332,7 @@ tcClassDecl2 :: RenamedTyClDecl -- The class declaration -> NF_TcM s (LIE, TcMonoBinds) tcClassDecl2 (ClassDecl context class_name - tyvar_names class_sigs default_binds pragmas _ _ _ src_loc) + tyvar_names _ class_sigs default_binds pragmas _ _ _ _ src_loc) | not (isLocallyDefined class_name) = returnNF_Tc (emptyLIE, EmptyMonoBinds) @@ -340,22 +340,27 @@ tcClassDecl2 (ClassDecl context class_name | otherwise -- It is locally defined = recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds)) $ tcAddSrcLoc src_loc $ + tcLookupTy class_name `thenNF_Tc` \ (_, AClass clas _) -> + tcDefaultMethodBinds clas default_binds class_sigs +\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 - +\begin{code} +mkImplicitClassBinds :: [Class] -> NF_TcM s ([Id], TcMonoBinds) +mkImplicitClassBinds classes + = returnNF_Tc (concat cls_ids_s, andMonoBindList binds_s) -- 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 - ] - in - -- Generate bindings for the default methods - tcDefaultMethodBinds clas default_binds class_sigs `thenTc` \ (const_insts, meth_binds) -> + where + (cls_ids_s, binds_s) = unzip (map mk_implicit classes) + + mk_implicit clas = (all_cls_ids, binds) + where + dict_con = classDataCon clas + all_cls_ids = dataConId dict_con : cls_ids + cls_ids = dataConWrapId dict_con : classSelIds clas - returnTc (const_insts, - meth_binds `AndMonoBinds` andMonoBindList sel_binds) + -- The wrapper and selectors get bindings, the worker does not + binds | isLocallyDefined clas = idsToMonoBinds cls_ids + | otherwise = EmptyMonoBinds \end{code} %************************************************************************ @@ -428,20 +433,21 @@ tcDefaultMethodBinds 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 @@ -454,10 +460,10 @@ tcDefaultMethodBinds clas default_binds sigs -- 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)] + theta = [(mkClassPred clas inst_tys)] in newDicts origin theta `thenNF_Tc` \ (this_dict, [this_dict_id]) -> let @@ -466,7 +472,7 @@ tcDefaultMethodBinds clas default_binds sigs 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) $ @@ -495,8 +501,8 @@ tcDefaultMethodBinds clas default_binds sigs \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 @@ -504,7 +510,7 @@ checkFromThisClass clas op_sel_ids mono_binds | 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} @@ -528,15 +534,13 @@ tcMethodBind -- 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) -> @@ -547,7 +551,6 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta 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 @@ -557,10 +560,7 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta 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 @@ -586,15 +586,14 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta -- Now check that the instance type variables -- (or, in the case of a class decl, the class tyvars) -- have not been unified with anything in the environment - tcAddErrCtxtM (sigCtxt sig_msg (mkSigmaTy inst_tyvars inst_theta (idType meth_id))) $ - checkSigTyVars inst_tyvars `thenTc_` + tcAddErrCtxtM (sigCtxt sig_msg inst_tyvars inst_theta (idType meth_id)) $ + checkSigTyVars inst_tyvars emptyVarSet `thenTc_` returnTc (binds `AndMonoBinds` prag_binds1 `AndMonoBinds` prag_binds2, insts `plusLIE` prag_lie', meth) where - sig_msg ty = sep [ptext SLIT("When checking the expected type for"), - nest 4 (ppr sel_name <+> dcolon <+> ppr ty)] + sig_msg = ptext SLIT("When checking the expected type for class method") <+> ppr sel_name sel_name = idName sel_id @@ -602,8 +601,6 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta -- but we must use the method name; so we substitute it here. Crude but simple. find_bind meth_name (FunMonoBind op_name fix matches loc) | op_name == sel_name = Just (FunMonoBind meth_name fix matches loc) - find_bind meth_name (PatMonoBind (VarPatIn op_name) grhss loc) - | op_name == sel_name = Just (PatMonoBind (VarPatIn meth_name) grhss loc) find_bind meth_name (AndMonoBinds b1 b2) = find_bind meth_name b1 `seqMaybe` find_bind meth_name b2 find_bind meth_name other = Nothing -- Default case @@ -614,21 +611,21 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta find_prags meth_name [] = [] find_prags meth_name (SpecSig name ty loc : prags) | name == sel_name = SpecSig meth_name ty loc : find_prags meth_name prags - find_prags meth_name (InlineSig name loc : prags) - | name == sel_name = InlineSig meth_name loc : find_prags meth_name prags - find_prags meth_name (NoInlineSig name loc : prags) - | name == sel_name = NoInlineSig meth_name loc : find_prags meth_name prags + find_prags meth_name (InlineSig name phase loc : prags) + | name == sel_name = InlineSig meth_name phase loc : find_prags meth_name prags + find_prags meth_name (NoInlineSig name phase loc : prags) + | name == sel_name = NoInlineSig meth_name phase loc : find_prags meth_name prags find_prags meth_name (prag:prags) = find_prags meth_name prags mk_default_bind local_meth_name loc - = PatMonoBind (VarPatIn local_meth_name) - (GRHSs (unguardedRHS (default_expr loc) loc) EmptyBinds Nothing) + = FunMonoBind local_meth_name + False -- Not infix decl + [mkSimpleMatch [] (default_expr loc) Nothing loc] 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)))) @@ -643,7 +640,7 @@ classArityErr class_name = ptext SLIT("Too many parameters for class") <+> quotes (ppr class_name) superClassErr class_name sc - = ptext SLIT("Illegal superclass constraint") <+> quotes (pprClassAssertion sc) + = ptext SLIT("Illegal superclass constraint") <+> quotes (ppr sc) <+> ptext SLIT("in declaration for class") <+> quotes (ppr class_name) defltMethCtxt class_name