From 8b867ea4de99b1d8924c091c2dc22e1b761abe4c Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 13 Dec 2002 20:00:41 +0000 Subject: [PATCH] new builtins: nth_clause, nth_instance. allow clause/3 on static predicates. predicate_property(P,number_of_clauses(N)). improve profiling code. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@728 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/cdmgr.c | 2 +- C/dbase.c | 224 +++++++++++++++++++++++++++++++++++++++++++++++-- docs/yap.tex | 66 ++++++++++----- pl/debug.yap | 31 +++---- pl/preds.yap | 124 ++++++++++++++++++++++----- pl/profile.yap | 2 - pl/utils.yap | 51 ----------- 7 files changed, 374 insertions(+), 126 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index 0b1d13cc7..b7a190a15 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1467,7 +1467,7 @@ p_number_of_clauses(void) ncl++; } READ_UNLOCK(RepPredProp(pe)->PRWLock); - t = MkIntTerm(ncl); + t = MkIntegerTerm(ncl); return (Yap_unify_constant(ARG3, t)); } diff --git a/C/dbase.c b/C/dbase.c index a0efad682..8260cd0d8 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -2067,10 +2067,10 @@ UnifyDBKey(DBRef DBSP, PropFlags flags, Term t) } else { t1 = Yap_MkNewApplTerm(p->FunctorOfDB,p->ArityOfDB); } - if (p->KindOfPE & CodeDBBit && (flags & CodeDBBit)) { + if ((p->KindOfPE & CodeDBBit) && (flags & CodeDBBit)) { Term t[2]; - t[1] = Yap_LookupModule(p->ModuleOfDB); - t[2] = t1; + t[0] = ModuleName[p->ModuleOfDB]; + t[1] = t1; tf = Yap_MkApplTerm(FunctorModule, 2, t); } else if (!(flags & CodeDBBit)) { tf = t1; @@ -2082,6 +2082,27 @@ UnifyDBKey(DBRef DBSP, PropFlags flags, Term t) } +static int +UnifyDBNumber(DBRef DBSP, Term t) +{ + DBProp p = DBSP->Parent; + DBRef ref; + Int i = 1; + + READ_LOCK(p->DBRWLock); + ref = p->First; + while (ref != NIL) { + if (ref == DBSP) break; + if (!DEAD_REF(ref)) i++; + ref = ref->Next; + } + if (ref == NIL) + return FALSE; + READ_UNLOCK(p->DBRWLock); + return(Yap_unify(MkIntegerTerm(i),t)); +} + + static Term GetDBTerm(DBRef DBSP) { @@ -2355,6 +2376,193 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg) return(RepDBProp(FindDBProp(RepAtom(At), flag, arity, dbmod))); } + +static DBRef +nth_recorded_log(LogUpdDBProp AtProp, Int Count) +{ + DBRef ref; + + if (AtProp->NOfEntries == 0) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + if (Count > AtProp->NOfEntries) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + if (AtProp->NOfEntries == 1) { + ref = AtProp->First; + } else { + if (AtProp->Index == NULL) { + while((AtProp->Index = new_lu_index(AtProp)) == NULL) { + if (!Yap_growheap(FALSE)) { + Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); + READ_UNLOCK(AtProp->DBRWLock); + return NULL; + } + } + } + ref = ((DBRef *)(AtProp->Index->Contents))[Count-1]; + } + return ref; +} + + +/* Finds a term recorded under the key ARG1 */ +static Int +nth_recorded(DBProp AtProp, Int Count) +{ + Register DBRef ref; + + READ_LOCK(AtProp->DBRWLock); + if (AtProp->KindOfPE & 0x1) { + ref = nth_recorded_log((LogUpdDBProp)AtProp, Count); + if (ref == NULL) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + } else { +#ifdef KEEP_OLD_ENTRIES_HANGING_ABOUT + ref = AtProp->FirstNEr; +#else + ref = AtProp->First; +#endif + Count--; + while (ref != NULL + && DEAD_REF(ref)) + ref = NextDBRef(ref); + if (ref == NULL) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + while (Count) { + Count--; + ref = NextDBRef(ref); + while (ref != NULL + && DEAD_REF(ref)) + ref = NextDBRef(ref); + if (ref == NULL) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + } + } +#if defined(YAPOR) || defined(THREADS) + LOCK(ref->lock); + READ_UNLOCK(AtProp->DBRWLock); + TRAIL_REF(ref); /* So that fail will erase it */ + INC_DBREF_COUNT(ref); + UNLOCK(ref->lock); +#else + if (!(ref->Flags & InUseMask)) { + ref->Flags |= InUseMask; + TRAIL_REF(ref); /* So that fail will erase it */ + } + READ_UNLOCK(AtProp->DBRWLock); +#endif + return Yap_unify(MkDBRefTerm(ref),ARG3); +} + +static Int +p_nth_instance(void) +{ + DBProp AtProp; + Term TCount; + Int Count; + Term t3 = Deref(ARG3); + + if (!IsVarTerm(t3)) { + if (!IsDBRefTerm(t3)) { + Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3"); + return FALSE; + } else { + DBRef ref = DBRefOfTerm(t3); + LOCK(ref->lock); + if (ref == NULL + || DEAD_REF(ref) + || !UnifyDBKey(ref,0,ARG1) + || !UnifyDBNumber(ref,ARG2)) { + UNLOCK(ref->lock); + return(FALSE); + } else { + UNLOCK(ref->lock); + return(TRUE); + } + } + } + if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) { + return(FALSE); + } + TCount = Deref(ARG2); + if (IsVarTerm(TCount)) { + Yap_Error(INSTANTIATION_ERROR, TCount, "nth_instance/3"); + return (FALSE); + } + if (!IsIntegerTerm(TCount)) { + Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3"); + return (FALSE); + } + Count = IntegerOfTerm(TCount); + if (Count <= 0) { + if (Count) + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_instance/3"); + else + Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_instance/3"); + return (FALSE); + } + return nth_recorded(AtProp,Count); +} + +static Int +p_nth_instancep(void) +{ + DBProp AtProp; + Term TCount; + Int Count; + Term t3 = Deref(ARG3); + + if (!IsVarTerm(t3)) { + if (!IsDBRefTerm(t3)) { + Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3"); + return FALSE; + } else { + DBRef ref = DBRefOfTerm(t3); + LOCK(ref->lock); + if (ref == NULL + || DEAD_REF(ref) + || !UnifyDBKey(ref,CodeDBBit,ARG1) + || !UnifyDBNumber(ref,ARG2)) { + UNLOCK(ref->lock); + return(FALSE); + } else { + UNLOCK(ref->lock); + return(TRUE); + } + } + } + if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), MkCode, FALSE, "nth_instance/3"))) { + return(FALSE); + } + TCount = Deref(ARG2); + if (IsVarTerm(TCount)) { + Yap_Error(INSTANTIATION_ERROR, TCount, "recorded_at/4"); + return (FALSE); + } + if (!IsIntegerTerm(TCount)) { + Yap_Error(TYPE_ERROR_INTEGER, TCount, "recorded_at/4"); + return (FALSE); + } + Count = IntegerOfTerm(TCount); + if (Count <= 0) { + if (Count) + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "recorded_at/4"); + else + Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "recorded_at/4"); + return (FALSE); + } + return nth_recorded(AtProp,Count); +} + /* Finds a term recorded under the key ARG1 */ static Int i_log_upd_recorded(LogUpdDBProp AtProp) @@ -2378,10 +2586,10 @@ i_log_upd_recorded(LogUpdDBProp AtProp) rtable[0] = NIL; } else { if (AtProp->Index == NULL) { - if((AtProp->Index = new_lu_index(AtProp)) == NULL) { + while((AtProp->Index = new_lu_index(AtProp)) == NULL) { if (!Yap_growheap(FALSE)) { Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); - cut_fail(); + return FALSE; } twork = Deref(ARG2); } @@ -2478,7 +2686,7 @@ i_log_upd_recorded(LogUpdDBProp AtProp) TRef = MkDBRefTerm(ref); if (*ep == NULL) { if (Yap_unify(ARG3, TRef)) { -#if defined(YAPOR) || defined(THREADS) +#if defined(OR) || defined(THREADS) LOCK(ref->lock); TRAIL_REF(ref); /* So that fail will erase it */ INC_DBREF_COUNT(ref); @@ -3701,7 +3909,7 @@ EraseEntry(DBRef entryref) #endif /* DISCONNECT_OLD_ENTRIES */ if (!DBREF_IN_USE(entryref)) { ErDBE(entryref); - } else if ((entryref->Flags & DBCode) && entryref->Code) { + } else if ((entryref->Flags & DBCode && entryref->Code)) { PrepareToEraseClause(ClauseCodeToClause(entryref->Code), entryref); } } @@ -4467,6 +4675,8 @@ Yap_InitDBPreds(void) Yap_InitCPred("$fetch_reference_from_index", 3, p_fetch_reference_from_index, SafePredFlag|SyncPredFlag); Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag); Yap_InitCPred("key_statistics", 3, p_key_statistics, SyncPredFlag); + Yap_InitCPred("nth_instance", 3, p_nth_instance, SyncPredFlag); + Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag); } void diff --git a/docs/yap.tex b/docs/yap.tex index 9f555e3cd..b91892418 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -4744,7 +4744,25 @@ program. Its head and body are respectively unified with @var{H} and @var{true}. This predicate is applicable to static procedures compiled with -@code{source} active, and to all the dynamic procedures. +@code{source} active, and to all dynamic procedures. + +@item clause(+@var{H},@var{B},-@var{R}) +@findex clause/3 +@saindex clause/3 +@caindex clause/3 +The same as @code{clause/2}, plus @var{R} is unified with the +reference to the clause in the database. You can use @code{instance/2} +to access the reference's value. Note that you may not use +@code{erase/1} on the reference on static procedures. + +@item nth_clause(+@var{H},@var{I},-@var{R}) +@findex nth_clause/3 +@saindex nth_clause/3 +@caindex nth_clause/3 +Find the @var{I}th clause in the predicate defining @var{H}, and give +a reference to the clause. Alternatively, if the reference @var{R} is +given the head @var{H} is unified with a description of the predicate +and @var{I} is bound to its position. @end table @@ -4856,6 +4874,9 @@ true if the predicate is public; note that all dynamic predicates are public. @item source true if source for the predicate is available. +@item number_of_clauses(@var{ClauseCount}) +Number of clauses in the predicate definition. Always one if external +or built-in. @end table @end table @@ -4904,16 +4925,9 @@ declared dynamic. @saindex retract/2 @caindex retract/2 Erases from the program the clause @var{C} whose -database reference is @var{R}. +database reference is @var{R}. The predicate must be dynamic. -@item clause(+H,B,-@var{R}) -@findex clause/3 -@saindex clause/3 -@caindex clause/3 - The same as @code{clause(H,B)} but @var{R} is unified with the -reference to the clause in the database. - @end table @node Internal Database, BlackBoard, Database References, Database @@ -4977,6 +4991,16 @@ elements of the internal data-base that match the key. match the reference. @end itemize +@item nth_instance(?@var{K},?@var{Index},@var{T},?@var{R}) +@findex nth_recorded/3 +@saindex nth_recorded/3 +@cnindex nth_recorded/3 +Fetches the @var{Index}nth entry in the internal database under the +key @var{K}. Entries are numbered from one. If the key @var{K} are the +@var{Index} are bound, a reference is unified with @var{R}. Otherwise, +the reference @var{R} must be given, and the term the system will find +the matching key and index. + @item erase(+@var{R}) @findex erase/1 @saindex erase/1 @@ -5671,31 +5695,30 @@ newer implementation. @item Currently only information on entries and retries to a predicate are maintained. This may change in the future. @item As an example, the following user-level program gives a list of -the most often called procedures in a program: +the most often called procedures in a program. The procedure +@code{list_profile} shows all procedures, irrespective of module, and +the procedure @code{list_profile/1} shows the procedures being used in +a specific module. @example list_profile :- % get number of calls for each profiled procedure - findall(D-P,profile_data(P,calls,D),LP), - % sort them - sort(LP,SLP), + setof(D-[M:P|D1],(current_module(M),profile_data(M:P,calls,D),profile_data(M:P,retries,D1)),LP), % output so that the most often called % predicates will come last: - write_profile_data(SLP). + write_profile_data(LP). list_profile(Module) :- % get number of calls for each profiled procedure - findall(D-P,profile_data(Module:P,calls,D),LP), - % sort them - sort(LP,SLP), + setof(D-[Module:P|D1],(profile_data(Module:P,calls,D),profile_data(Module:P,retries,D1)),LP), % output so that the most often called % predicates will come last: - write_profile_data(SLP). + write_profile_data(LP). write_profile_data([]). -write_profile_data([D-P|SLP]) :- +write_profile_data([D-[M:P|R]|SLP]) :- % swap the two calls if you want the most often % called predicates first. - format('~w: ~w~n', [P,D]), + format('~a:~w: ~32+~t~d~12+~t~d~12+~n', [M,P,D,R]), write_profile_data(SLP). @end example @end itemize @@ -13631,9 +13654,6 @@ Prolog implements Unix-like escape sequences. standard. Use @code{prolog_initialization/1} for the SICStus Prolog compatible built-in. -@item YAP does not implement the tabbing primitives in -@code{format/2} and @code{format/3}. - @item Prolog flags are different in SICStus Prolog and in YAP. @item The SICStus Prolog @code{on_exception/3} and diff --git a/pl/debug.yap b/pl/debug.yap index d8753b3ae..6ee218c2c 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -521,7 +521,8 @@ debugging :- ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), CP is '$last_choice_pt', ( - '$fetch_clause'(G,M,Cl,Clause), + '$nth_instancep'(M:G,Cl,R), + instance(R,(G:-Clause)), (Clause = true -> true ; '$call'(Clause,CP,Clause,M) ) ; Next is Cl+1, '$set_value'(spy_cl,Next), fail @@ -576,10 +577,15 @@ debugging :- ('$undefined'('$set_depth_limit'(_),prolog) -> true ; '$set_depth_limit'(D)), CP is '$last_choice_pt', ( - '$fetch_clause'(G,M,Cl,Clause), - (Clause = true -> true ; - '$creep_call'(Clause,M,CP) - ) + '$nth_instancep'(M:G,Cl,R), + instance(R,(G:-Clause)), + ( + Clause = true + -> + true + ; + '$creep_call'(Clause,M,CP) + ) ; Next is Cl+1, '$set_value'(spy_cl,Next), fail ). @@ -638,21 +644,6 @@ debugging :- '$creep', '$execute'(G,M,Cl). -'$fetch_clause'(G,M,ClNum,Body) :- - % I'd like an easier way to keep a counter - '$set_value'('$fetching_clauses',1), - '$recordedp'(M:G,Clause,_), - '$get_value'('$fetching_clauses',Num), - ( Num = ClNum -> - !, - Clause = (G :- Body) - ; - Num1 is Num+1, - '$set_value'('$fetching_clauses',Num1), - fail - ). - - %'$creep_call'(G,_) :- write(user_error,'$creepcall'(G)), nl(user_error), fail. '$creep_call'(V,M,_) :- var(V), !, '$do_error'(instantiation_error,meta_call(M:V)). diff --git a/pl/preds.yap b/pl/preds.yap index a15323276..0461890f2 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -230,30 +230,10 @@ assert(C,R) :- '$assert_dynamic'(C,M,last,R,assert(C,R)). clause(M:P,Q) :- !, - '$clause'(P,M,Q). + '$clause'(P,M,Q,_). clause(V,Q) :- '$current_module'(M), - '$clause'(V,M,Q). - -'$clause'(V,M,Q) :- var(V), !, - '$do_error'(instantiation_error,M:clause(V,Q)). -'$clause'(C,M,Q) :- number(C), !, - '$do_error'(type_error(callable,C),M:clause(C,Q)). -'$clause'(R,M,Q) :- db_reference(R), !, - '$do_error'(type_error(callable,R),M:clause(R,Q)). -'$clause'(M:P,_,Q) :- !, - '$clause'(P,M,Q). -'$clause'(P,Mod,Q) :- '$is_dynamic'(P, Mod), !, - '$recordedp'(Mod:P,(P:-Q),_). -'$clause'(P,M,Q) :- - '$some_recordedp'(M:P), !, - '$recordedp'(M:P,(P:-Q),_). -'$clause'(P,M,Q) :- - ( '$system_predicate'(P,M) -> true ; - '$number_of_clauses'(P,M,N), N > 0 ), - functor(P,Name,Arity), - '$do_error'(permission_error(access,private_procedure,Name/Arity), - clause(M:P,Q)). + '$clause'(V,M,Q,R). clause(M:P,Q,R) :- !, '$clause'(P,M,Q,R). @@ -261,6 +241,51 @@ clause(V,Q,R) :- '$current_module'(M), '$clause'(V,M,Q,R). +'$clause'(V,M,Q,_) :- var(V), !, + '$do_error'(instantiation_error,M:clause(V,Q)). +'$clause'(C,M,Q,_) :- number(C), !, + '$do_error'(type_error(callable,C),M:clause(C,Q)). +'$clause'(R,M,Q,_) :- db_reference(R), !, + '$do_error'(type_error(callable,R),M:clause(R,Q)). +'$clause'(M:P,_,Q,R) :- !, + '$clause'(P,M,Q,R). +'$clause'(P,M,Q,R) :- + '$some_recordedp'(M:P), !, + '$recordedp'(M:P,(P:-Q),R). +'$clause'(P,M,Q,_) :- + ( '$system_predicate'(P,M) -> true ; + '$number_of_clauses'(P,M,N), N > 0 ), + functor(P,Name,Arity), + '$do_error'(permission_error(access,private_procedure,Name/Arity), + clause(M:P,Q)). + +nth_clause(P,I,R) :- nonvar(R), !, + '$nth_instancep'(P,I,R). +nth_clause(M:V,I,R) :- !, + '$nth_clause'(V,M,I,R). +nth_clause(V,I,R) :- + '$current_module'(M), + '$nth_clause'(V,M,I,R). + + +'$nth_clause'(V,M,I,R) :- var(V), !, + '$do_error'(instantiation_error,M:nth_clause(V,I,R)). +'$nth_clause'(C,M,I,R) :- number(C), !, + '$do_error'(type_error(callable,C),M:nth_clause(C,I,R)). +'$nth_clause'(R,M,I,R) :- db_reference(R), !, + '$do_error'(type_error(callable,R),M:nth_clause(R,I,R)). +'$nth_clause'(M:P,_,I,R) :- !, + '$nth_clause'(P,M,I,R). +'$nth_clause'(P,M,I,R) :- + '$some_recordedp'(M:P), !, + '$nth_instancep'(M:P,I,R). +'$nth_clause'(P,M,I,R) :- + ( '$system_predicate'(P,M) -> true ; + '$number_of_nth_clauses'(P,M,N), N > 0 ), + functor(P,Name,Arity), + '$do_error'(permission_error(access,private_procedure,Name/Arity), + nth_clause(M:P,I,R)). + '$clause'(V,M,Q,R) :- var(V), !, '$do_error'(instantiation_error,M:clause(V,Q,R)). '$clause'(C,M,Q,R) :- number(C), !, @@ -635,8 +660,63 @@ hide_predicate(P) :- NF is F \/ 0x8200000, '$flags'(P,prolog,F,NF). +predicate_property(Mod:Pred,Prop) :- !, + '$predicate_property2'(Pred,Prop,Mod). +predicate_property(Pred,Prop) :- + '$current_module'(Mod), + '$predicate_property2'(Pred,Prop,Mod). + +'$predicate_property2'(Pred,Prop,M) :- var(Pred), !, + '$generate_all_preds_from_mod'(Pred, SourceMod, M), + '$predicate_property'(Pred,SourceMod,M,Prop). +'$predicate_property2'(M:Pred,Prop,_) :- !, + '$predicate_property2'(Pred,Prop,M). +'$predicate_property2'(Pred,Prop,Mod) :- + '$pred_exists'(Pred,Mod), !, + '$predicate_property'(Pred,Mod,Mod,Prop). +'$predicate_property2'(Pred,Prop,Mod) :- + functor(Pred, N, K), + '$recorded'('$import','$import'(M,Mod,N,K),_), + '$predicate_property'(Pred,M,Mod,Prop). + +'$generate_all_preds_from_mod'(Pred, M, M) :- + '$current_predicate'(M,Na,Ar), + functor(Pred, Na, Ar). +'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :- + '$recorded'('$import','$import'(SourceMod,Mod,N,K),_), + functor(Pred, N, K). + + +'$predicate_property'(P,M,_,built_in) :- + '$system_predicate'(P,M), !. +'$predicate_property'(P,M,_,source) :- + ( '$recordedp'(M:P,_,_) -> true ; false). +'$predicate_property'(P,M,_,dynamic) :- + '$is_dynamic'(P,M). +'$predicate_property'(P,M,_,static) :- + \+ '$is_dynamic'(P,M), + \+ '$undefined'(P,M). +'$predicate_property'(P,M,_,meta_predicate(P)) :- + functor(P,Na,Ar), + '$meta_predicate'(M,Na,Ar,P). +'$predicate_property'(P,M,_,multifile) :- + '$is_multifile'(P,M). +'$predicate_property'(P,Mod,M,imported_from(Mod)) :- + functor(P,N,K), + '$recorded'('$import','$import'(Mod,M,N,K),_). +'$predicate_property'(P,M,_,public) :- + '$is_public'(P,M). +'$predicate_property'(P,M,M,exported) :- + functor(P,N,A), + '$recorded'('$module','$module'(_TFN,M,Publics),_), + '$member'(N/A,Publics), !. /* defined in modules.yap */ +'$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :- + '$number_of_clauses'(P,Mod,NCl). + + :- '$make_pred_push_mod'((_,_)). :- '$make_pred_push_mod'((_;_)). :- '$make_pred_push_mod'((_|_)). :- '$make_pred_push_mod'((_->_)). :- '$make_pred_push_mod'((\+_)). + diff --git a/pl/profile.yap b/pl/profile.yap index 1d8f4d289..39a386c94 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -46,8 +46,6 @@ profile_data(P, Parm, Data) :- '$profile_info'(M, P, Stats), '$profile_say'(Stats, Parm, Data). - - '$profile_say'('$profile'(Entries, _, _), calls, Entries). '$profile_say'('$profile'(_, _, Backtracks), retries, Backtracks). diff --git a/pl/utils.yap b/pl/utils.yap index c14d90968..bdff9230b 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -540,57 +540,6 @@ unknown(V0,V) :- [P,M,Na,Ar]), fail. -predicate_property(Mod:Pred,Prop) :- !, - '$predicate_property2'(Pred,Prop,Mod). -predicate_property(Pred,Prop) :- - '$current_module'(Mod), - '$predicate_property2'(Pred,Prop,Mod). - -'$predicate_property2'(Pred,Prop,M) :- var(Pred), !, - '$generate_all_preds_from_mod'(Pred, SourceMod, M), - '$predicate_property'(Pred,SourceMod,M,Prop). -'$predicate_property2'(M:Pred,Prop,_) :- !, - '$predicate_property2'(Pred,Prop,M). -'$predicate_property2'(Pred,Prop,Mod) :- - '$pred_exists'(Pred,Mod), !, - '$predicate_property'(Pred,Mod,Mod,Prop). -'$predicate_property2'(Pred,Prop,Mod) :- - functor(Pred, N, K), - '$recorded'('$import','$import'(M,Mod,N,K),_), - '$predicate_property'(Pred,M,Mod,Prop). - -'$generate_all_preds_from_mod'(Pred, M, M) :- - '$current_predicate'(M,Na,Ar), - functor(Pred, Na, Ar). -'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :- - '$recorded'('$import','$import'(SourceMod,Mod,N,K),_), - functor(Pred, N, K). - - -'$predicate_property'(P,M,_,built_in) :- - '$system_predicate'(P,M), !. -'$predicate_property'(P,M,_,source) :- - ( '$recordedp'(M:P,_,_) -> true ; false). -'$predicate_property'(P,M,_,dynamic) :- - '$is_dynamic'(P,M). -'$predicate_property'(P,M,_,static) :- - \+ '$is_dynamic'(P,M), - \+ '$undefined'(P,M). -'$predicate_property'(P,M,_,meta_predicate(P)) :- - functor(P,Na,Ar), - '$meta_predicate'(M,Na,Ar,P). -'$predicate_property'(P,M,_,multifile) :- - '$is_multifile'(P,M). -'$predicate_property'(P,Mod,M,imported_from(Mod)) :- - functor(P,N,K), - '$recorded'('$import','$import'(Mod,M,N,K),_). -'$predicate_property'(P,M,_,public) :- - '$is_public'(P,M). -'$predicate_property'(P,M,M,exported) :- - functor(P,N,A), - '$recorded'('$module','$module'(_TFN,M,Publics),_), - '$member'(N/A,Publics), !. /* defined in modules.yap */ - %%% Some "dirty" predicates % Only efective if yap compiled with -DDEBUG