diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

android debugging plus clean-ups

Browse Source
This commit is contained in:
Vítor Santos Costa
2015-04-13 13:28:17 +01:00
parent d1a230eb56
commit ef586e264e
77 changed files with 2346 additions and 4054 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
pl/consult.yap
View File

@@ -16,7 +16,7 @@
*************************************************************************/
:- system_module( '$_consult', [compile/1,
consult/1,
db_files/1,-
db_files/1,
ensure_loaded/1,
exists_source/1,
exo_files/1,
@@ -879,6 +879,7 @@ db_files(Fs) :-
'$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :-
writeln(Stream),
peek_code(Stream, 0'#), !, % 35 is ASCII for '#
skip(Stream, 10),
'$skip_unix_header'(Stream).

36
pl/init.yap
View File

@@ -17,10 +17,10 @@
%% @defgroup builtins YAP Built-Ins
/*
@addtogroup YAPControl
@{
@{
*/
:- system_module( '$_init', [!/0,
@@ -51,21 +51,21 @@
% These are pseudo declarations
% so that the user will get a redefining system predicate
/** @pred fail is iso
/** @pred fail is iso
Always fails.
*/
fail :- fail.
/** @pred false is iso
/** @pred false is iso
The same as fail.
*/
false :- fail.
@@ -127,7 +127,7 @@ otherwise.
'arith.yap',
'flags.yap'
].
:- [ 'preds.yap',
'modules.yap'
].
@@ -232,7 +232,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- module(user).
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined
@@ -244,7 +244,7 @@ sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the default
rules.
*/
:- multifile goal_expansion/3.
@@ -263,25 +263,25 @@ rules.
:- dynamic goal_expansion/2.
/** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_)
/** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_)
This user-defined predicate is called by `expand_term/3` to
preprocess all terms read when consulting a file. If it succeeds:
+
+
If _X_ is of the form `:- G` or `?- G`, it is processed as
a directive.
+
+
If _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`.
+
+
If _X_ is a list, all terms of the list are asserted or processed
as directives.
+ The term _X_ is asserted instead of _T_.
*/
:- multifile term_expansion/2.
@@ -294,7 +294,7 @@ as directives.
:- multifile swi:swi_predicate_table/4.
/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_)
/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_)
Hook predicate that may be define in the module `user` to intercept
@@ -305,7 +305,7 @@ format statements as described with print_message_lines/3.
This predicate should be defined dynamic and multifile to allow other
modules defining clauses for it too.
*/
:- multifile user:message_hook/3.
@@ -315,7 +315,7 @@ modules defining clauses for it too.
:- dynamic user:portray_message/2.
/** @pred exception(+ _Exception_, + _Context_, - _Action_)
/** @pred exception(+ _Exception_, + _Context_, - _Action_)
Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1.
@@ -337,7 +337,7 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
:- dynamic user:exception/3.
:- yap_flag(unknown,error).
:- yap_flag(unknown,error).
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.

23
pl/modules.yap
View File

@@ -823,7 +823,10 @@ expand_goal(G, G).
% be careful here not to generate an undefined exception.
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
'$enter_undefp',
'$undefined'(G, ImportingMod),
( var(G) -> true ;
var(ImportingMod) -> true ;
'$undefined'(G, ImportingMod)
),
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
ExportingMod \= ImportingMod, !,
'$exit_undefp'.
@@ -833,8 +836,8 @@ expand_goal(G, G).
% This predicate should be bidirectional: both
% a consumer and a generator.
'$get_undefined_pred'(G, ImportingMod, call(G), ImportingMod) :-
var(G), !.
%'$get_undefined_pred'(G, ImportingMod, call(G), ImportingMod) :-
% var(G), !.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
@@ -852,8 +855,8 @@ expand_goal(G, G).
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
yap_flag(autoload, V),
V = true,
functor(G, N, K),
functor(G0, N, K),
functor(G, N, K),
functor(G0, N, K),
'$autoloader_find_predicate'(G0,ExportingMod),
ExportingMod \= ImportingMod,
(recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ).
@@ -1404,10 +1407,14 @@ export_list(Module, List) :-
G0=..[_N0|Args],
G1=..[N1|Args],
( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod = user ->
( recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_) -> true ; true)
( ContextMod == prolog ->
recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
fail
;
( recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_) -> true ; true )
recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
fail
;
true
)
;
true

17
pl/preddecls.yap
View File

@@ -31,7 +31,7 @@
The YAP Compiler allows the programmer to include declarations with
important pproprties of predicates, such as where they can be modified
during execution time, whether they are meta-predicates, or whether they can be
during execution time, whether they are meta-predicates, or whether they can be
defined across multiple files. We next join some of these declarations.
*/
@@ -50,7 +50,7 @@ as a dynamic predicate. _P_ must be written as a predicate indicator, that is i
:- dynamic god/1.
~~~~~
a more convenient form can be used:
~~~~~
@@ -65,10 +65,10 @@ or, equivalently,
Note:
a predicate is assumed to be dynamic when
a predicate is assumed to be dynamic when
asserted before being defined.
*/
dynamic(X) :- '$access_yap_flags'(8, 0), !,
'$current_module'(M),
@@ -102,7 +102,7 @@ dynamic(X) :-
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$dynamic2'(X,Mod) :-
'$dynamic2'(X,Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
'$logical_updatable'(A//N,Mod) :- integer(N), !,
@@ -117,7 +117,7 @@ dynamic(X) :-
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$logical_updatable'(X,Mod) :-
'$logical_updatable'(X,Mod) :-
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
/** @pred public( _P_ ) is iso
@@ -144,7 +144,7 @@ defines all new or redefined predicates to be public.
'$public'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
'$do_make_public'(T, Mod).
'$public'(X, Mod) :-
'$public'(X, Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
'$do_make_public'(T, Mod) :-
@@ -250,5 +250,4 @@ discontiguous(F) :-
write(user_error,' (line '),
'$start_line'(LN), write(user_error,LN),
write(user_error,')'),
nl(user_error).
nl(user_error).

242
pl/preds.yap
View File

@@ -15,14 +15,15 @@
* *
*************************************************************************/
/** @defgroup Database Using the Clausal Data Base
@ingroup builtins
@{
/**
* @defgroup Database Using the Clausal Data Base
* @ingroup builtins
* @{
Predicates in YAP may be dynamic or static. By default, when
consulting or reconsulting, predicates are assumed to be static:
execution is faster and the code will probably use less space.
Static predicates impose some restrictions: in general there can be no
Static predicates impose some restrictions: in general there can be no
addition or removal of clauses for a procedure if it is being used in the
current execution.
@@ -30,12 +31,9 @@ Dynamic predicates allow programmers to change the Clausal Data Base with
the same flexibility as in C-Prolog. With dynamic predicates it is
always possible to add or remove clauses during execution and the
semantics will be the same as for C-Prolog. But the programmer should be
aware of the fact that asserting or retracting are still expensive operations,
aware of the fact that asserting or retracting are still expensive operations,
and therefore he should try to avoid them whenever possible.
*/
:- system_module( '$_preds', [abolish/1,
@@ -103,13 +101,13 @@ and therefore he should try to avoid them whenever possible.
% The next predicates are applicable only
% to dynamic code
/** @pred asserta(+ _C_) is iso
/** @pred asserta(+ _C_) is iso
Adds clause _C_ to the beginning of the program. If the predicate is
undefined, declare it as dynamic.
*/
asserta(Mod:C) :- !,
'$assert'(C,Mod,first,_,asserta(Mod:C)).
@@ -117,7 +115,7 @@ asserta(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)).
/** @pred assertz(+ _C_) is iso
/** @pred assertz(+ _C_) is iso
Adds clause _C_ to the end of the program. If the predicate is
@@ -129,7 +127,7 @@ asserting clauses for static predicates. The current version of YAP
supports this feature, but this feature is deprecated and support may go
away in future versions.
*/
assertz(Mod:C) :- !,
'$assert'(C,Mod,last,_,assertz(Mod:C)).
@@ -137,7 +135,7 @@ assertz(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)).
/** @pred assert(+ _C_)
/** @pred assert(+ _C_)
Same as assertz/1. Adds clause _C_ to the program. If the predicate is undefined,
@@ -150,7 +148,7 @@ in use and the language flag is <tt>cprolog</tt>. Note that this feature is
deprecated, if you want to assert clauses for static procedures you
should use assert_static/1.
*/
assert(Mod:C) :- !,
'$assert'(C,Mod,last,_,assert(Mod:C)).
@@ -186,7 +184,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, true, H, Mod, R)
;
'$undefined'(H,Mod) ->
'$undefined'(H,Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_fact'(H,Mod,Where,R)
@@ -211,7 +209,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, B, C0, Mod, R)
;
'$undefined'(H,Mod) ->
'$undefined'(H,Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_clause3'(C0,C,Mod,Where,R,P)
@@ -242,7 +240,7 @@ assert(C) :-
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where,H,B,C0,Mod,R)
;
'$undefined'(H, Mod) ->
'$undefined'(H, Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_dynamic2'(C0,C,Mod,Where,R,P)
@@ -251,14 +249,14 @@ assert(C) :-
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
).
/** @pred assert_static(: _C_)
/** @pred assert_static(: _C_)
Adds clause _C_ to a static procedure. Asserting a static clause
for a predicate while choice-points for the predicate are available has
undefined results.
*/
assert_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assert_static(Mod:C)).
@@ -266,12 +264,12 @@ assert_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)).
/** @pred asserta_static(: _C_)
/** @pred asserta_static(: _C_)
Adds clause _C_ to the beginning of a static procedure.
Adds clause _C_ to the beginning of a static procedure.
*/
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,first,_,asserta_static(Mod:C)).
@@ -281,7 +279,7 @@ asserta_static(C) :-
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assertz_static(Mod:C)).
/** @pred assertz_static(: _C_)
/** @pred assertz_static(: _C_)
Adds clause _C_ to the end of a static procedure. Asserting a
@@ -295,7 +293,7 @@ static predicates, if source mode was on when they were compiled:
*/
assertz_static(C) :-
'$current_module'(Mod),
@@ -328,13 +326,13 @@ assertz_static(C) :-
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
;
true
),
),
'$head_and_body'(C0, H0, B0),
'$recordap'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(Head, Mod) ->
source_location(F, _),
functor(H0, Na, Ar),
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
;
true
).
@@ -346,13 +344,13 @@ assertz_static(C) :-
( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
;
true
),
),
'$head_and_body'(C0, H0, B0),
'$recordzp'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(H0, Mod) ->
source_location(F, _),
functor(H0, Na, Ar),
recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
;
true
).
@@ -363,8 +361,8 @@ assertz_static(C) :-
'$assertz_dynamic'(X, C, C0, Mod) :- (X/\4)=:=0, !,
'$head_and_body'(C,H,B),
'$assertat_d'(last,H,B,C0,Mod,_).
'$assertz_dynamic'(X,C,C0,Mod) :-
'$head_and_body'(C,H,B),
'$assertz_dynamic'(X,C,C0,Mod) :-
'$head_and_body'(C,H,B),
functor(H,N,A),
('$check_if_reconsulted'(N,A) ->
true
@@ -396,12 +394,12 @@ assertz_static(C) :-
/** @pred asserta(+ _C_,- _R_)
The same as `asserta(C)` but unifying _R_ with
the database reference that identifies the new clause, in a
the database reference that identifies the new clause, in a
one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be
declared dynamic.
*/
asserta(M:C,R) :- !,
'$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
@@ -412,12 +410,12 @@ asserta(C,R) :-
/** @pred assertz(+ _C_,- _R_)
The same as `assertz(C)` but unifying _R_ with
the database reference that identifies the new clause, in a
the database reference that identifies the new clause, in a
one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be
declared dynamic.
*/
assertz(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assertz(M:C,R)).
@@ -433,7 +431,7 @@ clause, in a one-to-one way. Note that `asserta/2` only works for dynamic
predicates. If the predicate is undefined, it will automatically be
declared dynamic.
*/
assert(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
@@ -441,7 +439,7 @@ assert(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)).
/** @pred clause(+ _H_, _B_) is iso
/** @pred clause(+ _H_, _B_) is iso
A clause whose head matches _H_ is searched for in the
@@ -452,7 +450,7 @@ program. Its head and body are respectively unified with _H_ and
This predicate is applicable to static procedures compiled with
`source` active, and to all dynamic procedures.
*/
clause(M:P,Q) :- !,
'$clause'(P,M,Q,_).
@@ -467,7 +465,7 @@ reference to the clause in the database. You can use instance/2
to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures.
*/
clause(P,Q,R) :- var(P), !,
'$current_module'(M),
@@ -483,9 +481,9 @@ clause(V,Q,R) :-
M0 = M,
instance(R,T),
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
'$clause'(V,M,Q,R) :- var(V), !,
'$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,clause(M:V,Q,R)).
'$clause'(C,M,Q,R) :-
'$clause'(C,M,Q,R) :-
number(C), !,
'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
'$clause'(C,M,Q,R) :-
@@ -515,26 +513,26 @@ clause(V,Q,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q,R)).
'$init_preds' :-
'$init_preds' :-
once('$handle_throw'(_,_,_)),
fail.
'$init_preds' :-
'$init_preds' :-
once('$do_static_clause'(_,_,_,_,_)),
fail.
'$init_preds' :-
'$init_preds' :-
once('$do_log_upd_clause0'(_,_,_,_,_,_)),
fail.
'$init_preds' :-
'$init_preds' :-
once('$do_log_upd_clause'(_,_,_,_,_,_)),
fail.
'$init_preds' :-
'$init_preds' :-
once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
fail.
'$init_preds'.
:- '$init_preds'.
/** @pred nth_clause(+ _H_, _I_,- _R_)
/** @pred nth_clause(+ _H_, _I_,- _R_)
Find the _I_th clause in the predicate defining _H_, and give
@@ -548,7 +546,7 @@ The following predicates can only be used for dynamic predicates:
*/
nth_clause(V,I,R) :-
'$current_module'(M),
@@ -563,7 +561,7 @@ nth_clause(V,I,R) :-
'$nth_clause'(P,M,I,R) :-
'$fetch_nth_clause'(P,M,I,R).
/** @pred retract(+ _C_) is iso
/** @pred retract(+ _C_) is iso
Erases the first clause in the program that matches _C_. This
@@ -571,20 +569,20 @@ predicate may also be used for the static predicates that have been
compiled when the source mode was `on`. For more information on
source/0 ( (see Setting the Compiler)).
*/
retract(M:C) :- !,
'$retract'(C,M).
retract(C) :-
'$current_module'(M),
'$retract'(C,M).
'$retract'(V,_) :- var(V), !,
'$do_error'(instantiation_error,retract(V)).
'$retract'(M:C,_) :- !,
'$retract'(C,M).
'$retract'(C,M) :-
'$retract'(C,M) :-
'$check_head_and_body'(C,H,B,retract(M:C)), !,
'$flags'(H, M, F, F),
'$retract2'(F, H,M,B,_).
@@ -595,24 +593,24 @@ retract(C) :-
'$log_update_clause'(H,M,B,R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
erase(R).
'$retract2'(F, H, M, B, R) :-
'$retract2'(F, H, M, B, R) :-
% '$is_dynamic'(H,M), !,
F /\ 0x00002000 =:= 0x00002000, !,
'$recordedp'(M:H,(H:-B),R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
erase(R).
'$retract2'(_, H,M,_,_) :-
'$retract2'(_, H,M,_,_) :-
'$undefined'(H,M), !,
functor(H,Na,Ar),
'$dynamic'(Na/Ar,M),
fail.
'$retract2'(_, H,M,B,_) :-
'$retract2'(_, H,M,B,_) :-
functor(H,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))).
/** @pred retract(+ _C_,- _R_)
Erases from the program the clause _C_ whose
Erases from the program the clause _C_ whose
database reference is _R_. The predicate must be dynamic.
@@ -645,9 +643,9 @@ retract(C,R) :-
functor(C, Na, Ar).
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
functor(C, Na, Ar).
/** @pred retractall(+ _G_) is iso
/** @pred retractall(+ _G_) is iso
Retract all the clauses whose head matches the goal _G_. Goal
@@ -689,7 +687,7 @@ retractall(V) :-
functor(T,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
).
'$retractall_lu'(T,M) :-
'$free_arguments'(T), !,
( '$purge_clauses'(T,M), fail ; true ).
@@ -717,14 +715,14 @@ retractall(V) :-
Completely delete the predicate with name _P_ and arity _N_. It will
remove both static and dynamic predicates. All state on the predicate,
including whether it is dynamic or static, multifile, or
meta-predicate, will be lost.
meta-predicate, will be lost.
*/
abolish(Mod:N,A) :- !,
'$abolish'(N,A,Mod).
abolish(N,A) :-
'$current_module'(Mod),
'$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !,
'$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- var(A), !,
@@ -736,7 +734,7 @@ abolish(N,A) :-
( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
/* else */ '$abolishs'(T,M) ).
/** @pred abolish(+ _PredSpec_) is iso
/** @pred abolish(+ _PredSpec_) is iso
Deletes the predicate given by _PredSpec_ from the database. If
@@ -744,9 +742,9 @@ Deletes the predicate given by _PredSpec_ from the database. If
current module. The
specification must include the name and arity, and it may include module
information. Under <tt>iso</tt> language mode this built-in will only abolish
dynamic procedures. Under other modes it will abolish any procedures.
dynamic procedures. Under other modes it will abolish any procedures.
*/
abolish(V) :- var(V), !,
'$do_error'(instantiation_error,abolish(V)).
@@ -754,14 +752,14 @@ abolish(Mod:V) :- var(V), !,
'$do_error'(instantiation_error,abolish(Mod:V)).
abolish(M:X) :- !,
'$abolish'(X,M).
abolish(X) :-
abolish(X) :-
'$current_module'(M),
'$abolish'(X,M).
'$abolish'(X,M) :-
'$abolish'(X,M) :-
'$access_yap_flags'(8, 2), !,
'$new_abolish'(X,M).
'$abolish'(X, M) :-
'$abolish'(X, M) :-
'$old_abolish'(X,M).
'$new_abolish'(V,M) :- var(V), !,
@@ -858,7 +856,7 @@ abolish(X) :-
'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M).
'$old_abolish'(T, M) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all_old'(M) :-
'$current_predicate'(Na, M, S, _),
functor( S, Na, Ar ),
@@ -913,14 +911,14 @@ abolish(X) :-
'$purge_clauses'(G, M), fail.
'$abolishs'(_, _).
/** @pred dynamic_predicate(+ _P_,+ _Semantics_)
/** @pred dynamic_predicate(+ _P_,+ _Semantics_)
Declares predicate _P_ or list of predicates [ _P1_,..., _Pn_]
as a dynamic predicate following either `logical` or
`immediate` semantics.
*/
dynamic_predicate(P,Sem) :-
'$bad_if_is_semantics'(Sem, dynamic(P,Sem)).
@@ -999,11 +997,11 @@ hide_predicate(P) :-
'$hide_predicate2'(PredDesc, M) :-
'$do_error'(type_error(predicate_indicator,PredDesc),hide_predicate(M:PredDesc)).
/** @pred predicate_property( _P_, _Prop_) is iso
/** @pred predicate_property( _P_, _Prop_) is iso
For the predicates obeying the specification _P_ unify _Prop_
with a property of _P_. These properties may be:
with a property of _P_. These properties may be:
+ `built_in `
true for built-in predicates,
@@ -1042,30 +1040,29 @@ Number of clauses in the predicate definition. Always one if external
or built-in.
*/
predicate_property(Pred,Prop) :- var(Pred), !,
'$current_module'(Mod),
'$predicate_property2'(Pred,Prop,Mod).
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(M), !,
'$all_current_modules'(M),
'$predicate_property2'(Pred,Prop,M).
'$predicate_property2'(Pred,Prop,M0) :- var(Pred), !,
(M = M0 ; M = prolog), % prolog mode is automatically incorporate in every other module
*/
predicate_property(Pred,Prop) :-
strip_module(Pred, Mod, TruePred),
'$predicate_property2'(TruePred,Prop,Mod).
'$predicate_property2'(Pred, Prop, Mod) :-
var(Mod), !,
'$all_current_modules'(Mod),
'$predicate_property2'(Pred, Prop, Mod).
'$predicate_property2'(Pred,Prop,M0) :-
var(Pred), !,
(M = M0 ;
M = prolog ;
M = user), % prolog and user modules are automatically incorporate in every other module
'$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) :-
'$predicate_property2'(Pred,Prop,Mod) :-
'$pred_exists'(Pred,Mod), !,
'$predicate_property'(Pred,Mod,Mod,Prop).
'$predicate_property2'(Pred,Prop,Mod) :-
'$predicate_property2'(Pred,Prop,Mod) :-
'$imported_pred'(Pred, Mod, NPred, M),
(
Prop = imported_from(M)
@@ -1080,12 +1077,12 @@ predicate_property(Pred,Prop) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
'$pred_exists'(Orig, SourceMod).
'$predicate_property'(P,M,_,built_in) :-
'$predicate_property'(P,M,_,built_in) :-
'$system_predicate'(P,M).
'$predicate_property'(P,M,_,source) :-
'$predicate_property'(P,M,_,source) :-
'$flags'(P,M,F,F),
F /\ 0x00400000 =\= 0.
'$predicate_property'(P,M,_,tabled) :-
'$predicate_property'(P,M,_,tabled) :-
'$flags'(P,M,F,F),
F /\ 0x00000040 =\= 0.
'$predicate_property'(P,M,_,dynamic) :-
@@ -1140,7 +1137,7 @@ predicate_statistics(P,NCls,Sz,ISz) :-
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$static_pred_statistics'(P,M,NCls,Sz,ISz).
/** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
/** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
Given predicate _P_, _NCls_ is the number of erased clauses for
@@ -1153,7 +1150,7 @@ of space required to store indices to those clauses (in bytes).
*/
predicate_erased_statistics(P,NCls,Sz,ISz) :-
var(P), !,
var(P), !,
current_predicate(_,P),
predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !,
@@ -1164,26 +1161,26 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
/** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/
current_predicate(A,T) :-
'$ground_module'(T, M, T0),
format('`0 ~w~n', [M:T0]),
(
'$current_predicate'(A, M, T0, Flags),
%TFlags is Flags /\ 0x00004000,
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
Flags /\ 0x00004000 =:= 0x0
;
'$imported_predicate'(A, M, A/_Arity, T0, Flags),
% format('2 ~w ~16r~n', [M:T0,Flags]),
Flags /\ 0x00004000 =:= 0x0
).
/** @pred system_predicate( _A_, _P_)
'$ground_module'(T, M, T0),
(
'$current_predicate'(A, M, T0, _),
%TFlags is Flags /\ 0x00004000,
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
\+ '$system_predicate'(T0, M)
;
'$imported_pred'(T0, M, SourceT, SourceMod),
functor(T0, A, _),
% format('2 ~w ~16r~n', [M:T0,Flags]),
\+ '$system_predicate'(SourceT, SourceMod)
).
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
/** @pred system_predicate( _A_, _P_)
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
*/
system_predicate(A,T) :-
@@ -1211,15 +1208,17 @@ system_predicate(P) :-
_Na_ is the name of the predicate, and _Ar_ its arity.
*/
current_predicate(F0) :-
'$ground_module'(F0, M, F),
strip_module(F0, M, F),
(
'$current_predicate'(N, M, S, _),
functor( S, N, Ar),
F = N/Ar
;
'$imported_predicate'(_Name, M, F, S, _)
),
\+ system_predicate(_, S).
var(F)
->
current_predicate(M:A, S),
functor( S, A, Ar)
;
F = A/Ar,
current_predicate(M:A, S),
functor( S, A, Ar)
).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
@@ -1227,7 +1226,7 @@ current_predicate(F0) :-
'$pred_exists'(G, ExportingMod),
'$flags'(G0, ExportingMod, Flags, Flags).
/** @pred current_key(? _A_,? _K_)
/** @pred current_key(? _A_,? _K_)
Defines the relation: _K_ is a currently defined database key whose
@@ -1248,7 +1247,7 @@ current_key(A,K) :-
).
/** @pred compile_predicates(: _ListOfNameArity_)
/** @pred compile_predicates(: _ListOfNameArity_)
@@ -1319,4 +1318,3 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
/**
@}
*/

29
pl/setof.yap
View File

@@ -31,7 +31,7 @@ post-process the result of the query in several different ways:
*/
:- system_module( '$_setof', [(^)/2,
@@ -61,7 +61,7 @@ _^Goal :-
% existential quantifier on every variable.
/** @pred findall( _T_,+ _G_,- _L_) is iso
/** @pred findall( _T_,+ _G_,- _L_) is iso
Unifies _L_ with a list that contains all the instantiations of the
@@ -88,7 +88,7 @@ L = [2,1,2];
no
~~~~~
*/
findall(Template, Generator, Answers) :-
@@ -105,7 +105,7 @@ findall(Template, Generator, Answers) :-
Similar to findall/3, but appends all answers to list _L0_.
*/
findall(Template, Generator, Answers, SoFar) :-
'$findall'(Template, Generator, SoFar, Answers).
@@ -142,9 +142,9 @@ findall(Template, Generator, Answers, SoFar) :-
'$collect_with_common_vars'([Key-_|Answers], VarList) :-
'$variables_in_term'(Key, _, VarList),
'$collect_with_common_vars'(Answers, VarList).
% This is the setof predicate
/** @pred setof( _X_,+ _P_,- _B_) is iso
/** @pred setof( _X_,+ _P_,- _B_) is iso
Similar to `bagof( _T_, _G_, _L_)` but sorts list
@@ -185,7 +185,7 @@ setof(Template, Generator, Set) :-
% and we need to find the solutions for each instantiation
% of these variables
/** @pred bagof( _T_,+ _G_,- _L_) is iso
/** @pred bagof( _T_,+ _G_,- _L_) is iso
For each set of possible instances of the free variables occurring in
@@ -206,7 +206,7 @@ L = [2];
no
~~~~~
*/
bagof(Template, Generator, Bag) :-
( '$is_list_or_partial_list'(Bag) ->
@@ -254,8 +254,8 @@ bagof(Template, Generator, Bag) :-
% as an alternative to setof you can use the predicate all(Term,Goal,Solutions)
% But this version of all does not allow for repeated answers
% if you want them use findall
/** @pred all( _T_,+ _G_,- _L_)
% if you want them use findall
/** @pred all( _T_,+ _G_,- _L_)
Similar to `findall( _T_, _G_, _L_)` but eliminate
@@ -276,10 +276,10 @@ no
Note that all/3 will fail if no answers are found.
*/
all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :-
all(T,G,S) :-
'$init_db_queue'(Ref),
( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G),
@@ -290,7 +290,7 @@ all(T,G,S) :-
).
% $$set does its best to preserve space
'$$set'(S,R) :-
'$$set'(S,R) :-
'$$build'(S0,_,R),
S0 = [_|_],
S = S0.
@@ -306,7 +306,7 @@ all(T,G,S) :-
'$$build'(Ns,Hash,R).
'$$new'(V,El) :- var(V), !, V = n(_,El,_).
'$$new'(n(R,El0,L),El) :-
'$$new'(n(R,El0,L),El) :-
compare(C,El0,El),
'$$new'(C,R,L,El).
@@ -327,4 +327,3 @@ all(T,G,S) :-
/**
@}
*/

29
pl/sort.yap
View File

@@ -39,7 +39,7 @@
% length of a list.
/** @pred length(? _L_,? _S_)
/** @pred length(? _L_,? _S_)
Unify the well-defined list _L_ with its length. The procedure can
@@ -78,13 +78,13 @@ length(L, M) :-
( N =:= O -> NL = [];
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
/** @pred sort(+ _L_,- _S_) is iso
/** @pred sort(+ _L_,- _S_) is iso
Unifies _S_ with the list obtained by sorting _L_ and merging
identical (in the sense of `==`) elements.
*/
sort(L,O) :-
'$skip_list'(NL,L,RL),
@@ -113,7 +113,7 @@ sort(L,O) :-
msort(L,O) :-
'$msort'(L,O).
/** @pred keysort(+ _L_, _S_) is iso
/** @pred keysort(+ _L_, _S_) is iso
Assuming L is a list of the form ` _Key_- _Value_`,
@@ -130,7 +130,7 @@ would return:
S = [1-b,1-a,1-b,2-c,3-a]
~~~~~
*/
keysort(L,O) :-
'$skip_list'(NL,L,RL),
@@ -159,7 +159,7 @@ keysort(L,O) :-
% Delta with one of <, > or =. If built-in predicate compare/3 is
% used, the result is the same as sort/2. See also keysort/2.
/** @pred predsort(+ _Pred_, + _List_, - _Sorted_)
/** @pred predsort(+ _Pred_, + _List_, - _Sorted_)
Sorts similar to sort/2, but determines the order of two terms by
@@ -168,23 +168,23 @@ unify _Delta_ with one of `<`, `>` or `=`. If
built-in predicate compare/3 is used, the result is the same as
sort/2.
*/
predsort(P, L, R) :-
length(L, N),
predsort(P, N, L, _, R1), !,
length(L, N),
predsort(P, N, L, _, R1), !,
R = R1.
predsort(P, 2, [X1, X2|L], L, R) :- !,
predsort(P, 2, [X1, X2|L], L, R) :- !,
call(P, Delta, X1, X2),
sort2(Delta, X1, X2, R).
predsort(_, 1, [X|L], L, [X]) :- !.
predsort(_, 0, L, L, []) :- !.
predsort(P, N, L1, L3, R) :-
N1 is N // 2,
plus(N1, N2, N),
predsort(P, N1, L1, L2, R1),
predsort(P, N2, L2, L3, R2),
N1 is N // 2,
plus(N1, N2, N),
predsort(P, N1, L1, L2, R1),
predsort(P, N2, L2, L3, R2),
predmerge(P, R1, R2, R).
sort2(<, X1, X2, [X1, X2]).
@@ -205,4 +205,3 @@ predmerge(<, P, H1, H2, T1, T2, [H1|R]) :-
predmerge(P, T1, [H2|T2], R).
%%! @}