flags etc
This commit is contained in:
Vítor Santos Costa
parent
b93f10fe07
commit
0889596e8b
|
|
@ -641,7 +641,7 @@ b_getval(GlobalVariable, Val) :-
|
|||
nb_getval('$trace',Trace),
|
||||
nb_getval('$debug_jump',Jump),
|
||||
nb_getval('$debug_run',Run),
|
||||
'$swi_current_prolog_flag'(debug, Debug),
|
||||
current_prolog_flag(debug, Debug),
|
||||
nb_getval('$spy_gn',SPY_GN),
|
||||
b_getval('$spy_glist',GList).
|
||||
|
||||
|
|
@ -649,14 +649,14 @@ b_getval(GlobalVariable, Val) :-
|
|||
'$debug_stop'( State ) :-
|
||||
'$debug_state'( State ),
|
||||
b_setval('$trace',off),
|
||||
'$swi_set_prolog_flag'(debug, false),
|
||||
set_prolog_flag(debug, false),
|
||||
b_setval('$spy_glist',[]),
|
||||
'$disable_debugging'.
|
||||
|
||||
'$debug_restart'(state(Trace, Debug, Jump, Run, SPY_GN, GList)) :-
|
||||
b_setval('$spy_glist',GList),
|
||||
b_setval('$spy_gn',SPY_GN),
|
||||
'$swi_set_prolog_flag'(debug, Debug),
|
||||
set_prolog_flag(debug, Debug),
|
||||
b_setval('$debug_jump',Jump),
|
||||
b_setval('$debug_run',Run),
|
||||
b_setval('$trace',Trace),
|
||||
|
|
@ -684,14 +684,14 @@ break :-
|
|||
nb_setval('$trace',off),
|
||||
nb_getval('$debug_jump',Jump),
|
||||
nb_getval('$debug_run',Run),
|
||||
'$swi_current_prolog_flag'(debug, Debug),
|
||||
'$swi_set_prolog_flag'(debug, false),
|
||||
current_prolog_flag(debug, Debug),
|
||||
set_prolog_flag(debug, false),
|
||||
'$break'( true ),
|
||||
nb_getval('$spy_gn',SPY_GN),
|
||||
b_getval('$spy_glist',GList),
|
||||
b_setval('$spy_glist',[]),
|
||||
current_output(OutStream), current_input(InpStream),
|
||||
'$swi_current_prolog_flag'(break_level, NBL ),
|
||||
current_prolog_flag(break_level, NBL ),
|
||||
format(user_error, '% Break (level ~w)~n', [NBL]),
|
||||
'$do_live',
|
||||
!,
|
||||
|
|
@ -700,7 +700,7 @@ break :-
|
|||
nb_setval('$spy_gn',SPY_GN),
|
||||
set_input(InpStream),
|
||||
set_output(OutStream),
|
||||
'$swi_set_prolog_flag'(debug, Debug),
|
||||
set_prolog_flag(debug, Debug),
|
||||
nb_setval('$debug_jump',Jump),
|
||||
nb_setval('$debug_run',Run),
|
||||
nb_setval('$trace',Trace),
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@
|
|||
'$safe_builtin'(A, M).
|
||||
|
||||
'$safe_builtin'(G, Mod) :-
|
||||
'$flags'(G, Mod, Fl, Fl),
|
||||
'$predicate_flags'(G, Mod, Fl, Fl),
|
||||
Fl /\ 0x00008880 =\= 0.
|
||||
|
||||
'$vmember'(V,[V1|_]) :- V == V1, !.
|
||||
|
|
|
|||
10
pl/lists.yap
10
pl/lists.yap
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
:- system_module( '$_lists', [], []).
|
||||
|
||||
:- '$set_yap_flags'(11,1). % source.
|
||||
:- set_prolog_flag(source, true). % source.
|
||||
|
||||
% memberchk(+Element, +Set)
|
||||
% means the same thing, but may only be used to test whether a known
|
||||
|
|
@ -52,7 +52,7 @@ lists:append([H|T], L, [H|R]) :-
|
|||
lists:append(T, L, R).
|
||||
|
||||
|
||||
:- '$set_yap_flags'(11,0). % :- no_source.
|
||||
:- set_prolog_flag(source, false)). % :- no_source.
|
||||
|
||||
% lists:delete(List, Elem, Residue)
|
||||
% is true when List is a list, in which Elem may or may not occur, and
|
||||
|
|
@ -60,12 +60,12 @@ lists:append([H|T], L, [H|R]) :-
|
|||
|
||||
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
|
||||
|
||||
|
||||
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
|
||||
True when _List_ is a list, in which _Element_ may or may not
|
||||
occur, and _Residue_ is a copy of _List_ with all elements
|
||||
identical to _Element_ deleted.
|
||||
|
||||
|
||||
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
|
||||
*/
|
||||
lists:delete([], _, []).
|
||||
lists:delete([Head|List], Elem, Residue) :-
|
||||
|
|
@ -74,5 +74,5 @@ lists:delete([Head|List], Elem, Residue) :-
|
|||
lists:delete([Head|List], Elem, [Head|Residue]) :-
|
||||
lists:delete(List, Elem, Residue).
|
||||
|
||||
:- '$set_yap_flags'(11,0). % disable source.
|
||||
:- set_prolog_flag(source, false). % disable source.
|
||||
|
||||
|
|
|
|||
|
|
@ -110,10 +110,10 @@ load_foreign_files(Objs,Libs,Entry) :-
|
|||
'$do_error'(type_error(atom,Lib),G).
|
||||
|
||||
'$process_obj_suffix'(Obj,Obj) :-
|
||||
'$swi_current_prolog_flag'(shared_object_extension, ObjSuffix),
|
||||
current_prolog_flag(shared_object_extension, ObjSuffix),
|
||||
sub_atom(Obj, _, _, 0, ObjSuffix), !.
|
||||
'$process_obj_suffix'(Obj,NewObj) :-
|
||||
'$swi_current_prolog_flag'(shared_object_extension, ObjSuffix),
|
||||
current_prolog_flag(shared_object_extension, ObjSuffix),
|
||||
atom_concat([Obj,'.',ObjSuffix],NewObj).
|
||||
|
||||
'$checklib_prefix'(F,F) :- is_absolute_file_name(F), !.
|
||||
|
|
|
|||
|
|
@ -608,7 +608,7 @@ prolog:print_message_lines(S, P, Lines) :-
|
|||
print_message_line(S, [flush], []) :- !,
|
||||
flush_output(S).
|
||||
print_message_line(S, [], []) :- !,
|
||||
nl(S).
|
||||
format(S, '~N', []).
|
||||
print_message_line(S, [nl|T], T) :- !,
|
||||
nl(S).
|
||||
print_message_line(S, [begin(_,_)|T0], T) :- !,
|
||||
|
|
@ -625,7 +625,7 @@ print_message_line(S, [Fmt|T0], T) :-
|
|||
|
||||
prefix(help, '', user_error) --> [].
|
||||
prefix(query, '', user_error) --> [].
|
||||
prefix(debug, '', user_output) --> [].
|
||||
prefix(debug, '', user_error) --> [].
|
||||
prefix(warning, '', user_error) -->
|
||||
{ thread_self(Id) },
|
||||
( { Id == main }
|
||||
|
|
@ -683,3 +683,7 @@ pred_arity(H,Name,Arity) :-
|
|||
@}
|
||||
@}
|
||||
*/
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -947,9 +947,9 @@ meta_predicate declaration
|
|||
( M1 = prolog -> M = _ ; M1 = M),
|
||||
( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
|
||||
asserta(prolog:'$meta_predicate'(F,M,N,P)),
|
||||
'$flags'(P, M1, Fl, Fl),
|
||||
'$predicate_flags'(P, M1, Fl, Fl),
|
||||
NFlags is Fl \/ 0x200000,
|
||||
'$flags'(P, M1, Fl, NFlags).
|
||||
'$predicate_flags'(P, M1, Fl, NFlags).
|
||||
|
||||
% return list of vars in expanded positions on the head of a clause.
|
||||
%
|
||||
|
|
@ -1057,9 +1057,9 @@ its parent goal.
|
|||
'$module_transparent'(F/N, M) :-
|
||||
functor(P,F,N),
|
||||
asserta(prolog:'$module_transparent'(F,M,N,P)),
|
||||
'$flags'(P, M, Fl, Fl),
|
||||
'$predicate_flags'(P, M, Fl, Fl),
|
||||
NFlags is Fl \/ 0x200004,
|
||||
'$flags'(P, M, Fl, NFlags).
|
||||
'$predicate_flags'(P, M, Fl, NFlags).
|
||||
|
||||
%% handle module transparent predicates by defining a
|
||||
%% new context module.
|
||||
|
|
@ -1397,6 +1397,7 @@ export_list(Module, List) :-
|
|||
'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
|
||||
op(Prio,Assoc,ContextMod:Name).
|
||||
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
|
||||
'$do_import'(N0/K0-N0/K0, Mod, prolog) :- !.
|
||||
'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
|
||||
recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
|
||||
once(lists:member(N1/K, MyExports)),
|
||||
|
|
|
|||
|
|
@ -70,7 +70,8 @@ asserted before being defined.
|
|||
|
||||
|
||||
*/
|
||||
dynamic(X) :- '$access_yap_flags'(8, 0), !,
|
||||
dynamic(X) :-
|
||||
current_prolog_flag(language, yap), !,
|
||||
'$current_module'(M),
|
||||
'$dynamic'(X, M).
|
||||
dynamic(X) :-
|
||||
|
|
@ -94,12 +95,12 @@ dynamic(X) :-
|
|||
'$dynamic2'(A/N, Mod).
|
||||
'$dynamic2'(A/N, Mod) :-
|
||||
integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
functor(T,A,N), '$predicate_flags'(T,Mod,F,F),
|
||||
% LogUpd,BinaryTest,Safe,C,Dynamic,Compiled,Standard,Asm,
|
||||
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
|
||||
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$predicate_flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
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);
|
||||
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$predicate_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) :-
|
||||
|
|
@ -109,12 +110,12 @@ dynamic(X) :-
|
|||
N1 is N+2,
|
||||
'$logical_updatable'(A/N1,Mod).
|
||||
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
functor(T,A,N), '$predicate_flags'(T,Mod,F,F),
|
||||
(
|
||||
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$predicate_flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$predicate_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) :-
|
||||
|
|
@ -150,9 +151,9 @@ defines all new or redefined predicates to be public.
|
|||
'$do_make_public'(T, Mod) :-
|
||||
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
|
||||
'$do_make_public'(T, Mod) :-
|
||||
'$flags'(T,Mod,F,F),
|
||||
'$predicate_flags'(T,Mod,F,F),
|
||||
NF is F\/0x00400000,
|
||||
'$flags'(T,Mod,F,NF).
|
||||
'$predicate_flags'(T,Mod,F,NF).
|
||||
|
||||
|
||||
/** @pred multifile( _P_ ) is iso
|
||||
|
|
@ -241,7 +242,7 @@ discontiguous(F) :-
|
|||
% so this is not a multi-file predicate any longer.
|
||||
functor(Hd,Na,Ar),
|
||||
NFl is \(0x20000000) /\ Fl,
|
||||
'$flags'(Hd,M,Fl,NFl),
|
||||
'$predicate_flags'(Hd,M,Fl,NFl),
|
||||
'$warn_mfile'(Na,Ar).
|
||||
|
||||
'$warn_mfile'(F,A) :-
|
||||
|
|
@ -251,3 +252,10 @@ discontiguous(F) :-
|
|||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
|
||||
'$is_public'(T, Mod) :-
|
||||
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
|
||||
'$is_public'(T, Mod) :-
|
||||
'$predicate_flags'(T,Mod,F,F),
|
||||
F\/0x00400000 =\= 0.
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,476 @@
|
|||
% The next predicates are applicable only
|
||||
% to dynamic code
|
||||
|
||||
/** @file preddyns.yap */
|
||||
|
||||
/**
|
||||
* @ingroup Database
|
||||
* @{
|
||||
|
||||
Next follow the main operations on dynamic predicates.
|
||||
|
||||
*/
|
||||
|
||||
/** @pred asserta(+ _C_) is iso
|
||||
|
||||
|
||||
Adds clause _C_ to the beginning of the program. If the predicate is
|
||||
undefined, it is declared dynamic (see dynamic/1).
|
||||
|
||||
*/
|
||||
asserta(Mod:C) :- !,
|
||||
'$assert'(C,Mod,first,_,asserta(Mod:C)).
|
||||
asserta(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,first,_,asserta(C)).
|
||||
|
||||
/** @pred assertz(+ _C_) is iso
|
||||
|
||||
|
||||
Adds clause _C_ to the end of the program. If the predicate is
|
||||
undefined, it is declared dynamic (see dynamic/1).
|
||||
|
||||
Most Prolog systems only allow asserting clauses for dynamic
|
||||
predicates. This is also as specified in the ISO standard. YAP also allows
|
||||
asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks.
|
||||
*/
|
||||
assertz(Mod:C) :- !,
|
||||
'$assert'(C,Mod,last,_,assertz(Mod:C)).
|
||||
assertz(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,last,_,assertz(C)).
|
||||
|
||||
/** @pred assert(+ _C_)
|
||||
|
||||
Same as assertz/1. Adds clause _C_ to the program. If the predicate is undefined,
|
||||
declare it as dynamic. New code should use assertz/1 for better portability.
|
||||
|
||||
Most Prolog systems only allow asserting clauses for dynamic
|
||||
predicates. This is also as specified in the ISO standard. YAP allows
|
||||
asserting clauses for static predicates, as long as the predicate is not
|
||||
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)).
|
||||
assert(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,last,_,assert(C)).
|
||||
|
||||
'$assert'(V,Mod,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(V,Mod,_,_,_) :- var(Mod), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(I,Mod,_,_,_) :- number(I), !,
|
||||
'$do_error'(type_error(callable,I),assert(Mod:I)).
|
||||
'$assert'(M:C,_,Where,R,P) :- !,
|
||||
'$assert'(C,M,Where,R,P).
|
||||
'$assert'((H:-G),M1,Where,R,P) :- !,
|
||||
'$assert_clause'(H, G, M1, Where, R, P).
|
||||
'$assert'(H,M1,Where,R,_) :-
|
||||
strip_module(M1:H, HM, H1),
|
||||
'$assert_fact'(H1, HM, Where, R).
|
||||
|
||||
'$assert_clause'(H, _, _, _, _, P) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_clause'(M1:C, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(C, G, M1, Where, R, P).
|
||||
'$assert_clause'(H, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(H, G, M1, Where, R, P).
|
||||
|
||||
'$assert_fact'(H,Mod,Where,R) :-
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'(H, Where, H, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, true, H, Mod, R)
|
||||
;
|
||||
'$undefined'(H,Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_fact'(H,Mod,Where,R)
|
||||
;
|
||||
current_prolog_flag(language, yap)) -> % I can assert over static facts in YAP mode
|
||||
'$assert1'(Where,H,H,Mod,H)
|
||||
;
|
||||
functor(H, Na, Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),Mod:assert(H))
|
||||
).
|
||||
|
||||
|
||||
'$assert_clause2'(HI,BI,Mod,Where,R,P) :-
|
||||
'$expand_clause'((HI :- BI),C0,C,Mod,HM),
|
||||
'$assert_clause3'(C0,C,HM,Where,R,P).
|
||||
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P) :-
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'((H :- B), Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, B, C0, Mod, R)
|
||||
;
|
||||
'$undefined'(H,Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P)
|
||||
;
|
||||
current_prolog_flag(language, sicstus)) -> % I can assert over static facts in YAP mode
|
||||
'$assert1'(Where,C,C0,Mod,H)
|
||||
;
|
||||
functor(H, Na, Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
|
||||
).
|
||||
|
||||
|
||||
'$assert_dynamic'(V,Mod,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert_dynamic'(M:C,_,Where,R,P) :- !,
|
||||
'$assert_dynamic'(C,M,Where,R,P).
|
||||
'$assert_dynamic'((H:-_G),_M1,_Where,_R,P) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_dynamic'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod,HM),
|
||||
'$assert_dynamic2'(C0,C,HM,Where,R,P).
|
||||
|
||||
'$assert_dynamic2'(C0,C,Mod,Where,R,P) :-
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'(C, Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where,H,B,C0,Mod,R)
|
||||
;
|
||||
'$undefined'(H, Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_dynamic2'(C0,C,Mod,Where,R,P)
|
||||
;
|
||||
functor(H,Na,Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
|
||||
).
|
||||
|
||||
/** @pred asserta(+ _C_,- _R_)
|
||||
|
||||
The same as `asserta(C)` but unifying _R_ with
|
||||
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)).
|
||||
asserta(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,first,R,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
|
||||
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)).
|
||||
assertz(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
|
||||
|
||||
/** @pred assert(+ _C_,- _R_)
|
||||
|
||||
The same as `assert(C)` ( (see Modifying the Database)) but
|
||||
unifies _R_ with 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.
|
||||
|
||||
|
||||
*/
|
||||
assert(M:C,R) :- !,
|
||||
'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
|
||||
assert(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assert(C,R)).
|
||||
|
||||
|
||||
'$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),
|
||||
functor(H,N,A),
|
||||
('$check_if_reconsulted'(N,A) ->
|
||||
true
|
||||
;
|
||||
(X/\8)=:=0 ->
|
||||
'$inform_as_reconsulted'(N,A),
|
||||
'$remove_all_d_clauses'(H,Mod)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$assertat_d'(last,H,B,C0,Mod,_).
|
||||
|
||||
|
||||
'$remove_all_d_clauses'(H,M) :-
|
||||
'$is_multifile'(H, M), !,
|
||||
functor(H, Na, A),
|
||||
'$erase_all_mf_dynamic'(Na,A,M).
|
||||
'$remove_all_d_clauses'(H,M) :-
|
||||
'$recordedp'(M:H,_,R), erase(R), fail.
|
||||
'$remove_all_d_clauses'(_,_).
|
||||
|
||||
'$erase_all_mf_dynamic'(Na,A,M) :-
|
||||
source_location( F , _),
|
||||
recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
|
||||
erase(R1),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_all_mf_dynamic'(_,_,_).
|
||||
|
||||
'$assertat_d'(first,Head,Body,C0,Mod,R) :- !,
|
||||
'$compile_dynamic'((Head:-Body), first, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( 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), _)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$assertat_d'(last,Head,Body,C0,Mod,R) :-
|
||||
'$compile_dynamic'((Head:-Body), last, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$predicate_flags'(Head,Mod,Fl,Fl),
|
||||
( 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), _)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
/** @pred retract(+ _C_) is iso
|
||||
|
||||
|
||||
Erases the first clause in the program that matches _C_. This
|
||||
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) :-
|
||||
'$check_head_and_body'(C,H,B,retract(M:C)), !,
|
||||
'$predicate_flags'(H, M, F, F),
|
||||
'$retract2'(F, H,M,B,_).
|
||||
|
||||
'$retract2'(F, H, M, B, R) :-
|
||||
F /\ 0x08000000 =:= 0x08000000, !,
|
||||
% '$is_log_updatable'(H, M), !,
|
||||
'$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) :-
|
||||
% '$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,_,_) :-
|
||||
'$undefined'(H,M), !,
|
||||
functor(H,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M),
|
||||
fail.
|
||||
'$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
|
||||
database reference is _R_. The predicate must be dynamic.
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
retract(M:C,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
retract(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$retract'(C,M,R).
|
||||
|
||||
'$retract'(V,M,R) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(M:V,R)).
|
||||
'$retract'(M:C,_,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
'$retract'(C, M, R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
db_reference(R), '$is_dynamic'(H,M), !,
|
||||
instance(R,(H:-B)), erase(R).
|
||||
'$retract'(C,M,R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
var(R), !,
|
||||
'$retract2'(H, M, B, R).
|
||||
'$retract'(C,M,_) :-
|
||||
'$fetch_predicate_indicator_from_clause'(C, PI),
|
||||
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
|
||||
|
||||
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
|
||||
functor(C, Na, Ar).
|
||||
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
|
||||
functor(C, Na, Ar).
|
||||
|
||||
|
||||
/** @pred retractall(+ _G_) is iso
|
||||
|
||||
|
||||
Retract all the clauses whose head matches the goal _G_. Goal
|
||||
_G_ must be a call to a dynamic predicate.
|
||||
|
||||
*/
|
||||
retractall(M:V) :- !,
|
||||
'$retractall'(V,M).
|
||||
retractall(V) :-
|
||||
'$current_module'(M),
|
||||
'$retractall'(V,M).
|
||||
|
||||
'$retractall'(V,M) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(M:V)).
|
||||
'$retractall'(M:V,_) :- !,
|
||||
'$retractall'(V,M).
|
||||
'$retractall'(T,M) :-
|
||||
(
|
||||
'$is_log_updatable'(T, M) ->
|
||||
( '$is_multifile'(T, M) ->
|
||||
'$retractall_lu_mf'(T,M)
|
||||
;
|
||||
'$retractall_lu'(T,M)
|
||||
)
|
||||
;
|
||||
\+ callable(T) ->
|
||||
'$do_error'(type_error(callable,T),retractall(T))
|
||||
;
|
||||
'$undefined'(T,M) ->
|
||||
functor(T,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M), !
|
||||
;
|
||||
'$is_dynamic'(T,M) ->
|
||||
'$erase_all_clauses_for_dynamic'(T, M)
|
||||
;
|
||||
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 ).
|
||||
'$retractall_lu'(T,M) :-
|
||||
'$log_update_clause'(T,M,_,R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$retractall_lu'(_,_).
|
||||
|
||||
'$retractall_lu_mf'(T,M) :-
|
||||
'$log_update_clause'(T,M,_,R),
|
||||
( recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
|
||||
erase(R),
|
||||
fail.
|
||||
'$retractall_lu_mf'(_,_).
|
||||
|
||||
'$erase_all_clauses_for_dynamic'(T, M) :-
|
||||
'$recordedp'(M:T,(T :- _),R), erase(R), fail.
|
||||
'$erase_all_clauses_for_dynamic'(T,M) :-
|
||||
'$recordedp'(M:T,_,_), fail.
|
||||
'$erase_all_clauses_for_dynamic'(_,_).
|
||||
|
||||
/* support for abolish/1 */
|
||||
'$abolishd'(T, M) :-
|
||||
'$is_multifile'(T,M),
|
||||
functor(T,Name,Arity),
|
||||
recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R),
|
||||
erase(R),
|
||||
erase(Ref),
|
||||
fail.
|
||||
'$abolishd'(T, M) :-
|
||||
recorded('$import','$import'(_,M,_,T,_,_),R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$abolishd'(T, M) :-
|
||||
'$purge_clauses'(T,M), fail.
|
||||
'$abolishd'(T, M) :-
|
||||
'$kill_dynamic'(T,M), fail.
|
||||
'$abolishd'(_, _).
|
||||
|
||||
|
||||
/** @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)).
|
||||
dynamic_predicate(P,Sem) :-
|
||||
'$log_upd'(OldSem),
|
||||
( Sem = logical -> '$switch_log_upd'(1) ; '$switch_log_upd'(0) ),
|
||||
'$current_module'(M),
|
||||
'$dynamic'(P, M),
|
||||
'$switch_log_upd'(OldSem).
|
||||
|
||||
'$bad_if_is_semantics'(Sem, Goal) :-
|
||||
var(Sem), !,
|
||||
'$do_error'(instantiation_error,Goal).
|
||||
'$bad_if_is_semantics'(Sem, Goal) :-
|
||||
Sem \= immediate, Sem \= logical, !,
|
||||
'$do_error'(domain_error(semantics_indicator,Sem),Goal).
|
||||
|
||||
|
||||
'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
|
||||
strip_module(Mod:H, HM, H1),
|
||||
% Mod has scope over the full clause
|
||||
'$module_expansion'((H1:-B), C1, C2, HM, Mod, Mod),
|
||||
( get_value('$strict_iso',on) ->
|
||||
'$check_iso_strict_clause'(C1)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$expand_clause'(H,H1,H1,Mod,HM) :-
|
||||
strip_module(Mod:H, HM, H1).
|
||||
|
||||
506
pl/preds.yap
506
pl/preds.yap
|
|
@ -98,157 +98,6 @@ and therefore he should try to avoid them whenever possible.
|
|||
|
||||
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1]).
|
||||
|
||||
% The next predicates are applicable only
|
||||
% to dynamic code
|
||||
|
||||
/** @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)).
|
||||
asserta(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,first,_,asserta(C)).
|
||||
|
||||
/** @pred assertz(+ _C_) is iso
|
||||
|
||||
|
||||
Adds clause _C_ to the end of the program. If the predicate is
|
||||
undefined, declare it as dynamic.
|
||||
|
||||
Most Prolog systems only allow asserting clauses for dynamic
|
||||
predicates. This is also as specified in the ISO standard. YAP allows
|
||||
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)).
|
||||
assertz(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,last,_,assertz(C)).
|
||||
|
||||
/** @pred assert(+ _C_)
|
||||
|
||||
|
||||
Same as assertz/1. Adds clause _C_ to the program. If the predicate is undefined,
|
||||
declare it as dynamic. New code should use assertz/1 for better portability.
|
||||
|
||||
Most Prolog systems only allow asserting clauses for dynamic
|
||||
predicates. This is also as specified in the ISO standard. YAP allows
|
||||
asserting clauses for static predicates, as long as the predicate is not
|
||||
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)).
|
||||
assert(C) :-
|
||||
'$current_module'(Mod),
|
||||
'$assert'(C,Mod,last,_,assert(C)).
|
||||
|
||||
'$assert'(V,Mod,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(V,Mod,_,_,_) :- var(Mod), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert'(I,Mod,_,_,_) :- number(I), !,
|
||||
'$do_error'(type_error(callable,I),assert(Mod:I)).
|
||||
'$assert'(M:C,_,Where,R,P) :- !,
|
||||
'$assert'(C,M,Where,R,P).
|
||||
'$assert'((H:-G),M1,Where,R,P) :- !,
|
||||
'$assert_clause'(H, G, M1, Where, R, P).
|
||||
'$assert'(H,M1,Where,R,_) :-
|
||||
strip_module(M1:H, HM, H1),
|
||||
'$assert_fact'(H1, HM, Where, R).
|
||||
|
||||
'$assert_clause'(H, _, _, _, _, P) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_clause'(M1:C, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(C, G, M1, Where, R, P).
|
||||
'$assert_clause'(H, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(H, G, M1, Where, R, P).
|
||||
|
||||
'$assert_fact'(H,Mod,Where,R) :-
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'(H, Where, H, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, true, H, Mod, R)
|
||||
;
|
||||
'$undefined'(H,Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_fact'(H,Mod,Where,R)
|
||||
;
|
||||
'$access_yap_flags'(14, 1) -> % I can assert over static facts in YAP mode
|
||||
'$assert1'(Where,H,H,Mod,H)
|
||||
;
|
||||
functor(H, Na, Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),Mod:assert(H))
|
||||
).
|
||||
|
||||
|
||||
'$assert_clause2'(HI,BI,Mod,Where,R,P) :-
|
||||
'$expand_clause'((HI :- BI),C0,C,Mod,HM),
|
||||
'$assert_clause3'(C0,C,HM,Where,R,P).
|
||||
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P) :-
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'((H :- B), Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where, H, B, C0, Mod, R)
|
||||
;
|
||||
'$undefined'(H,Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_clause3'(C0,C,Mod,Where,R,P)
|
||||
;
|
||||
'$access_yap_flags'(14, 1) -> % I can assert over static facts in YAP mode
|
||||
'$assert1'(Where,C,C0,Mod,H)
|
||||
;
|
||||
functor(H, Na, Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
|
||||
).
|
||||
|
||||
|
||||
'$assert_dynamic'(V,Mod,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert_dynamic'(M:C,_,Where,R,P) :- !,
|
||||
'$assert_dynamic'(C,M,Where,R,P).
|
||||
'$assert_dynamic'((H:-_G),_M1,_Where,_R,P) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_dynamic'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod,HM),
|
||||
'$assert_dynamic2'(C0,C,HM,Where,R,P).
|
||||
|
||||
'$assert_dynamic2'(C0,C,Mod,Where,R,P) :-
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
( '$is_log_updatable'(H, Mod) ->
|
||||
'$compile_dynamic'(C, Where, C0, Mod, R)
|
||||
;
|
||||
'$is_dynamic'(H, Mod) ->
|
||||
'$assertat_d'(Where,H,B,C0,Mod,R)
|
||||
;
|
||||
'$undefined'(H, Mod) ->
|
||||
functor(H, Na, Ar),
|
||||
'$dynamic'(Na/Ar, Mod),
|
||||
'$assert_dynamic2'(C0,C,Mod,Where,R,P)
|
||||
;
|
||||
functor(H,Na,Ar),
|
||||
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
|
||||
).
|
||||
|
||||
/** @pred assert_static(: _C_)
|
||||
|
||||
|
||||
|
|
@ -318,127 +167,9 @@ assertz_static(C) :-
|
|||
).
|
||||
|
||||
|
||||
'$assertat_d'(first,Head,Body,C0,Mod,R) :- !,
|
||||
'$compile_dynamic'((Head:-Body), first, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$flags'(Head,Mod,Fl,Fl),
|
||||
( 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), _)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$assertat_d'(last,Head,Body,C0,Mod,R) :-
|
||||
'$compile_dynamic'((Head:-Body), last, C0, Mod, CR),
|
||||
( get_value('$abol',true)
|
||||
->
|
||||
'$flags'(Head,Mod,Fl,Fl),
|
||||
( 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), _)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$assert1'(last,C,C0,Mod,_) :- '$compile'(C,0,C0,Mod).
|
||||
'$assert1'(first,C,C0,Mod,_) :- '$compile'(C,2,C0,Mod).
|
||||
|
||||
'$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),
|
||||
functor(H,N,A),
|
||||
('$check_if_reconsulted'(N,A) ->
|
||||
true
|
||||
;
|
||||
(X/\8)=:=0 ->
|
||||
'$inform_as_reconsulted'(N,A),
|
||||
'$remove_all_d_clauses'(H,Mod)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$assertat_d'(last,H,B,C0,Mod,_).
|
||||
|
||||
'$remove_all_d_clauses'(H,M) :-
|
||||
'$is_multifile'(H, M), !,
|
||||
functor(H, Na, A),
|
||||
'$erase_all_mf_dynamic'(Na,A,M).
|
||||
'$remove_all_d_clauses'(H,M) :-
|
||||
'$recordedp'(M:H,_,R), erase(R), fail.
|
||||
'$remove_all_d_clauses'(_,_).
|
||||
|
||||
'$erase_all_mf_dynamic'(Na,A,M) :-
|
||||
source_location( F , _),
|
||||
recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
|
||||
erase(R1),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_all_mf_dynamic'(_,_,_).
|
||||
|
||||
/** @pred asserta(+ _C_,- _R_)
|
||||
|
||||
The same as `asserta(C)` but unifying _R_ with
|
||||
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)).
|
||||
asserta(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,first,R,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
|
||||
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)).
|
||||
assertz(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
|
||||
|
||||
/** @pred assert(+ _C_,- _R_)
|
||||
|
||||
The same as `assert(C)` ( (see Modifying the Database)) but
|
||||
unifies _R_ with 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.
|
||||
|
||||
|
||||
*/
|
||||
assert(M:C,R) :- !,
|
||||
'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
|
||||
assert(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$assert_dynamic'(C,M,last,R,assert(C,R)).
|
||||
|
||||
/** @pred clause(+ _H_, _B_) is iso
|
||||
|
||||
|
||||
|
|
@ -464,8 +195,6 @@ The same as clause/2, plus _R_ is unified with the
|
|||
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),
|
||||
|
|
@ -541,12 +270,6 @@ given the head _H_ is unified with a description of the predicate
|
|||
and _I_ is bound to its position.
|
||||
|
||||
|
||||
|
||||
The following predicates can only be used for dynamic predicates:
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
nth_clause(V,I,R) :-
|
||||
'$current_module'(M),
|
||||
|
|
@ -561,155 +284,6 @@ nth_clause(V,I,R) :-
|
|||
'$nth_clause'(P,M,I,R) :-
|
||||
'$fetch_nth_clause'(P,M,I,R).
|
||||
|
||||
/** @pred retract(+ _C_) is iso
|
||||
|
||||
|
||||
Erases the first clause in the program that matches _C_. This
|
||||
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) :-
|
||||
'$check_head_and_body'(C,H,B,retract(M:C)), !,
|
||||
'$flags'(H, M, F, F),
|
||||
'$retract2'(F, H,M,B,_).
|
||||
|
||||
'$retract2'(F, H, M, B, R) :-
|
||||
F /\ 0x08000000 =:= 0x08000000, !,
|
||||
% '$is_log_updatable'(H, M), !,
|
||||
'$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) :-
|
||||
% '$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,_,_) :-
|
||||
'$undefined'(H,M), !,
|
||||
functor(H,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M),
|
||||
fail.
|
||||
'$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
|
||||
database reference is _R_. The predicate must be dynamic.
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
retract(M:C,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
retract(C,R) :-
|
||||
'$current_module'(M),
|
||||
'$retract'(C,M,R).
|
||||
|
||||
'$retract'(V,M,R) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(M:V,R)).
|
||||
'$retract'(M:C,_,R) :- !,
|
||||
'$retract'(C,M,R).
|
||||
'$retract'(C, M, R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
db_reference(R), '$is_dynamic'(H,M), !,
|
||||
instance(R,(H:-B)), erase(R).
|
||||
'$retract'(C,M,R) :-
|
||||
'$check_head_and_body'(C,H,B,retract(C,R)),
|
||||
var(R), !,
|
||||
'$retract2'(H, M, B, R).
|
||||
'$retract'(C,M,_) :-
|
||||
'$fetch_predicate_indicator_from_clause'(C, PI),
|
||||
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
|
||||
|
||||
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
|
||||
functor(C, Na, Ar).
|
||||
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
|
||||
functor(C, Na, Ar).
|
||||
|
||||
|
||||
/** @pred retractall(+ _G_) is iso
|
||||
|
||||
|
||||
Retract all the clauses whose head matches the goal _G_. Goal
|
||||
_G_ must be a call to a dynamic predicate.
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
retractall(M:V) :- !,
|
||||
'$retractall'(V,M).
|
||||
retractall(V) :-
|
||||
'$current_module'(M),
|
||||
'$retractall'(V,M).
|
||||
|
||||
'$retractall'(V,M) :- var(V), !,
|
||||
'$do_error'(instantiation_error,retract(M:V)).
|
||||
'$retractall'(M:V,_) :- !,
|
||||
'$retractall'(V,M).
|
||||
'$retractall'(T,M) :-
|
||||
(
|
||||
'$is_log_updatable'(T, M) ->
|
||||
( '$is_multifile'(T, M) ->
|
||||
'$retractall_lu_mf'(T,M)
|
||||
;
|
||||
'$retractall_lu'(T,M)
|
||||
)
|
||||
;
|
||||
\+ callable(T) ->
|
||||
'$do_error'(type_error(callable,T),retractall(T))
|
||||
;
|
||||
'$undefined'(T,M) ->
|
||||
functor(T,Na,Ar),
|
||||
'$dynamic'(Na/Ar,M), !
|
||||
;
|
||||
'$is_dynamic'(T,M) ->
|
||||
'$erase_all_clauses_for_dynamic'(T, M)
|
||||
;
|
||||
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 ).
|
||||
'$retractall_lu'(T,M) :-
|
||||
'$log_update_clause'(T,M,_,R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$retractall_lu'(_,_).
|
||||
|
||||
'$retractall_lu_mf'(T,M) :-
|
||||
'$log_update_clause'(T,M,_,R),
|
||||
( recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
|
||||
erase(R),
|
||||
fail.
|
||||
'$retractall_lu_mf'(_,_).
|
||||
|
||||
'$erase_all_clauses_for_dynamic'(T, M) :-
|
||||
'$recordedp'(M:T,(T :- _),R), erase(R), fail.
|
||||
'$erase_all_clauses_for_dynamic'(T,M) :-
|
||||
'$recordedp'(M:T,_,_), fail.
|
||||
'$erase_all_clauses_for_dynamic'(_,_).
|
||||
|
||||
/** @pred abolish(+ _P_,+ _N_)
|
||||
|
||||
Completely delete the predicate with name _P_ and arity _N_. It will
|
||||
|
|
@ -757,7 +331,7 @@ abolish(X) :-
|
|||
'$abolish'(X,M).
|
||||
|
||||
'$abolish'(X,M) :-
|
||||
'$access_yap_flags'(8, 2), !,
|
||||
current_prolog_flag(language, sicstus), !,
|
||||
'$new_abolish'(X,M).
|
||||
'$abolish'(X, M) :-
|
||||
'$old_abolish'(X,M).
|
||||
|
|
@ -837,7 +411,7 @@ abolish(X) :-
|
|||
'$do_error'(type_error(atom,M), Msg).
|
||||
|
||||
'$old_abolish'(V,M) :- var(V), !,
|
||||
( '$access_yap_flags'(8, 1) ->
|
||||
( current_prolog_flag(language, sicstus) ->
|
||||
'$do_error'(instantiation_error,abolish(M:V))
|
||||
;
|
||||
'$abolish_all_old'(M)
|
||||
|
|
@ -845,7 +419,7 @@ abolish(X) :-
|
|||
'$old_abolish'(N/A, M) :- !,
|
||||
'$abolish'(N, A, M).
|
||||
'$old_abolish'(A,M) :- atom(A), !,
|
||||
( '$access_yap_flags'(8, 1) ->
|
||||
( current_prolog_flag(language, iso) ->
|
||||
'$do_error'(type_error(predicate_indicator,A),abolish(M:A))
|
||||
;
|
||||
'$abolish_all_atoms_old'(A,M)
|
||||
|
|
@ -871,28 +445,11 @@ abolish(X) :-
|
|||
fail.
|
||||
'$abolish_all_atoms_old'(_,_).
|
||||
|
||||
'$abolishd'(T, M) :-
|
||||
'$is_multifile'(T,M),
|
||||
functor(T,Name,Arity),
|
||||
recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R),
|
||||
erase(R),
|
||||
erase(Ref),
|
||||
fail.
|
||||
'$abolishd'(T, M) :-
|
||||
recorded('$import','$import'(_,M,_,T,_,_),R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$abolishd'(T, M) :-
|
||||
'$purge_clauses'(T,M), fail.
|
||||
'$abolishd'(T, M) :-
|
||||
'$kill_dynamic'(T,M), fail.
|
||||
'$abolishd'(_, _).
|
||||
|
||||
'$abolishs'(G, M) :- '$system_predicate'(G,M), !,
|
||||
functor(G,Name,Arity),
|
||||
'$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
|
||||
'$abolishs'(G, Module) :-
|
||||
'$access_yap_flags'(8, 2), % only do this in sicstus mode
|
||||
current_prolog_flag(language, sicstus), % only do this in sicstus mode
|
||||
'$undefined'(G, Module),
|
||||
functor(G,Name,Arity),
|
||||
print_message(warning,no_match(abolish(Module:Name/Arity))).
|
||||
|
|
@ -911,50 +468,6 @@ abolish(X) :-
|
|||
'$purge_clauses'(G, M), fail.
|
||||
'$abolishs'(_, _).
|
||||
|
||||
/** @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)).
|
||||
dynamic_predicate(P,Sem) :-
|
||||
'$log_upd'(OldSem),
|
||||
( Sem = logical -> '$switch_log_upd'(1) ; '$switch_log_upd'(0) ),
|
||||
'$current_module'(M),
|
||||
'$dynamic'(P, M),
|
||||
'$switch_log_upd'(OldSem).
|
||||
|
||||
'$bad_if_is_semantics'(Sem, Goal) :-
|
||||
var(Sem), !,
|
||||
'$do_error'(instantiation_error,Goal).
|
||||
'$bad_if_is_semantics'(Sem, Goal) :-
|
||||
Sem \= immediate, Sem \= logical, !,
|
||||
'$do_error'(domain_error(semantics_indicator,Sem),Goal).
|
||||
|
||||
|
||||
'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
|
||||
strip_module(Mod:H, HM, H1),
|
||||
% Mod has scope over the full clause
|
||||
'$module_expansion'((H1:-B), C1, C2, HM, Mod, Mod),
|
||||
( get_value('$strict_iso',on) ->
|
||||
'$check_iso_strict_clause'(C1)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$expand_clause'(H,H1,H1,Mod,HM) :-
|
||||
strip_module(Mod:H, HM, H1).
|
||||
|
||||
'$is_public'(T, Mod) :-
|
||||
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
|
||||
'$is_public'(T, Mod) :-
|
||||
'$flags'(T,Mod,F,F),
|
||||
F\/0x00400000 =\= 0.
|
||||
|
||||
/** @pred stash_predicate(+ _Pred_) @anchor stash_predicate
|
||||
Make predicate _Pred_ invisible to new code, and to `current_predicate/2`,
|
||||
`listing`, and friends. New predicates with the same name and
|
||||
|
|
@ -1039,8 +552,6 @@ true if source for the predicate is available.
|
|||
Number of clauses in the predicate definition. Always one if external
|
||||
or built-in.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
predicate_property(Pred,Prop) :-
|
||||
strip_module(Pred, Mod, TruePred),
|
||||
|
|
@ -1080,10 +591,10 @@ predicate_property(Pred,Prop) :-
|
|||
'$predicate_property'(P,M,_,built_in) :-
|
||||
'$system_predicate'(P,M).
|
||||
'$predicate_property'(P,M,_,source) :-
|
||||
'$flags'(P,M,F,F),
|
||||
'$predicate_flags'(P,M,F,F),
|
||||
F /\ 0x00400000 =\= 0.
|
||||
'$predicate_property'(P,M,_,tabled) :-
|
||||
'$flags'(P,M,F,F),
|
||||
'$predicate_flags'(P,M,F,F),
|
||||
F /\ 0x00000040 =\= 0.
|
||||
'$predicate_property'(P,M,_,dynamic) :-
|
||||
'$is_dynamic'(P,M).
|
||||
|
|
@ -1145,9 +656,6 @@ Given predicate _P_, _NCls_ is the number of erased clauses for
|
|||
taken to store those clauses (in bytes), and _IndexSz_ is the amount
|
||||
of space required to store indices to those clauses (in bytes).
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
predicate_erased_statistics(P,NCls,Sz,ISz) :-
|
||||
var(P), !,
|
||||
|
|
@ -1224,7 +732,7 @@ current_predicate(F0) :-
|
|||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
|
||||
functor(G, A, Arity),
|
||||
'$pred_exists'(G, ExportingMod),
|
||||
'$flags'(G0, ExportingMod, Flags, Flags).
|
||||
'$predicate_flags'(G0, ExportingMod, Flags, Flags).
|
||||
|
||||
/** @pred current_key(? _A_,? _K_)
|
||||
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@
|
|||
%format(' ~a ~n', [M]) ,
|
||||
M \= user,
|
||||
M \= lists,
|
||||
'$flags'(T0, M, _Flags, NFlags),
|
||||
'$predicate_flags'(T0, M, _Flags, NFlags),
|
||||
NFlags is Flags \/ 0x00004000,
|
||||
%format('~w ~16r ~16r~n', [T0,Flags, NFlags]) ,
|
||||
fail.
|
||||
|
|
@ -32,11 +32,11 @@
|
|||
current_atom(Name),
|
||||
atom_codes(Name,[0'$|_]), %'
|
||||
%'$hide_predicates'(Name),
|
||||
'$hide'(Name),
|
||||
hide(Name),
|
||||
fail.
|
||||
'$protect' :-
|
||||
'$hide_predicates'(bootstrap),
|
||||
'$hide'(bootstrap).
|
||||
hide(bootstrap).
|
||||
'$protect'.
|
||||
|
||||
'$hide_predicates'(Name) :-
|
||||
|
|
|
|||
Reference in New Issue