This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/preddecls.yap

262 lines
7.9 KiB
Plaintext
Raw Normal View History

2014-04-06 17:05:17 +01:00
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: preds.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Predicate Manipulation for YAP: declaration support *
* *
*************************************************************************/
2014-04-09 12:39:29 +01:00
:- system_module( '$_preddecls', [(discontiguous)/1,
(dynamic)/1,
(multifile)/1,
(discontiguous)/1], ['$check_multifile_pred'/3,
2014-04-09 12:39:29 +01:00
'$discontiguous'/2,
'$dynamic'/2]).
:- use_system_module( '$_consult', ['$add_multifile'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
/**
@defgroup YAPPredDecls Declaring Properties of Predicates
@ingroup YAPCompilerSettings
The YAP Compiler allows the programmer to include declarations with
important pproprties of predicates, such as where they can be modified
2015-04-13 13:28:17 +01:00
during execution time, whether they are meta-predicates, or whether they can be
defined across multiple files. We next join some of these declarations.
*/
2014-04-06 17:05:17 +01:00
%
% can only do as goal in YAP mode.
%
2014-09-11 20:06:57 +01:00
/** @pred dynamic( + _P_ )
Declares predicate _P_ or list of predicates [ _P1_,..., _Pn_]
as a dynamic predicate. _P_ must be written as a predicate indicator, that is in form
_Name/Arity_ or _Module:Name/Arity_.
~~~~~
:- dynamic god/1.
~~~~~
2015-04-13 13:28:17 +01:00
2014-09-11 20:06:57 +01:00
a more convenient form can be used:
~~~~~
:- dynamic son/3, father/2, mother/2.
~~~~~
or, equivalently,
~~~~~
:- dynamic [son/3, father/2, mother/2].
~~~~~
Note:
2015-04-13 13:28:17 +01:00
a predicate is assumed to be dynamic when
2014-09-11 20:06:57 +01:00
asserted before being defined.
2015-04-13 13:28:17 +01:00
2014-09-11 20:06:57 +01:00
*/
2015-06-19 01:12:05 +01:00
dynamic(X) :-
current_prolog_flag(language, yap), !,
2014-04-06 17:05:17 +01:00
'$current_module'(M),
'$dynamic'(X, M).
dynamic(X) :-
'$do_error'(context_error(dynamic(X),declaration),query).
'$dynamic'(X,M) :- var(X), !,
'$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod).
'$dynamic'([], _) :- !.
'$dynamic'([H|L], M) :- !, '$dynamic'(H, M), '$dynamic'(L, M).
'$dynamic'((A,B),M) :- !, '$dynamic'(A,M), '$dynamic'(B,M).
'$dynamic'(X,M) :-
'$dynamic2'(X,M).
'$dynamic2'(X, Mod) :- '$log_upd'(Stat), Stat\=0, !,
'$logical_updatable'(X, Mod).
'$dynamic2'(A//N1, Mod) :-
integer(N1),
N is N1+2,
'$dynamic2'(A/N, Mod).
'$dynamic2'(A/N, Mod) :-
integer(N), atom(A), !,
2015-06-19 01:12:05 +01:00
functor(T,A,N), '$predicate_flags'(T,Mod,F,F),
2014-04-06 17:05:17 +01:00
% LogUpd,BinaryTest,Safe,C,Dynamic,Compiled,Standard,Asm,
2015-06-19 01:12:05 +01:00
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$predicate_flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
2014-04-06 17:05:17 +01:00
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
2015-06-19 01:12:05 +01:00
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);
2014-04-06 17:05:17 +01:00
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
2015-04-13 13:28:17 +01:00
'$dynamic2'(X,Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
2014-04-06 17:05:17 +01:00
'$logical_updatable'(A//N,Mod) :- integer(N), !,
N1 is N+2,
'$logical_updatable'(A/N1,Mod).
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
2015-06-19 01:12:05 +01:00
functor(T,A,N), '$predicate_flags'(T,Mod,F,F),
2014-04-06 17:05:17 +01:00
(
2015-06-19 01:12:05 +01:00
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$predicate_flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
2014-04-06 17:05:17 +01:00
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
2015-06-19 01:12:05 +01:00
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$predicate_flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
2014-04-06 17:05:17 +01:00
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
2015-04-13 13:28:17 +01:00
'$logical_updatable'(X,Mod) :-
2014-10-20 09:20:56 +01:00
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
2014-04-06 17:05:17 +01:00
/** @pred public( _P_ ) is iso
Instructs the compiler that the source of a predicate of a list of
predicates _P_ must be kept. This source is then accessible through
the clause/2 procedure and through the `listing` family of
built-ins.
Note that all dynamic procedures are public. The `source` directive
defines all new or redefined predicates to be public.
**/
'$public'(X, _) :- var(X), !,
'$do_error'(instantiation_error,public(X)).
'$public'(Mod:Spec, _) :- !,
'$public'(Spec,Mod).
'$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
'$public'([],_) :- !.
'$public'([H|L], M) :- !, '$public'(H, M), '$public'(L, M).
'$public'(A//N1, Mod) :- integer(N1), !,
N is N1+2,
'$public'(A/N, Mod).
'$public'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
'$do_make_public'(T, Mod).
2015-04-13 13:28:17 +01:00
'$public'(X, Mod) :-
'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
'$do_make_public'(T, Mod) :-
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
'$do_make_public'(T, Mod) :-
2015-06-19 01:12:05 +01:00
'$predicate_flags'(T,Mod,F,F),
NF is F\/0x00400000,
2015-06-19 01:12:05 +01:00
'$predicate_flags'(T,Mod,F,NF).
2014-09-13 06:53:56 +01:00
/** @pred multifile( _P_ ) is iso
Declares that a predicate or several predicates may be defined
throughout several files. _P_ is a collection of one or more predicate
indicators:
~~~~~~~
:- multifile user:portray_message/2, multifile user:message_hook/3.
~~~~~~~
Instructs the compiler about the declaration of a predicate _P_ in
more than one file. It must appear in the first of the loaded files
where the predicate is declared, and before declaration of any of its
clauses.
2014-09-13 06:53:56 +01:00
Multifile declarations must be supported by reconsult/1 and
compile/1: when a multifile predicate is reconsulted,
only the clauses from the same file are removed.
Since YAP4.3.0 multifile procedures can be static or dynamic.
**/
2014-04-06 17:05:17 +01:00
multifile(P) :-
'$current_module'(OM),
'$multifile'(P, OM).
2014-04-06 17:05:17 +01:00
'$multifile'(V, _) :- var(V), !,
'$do_error'(instantiation_error,multifile(V)).
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
'$multifile'(Mod:PredSpec, _) :- !,
'$multifile'(PredSpec, Mod).
'$multifile'(N//A, M) :- !,
integer(A),
A1 is A+2,
'$multifile'(N/A1, M).
'$multifile'(N/A, M) :-
'$add_multifile'(N,A,M),
fail.
'$multifile'(N/A, M) :-
functor(S,N,A),
'$is_multifile'(S, M), !.
'$multifile'(N/A, M) :- !,
'$new_multifile'(N,A,M).
'$multifile'([H|T], M) :- !,
'$multifile'(H,M),
'$multifile'(T,M).
'$multifile'(P, M) :-
'$do_error'(type_error(predicate_indicator,P),multifile(M:P)).
discontiguous(V) :-
var(V), !,
'$do_error'(instantiation_error,discontiguous(V)).
discontiguous(M:F) :- !,
'$discontiguous'(F,M).
discontiguous(F) :-
'$current_module'(M),
'$discontiguous'(F,M).
'$discontiguous'(V,M) :- var(V), !,
'$do_error'(instantiation_error,M:discontiguous(V)).
'$discontiguous'((X,Y),M) :- !,
'$discontiguous'(X,M),
'$discontiguous'(Y,M).
'$discontiguous'(M:A,_) :- !,
'$discontiguous'(A,M).
'$discontiguous'(N//A1, M) :- !,
integer(A1), !,
A is A1+2,
'$discontiguous'(N/A, M).
'$discontiguous'(N/A, M) :- !,
'$new_discontiguous'(N,A,M).
2014-04-06 17:05:17 +01:00
'$discontiguous'(P,M) :-
'$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)).
%
% did we declare multifile properly?
%
'$check_multifile_pred'(Hd, M, _) :-
functor(Hd,Na,Ar),
source_location(F, _),
recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
% oops, we did not.
'$check_multifile_pred'(Hd, M, Fl) :-
% so this is not a multi-file predicate any longer.
functor(Hd,Na,Ar),
NFl is \(0x20000000) /\ Fl,
2015-06-19 01:12:05 +01:00
'$predicate_flags'(Hd,M,Fl,NFl),
2014-04-06 17:05:17 +01:00
'$warn_mfile'(Na,Ar).
'$warn_mfile'(F,A) :-
write(user_error,'% Warning: predicate '),
write(user_error,F/A), write(user_error,' was a multifile predicate '),
write(user_error,' (line '),
'$start_line'(LN), write(user_error,LN),
write(user_error,')'),
2015-04-13 13:28:17 +01:00
nl(user_error).
2015-06-19 01:12:05 +01:00
'$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.