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
This commit is contained in:
vsc
parent
f7161d37c4
commit
8b867ea4de
@ -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));
|
||||
}
|
||||
|
||||
|
||||
224
C/dbase.c
224
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
|
||||
|
||||
66
docs/yap.tex
66
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
|
||||
|
||||
27
pl/debug.yap
27
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,8 +577,13 @@ 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 ;
|
||||
'$nth_instancep'(M:G,Cl,R),
|
||||
instance(R,(G:-Clause)),
|
||||
(
|
||||
Clause = true
|
||||
->
|
||||
true
|
||||
;
|
||||
'$creep_call'(Clause,M,CP)
|
||||
)
|
||||
;
|
||||
@ -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)).
|
||||
|
||||
124
pl/preds.yap
124
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'((\+_)).
|
||||
|
||||
|
||||
@ -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).
|
||||
|
||||
|
||||
51
pl/utils.yap
51
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
|
||||
|
||||
Reference in New Issue
Block a user