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

fixes

Browse Source
This commit is contained in:
Vitor Santos Costa 2017-06-05 13:06:12 +01:00
parent 78768c354c
commit 2ad3420fac
155 changed files with 2502 additions and 45809 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

270
C/atomic.c
View File

@ -210,6 +210,16 @@ static Int unhide_atom(USES_REGS1) { /* unhide_atom(+Atom) */
return (TRUE);
}
/** @pred char_code(? _A_,? _I_) is iso
The built-in succeeds with _A_ bound to character represented as an
atom, and _I_ bound to the character code represented as an
integer. At least, one of either _A_ or _I_ must be bound before
the call.
*/
static Int char_code(USES_REGS1) {
Int t0 = Deref(ARG1);
if (IsVarTerm(t0)) {
@ -269,7 +279,36 @@ static Int char_code(USES_REGS1) {
}
}
static Int name(USES_REGS1) { /* name(?Atomic,?String) */
/** @pred name( _A_, _L_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _A_ will
be unified with an atomic symbol and _L_ with the list of the ASCII
codes for the characters of the external representation of _A_.
~~~~~{.prolog}
name(yap,L).
~~~~~
will return:
~~~~~{.prolog}
L = [121,97,112].
~~~~~
and
~~~~~{.prolog}
name(3,L).
~~~~~
will return:
~~~~~{.prolog}
L = [51].
~~~~~
*/
static Int name(USES_REGS1) { /* name(?Atomic,?String) */
Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1);
LOCAL_MAX_SIZE = 1024;
@ -341,6 +380,30 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/// @pred atomic_to_string(?Atomic.?String)
//
// reverse to string_to_atomic(_Atomic_, _String_).
// The second argument may be a sequence of codes or atoms.
//
static Int atomic_to_string(
USES_REGS1) {
Term t1 = ARG1; ARG1 = ARG2, ARG2 = t1;
return string_to_atomic(PASS_REGS1);
}
/// @pred string_to_atom(?String, ?Atom)
//
// Verifies if (a) at least one of the argument is bound. If _String_
// is bound it must be a string term, list if codes, or list of atoms,
// and _Atom_ musr be bound to a symbol with the same text. Otherwise,
// _Atom_ must be an _Atom_ and _String_ will unify with a string term
// of the same text.
//
// Notes:
// - some versions of YAP allow the first argument to be a number. Please use
// atomic_to_string/2 in this YAP.
//
static Int string_to_atom(
USES_REGS1) { /* string_to_atom(?String,?Atom) */
Term t2 = Deref(ARG2), t1 = Deref(ARG1);
@ -375,6 +438,19 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/// @pred atom_to_string(?Atom.?String)
//
// reverse to string_to_atom(_Atom_, _String_).
// The second argument may be a sequence of codes or atoms.
//
static Int atom_to_string(
USES_REGS1) { /* string_to_atom(?String,?Atom) */
Term t2 = ARG1; ARG1 = ARG2; ARG2 = t2;
return string_to_atom(PASS_REGS1);
}
static Int string_to_list(USES_REGS1) {
Term list = Deref(ARG2), string = Deref(ARG1);
LOCAL_MAX_SIZE = 1024;
@ -403,6 +479,12 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/// @pred atom_string(?Atom.?String)
//
// reverse to string_to_atom(_Atom_, _String_).
// The second argument may be a sequence of codes or atoms.
//
static Int atom_string(USES_REGS1) {
Term t1 = Deref(ARG1), t2 = Deref(ARG2);
LOCAL_MAX_SIZE = 1024;
@ -431,6 +513,25 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
// The second argument may be a sequence of codes or atoms.
//
static Int string_atom(
USES_REGS1) { /* string_to_atom(?String,?Atom) */
Term t2 = ARG1; ARG1 = ARG2; ARG2 = t2;
return atom_string(PASS_REGS1);
}
/** @pred atom_chars(? _A_,? _L_) is iso
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _A_ must
be unifiable with an atom, and the argument _L_ with the list of the
characters of _A_.
*/
static Int atom_chars(USES_REGS1) {
Term t1;
LOCAL_MAX_SIZE = 1024;
@ -579,6 +680,17 @@ restart_aux:
ReleaseAndReturn(false);
}
/** @pred number_atom(? _I_,? _A_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _I_ must
be unifiable with a number, and the argument _A_ must be unifiable
with an atom representing the number.
*/
static Int number_atom(USES_REGS1) {
Term t1;
int l = push_text_stack();
@ -613,6 +725,17 @@ restart_aux:
ReleaseAndReturn(false);
}
/** @pred number_string(? _I_,? _L_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _I_ must
be unifiable with a number, and the argument _L_ must be unifiable
with a term string representing the number.
*/
static Int number_string(USES_REGS1) {
Term t1;
int l = push_text_stack();
@ -639,6 +762,16 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/** @pred number_codes(? _I_,? _L_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _I_ must
be unifiable with a number, and the argument _L_ must be unifiable
with a list of UNICODE numbers representing the number.
*/
static Int number_codes(USES_REGS1) {
Term t1;
int l = push_text_stack();
@ -1304,6 +1437,15 @@ error:
ReleaseAndReturn(FALSE);
}
/** @pred atom_length(+ _A_,? _I_) is iso
The predicate holds when the first argument is an atom, and the
second unifies with the number of characters forming that atom. If
bound, _I_ must be a non-negative integer.
*/
static Int atom_length(USES_REGS1) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
@ -1339,6 +1481,15 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/** @pred atomic_length(+ _A_,? _I_) is iso
The predicate holds when the first argument is a number or atom, and
the second unifies with the number of characters needed to represent
the number, or atom.
*/
static Int atomic_length(USES_REGS1) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
@ -1724,6 +1875,17 @@ static Int atom_split(USES_REGS1) {
(Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2)));
}
/** @pred atom_number(? _Atom_,? _Number_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). If the argument
_Atom_ is an atom, _Number_ must be the number corresponding
to the characters in _Atom_, otherwise the characters in
_Atom_ must encode a number _Number_.
*/
static Int atom_number(USES_REGS1) {
Term t1;
int l = push_text_stack();
@ -1748,6 +1910,17 @@ restart_aux:
ReleaseAndReturn(FALSE);
}
/** @pred atom_number(? _String_,? _Number_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). If the argument
_String_ is a string term, _String_ must be the number corresponding
to the characters in _Atom_, otherwise the characters in
_String_ must encode the number _Number_.
*/
static Int string_number(USES_REGS1) {
Term t1;
int l = push_text_stack();
@ -2297,118 +2470,31 @@ void Yap_InitBackAtoms(void) {
void Yap_InitAtomPreds(void) {
Yap_InitCPred("name", 2, name, 0);
/** @pred name( _A_, _L_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _A_ will
be unified with an atomic symbol and _L_ with the list of the ASCII
codes for the characters of the external representation of _A_.
~~~~~{.prolog}
name(yap,L).
~~~~~
will return:
~~~~~{.prolog}
L = [121,97,112].
~~~~~
and
~~~~~{.prolog}
name(3,L).
~~~~~
will return:
~~~~~{.prolog}
L = [51].
~~~~~
*/
Yap_InitCPred("string_to_atom", 2, string_to_atom, 0);
Yap_InitCPred("atom_string", 2, atom_string, 0);
Yap_InitCPred("atom_to_string", 2, atom_to_string, 0);
Yap_InitCPred("string_to_atomic", 2, string_to_atomic, 0);
Yap_InitCPred("atomic_to_string", 2, atomic_to_string, 0);
Yap_InitCPred("string_to_list", 2, string_to_list, 0);
Yap_InitCPred("char_code", 2, char_code, SafePredFlag);
/** @pred char_code(? _A_,? _I_) is iso
The built-in succeeds with _A_ bound to character represented as an
atom, and _I_ bound to the character code represented as an
integer. At least, one of either _A_ or _I_ must be bound before
the call.
*/
Yap_InitCPred("atom_chars", 2, atom_chars, 0);
/** @pred atom_chars(? _A_,? _L_) is iso
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _A_ must
be unifiable with an atom, and the argument _L_ with the list of the
characters of _A_.
*/
Yap_InitCPred("atom_codes", 2, atom_codes, 0);
Yap_InitCPred("atom_string", 2, atom_string, 0);
Yap_InitCPred("string_atom", 2, string_atom, 0);
Yap_InitCPred("string_codes", 2, string_codes, 0);
Yap_InitCPred("string_chars", 2, string_chars, 0);
Yap_InitCPred("atom_length", 2, atom_length, SafePredFlag);
/** @pred atom_length(+ _A_,? _I_) is iso
The predicate holds when the first argument is an atom, and the second
unifies with the number of characters forming that atom.
*/
Yap_InitCPred("atomic_length", 2, atomic_length, SafePredFlag);
Yap_InitCPred("string_length", 2, string_length, SafePredFlag);
Yap_InitCPred("$atom_split", 4, atom_split, SafePredFlag);
Yap_InitCPred("number_chars", 2, number_chars, 0);
Yap_InitCPred("number_atom", 2, number_atom, 0);
/** @pred number_atom(? _I_,? _L_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument _I_ must
be unifiable with a number, and the argument _L_ must be unifiable
with an atom representing the number.
*/
Yap_InitCPred("number_string", 2, number_string, 0);
Yap_InitCPred("number_codes", 2, number_codes, 0);
Yap_InitCPred("atom_number", 2, atom_number, 0);
/** @pred atom_number(? _Atom_,? _Number_)
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). If the argument
_Atom_ is an atom, _Number_ must be the number corresponding
to the characters in _Atom_, otherwise the characters in
_Atom_ must encode a number _Number_.
*/
Yap_InitCPred("string_number", 2, string_number, 0);
Yap_InitCPred("$atom_concat", 2, atom_concat2, 0);
Yap_InitCPred("$string_concat", 2, string_concat2, 0);
Yap_InitCPred("atomic_concat", 2, atomic_concat2, 0);
/** @pred atomic_concat(+ _As_,? _A_)
The predicate holds when the first argument is a list of atomic terms,
and
the second unifies with the atom obtained by concatenating all the
atomic terms in the first list. The first argument thus may contain
atoms or numbers.
*/
Yap_InitCPred("atomics_to_string", 2, atomics_to_string2, 0);
Yap_InitCPred("atomics_to_string", 3, atomics_to_string3, 0);
Yap_InitCPred("get_string_code", 3, get_string_code3, 0);

77
C/cdmgr.c
View File

@ -1,3 +1,4 @@
/*************************************************************************
* *
* YAP Prolog *
@ -19,8 +20,8 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#endif
#include "Yap.h"
#include "clause.h"
#include "YapEval.h"
#include "clause.h"
#include "tracer.h"
#include "yapio.h"
#ifdef YAPOR
@ -115,7 +116,8 @@ restart:
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
@ -140,7 +142,8 @@ restart:
t = ArgOfTerm(2, t);
goto restart;
}
return RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
@ -496,7 +499,7 @@ static void RemoveMainIndex(PredEntry *ap) {
#ifdef TABLING
|| ap->PredFlags & TabledPredFlag
#endif /* TABLING */
) {
) {
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred =
(yamop *)(&(ap->OpcodeOfPred));
@ -1453,7 +1456,7 @@ static void addcl_permission_error(AtomEntry *ap, Int Arity, int in_use) {
CACHE_REGS
LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
LOCAL_ErrorMessage = Malloc( 256 );
LOCAL_ErrorMessage = Malloc(256);
if (in_use) {
if (Arity == 0)
@ -1648,7 +1651,7 @@ bool Yap_constPred(PredEntry *p) {
pred_flags_t pflags;
pflags = p->PredFlags;
if (pflags &
if (pflags &
((UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)))
return true;
@ -1810,7 +1813,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
p->PredFlags = p->PredFlags | CompiledPredFlag;
}
if (p->cs.p_code.FirstClause == NULL) {
p->PredFlags &= ~UndefPredFlag;
p->PredFlags &= ~UndefPredFlag;
if (!(pflags & DynamicPredFlag)) {
add_first_static(p, cp, spy_flag);
/* make sure we have a place to jump to */
@ -1911,9 +1914,14 @@ void Yap_EraseStaticClause(StaticClause *cl, PredEntry *ap, Term mod) {
if (ap->cs.p_code.LastClause == cl->ClCode) {
/* got rid of all clauses */
ap->cs.p_code.LastClause = ap->cs.p_code.FirstClause = NULL;
if (!(ap->PredFlags & MultiFileFlag)) {
ap->OpcodeOfPred = FAIL_OPCODE;
} else {
ap->OpcodeOfPred = UNDEF_OPCODE;
ap->PredFlags |= UndefPredFlag;
ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
}
ap->cs.p_code.TrueCodeOfPred = (yamop
*)(&(ap->OpcodeOfPred));
} else {
yamop *ncl = cl->ClNext->ClCode;
ap->cs.p_code.FirstClause = ncl;
@ -1981,7 +1989,6 @@ void Yap_add_logupd_clause(PredEntry *pe, LogUpdClause *cl, int mode) {
Yap_AddClauseToIndex(pe, cp, mode == asserta);
}
if (pe->cs.p_code.FirstClause == NULL) {
pe->PredFlags &= ~UndefPredFlag;
add_first_static(pe, cp, FALSE);
/* make sure we have a place to jump to */
if (pe->OpcodeOfPred == UNDEF_OPCODE ||
@ -2433,7 +2440,8 @@ static Int p_new_multifile(USES_REGS1) { /* '$new_multifile'(+N,+Ar,+Mod) */
UNLOCKPE(26, pe);
addcl_permission_error(RepAtom(at), arity, FALSE);
return false;
}
}
pe->PredFlags &= ~UndefPredFlag;
if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe);
return true;
@ -2467,6 +2475,7 @@ static Int p_is_multifile(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27, pe);
out = (pe->PredFlags & MultiFileFlag);
UNLOCKPE(44, pe);
return (out);
@ -2510,15 +2519,20 @@ static Int new_system_predicate(
static Int
p_is_system_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
PredEntry *pe;
bool out;
Term t1 = Deref(ARG1);
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "system_predicate");
// pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe)
pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
// if (!pe) pe = Yap_get_pred(t1, USER_MODULE, "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27, pe);
out = (pe->PredFlags & SystemPredFlags);
UNLOCKPE(44, pe);
return (out);
return (pe->ModuleOfPred == 0);
// return true;
// PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags);
// UNLOCKPE(44, pe);
// return (out);
}
static Int p_is_thread_local(USES_REGS1) { /* '$is_dynamic'(+P) */
@ -2719,7 +2733,7 @@ static Int p_pred_exists(USES_REGS1) { /* '$pred_exists'(+P,+M) */
}
static Int p_set_pred_module(USES_REGS1) { /* '$set_pred_module'(+P,+Mod)
*/
*/
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
@ -2732,7 +2746,7 @@ static Int p_set_pred_module(USES_REGS1) { /* '$set_pred_module'(+P,+Mod)
}
static Int p_set_pred_owner(USES_REGS1) { /* '$set_pred_module'(+P,+File)
*/
*/
PredEntry *pe;
Term a2 = Deref(ARG2);
@ -2772,7 +2786,8 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */
if (EndOfPAEntr(pe))
return false;
PELOCK(59, pe);
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
if (pe->OpcodeOfPred == UNDEF_OPCODE &&
!(pe->PredFlags & (LogUpdatePredFlag|DynamicPredFlag|MultiFileFlag))) {
UNLOCKPE(59, pe);
return false;
}
@ -2788,7 +2803,7 @@ static Int p_undefined(USES_REGS1) { /* '$undefined'(P,Mod) */
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36, pe);
if (pe->PredFlags & (CPredFlag | UserCPredFlag | TestPredFlag | AsmPredFlag |
if (pe->PredFlags & (CPredFlag | UserCPredFlag | TestPredFlag | AsmPredFlag |MultiFileFlag|
DynamicPredFlag | LogUpdatePredFlag | TabledPredFlag)) {
UNLOCKPE(57, pe);
return FALSE;
@ -2825,7 +2840,7 @@ static Int p_kill_dynamic(USES_REGS1) { /* '$kill_dynamic'(P,M) */
pe->OpcodeOfPred = UNDEF_OPCODE;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
(yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = UndefPredFlag;
pe->PredFlags = UndefPredFlag;
UNLOCKPE(62, pe);
return (TRUE);
}
@ -3029,7 +3044,7 @@ void Yap_HidePred(PredEntry *pe) {
}
static Int /* $system_predicate(P) */
p_stash_predicate(USES_REGS1) {
p_stash_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
@ -3072,7 +3087,7 @@ restart_system_pred:
}
static Int /* $system_predicate(P) */
hide_predicate(USES_REGS1) {
hide_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
@ -3115,7 +3130,7 @@ restart_system_pred:
}
static Int /* $hidden_predicate(P) */
p_hidden_predicate(USES_REGS1) {
p_hidden_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
@ -3266,7 +3281,7 @@ static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb,
}
static Int /* $hidden_predicate(P) */
p_log_update_clause(USES_REGS1) {
p_log_update_clause(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
@ -3286,7 +3301,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_log_update_clause(USES_REGS1) {
p_continue_log_update_clause(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -3416,7 +3431,7 @@ static Int fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th,
}
static Int /* $hidden_predicate(P) */
p_log_update_clause_erase(USES_REGS1) {
p_log_update_clause_erase(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
@ -3437,7 +3452,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_log_update_clause_erase(USES_REGS1) {
p_continue_log_update_clause_erase(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -3878,7 +3893,7 @@ static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th,
}
static Int /* $hidden_predicate(P) */
p_static_clause(USES_REGS1) {
p_static_clause(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
yamop *new_cp;
@ -3897,7 +3912,7 @@ static Int /* $hidden_predicate(P) */
}
static Int /* $hidden_predicate(P) */
p_continue_static_clause(USES_REGS1) {
p_continue_static_clause(USES_REGS1) {
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
@ -4056,7 +4071,7 @@ static Int
#ifdef TABLING
| TabledPredFlag
#endif /* TABLING */
)) {
)) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t,
"dbload_get_space/4");
return FALSE;

6
C/exec.c
View File

@ -126,12 +126,12 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
* @param mod current module
* @return su
*/
Term Yap_ExecuteCallMetaCall(Term mod) {
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS
Term ts[4];
ts[0] = ARG1;
ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = ARG1;
ts[2] = g;
ts[3] = mod;
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return Yap_MkApplTerm(PredTraceMetaCall->FunctorOfPred, 3, ts);

4
CXX/yapdb.hh
View File

@ -46,13 +46,14 @@ class YAPModule;
class YAPModule : protected YAPAtomTerm {
friend class YAPPredicate;
friend class YAPModuleProp;
YAPModule(YAP_Term t) : YAPAtomTerm(t){};
Term t() { return gt(); }
Term curModule() { CACHE_REGS return Yap_CurrentModule(); }
public:
YAPModule(YAP_Term t) : YAPAtomTerm(t){};
YAPModule() : YAPAtomTerm(curModule()){};
YAPModule(YAPAtom t) : YAPAtomTerm(t){};
Term term() { return gt(); };
};
/**
@ -288,6 +289,7 @@ Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, MkIntTerm(0), "YAPFunctor::functor");
/// we return a positive number.
uintptr_t getArity() { return ap->ArityOfPE; }
arity_t arity() { return ap->ArityOfPE; }
PredEntry *predEntry() { return ap; }
};
/**

103
CXX/yapi.cpp
View File

@ -435,7 +435,7 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[])
{
CACHE_REGS
if (ap.ap == NULL)
return false;
return false;
BACKUP_MACHINE_REGS();
arity_t arity = ap.getArity();
bool result;
@ -444,6 +444,13 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[])
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i].term();
if (ap.ap == nullptr || ap.ap->OpcodeOfPred == UNDEF_OPCODE)
{
Term g = YAP_MkApplTerm(ap.ap->FunctorOfPred, arity, XREGS+1);
ap = YAPPredicate(rewriteUndefEngineQuery(ap.ap, g, ap.ap->ModuleOfPred));
}
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
@ -476,27 +483,36 @@ bool YAPEngine::mgoal(Term t, Term tmod)
BACKUP_MACHINE_REGS();
Term *ts = nullptr;
PredEntry *ap = Yap_get_pred(t, tmod, "C++");
if (ap == nullptr)
if (ap == nullptr || ap->OpcodeOfPred == UNDEF_OPCODE)
{
ap = rewriteUndefEngineQuery(ap, t, tmod);
}
if (ap==nullptr)
return false;
arity_t arity = ap->ArityOfPE;
{
/* legal ap */
arity_t arity = ap->ArityOfPE;
if (arity) {
if (IsApplTerm(t))
{
ts = RepAppl(t) + 1;
}
else
{
ts = RepPair(t);
}
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i];
} else if ( IsAtomTerm(t)) {
ts = nullptr;
}
}
bool result;
sigjmp_buf q_env;
if (arity) {
if (IsApplTerm(t))
{
ts = RepAppl(t) + 1;
}
else
{
ts = RepPair(t);
}
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i];
} else if ( IsAtomTerm(t)) {
ts = nullptr;
}
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
@ -578,6 +594,11 @@ Term YAPEngine::fun(Term t)
arity++;
f = Yap_MkFunctor(name, arity);
ap = (PredEntry *)(PredPropByFunc(f, tmod));
if (ap == nullptr || ap->OpcodeOfPred == UNDEF_OPCODE)
{
Term g = (Yap_MkApplTerm(f,arity, ts) );
ap = rewriteUndefEngineQuery(ap, g, (ap->ModuleOfPred));
}
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
@ -615,13 +636,13 @@ YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm ts[])
{
/* ignore flags for now */
BACKUP_MACHINE_REGS();
CELL *nts;
Term *nts;
Term goal;
if ( ts) {
if (ts) {
goal = Yap_MkApplTerm(f.f, f.arity(), nts);
nts = RepAppl(goal)+1;
goal = YAPApplTerm(f, ts).term();
nts = RepAppl(goal)+1;
} else {
goal = MkVarTerm();
@ -676,7 +697,7 @@ YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) {
arity_t arity = p.ap->ArityOfPE;
if (arity) {
goal = YAPApplTerm(YAPFunctor(p.ap->FunctorOfPred), ts).term();
for (int i =0; i < arity; i++)
for (arity_t i =0; i < arity; i++)
XREGS[i+1]=ts[i].term();
openQuery(goal.term(), nullptr);
} else {
@ -692,6 +713,9 @@ bool YAPQuery::next()
CACHE_REGS
bool result = false;
Term terr;
if (ap == NULL || ap->OpcodeOfPred == UNDEF_OPCODE) {
ap = rewriteUndefQuery();
}
LOCAL_RestartEnv = &q_env;
try
{
@ -759,6 +783,28 @@ bool YAPQuery::next()
}
}
PredEntry *
YAPQuery::rewriteUndefQuery()
{
Term ts[3];
ARG1 = ts[0] = goal.term();
ARG2 = ts[1] = ap->ModuleOfPred;
ARG3 = ts[2] = Yap_cp_as_integer(B PASS_REGS);
goal = YAPApplTerm(FunctorUndefinedQuery, ts);
return ap = PredUndefinedQuery;
}
PredEntry *
YAPEngine::rewriteUndefEngineQuery(PredEntry *a, Term goal, Term mod)
{
Term ts[3];
ARG1 = ts[0] = goal;
ARG2 = ts[1] = mod;
ARG3 = ts[2] = Yap_cp_as_integer(B PASS_REGS);
return PredUndefinedQuery;
//return YAPApplTerm(FunctorUndefinedQuery, ts);
}
void YAPQuery::cut()
{
CACHE_REGS
@ -884,14 +930,9 @@ void YAPEngine::doInit(YAP_file_type_t BootMode)
YAPQuery initq = YAPQuery(YAPPredicate(p), nullptr);
if (initq.next())
{
std::cerr << "init\n" ;
initq.cut();
std::cerr << "cut\n" ;
}
else
{
std::cerr << "fail\n" ;
}
CurrentModule = TermUser;
}

14
CXX/yapq.hh
View File

@ -56,10 +56,12 @@ class YAPQuery : public YAPPredicate
q_cp = CP;
// make sure this is safe
q_handles = LOCAL_CurSlot;
}
};
void openQuery(Term t, Term *pt);
void openQuery(Term t, Term *ts);
PredEntry *rewriteUndefQuery();
public:
YAPQuery() {
@ -358,10 +360,12 @@ private:
YAPError yerror;
void doInit(YAP_file_type_t BootMode);
YAP_dogoalinfo q;
PredEntry *rewriteUndefEngineQuery(PredEntry *ap, Term t, Term tmod);
public:
/// construct a new engine; may use a variable number of arguments
YAPEngine(YAPEngineArgs *cargs) {
public :
/// construct a new engine; may use a variable number of arguments
YAPEngine(YAPEngineArgs *cargs)
{
engine_args = cargs;
//doInit(cargs->init_args.boot_file_type);
doInit(YAP_QLY);

2
H/ATOMS
View File

@ -414,6 +414,7 @@ A Tuple N "tuple"
A Txt N "txt"
A TypeError N "type_error"
A Undefined N "undefined"
A UndefinedQuery N "undefined_query"
A Undefp F "$undefp"
A Undefp0 F "$undefp0"
A Underflow N "underflow"
@ -583,6 +584,7 @@ F TimeoutError TimeoutError 2
F TraceMetaCall TraceMetaCall 3
F TypeError TypeError 2
F UMinus Minus 1
F UndefinedQuery UndefinedQuery 3
F UPlus Plus 1
F VBar VBar 2
F WriteTerm WriteTerm 2

2
H/HEAPFIELDS
View File

@ -168,6 +168,8 @@ struct pred_entry *PredThrow MkPred FunctorThrow PROLOG_MODULE
struct pred_entry *PredTraceMetaCall MkPred FunctorTraceMetaCall PROLOG_MODULE
struct pred_entry *PredCommentHook MkPred FunctorCommentHook PROLOG_MODULE
struct pred_entry *PredProcedure MkLogPred FunctorProcedure PROLOG_MODULE
struct pred_entry *PredUndefinedQuery MkPred FunctorUndefinedQuery PROLOG_MODULE
/* low-level tracer */
#ifdef LOW_LEVEL_TRACER

4
H/Yapproto.h
View File

@ -191,7 +191,7 @@ extern void Yap_InitEval(void);
/* exec.c */
extern void Yap_fail_all(choiceptr bb USES_REGS);
extern Term Yap_ExecuteCallMetaCall(Term);
extern Term Yap_ExecuteCallMetaCall(Term,Term);
extern void Yap_InitExecFs(void);
extern bool Yap_JumpToEnv(Term);
extern Term Yap_RunTopGoal(Term, bool);
@ -519,4 +519,4 @@ extern void init_myddas(void);
#define strncpy(X, Y, Z) strcpy(X, Y)
#endif
#endif /* YAP_PROTOS_H */
#endif /* YAP_PROTOS_H */

1
H/generated/dhstruct.h
View File

@ -152,6 +152,7 @@
#define PredTraceMetaCall Yap_heap_regs->PredTraceMetaCall_
#define PredCommentHook Yap_heap_regs->PredCommentHook_
#define PredProcedure Yap_heap_regs->PredProcedure_
#define PredUndefinedQuery Yap_heap_regs->PredUndefinedQuery_
#ifdef LOW_LEVEL_TRACER
#define Yap_do_low_level_trace Yap_heap_regs->Yap_do_low_level_trace_

1
H/generated/h0struct.h
View File

@ -156,6 +156,7 @@ EXTERNAL struct pred_entry *PredThrow;
EXTERNAL struct pred_entry *PredTraceMetaCall;
EXTERNAL struct pred_entry *PredCommentHook;
EXTERNAL struct pred_entry *PredProcedure;
EXTERNAL struct pred_entry *PredUndefinedQuery;
/* low-level tracer */
#ifdef LOW_LEVEL_TRACER
EXTERNAL int Yap_do_low_level_trace;

1
H/generated/hstruct.h
View File

@ -156,6 +156,7 @@
struct pred_entry *PredTraceMetaCall_;
struct pred_entry *PredCommentHook_;
struct pred_entry *PredProcedure_;
struct pred_entry *PredUndefinedQuery_;
/* low-level tracer */
#ifdef LOW_LEVEL_TRACER
int Yap_do_low_level_trace_;

1170
H/generated/iatoms.h
View File

File diff suppressed because it is too large Load Diff

1
H/generated/ihstruct.h
View File

@ -152,6 +152,7 @@
PredTraceMetaCall = RepPredProp(PredPropByFunc(FunctorTraceMetaCall,PROLOG_MODULE));
PredCommentHook = RepPredProp(PredPropByFunc(FunctorCommentHook,PROLOG_MODULE));
PredProcedure = Yap_MkLogPred(RepPredProp(PredPropByFunc(FunctorProcedure,PROLOG_MODULE)));
PredUndefinedQuery = RepPredProp(PredPropByFunc(FunctorUndefinedQuery,PROLOG_MODULE));
#ifdef LOW_LEVEL_TRACER
Yap_do_low_level_trace = FALSE;

1170
H/generated/ratoms.h
View File

File diff suppressed because it is too large Load Diff

1
H/generated/rhstruct.h
View File

@ -152,6 +152,7 @@
PredTraceMetaCall = PtoPredAdjust(PredTraceMetaCall);
PredCommentHook = PtoPredAdjust(PredCommentHook);
PredProcedure = PtoPredAdjust(PredProcedure);
PredUndefinedQuery = PtoPredAdjust(PredUndefinedQuery);
#ifdef LOW_LEVEL_TRACER

1892
H/generated/tatoms.h
View File

File diff suppressed because it is too large Load Diff

2
misc/ATOMS
View File

@ -404,6 +404,7 @@ A Tuple N "tuple"
A Txt N "txt"
A TypeError N "type_error"
A Undefined N "undefined"
A UndefinedQuery N "undefined_query"
A Undefp F "$undefp"
A Underflow N "underflow"
A UnificationStack N "unification_stack"
@ -566,6 +567,7 @@ F TimeoutError TimeoutError 2
F TraceMetaCall TraceMetaCall 3
F TypeError TypeError 2
F UMinus Minus 1
F UndefinedQuery UndefinedQuery 3
F UPlus Plus 1
F VBar VBar 2
F HiddenVar HiddenVar 1

4
os/fmem.c
View File

@ -114,6 +114,7 @@ bool Yap_set_stream_to_buf(StreamDesc *st, const char *buf, size_t nchars) {
// like any file stream.
st->file = f = fmemopen((void *)buf, nchars, "r");
st->status = Input_Stream_f | InMemory_Stream_f | Seekable_Stream_f;
st->vfs = NULL;
Yap_DefaultStreamOps(st);
return true;
}
@ -139,7 +140,7 @@ int Yap_open_buf_read_stream(const char *buf, size_t nchars, encoding_t *encp,
// like any file stream.
f = st->file = fmemopen((void *)buf, nchars, "r");
flags = Input_Stream_f | InMemory_Stream_f | Seekable_Stream_f;
Yap_initStream(sno, f, NULL, TermNil, encoding, flags, AtomRead);
Yap_initStream(sno, f, NULL, TermNil, encoding, flags, AtomRead, NULL);
// like any file stream.
Yap_DefaultStreamOps(st);
UNLOCK(st->streamlock);
@ -181,6 +182,7 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->charcount = 0;
st->linecount = 1;
st->encoding = enc;
st->vfs = NULL;
Yap_DefaultStreamOps(st);
#if HAVE_OPEN_MEMSTREAM
st->file = open_memstream(&st->nbuf, &st->nsize);

32
os/iopreds.c
View File

@ -249,8 +249,8 @@ void Yap_DefaultStreamOps(StreamDesc *st) {
if (st->vfs) {
st->stream_wputc = st->vfs->put_char;
st->stream_wgetc = st->vfs->get_char;
st->stream_putc = FilePutc;
st->stream_getc = PlGetc;
st->stream_putc = st->vfs->put_char;
st->stream_wgetc = st->vfs->get_char;
return;
}
st->stream_wputc = put_wchar;
@ -285,13 +285,14 @@ static void InitFileIO(StreamDesc *s) {
Yap_DefaultStreamOps(s);
}
static void InitStdStream(int sno, SMALLUNSGN flags, FILE *file) {
static void InitStdStream(int sno, SMALLUNSGN flags, FILE *file, void *vfsp) {
StreamDesc *s = &GLOBAL_Stream[sno];
s->file = file;
s->status = flags;
s->linepos = 0;
s->linecount = 1;
s->charcount = 0.;
s->vfs = vfsp;
s->encoding = ENC_ISO_UTF8;
INIT_LOCK(s->streamlock);
unix_upd_stream_info(s);
@ -339,13 +340,13 @@ Term Yap_StreamUserName(int sno) {
static void InitStdStreams(void) {
CACHE_REGS
if (LOCAL_sockets_io) {
InitStdStream(StdInStream, Input_Stream_f, NULL);
InitStdStream(StdOutStream, Output_Stream_f, NULL);
InitStdStream(StdErrStream, Output_Stream_f, NULL);
InitStdStream(StdInStream, Input_Stream_f, NULL, NULL);
InitStdStream(StdOutStream, Output_Stream_f, NULL, NULL);
InitStdStream(StdErrStream, Output_Stream_f, NULL, NULL);
} else {
InitStdStream(StdInStream, Input_Stream_f, stdin);
InitStdStream(StdOutStream, Output_Stream_f, stdout);
InitStdStream(StdErrStream, Output_Stream_f, stderr);
InitStdStream(StdInStream, Input_Stream_f, stdin, NULL);
InitStdStream(StdOutStream, Output_Stream_f, stdout, NULL);
InitStdStream(StdErrStream, Output_Stream_f, stderr, NULL);
}
GLOBAL_Stream[StdInStream].name = Yap_LookupAtom("user_input");
GLOBAL_Stream[StdOutStream].name = Yap_LookupAtom("user_output");
@ -1056,10 +1057,11 @@ static void check_bom(int sno, StreamDesc *st) {
}
bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags, Atom open_mode) {
encoding_t encoding, stream_flags_t flags, Atom open_mode, void *vfs) {
StreamDesc *st = &GLOBAL_Stream[sno];
st->status = flags;
st->vfs = vfs;
st->charcount = 0;
st->linecount = 1;
if (flags & Binary_Stream_f) {
@ -1288,9 +1290,9 @@ do_open(Term file_name, Term t2,
if (st - GLOBAL_Stream < 3) {
flags |= RepError_Prolog_f;
}
st->vfs = NULL;
if ((st->vfs = vfs_owner(fname)) != NULL) {
st->u.private_data = st->vfs->open(fname, io_mode);
struct vfs *vfsp = NULL;
if ((vfsp = vfs_owner(fname)) != NULL) {
st->u.private_data = vfsp->open(fname, io_mode);
fd = NULL;
if (st->u.private_data == NULL)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s", fname));
@ -1317,7 +1319,7 @@ do_open(Term file_name, Term t2,
#endif
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "open %s", fname);
flags &= ~(Free_Stream_f);
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode))
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode, vfsp))
return false;
if (open_mode == AtomWrite) {
if (needs_bom && !write_bom(sno, st))
@ -1514,7 +1516,7 @@ int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) {
at = AtomWrite;
} else
at = AtomRead;
Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at);
Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at, NULL);
return sno;
}

2
os/iopreds.h
View File

@ -33,7 +33,7 @@ INLINE_ONLY EXTERN inline bool IsStreamTerm(Term t) {
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode);
Atom open_mode, void *vfs);
#define Yap_CheckStream(arg, kind, msg) \
Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)

3
os/mem.c
View File

@ -186,6 +186,7 @@ bool Yap_set_stream_to_buf(StreamDesc *st, const char *buf, size_t nchars) {
st->file = f = NULL;
flags = Input_Stream_f | InMemory_Stream_f;
st->vfs = NULL;
Yap_initStream(st - GLOBAL_Stream, f, NULL, TermNil, LOCAL_encoding, flags,
AtomRead);
// like any file stream.
@ -220,6 +221,7 @@ int Yap_open_buf_read_stream(const char *buf, size_t nchars, encoding_t *encp,
encoding = LOCAL_encoding;
st->file = f = NULL;
flags = Input_Stream_f | InMemory_Stream_f;
st->vfs = NULL;
Yap_initStream(sno, f, NULL, TermNil, encoding, flags, AtomRead);
// like any file stream.
/* currently these streams are not seekable */
@ -269,6 +271,7 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->charcount = 0;
st->linecount = 1;
st->encoding = enc;
st->vfs = NULL;
Yap_DefaultStreamOps(st);
st->nbuf = st->u.mem_string.buf = malloc(PLGETC_BUF_SIZE);
st->u.mem_string.src = MEM_BUF_MALLOC;

2
os/pipes.c
View File

@ -230,6 +230,7 @@ open_pipe_stream (USES_REGS1)
st->linecount = 1;
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
st->vfs = NULL;
Yap_DefaultStreamOps( st );
st->u.pipe.fd = filedes[0];
st->file = fdopen( filedes[0], "r");
@ -242,6 +243,7 @@ open_pipe_stream (USES_REGS1)
st->linepos = 0;
st->charcount = 0;
st->linecount = 1;
st->vfs = NULL;
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
Yap_DefaultStreamOps( st );

1
os/sockets.c
View File

@ -242,6 +242,7 @@ Yap_InitSocketStream(int fd, socket_info flags, socket_domain domain) {
st = &GLOBAL_Stream[sno];
st->u.socket.domain = domain;
st->u.socket.flags = flags;
st->vfs = NULL;
if (flags & (client_socket|server_session_socket)) {
/* I can read and write from these sockets */
st->status = (Socket_Stream_f|Input_Stream_f|Output_Stream_f);

31
packages/python/swig/CMakeLists.txt
View File

@ -5,7 +5,7 @@ INCLUDE(NewUseSWIG)
include(FindPythonModule)
set (PROLOG_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/yapi.yap)
set (PROLOG_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/yapi.yap ${CMAKE_CURRENT_SOURCE_DIR}/jupyter.yap)
set (PYTHON_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/yapi.py ${CMAKE_CURRENT_SOURCE_DIR}/__init__.py ${CMAKE_CURRENT_SOURCE_DIR}/__main__.py)
file(RELATIVE_PATH RELATIVE_SOURCE ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_SOURCE_DIR})
@ -59,28 +59,31 @@ else()
)
endif()
file( MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/pl )
file( MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/os )
set (PL ${pl_library} ${PROLOG_SOURCES} )
add_custom_target( YAP4PY ALL
COMMAND ${CMAKE_COMMAND} -E copy ${dlls} ${CMAKE_BINARY_DIR}/libYap${CMAKE_SHARED_LIBRARY_SUFFIX} ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ${CMAKE_CURRENT_BINARY_DIR}/yap4py
COMMAND ${CMAKE_COMMAND} -E copy ${pl_library} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog
COMMAND ${CMAKE_COMMAND} -E copy ${PYTHON_SOURCES} ${CMAKE_CURRENT_BINARY_DIR}/yap4py
COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/yapi.yap ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog
COMMAND ${CMAKE_COMMAND} -E copy ${pl_library} ${PROLOG_SOURCES} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog
COMMAND ${CMAKE_COMMAND} -E copy ${pl_boot_library} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/pl
COMMAND ${CMAKE_COMMAND} -E copy ${pl_os_library} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/os
COMMAND ${PYTHON_EXECUTABLE} ${CMAKE_CURRENT_BINARY_DIR}/setup.py sdist bdist_wheel
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
add_custom_target( YAP4PY_SETUP
COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_CURRENT_BINARY_DIR}/yap4py
COMMAND ${CMAKE_COMMAND} -E copy ${dlls} ${CMAKE_BINARY_DIR}/libYap${CMAKE_SHARED_LIBRARY_SUFFIX} ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ${PYTHON_SOURCES} ${CMAKE_CURRENT_BINARY_DIR}/yap4py
COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog
COMMAND ${CMAKE_COMMAND} -E copy ${PL} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog
COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/pl
COMMAND ${CMAKE_COMMAND} -E copy ${pl_boot_library} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/pl
COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/os
COMMAND ${CMAKE_COMMAND} -E copy ${pl_os_library} ${CMAKE_CURRENT_BINARY_DIR}/yap4py/prolog/os
DEPENDS STARTUP ${dlls} ${PYTHON_SOURCES} ${PROLOG_SOURCES} ${CMAKE_CURRENT_BINARY_DIR}/setup.py ${SWIG_MODULE_Py2YAP_REAL_NAME} )
add_custom_target( YAP4PY ALL
COMMAND ${PYTHON_EXECUTABLE} setup.py sdist bdist_wheel
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
DEPENDS YAP4PY_SETUP)
install(CODE "execute_process(COMMAND ${PYTHON_EXECUTABLE} -m pip install --force --no-index -f dist yap4py
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})"
DEPENDS Py4YAP ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ${dlls} )
install(FILES yapi.yap DESTINATION ${libpl})
install(FILES ${PROLOG_SOURCES} DESTINATION ${libpl})

406
packages/python/swig/yap4py/prolog/INDEX.pl
View File

@ -1,406 +0,0 @@
index(foreach,2,aggretate,library(aggregate)).
index(aggregate,3,aggretate,library(aggregate)).
index(aggregate,4,aggretate,library(aggregate)).
index(aggregate_all,3,aggretate,library(aggregate)).
index(aggregate_all,4,aggretate,library(aggregate)).
index(free_variables,4,aggretate,library(aggregate)).
index(genarg,3,arg,library(arg)).
index(arg0,3,arg,library(arg)).
index(genarg0,3,arg,library(arg)).
index(args,3,arg,library(arg)).
index(args0,3,arg,library(arg)).
index(path_arg,3,arg,library(arg)).
index(empty_assoc,1,assoc,library(assoc)).
index(assoc_to_list,2,assoc,library(assoc)).
index(is_assoc,1,assoc,library(assoc)).
index(min_assoc,3,assoc,library(assoc)).
index(max_assoc,3,assoc,library(assoc)).
index(gen_assoc,3,assoc,library(assoc)).
index(get_assoc,3,assoc,library(assoc)).
index(get_assoc,5,assoc,library(assoc)).
index(get_next_assoc,4,assoc,library(assoc)).
index(get_prev_assoc,4,assoc,library(assoc)).
index(list_to_assoc,2,assoc,library(assoc)).
index(ord_list_to_assoc,2,assoc,library(assoc)).
index(map_assoc,2,assoc,library(assoc)).
index(map_assoc,3,assoc,library(assoc)).
index(put_assoc,4,assoc,library(assoc)).
index(del_assoc,4,assoc,library(assoc)).
index(assoc_to_keys,2,assoc,library(assoc)).
index(del_min_assoc,4,assoc,library(assoc)).
index(del_max_assoc,4,assoc,library(assoc)).
index(avl_new,1,avl,library(avl)).
index(avl_insert,4,avl,library(avl)).
index(avl_lookup,3,avl,library(avl)).
index(b_hash_new,1,b_hash,library(bhash)).
index(b_hash_new,2,b_hash,library(bhash)).
index(b_hash_new,4,b_hash,library(bhash)).
index(b_hash_lookup,3,b_hash,library(bhash)).
index(b_hash_update,3,b_hash,library(bhash)).
index(b_hash_update,4,b_hash,library(bhash)).
index(b_hash_insert_new,4,b_hash,library(bhash)).
index(b_hash_insert,4,b_hash,library(bhash)).
index(format_to_chars,3,charsio,library(charsio)).
index(format_to_chars,4,charsio,library(charsio)).
index(write_to_chars,3,charsio,library(charsio)).
index(write_to_chars,2,charsio,library(charsio)).
index(atom_to_chars,3,charsio,library(charsio)).
index(atom_to_chars,2,charsio,library(charsio)).
index(number_to_chars,3,charsio,library(charsio)).
index(number_to_chars,2,charsio,library(charsio)).
index(read_from_chars,2,charsio,library(charsio)).
index(open_chars_stream,2,charsio,library(charsio)).
index(with_output_to_chars,2,charsio,library(charsio)).
index(with_output_to_chars,3,charsio,library(charsio)).
index(with_output_to_chars,4,charsio,library(charsio)).
index(term_to_atom,2,charsio,library(charsio)).
index(chr_show_store,1,chr,library(chr)).
index(find_chr_constraint,1,chr,library(chr)).
index(chr_trace,0,chr,library(chr)).
index(chr_notrace,0,chr,library(chr)).
index(chr_leash,1,chr,library(chr)).
index(#>,2,clpfd,library(clpfd)).
index(#<,2,clpfd,library(clpfd)).
index(#>=,2,clpfd,library(clpfd)).
index(#=<,2,clpfd,library(clpfd)).
index(#=,2,clpfd,library(clpfd)).
index(#\=,2,clpfd,library(clpfd)).
index(#\,1,clpfd,library(clpfd)).
index(#<==>,2,clpfd,library(clpfd)).
index(#==>,2,clpfd,library(clpfd)).
index(#<==,2,clpfd,library(clpfd)).
index(#\/,2,clpfd,library(clpfd)).
index(#/\,2,clpfd,library(clpfd)).
index(in,2,clpfd,library(clpfd)).
index(ins,2,clpfd,library(clpfd)).
index(all_different,1,clpfd,library(clpfd)).
index(all_distinct,1,clpfd,library(clpfd)).
index(sum,3,clpfd,library(clpfd)).
index(scalar_product,4,clpfd,library(clpfd)).
index(tuples_in,2,clpfd,library(clpfd)).
index(labeling,2,clpfd,library(clpfd)).
index(label,1,clpfd,library(clpfd)).
index(indomain,1,clpfd,library(clpfd)).
index(lex_chain,1,clpfd,library(clpfd)).
index(serialized,2,clpfd,library(clpfd)).
index(global_cardinality,2,clpfd,library(clpfd)).
index(global_cardinality,3,clpfd,library(clpfd)).
index(circuit,1,clpfd,library(clpfd)).
index(element,3,clpfd,library(clpfd)).
index(automaton,3,clpfd,library(clpfd)).
index(automaton,8,clpfd,library(clpfd)).
index(transpose,2,clpfd,library(clpfd)).
index(zcompare,3,clpfd,library(clpfd)).
index(chain,2,clpfd,library(clpfd)).
index(fd_var,1,clpfd,library(clpfd)).
index(fd_inf,2,clpfd,library(clpfd)).
index(fd_sup,2,clpfd,library(clpfd)).
index(fd_size,2,clpfd,library(clpfd)).
index(fd_dom,2,clpfd,library(clpfd)).
index({},1,clpr,library(clpr)).
index(maximize,1,clpr,library(clpr)).
index(minimize,1,clpr,library(clpr)).
index(inf,2,clpr,library(clpr)).
index(inf,4,clpr,library(clpr)).
index(sup,2,clpr,library(clpr)).
index(sup,4,clpr,library(clpr)).
index(bb_inf,3,clpr,library(clpr)).
index(bb_inf,5,clpr,library(clpr)).
index(ordering,1,clpr,library(clpr)).
index(entailed,1,clpr,library(clpr)).
index(clp_type,2,clpr,library(clpr)).
index(dump,3,clpr,library(clpr)).
index(gensym,2,gensym,library(gensym)).
index(reset_gensym,1,gensym,library(gensym)).
index(reset_gensym,0,gensym,library(gensym)).
index(add_to_heap,4,heaps,library(heaps)).
index(get_from_heap,4,heaps,library(heaps)).
index(empty_heap,1,heaps,library(heaps)).
index(heap_size,2,heaps,library(heaps)).
index(heap_to_list,2,heaps,library(heaps)).
index(list_to_heap,2,heaps,library(heaps)).
index(min_of_heap,3,heaps,library(heaps)).
index(min_of_heap,5,heaps,library(heaps)).
index(jpl_get_default_jvm_opts,1,jpl,library(jpl)).
index(jpl_set_default_jvm_opts,1,jpl,library(jpl)).
index(jpl_get_actual_jvm_opts,1,jpl,library(jpl)).
index(jpl_pl_lib_version,1,jpl,library(jpl)).
index(jpl_c_lib_version,1,jpl,library(jpl)).
index(jpl_new,3,jpl,library(jpl)).
index(jpl_call,4,jpl,library(jpl)).
index(jpl_get,3,jpl,library(jpl)).
index(jpl_set,3,jpl,library(jpl)).
index(jpl_servlet_byref,3,jpl,library(jpl)).
index(jpl_servlet_byval,3,jpl,library(jpl)).
index(jpl_class_to_classname,2,jpl,library(jpl)).
index(jpl_class_to_type,2,jpl,library(jpl)).
index(jpl_classname_to_class,2,jpl,library(jpl)).
index(jpl_classname_to_type,2,jpl,library(jpl)).
index(jpl_datum_to_type,2,jpl,library(jpl)).
index(jpl_false,1,jpl,library(jpl)).
index(jpl_is_class,1,jpl,library(jpl)).
index(jpl_is_false,1,jpl,library(jpl)).
index(jpl_is_null,1,jpl,library(jpl)).
index(jpl_is_object,1,jpl,library(jpl)).
index(jpl_is_object_type,1,jpl,library(jpl)).
index(jpl_is_ref,1,jpl,library(jpl)).
index(jpl_is_true,1,jpl,library(jpl)).
index(jpl_is_type,1,jpl,library(jpl)).
index(jpl_is_void,1,jpl,library(jpl)).
index(jpl_null,1,jpl,library(jpl)).
index(jpl_object_to_class,2,jpl,library(jpl)).
index(jpl_object_to_type,2,jpl,library(jpl)).
index(jpl_primitive_type,1,jpl,library(jpl)).
index(jpl_ref_to_type,2,jpl,library(jpl)).
index(jpl_true,1,jpl,library(jpl)).
index(jpl_type_to_class,2,jpl,library(jpl)).
index(jpl_type_to_classname,2,jpl,library(jpl)).
index(jpl_void,1,jpl,library(jpl)).
index(jpl_array_to_length,2,jpl,library(jpl)).
index(jpl_array_to_list,2,jpl,library(jpl)).
index(jpl_datums_to_array,2,jpl,library(jpl)).
index(jpl_enumeration_element,2,jpl,library(jpl)).
index(jpl_enumeration_to_list,2,jpl,library(jpl)).
index(jpl_hashtable_pair,2,jpl,library(jpl)).
index(jpl_iterator_element,2,jpl,library(jpl)).
index(jpl_list_to_array,2,jpl,library(jpl)).
index(jpl_list_to_array,3,jpl,library(jpl)).
index(jpl_terms_to_array,2,jpl,library(jpl)).
index(jpl_map_element,2,jpl,library(jpl)).
index(jpl_set_element,2,jpl,library(jpl)).
index(append,3,lists,library(lists)).
index(append,2,lists,library(lists)).
index(delete,3,lists,library(lists)).
index(intersection,3,lists,library(lists)).
index(flatten,2,lists,library(lists)).
index(last,2,lists,library(lists)).
index(list_concat,2,lists,library(lists)).
index(max_list,2,lists,library(lists)).
index(member,2,lists,library(lists)).
index(memberchk,2,lists,library(lists)).
index(min_list,2,lists,library(lists)).
index(nextto,3,lists,library(lists)).
index(nth,3,lists,library(lists)).
index(nth,4,lists,library(lists)).
index(nth0,3,lists,library(lists)).
index(nth0,4,lists,library(lists)).
index(nth1,3,lists,library(lists)).
index(nth1,4,lists,library(lists)).
index(numlist,3,lists,library(lists)).
index(permutation,2,lists,library(lists)).
index(prefix,2,lists,library(lists)).
index(remove_duplicates,2,lists,library(lists)).
index(reverse,2,lists,library(lists)).
index(same_length,2,lists,library(lists)).
index(select,3,lists,library(lists)).
index(selectchk,3,lists,library(lists)).
index(sublist,2,lists,library(lists)).
index(substitute,4,lists,library(lists)).
index(subtract,3,lists,library(lists)).
index(suffix,2,lists,library(lists)).
index(sum_list,2,lists,library(lists)).
index(sum_list,3,lists,library(lists)).
index(sumlist,2,lists,library(lists)).
index(nb_queue,1,nb,library(nb)).
index(nb_queue,2,nb,library(nb)).
index(nb_queue_close,3,nb,library(nb)).
index(nb_queue_enqueue,2,nb,library(nb)).
index(nb_queue_dequeue,2,nb,library(nb)).
index(nb_queue_peek,2,nb,library(nb)).
index(nb_queue_empty,1,nb,library(nb)).
index(nb_queue_size,2,nb,library(nb)).
index(nb_heap,2,nb,library(nb)).
index(nb_heap_close,1,nb,library(nb)).
index(nb_heap_add,3,nb,library(nb)).
index(nb_heap_del,3,nb,library(nb)).
index(nb_heap_peek,3,nb,library(nb)).
index(nb_heap_empty,1,nb,library(nb)).
index(nb_heap_size,2,nb,library(nb)).
index(nb_beam,2,nb,library(nb)).
index(nb_beam_close,1,nb,library(nb)).
index(nb_beam_add,3,nb,library(nb)).
index(nb_beam_del,3,nb,library(nb)).
index(nb_beam_peek,3,nb,library(nb)).
index(nb_beam_empty,1,nb,library(nb)).
index(nb_beam_size,2,nb,library(nb)).
index(contains_term,2,occurs,library(occurs)).
index(contains_var,2,occurs,library(occurs)).
index(free_of_term,2,occurs,library(occurs)).
index(free_of_var,2,occurs,library(occurs)).
index(occurrences_of_term,3,occurs,library(occurs)).
index(occurrences_of_var,3,occurs,library(occurs)).
index(sub_term,2,occurs,library(occurs)).
index(sub_var,2,occurs,library(occurs)).
index(option,2,swi_option,library(option)).
index(option,3,swi_option,library(option)).
index(select_option,3,swi_option,library(option)).
index(select_option,4,swi_option,library(option)).
index(merge_options,3,swi_option,library(option)).
index(meta_options,3,swi_option,library(option)).
index(list_to_ord_set,2,ordsets,library(ordsets)).
index(merge,3,ordsets,library(ordsets)).
index(ord_add_element,3,ordsets,library(ordsets)).
index(ord_del_element,3,ordsets,library(ordsets)).
index(ord_disjoint,2,ordsets,library(ordsets)).
index(ord_insert,3,ordsets,library(ordsets)).
index(ord_member,2,ordsets,library(ordsets)).
index(ord_intersect,2,ordsets,library(ordsets)).
index(ord_intersect,3,ordsets,library(ordsets)).
index(ord_intersection,3,ordsets,library(ordsets)).
index(ord_intersection,4,ordsets,library(ordsets)).
index(ord_seteq,2,ordsets,library(ordsets)).
index(ord_setproduct,3,ordsets,library(ordsets)).
index(ord_subset,2,ordsets,library(ordsets)).
index(ord_subtract,3,ordsets,library(ordsets)).
index(ord_symdiff,3,ordsets,library(ordsets)).
index(ord_union,2,ordsets,library(ordsets)).
index(ord_union,3,ordsets,library(ordsets)).
index(ord_union,4,ordsets,library(ordsets)).
index(ord_empty,1,ordsets,library(ordsets)).
index(ord_memberchk,2,ordsets,library(ordsets)).
index(pairs_keys_values,3,pairs,library(pairs)).
index(pairs_values,2,pairs,library(pairs)).
index(pairs_keys,2,pairs,library(pairs)).
index(group_pairs_by_key,2,pairs,library(pairs)).
index(transpose_pairs,2,pairs,library(pairs)).
index(map_list_to_pairs,3,pairs,library(pairs)).
index(xref_source,1,prolog_xref,library(prolog_xref)).
index(xref_called,3,prolog_xref,library(prolog_xref)).
index(xref_defined,3,prolog_xref,library(prolog_xref)).
index(xref_definition_line,2,prolog_xref,library(prolog_xref)).
index(xref_exported,2,prolog_xref,library(prolog_xref)).
index(xref_module,2,prolog_xref,library(prolog_xref)).
index(xref_op,2,prolog_xref,library(prolog_xref)).
index(xref_clean,1,prolog_xref,library(prolog_xref)).
index(xref_current_source,1,prolog_xref,library(prolog_xref)).
index(xref_done,2,prolog_xref,library(prolog_xref)).
index(xref_built_in,1,prolog_xref,library(prolog_xref)).
index(xref_expand,2,prolog_xref,library(prolog_xref)).
index(xref_source_file,3,prolog_xref,library(prolog_xref)).
index(xref_source_file,4,prolog_xref,library(prolog_xref)).
index(xref_public_list,4,prolog_xref,library(prolog_xref)).
index(xref_meta,2,prolog_xref,library(prolog_xref)).
index(xref_hook,1,prolog_xref,library(prolog_xref)).
index(xref_used_class,2,prolog_xref,library(prolog_xref)).
index(xref_defined_class,3,prolog_xref,library(prolog_xref)).
index(set_test_options,1,plunit,library(plunit)).
index(begin_tests,1,plunit,library(plunit)).
index(begin_tests,2,plunit,library(plunit)).
index(end_tests,1,plunit,library(plunit)).
index(run_tests,0,plunit,library(plunit)).
index(run_tests,1,plunit,library(plunit)).
index(load_test_files,1,plunit,library(plunit)).
index(running_tests,0,plunit,library(plunit)).
index(test_report,1,plunit,library(plunit)).
index(make_queue,1,queues,library(queues)).
index(join_queue,3,queues,library(queues)).
index(list_join_queue,3,queues,library(queues)).
index(jump_queue,3,queues,library(queues)).
index(list_jump_queue,3,queues,library(queues)).
index(head_queue,2,queues,library(queues)).
index(serve_queue,3,queues,library(queues)).
index(length_queue,2,queues,library(queues)).
index(empty_queue,1,queues,library(queues)).
index(list_to_queue,2,queues,library(queues)).
index(queue_to_list,2,queues,library(queues)).
index(random,1,random,library(random)).
index(random,3,random,library(random)).
index(randseq,3,random,library(random)).
index(randset,3,random,library(random)).
index(getrand,1,random,library(random)).
index(setrand,1,random,library(random)).
index(rb_new,1,rbtrees,library(rbtrees)).
index(rb_empty,1,rbtrees,library(rbtrees)).
index(rb_lookup,3,rbtrees,library(rbtrees)).
index(rb_update,4,rbtrees,library(rbtrees)).
index(rb_update,5,rbtrees,library(rbtrees)).
index(rb_apply,4,rbtrees,library(rbtrees)).
index(rb_lookupall,3,rbtrees,library(rbtrees)).
index(rb_insert,4,rbtrees,library(rbtrees)).
index(rb_insert_new,4,rbtrees,library(rbtrees)).
index(rb_delete,3,rbtrees,library(rbtrees)).
index(rb_delete,4,rbtrees,library(rbtrees)).
index(rb_visit,2,rbtrees,library(rbtrees)).
index(rb_visit,3,rbtrees,library(rbtrees)).
index(rb_keys,2,rbtrees,library(rbtrees)).
index(rb_keys,3,rbtrees,library(rbtrees)).
index(rb_map,2,rbtrees,library(rbtrees)).
index(rb_map,3,rbtrees,library(rbtrees)).
index(rb_partial_map,4,rbtrees,library(rbtrees)).
index(rb_clone,3,rbtrees,library(rbtrees)).
index(rb_clone,4,rbtrees,library(rbtrees)).
index(rb_min,3,rbtrees,library(rbtrees)).
index(rb_max,3,rbtrees,library(rbtrees)).
index(rb_del_min,4,rbtrees,library(rbtrees)).
index(rb_del_max,4,rbtrees,library(rbtrees)).
index(rb_next,4,rbtrees,library(rbtrees)).
index(rb_previous,4,rbtrees,library(rbtrees)).
index(list_to_rbtree,2,rbtrees,library(rbtrees)).
index(ord_list_to_rbtree,2,rbtrees,library(rbtrees)).
index(is_rbtree,1,rbtrees,library(rbtrees)).
index(rb_size,2,rbtrees,library(rbtrees)).
index(rb_in,3,rbtrees,library(rbtrees)).
index(read_line_to_codes,2,read_util,library(readutil)).
index(read_line_to_codes,3,read_util,library(readutil)).
index(read_stream_to_codes,2,read_util,library(readutil)).
index(read_stream_to_codes,3,read_util,library(readutil)).
index(read_file_to_codes,3,read_util,library(readutil)).
index(read_file_to_terms,3,read_util,library(readutil)).
index(regexp,3,regexp,library(regexp)).
index(regexp,4,regexp,library(regexp)).
index(load_foreign_library,1,shlib,library(shlib)).
index(load_foreign_library,2,shlib,library(shlib)).
index(unload_foreign_library,1,shlib,library(shlib)).
index(unload_foreign_library,2,shlib,library(shlib)).
index(current_foreign_library,2,shlib,library(shlib)).
index(reload_foreign_libraries,0,shlib,library(shlib)).
index(use_foreign_library,1,shlib,library(shlib)).
index(use_foreign_library,2,shlib,library(shlib)).
index(datime,1,operating_system_support,library(system)).
index(delete_file,1,operating_system_support,library(system)).
index(delete_file,2,operating_system_support,library(system)).
index(directory_files,2,operating_system_support,library(system)).
index(environ,2,operating_system_support,library(system)).
index(exec,3,operating_system_support,library(system)).
index(file_exists,1,operating_system_support,library(system)).
index(file_exists,2,operating_system_support,library(system)).
index(file_property,2,operating_system_support,library(system)).
index(host_id,1,operating_system_support,library(system)).
index(host_name,1,operating_system_support,library(system)).
index(pid,1,operating_system_support,library(system)).
index(kill,2,operating_system_support,library(system)).
index(mktemp,2,operating_system_support,library(system)).
index(make_directory,1,operating_system_support,library(system)).
index(popen,3,operating_system_support,library(system)).
index(rename_file,2,operating_system_support,library(system)).
index(shell,0,operating_system_support,library(system)).
index(shell,1,operating_system_support,library(system)).
index(shell,2,operating_system_support,library(system)).
index(sleep,1,operating_system_support,library(system)).
index(system,0,operating_system_support,library(system)).
index(system,1,operating_system_support,library(system)).
index(system,2,operating_system_support,library(system)).
index(mktime,2,operating_system_support,library(system)).
index(tmpnam,1,operating_system_support,library(system)).
index(tmp_file,2,operating_system_support,library(system)).
index(tmpdir,1,operating_system_support,library(system)).
index(wait,2,operating_system_support,library(system)).
index(working_directory,2,operating_system_support,library(system)).
index(term_hash,2,terms,library(terms)).
index(term_hash,4,terms,library(terms)).
index(instantiated_term_hash,4,terms,library(terms)).
index(variant,2,terms,library(terms)).
index(unifiable,3,terms,library(terms)).
index(subsumes,2,terms,library(terms)).
index(subsumes_chk,2,terms,library(terms)).
index(cyclic_term,1,terms,library(terms)).
index(variable_in_term,2,terms,library(terms)).
index(variables_within_term,3,terms,library(terms)).
index(new_variables_in_term,3,terms,library(terms)).
index(time_out,3,timeout,library(timeout)).
index(get_label,3,trees,library(trees)).
index(list_to_tree,2,trees,library(trees)).
index(map_tree,3,trees,library(trees)).
index(put_label,4,trees,library(trees)).
index(tree_size,2,trees,library(trees)).
index(tree_to_list,2,trees,library(trees)).

52
packages/python/swig/yap4py/prolog/apply.yap
View File

@ -1,52 +0,0 @@
/**
* @file apply.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Mon Nov 16 23:00:08 2015
*
* @brief Stub for maplist and friends
*
*
*/
:- module(apply_stub,[]).
/**
* @file apply.yap
* @defgroup apply_stub Apply Predicates
*
* @ingroup library
*
* @{
This library provides a SWI-compatible set of utilities for applying a
predicate to all elements of a list.
The apply library is a _stub_, it just forwards definitions to the
@ref maplist library. The predicates forwarded are:
- maplist/2,
- maplist/3,
- maplist/4,
- maplist/5,
- include/3,
- exclude/3,
- partition/4,
- partition/5
*/
:- reexport(library(maplist),
[maplist/2,
maplist/3,
maplist/4,
maplist/5,
include/3,
exclude/3,
partition/4,
partition/5
]).
%% @}

38
packages/python/swig/yap4py/prolog/apply_macros.yap
View File

@ -1,38 +0,0 @@
%% @file apply_macros.yap
%% @author E. Alphonse from code by Joachim Schimpf
%% @date 15 June 2002
%% @nrief Purpose: Macros to apply a predicate to all elements
% of a list or to all sub-terms of a term.
:- module(apply_macros, []).
/**
@defgroup apply_macros Apply Interface to maplist
@ingroup library
@{
This library provides a SWI-compatible set of utilities for applying a
predicate to all elements of a list.
The apply library just forwards
definitions to the @ref maplist library, these include:
- maplist/2,
- maplist/3,
- maplist/4,
- maplist/5,
- include/3,
- exclude/3,
- partition/4,
- partition/5
*/
:- reexport(maplist).
:- reexport(mapargs).
%% @}

167
packages/python/swig/yap4py/prolog/arg.yap
View File

@ -1,167 +0,0 @@
/**
* @file arg.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 01:08:55 2015
*
* @brief
*/
/**
*
@defgroup args Term Argument Manipulation.
@ingroup @library
@{
Extends arg/3 by including backtracking through arguments and access
to sub-arguments,
- arg0/3
- args/3
- args0/3
- genarg/3
- genarg0/3
- path_arg/3
It is based on the Quintus Prolog arg library. Except for project, all
predicates use the arg/3 argument pattern.
This file has been included in the YAP library by Vitor Santos Costa, 2008. No error checking is actuallly performed within the package: this left to the C-code thaat implements arg``/3 and
genarg/3.
*/
:- module(arg,
[
genarg/3,
arg0/3,
genarg0/3,
args/3,
args0/3,
% project/3
path_arg/3
]).
/**
* @pred arg0( +_Index_, +_Term_ , -_Arg_ )
*
* Similar to arg/3, but `arg0(0,_T_,_F_)` unifies _F_ with _T_'s principal functor:
~~~~~~~~~
?- arg0(0, f(a,b), A).
A = f.
?- arg0(1, f(a,b), A).
A = a.
?- arg0(2, f(a,b), A).
A = b.
~~~~~~~~~
*/
arg0(0,T,A) :- !,
functor(T,A,_).
arg0(I,T,A) :-
arg(I,T,A).
/**
* @pred genarg0( +_Index_, +_Term_ , -_Arg_ )
*
* Similar to genarg/3, but `genarg0(0,_T_,_F_)` unifies _F_ with _T_'s principal functor:
~~~~~~~~~
?- genarg0(I,f(a,b),A).
A = f,
I = 0 ? ;
A = a,
I = 1 ? ;
A = b,
I = 2.
~~~~~~~~~
*/
genarg0(I,T,A) :-
nonvar(I), !,
arg0(I,T,A).
genarg0(0,T,A) :-
functor(T,A,_).
genarg0(I,T,A) :-
genarg(I,T,A).
/**
* @pred args( +_Index_, +_ListOfTerms_ , -_ListOfArgs_ )
*
* Succeeds if _ListOfArgs_ unifies with the application of genarg/3 to every element of _ListOfTerms_.
It corresponds to calling maplist/3 on genarg/3:
~~~~~~~~~
args( I, Ts, As) :-
maplist( genarg(I), Ts, As).
~~~~~~~~~
Notice that unification allows _ListOfArgs_ to be bound, eg:
~~~~~~~~~
?- args(1, [X1+Y1,X2-Y2,X3*Y3,X4/Y4], [1,1,1,1]).
X1 = X2 = X3 = X4 = 1.
~~~~~~~~~
*/
args(_,[],[]).
args(I,[T|List],[A|ArgList]) :-
genarg(I, T, A),
args(I, List, ArgList).
/**
* @pred args0( +_Index_, +_ListOfTerms_ , -_ListOfArgs_ )
*
* Succeeds if _ListOfArgs_ unifies with the application of genarg0/3 to every element of _ListOfTerms_.
It corresponds to calling maplist/3 on genarg0/3:
~~~~~~~~~
args( I, Ts, As) :-
maplist( genarg0(I), Ts, As).
~~~~~~~~~
Notice that unification allows _ListOfArgs_ to be bound, eg:
~~~~~~~~~
?- args(1, [X1+Y1,X2-Y2,X3*Y3,X4/Y4], [1,1,1,1]).
X1 = X2 = X3 = X4 = 1.
~~~~~~~~~
*/
args0(_,[],[]).
args0(I,[T|List],[A|ArgList]) :-
genarg(I, T, A),
args0(I, List, ArgList).
/**
* @pred args0( +_ListOfTerms_ , +_Index_, -_ListOfArgs_ )
*
* Succeeds if _ListOfArgs_ unifies with the application of genarg0/3 to every element of _ListOfTerms_.
It corresponds to calling args0/3 but with a different order.
*/
project(Terms, Index, Args) :-
args0(Index, Terms, Args).
% no error checking here!
/**
* @pred path_arg( +_Path_ , +_Term_, -_Arg_ )
*
* Succeeds if _Path_ is empty and _Arg unifies with _Term_, or if _Path_ is a list with _Head_ and _Tail_, genarg/3 succeeds on the current term, and path_arg/3 succeeds on its argument.
*
* Notice that it can be used to enumerate all possible paths in a term.
*/
path_arg([], Term, Term).
path_arg([Index|Indices], Term, SubTerm) :-
genarg(Index, Term, Arg),
path_arg(Indices, Arg, SubTerm).
%%% @}
/** @} */

296
packages/python/swig/yap4py/prolog/assoc.yap
View File

@ -1,296 +0,0 @@
/**
* @file assoc.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 13:53:34 2015
*
* @brief Red-Black Implementation of Association Lists.
*
* This file has been included as an YAP library by Vitor Santos Costa, 1999
*
* Note: the keys should be bound, the associated values need not be.
*/
:- module(assoc, [
empty_assoc/1,
assoc_to_list/2,
is_assoc/1,
min_assoc/3,
max_assoc/3,
gen_assoc/3,
get_assoc/3,
get_assoc/5,
get_next_assoc/4,
get_prev_assoc/4,
list_to_assoc/2,
ord_list_to_assoc/2,
map_assoc/2,
map_assoc/3,
put_assoc/4,
del_assoc/4,
assoc_to_keys/2,
del_min_assoc/4,
del_max_assoc/4
]).
/** @defgroup Association_Lists Association Lists
@ingroup library
@{
The following association list manipulation predicates are available
once included with the `use_module(library(assoc))` command. The
original library used Richard O'Keefe's implementation, on top of
unbalanced binary trees. The current code utilises code from the
red-black trees library and emulates the SICStus Prolog interface.
The library exports the following definitions:
- is/assoc/1
*/
:- meta_predicate map_assoc(2, +, -), map_assoc(1, +).
:- use_module(library(rbtrees), [
rb_empty/1,
rb_visit/2,
is_rbtree/1,
rb_min/3,
rb_max/3,
rb_in/3,
rb_lookup/3,
rb_update/5,
rb_next/4,
rb_previous/4,
list_to_rbtree/2,
ord_list_to_rbtree/2,
rb_map/2,
rb_map/3,
rb_keys/2,
rb_update/4,
rb_insert/4,
rb_delete/4,
rb_del_min/4,
rb_del_max/4
]).
/** @pred empty_assoc(+ _Assoc_)
Succeeds if association list _Assoc_ is empty.
*/
empty_assoc(t).
/** @pred assoc_to_list(+ _Assoc_,? _List_)
Given an association list _Assoc_ unify _List_ with a list of
the form _Key-Val_, where the elements _Key_ are in ascending
order.
*/
assoc_to_list(t, L) :- !, L = [].
assoc_to_list(T, L) :-
rb_visit(T, L).
/** @pred is_assoc(+ _Assoc_)
Succeeds if _Assoc_ is an association list, that is, if it is a
red-black tree.
*/
is_assoc(t) :- !.
is_assoc(T) :-
is_rbtree(T).
/** @pred min_assoc(+ _Assoc_,- _Key_,? _Value_)
Given the association list
_Assoc_, _Key_ in the smallest key in the list, and _Value_
the associated value.
*/
min_assoc(T,K,V) :-
rb_min(T,K,V).
/** @pred max_assoc(+ _Assoc_,- _Key_,? _Value_)
Given the association list
_Assoc_, _Key_ in the largest key in the list, and _Value_
the associated value.
*/
max_assoc(T,K,V) :-
rb_max(T,K,V).
/** @pred gen_assoc( ?Key, +Assoc, ?Valu_)
Given the association list _Assoc_, unify _Key_ and _Value_
with a key-value pair in the list. It can be used to enumerate all elements
in the association list.
*/
gen_assoc(K, T, V) :-
rb_in(K,V,T).
/** @pred get_assoc(+ _Key_,+ _Assoc_,? _Value_)
If _Key_ is one of the elements in the association list _Assoc_,
return the associated value.
*/
get_assoc(K,T,V) :-
rb_lookup(K,V,T).
/** @pred get_assoc(+ _Key_,+ _Assoc_,? _Value_,+ _NAssoc_,? _NValue_)
If _Key_ is one of the elements in the association list _Assoc_,
return the associated value _Value_ and a new association list
_NAssoc_ where _Key_ is associated with _NValue_.
*/
get_assoc(K,T,V,NT,NV) :-
rb_update(T,K,V,NV,NT).
/** @pred get_next_assoc(+ _Key_,+ _Assoc_,? _Next_,? _Value_)
If _Key_ is one of the elements in the association list _Assoc_,
return the next key, _Next_, and its value, _Value_.
*/
get_next_assoc(K,T,KN,VN) :-
rb_next(T,K,KN,VN).
/** @pred get_prev_assoc(+ _Key_,+ _Assoc_,? _Next_,? _Value_)
If _Key_ is one of the elements in the association list _Assoc_,
return the previous key, _Next_, and its value, _Value_.
*/
get_prev_assoc(K,T,KP,VP) :-
rb_previous(T,K,KP,VP).
/** @pred list_to_assoc(+ _List_,? _Assoc_)
Given a list _List_ such that each element of _List_ is of the
form _Key-Val_, and all the _Keys_ are unique, _Assoc_ is
the corresponding association list.
*/
list_to_assoc(L, T) :-
list_to_rbtree(L, T).
/** @pred ord_list_to_assoc(+ _List_,? _Assoc_)
Given an ordered list _List_ such that each element of _List_ is
of the form _Key-Val_, and all the _Keys_ are unique, _Assoc_ is
the corresponding association list.
*/
ord_list_to_assoc(L, T) :-
ord_list_to_rbtree(L, T).
/** @pred map_assoc(+ _Pred_,+ _Assoc_)
Succeeds if the unary predicate name _Pred_( _Val_) holds for every
element in the association list.
*/
map_assoc(t, _) :- !.
map_assoc(P, T) :-
yap_flag(typein_module, M0),
extract_mod(P, M0, M, G),
functor(G, Name, 1),
rb_map(T, M:Name).
/** @pred map_assoc(+ _Pred_,+ _Assoc_,? _New_)
Given the binary predicate name _Pred_ and the association list
_Assoc_, _New_ in an association list with keys in _Assoc_,
and such that if _Key-Val_ is in _Assoc_, and _Key-Ans_ is in
_New_, then _Pred_( _Val_, _Ans_) holds.*/
map_assoc(t, T, T) :- !.
map_assoc(P, T, NT) :-
yap_flag(typein_module, M0),
extract_mod(P, M0, M, G),
functor(G, Name, 2),
rb_map(T, M:Name, NT).
extract_mod(G,_,_) :- var(G), !, fail.
extract_mod(M:G, _, FM, FG ) :- !,
extract_mod(G, M, FM, FG ).
extract_mod(G, M, M, G ).
/** @pred put_assoc(+ _Key_,+ _Assoc_,+ _Val_,+ _New_)
The association list _New_ includes and element of association
_key_ with _Val_, and all elements of _Assoc_ that did not
have key _Key_.
*/
put_assoc(K, T, V, NT) :-
rb_update(T, K, V, NT), !.
put_assoc(K, t, V, NT) :- !,
rbtrees:rb_new(K,V,NT).
put_assoc(K, T, V, NT) :-
rb_insert(T, K, V, NT).
/** @pred del_assoc(+ _Key_, + _Assoc_, ? _Val_, ? _NewAssoc_)
Succeeds if _NewAssoc_ is an association list, obtained by removing
the element with _Key_ and _Val_ from the list _Assoc_.
*/
del_assoc(K, T, V, NT) :-
rb_delete(T, K, V, NT).
/** @pred del_min_assoc(+ _Assoc_, ? _Key_, ? _Val_, ? _NewAssoc_)
Succeeds if _NewAssoc_ is an association list, obtained by removing
the smallest element of the list, with _Key_ and _Val_
from the list _Assoc_.
*/
del_min_assoc(T, K, V, NT) :-
rb_del_min(T, K, V, NT).
/** @pred del_max_assoc(+ _Assoc_, ? _Key_, ? _Val_, ? _NewAssoc_)
Succeeds if _NewAssoc_ is an association list, obtained by removing
the largest element of the list, with _Key_ and _Val_ from the
list _Assoc_.
*/
del_max_assoc(T, K, V, NT) :-
rb_del_max(T, K, V, NT).
assoc_to_keys(T, Ks) :-
rb_keys(T, Ks).
/**
@}
*/

280
packages/python/swig/yap4py/prolog/atts.yap
View File

@ -1,280 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: atts.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: attribute support for Prolog *
* *
*************************************************************************/
:- module(attributes, [op(1150, fx, attribute)]).
/**
*
* @defgroup sicsatts SICStus style attribute declarations
*
* @ingroup attributes
*
* @{
*
SICStus style attribute declarations are activated through loading the
library <tt>atts</tt>. The command
~~~~~
| ?- use_module(library(atts)).
~~~~~
enables this form of attributed variables.
The directive
- attribute/1
and the following user defined predicates can be used:
- Module:get_atts/2
- Module:put_atts/2
- Module:put_atts/3
- Module:woken_att_do/4
*/
:- use_module(library(lists), [member/2]).
:- multifile
user:goal_expansion/3.
:- multifile
user:term_expansion/2.
:- multifile
attributed_module/3.
:- dynamic existing_attribute/4.
:- dynamic modules_with_attributes/1.
:- dynamic attributed_module/3.
modules_with_attributes([]).
%
% defining a new attribute is just a question of establishing a
% Functor, Mod -> INT mappings
%
new_attribute(V) :- var(V), !,
throw(error(instantiation_error,attribute(V))).
new_attribute((At1,At2)) :-
new_attribute(At1),
new_attribute(At2).
new_attribute(Na/Ar) :-
source_module(Mod),
functor(S,Na,Ar),
existing_attribute(S,Mod,_,_) , !.
new_attribute(Na/Ar) :-
source_module(Mod),
functor(S,Na,Ar),
store_new_module(Mod,Ar,Position),
assertz(existing_attribute(S,Mod,Ar,Position)).
store_new_module(Mod,Ar,ArgPosition) :-
(
retract(attributed_module(Mod,Position,_))
->
true
;
retract(modules_with_attributes(Mods)),
assert(modules_with_attributes([Mod|Mods])), Position = 2
),
ArgPosition is Position+1,
( Ar == 0 -> NOfAtts is Position+1 ; NOfAtts is Position+Ar),
functor(AccessTerm,Mod,NOfAtts),
assertz(attributed_module(Mod,NOfAtts,AccessTerm)).
:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
/** @pred Module:get_atts( _-Var_, _?ListOfAttributes_)
Unify the list _?ListOfAttributes_ with the attributes for the unbound
variable _Var_. Each member of the list must be a bound term of the
form `+( _Attribute_)`, `-( _Attribute_)` (the <tt>kbd</tt>
prefix may be dropped). The meaning of <tt>+</tt> and <tt>-</tt> is:
+ +( _Attribute_)
Unifies _Attribute_ with a corresponding attribute associated with
_Var_, fails otherwise.
+ -( _Attribute_)
Succeeds if a corresponding attribute is not associated with
_Var_. The arguments of _Attribute_ are ignored.
*/
user:goal_expansion(get_atts(Var,AccessSpec), Mod, Goal) :-
expand_get_attributes(AccessSpec,Mod,Var,Goal).
/** @pred Module:put_atts( _-Var_, _?ListOfAttributes_)
Associate with or remove attributes from a variable _Var_. The
attributes are given in _?ListOfAttributes_, and the action depends
on how they are prefixed:
+ +( _Attribute_ )
Associate _Var_ with _Attribute_. A previous value for the
attribute is simply replace (like with `set_mutable/2`).
+ -( _Attribute_ )
Remove the attribute with the same name. If no such attribute existed,
simply succeed.
*/
user:goal_expansion(put_atts(Var,AccessSpec), Mod, Goal) :-
expand_put_attributes(AccessSpec, Mod, Var, Goal).
expand_get_attributes(V,_,_,_) :- var(V), !, fail.
expand_get_attributes([],_,_,true) :- !.
expand_get_attributes([-G1],Mod,V,attributes:free_att(V,Mod,Pos)) :-
existing_attribute(G1,Mod,_,Pos), !.
expand_get_attributes([+G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
arg(1,G1,A).
expand_get_attributes([G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
arg(1,G1,A).
expand_get_attributes(Atts,Mod,Var,attributes:get_module_atts(Var,AccessTerm)) :- Atts = [_|_], !,
attributed_module(Mod,NOfAtts,AccessTerm),
void_term(Void),
cvt_atts(Atts,Mod,Void,LAtts),
sort(LAtts,SortedLAtts),
free_term(Free),
build_att_term(1,NOfAtts,SortedLAtts,Free,AccessTerm).
expand_get_attributes(Att,Mod,Var,Goal) :-
expand_get_attributes([Att],Mod,Var,Goal).
build_att_term(NOfAtts,NOfAtts,[],_,_) :- !.
build_att_term(I0,NOfAtts,[I-Info|SortedLAtts],Void,AccessTerm) :-
I is I0+1, !,
copy_att_args(Info,I0,NI,AccessTerm),
build_att_term(NI,NOfAtts,SortedLAtts,Void,AccessTerm).
build_att_term(I0,NOfAtts,SortedLAtts,Void,AccessTerm) :-
I is I0+1,
arg(I,AccessTerm,Void),
build_att_term(I,NOfAtts,SortedLAtts,Void,AccessTerm).
cvt_atts(V,_,_,_) :- var(V), !, fail.
cvt_atts([],_,_,[]).
cvt_atts([V|_],_,_,_) :- var(V), !, fail.
cvt_atts([+Att|Atts],Mod,Void,[Pos-LAtts|Read]) :- !,
existing_attribute(Att,Mod,_,Pos),
(atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
cvt_atts(Atts,Mod,Void,Read).
cvt_atts([-Att|Atts],Mod,Void,[Pos-LVoids|Read]) :- !,
existing_attribute(Att,Mod,_,Pos),
(
atom(Att)
->
LVoids = [Void]
;
Att =..[_|LAtts],
void_vars(LAtts,Void,LVoids)
),
cvt_atts(Atts,Mod,Void,Read).
cvt_atts([Att|Atts],Mod,Void,[Pos-LAtts|Read]) :- !,
existing_attribute(Att,Mod,_,Pos),
(atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
cvt_atts(Atts,Mod,Void,Read).
copy_att_args([],I,I,_).
copy_att_args([V|Info],I,NI,AccessTerm) :-
I1 is I+1,
arg(I1,AccessTerm,V),
copy_att_args(Info,I1,NI,AccessTerm).
void_vars([],_,[]).
void_vars([_|LAtts],Void,[Void|LVoids]) :-
void_vars(LAtts,Void,LVoids).
expand_put_attributes(V,_,_,_) :- var(V), !, fail.
expand_put_attributes([-G1],Mod,V,attributes:rm_att(V,Mod,NOfAtts,Pos)) :-
existing_attribute(G1,Mod,_,Pos), !,
attributed_module(Mod,NOfAtts,_).
expand_put_attributes([+G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
attributed_module(Mod,NOfAtts,_),
arg(1,G1,A).
expand_put_attributes([G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
attributed_module(Mod,NOfAtts,_),
arg(1,G1,A).
expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) :- Atts = [_|_], !,
attributed_module(Mod,NOfAtts,AccessTerm),
void_term(Void),
cvt_atts(Atts,Mod,Void,LAtts),
sort(LAtts,SortedLAtts),
free_term(Free),
build_att_term(1,NOfAtts,SortedLAtts,Free,AccessTerm).
expand_put_attributes(Att,Mod,Var,Goal) :-
expand_put_attributes([Att],Mod,Var,Goal).
woken_att_do(AttVar, Binding, NGoals, DoNotBind) :-
modules_with_attributes(AttVar,Mods0),
modules_with_attributes(Mods),
find_used(Mods,Mods0,[],ModsI),
do_verify_attributes(ModsI, AttVar, Binding, Goals),
process_goals(Goals, NGoals, DoNotBind).
% dirty trick to be able to unbind a variable that has been constrained.
process_goals([], [], _).
process_goals((M:do_not_bind_variable(Gs)).Goals, (M:Gs).NGoals, true) :- !,
process_goals(Goals, NGoals, _).
process_goals(G.Goals, G.NGoals, Do) :-
process_goals(Goals, NGoals, Do).
find_used([],_,L,L).
find_used([M|Mods],Mods0,L0,Lf) :-
member(M,Mods0), !,
find_used(Mods,Mods0,[M|L0],Lf).
find_used([_|Mods],Mods0,L0,Lf) :-
find_used(Mods,Mods0,L0,Lf).
/** @pred Module:verify_attributes( _-Var_, _+Value_, _-Goals_)
The predicate is called when trying to unify the attributed variable
_Var_ with the Prolog term _Value_. Note that _Value_ may be
itself an attributed variable, or may contain attributed variables. The
goal <tt>verify_attributes/3</tt> is actually called before _Var_ is
unified with _Value_.
It is up to the user to define which actions may be performed by
<tt>verify_attributes/3</tt> but the procedure is expected to return in
_Goals_ a list of goals to be called <em>after</em> _Var_ is
unified with _Value_. If <tt>verify_attributes/3</tt> fails, the
unification will fail.
Notice that the <tt>verify_attributes/3</tt> may be called even if _Var_<
has no attributes in module <tt>Module</tt>. In this case the routine should
simply succeed with _Goals_ unified with the empty list.
*/
do_verify_attributes([], _, _, []).
do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
current_predicate(verify_attributes,Mod:verify_attributes(_,_,_)), !,
Mod:verify_attributes(AttVar, Binding, Goal),
do_verify_attributes(Mods, AttVar, Binding, Goals).
do_verify_attributes([_|Mods], AttVar, Binding, Goals) :-
do_verify_attributes(Mods, AttVar, Binding, Goals).
/**
@}
*/

127
packages/python/swig/yap4py/prolog/autoloader.yap
View File

@ -1,127 +0,0 @@
:- module(autoloader,[make_library_index/0]).
:- use_module(library(lists),[append/3]).
:- dynamic exported/3, loaded/1.
make_library_index :-
scan_library_exports,
scan_swi_exports.
scan_library_exports :-
% init table file.
open('INDEX.pl', write, W),
close(W),
scan_exports('../GPL/aggregate', library(aggregate)),
scan_exports(apply, library(apply)),
scan_exports(arg, library(arg)),
scan_exports(assoc, library(assoc)),
scan_exports(avl, library(avl)),
scan_exports(bhash, library(bhash)),
scan_exports(charsio, library(charsio)),
scan_exports('../packages/chr/chr_swi', library(chr)),
scan_exports(clp/clpfd, library(clpfd)),
scan_exports('../packages/clpqr/clpr', library(clpr)),
scan_exports(gensym, library(gensym)),
scan_exports(heaps, library(heaps)),
scan_exports('../packages/jpl/jpl', library(jpl)),
scan_exports(lists, library(lists)),
scan_exports(nb, library(nb)),
scan_exports(occurs, library(occurs)),
scan_exports('../LGPL/option', library(option)),
scan_exports(ordsets, library(ordsets)),
scan_exports(pairs, library(pairs)),
scan_exports('../LGPL/prolog_xref', library(prolog_xref)),
scan_exports('../packages/plunit/plunit', library(plunit)),
scan_exports(queues, library(queues)),
scan_exports(random, library(random)),
scan_exports(rbtrees, library(rbtrees)),
scan_exports('../LGPL/readutil', library(readutil)),
scan_exports(regexp, library(regexp)),
scan_exports('../LGPL/shlib', library(shlib)),
scan_exports(system, library(system)),
scan_exports(terms, library(terms)),
scan_exports(timeout, library(timeout)),
scan_exports(trees, library(trees)).
scan_exports(Library, CallName) :-
absolute_file_name(Library, Path,
[ file_type(prolog),
access(read),
file_errors(fail)
]),
open(Path, read, O),
!,
get_exports(O, Exports, Module),
close(O),
open('INDEX.pl', append, W),
publish_exports(Exports, W, CallName, Module),
close(W).
scan_exports(Library) :-
format(user_error,'[ warning: library ~w not defined ]~n',[Library]).
%
% SWI is the only language that uses autoload.
%
scan_swi_exports :-
retractall(exported(_,_,_)),
absolute_file_name(dialect/swi, Path,
[ file_type(prolog),
access(read),
file_errors(fail)
]),
open(Path, read, O),
get_exports(O, Exports, Module),
get_reexports(O, Reexports, Exports),
close(O),
open('dialect/swi/INDEX.pl', write, W),
publish_exports(Reexports, W, library(dialect/swi), Module),
close(W).
get_exports(O, Exports, Module) :-
read(O, (:- module(Module,Exports))), !.
get_exports(O, Exports, Module) :-
get_exports(O, Exports, Module).
get_reexports(O, Exports, ExportsL) :-
read(O, (:- reexport(_File,ExportsI))), !,
get_reexports(O, Exports0, ExportsL),
append(ExportsI, Exports0, Exports).
get_reexports(_, Exports, Exports).
publish_exports([], _, _, _).
publish_exports([F/A|Exports], W, Path, Module) :-
publish_export(F, A, W, Path, Module),
publish_exports(Exports, W, Path, Module).
publish_exports([F//A0|Exports], W, Path, Module) :-
A is A0+2,
publish_export(F, A, W, Path, Module),
publish_exports(Exports, W, Path, Module).
publish_exports([op(_,_,_)|Exports], W, Path, Module) :-
publish_exports(Exports, W, Path, Module).
publish_export(F, A, _, _, Module) :-
exported(F, A, M), M \= Module, !,
format(user_error,'[ warning: clash between ~a and ~a over ~a/~d ]~n',[Module,M,F,A]).
publish_export(F, A, W, Path, Module) :-
assert(exported(F, A, Module)), !,
portray_clause(W, index(F, A, Module, Path)).
find_predicate(G,ExportingModI) :-
nonvar(G), !,
functor(G, Name, Arity),
index(Name,Arity,ExportingModI,File),
ensure_file_loaded(File).
find_predicate(G,ExportingModI) :-
var(G),
index(Name,Arity,ExportingModI,File),
functor(G, Name, Arity),
ensure_file_loaded(File).
ensure_file_loaded(File) :-
loaded(File), !.
ensure_file_loaded(File) :-
load_files(autoloader:File,[silent(true),if(not_loaded)]),
assert(loaded(File)).

152
packages/python/swig/yap4py/prolog/avl.yap
View File

@ -1,152 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: regexp.yap *
* Last rev: 5/15/2000 *
* mods: *
* comments: AVL trees in YAP (from code by M. van Emden, P. Vasey) *
* *
*************************************************************************/
/**
* @file avl.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 00:59:28 2015
*
* @brief Support for constructing AVL trees
*
*
*/
:- module(avl, [
avl_new/1,
avl_insert/4,
avl_lookup/3
]).
/**
* @defgroup avl AVL Trees
* @ingroup library
@{
Supports constructing AVL trees, available through the directive:
~~~~~~~
:- use_module(library(avl)).
~~~~~~~
It includes the following predicates:
- avl_insert/4
- avl_lookup/3
- avl_new/1
AVL trees are balanced search binary trees. They are named after their
inventors, Adelson-Velskii and Landis, and they were the first
dynamically balanced trees to be proposed. The YAP AVL tree manipulation
predicates library uses code originally written by Martin van Emdem and
published in the Logic Programming Newsletter, Autumn 1981. A bug in
this code was fixed by Philip Vasey, in the Logic Programming
Newsletter, Summer 1982. The library currently only includes routines to
insert and lookup elements in the tree. Please try red-black trees if
you need deletion.
*/
/** @pred avl_new(+ _T_)
Create a new tree.
*/
avl_new([]).
/** @pred avl_insert(+ _Key_,? _Value_,+ _T0_,- _TF_)
Add an element with key _Key_ and _Value_ to the AVL tree
_T0_ creating a new AVL tree _TF_. Duplicated elements are
allowed.
*/
avl_insert(Key, Value, T0, TF) :-
insert(T0, Key, Value, TF, _).
insert([], Key, Value, avl([],Key,Value,-,[]), yes).
insert(avl(L,Root,RVal,Bl,R), E, Value, NewTree, WhatHasChanged) :-
E @< Root, !,
insert(L, E, Value, NewL, LeftHasChanged),
adjust(avl(NewL,Root,RVal,Bl,R), LeftHasChanged, left, NewTree, WhatHasChanged).
insert(avl(L,Root,RVal,Bl,R), E, Val, NewTree, WhatHasChanged) :-
% E @>= Root, currently we allow duplicated values, although
% lookup will only fetch the first.
insert(R, E, Val,NewR, RightHasChanged),
adjust(avl(L,Root,RVal,Bl,NewR), RightHasChanged, right, NewTree, WhatHasChanged).
adjust(Oldtree, no, _, Oldtree, no).
adjust(avl(L,Root,RVal,Bl,R), yes, Lor, NewTree, WhatHasChanged) :-
table(Bl, Lor, Bl1, WhatHasChanged, ToBeRebalanced),
rebalance(avl(L, Root, RVal, Bl, R), Bl1, ToBeRebalanced, NewTree).
% balance where balance whole tree to be
% before inserted after increased rebalanced
table(- , left , < , yes , no ).
table(- , right , > , yes , no ).
table(< , left , - , no , yes ).
table(< , right , - , no , no ).
table(> , left , - , no , no ).
table(> , right , - , no , yes ).
rebalance(avl(Lst, Root, RVal, _Bl, Rst), Bl1, no, avl(Lst, Root, RVal, Bl1,Rst)).
rebalance(OldTree, _, yes, NewTree) :-
avl_geq(OldTree,NewTree).
avl_geq(avl(Alpha,A,VA,>,avl(Beta,B,VB,>,Gamma)),
avl(avl(Alpha,A,VA,-,Beta),B,VB,-,Gamma)).
avl_geq(avl(avl(Alpha,A,VA,<,Beta),B,VB,<,Gamma),
avl(Alpha,A,VA,-,avl(Beta,B,VB,-,Gamma))).
avl_geq(avl(Alpha,A,VA,>,avl(avl(Beta,X,VX,Bl1,Gamma),B,VB,<,Delta)),
avl(avl(Alpha,A,VA,Bl2,Beta),X,VX,-,avl(Gamma,B,VB,Bl3,Delta))) :-
table2(Bl1,Bl2,Bl3).
avl_geq(avl(avl(Alpha,A,VA,>,avl(Beta,X,VX,Bl1,Gamma)),B,VB,<,Delta),
avl(avl(Alpha,A,VA,Bl2,Beta),X,VX,-,avl(Gamma,B,VB,Bl3,Delta))) :-
table2(Bl1,Bl2,Bl3).
table2(< ,- ,> ).
table2(> ,< ,- ).
table2(- ,- ,- ).
/** @pred avl_lookup(+ _Key_,- _Value_,+ _T_)
Lookup an element with key _Key_ in the AVL tree
_T_, returning the value _Value_.
*/
avl_lookup(Key, Value, avl(L,Key0,KVal,_,R)) :-
compare(Cmp, Key, Key0),
avl_lookup(Cmp, Value, L, R, Key, KVal).
avl_lookup(=, Value, _, _, _, Value).
avl_lookup(<, Value, L, _, Key, _) :-
avl_lookup(Key, Value, L).
avl_lookup(>, Value, _, R, Key, _) :-
avl_lookup(Key, Value, R).
/**
@}
*/

332
packages/python/swig/yap4py/prolog/bhash.yap
View File

@ -1,332 +0,0 @@
%% -*- Prolog -*-
/**
* @file bhash.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 01:11:29 2015
*
* @brief Backtrackable Hash Tables
*
*
*/
:- source.
:- yap_flag(unknown,error).
:- style_check(all).
:- module(b_hash, [ b_hash_new/1,
b_hash_new/2,
b_hash_new/4,
b_hash_lookup/3,
b_hash_update/3,
b_hash_update/4,
b_hash_insert_new/4,
b_hash_insert/4,
b_hash_size/2,
b_hash_code/2,
is_b_hash/1,
b_hash_to_list/2,
b_hash_values_to_list/2,
b_hash_keys_to_list/2
]).
/**
* @defgroup bhash Backtrackable Hash Tables
* @ingroup library
@{
This library implements hash-arrays.
It requires the hash key to be a ground term. The library can
be loaded as
:- use_module( library( bhash ) ).
This code relies on backtrackable updates. The default hash key is
generated by term_hash/4.
*/
:- use_module(library(terms), [ term_hash/4 ]).
:- meta_predicate(b_hash_new(-,+,3,2)).
array_default_size(2048).
/** @pred is_b_hash( +Hash )
Term _Hash_ is a hash table.
*/
is_b_hash(V) :- var(V), !, fail.
is_b_hash(hash(_,_,_,_,_)).
/** @pred b_hash_new( -NewHash )
Create a empty hash table _NewHash_, with size 2048 entries.
*/
b_hash_new(hash(Keys, Vals, Size, N, _, _)) :-
array_default_size(Size),
array(Keys, Size),
array(Vals, Size),
create_mutable(0, N).
/** @pred b_hash_new( -_NewHash_, +_Size_ )
Create a empty hash table, with size _Size_ entries.
*/
b_hash_new(hash(Keys, Vals, Size, N, _, _), Size) :-
array(Keys, Size),
array(Vals, Size),
create_mutable(0, N).
/** @pred b_hash_new( -_NewHash_, +_Size_, :_Hash_, :_Cmp_ )
Create a empty hash table, with size _Size_ entries.
_Hash_ defines a partition function, and _Cmp_ defined a comparison function.
*/
b_hash_new(hash(Keys,Vals, Size, N, HashF, CmpF), Size, HashF, CmpF) :-
array(Keys, Size),
array(Vals, Size),
create_mutable(0, N).
/**
@pred b_hash_size( +_Hash_, -_Size_ )
_Size_ unifies with the size of the hash table _Hash_.
*/
b_hash_size(hash(_, _, Size, _, _, _), Size).
/**
@pred b_hash_lookup( +_Key_, ?_Val_, +_Hash_ )
Search the ground term _Key_ in table _Hash_ and unify _Val_ with the associated entry.
*/
b_hash_lookup(Key, Val, hash(Keys, Vals, Size, _, F, CmpF)):-
hash_f(Key, Size, Index, F),
fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
array_element(Vals, ActualIndex, Mutable),
get_mutable(Val, Mutable).
fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex) :-
array_element(Keys, Index, El),
nonvar(El),
(
cmp_f(CmpF, El, Key)
->
Index = ActualIndex
;
I1 is (Index+1) mod Size,
fetch_key(Keys, I1, Size, Key, CmpF, ActualIndex)
).
/**
@pred b_hash_update( +_Key_, +_Hash_, +NewVal )
Update to the value associated with the ground term _Key_ in table _Hash_ to _NewVal_.
*/
b_hash_update(Hash, Key, NewVal):-
Hash = hash(Keys, Vals, Size, _, F, CmpF),
hash_f(Key,Size,Index,F),
fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
array_element(Vals, ActualIndex, Mutable),
update_mutable(NewVal, Mutable).
/**
@pred b_hash_update( +_Key_, -_OldVal_, +_Hash_, +NewVal )
Update to the value associated with the ground term _Key_ in table _Hash_ to _NewVal_, and unify _OldVal_ with the current value.
*/
b_hash_update(Hash, Key, OldVal, NewVal):-
Hash = hash(Keys, Vals, Size, _, F, CmpF),
hash_f(Key,Size,Index,F),
fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
array_element(Vals, ActualIndex, Mutable),
get_mutable(OldVal, Mutable),
update_mutable(NewVal, Mutable).
/** b_hash_insert(+_Hash_, +_Key_, _Val_, +_NewHash_ )
Insert the term _Key_-_Val_ in table _Hash_ and unify _NewHash_ with the result. If ground term _Key_ exists, update the dictionary.
*/
b_hash_insert(Hash, Key, NewVal, NewHash):-
Hash = hash(Keys, Vals, Size, N, F, CmpF),
hash_f(Key,Size,Index,F),
find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash).
find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :-
array_element(Keys, Index, El),
(
var(El)
->
add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash)
;
cmp_f(CmpF, El, Key)
->
% do rb_update
array_element(Vals, Index, Mutable),
update_mutable(NewVal, Mutable),
Hash = NewHash
;
I1 is (Index+1) mod Size,
find_or_insert(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash)
).
/**
@pred b_hash_insert_new(+_Hash_, +_Key_, _Val_, +_NewHash_ )
Insert the term _Key_-_Val_ in table _Hash_ and unify _NewHash_ with the result. If ground term _Key_ exists, fail.
*/
b_hash_insert_new(Hash, Key, NewVal, NewHash):-
Hash = hash(Keys, Vals, Size, N, F, CmpF),
hash_f(Key,Size,Index,F),
find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash).
find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :-
array_element(Keys, Index, El),
(
var(El)
->
add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash)
;
cmp_f(CmpF, El, Key)
->
fail
;
I1 is (Index+1) mod Size,
find_or_insert_new(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash)
).
add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash) :-
get_mutable(NEls, N),
NN is NEls+1,
update_mutable(NN, N),
array_element(Keys, Index, Key),
update_mutable(NN, N),
array_element(Vals, Index, Mutable),
create_mutable(NewVal, Mutable),
(
NN > Size/3
->
expand_array(Hash, NewHash)
;
Hash = NewHash
).
expand_array(Hash, NewHash) :-
Hash == NewHash, !,
Hash = hash(Keys, Vals, Size, _X, F, _CmpF),
new_size(Size, NewSize),
array(NewKeys, NewSize),
array(NewVals, NewSize),
copy_hash_table(Size, Keys, Vals, F, NewSize, NewKeys, NewVals),
/* overwrite in place */
setarg(1, Hash, NewKeys),
setarg(2, Hash, NewVals),
setarg(3, Hash, NewSize).
expand_array(Hash, hash(NewKeys, NewVals, NewSize, X, F, CmpF)) :-
Hash = hash(Keys, Vals, Size, X, F, CmpF),
new_size(Size, NewSize),
array(NewKeys, NewSize),
array(NewVals, NewSize),
copy_hash_table(Size, Keys, Vals, F, NewSize, NewKeys, NewVals).
new_size(Size, NewSize) :-
Size > 1048576, !,
NewSize is Size+1048576.
new_size(Size, NewSize) :-
NewSize is Size*2.
copy_hash_table(0, _, _, _, _, _, _) :- !.
copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :-
I is I1-1,
array_element(Keys, I, Key),
nonvar(Key), !,
array_element(Vals, I, Val),
insert_el(Key, Val, Size, F, NewKeys, NewVals),
copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals).
copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :-
I is I1-1,
copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals).
insert_el(Key, Val, Size, F, NewKeys, NewVals) :-
hash_f(Key,Size,Index, F),
find_free(Index, Size, NewKeys, TrueIndex),
array_element(NewKeys, TrueIndex, Key),
array_element(NewVals, TrueIndex, Val).
find_free(Index, Size, Keys, NewIndex) :-
array_element(Keys, Index, El),
(
var(El)
->
NewIndex = Index
;
I1 is (Index+1) mod Size,
find_free(I1, Size, Keys, NewIndex)
).
hash_f(Key, Size, Index, F) :-
var(F), !,
term_hash(Key,-1,Size,Index).
hash_f(Key, Size, Index, F) :-
call(F, Key, Size, Index).
cmp_f(F, A, B) :-
var(F), !,
A == B.
cmp_f(F, A, B) :-
call(F, A, B).
/**
@pred b_hash_to_list(+_Hash_, -_KeyValList_ )
The term _KeyValList_ unifies with a list containing all terms _Key_-_Val_ in the hash table.
*/
b_hash_to_list(hash(Keys, Vals, _, _, _, _), LKeyVals) :-
Keys =.. (_.LKs),
Vals =.. (_.LVs),
mklistpairs(LKs, LVs, LKeyVals).
/**
@pred b_key_to_list(+_Hash_, -_KeyList_ )
The term _KeyList_ unifies with a list containing all keys in the hash table.
*/
b_hash_keys_to_list(hash(Keys, _, _, _, _, _), LKeys) :-
Keys =.. (_.LKs),
mklistels(LKs, LKeys).
/**
@pred b_key_to_list(+_Hash_, -_ValList_ )
The term _`valList_ unifies with a list containing all values in the hash table.
*/
b_hash_values_to_list(hash(_, Vals, _, _, _, _), LVals) :-
Vals =.. (_.LVs),
mklistvals(LVs, LVals).
mklistpairs([], [], []).
mklistpairs(V.LKs, _.LVs, KeyVals) :- var(V), !,
mklistpairs(LKs, LVs, KeyVals).
mklistpairs(K.LKs, V.LVs, (K-VV).KeyVals) :-
get_mutable(VV, V),
mklistpairs(LKs, LVs, KeyVals).
mklistels([], []).
mklistels(V.Els, NEls) :- var(V), !,
mklistels(Els, NEls).
mklistels(K.Els, K.NEls) :-
mklistels(Els, NEls).
mklistvals([], []).
mklistvals(V.Vals, NVals) :- var(V), !,
mklistvals(Vals, NVals).
mklistvals(K.Vals, KK.NVals) :-
get_mutable(KK, K),
mklistvals(Vals, NVals).
/**
@}
*/

477
packages/python/swig/yap4py/prolog/block_diagram.yap
View File

@ -1,477 +0,0 @@
%%% -*- Mode: Prolog; -*-
/**
* @file block_diagram.yap
* @author Theofrastos Mantadelis, Sugestions from Paulo Moura
* @date Tue Nov 17 14:12:02 2015
*
* @brief Graph the program structure.
*
* @{
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Flags was developed at Katholieke Universiteit Leuven
%
% Copyright 2010
% Katholieke Universiteit Leuven
%
% Contributions to this file:
% Author: Theofrastos Mantadelis
% Sugestions: Paulo Moura
% Version: 1
% Date: 19/11/2010
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Artistic License 2.0
%
% Copyright (c) 2000-2006, The Perl Foundation.
%
% Everyone is permitted to copy and distribute verbatim copies of this
% license document, but changing it is not allowed. Preamble
%
% This license establishes the terms under which a given free software
% Package may be copied, modified, distributed, and/or
% redistributed. The intent is that the Copyright Holder maintains some
% artistic control over the development of that Package while still
% keeping the Package available as open source and free software.
%
% You are always permitted to make arrangements wholly outside of this
% license directly with the Copyright Holder of a given Package. If the
% terms of this license do not permit the full use that you propose to
% make of the Package, you should contact the Copyright Holder and seek
% a different licensing arrangement. Definitions
%
% "Copyright Holder" means the individual(s) or organization(s) named in
% the copyright notice for the entire Package.
%
% "Contributor" means any party that has contributed code or other
% material to the Package, in accordance with the Copyright Holder's
% procedures.
%
% "You" and "your" means any person who would like to copy, distribute,
% or modify the Package.
%
% "Package" means the collection of files distributed by the Copyright
% Holder, and derivatives of that collection and/or of those files. A
% given Package may consist of either the Standard Version, or a
% Modified Version.
%
% "Distribute" means providing a copy of the Package or making it
% accessible to anyone else, or in the case of a company or
% organization, to others outside of your company or organization.
%
% "Distributor Fee" means any fee that you charge for Distributing this
% Package or providing support for this Package to another party. It
% does not mean licensing fees.
%
% "Standard Version" refers to the Package if it has not been modified,
% or has been modified only in ways explicitly requested by the
% Copyright Holder.
%
% "Modified Version" means the Package, if it has been changed, and such
% changes were not explicitly requested by the Copyright Holder.
%
% "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and
% configuration files for the Package.
%
% "Compiled" form means the compiled bytecode, object code, binary, or
% any other form resulting from mechanical transformation or translation
% of the Source form.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Permission for Use and Modification Without Distribution
%
% (1) You are permitted to use the Standard Version and create and use
% Modified Versions for any purpose without restriction, provided that
% you do not Distribute the Modified Version.
%
% Permissions for Redistribution of the Standard Version
%
% (2) You may Distribute verbatim copies of the Source form of the
% Standard Version of this Package in any medium without restriction,
% either gratis or for a Distributor Fee, provided that you duplicate
% all of the original copyright notices and associated disclaimers. At
% your discretion, such verbatim copies may or may not include a
% Compiled form of the Package.
%
% (3) You may apply any bug fixes, portability changes, and other
% modifications made available from the Copyright Holder. The resulting
% Package will still be considered the Standard Version, and as such
% will be subject to the Original License.
%
% Distribution of Modified Versions of the Package as Source
%
% (4) You may Distribute your Modified Version as Source (either gratis
% or for a Distributor Fee, and with or without a Compiled form of the
% Modified Version) provided that you clearly document how it differs
% from the Standard Version, including, but not limited to, documenting
% any non-standard features, executables, or modules, and provided that
% you do at least ONE of the following:
%
% (a) make the Modified Version available to the Copyright Holder of the
% Standard Version, under the Original License, so that the Copyright
% Holder may include your modifications in the Standard Version. (b)
% ensure that installation of your Modified Version does not prevent the
% user installing or running the Standard Version. In addition, the
% modified Version must bear a name that is different from the name of
% the Standard Version. (c) allow anyone who receives a copy of the
% Modified Version to make the Source form of the Modified Version
% available to others under (i) the Original License or (ii) a license
% that permits the licensee to freely copy, modify and redistribute the
% Modified Version using the same licensing terms that apply to the copy
% that the licensee received, and requires that the Source form of the
% Modified Version, and of any works derived from it, be made freely
% available in that license fees are prohibited but Distributor Fees are
% allowed.
%
% Distribution of Compiled Forms of the Standard Version or
% Modified Versions without the Source
%
% (5) You may Distribute Compiled forms of the Standard Version without
% the Source, provided that you include complete instructions on how to
% get the Source of the Standard Version. Such instructions must be
% valid at the time of your distribution. If these instructions, at any
% time while you are carrying out such distribution, become invalid, you
% must provide new instructions on demand or cease further
% distribution. If you provide valid instructions or cease distribution
% within thirty days after you become aware that the instructions are
% invalid, then you do not forfeit any of your rights under this
% license.
%
% (6) You may Distribute a Modified Version in Compiled form without the
% Source, provided that you comply with Section 4 with respect to the
% Source of the Modified Version.
%
% Aggregating or Linking the Package
%
% (7) You may aggregate the Package (either the Standard Version or
% Modified Version) with other packages and Distribute the resulting
% aggregation provided that you do not charge a licensing fee for the
% Package. Distributor Fees are permitted, and licensing fees for other
% components in the aggregation are permitted. The terms of this license
% apply to the use and Distribution of the Standard or Modified Versions
% as included in the aggregation.
%
% (8) You are permitted to link Modified and Standard Versions with
% other works, to embed the Package in a larger work of your own, or to
% build stand-alone binary or bytecode versions of applications that
% include the Package, and Distribute the result without restriction,
% provided the result does not expose a direct interface to the Package.
%
% Items That are Not Considered Part of a Modified Version
%
% (9) Works (including, but not limited to, modules and scripts) that
% merely extend or make use of the Package, do not, by themselves, cause
% the Package to be a Modified Version. In addition, such works are not
% considered parts of the Package itself, and are not subject to the
% terms of this license.
%
% General Provisions
%
% (10) Any use, modification, and distribution of the Standard or
% Modified Versions is governed by this Artistic License. By using,
% modifying or distributing the Package, you accept this license. Do not
% use, modify, or distribute the Package, if you do not accept this
% license.
%
% (11) If your Modified Version has been derived from a Modified Version
% made by someone other than you, you are nevertheless required to
% ensure that your Modified Version complies with the requirements of
% this license.
%
% (12) This license does not grant you the right to use any trademark,
% service mark, tradename, or logo of the Copyright Holder.
%
% (13) This license includes the non-exclusive, worldwide,
% free-of-charge patent license to make, have made, use, offer to sell,
% sell, import and otherwise transfer the Package with respect to any
% patent claims licensable by the Copyright Holder that are necessarily
% infringed by the Package. If you institute patent litigation
% (including a cross-claim or counterclaim) against any party alleging
% that the Package constitutes direct or contributory patent
% infringement, then this Artistic License to you shall terminate on the
% date that such litigation is filed.
%
% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/** @defgroup block_diagram Block Diagram
@ingroup library
@{
This library provides a way of visualizing a prolog program using
modules with blocks. To use it use:
`:-use_module(library(block_diagram))`.
*/
:- module(block_diagram, [make_diagram/2, make_diagram/5]).
/* ---------------------------------------------------------------------- *\
|* Missing stuff: a parameter that bounds the module connection depth *|
|* and a parameter that diseables/limits the text over edges *|
\* ---------------------------------------------------------------------- */
:- style_check(all).
:- yap_flag(unknown, error).
:- use_module(library(charsio), [term_to_atom/2]).
:- use_module(library(lists), [memberchk/2, member/2, append/3]).
:- use_module(library(system), [working_directory/2]).
:- dynamic([seen_module/1, parameter/1]).
parameter(texts((+inf))).
parameter(depth((+inf))).
parameter(default_ext('.yap')).
/** @pred make_diagram(+Inputfilename, +Ouputfilename)
This will crawl the files following the use_module, ensure_loaded directives withing the inputfilename.
The result will be a file in dot format.
You can make a pdf at the shell by asking `dot -Tpdf filename > output.pdf`.
*/
make_diagram(InputFile, OutputFile):-
tell(OutputFile),
write('digraph G {\nrankdir=BT'), nl,
extract_name_file(InputFile, Name, File),
nb_setval(depth, 0),
read_module_file(File, Name),
write_explicit,
write('}'), nl,
told.
/** @pred make_diagram(+Inputfilename, +Ouputfilename, +Predicate, +Depth, +Extension)
The same as make_diagram/2 but you can define how many of the imported/exporeted predicates will be shown with predicate, and how deep the crawler is allowed to go with depth. The extension is used if the file use module directives do not include a file extension.
*/
make_diagram(InputFile, OutputFile, Texts, Depth, Ext):-
integer(Texts),
integer(Depth),
retractall(parameter(_)),
assertz(parameter(texts(Texts))),
assertz(parameter(depth(Depth))),
assertz(parameter(default_ext(Ext))),
make_diagram(InputFile, OutputFile),
retractall(parameter(_)),
assertz(parameter(texts((+inf)))),
assertz(parameter(depth((+inf)))),
assertz(parameter(default_ext('.yap'))).
path_seperator('\\'):-
yap_flag(windows, true), !.
path_seperator('/').
split_path_file(PathFile, Path, File):-
path_seperator(PathSeperator),
atom_concat(Path, File, PathFile),
name(PathSeperator, [PathSeperatorName]),
name(File, FileName),
\+ memberchk(PathSeperatorName, FileName),
!.
split_file_ext(FileExt, File, Ext):-
atom_concat(File, Ext, FileExt),
atom_concat('.', _, Ext),
name('.', [DotName]),
name(Ext, ExtName),
findall(A, (member(A, ExtName), A = DotName), L),
length(L, 1), !.
parse_module_directive(':-'(module(Name)), _):-
seen_module(node(Name)), !.
parse_module_directive(':-'(module(Name, _Exported)), _):-
seen_module(node(Name)), !.
parse_module_directive(':-'(module(Name, Exported)), Shape):-
!, \+ seen_module(node(Name)),
assertz(seen_module(node(Name))),
list_to_message(Exported, ExportedMessage),
atom_concat([Name, ' [shape=', Shape,',label="', Name, '\\n', ExportedMessage, '"]'], NodeDefinition),
write(NodeDefinition), nl.
parse_module_directive(':-'(module(Name)), Shape):-
\+ seen_module(node(Name)),
assertz(seen_module(node(Name))),
atom_concat([Name, ' [shape=', Shape,',label="', Name, '"]'], NodeDefinition),
write(NodeDefinition), nl.
extract_name_file(PathFile, Name, FinalFile):-
split_path_file(PathFile, Path, FileName), Path \== '', !,
extract_name_file(FileName, Name, File),
atom_concat(Path, File, FinalFile).
extract_name_file(File, Name, File):-
split_file_ext(File, Name, _), !.
extract_name_file(Name, Name, File):-
parameter(default_ext(Ext)),
atom_concat(Name, Ext, File).
read_use_module_directive(':-'(ensure_loaded(library(Name))), Name, library(Name), []):- !.
read_use_module_directive(':-'(ensure_loaded(Path)), Name, FinalFile, []):-
extract_name_file(Path, Name, FinalFile), !.
read_use_module_directive(':-'(use_module(library(Name))), Name, library(Name), []):- !.
read_use_module_directive(':-'(use_module(Path)), Name, FinalFile, []):-
extract_name_file(Path, Name, FinalFile), !.
read_use_module_directive(':-'(use_module(library(Name), Import)), Name, library(Name), Import):- !.
read_use_module_directive(':-'(use_module(Path, Import)), Name, FinalFile, Import):-
extract_name_file(Path, Name, FinalFile), !.
read_use_module_directive(':-'(use_module(Name, Path, Import)), Name, FinalFile, Import):-
nonvar(Path),
extract_name_file(Path, _, FinalFile), !.
read_use_module_directive(':-'(use_module(Name, Path, Import)), Name, FinalFile, Import):-
var(Path),
extract_name_file(Name, _, FinalFile), !.
parse_use_module_directive(Module, Directive):-
read_use_module_directive(Directive, Name, File, Imported),
parse_use_module_directive(Module, Name, File, Imported).
parse_use_module_directive(Module, Name, _File, _Imported):-
seen_module(edge(Module, Name)), !.
parse_use_module_directive(Module, Name, File, Imported):-
\+ seen_module(edge(Module, Name)),
assertz(seen_module(edge(Module, Name))),
read_module_file(File, Name),
list_to_message(Imported, ImportedMessage),
atom_concat([Module, ' -> ', Name, ' [label="', ImportedMessage, '"]'], NodeConnection),
write(NodeConnection), nl.
list_to_message(List, Message):-
length(List, Len),
parameter(texts(TextCnt)),
(Len > TextCnt + 1 ->
append(FirstCnt, _, List),
length(FirstCnt, TextCnt),
append(FirstCnt, ['...'], First)
;
First = List
),
list_to_message(First, '', Message).
list_to_message([], Message, Message).
list_to_message([H|T], '', FinalMessage):-
term_to_atom(H, HAtom), !,
list_to_message(T, HAtom, FinalMessage).
list_to_message([H|T], AccMessage, FinalMessage):-
term_to_atom(H, HAtom),
atom_concat([AccMessage, '\\n', HAtom], NewMessage),
list_to_message(T, NewMessage, FinalMessage).
read_module_file(library(Module), Module):-
!, parse_module_directive(':-'(module(Module, [])), component).
read_module_file(File, Module):-
parameter(depth(MaxDepth)),
nb_getval(depth, Depth),
MaxDepth > Depth,
split_path_file(File, Path, FileName),
catch((working_directory(CurDir,Path), open(FileName, read, S)), _, (parse_module_directive(':-'(module(Module, [])), box3d), fail)),
NDepth is Depth + 1,
nb_setval(depth, NDepth),
repeat,
catch(read(S, Next),_,fail),
process(Module, Next),
nb_setval(depth, Depth),
close(S), working_directory(_,CurDir), !.
read_module_file(_, _).
/** @pred process(+ _StreamInp_, + _Goal_)
For every line _LineIn_ in stream _StreamInp_, call
`call(Goal,LineIn)`.
*/
process(_, end_of_file):-!.
process(_, Term):-
parse_module_directive(Term, box), !, fail.
process(Module, Term):-
parse_use_module_directive(Module, Term), !, fail.
process(Module, Term):-
find_explicit_qualification(Module, Term), fail.
find_explicit_qualification(OwnerModule, ':-'(Module:Goal)):-
!, explicit_qualification(OwnerModule, Module, Goal).
find_explicit_qualification(OwnerModule, ':-'(_Head, Body)):-
find_explicit_qualification(OwnerModule, Body).
find_explicit_qualification(OwnerModule, (Module:Goal, RestBody)):-
!, explicit_qualification(OwnerModule, Module, Goal),
find_explicit_qualification(OwnerModule, RestBody).
find_explicit_qualification(OwnerModule, (_Goal, RestBody)):-
!, find_explicit_qualification(OwnerModule, RestBody).
find_explicit_qualification(OwnerModule, Module:Goal):-
!, explicit_qualification(OwnerModule, Module, Goal).
find_explicit_qualification(_OwnerModule, _Goal).
explicit_qualification(InModule, ToModule, Goal):-
nonvar(Goal), nonvar(ToModule), !,
functor(Goal, FunctorName, Arity),
\+ seen_module(explicit(InModule, ToModule, FunctorName/Arity)),
assertz(seen_module(explicit(InModule, ToModule, FunctorName/Arity))).
explicit_qualification(InModule, ToModule, Goal):-
var(Goal), nonvar(ToModule), !,
\+ seen_module(explicit(InModule, ToModule, 'DYNAMIC')),
assertz(seen_module(explicit(InModule, ToModule, 'DYNAMIC'))).
explicit_qualification(InModule, ToModule, Goal):-
nonvar(Goal), var(ToModule), !,
functor(Goal, FunctorName, Arity),
\+ seen_module(explicit(InModule, 'DYNAMIC', FunctorName/Arity)),
assertz(seen_module(explicit(InModule, 'DYNAMIC', FunctorName/Arity))).
explicit_qualification(InModule, ToModule, Goal):-
var(Goal), var(ToModule),
\+ seen_module(explicit(InModule, 'DYNAMIC', 'DYNAMIC')),
assertz(seen_module(explicit(InModule, 'DYNAMIC', 'DYNAMIC'))).
write_explicit:-
seen_module(explicit(InModule, ToModule, _Goal)),
\+ seen_module(generate_explicit(InModule, ToModule)),
assertz(seen_module(generate_explicit(InModule, ToModule))),
all(Goal, seen_module(explicit(InModule, ToModule, Goal)), Goals),
list_to_message(Goals, Explicit),
atom_concat([InModule, ' -> ', ToModule, ' [label="', Explicit, '",style=dashed]'], NodeConnection),
write(NodeConnection), nl, fail.
write_explicit.
/*
functor(Goal, FunctorName, Arity),
term_to_atom(FunctorName/Arity, Imported),
atom_concat([InModule, ' -> ', ToModule, ' [label="', Imported, '",style=dashed]'], NodeConnection),
write(NodeConnection), nl.
atom_concat([InModule, ' -> ', ToModule, ' [label="DYNAMIC",style=dashed]'], NodeConnection),
write(NodeConnection), nl.
functor(Goal, FunctorName, Arity),
term_to_atom(FunctorName/Arity, Imported),
atom_concat([InModule, ' -> DYNAMIC [label="', Imported, '",style=dashed]'], NodeConnection),
write(NodeConnection), nl.
atom_concat([InModule, ' -> DYNAMIC [label="DYNAMIC",style=dashed]'], NodeConnection),
write(NodeConnection), nl.
*/
%% @} @}

422
packages/python/swig/yap4py/prolog/c_alarms.yap
View File

@ -1,422 +0,0 @@
%%% -*- Mode: Prolog; -*-
/**
* @file c_alarms.yap
* @author Theofrastos Mantadelis
* @date Tue Nov 17 14:50:03 2015
*
* @brief Concurrent alarms
*
*
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Concurrent alarms was developed at Katholieke Universiteit Leuven
%
% Copyright 2010
% Katholieke Universiteit Leuven
%
% Contributions to this file:
% Author: Theofrastos Mantadelis
% $Date: 2011-02-04 16:04:49 +0100 (Fri, 04 Feb 2011) $
% $Revision: 11 $
% Contributions: The timer implementation is inspired by Bernd Gutmann's timers
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Artistic License 2.0
%
% Copyright (c) 2000-2006, The Perl Foundation.
%
% Everyone is permitted to copy and distribute verbatim copies of this
% license document, but changing it is not allowed. Preamble
%
% This license establishes the terms under which a given free software
% Package may be copied, modified, distributed, and/or
% redistributed. The intent is that the Copyright Holder maintains some
% artistic control over the development of that Package while still
% keeping the Package available as open source and free software.
%
% You are always permitted to make arrangements wholly outside of this
% license directly with the Copyright Holder of a given Package. If the
% terms of this license do not permit the full use that you propose to
% make of the Package, you should contact the Copyright Holder and seek
% a different licensing arrangement. Definitions
%
% "Copyright Holder" means the individual(s) or organization(s) named in
% the copyright notice for the entire Package.
%
% "Contributor" means any party that has contributed code or other
% material to the Package, in accordance with the Copyright Holder's
% procedures.
%
% "You" and "your" means any person who would like to copy, distribute,
% or modify the Package.
%
% "Package" means the collection of files distributed by the Copyright
% Holder, and derivatives of that collection and/or of those files. A
% given Package may consist of either the Standard Version, or a
% Modified Version.
%
% "Distribute" means providing a copy of the Package or making it
% accessible to anyone else, or in the case of a company or
% organization, to others outside of your company or organization.
%
% "Distributor Fee" means any fee that you charge for Distributing this
% Package or providing support for this Package to another party. It
% does not mean licensing fees.
%
% "Standard Version" refers to the Package if it has not been modified,
% or has been modified only in ways explicitly requested by the
% Copyright Holder.
%
% "Modified Version" means the Package, if it has been changed, and such
% changes were not explicitly requested by the Copyright Holder.
%
% "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and
% configuration files for the Package.
%
% "Compiled" form means the compiled bytecode, object code, binary, or
% any other form resulting from mechanical transformation or translation
% of the Source form.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Permission for Use and Modification Without Distribution
%
% (1) You are permitted to use the Standard Version and create and use
% Modified Versions for any purpose without restriction, provided that
% you do not Distribute the Modified Version.
%
% Permissions for Redistribution of the Standard Version
%
% (2) You may Distribute verbatim copies of the Source form of the
% Standard Version of this Package in any medium without restriction,
% either gratis or for a Distributor Fee, provided that you duplicate
% all of the original copyright notices and associated disclaimers. At
% your discretion, such verbatim copies may or may not include a
% Compiled form of the Package.
%
% (3) You may apply any bug fixes, portability changes, and other
% modifications made available from the Copyright Holder. The resulting
% Package will still be considered the Standard Version, and as such
% will be subject to the Original License.
%
% Distribution of Modified Versions of the Package as Source
%
% (4) You may Distribute your Modified Version as Source (either gratis
% or for a Distributor Fee, and with or without a Compiled form of the
% Modified Version) provided that you clearly document how it differs
% from the Standard Version, including, but not limited to, documenting
% any non-standard features, executables, or modules, and provided that
% you do at least ONE of the following:
%
% (a) make the Modified Version available to the Copyright Holder of the
% Standard Version, under the Original License, so that the Copyright
% Holder may include your modifications in the Standard Version. (b)
% ensure that installation of your Modified Version does not prevent the
% user installing or running the Standard Version. In addition, the
% modified Version must bear a name that is different from the name of
% the Standard Version. (c) allow anyone who receives a copy of the
% Modified Version to make the Source form of the Modified Version
% available to others under (i) the Original License or (ii) a license
% that permits the licensee to freely copy, modify and redistribute the
% Modified Version using the same licensing terms that apply to the copy
% that the licensee received, and requires that the Source form of the
% Modified Version, and of any works derived from it, be made freely
% available in that license fees are prohibited but Distributor Fees are
% allowed.
%
% Distribution of Compiled Forms of the Standard Version or
% Modified Versions without the Source
%
% (5) You may Distribute Compiled forms of the Standard Version without
% the Source, provided that you include complete instructions on how to
% get the Source of the Standard Version. Such instructions must be
% valid at the time of your distribution. If these instructions, at any
% time while you are carrying out such distribution, become invalid, you
% must provide new instructions on demand or cease further
% distribution. If you provide valid instructions or cease distribution
% within thirty days after you become aware that the instructions are
% invalid, then you do not forfeit any of your rights under this
% license.
%
% (6) You may Distribute a Modified Version in Compiled form without the
% Source, provided that you comply with Section 4 with respect to the
% Source of the Modified Version.
%
% Aggregating or Linking the Package
%
% (7) You may aggregate the Package (either the Standard Version or
% Modified Version) with other packages and Distribute the resulting
% aggregation provided that you do not charge a licensing fee for the
% Package. Distributor Fees are permitted, and licensing fees for other
% components in the aggregation are permitted. The terms of this license
% apply to the use and Distribution of the Standard or Modified Versions
% as included in the aggregation.
%
% (8) You are permitted to link Modified and Standard Versions with
% other works, to embed the Package in a larger work of your own, or to
% build stand-alone binary or bytecode versions of applications that
% include the Package, and Distribute the result without restriction,
% provided the result does not expose a direct interface to the Package.
%
% Items That are Not Considered Part of a Modified Version
%
% (9) Works (including, but not limited to, modules and scripts) that
% merely extend or make use of the Package, do not, by themselves, cause
% the Package to be a Modified Version. In addition, such works are not
% considered parts of the Package itself, and are not subject to the
% terms of this license.
%
% General Provisions
%
% (10) Any use, modification, and distribution of the Standard or
% Modified Versions is governed by this Artistic License. By using,
% modifying or distributing the Package, you accept this license. Do not
% use, modify, or distribute the Package, if you do not accept this
% license.
%
% (11) If your Modified Version has been derived from a Modified Version
% made by someone other than you, you are nevertheless required to
% ensure that your Modified Version complies with the requirements of
% this license.
%
% (12) This license does not grant you the right to use any trademark,
% service mark, tradename, or logo of the Copyright Holder.
%
% (13) This license includes the non-exclusive, worldwide,
% free-of-charge patent license to make, have made, use, offer to sell,
% sell, import and otherwise transfer the Package with respect to any
% patent claims licensable by the Copyright Holder that are necessarily
% infringed by the Package. If you institute patent litigation
% (including a cross-claim or counterclaim) against any party alleging
% that the Package constitutes direct or contributory patent
% infringement, then this Artistic License to you shall terminate on the
% date that such litigation is filed.
%
% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module(c_alarms, [set_alarm/3,
unset_alarm/1,
time_out_call_once/3,
timer_start/1,
timer_restart/1,
timer_stop/2,
timer_elapsed/2,
timer_pause/2]).
/** @defgroup c_alarms Concurrent Alarms
@ingroup library
@{
This library provides a concurrent signals. To use it use:
`:-use_module(library(c_alarms))`.
*/
:- use_module(library(lists), [member/2, memberchk/2, delete/3]).
:- use_module(library(ordsets), [ord_add_element/3]).
:- use_module(library(apply_macros), [maplist/3]).
:- dynamic('$timer'/3).
:- meta_predicate(set_alarm(+, 0, -)).
:- meta_predicate(time_out_call_once(+, 0, -)).
:- meta_predicate(prove_once(0)).
:- initialization(local_init).
local_init:-
bb_put(alarms, []),
bb_put(identity, 0).
get_next_identity(ID):-
bb_get(identity, ID),
NID is ID + 1,
bb_put(identity, NID).
set_alarm(Seconds, Execute, ID):-
bb_get(alarms, []),
get_next_identity(ID), !,
bb_put(alarms, [alarm(Seconds, ID, Execute)]),
alarm(Seconds, alarm_handler, _).
%% set_alarm(+Seconds, +Execute, -ID)
%
% calls Executes after a time interval of Seconds
% ID is returned to be able to unset the alarm (the call will not be executed)
% set_alarm/3 supports multiple & nested settings of alarms.
% Known Bug: There is the case that an alarm might trigger +-1 second of the set time.
%
set_alarm(Seconds, Execute, ID):-
get_next_identity(ID), !,
bb_get(alarms, [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms]),
alarm(0, true, Remaining),
Elapsed is CurrentSeconds - Remaining - 1,
maplist(subtract(Elapsed), [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms], RemainingAlarms),
ord_add_element(RemainingAlarms, alarm(Seconds, ID, Execute), [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
bb_put(alarms, [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
alarm(NewSeconds, alarm_handler, _).
set_alarm(Seconds, Execute, ID):-
throw(error(permission_error(create, alarm, set_alarm(Seconds, Execute, ID)), 'Non permitted alarm identifier.')).
subtract(Elapsed, alarm(Seconds, ID, Execute), alarm(NewSeconds, ID, Execute)):-
NewSeconds is Seconds - Elapsed.
%% unset_alarm(+ID)
%
% It will unschedule the alarm.
% It will not affect other concurrent alarms.
%
unset_alarm(ID):-
\+ ground(ID),
throw(error(instantiation_error, 'Alarm ID needs to be instantiated.')).
unset_alarm(ID):-
bb_get(alarms, Alarms),
\+ memberchk(alarm(_Seconds, ID, _Execute), Alarms),
throw(error(existence_error(alarm, unset_alarm(ID)), 'Alarm does not exist.')).
unset_alarm(ID):-
alarm(0, true, Remaining),
bb_get(alarms, Alarms),
[alarm(Seconds, _, _)|_] = Alarms,
Elapsed is Seconds - Remaining - 1,
delete_alarm(Alarms, ID, NewAlarms),
bb_put(alarms, NewAlarms),
(NewAlarms = [alarm(NewSeconds, _, _)|_] ->
RemainingSeconds is NewSeconds - Elapsed,
alarm(RemainingSeconds, alarm_handler, _)
;
true
).
delete_alarm(Alarms, ID, NewAlarms):-
memberchk(alarm(Seconds, ID, Execute), Alarms),
delete(Alarms, alarm(Seconds, ID, Execute), NewAlarms).
alarm_handler:-
bb_get(alarms, [alarm(_, _, CurrentExecute)|[]]),
bb_put(alarms, []),
call(CurrentExecute).
alarm_handler:-
bb_get(alarms, [alarm(Elapsed, CurrentID, CurrentExecute)|Alarms]),
maplist(subtract(Elapsed), Alarms, NewAlarms),
find_zeros(NewAlarms, ZeroAlarms),
findall(alarm(S, ID, E), (member(alarm(S, ID, E), NewAlarms), S > 0), NonZeroAlarms),
bb_put(alarms, NonZeroAlarms),
(NonZeroAlarms = [alarm(NewSeconds, _, _)|_] ->
alarm(NewSeconds, alarm_handler, _)
;
true
),
execute([alarm(0, CurrentID, CurrentExecute)|ZeroAlarms]).
find_zeros([], []).
find_zeros([alarm(0, ID, E)|T], [alarm(0, ID, E)|R]):-
find_zeros(T, R).
find_zeros([alarm(S, _, _)|T], R):-
S > 0,
find_zeros(T, R).
execute([]).
execute([alarm(_, _, Execute)|R]):-
call(Execute),
execute(R).
%% time_out_call(+Seconds, +Goal, -Return)
%
% It will will execute the closure Goal and returns its success or failure at Return.
% If the goal times out in Seconds then Return = timeout.
time_out_call_once(Seconds, Goal, Return):-
bb_get(identity, ID),
set_alarm(Seconds, throw(timeout(ID)), ID),
catch((
prove_once(Goal, Return),
unset_alarm(ID))
, Exception, (
(Exception == timeout(ID) ->
Return = timeout
;
unset_alarm(ID),
throw(Exception)
))).
prove_once(Goal, success):-
once(Goal), !.
prove_once(_Goal, failure).
timer_start(Name):-
\+ ground(Name),
throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
timer_start(Name):-
'$timer'(Name, _, _),
throw(error(permission_error(create, timer, timer_start(Name)), 'Timer already exists.')).
timer_start(Name):-
statistics(walltime, [StartTime, _]),
assertz('$timer'(Name, running, StartTime)).
timer_restart(Name):-
\+ ground(Name),
throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
timer_restart(Name):-
\+ '$timer'(Name, _, _), !,
statistics(walltime, [StartTime, _]),
assertz('$timer'(Name, running, StartTime)).
timer_restart(Name):-
retract('$timer'(Name, running, _)), !,
statistics(walltime, [StartTime, _]),
assertz('$timer'(Name, running, StartTime)).
timer_restart(Name):-
retract('$timer'(Name, paused, Duration)),
statistics(walltime, [StartTime, _]),
Elapsed is StartTime - Duration,
assertz('$timer'(Name, running, Elapsed)).
timer_stop(Name, Elapsed):-
\+ '$timer'(Name, _, _),
throw(error(existence_error(timer, timer_stop(Name, Elapsed)), 'Timer does not exist.')).
timer_stop(Name, Elapsed):-
retract('$timer'(Name, running, StartTime)), !,
statistics(walltime, [EndTime, _]),
Elapsed is EndTime - StartTime.
timer_stop(Name, Elapsed):-
retract('$timer'(Name, paused, Elapsed)).
timer_elapsed(Name, Elapsed):-
\+ '$timer'(Name, _, _),
throw(error(existence_error(timer, timer_elapsed(Name, Elapsed)), 'Timer does not exist.')).
timer_elapsed(Name, Elapsed):-
'$timer'(Name, running, StartTime), !,
statistics(walltime, [EndTime, _]),
Elapsed is EndTime - StartTime.
timer_elapsed(Name, Elapsed):-
'$timer'(Name, paused, Elapsed).
timer_pause(Name, Elapsed):-
\+ '$timer'(Name, _, _),
throw(error(existence_error(timer, timer_pause(Name, Elapsed)), 'Timer does not exist.')).
timer_pause(Name, Elapsed):-
'$timer'(Name, paused, _),
throw(error(permission_error(timer, timer_pause(Name, Elapsed)), 'Timer already paused.')).
timer_pause(Name, Elapsed):-
retract('$timer'(Name, _, StartTime)),
statistics(walltime, [EndTime, _]),
Elapsed is EndTime - StartTime,
assertz('$timer'(Name, paused, Elapsed)).
/**
@}
*/

230
packages/python/swig/yap4py/prolog/charsio.yap
View File

@ -1,230 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: charsio.yap *
* Last rev: 5/12/99 *
* mods: *
* comments: I/O on character strings *
* *
*************************************************************************/
/**
* @file charsio.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 01:17:33 2015
*
* @brief Several operations on text.
* @{
*
*/
:- module(charsio, [
format_to_chars/3,
format_to_chars/4,
write_to_chars/3,
write_to_chars/2,
atom_to_chars/3,
atom_to_chars/2,
number_to_chars/3,
number_to_chars/2,
read_from_chars/2,
open_chars_stream/2,
with_output_to_chars/2,
with_output_to_chars/3,
with_output_to_chars/4,
term_to_atom/2
]).
/** @defgroup charsio Operations on Sequences of Codes.
@ingroup library
Term to sequence of codes conversion, mostly replaced by engine code.
You can use the following directive to load the files.
~~~~~~~
:- use_module(library(avl)).
~~~~~~~
It includes the following predicates:
- atom_to_chars/2
- atom_to_chars/3
- format_to_chars/3
- format_to_chars/4
- number_to_chars/2
- number_to_chars/3
- open_chars_stream/2
- read_from_chars/2
- term_to_atom/2
- with_output_to_chars/2
- with_output_to_chars/3
- with_output_to_chars/4
- write_to_chars/2
- write_to_chars/3
*/
:- meta_predicate(with_output_to_chars(0,?)).
:- meta_predicate(with_output_to_chars(0,-,?)).
:- meta_predicate(with_output_to_chars(0,-,?,?)).
/** @pred format_to_chars(+ _Form_, + _Args_, - _Result_)
Execute the built-in procedure format/2 with form _Form_ and
arguments _Args_ outputting the result to the string of character
codes _Result_.
*/
format_to_chars(Format, Args, Codes) :-
format(codes(Codes), Format, Args).
/** @pred format_to_chars(+ _Form_, + _Args_, - _Result_, - _Result0_)
Execute the built-in procedure format/2 with form _Form_ and
arguments _Args_ outputting the result to the difference list of
character codes _Result-Result0_.
*/
format_to_chars(Format, Args, OUT, L0) :-
format(codes(OUT, L0), Format, Args).
/** @pred write_to_chars(+ _Term_, - _Result_)
Execute the built-in procedure write/1 with argument _Term_
outputting the result to the string of character codes _Result_.
*/
write_to_chars(Term, Codes) :-
format(codes(Codes), '~w', [Term]).
/** @pred write_to_chars(+ _Term_, - _Result0_, - _Result_)
Execute the built-in procedure write/1 with argument _Term_
outputting the result to the difference list of character codes
_Result-Result0_.
*/
write_to_chars(Term, Out, Tail) :-
format(codes(Out,Tail),'~w',[Term]).
/** @pred atom_to_chars(+ _Atom_, - _Result_)
Convert the atom _Atom_ to the string of character codes
_Result_.
*/
atom_to_chars(Atom, OUT) :-
atom_codes(Atom, OUT).
/** @pred atom_to_chars(+ _Atom_, - _Result0_, - _Result_)
Convert the atom _Atom_ to the difference list of character codes
_Result-Result0_.
*/
atom_to_chars(Atom, L0, OUT) :-
format(codes(L0, OUT), '~a', [Atom]).
/** @pred number_to_chars(+ _Number_, - _Result_)
Convert the number _Number_ to the string of character codes
_Result_.
*/
number_to_chars(Number, OUT) :-
number_codes(Number, OUT).
/** @pred number_to_chars(+ _Number_, - _Result0_, - _Result_)
Convert the atom _Number_ to the difference list of character codes
_Result-Result0_.
*/
number_to_chars(Number, L0, OUT) :-
var(Number), !,
throw(error(instantiation_error,number_to_chars(Number, L0, OUT))).
number_to_chars(Number, L0, OUT) :-
number(Number), !,
format(codes(L0, OUT), '~w', [Number]).
number_to_chars(Number, L0, OUT) :-
throw(error(type_error(number,Number),number_to_chars(Number, L0, OUT))).
/** @pred open_chars_stream(+ _Chars_, - _Stream_)
Open the list of character codes _Chars_ as a stream _Stream_.
*/
open_chars_stream(Codes, Stream) :-
open_chars_stream(Codes, Stream, '').
open_chars_stream(Codes, Stream, Postfix) :-
predicate_property(memory_file:open_memory_file(_,_,_),_), !,
memory_file:new_memory_file(MF),
memory_file:open_memory_file(MF, write, Out),
format(Out, '~s~w', [Codes, Postfix]),
close(Out),
memory_file:open_memory_file(MF, read, Stream,
[ free_on_close(true)
]).
open_chars_stream(Codes, Stream, Postfix) :-
ensure_loaded(library(memfile)),
open_chars_stream(Codes, Stream, Postfix).
/** @pred with_output_to_chars(? _Goal_, - _Chars_)
Execute goal _Goal_ such that its standard output will be sent to a
memory buffer. After successful execution the contents of the memory
buffer will be converted to the list of character codes _Chars_.
*/
with_output_to_chars(Goal, Codes) :-
with_output_to(codes(Codes), Goal).
/** @pred with_output_to_chars(? _Goal_, ? _Chars0_, - _Chars_)
Execute goal _Goal_ such that its standard output will be sent to a
memory buffer. After successful execution the contents of the memory
buffer will be converted to the difference list of character codes
_Chars-Chars0_.
*/
with_output_to_chars(Goal, Codes, L0) :-
with_output_to(codes(Codes, L0), Goal).
%% with_output_to_chars(:Goal, -Stream, -Codes, ?Tail) is det.
%
% As with_output_to_chars/2, but Stream is unified with the
% temporary stream.
/** @pred with_output_to_chars(? _Goal_, - _Stream_, ? _Chars0_, - _Chars_)
Execute goal _Goal_ such that its standard output will be sent to a
memory buffer. After successful execution the contents of the memory
buffer will be converted to the difference list of character codes
_Chars-Chars0_ and _Stream_ receives the stream corresponding to
the memory buffer.
*/
with_output_to_chars(Goal, Stream, Codes, Tail) :-
with_output_to(codes(Codes, Tail), with_stream(Stream, Goal)).
with_stream(Stream, Goal) :-
current_output(Stream),
call(Goal).
/** @pred read_from_chars(+ _Chars_, - _Term_)
Parse the list of character codes _Chars_ and return the result in
the term _Term_. The character codes to be read must terminate with
a dot character such that either (i) the dot character is followed by
blank characters; or (ii) the dot character is the last character in the
string.
@compat The SWI-Prolog version does not require Codes to end
in a full-stop.
*/
read_from_chars("", end_of_file) :- !.
read_from_chars(List, Term) :-
atom_to_term(List, Term, _).
/**
@}
*/

96
packages/python/swig/yap4py/prolog/clauses.yap
View File

@ -1,96 +0,0 @@
/**
* @file clauses.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 14:51:30 2015
*
* @brief Utilities for clause manipulation.
*
*
*/
:- module(clauses,
[list2conj/2,
conj2list/2,
clauselength/2]).
%% @{
/**
* @defgroup clauses Clause Manipulation
* @ingroup library
This library supports a number of useful utilities that come up over and
over again when manipulating Prolog programs. This will include
operations and conversion to other structures.
@author Vitor Santos Costa
*/
/** conj2list( +Conj, -List) is det
Generate a list from a conjunction of literals.
It is often easier to apply operations on lists than on clauses
*/
conj2list( M:Conj, List ) :-
conj2list_( Conj, M, List, [] ).
conj2list( Conj, List ) :-
conj2list_( Conj, List, [] ).
conj2list_( C ) -->
{ var(C) },
!,
[C].
conj2list_( true ) --> !.
conj2list_( (C1, C2) ) -->
!,
conj2list_( C1 ),
conj2list_( C2 ).
conj2list_( C ) -->
[C].
conj2list_( C, M ) -->
{ var(C) },
!,
[M: C].
conj2list_( true , _) --> !.
conj2list_( (C1, C2), M ) -->
!,
conj2list_( C1, M ),
conj2list_( C2, M ).
conj2list_( C, M ) -->
{ strip_module(M:C, NM, NC) },
[NM:NC].
/** list2conj( +List, -Conj) is det
Generate a conjunction from a list of literals.
Notice Mthat this relies on indexing within the list to avoid creating
choice-points.
*/
list2conj([], true).
list2conj([Last], Last).
list2conj([Head,Next|Tail], (Head,Goals)) :-
list2conj([Next|Tail], Goals).
/** clauselength( +Clause, -Length) is det
Count the number of literals in a clause (head counts as one).
Notice that this is 1+length(conj2list), as we ignore disjunctions.
*/
clauselength( (_Head :- Conj), Length ) :-
clauselength( Conj, Length, 1 ).
clauselength( C, I1, I ) :-
{ var(C) },
!,
I1 is I+1.
clauselength( (C1, C2), I2, I ) :- !,
clauselength( C1, I1, I ),
clauselength( C2, I2, I1 ).
clauselength( _C, I1, I ) :-
I1 is I+1.
%%@}

216
packages/python/swig/yap4py/prolog/coinduction.yap
View File

@ -1,216 +0,0 @@
/**
* @file coinduction.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>, Arvin Bansal,
*
*
* @date Tue Nov 17 14:55:02 2015
*
* @brief Co-inductive execution
*
*
*/
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: coinduction.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: coinduction support for Prolog *
* *
*************************************************************************/
% :- yap_flag(unknown,error).
% :- style_check(all).
%
% Code originally written by Arvin Bansal and Vitor Santos Costa
% Includes nice extensions from Jan Wielemaker (from the SWI version).
%
:- module(coinduction,
[ (coinductive)/1,
op(1150, fx, (coinductive))
]).
:- use_module(library(error)).
/** <module> coinduction Co-Logic Programming
@ingroup library
This simple module implements the directive coinductive/1 as described
in "Co-Logic Programming: Extending Logic Programming with Coinduction"
by Luke Somin et al. The idea behind coinduction is that a goal succeeds
if it unifies to a parent goal. This enables some interesting programs,
notably on infinite trees (cyclic terms).
~~~~
:- use_module(library(coinduction)).
:- coinductive stream/1.
stream([H|T]) :- i(H), stream(T).
% inductive
i(0).
i(s(N)) :- i(N).
?- X=[s(s(A))|X], stream(X).
X= [s(s(A))|X], stream(X).
A = 0,
X = [s(s(0)),**]
~~~~
This predicate is true for any cyclic list containing only 1-s,
regardless of the cycle-length.
@bug Programs mixing normal predicates and coinductive predicates must
be _stratified_. The theory does not apply to normal Prolog calling
coinductive predicates, calling normal Prolog predicates, etc.
Stratification is not checked or enforced in any other way and thus
left as a responsibility to the user.
@see "Co-Logic Programming: Extending Logic Programming with Coinduction"
by Luke Somin et al.
@{
*/
:- meta_predicate coinductive(:).
:- dynamic coinductive/3.
%-----------------------------------------------------
coinductive(Spec) :-
var(Spec),
!,
throw(error(instantiation_error,coinductive(Spec))).
coinductive(Module:Spec) :-
coinductive_declaration(Spec, Module, coinductive(Module:Spec)).
coinductive(Spec) :-
prolog_load_context(module, Module),
coinductive_declaration(Spec, Module, coinductive(Spec)).
coinductive_declaration(Spec, _M, G) :-
var(Spec),
!,
throw(error(instantiation_error,G)).
coinductive_declaration((A,B), M, G) :- !,
coinductive_declaration(A, M, G),
coinductive_declaration(B, M, G).
coinductive_declaration(M:Spec, _, G) :- !,
coinductive_declaration(Spec, M, G).
coinductive_declaration(Spec, M, _G) :-
valid_pi(Spec, F, N),
functor(S,F,N),
atomic_concat(['__coinductive__',F,'/',N],NF),
functor(NS,NF,N),
match_args(N,S,NS),
atomic_concat(['__stack_',M,':',F,'/',N],SF),
nb_setval(SF, _),
assert((M:S :-
b_getval(SF,L),
coinduction:in_stack(S, L, End),
(
nonvar(End)
->
true
;
End = [S|_],
M:NS)
)
),
assert(coinduction:coinductive(S,M,NS)).
valid_pi(Name/Arity, Name, Arity) :-
must_be(atom, Name),
must_be(integer, Arity).
match_args(0,_,_) :- !.
match_args(I,S1,S2) :-
arg(I,S1,A),
arg(I,S2,A),
I1 is I-1,
match_args(I1,S1,S2).
%-----------------------------------------------------
co_term_expansion((M:H :- B), _, (M:NH :- B)) :- !,
co_term_expansion((H :- B), M, (NH :- B)).
co_term_expansion((H :- B), M, (NH :- B)) :- !,
coinductive(H, M, NH), !.
co_term_expansion(H, M, NH) :-
coinductive(H, M, NH), !.
user:term_expansion(M:Cl,M:NCl ) :- !,
co_term_expansion(Cl, M, NCl).
user:term_expansion(G, NG) :-
prolog_load_context(module, Module),
co_term_expansion(G, Module, NG).
%-----------------------------------------------------
in_stack(_, V, V) :- var(V), !.
in_stack(G, [G|_], [G|_]) :- !.
in_stack(G, [_|T], End) :- in_stack(G, T, End).
writeG_val(G_var) :-
b_getval(G_var, G_val),
write(G_var), write(' ==> '), write(G_val), nl.
%-----------------------------------------------------
/**
Some examples from Coinductive Logic Programming and its Applications by Gopal Gupta et al, ICLP 97
~~~~
:- coinductive stream/1.
stream([H|T]) :- i(H), stream(T).
% inductive
i(0).
i(s(N)) :- i(N).
% Are there infinitely many "occurrences" of arg1 in arg2?
:- coinductive comember/2.
comember(X, L) :-
drop(X, L, L1),
comember(X, L1).
% Drop some prefix of arg2 upto an "occurrence" of arg1 from arg2,
% yielding arg3.
% ("Occurrence" of X = something unifiable with X.)
%:- table(drop/3). % not working; needs tabling supporting cyclic terms!
drop(H, [H| T], T).
drop(H, [_| T], T1) :-
drop(H, T, T1).
% X = [1, 2, 3| X], comember(E, X).
user:p(E) :-
X = [1, 2, 3| X],
comember(E, X),
format('~w~n',[E]),
get_code(_),
fail.
~~~~
@}
*/

70
packages/python/swig/yap4py/prolog/dbqueues.yap
View File

@ -1,70 +0,0 @@
s/**
* @file dbqueues.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 15:01:49 2015
*
* @brief A library to support queues with no-backtrackable queues.
*
*
*/
:- module(nbqueue, [
nb_enqueue/2,
nb_dequeue/2,
nb_clean_queue/1,
nb_size/2
]).
/**
* @defgroup dbqueues Non-backtrackable queues in YAP.
* @ingroup library
A library to implement queues of NB Terms
*/
:- unhide_atom('$init_nb_queue').
:- unhide_atom('$nb_enqueue').
:- unhide_atom('$nb_dequeue').
nb_enqueue(Name,El) :- var(Name),
throw(error(instantiation_error(Name),nb_enqueue(Name,El))).
nb_enqueue(Name,El) :- \+ atom(Name), !,
throw(error(type_error_atom(Name),nb_enqueue(Name,El))).
nb_enqueue(Name,El) :-
recorded('$nb_queue',[Name|Ref],_), !,
prolog:'$nb_enqueue'(Ref, El).
nb_enqueue(Name,El) :-
prolog:'$init_nb_queue'(Ref),
recorda('$nb_queue',[Name|Ref],_),
prolog:'$nb_enqueue'(Ref,El).
nb_dequeue(Name,El) :- var(Name),
throw(error(instantiation_error(Name),nb_dequeue(Name,El))).
nb_dequeue(Name,El) :- \+ atom(Name), !,
throw(error(type_error_atom(Name),nb_dequeue(Name,El))).
nb_dequeue(Name,El) :-
recorded('$nb_queue',[Name|Ref],R),
( prolog:'$nb_dequeue'(Ref, El) ->
true
;
erase(R),
fail
).
nb_clean_queue(Name) :-
recorded('$nb_queue',[Name|Ref],R), !,
erase(R),
nb_dequeue_all(Ref).
nb_clean_queue(_).
nb_dequeue_all(Ref) :-
( prolog:'$nb_dequeue'(Ref, _) -> nb_dequeue_all(Ref) ; true ).
nb_dequeue_size(Ref, Size) :-
prolog:'$nb_size'(Ref, Size).

208
packages/python/swig/yap4py/prolog/dbusage.yap
View File

@ -1,208 +0,0 @@
/**
* @file dbusage.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 15:04:52 2015
*
* @brief Useful statistics on memory usage
*
*
*/
:- module(dbusage, [
db_usage/0,
db_static/0,
db_static/1,
db_dynamic/0,
db_dynamic/1
]).
/**
* @defgroup dbusage Memory Usage in Prolog Data-Base
* @ingroup library
@{
This library provides a set of utilities for studying memory usage in YAP.
The following routines are available once included with the
`use_module(library(dbusage))` command.
*/
/** @pred db_usage
Give general overview of data-base usage in the system.
*/
db_usage :-
statistics(heap,[HeapUsed,HeapFree]),
statistics(local_stack,[GInU,FreeS]),
statistics(global_stack,[SInU,_]),
statistics(trail,[TInU,FreeT]),
HeapUsedK is HeapUsed//1024,
HeapFreeK is HeapFree//1024,
StackSpace is (GInU+SInU+FreeS+TInU+FreeT)//1024,
format(user_error, 'Heap Space = ~D KB (+ ~D KB free)~n',[HeapUsedK,HeapFreeK]),
format(user_error, 'Stack Space = ~D KB~n',[StackSpace]),
findall(p(Cls,CSz,ISz),
(current_module(M),
current_predicate(_,M:P),
predicate_statistics(M:P,Cls,CSz,ISz)),LAll),
sumall(LAll, TCls, TCSz, TISz),
statistics(atoms,[AtomN,AtomS]),
AtomSK is AtomS//1024,
format(user_error, '~D Atoms taking ~D KB~n',[AtomN,AtomSK]),
TSz is TCSz+TISz,
TSzK is TSz//1024,
TCSzK is TCSz//1024,
TISzK is TISz//1024,
format(user_error, 'Total User Code~n ~D clauses taking ~D KB~n ~D KB in clauses + ~D KB in indices~n',
[TCls,TSzK,TCSzK,TISzK]),
statistics(static_code,[SCl,SI,SI1,SI2,SI3]),
SClK is SCl//1024,
SIK is SI//1024,
SI1K is SI1//1024,
SI2K is SI2//1024,
SI3K is SI3//1024,
ST is SCl+SI,
STK is ST//1024,
format(user_error, 'Total Static code=~D KB~n ~D KB in clauses + ~D KB in indices (~D+~D+~D)~n',
[STK,SClK,SIK,SI1K,SI2K,SI3K]),
statistics(dynamic_code,[DCl,DI,DI1,DI2,DI3,DI4]),
DClK is DCl//1024,
DIK is DI//1024,
DI1K is DI1//1024,
DI2K is DI2//1024,
DI3K is DI3//1024,
DI4K is DI4//1024,
DT is DCl+DI,
DTK is DT//1024,
format(user_error, 'Total Dynamic code=~D KB~n ~D KB in clauses + ~D KB in indices (~D+~D+~D+~D)~n',
[DTK,DClK,DIK,DI1K,DI2K,DI3K,DI4K]),
total_erased(DCls,DSZ,ICls,ISZ),
(DCls =:= 0 ->
true
;
DSZK is DSZ//1024,
format(user_error, ' ~D erased clauses not reclaimed (~D KB)~n',[DCls,DSZK])
),
(ICls =:= 0 ->
true
;
ISZK is ISZ//1024,
format(user_error, ' ~D erased indices not reclaimed (~D KB)~n',[ICls,ISZK])
),
!.
db_usage:-
write(mem_dump_error),nl.
/** @pred db_static
List memory usage for every static predicate.
*/
db_static :-
db_static(-1).
/** @pred db_static(+ _Threshold_)
List memory usage for every static predicate. Predicate must use more
than _Threshold_ bytes.
*/
db_static(Min) :-
setof(p(Sz,M:P,Cls,CSz,ISz),
PN^(current_module(M),
current_predicate(PN,M:P),
\+ predicate_property(M:P,dynamic),
predicate_statistics(M:P,Cls,CSz,ISz),
Sz is (CSz+ISz),
Sz > Min),All),
format(user_error,' Static user code~n===========================~n',[]),
display_preds(All).
/** @pred db_dynamic
List memory usage for every dynamic predicate.
*/
db_dynamic :-
db_dynamic(-1).
/** @pred db_dynamic(+ _Threshold_)
List memory usage for every dynamic predicate. Predicate must use more
than _Threshold_ bytes.
*/
db_dynamic(Min) :-
setof(p(Sz,M:P,Cls,CSz,ISz,ECls,ECSz,EISz),
PN^(current_module(M),
current_predicate(PN,M:P),
predicate_property(M:P,dynamic),
predicate_statistics(M:P,Cls,CSz,ISz),
predicate_erased_statistics(M:P,ECls,ECSz,EISz),
Sz is (CSz+ISz+ECSz+EISz),
Sz > Min),
All),
format(user_error,' Dynamic user code~n===========================~n',[]),
display_dpreds(All).
display_preds([]).
display_preds([p(Sz,M:P,Cls,CSz,ISz)|_]) :-
functor(P,A,N),
KSz is Sz//1024,
KCSz is CSz//1024,
KISz is ISz//1024,
(M = user -> Name = A/N ; Name = M:A/N),
format(user_error,'~w~t~36+:~t~D~7+ clauses using~|~t~D~8+ KB (~D + ~D)~n',[Name,Cls,KSz,KCSz,KISz]),
fail.
display_preds([_|All]) :-
display_preds(All).
display_dpreds([]).
display_dpreds([p(Sz,M:P,Cls,CSz,ISz,ECls,ECSz,EISz)|_]) :-
functor(P,A,N),
KSz is Sz//1024,
KCSz is CSz//1024,
KISz is ISz//1024,
(M = user -> Name = A/N ; Name = M:A/N),
format(user_error,'~w~t~36+:~t~D~7+ clauses using~|~t~D~8+ KB (~D + ~D)~n',[Name,Cls,KSz,KCSz,KISz]),
(ECls =:= 0
->
true
;
ECSzK is ECSz//1024,
format(user_error,' ~D erased clauses: ~D KB~n',[ECls,ECSzK])
),
(EISz =:= 0
->
true
;
EISzK is EISz//1024,
format(user_error,' ~D KB erased indices~n',[EISzK])
),
fail.
display_dpreds([_|All]) :-
display_dpreds(All).
sumall(LEDAll, TEDCls, TEDCSz, TEDISz) :-
sumall(LEDAll, 0, TEDCls, 0, TEDCSz, 0, TEDISz).
sumall([], TEDCls, TEDCls, TEDCSz, TEDCSz, TEDISz, TEDISz).
sumall([p(Cls,CSz,ISz)|LEDAll], TEDCls0, TEDCls, TEDCSz0, TEDCSz, TEDISz0, TEDISz) :-
TEDClsI is Cls+TEDCls0,
TEDCSzI is CSz+TEDCSz0,
TEDISzI is ISz+TEDISz0,
sumall(LEDAll, TEDClsI, TEDCls, TEDCSzI, TEDCSz, TEDISzI, TEDISz).
/**
@}
*/

708
packages/python/swig/yap4py/prolog/dgraphs.yap
View File

@ -1,708 +0,0 @@
/**
* @file dgraphs.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 01:23:20 2015
*
* @brief Directed Graph Processing Utilities.
*
*
*/
:- module( dgraphs,
[
dgraph_vertices/2,
dgraph_edge/3,
dgraph_edges/2,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_del_vertex/3,
dgraph_del_vertices/3,
dgraph_add_edge/4,
dgraph_add_edges/3,
dgraph_del_edge/4,
dgraph_del_edges/3,
dgraph_to_ugraph/2,
ugraph_to_dgraph/2,
dgraph_neighbors/3,
dgraph_neighbours/3,
dgraph_complement/2,
dgraph_transpose/2,
dgraph_compose/3,
dgraph_transitive_closure/2,
dgraph_symmetric_closure/2,
dgraph_top_sort/2,
dgraph_top_sort/3,
dgraph_min_path/5,
dgraph_max_path/5,
dgraph_min_paths/3,
dgraph_isomorphic/4,
dgraph_path/3,
dgraph_path/4,
dgraph_leaves/2,
dgraph_reachable/3
]).
/** @defgroup dgraphs Directed Graphs
@ingroup library
@{
The following graph manipulation routines use the red-black tree library
to try to avoid linear-time scans of the graph for all graph
operations. Graphs are represented as a red-black tree, where the key is
the vertex, and the associated value is a list of vertices reachable
from that vertex through an edge (ie, a list of edges).
*/
/** @pred dgraph_new(+ _Graph_)
Create a new directed graph. This operation must be performed before
trying to use the graph.
*/
:- reexport(library(rbtrees),
[rb_new/1 as dgraph_new]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_empty/1,
rb_lookup/3,
rb_apply/4,
rb_insert/4,
rb_visit/2,
rb_keys/2,
rb_delete/3,
rb_map/3,
rb_clone/3,
ord_list_to_rbtree/2]).
:- use_module(library(ordsets),
[ord_insert/3,
ord_union/3,
ord_subtract/3,
ord_del_element/3,
ord_memberchk/2]).
:- use_module(library(wdgraphs),
[dgraph_to_wdgraph/2,
wdgraph_min_path/5,
wdgraph_max_path/5,
wdgraph_min_paths/3]).
/** @pred dgraph_add_edge(+ _Graph_, + _N1_, + _N2_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by adding the edge
_N1_- _N2_ to the graph _Graph_.
*/
dgraph_add_edge(Vs0,V1,V2,Vs2) :-
dgraph_new_edge(V1,V2,Vs0,Vs1),
dgraph_add_vertex(Vs1,V2,Vs2).
/** @pred dgraph_add_edges(+ _Graph_, + _Edges_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by adding the list of
edges _Edges_ to the graph _Graph_.
*/
dgraph_add_edges(V0, Edges, VF) :-
rb_empty(V0), !,
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
edges2graphl(SortedVertices, SortedEdges, GraphL),
ord_list_to_rbtree(GraphL, VF).
dgraph_add_edges(G0, Edges, GF) :-
sort(Edges,SortedEdges),
all_vertices_in_edges(SortedEdges,Vertices),
sort(Vertices,SortedVertices),
dgraph_add_edges(SortedVertices,SortedEdges, G0, GF).
all_vertices_in_edges([],[]).
all_vertices_in_edges([V1-V2|Edges],[V1,V2|Vertices]) :-
all_vertices_in_edges(Edges,Vertices).
edges2graphl([], [], []).
edges2graphl([V|Vertices], [VV-V1|SortedEdges], [V-[V1|Children]|GraphL]) :-
V == VV, !,
get_extra_children(SortedEdges,VV,Children,RemEdges),
edges2graphl(Vertices, RemEdges, GraphL).
edges2graphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
edges2graphl(Vertices, SortedEdges, GraphL).
dgraph_add_edges([],[]) --> [].
dgraph_add_edges([V|Vs],[V0-V1|Es]) --> { V == V0 }, !,
{ get_extra_children(Es,V,Children,REs) },
dgraph_update_vertex(V,[V1|Children]),
dgraph_add_edges(Vs,REs).
dgraph_add_edges([V|Vs],Es) --> !,
dgraph_update_vertex(V,[]),
dgraph_add_edges(Vs,Es).
get_extra_children([V-C|Es],VV,[C|Children],REs) :- V == VV, !,
get_extra_children(Es,VV,Children,REs).
get_extra_children(Es,_,[],Es).
dgraph_update_vertex(V,Children, Vs0, Vs) :-
rb_apply(Vs0, V, add_edges(Children), Vs), !.
dgraph_update_vertex(V,Children, Vs0, Vs) :-
rb_insert(Vs0,V,Children,Vs).
add_edges(E0,E1,E) :-
ord_union(E0,E1,E).
dgraph_new_edge(V1,V2,Vs0,Vs) :-
rb_apply(Vs0, V1, insert_edge(V2), Vs), !.
dgraph_new_edge(V1,V2,Vs0,Vs) :-
rb_insert(Vs0,V1,[V2],Vs).
insert_edge(V2, Children0, Children) :-
ord_insert(Children0,V2,Children).
/** @pred dgraph_add_vertices(+ _Graph_, + _Vertices_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by adding the list of
vertices _Vertices_ to the graph _Graph_.
*/
dgraph_add_vertices(G, [], G).
dgraph_add_vertices(G0, [V|Vs], GF) :-
dgraph_add_vertex(G0, V, G1),
dgraph_add_vertices(G1, Vs, GF).
/** @pred dgraph_add_vertex(+ _Graph_, + _Vertex_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by adding
vertex _Vertex_ to the graph _Graph_.
*/
dgraph_add_vertex(Vs0, V, Vs0) :-
rb_lookup(V,_,Vs0), !.
dgraph_add_vertex(Vs0, V, Vs) :-
rb_insert(Vs0, V, [], Vs).
/** @pred dgraph_edges(+ _Graph_, - _Edges_)
Unify _Edges_ with all edges appearing in graph
_Graph_.
*/
dgraph_edges(Vs,Edges) :-
rb_visit(Vs,L0),
cvt2edges(L0,Edges).
/** @pred dgraph_vertices(+ _Graph_, - _Vertices_)
Unify _Vertices_ with all vertices appearing in graph
_Graph_.
*/
dgraph_vertices(Vs,Vertices) :-
rb_keys(Vs,Vertices).
cvt2edges([],[]).
cvt2edges([V-Children|L0],Edges) :-
children2edges(Children,V,Edges,Edges0),
cvt2edges(L0,Edges0).
children2edges([],_,Edges,Edges).
children2edges([Child|L0],V,[V-Child|EdgesF],Edges0) :-
children2edges(L0,V,EdgesF,Edges0).
/** @pred dgraph_neighbours(+ _Vertex_, + _Graph_, - _Vertices_)
Unify _Vertices_ with the list of neighbours of vertex _Vertex_
in _Graph_.
*/
dgraph_neighbours(V,Vertices,Children) :-
rb_lookup(V,Children,Vertices).
/** @pred dgraph_neighbors(+ _Vertex_, + _Graph_, - _Vertices_)
Unify _Vertices_ with the list of neighbors of vertex _Vertex_
in _Graph_. If the vertice is not in the graph fail.
*/
dgraph_neighbors(V,Vertices,Children) :-
rb_lookup(V,Children,Vertices).
add_vertices(Graph, [], Graph).
add_vertices(Graph, [V|Vertices], NewGraph) :-
rb_insert(Graph, V, [], IntGraph),
add_vertices(IntGraph, Vertices, NewGraph).
/** @pred dgraph_complement(+ _Graph_, - _NewGraph_)
Unify _NewGraph_ with the graph complementary to _Graph_.
*/
dgraph_complement(Vs0,VsF) :-
dgraph_vertices(Vs0,Vertices),
rb_map(Vs0,complement(Vertices),VsF).
complement(Vs,Children,NewChildren) :-
ord_subtract(Vs,Children,NewChildren).
/** @pred dgraph_del_edge(+ _Graph_, + _N1_, + _N2_, - _NewGraph_)
Succeeds if _NewGraph_ unifies with a new graph obtained by
removing the edge _N1_- _N2_ from the graph _Graph_. Notice
that no vertices are deleted.
*/
dgraph_del_edge(Vs0,V1,V2,Vs1) :-
rb_apply(Vs0, V1, delete_edge(V2), Vs1).
/** @pred dgraph_del_edges(+ _Graph_, + _Edges_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by removing the list of
edges _Edges_ from the graph _Graph_. Notice that no vertices
are deleted.
*/
dgraph_del_edges(G0, Edges, Gf) :-
sort(Edges,SortedEdges),
continue_del_edges(SortedEdges, G0, Gf).
continue_del_edges([]) --> [].
continue_del_edges([V-V1|Es]) --> !,
{ get_extra_children(Es,V,Children,REs) },
contract_vertex(V,[V1|Children]),
continue_del_edges(REs).
contract_vertex(V,Children, Vs0, Vs) :-
rb_apply(Vs0, V, del_edges(Children), Vs).
del_edges(ToRemove,E0,E) :-
ord_subtract(E0,ToRemove,E).
/** @pred dgraph_del_vertex(+ _Graph_, + _Vertex_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by deleting vertex
_Vertex_ and all the edges that start from or go to _Vertex_ to
the graph _Graph_.
*/
dgraph_del_vertex(Vs0, V, Vsf) :-
rb_delete(Vs0, V, Vs1),
rb_map(Vs1, delete_edge(V), Vsf).
delete_edge(Edges0, V, Edges) :-
ord_del_element(Edges0, V, Edges).
/** @pred dgraph_del_vertices(+ _Graph_, + _Vertices_, - _NewGraph_)
Unify _NewGraph_ with a new graph obtained by deleting the list of
vertices _Vertices_ and all the edges that start from or go to a
vertex in _Vertices_ to the graph _Graph_.
*/
dgraph_del_vertices(G0, Vs, GF) :-
sort(Vs,SortedVs),
delete_all(SortedVs, G0, G1),
delete_remaining_edges(SortedVs, G1, GF).
% it would be nice to be able to delete a set of elements from an RB tree
% but I don't how to do it yet.
delete_all([]) --> [].
delete_all([V|Vs],Vs0,Vsf) :-
rb_delete(Vs0, V, Vsi),
delete_all(Vs,Vsi,Vsf).
delete_remaining_edges(SortedVs,Vs0,Vsf) :-
rb_map(Vs0, del_edges(SortedVs), Vsf).
/** @pred dgraph_transpose(+ _Graph_, - _Transpose_)
Unify _NewGraph_ with a new graph obtained from _Graph_ by
replacing all edges of the form _V1-V2_ by edges of the form
_V2-V1_.
*/
dgraph_transpose(Graph, TGraph) :-
rb_visit(Graph, Edges),
transpose(Edges, Nodes, TEdges, []),
dgraph_new(G0),
% make sure we have all vertices, even if they are unconnected.
dgraph_add_vertices(G0, Nodes, G1),
dgraph_add_edges(G1, TEdges, TGraph).
transpose([], []) --> [].
transpose([V-Edges|MoreVs], [V|Vs]) -->
transpose_edges(Edges, V),
transpose(MoreVs, Vs).
transpose_edges([], _V) --> [].
transpose_edges(E.Edges, V) -->
[E-V],
transpose_edges(Edges, V).
dgraph_compose(T1,T2,CT) :-
rb_visit(T1,Nodes),
compose(Nodes,T2,NewNodes),
dgraph_new(CT0),
dgraph_add_edges(CT0,NewNodes,CT).
compose([],_,[]).
compose([V-Children|Nodes],T2,NewNodes) :-
compose2(Children,V,T2,NewNodes,NewNodes0),
compose(Nodes,T2,NewNodes0).
compose2([],_,_,NewNodes,NewNodes).
compose2([C|Children],V,T2,NewNodes,NewNodes0) :-
rb_lookup(C, GrandChildren, T2),
compose3(GrandChildren, V, NewNodes,NewNodesI),
compose2(Children,V,T2,NewNodesI,NewNodes0).
compose3([], _, NewNodes, NewNodes).
compose3([GC|GrandChildren], V, [V-GC|NewNodes], NewNodes0) :-
compose3(GrandChildren, V, NewNodes, NewNodes0).
/** @pred dgraph_transitive_closure(+ _Graph_, - _Closure_)
Unify _Closure_ with the transitive closure of graph _Graph_.
*/
dgraph_transitive_closure(G,Closure) :-
dgraph_edges(G,Edges),
continue_closure(Edges,G,Closure).
continue_closure([], Closure, Closure) :- !.
continue_closure(Edges, G, Closure) :-
transit_graph(Edges,G,NewEdges),
dgraph_add_edges(G, NewEdges, GN),
continue_closure(NewEdges, GN, Closure).
transit_graph([],_,[]).
transit_graph([V-V1|Edges],G,NewEdges) :-
rb_lookup(V1, GrandChildren, G),
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges),
transit_graph(Edges, G, MoreEdges).
transit_graph2([], _, _, NewEdges, NewEdges).
transit_graph2([GC|GrandChildren], V, G, NewEdges, MoreEdges) :-
is_edge(V,GC,G), !,
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
transit_graph2([GC|GrandChildren], V, G, [V-GC|NewEdges], MoreEdges) :-
transit_graph2(GrandChildren, V, G, NewEdges, MoreEdges).
is_edge(V1,V2,G) :-
rb_lookup(V1,Children,G),
ord_memberchk(V2, Children).
/** @pred dgraph_symmetric_closure(+ _Graph_, - _Closure_)
Unify _Closure_ with the symmetric closure of graph _Graph_,
that is, if _Closure_ contains an edge _U-V_ it must also
contain the edge _V-U_.
*/
dgraph_symmetric_closure(G,S) :-
dgraph_edges(G, Edges),
invert_edges(Edges, InvertedEdges),
dgraph_add_edges(G, InvertedEdges, S).
invert_edges([], []).
invert_edges([V1-V2|Edges], [V2-V1|InvertedEdges]) :-
invert_edges(Edges, InvertedEdges).
/** @pred dgraph_top_sort(+ _Graph_, - _Vertices_)
Unify _Vertices_ with the topological sort of graph _Graph_.
*/
dgraph_top_sort(G, Q) :-
dgraph_top_sort(G, Q, []).
/** @pred dgraph_top_sort(+ _Graph_, - _Vertices_, ? _Vertices0_)
Unify the difference list _Vertices_- _Vertices0_ with the
topological sort of graph _Graph_.
*/
dgraph_top_sort(G, Q, RQ0) :-
% O(E)
rb_visit(G, Vs),
% O(E)
invert_and_link(Vs, Links, UnsortedInvertedEdges, AllVs, Q),
% O(V)
rb_clone(G, LinkedG, Links),
% O(Elog(E))
sort(UnsortedInvertedEdges, InvertedEdges),
% O(E)
dgraph_vertices(G, AllVs),
start_queue(AllVs, InvertedEdges, Q, RQ),
continue_queue(Q, LinkedG, RQ, RQ0).
invert_and_link([], [], [], [], []).
invert_and_link([V-Vs|Edges], [V-NVs|ExtraEdges], UnsortedInvertedEdges, [V|AllVs],[_|Q]) :-
inv_links(Vs, NVs, V, UnsortedInvertedEdges, UnsortedInvertedEdges0),
invert_and_link(Edges, ExtraEdges, UnsortedInvertedEdges0, AllVs, Q).
inv_links([],[],_,UnsortedInvertedEdges,UnsortedInvertedEdges).
inv_links([V2|Vs],[l(V2,A,B,S,E)|VLnks],V1,[V2-e(A,B,S,E)|UnsortedInvertedEdges],UnsortedInvertedEdges0) :-
inv_links(Vs,VLnks,V1,UnsortedInvertedEdges,UnsortedInvertedEdges0).
dup([], []).
dup([_|AllVs], [_|Q]) :-
dup(AllVs, Q).
start_queue([], [], RQ, RQ).
start_queue([V|AllVs], [VV-e(S,B,S,E)|InvertedEdges], Q, RQ) :- V == VV, !,
link_edges(InvertedEdges, VV, B, S, E, RemainingEdges),
start_queue(AllVs, RemainingEdges, Q, RQ).
start_queue([V|AllVs], InvertedEdges, [V|Q], RQ) :-
start_queue(AllVs, InvertedEdges, Q, RQ).
link_edges([V-e(A,B,S,E)|InvertedEdges], VV, A, S, E, RemEdges) :- V == VV, !,
link_edges(InvertedEdges, VV, B, S, E, RemEdges).
link_edges(RemEdges, _, A, _, A, RemEdges).
continue_queue([], _, RQ0, RQ0).
continue_queue([V|Q], LinkedG, RQ, RQ0) :-
rb_lookup(V, Links, LinkedG),
close_links(Links, RQ, RQI),
% not clear whether I should deleted V from LinkedG
continue_queue(Q, LinkedG, RQI, RQ0).
close_links([], RQ, RQ).
close_links([l(V,A,A,S,E)|Links], RQ, RQ0) :-
( S == E -> RQ = [V| RQ1] ; RQ = RQ1),
close_links(Links, RQ1, RQ0).
/** @pred ugraph_to_dgraph( + _UGraph_, - _Graph_)
Unify _Graph_ with the directed graph obtain from _UGraph_,
represented in the form used in the _ugraphs_ unweighted graphs
library.
*/
ugraph_to_dgraph(UG, DG) :-
ord_list_to_rbtree(UG, DG).
/** @pred dgraph_to_ugraph(+ _Graph_, - _UGraph_)
Unify _UGraph_ with the representation used by the _ugraphs_
unweighted graphs library, that is, a list of the form
_V-Neighbors_, where _V_ is a node and _Neighbors_ the nodes
children.
*/
dgraph_to_ugraph(DG, UG) :-
rb_visit(DG, UG).
/** @pred dgraph_edge(+ _N1_, + _N2_, + _Graph_)
Edge _N1_- _N2_ is an edge in directed graph _Graph_.
*/
dgraph_edge(N1, N2, G) :-
rb_lookup(N1, Ns, G),
ord_memberchk(N2, Ns).
/** @pred dgraph_min_path(+ _V1_, + _V1_, + _Graph_, - _Path_, ? _Costt_)
Unify the list _Path_ with the minimal cost path between nodes
_N1_ and _N2_ in graph _Graph_. Path _Path_ has cost
_Cost_.
*/
dgraph_min_path(V1, V2, Graph, Path, Cost) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_min_path(V1, V2, WGraph, Path, Cost).
/** @pred dgraph_max_path(+ _V1_, + _V1_, + _Graph_, - _Path_, ? _Costt_)
Unify the list _Path_ with the maximal cost path between nodes
_N1_ and _N2_ in graph _Graph_. Path _Path_ has cost
_Cost_.
*/
dgraph_max_path(V1, V2, Graph, Path, Cost) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_max_path(V1, V2, WGraph, Path, Cost).
/** @pred dgraph_min_paths(+ _V1_, + _Graph_, - _Paths_)
Unify the list _Paths_ with the minimal cost paths from node
_N1_ to the nodes in graph _Graph_.
*/
dgraph_min_paths(V1, Graph, Paths) :-
dgraph_to_wdgraph(Graph, WGraph),
wdgraph_min_paths(V1, WGraph, Paths).
/** @pred dgraph_path(+ _Vertex_, + _Vertex1_, + _Graph_, ? _Path_)
The path _Path_ is a path starting at vertex _Vertex_ in graph
_Graph_ and ending at path _Vertex2_.
*/
dgraph_path(V1, V2, Graph, Path) :-
rb_new(E0),
rb_lookup(V1, Children, Graph),
dgraph_path_children(Children, V2, E0, Graph, Path).
dgraph_path_children([V1|_], V2, _E1, _Graph, []) :- V1 == V2.
dgraph_path_children([V1|_], V2, E1, Graph, [V1|Path]) :-
V2 \== V1,
\+ rb_lookup(V1, _, E0),
rb_insert(E0, V2, [], E1),
rb_lookup(V1, Children, Graph),
dgraph_path_children(Children, V2, E1, Graph, Path).
dgraph_path_children([_|Children], V2, E1, Graph, Path) :-
dgraph_path_children(Children, V2, E1, Graph, Path).
do_path([], _, _, []).
do_path([C|Children], G, SoFar, Path) :-
do_children([C|Children], G, SoFar, Path).
do_children([V|_], G, SoFar, [V|Path]) :-
rb_lookup(V, Children, G),
ord_subtract(Children, SoFar, Ch),
ord_insert(SoFar, V, NextSoFar),
do_path(Ch, G, NextSoFar, Path).
do_children([_|Children], G, SoFar, Path) :-
do_children(Children, G, SoFar, Path).
/** @pred dgraph_path(+ _Vertex_, + _Graph_, ? _Path_)
The path _Path_ is a path starting at vertex _Vertex_ in graph
_Graph_.
*/
dgraph_path(V, G, [V|P]) :-
rb_lookup(V, Children, G),
ord_del_element(Children, V, Ch),
do_path(Ch, G, [V], P).
/** @pred dgraph_isomorphic(+ _Vs_, + _NewVs_, + _G0_, - _GF_)
Unify the list _GF_ with the graph isomorphic to _G0_ where
vertices in _Vs_ map to vertices in _NewVs_.
*/
dgraph_isomorphic(Vs, Vs2, G1, G2) :-
rb_new(Map0),
mapping(Vs,Vs2,Map0,Map),
dgraph_edges(G1,Edges),
translate_edges(Edges,Map,TEdges),
dgraph_new(G20),
dgraph_add_vertices(Vs2,G20,G21),
dgraph_add_edges(G21,TEdges,G2).
mapping([],[],Map,Map).
mapping([V1|Vs],[V2|Vs2],Map0,Map) :-
rb_insert(Map0,V1,V2,MapI),
mapping(Vs,Vs2,MapI,Map).
translate_edges([],_,[]).
translate_edges([V1-V2|Edges],Map,[NV1-NV2|TEdges]) :-
rb_lookup(V1,NV1,Map),
rb_lookup(V2,NV2,Map),
translate_edges(Edges,Map,TEdges).
/** @pred dgraph_reachable(+ _Vertex_, + _Graph_, ? _Edges_)
The path _Path_ is a path starting at vertex _Vertex_ in graph
_Graph_.
*/
dgraph_reachable(V, G, Edges) :-
rb_lookup(V, Children, G),
ord_list_to_rbtree([V-[]],Done0),
reachable(Children, Done0, _, G, Edges, []).
reachable([], Done, Done, _, Edges, Edges).
reachable([V|Vertices], Done0, DoneF, G, EdgesF, Edges0) :-
rb_lookup(V,_, Done0), !,
reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0).
reachable([V|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :-
rb_lookup(V, Kids, G),
rb_insert(Done0, V, [], Done1),
reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI),
reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0).
/** @pred dgraph_leaves(+ _Graph_, ? _Vertices_)
The vertices _Vertices_ have no outgoing edge in graph
_Graph_.
*/
dgraph_leaves(Graph, Vertices) :-
rb_visit(Graph, Pairs),
vertices_without_children(Pairs, Vertices).
vertices_without_children([], []).
vertices_without_children((V-[]).Pairs, V.Vertices) :-
vertices_without_children(Pairs, Vertices).
vertices_without_children(_V-[_|_].Pairs, Vertices) :-
vertices_without_children(Pairs, Vertices).
%% @}/** @} */

242
packages/python/swig/yap4py/prolog/exo_interval.yap
View File

@ -1,242 +0,0 @@
/**
* @file exo_interval.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date 2013
*
* @brief This file implements a very simple interval solver
* designed to interact with the exo
* data-base.
* It assumes simple queries and a contiguous interval,
* and does not really expect to do non-trivial
* constraint propagation and solving.
*
*
*/
:- module(exo_interval,
[max/2,
min/2,
any/2,
max/1,
min/1,
maximum/1,
minimum/1,
any/1,
(#<)/2,
(#>)/2,
(#=<)/2,
(#>=)/2,
(#=)/2,
op(700, xfx, (#>)),
op(700, xfx, (#<)),
op(700, xfx, (#>=)),
op(700, xfx, (#=<)),
op(700, xfx, (#=))]).
/**
@defgroup exo_interval Exo Intervals
@ingroup library
@{
This package assumes you use exo-compilation, that is, that you loaded
the pedicate using the `exo` option to load_files/2, In this
case, YAP includes a package for improved search on intervals of
integers.
The package is activated by `udi` declarations that state what is
the argument of interest:
~~~~~{.prolog}
:- udi(diagnoses(exo_interval,?,?)).
:- load_files(db, [consult(exo)]).
~~~~~
It is designed to optimise the following type of queries:
~~~~~{.prolog}
?- max(X, diagnoses(X, 9, Y), X).
?- min(X, diagnoses(X, 9, 36211117), X).
?- X #< Y, min(X, diagnoses(X, 9, 36211117), X ), diagnoses(Y, 9, _).
~~~~~
The first argument gives the time, the second the patient, and the
third the condition code. The first query should find the last time
the patient 9 had any code reported, the second looks for the first
report of code 36211117, and the last searches for reports after this
one. All queries run in constant or log(n) time.
*/
/** @pred max( _X_, _Vs_)
First Argument is the greatest element of a list.
+ lex_order( _Vs_)
All elements must be ordered.
The following predicates control search:
*/
/** @pred max(+ _Expression_)
Maximizes _Expression_ within the current constraint store. This is
the same as computing the supremum and equating the expression to that
supremum.
*/
/** @pred min( _X_, _Vs_)
First Argument is the least element of a list.
*/
/** @pred min(+ _Expression_)
Minimizes _Expression_ within the current constraint store. This is
the same as computing the infimum and equation the expression to that
infimum.
*/
:- meta_predicate max(?,0), min(?,0), any(?,0).
max(X, G) :-
insert_atts(X, i(_,_,max)),
call(G).
min(X, G) :-
insert_atts(X, i(_,_,min)),
call(G).
max(X) :-
insert_atts(X, i(_,_,max)).
maximum(X) :-
insert_atts(X, i(_,_,maximum)).
any(X) :-
insert_atts(X, i(_,_,any)).
min(X) :-
insert_atts(X, i(_,_,min)).
minimum(X) :-
insert_atts(X, i(_,_,minimum)).
least(X) :-
insert_atts(X, i(_,_,least)).
X #> Y :-
( var(X) -> insert_atts(X, i(Y,_,_))
;
( var(Y) -> insert_atts(Y, i(_,X,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(_,X,_))
;
X > Y
).
X #>= Y :-
( var(X) -> insert_atts(X, i(Y-1,_,_))
;
X >= Y
).
X #< Y :-
( var(X) -> insert_atts(X, i(_,Y,_))
;
X < Y
).
X #=< Y :-
( var(X) -> insert_atts(X, i(Y+1,_,_))
;
X =< Y
).
X #= Y :-
( var(X) -> insert_atts(X, i(Y-1,Y+1,_)) ;
X =:= Y
).
attribute_goals(X) -->
{ get_attr(X, exo_interval, Op) },
( { Op = max } -> [max(X)] ;
{ Op = min } -> [min(X)] ;
{ Op = '>'(Y) } -> [X #> Y] ;
{ Op = '<'(Y) } -> [X #< Y] ;
{ Op = range(A,B,C) } ->
range_min(A,X),
range_max(B,X),
range_op(C, X)
).
range_min(Y, _X) -->
{ var(Y) }, !,
[].
range_min(Y, X) -->
[X #> Y].
range_max(Y, _X) -->
{ var(Y) }, !,
[].
range_max(Y, X) -->
[X #< Y].
range_op(Y, _X) -->
{ var(Y) }, !,
[].
range_op(Y, X) -->
{ Op =.. [Y, X] },
[Op].
insert_atts(V, Att) :-
( nonvar(V) ->
throw( error(uninstantion_error(V), exo_interval) )
; attvar(V) ->
get_attr(V, exo_interval, Att0),
expand_atts(Att, Att0, NAtt)
;
NAtt = Att
),
put_attr(V, exo_interval, NAtt).
expand_atts(i(A1, B1, C1), i(A2, B2, C2), i(A3,B3,C3)) :-
expand_min(A1, A2, A3),
expand_max(B1, B2, B3),
expand_op(C1, C2, C3).
expand_min(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
ground(A1), ground(A2) -> A3 is max(A1,A2) ;
A3 = max(A1,A2)
).
expand_max(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
ground(A1), ground(A2) -> A3 is min(A1,A2) ;
A3 = min(A1,A2)
).
expand_op(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
A1 == A2 -> A3 = A1;
A1 == unique -> A3 = unique;
A2 == unique -> A3 = unique;
A2 == min, A1 = max -> A3 = unique;
A1 == min, A2 = max -> A3 = unique;
A1 == min -> A3 = min; A2 == min -> A3 = min;
A1 == max -> A3 = max; A2 == max -> A3 = max;
A3 = any
).
%% @}

165
packages/python/swig/yap4py/prolog/expand_macros.yap
View File

@ -1,165 +0,0 @@
/**
* @file expand_macros.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 15:16:12 2015
*
* @brief utilities that perform macro expansion for maplist/2 and
* friends.
*
*
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% preprocessing for meta-calls
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module( expand_macros,
[compile_aux/2,
pred_name/4,
transformation_id/1,
allowed_expansion/1,
allowed_module/2] ).
:- use_module(library(lists), [append/3]).
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
:- use_module(library(error), [must_be/2]).
:- use_module(library(occurs), [sub_term/2]).
:- multifile allowed_module/2.
:- dynamic number_of_expansions/1.
number_of_expansions(0).
%%%%%%%%%%%%%%%%%%%%
% utilities
%%%%%%%%%%%%%%%%%%%%
compile_aux([Clause|Clauses], Module) :-
% compile the predicate declaration if needed
(
Clause = (Head :- _)
;
Clause = Head
),
!,
functor(Head, F, N),
( current_predicate(Module:F/N)
->
true
;
% format'*** Creating auxiliary predicate ~q~n', [F/N]),
% checklist(portray_clause, [Clause|Clauses]),
compile_term([Clause|Clauses], Module)
).
compile_term([], _).
compile_term([Clause|Clauses], Module) :-
assert_static(Module:Clause),
compile_term(Clauses, Module).
append_args(Term, Args, NewTerm) :-
Term =.. [Meta|OldArgs],
append(OldArgs, Args, GoalArgs),
NewTerm =.. [Meta|GoalArgs].
aux_preds(Module:Meta, MetaVars, Pred, PredVars, Proto, _, OModule) :- !,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, OModule).
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, Module) :-
Meta =.. [F|Args],
aux_args(Args, MetaVars, PredArgs, PredVars, ProtoArgs),
Pred =.. [F|PredArgs],
Proto =.. [F|ProtoArgs].
aux_args([], [], [], [], []).
aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
ground(Arg), !,
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
pred_name(Macro, Arity, _ , Name) :-
transformation_id(Id),
atomic_concat(['$$$__Auxiliary_predicate__ for',Macro,'/',Arity,' ',Id], Name).
transformation_id(Id) :-
retract(number_of_expansions(Id)),
Id1 is Id+1,
assert(number_of_expansions(Id1)).
harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L)
allowed_expansion(QExpand) :-
strip_module(QExpand, Mod, Pred),
goal_expansion_allowed(Pred, Mod).
goal_expansion_allowed(Pred, Mod) :-
allowed_module(Pred,Mod),
once( prolog_load_context(_, _) ), % make sure we are compiling.
allowed_module(checklist(_,_),expand_macros).
allowed_module(checklist(_,_),apply_macros).
allowed_module(checklist(_,_),maplist).
allowed_module(maplist(_,_),expand_macros).
allowed_module(maplist(_,_),apply_macros).
allowed_module(maplist(_,_),maplist).
allowed_module(maplist(_,_,_),expand_macros).
allowed_module(maplist(_,_,_),apply_macros).
allowed_module(maplist(_,_,_),maplist).
allowed_module(maplist(_,_,_,_),expand_macros).
allowed_module(maplist(_,_,_,_),apply_macros).
allowed_module(maplist(_,_,_,_),maplist).
allowed_module(maplist(_,_,_,_,_),expand_macros).
allowed_module(maplist(_,_,_,_,_),apply_macros).
allowed_module(maplist(_,_,_,_,_),maplist).
allowed_module(maplist(_,_,_,_,_,_),expand_macros).
allowed_module(maplist(_,_,_,_,_,_),apply_macros).
allowed_module(maplist(_,_,_,_,_,_),maplist).
allowed_module(selectlist(_,_,_),expand_macros).
allowed_module(selectlist(_,_,_),apply_macros).
allowed_module(selectlist(_,_,_),maplist).
allowed_module(include(_,_,_),expand_macros).
allowed_module(include(_,_,_),apply_macros).
allowed_module(include(_,_,_),maplist).
allowed_module(exclude(_,_,_),expand_macros).
allowed_module(exclude(_,_,_),apply_macros).
allowed_module(exclude(_,_,_),maplist).
allowed_module(partition(_,_,_,_),expand_macros).
allowed_module(partition(_,_,_,_),apply_macros).
allowed_module(partition(_,_,_,_),maplist).
allowed_module(partition(_,_,_,_,_),expand_macros).
allowed_module(partition(_,_,_,_,_),apply_macros).
allowed_module(partition(_,_,_,_,_),maplist).
allowed_module(convlist(_,_,_),expand_macros).
allowed_module(convlist(_,_,_),apply_macros).
allowed_module(convlist(_,_,_),maplist).
allowed_module(sumlist(_,_,_,_),expand_macros).
allowed_module(sumlist(_,_,_,_),apply_macros).
allowed_module(sumlist(_,_,_,_),maplist).
allowed_module(mapargs(_,_,_),expand_macros).
allowed_module(mapargs(_,_,_),apply_macros).
allowed_module(mapargs(_,_,_),maplist).
allowed_module(sumargs(_,_,_,_),expand_macros).
allowed_module(sumargs(_,_,_,_),apply_macros).
allowed_module(sumargs(_,_,_,_),maplist).
allowed_module(mapnodes(_,_,_),expand_macros).
allowed_module(mapnodes(_,_,_),apply_macros).
allowed_module(mapnodes(_,_,_),maplist).
allowed_module(checknodes(_,_),expand_macros).
allowed_module(checknodes(_,_),apply_macros).
allowed_module(checknodes(_,_),maplist).
allowed_module(sumnodes(_,_,_,_),expand_macros).
allowed_module(sumnodes(_,_,_,_),apply_macros).
allowed_module(sumnodes(_,_,_,_),maplist).

589
packages/python/swig/yap4py/prolog/flags.yap
View File

@ -1,589 +0,0 @@
%%% -*- Mode: Prolog; -*-
/**
* @file library/flags.yap
* @author Theofrastos Mantadelis, Bernd Gutmann, Paulo Moura
* @date Tue Nov 17 15:18:02 2015
*
* @brief Flag Manipulation in Prolog
*
*
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Flags was developed at Katholieke Universiteit Leuven
%
% Copyright 2010
% Katholieke Universiteit Leuven
%
% Contributions to this file:
% Author: Theofrastos Mantadelis
% Sugestions: Bernd Gutmann, Paulo Moura
% $Date: 2011-02-15 13:33:01 +0100 (Tue, 15 Feb 2011) $
% $Revision: 15 $
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Artistic License 2.0
%
% Copyright (c) 2000-2006, The Perl Foundation.
%
% Everyone is permitted to copy and distribute verbatim copies of this
% license document, but changing it is not allowed. Preamble
%
% This license establishes the terms under which a given free software
% Package may be copied, modified, distributed, and/or
% redistributed. The intent is that the Copyright Holder maintains some
% artistic control over the development of that Package while still
% keeping the Package available as open source and free software.
%
% You are always permitted to make arrangements wholly outside of this
% license directly with the Copyright Holder of a given Package. If the
% terms of this license do not permit the full use that you propose to
% make of the Package, you should contact the Copyright Holder and seek
% a different licensing arrangement. Definitions
%
% "Copyright Holder" means the individual(s) or organization(s) named in
% the copyright notice for the entire Package.
%
% "Contributor" means any party that has contributed code or other
% material to the Package, in accordance with the Copyright Holder's
% procedures.
%
% "You" and "your" means any person who would like to copy, distribute,
% or modify the Package.
%
% "Package" means the collection of files distributed by the Copyright
% Holder, and derivatives of that collection and/or of those files. A
% given Package may consist of either the Standard Version, or a
% Modified Version.
%
% "Distribute" means providing a copy of the Package or making it
% accessible to anyone else, or in the case of a company or
% organization, to others outside of your company or organization.
%
% "Distributor Fee" means any fee that you charge for Distributing this
% Package or providing support for this Package to another party. It
% does not mean licensing fees.
%
% "Standard Version" refers to the Package if it has not been modified,
% or has been modified only in ways explicitly requested by the
% Copyright Holder.
%
% "Modified Version" means the Package, if it has been changed, and such
% changes were not explicitly requested by the Copyright Holder.
%
% "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and
% configuration files for the Package.
%
% "Compiled" form means the compiled bytecode, object code, binary, or
% any other form resulting from mechanical transformation or translation
% of the Source form.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Permission for Use and Modification Without Distribution
%
% (1) You are permitted to use the Standard Version and create and use
% Modified Versions for any purpose without restriction, provided that
% you do not Distribute the Modified Version.
%
% Permissions for Redistribution of the Standard Version
%
% (2) You may Distribute verbatim copies of the Source form of the
% Standard Version of this Package in any medium without restriction,
% either gratis or for a Distributor Fee, provided that you duplicate
% all of the original copyright notices and associated disclaimers. At
% your discretion, such verbatim copies may or may not include a
% Compiled form of the Package.
%
% (3) You may apply any bug fixes, portability changes, and other
% modifications made available from the Copyright Holder. The resulting
% Package will still be considered the Standard Version, and as such
% will be subject to the Original License.
%
% Distribution of Modified Versions of the Package as Source
%
% (4) You may Distribute your Modified Version as Source (either gratis
% or for a Distributor Fee, and with or without a Compiled form of the
% Modified Version) provided that you clearly document how it differs
% from the Standard Version, including, but not limited to, documenting
% any non-standard features, executables, or modules, and provided that
% you do at least ONE of the following:
%
% (a) make the Modified Version available to the Copyright Holder of the
% Standard Version, under the Original License, so that the Copyright
% Holder may include your modifications in the Standard Version. (b)
% ensure that installation of your Modified Version does not prevent the
% user installing or running the Standard Version. In addition, the
% modified Version must bear a name that is different from the name of
% the Standard Version. (c) allow anyone who receives a copy of the
% Modified Version to make the Source form of the Modified Version
% available to others under (i) the Original License or (ii) a license
% that permits the licensee to freely copy, modify and redistribute the
% Modified Version using the same licensing terms that apply to the copy
% that the licensee received, and requires that the Source form of the
% Modified Version, and of any works derived from it, be made freely
% available in that license fees are prohibited but Distributor Fees are
% allowed.
%
% Distribution of Compiled Forms of the Standard Version or
% Modified Versions without the Source
%
% (5) You may Distribute Compiled forms of the Standard Version without
% the Source, provided that you include complete instructions on how to
% get the Source of the Standard Version. Such instructions must be
% valid at the time of your distribution. If these instructions, at any
% time while you are carrying out such distribution, become invalid, you
% must provide new instructions on demand or cease further
% distribution. If you provide valid instructions or cease distribution
% within thirty days after you become aware that the instructions are
% invalid, then you do not forfeit any of your rights under this
% license.
%
% (6) You may Distribute a Modified Version in Compiled form without the
% Source, provided that you comply with Section 4 with respect to the
% Source of the Modified Version.
%
% Aggregating or Linking the Package
%
% (7) You may aggregate the Package (either the Standard Version or
% Modified Version) with other packages and Distribute the resulting
% aggregation provided that you do not charge a licensing fee for the
% Package. Distributor Fees are permitted, and licensing fees for other
% components in the aggregation are permitted. The terms of this license
% apply to the use and Distribution of the Standard or Modified Versions
% as included in the aggregation.
%
% (8) You are permitted to link Modified and Standard Versions with
% other works, to embed the Package in a larger work of your own, or to
% build stand-alone binary or bytecode versions of applications that
% include the Package, and Distribute the result without restriction,
% provided the result does not expose a direct interface to the Package.
%
% Items That are Not Considered Part of a Modified Version
%
% (9) Works (including, but not limited to, modules and scripts) that
% merely extend or make use of the Package, do not, by themselves, cause
% the Package to be a Modified Version. In addition, such works are not
% considered parts of the Package itself, and are not subject to the
% terms of this license.
%
% General Provisions
%
% (10) Any use, modification, and distribution of the Standard or
% Modified Versions is governed by this Artistic License. By using,
% modifying or distributing the Package, you accept this license. Do not
% use, modify, or distribute the Package, if you do not accept this
% license.
%
% (11) If your Modified Version has been derived from a Modified Version
% made by someone other than you, you are nevertheless required to
% ensure that your Modified Version complies with the requirements of
% this license.
%
% (12) This license does not grant you the right to use any trademark,
% service mark, tradename, or logo of the Copyright Holder.
%
% (13) This license includes the non-exclusive, worldwide,
% free-of-charge patent license to make, have made, use, offer to sell,
% sell, import and otherwise transfer the Package with respect to any
% patent claims licensable by the Copyright Holder that are necessarily
% infringed by the Package. If you institute patent litigation
% (including a cross-claim or counterclaim) against any party alleging
% that the Package constitutes direct or contributory patent
% infringement, then this Artistic License to you shall terminate on the
% date that such litigation is filed.
%
% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module(flags, [flag_define/2,
flag_define/5,
flag_define/7,
flag_set/2,
flag_set/3,
flag_unsafe_set/2,
flag_get/2,
flags_reset/0,
flags_reset/1,
flags_save/1,
flags_load/1,
flag_groups/1,
flag_group_chk/1,
flag_help/0,
flags_print/0,
defined_flag/7]).
/**
* @defgroup flags Flag Manipulation in Prolog
* @ingroup library
*
* Routines to manipulate flags: they allow defining, set,
* resetting.
* @{
*/
:- use_module(library(lists), [append/3, memberchk/2, member/2]).
:- style_check(all).
:- yap_flag(unknown, error).
:- dynamic(['$defined_flag$'/7, '$store_flag_value$'/2]).
:- meta_predicate(flag_define(+, +, +, ?, ?, ?, :)).
:- meta_predicate(flag_define(+, :)).
:- meta_predicate(validate(+, :, ?, +)).
:- multifile(flags_type_definition/3).
flag_define(FlagName, InputOptions):-
strip_module(InputOptions, Module, UserOptions),
Defaults = [flag_group(general), flag_type(nonvar), default_value(true), description(FlagName), access(read_write), handler(true)],
append(UserOptions, Defaults, Options),
memberchk(flag_group(FlagGroup), Options),
memberchk(flag_type(FlagType), Options),
memberchk(default_value(DefaultValue), Options),
memberchk(description(Description), Options),
memberchk(access(Access), Options),
memberchk(handler(Handler), Options),
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler).
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description):-
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, read_write, true).
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, MHandler):-
strip_module(MHandler, Module, Handler),
nonvar(FlagName),
nonvar(FlagGroup),
nonvar(FlagType),
nonvar(Access),
nonvar(Handler), !,
(\+ atom(FlagName) ->
throw(error(type_error(atom, FlagName), message('Flag name needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ atom(FlagGroup) ->
throw(error(type_error(atom, FlagGroup), message('Flag group needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ flag_type(FlagType) ->
throw(error(domain_error(flag_type, FlagType), message('Unknown flag type.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Module:Handler))))
; \+ validate_type(FlagType) ->
throw(error(evaluation_error(type_validation), message('Validation of flag type failed, check custom domain.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; '$defined_flag$'(FlagName, _FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler) ->
throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]),
throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ callable(Handler) -> % the Handler comes from: strip_module(MHandler, Module, Handler)
throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
;
validate(FlagType, Module:Handler, DefaultValue, FlagName),
assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)),
assertz('$store_flag_value$'(FlagName, DefaultValue)),
(Handler == true ->
true
;
call(Module:Handler, stored, DefaultValue)
)
).
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
throw(error(instantiation_error, message('Flag name, group, type, access and handler need to be instantiated.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler)))).
flag_groups(FlagGroups):-
all(FlagGroup, ('$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, Access, _Handler), Access \== hidden, Access \== hidden_read_only), FlagGroups).
flag_group_chk(FlagGroup):-
nonvar(FlagGroup),
'$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler), !.
flag_type(Type):-
flags_type_definition(Type, _, _).
% flags_type_definition(TypeName, TypeHandler, TypeValidator).
flags_type_definition(nonvar, nonvar, true).
flags_type_definition(atom, atom, true).
flags_type_definition(atomic, atomic, true).
flags_type_definition(integer, integer, true).
flags_type_definition(float, float, true).
flags_type_definition(number, number, true).
flags_type_definition(ground, ground, true).
flags_type_definition(compound, compound, true).
flags_type_definition(is_list, is_list, true).
flags_type_definition(callable, callable, true).
flags_type_definition(in_interval(Type, Interval), in_interval(Type, Interval), in_interval(Type, Interval)).
flags_type_definition(integer_in_interval(Interval), in_interval(integer, Interval), in_interval(integer, Interval)).
flags_type_definition(positive_integer, in_interval(integer, (0, (+inf))), true).
flags_type_definition(non_negative_integer, in_interval(integer, ([0], (+inf))), true).
flags_type_definition(negative_integer, in_interval(integer, ((-inf), 0)), true).
flags_type_definition(float_in_interval(Interval), in_interval(float, Interval), in_interval(float, Interval)).
flags_type_definition(positive_float, in_interval(float, (0.0, (+inf))), true).
flags_type_definition(non_negative_float, in_interval(float, ([0.0], (+inf))), true).
flags_type_definition(negative_float, in_interval(float, ((-inf), 0.0)), true).
flags_type_definition(number_in_interval(Interval), in_interval(number, Interval), in_interval(number, Interval)).
flags_type_definition(positive_number, in_interval(number, (0.0, (+inf))), true).
flags_type_definition(non_negative_number, in_interval(number, ([0.0], (+inf))), true).
flags_type_definition(negative_number, in_interval(number, ((-inf), 0.0)), true).
flags_type_definition(in_domain(Domain), in_domain(Domain), in_domain(Domain)).
flags_type_definition(boolean, in_domain([true, false]), true).
flags_type_definition(switch, in_domain([on, off]), true).
in_domain(Domain):-
ground(Domain),
is_list(Domain).
in_domain(Domain, Value):-
ground(Value),
memberchk(Value, Domain).
in_interval(Type, Interval):-
is_list(Interval), !,
Interval \== [],
in_interval_conj(Type, Interval).
in_interval(Type, Interval):-
in_interval_single(Type, Interval).
in_interval_conj(_Type, []).
in_interval_conj(Type, [Interval|Rest]):-
in_interval_single(Type, Interval),
in_interval_conj(Type, Rest).
in_interval_single(Type, ([Min], [Max])):-
!, call(Type, Min),
call(Type, Max),
Min =< Max.
in_interval_single(Type, ([Min], Max)):-
!, call(Type, Min),
type_or_inf(Type, Max),
Min < Max.
in_interval_single(Type, (Min, [Max])):-
!, type_or_inf(Type, Min),
call(Type, Max),
Min < Max.
in_interval_single(Type, (Min, Max)):-
type_or_inf(Type, Min),
type_or_inf(Type, Max),
Min < Max,
Max - Min > 0.0.
type_or_inf(Type, Value):-
nonvar(Type), nonvar(Value),
Value == (+inf), !.
type_or_inf(Type, Value):-
nonvar(Type), nonvar(Value),
Value == (-inf), !.
type_or_inf(Type, Value):- call(Type, Value).
in_interval(Type, [Interval|_Rest], Value):-
in_interval(Type, Interval, Value), !.
in_interval(Type, [_Interval|Rest], Value):-
in_interval(Type, Rest, Value).
in_interval(Type, ([Min], [Max]), Value):-
!, call(Type, Value),
Value >= Min,
Value =< Max.
in_interval(Type, ([Min], Max), Value):-
!, call(Type, Value),
Value >= Min,
Value < Max.
in_interval(Type, (Min, [Max]), Value):-
!, call(Type, Value),
Value > Min,
Value =< Max.
in_interval(Type, (Min, Max), Value):-
call(Type, Value),
Value > Min,
Value < Max.
validate_type(Type):-
flags_type_definition(Type, _, TypeValidater),
call(TypeValidater).
validate(FlagType, Handler, Value, FlagName):-
strip_module(Handler, _Module, true),
!, flags_type_definition(FlagType, FlagValidator, _),
(call(FlagValidator, Value) ->
true
;
throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Value, FlagName))))
).
validate(FlagType, Handler, Value, FlagName):-
flags_type_definition(FlagType, FlagValidator, _),
((call(Handler, validating, Value), (call(FlagValidator, Value); call(Handler, validate, Value))) ->
call(Handler, validated, Value)
;
throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Handler, Value, FlagName))))
).
flag_set(FlagName, FlagValue):-
flag_set(FlagName, _OldValue, FlagValue).
flag_set(FlagName, OldValue, FlagValue):-
atom(FlagName),
'$defined_flag$'(FlagName, _FlagGroup, FlagType, _DefaultValue, _Description, Access, Module:Handler), !,
(Access \== read_only, Access \== hidden_read_only ->
validate(FlagType, Module:Handler, FlagValue, FlagName),
retract('$store_flag_value$'(FlagName, OldValue)),
assertz('$store_flag_value$'(FlagName, FlagValue)),
(Handler == true ->
true
;
call(Module:Handler, stored, FlagValue)
)
;
throw(error(permission_error(set, flag, FlagName), message('Setting the flag value is not allowed.',flag_set(FlagName, OldValue, FlagValue))))
).
flag_set(FlagName, OldValue, FlagValue):-
throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_set(FlagName, OldValue, FlagValue)))).
flag_unsafe_set(FlagName, FlagValue):-
retract('$store_flag_value$'(FlagName, _)),
assertz('$store_flag_value$'(FlagName, FlagValue)).
flag_get(FlagName, FlagValue):-
\+ '$store_flag_value$'(FlagName, _),
throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_get(FlagName, FlagValue)))).
flag_get(FlagName, FlagValue):-
'$store_flag_value$'(FlagName, FlagValue).
flags_reset:-
retractall('$store_flag_value$'(_, _)),
'$defined_flag$'(FlagName, _FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler),
assertz('$store_flag_value$'(FlagName, DefaultValue)),
(Handler == true ->
true
;
call(Module:Handler, stored, DefaultValue)
),
fail.
flags_reset.
flags_reset(FlagGroup):-
'$defined_flag$'(FlagName, FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler),
retractall('$store_flag_value$'(FlagName, _)),
assertz('$store_flag_value$'(FlagName, DefaultValue)),
(Handler == true ->
true
;
call(Module:Handler, stored, DefaultValue)
),
fail.
flags_reset(_).
flags_save(FileName):-
tell(FileName),
catch(('$store_flag_value$'(FlagName, Value),
write_canonical('$store_flag_value$'(FlagName, Value)),
write('.'), nl),
Exception, clean_and_throw(told, Exception)),
fail.
flags_save(_FileName):-
told.
flags_load(FileName):-
see(FileName),
catch((read('$store_flag_value$'(FlagName, Value)),
flag_set(FlagName, Value)),
Exception, clean_and_throw(seen, Exception)),
fail.
flags_load(_FileName):-
seen.
clean_and_throw(Action, Exception):-
Action,
throw(Exception).
flag_help:-
format('This is a short tutorial for the flags library.~nExported predicates:~n'),
format(' flag_define/5 : defines a new flag without a handler~n'),
format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description)~n'),
format(' flag_define/6 : defines a new flag with a handler~n'),
format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Handler)~n'),
format(' FlagName : the name of the flag~n'),
format(' FlagGroup : the name of the flag group~n'),
format(' FlagType : the type of the flag available types are:~n'),
flag_help_types,
format(' DefaultValue : the default value for the flag~n'),
format(' Description : a flag description~n'),
format(' Handler : a handler~n'),
flags:flag_help_handler,
format(' flag_groups/1 : returns all the flag groups in a list~n'),
format(' flag_group_chk/1 : checks if a group exists~n'),
format(' flag_set/2 : sets the value of a flag~n'),
format(' flag_get/2 : gets the value of a flag~n'),
format(' flag_store/2 : sets the value of a flag ignoring all tests and handlers~n'),
format(' flag_reset/0 : resets all flags to their default value~n'),
format(' flag_reset/1 : resets all flags of a group to their default value~n'),
format(' flag_help/0 : this screen~n'),
format(' flags_print/0 : shows the current flags/values~n').
flag_help_types:-
flag_type(FlagType),
format(' ~w~n', [FlagType]),
fail.
flag_help_types.
flag_help_handler:-
format(' Handler important notes:~n'),
format(' Conjuction: external_handler(validating, Value):-...~n'),
format(' Disjunction: external_handler(validate, Value):-...~n'),
format(' After: external_handler(validated, Value):-...~n'),
format(' After set: external_handler(stored, Value):-...~n'),
format(' this is implemented as (validating,(original;validated))~n'),
format(' validating|original|validate|result~n'),
format(' true | true | true | true~n'),
format(' true | true | fail | true~n'),
format(' true | fail | true | true~n'),
format(' true | fail | fail | fail~n'),
format(' fail | true | true | fail~n'),
format(' fail | true | fail | fail~n'),
format(' fail | fail | true | fail~n'),
format(' fail | fail | fail | fail~n'),
format(' Default behaviour is validating->true, validate->fail~n'),
format(' To completly replace original set validate->true~n'),
format(' To add new values to original set validating->true~n'),
format(' To remove values from original set validate->fail~n'),
format(' Example definition with a handler:~n'),
format(' flag_define(myflag, mygroup, in_interval(integer, [(-5, 5),([15],[25])]), 0, description, my_handler).~n'),
format(' my_handler(validate, Value):-Value is 10.~n'),
format(' my_handler(validating, Value).~n'),
format(' my_handler(validated, Value).~n'),
format(' my_handler(stored, Value).~n'),
format(' This has defined a flag that accepts integers (-5,5)v[15,25].~n'),
format(' The handler adds the value 10 in those.~n').
flags_print:-
flag_groups(Groups),
forall(member(Group, Groups), flags_print(Group)).
flags_print(Group):-
format(' ~w:~n~w~38+ ~w~19+ ~w~10+ ~w~10+~n', [Group, 'Description', 'Domain', 'Flag', 'Value']),
fail.
flags_print(FlagGroup):-
'$defined_flag$'(FlagName, FlagGroup, FlagType, _DefaultValue, Description, Access, _Handler),
Access \== hidden, Access \== hidden_read_only,
flag_get(FlagName, Value),
format('~w~38+ ~w~19+ ~w~10+ ~q~10+~n', [Description, FlagType, FlagName, Value]),
fail.
flags_print(_).
defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
'$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler),
Access \== hidden, Access \== hidden_read_only.
defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
nonvar(FlagName), nonvar(FlagGroup),
'$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler).
%% @}

44
packages/python/swig/yap4py/prolog/gensym.yap
View File

@ -1,44 +0,0 @@
/**
* @file gensym.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 18:37:13 2015
*
* @brief Generate a new atom.
*
*
*/
:- module(gensym, [
gensym/2,
reset_gensym/1,
reset_gensym/0
]).
/**
* @defgroup gensym Generate a new symbol.
* @ingroup library
*
* Predicates to create new atoms based on the prefix _Atom_.
* They use a counter, stored as a
* dynamic predicate, to construct the atom's suffix.
*
*/
:- dynamic gensym_key/2.
gensym(Atom, New) :-
retract(gensym_key(Atom,Id)), !,
atomic_concat(Atom,Id,New),
NId is Id+1,
assert(gensym_key(Atom,NId)).
gensym(Atom, New) :-
atomic_concat(Atom,1,New),
assert(gensym_key(Atom,2)).
reset_gensym(Atom) :-
retract(gensym_key(Atom,_)).
reset_gensym :-
retractall(gensym_key(_,_)).

70
packages/python/swig/yap4py/prolog/hacks.yap
View File

@ -1,70 +0,0 @@
/**
* @file library/hacks.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 19:00:25 2015
*
* @brief Prolog hacking
*
*
*/
:- module(yap_hacks, [
current_choicepoint/1,
cut_by/1,
cut_at/1,
current_choicepoints/1,
choicepoint/7,
current_continuations/1,
continuation/4,
stack_dump/0,
stack_dump/1,
enable_interrupts/0,
disable_interrupts/0,
virtual_alarm/3,
fully_strip_module/3,
context_variables/1
]).
/**
* @defgroup yap_hacks YAP hacking
* @ingroup library
*
* Manipulate the Prolog stacks, including setting and resetting
* choice-points.
*
*/
stack_dump :-
stack_dump(-1).
stack_dump(Max) :-
current_choicepoints(CPs),
current_continuations([Env|Envs]),
continuation(Env,_,ContP,_),
length(CPs, LCPs),
length(Envs, LEnvs),
format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Cur/Next Clause Goal~n',[LCPs,LEnvs]),
'$hacks':display_stack_info(CPs, Envs, Max, ContP, StackInfo, []),
run_formats(StackInfo, user_error).
run_formats([], _).
run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args),
run_formats(StackInfo, user_error).
virtual_alarm(Interval, Goal, Left) :-
Interval == 0, !,
virtual_alarm(0, 0, Left0, _),
on_signal(sig_vtalarm, _, Goal),
Left = Left0.
virtual_alarm(Interval, Goal, Left) :-
integer(Interval), !,
on_signal(sig_vtalarm, _, Goal),
virtual_alarm(Interval, 0, Left, _).
virtual_alarm(Interval.USecs, Goal, Left.LUSecs) :-
on_signal(sig_vtalarm, _, Goal),
virtual_alarm(Interval, USecs, Left, LUSecs).
fully_strip_module(T,M,S) :-
'$hacks':fully_strip_module(T,M,S).

283
packages/python/swig/yap4py/prolog/heaps.yap
View File

@ -1,283 +0,0 @@
/**
* @file heaps.yap
* @author R.A.O'Keefe, included as an YAP library by Vitor Santos Costa, 1999.
* @date 29 November 1983
*
* @brief Implement heaps in Prolog.
*
*
*/
:- module(heaps,[
add_to_heap/4, % Heap x Key x Datum -> Heap
get_from_heap/4, % Heap -> Key x Datum x Heap
empty_heap/1, % Heap
heap_size/2, % Heap -> Size
heap_to_list/2, % Heap -> List
list_to_heap/2, % List -> Heap
min_of_heap/3, % Heap -> Key x Datum
min_of_heap/5 % Heap -> (Key x Datum) x (Key x Datum)
]).
/** @defgroup heaps Heaps
@ingroup library
@{
A heap is a labelled binary tree where the key of each node is less than
or equal to the keys of its sons. The point of a heap is that we can
keep on adding new elements to the heap and we can keep on taking out
the minimum element. If there are N elements total, the total time is
O(NlgN). If you know all the elements in advance, you are better off
doing a merge-sort, but this file is for when you want to do say a
best-first search, and have no idea when you start how many elements
there will be, let alone what they are.
The following heap manipulation routines are available once included
with the `use_module(library(heaps))` command.
- add_to_heap/4
- empty_heap/1
- get_from_heap/4
- heap_size/2
- heap_to_list/2
- list_to_heap/2
- min_of_heap/3
- min_of_heap/5
A heap is a labelled binary tree where the key of each node is less
than or equal to the keys of its sons. The point of a heap is that
we can keep on adding new elements to the heap and we can keep on
taking out the minimum element. If there are N elements total, the
total time is O(NlgN). If you know all the elements in advance, you
are better off doing a merge-sort, but this file is for when you want
to do say a best-first search, and have no idea when you start how
many elements there will be, let alone what they are.
A heap is represented as a triple t(N, Free, Tree) where N is the
number of elements in the tree, Free is a list of integers which
specifies unused positions in the tree, and Tree is a tree made of
t terms for empty subtrees and
t(Key,Datum,Lson,Rson) terms for the rest
The nodes of the tree are notionally numbered like this:
1
2 3
4 6 5 7
8 12 10 14 9 13 11 15
.. .. .. .. .. .. .. .. .. .. .. .. .. .. .. ..
The idea is that if the maximum number of elements that have been in
the heap so far is M, and the tree currently has K elements, the tree
is some subtreee of the tree of this form having exactly M elements,
and the Free list is a list of K-M integers saying which of the
positions in the M-element tree are currently unoccupied. This free
list is needed to ensure that the cost of passing N elements through
the heap is O(NlgM) instead of O(NlgN). For M say 100 and N say 10^4
this means a factor of two. The cost of the free list is slight.
The storage cost of a heap in a copying Prolog (which Dec-10 Prolog is
not) is 2K+3M words.
*/
/*
:- mode
add_to_heap(+, +, +, -),
add_to_heap(+, +, +, +, -),
add_to_heap(+, +, +, +, +, +, -, -),
sort2(+, +, +, +, -, -, -, -),
get_from_heap(+, ?, ?, -),
repair_heap(+, +, +, -),
heap_size(+, ?),
heap_to_list(+, -),
heap_tree_to_list(+, -),
heap_tree_to_list(+, +, -),
list_to_heap(+, -),
list_to_heap(+, +, +, -),
min_of_heap(+, ?, ?),
min_of_heap(+, ?, ?, ?, ?),
min_of_heap(+, +, ?, ?).
*/
%% @pred add_to_heap(OldHeap, Key, Datum, NewHeap)
%
% inserts the new Key-Datum pair into the heap. The insertion is
% not stable, that is, if you insert several pairs with the same
% Key it is not defined which of them will come out first, and it
% is possible for any of them to come out first depending on the
% history of the heap. If you need a stable heap, you could add
% a counter to the heap and include the counter at the time of
% insertion in the key. If the free list is empty, the tree will
% be grown, otherwise one of the empty slots will be re-used. (I
% use imperative programming language, but the heap code is as
% pure as the trees code, you can create any number of variants
% starting from the same heap, and they will share what common
% structure they can without interfering with each other.)
add_to_heap(t(M,[],OldTree), Key, Datum, t(N,[],NewTree)) :- !,
N is M+1,
add_to_heap(N, Key, Datum, OldTree, NewTree).
add_to_heap(t(M,[H|T],OldTree), Key, Datum, t(N,T,NewTree)) :-
N is M+1,
add_to_heap(H, Key, Datum, OldTree, NewTree).
add_to_heap(1, Key, Datum, _, t(Key,Datum,t,t)) :- !.
add_to_heap(N, Key, Datum, t(K1,D1,L1,R1), t(K2,D2,L2,R2)) :-
E is N mod 2,
M is N//2,
% M > 0, % only called from list_to_heap/4,add_to_heap/4
sort2(Key, Datum, K1, D1, K2, D2, K3, D3),
add_to_heap(E, M, K3, D3, L1, R1, L2, R2).
add_to_heap(0, N, Key, Datum, L1, R, L2, R) :- !,
add_to_heap(N, Key, Datum, L1, L2).
add_to_heap(1, N, Key, Datum, L, R1, L, R2) :- !,
add_to_heap(N, Key, Datum, R1, R2).
sort2(Key1, Datum1, Key2, Datum2, Key1, Datum1, Key2, Datum2) :-
Key1 @< Key2,
!.
sort2(Key1, Datum1, Key2, Datum2, Key2, Datum2, Key1, Datum1).
%% @pred @pred get_from_heap(+ _Heap_,- _key_,- _Datum_,- _Heap_)
%
% returns the Key-Datum pair in OldHeap with the smallest Key, and
% also a New Heap which is the Old Heap with that pair deleted.
% The easy part is picking off the smallest element. The hard part
% is repairing the heap structure. repair_heap/4 takes a pair of
% heaps and returns a new heap built from their elements, and the
% position number of the gap in the new tree. Note that repair_heap
% is *not* tail-recursive.
get_from_heap(t(N,Free,t(Key,Datum,L,R)), Key, Datum, t(M,[Hole|Free],Tree)) :-
M is N-1,
repair_heap(L, R, Tree, Hole).
repair_heap(t(K1,D1,L1,R1), t(K2,D2,L2,R2), t(K2,D2,t(K1,D1,L1,R1),R3), N) :-
K2 @< K1,
!,
repair_heap(L2, R2, R3, M),
N is 2*M+1.
repair_heap(t(K1,D1,L1,R1), t(K2,D2,L2,R2), t(K1,D1,L3,t(K2,D2,L2,R2)), N) :- !,
repair_heap(L1, R1, L3, M),
N is 2*M.
repair_heap(t(K1,D1,L1,R1), t, t(K1,D1,L3,t), N) :- !,
repair_heap(L1, R1, L3, M),
N is 2*M.
repair_heap(t, t(K2,D2,L2,R2), t(K2,D2,t,R3), N) :- !,
repair_heap(L2, R2, R3, M),
N is 2*M+1.
repair_heap(t, t, t, 1) :- !.
%% @pred heap_size(+ _Heap_, - _Size_)
%
% reports the number of elements currently in the heap.
heap_size(t(Size,_,_), Size).
%% @pred heap_to_list(+ _Heap_, - _List_)
%
% returns the current set of Key-Datum pairs in the Heap as a
% List, sorted into ascending order of Keys. This is included
% simply because I think every data structure foo ought to have
% a foo_to_list and list_to_foo relation (where, of course, it
% makes sense!) so that conversion between arbitrary data
% structures is as easy as possible. This predicate is basically
% just a merge sort, where we can exploit the fact that the tops
% of the subtrees are smaller than their descendants.
heap_to_list(t(_,_,Tree), List) :-
heap_tree_to_list(Tree, List).
heap_tree_to_list(t, []) :- !.
heap_tree_to_list(t(Key,Datum,Lson,Rson), [Key-Datum|Merged]) :-
heap_tree_to_list(Lson, Llist),
heap_tree_to_list(Rson, Rlist),
heap_tree_to_list(Llist, Rlist, Merged).
heap_tree_to_list([H1|T1], [H2|T2], [H2|T3]) :-
H2 @< H1,
!,
heap_tree_to_list([H1|T1], T2, T3).
heap_tree_to_list([H1|T1], T2, [H1|T3]) :- !,
heap_tree_to_list(T1, T2, T3).
heap_tree_to_list([], T, T) :- !.
heap_tree_to_list(T, [], T).
%% @pred list_to_heap(+ _List_, - _Heap_)
%
% takes a list of Key-Datum pairs (such as keysort could be used to
% sort) and forms them into a heap. We could do that a wee bit
% faster by keysorting the list and building the tree directly, but
% this algorithm makes it obvious that the result is a heap, and
% could be adapted for use when the ordering predicate is not @<
% and hence keysort is inapplicable.
list_to_heap(List, Heap) :-
list_to_heap(List, 0, t, Heap).
list_to_heap([], N, Tree, t(N,[],Tree)) :- !.
list_to_heap([Key-Datum|Rest], M, OldTree, Heap) :-
N is M+1,
add_to_heap(N, Key, Datum, OldTree, MidTree),
list_to_heap(Rest, N, MidTree, Heap).
%% @pred min_of_heap(Heap, Key, Datum)
%
% returns the Key-Datum pair at the top of the heap (which is of
% course the pair with the smallest Key), but does not remove it
% from the heap. It fails if the heap is empty.
/** @pred min_of_heap(+ _Heap_, - _Key_, - _Datum_)
Returns the Key-Datum pair at the top of the heap (which is of course
the pair with the smallest Key), but does not remove it from the heap.
*/
min_of_heap(t(_,_,t(Key,Datum,_,_)), Key, Datum).
%% @pred @pred min_of_heap(+ _Heap_, - _Key1_, - _Datum1_, -_Key2_, - _Datum2_)
%
% returns the smallest (Key1) and second smallest (Key2) pairs in
% the heap, without deleting them. It fails if the heap does not
% have at least two elements.
min_of_heap(t(_,_,t(Key1,Datum1,Lson,Rson)), Key1, Datum1, Key2, Datum2) :-
min_of_heap(Lson, Rson, Key2, Datum2).
min_of_heap(t(Ka,_Da,_,_), t(Kb,Db,_,_), Kb, Db) :-
Kb @< Ka, !.
min_of_heap(t(Ka,Da,_,_), _, Ka, Da).
min_of_heap(t, t(Kb,Db,_,_), Kb, Db).
/** @pred empty_heap(? _Heap_)
Succeeds if _Heap_ is an empty heap.
*/
empty_heap(t(0,[],t)).
/** @} */

49
packages/python/swig/yap4py/prolog/itries.yap
View File

@ -1,49 +0,0 @@
/**
* @file itries.yap
* @author Ricardo Rocha
* @date
*
* @brief Tries module for ILP
*
*
*/
/*********************************
File: itries.yap
Author: Ricardo Rocha
Comments: Tries module for ILP
version: $ID$
*********************************/
:- module(itries, [
itrie_open/1,
itrie_close/1,
itrie_close_all/0,
itrie_mode/2,
itrie_timestamp/2,
itrie_put_entry/2,
itrie_update_entry/2,
itrie_check_entry/3,
itrie_get_entry/2,
itrie_get_data/2,
itrie_traverse/2,
itrie_remove_entry/1,
itrie_remove_subtree/1,
itrie_add/2,
itrie_subtract/2,
itrie_join/2,
itrie_intersect/2,
itrie_count_join/3,
itrie_count_intersect/3,
itrie_save/2,
itrie_save_as_trie/2,
itrie_load/2,
itrie_save2stream/2,
itrie_loadFromstream/2,
itrie_stats/4,
itrie_max_stats/4,
itrie_usage/4,
itrie_print/1
]).
:- load_foreign_files([itries], [], init_itries).

221
packages/python/swig/yap4py/prolog/lam_mpi.yap
View File

@ -1,221 +0,0 @@
% Author: Nuno A. Fonseca
% Date: 2006-06-01
% $Id: lam_mpi.yap,v 1.1 2006-06-04 18:43:38 nunofonseca Exp $
:- module(lam_mpi, [
mpi_init/0,
mpi_finalize/0,
mpi_comm_size/1,
mpi_comm_rank/1,
mpi_version/2,
mpi_send/3,
mpi_isend/4,
mpi_recv/3,
mpi_irecv/3,
mpi_wait/2,
mpi_wait_recv/3,
mpi_test/2,
mpi_test_recv/3,
mpi_bcast/2,
mpi_ibcast2/2,
mpi_ibcast2/3,
mpi_bcast2/2,
mpi_bcast2/3,
mpi_barrier/0,
mpi_msg_buffer_size/2,
mpi_msg_size/2,
mpi_gc/0,
mpi_default_buffer_size/2
]).
/**
* @defgroup lam_mpi MPI Interface
* @ingroup library
@{
This library provides a set of utilities for interfacing with LAM MPI.
The following routines are available once included with the
`use_module(library(lam_mpi))` command. The yap should be
invoked using the LAM mpiexec or mpirun commands (see LAM manual for
more details).
*/
/** @pred mpi_barrier
Collective communication predicate. Performs a barrier
synchronization among all processes. Note that a collective
communication means that all processes call the same predicate. To be
able to use a regular `mpi_recv` to receive the messages, one
should use `mpi_bcast2`.
*/
/** @pred mpi_bcast2(+ _Root_, ? _Data_)
Broadcasts the message _Data_ from the process with rank _Root_
to all other processes.
*/
/** @pred mpi_comm_rank(- _Rank_)
Unifies _Rank_ with the rank of the current process in the MPI environment.
*/
/** @pred mpi_comm_size(- _Size_)
Unifies _Size_ with the number of processes in the MPI environment.
*/
/** @pred mpi_finalize
Terminates the MPI execution environment. Every process must call this predicate before exiting.
*/
/** @pred mpi_gc
Attempts to perform garbage collection with all the open handles
associated with send and non-blocking broadcasts. For each handle it
tests it and the message has been delivered the handle and the buffer
are released.
*/
/** @pred mpi_init
Sets up the mpi environment. This predicate should be called before any other MPI predicate.
*/
/** @pred mpi_irecv(? _Source_,? _Tag_,- _Handle_)
Non-blocking communication predicate. The predicate returns an
_Handle_ for a message that will be received from processor with
rank _Source_ and tag _Tag_. Note that the predicate succeeds
immediately, even if no message has been received. The predicate
`mpi_wait_recv` should be used to obtain the data associated to
the handle.
*/
/** @pred mpi_isend(+ _Data_,+ _Dest_,+ _Tag_,- _Handle_)
Non blocking communication predicate. The message in _Data_, with
tag _Tag_, is sent whenever possible to the processor with rank
_Dest_. An _Handle_ to the message is returned to be used to
check for the status of the message, using the `mpi_wait` or
`mpi_test` predicates. Until `mpi_wait` is called, the
memory allocated for the buffer containing the message is not
released.
*/
/** @pred mpi_msg_size( _Msg_, - _MsgSize_)
Unify _MsgSize_ with the number of bytes YAP would need to send the
message _Msg_.
*/
/** @pred mpi_recv(? _Source_,? _Tag_,- _Data_)
Blocking communication predicate. The predicate blocks until a message
is received from processor with rank _Source_ and tag _Tag_.
The message is placed in _Data_.
*/
/** @pred mpi_send(+ _Data_,+ _Dest_,+ _Tag_)
Blocking communication predicate. The message in _Data_, with tag
_Tag_, is sent immediately to the processor with rank _Dest_.
The predicate succeeds after the message being sent.
*/
/** @pred mpi_test(? _Handle_,- _Status_)
Provides information regarding the handle _Handle_, ie., if a
communication operation has been completed. If the operation
associate with _Hanlde_ has been completed the predicate succeeds
with the completion status in _Status_, otherwise it fails.
*/
/** @pred mpi_test_recv(? _Handle_,- _Status_,- _Data_)
Provides information regarding a handle. If the message associated
with handle _Hanlde_ is buffered then the predicate succeeds
unifying _Status_ with the status of the message and _Data_
with the message itself. Otherwise, the predicate fails.
*/
/** @pred mpi_version(- _Major_,- _Minor_)
Unifies _Major_ and _Minor_ with, respectively, the major and minor version of the MPI.
*/
/** @pred mpi_wait(? _Handle_,- _Status_)
Completes a non-blocking operation. If the operation was a
`mpi_send`, the predicate blocks until the message is buffered
or sent by the runtime system. At this point the send buffer is
released. If the operation was a `mpi_recv`, it waits until the
message is copied to the receive buffer. _Status_ is unified with
the status of the message.
*/
/** @pred mpi_wait_recv(? _Handle_,- _Status_,- _Data_)
Completes a non-blocking receive operation. The predicate blocks until
a message associated with handle _Hanlde_ is buffered. The
predicate succeeds unifying _Status_ with the status of the
message and _Data_ with the message itself.
*/
:- load_foreign_files([yap_mpi], [], init_mpi).
mpi_msg_size(Term, Size) :-
terms:export_term(Term, Buf, Size),
terms:kill_exported_term(Buf).
/** @} */

217
packages/python/swig/yap4py/prolog/lambda.pl
View File

@ -1,217 +0,0 @@
/**
* @file heaps.yap
* @author Ulrich Neumerkel
* @date 2009
*
* @brief Lambda expressions in Prolog.
*
*
*/
/*
Author:
E-mail: ulrich@complang.tuwien.ac.at
Copyright (C): 2009 Ulrich Neumerkel. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY Ulrich Neumerkel ``AS IS'' AND ANY
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Ulrich Neumerkel OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
The views and conclusions contained in the software and documentation
are those of the authors and should not be interpreted as representing
official policies, either expressed or implied, of Ulrich Neumerkel.
*/
:- module(lambda, [
(^)/3, (^)/4, (^)/5, (^)/6, (^)/7, (^)/8, (^)/9,
(\)/1, (\)/2, (\)/3, (\)/4, (\)/5, (\)/6, (\)/7,
(+\)/2, (+\)/3, (+\)/4, (+\)/5, (+\)/6, (+\)/7,
op(201,xfx,+\)]).
/**
@defgroup Lambda expressions
@ingroup library
This library provides lambda expressions to simplify higher order
programming based on call/N.
Lambda expressions are represented by ordinary Prolog terms.
There are two kinds of lambda expressions:
~~~~
Free+\X1^X2^ ..^XN^Goal
\X1^X2^ ..^XN^Goal
~~~~
The second is a shorthand for t+\X1^X2^..^XN^Goal
+ _Xi_ are the parameters.
+ _Goal_ is a goal or continuation. Syntax note: Operators within Goal
require parentheses due to the low precedence of the ^ operator.
+ _Free_ contains variables that are valid outside the scope of the lambda
expression. They are thus free variables within.
All other variables of Goal are considered local variables. They must
not appear outside the lambda expression. This restriction is
currently not checked. Violations may lead to unexpected bindings.
In the following example the parentheses around X>3 are necessary.
~~~~~
?- use_module(library(lambda)).
?- use_module(library(apply)).
?- maplist(\X^(X>3),[4,5,9]).
true.
~~~~~
In the following _X_ is a variable that is shared by both instances of
the lambda expression. The second query illustrates the cooperation of
continuations and lambdas. The lambda expression is in this case a
continuation expecting a further argument.
~~~~~
?- Xs = [A,B], maplist(X+\Y^dif(X,Y), Xs).
Xs = [A, B],
dif(X, A),
dif(X, B).
?- Xs = [A,B], maplist(X+\dif(X), Xs).
Xs = [A, B],
dif(X, A),
dif(X, B).
~~~~~
The following queries are all equivalent. To see this, use
the fact f(x,y).
~~~~~
?- call(f,A1,A2).
?- call(\X^f(X),A1,A2).
?- call(\X^Y^f(X,Y), A1,A2).
?- call(\X^(X+\Y^f(X,Y)), A1,A2).
?- call(call(f, A1),A2).
?- call(f(A1),A2).
?- f(A1,A2).
A1 = x,
A2 = y.
~~~~~
Further discussions
http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord
@tbd Static expansion similar to apply_macros.
@author Ulrich Neumerkel
*/
:- meta_predicate no_hat_call(0).
:- meta_predicate
^(?,0,?),
^(?,1,?,?),
^(?,2,?,?,?),
^(?,3,?,?,?,?),
^(?,4,?,?,?,?,?).
^(V1,Goal,V1) :-
no_hat_call(Goal).
^(V1,Goal,V1,V2) :-
call(Goal,V2).
^(V1,Goal,V1,V2,V3) :-
call(Goal,V2,V3).
^(V1,Goal,V1,V2,V3,V4) :-
call(Goal,V2,V3,V4).
^(V1,Goal,V1,V2,V3,V4,V5) :-
call(Goal,V2,V3,V4,V5).
^(V1,Goal,V1,V2,V3,V4,V5,V6) :-
call(Goal,V2,V3,V4,V5,V6).
^(V1,Goal,V1,V2,V3,V4,V5,V6,V7) :-
call(Goal,V2,V3,V4,V5,V6,V7).
:- meta_predicate
\(0),
\(1,?),
\(2,?,?),
\(3,?,?,?),
\(4,?,?,?,?),
\(5,?,?,?,?,?),
\(6,?,?,?,?,?,?).
\(FC) :-
copy_term_nat(FC,C),no_hat_call(C).
\(FC,V1) :-
copy_term_nat(FC,C),call(C,V1).
\(FC,V1,V2) :-
copy_term_nat(FC,C),call(C,V1,V2).
\(FC,V1,V2,V3) :-
copy_term_nat(FC,C),call(C,V1,V2,V3).
\(FC,V1,V2,V3,V4) :-
copy_term_nat(FC,C),call(C,V1,V2,V3,V4).
\(FC,V1,V2,V3,V4,V5) :-
copy_term_nat(FC,C),call(C,V1,V2,V3,V4,V5).
\(FC,V1,V2,V3,V4,V5,V6) :-
copy_term_nat(FC,C),call(C,V1,V2,V3,V4,V5,V6).
:- meta_predicate
+\(?,0),
+\(?,1,?),
+\(?,2,?,?),
+\(?,3,?,?,?),
+\(?,4,?,?,?,?),
+\(?,5,?,?,?,?,?),
+\(?,6,?,?,?,?,?,?).
+\(GV,FC) :-
copy_term_nat(GV+FC,GV+C),no_hat_call(C).
+\(GV,FC,V1) :-
copy_term_nat(GV+FC,GV+C),call(C,V1).
+\(GV,FC,V1,V2) :-
copy_term_nat(GV+FC,GV+C),call(C,V1,V2).
+\(GV,FC,V1,V2,V3) :-
copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3).
+\(GV,FC,V1,V2,V3,V4) :-
copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4).
+\(GV,FC,V1,V2,V3,V4,V5) :-
copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4,V5).
+\(GV,FC,V1,V2,V3,V4,V5,V6) :-
copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4,V5,V6).
%% no_hat_call(:Goal)
%
% Like call, but issues an error for a goal (^)/2. Such goals are
% likely the result of an insufficient number of arguments.
no_hat_call(MGoal) :-
strip_module(MGoal, _, Goal),
( nonvar(Goal),
Goal = (_^_)
-> throw(error(existence_error(lambda_parameters,Goal),_))
; call(MGoal)
).
% I would like to replace this by:
% V1^Goal :- throw(error(existence_error(lambda_parameters,V1^Goal),_)).

527
packages/python/swig/yap4py/prolog/lineutils.yap
View File

@ -1,527 +0,0 @@
/**
* @file lineutils.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 22:02:22 2015
*
* @brief line text processing.
*
*
*/
:- module(lineutils,
[search_for/2,
search_for/3,
scan_natural/3,
scan_integer/3,
natural/3,
integer/3,
blank/3,
split/2,
split/3,
split/4,
split/5,
split_unquoted/3,
fields/2,
fields/3,
glue/3,
copy_line/2,
filter/3,
file_filter/3,
file_select/2,
file_filter_with_initialization/5,
file_filter_with_start_end/5,
file_filter_with_initialization/5 as file_filter_with_init,
process/2
]).
/** @defgroup line_utils Line Manipulation Utilities
@ingroup library
@{
This package provides a set of useful predicates to manipulate
sequences of characters codes, usually first read in as a line. It is
available by loading the
~~~~
:- use_module(library(lineutils)).
~~~~
*/
:- meta_predicate
filter(+,+,2),
file_filter(+,+,2),
file_filter_with_initialization(+,+,2,+,:),
file_filter_with_start_end(+,+,2,2,2),
process(+,1).
:- use_module(library(lists),
[member/2,
append/3]).
:- use_module(library(readutil),
[read_line_to_codes/2]).
/**
@pred search_for(+ _Char_,+ _Line_)
Search for a character _Char_ in the list of codes _Line_.
*/
search_for(C,L) :-
search_for(C, L, []).
search_for(C) --> [C], !.
search_for(C) --> [_],
search_for(C).
/** @pred scan_integer(? _Int_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for an integer _Nat_, either a
positive, zero, or negative integer, and unify _RestOfLine_ with
the remainder of the line.
*/
scan_integer(N) -->
"-", !,
scan_natural(0, N0),
N is -N0.
scan_integer(N) -->
scan_natural(0, N).
/** @pred integer(? _Int_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for an integer _Nat_, either a
positive, zero, or negative integer, and unify _RestOfLine_ with
the remainder of the line.
*/
integer(N) -->
"-", !,
natural(0, N0),
N is -N0.
integer(N) -->
natural(0, N).
/** @pred scan_natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero
or a positive integer, and unify _RestOfLine_ with the remainder
of the line.
*/
scan_natural(N) -->
scan_natural(0, N).
scan_natural(N0,N) -->
[C],
{C >= 0'0, C =< 0'9 }, !,
{ N1 is N0*10+(C-0'0) }, %'
get_natural(N1,N).
scan_natural(N,N) --> [].
/** @pred natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero
or a positive integer, and unify _RestOfLine_ with the remainder
of the line.
*/
natural(N) -->
natural(0, N).
natural(N0,N) -->
[C],
{C >= 0'0, C =< 0'9 }, !,
{ N1 is N0*10+(C-0'0) }, %'
get_natural(N1,N).
natural(N,N) --> [].
/** @pred skip_whitespace(+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for white space, namely for tabbing and space characters.
*/
skip_whitespace([0' |Blanks]) -->
" ",
skip_whitespace( Blanks ).
skip_whitespace([0' |Blanks]) -->
" ",
skip_whitespace( Blanks ).
skip_whitespace( [] ) -->
!.
/** @pred blank(+ _Line_,+ _RestOfLine_)
The list of codes _Line_ is formed by white space, namely by tabbing and space characters.
*/
blank([0' |Blanks]) -->
" ",
blank( Blanks ).
blank([0' |Blanks]) -->
" ",
blank( Blanks ).
blank( [] ) -->
[].
/** @pred split(+ _Line_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the blank characters as separators.
*/
split(String, Strings) :-
split_at_blank(" ", Strings, String, []).
/** @pred split(+ _Line_,+ _Separators_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the character codes in _Separators_ as separators. As an
example, consider:
~~~~~{.prolog}
?- split("Hello * I am free"," *",S).
S = ["Hello","I","am","free"] ?
no
~~~~~
*/
split(String, SplitCodes, Strings) :-
split_at_blank(SplitCodes, Strings, String, []).
split_at_blank(SplitCodes, More) -->
[C],
{ member(C, SplitCodes) }, !,
split_at_blank(SplitCodes, More).
split_at_blank(SplitCodes, [[C|New]| More]) -->
[C], !,
split_(SplitCodes, New, More).
split_at_blank(_, []) --> [].
split_(SplitCodes, [], More) -->
[C],
{ member(C, SplitCodes) }, !,
split_at_blank(SplitCodes, More).
split_(SplitCodes, [C|New], Set) -->
[C], !,
split_(SplitCodes, New, Set).
split_(_, [], []) --> [].
split(Text, SplitCodes, DoubleQs, SingleQs, Strings) :-
split_element(SplitCodes, DoubleQs, SingleQs, Strings, Text, []).
split_element(SplitCodes, DoubleQs, SingleQs, Strings) -->
[C],
!,
split_element(SplitCodes, DoubleQs, SingleQs, Strings, C).
split_element(_SplitCodes, _DoubleQs, _SingleQs, []) --> !.
split_element(_SplitCodes, _DoubleQs, _SingleQs, [[]]) --> [].
split_element(SplitCodes, DoubleQs, SingleQs, Strings, C) -->
{ member( C, SingleQs ) },
!,
[C2],
{ Strings = [[C2|String]|More] },
split_element(SplitCodes, DoubleQs, SingleQs, [String| More]).
split_element(SplitCodes, DoubleQs, SingleQs, [[]|Strings], C) -->
{ member( C, SplitCodes ) },
!,
split_element(SplitCodes, DoubleQs, SingleQs, Strings).
split_element(SplitCodes, DoubleQs, SingleQs, Strings, C) -->
{ member( C, DoubleQs ) } ,
!,
split_within(SplitCodes, C-DoubleQs, SingleQs, Strings).
split_element(SplitCodes, DoubleQs, SingleQs, [[C|String]|Strings], C) -->
split_element(SplitCodes, DoubleQs, SingleQs, [String|Strings]).
split_within(SplitCodes, DoubleQs, SingleQs, Strings) -->
[C],
split_within(SplitCodes, DoubleQs, SingleQs, Strings, C).
split_within(SplitCodes, DoubleQs, SingleQs, Strings, C) -->
{ member( C, SingleQs ) },
!,
[C2],
{ Strings = [[C2|String]|More] },
split_within(SplitCodes, DoubleQs, SingleQs, [String| More]).
split_within(SplitCodes, DoubleQs, C-SingleQs, Strings, C) -->
!,
split_element(SplitCodes, DoubleQs, SingleQs, Strings).
split_within(SplitCodes, DoubleQs, SingleQs, [[C|String]|Strings], C) -->
split_within(SplitCodes, DoubleQs, SingleQs, [String|Strings]).
/** @pred split_unquoted(+ _Line_,+ _Separators_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the character codes in _Separators_ as separators, but treat text wi
thin double quotes as a single unit. As an
example, consider:
~~~~~{.prolog}
?- split("Hello * I \"am free\""," *",S).
S = ["Hello","I","am free"] ?
no
~~~~~
*/
split_unquoted(String, SplitCodes, Strings) :-
split_unquoted_at_blank(SplitCodes, Strings, String, []).
split_unquoted_at_blank(SplitCodes, [[0'"|New]|More]) --> %0'"
"\"",
split_quoted(New, More),
split_unquoted_at_blank(SplitCodes, More).
split_unquoted_at_blank(SplitCodes, More) -->
[C],
{ member(C, SplitCodes) }, !,
split_unquoted_at_blank(SplitCodes, More).
split_unquoted_at_blank(SplitCodes, [[C|New]| More]) -->
[C], !,
split_unquoted(SplitCodes, New, More).
split_unquoted_at_blank(_, []) --> [].
split_unquoted(SplitCodes, [], More) -->
[C],
{ member(C, SplitCodes) }, !,
split_unquoted_at_blank(SplitCodes, More).
split_unquoted(SplitCodes, [C|New], Set) -->
[C], !,
split_unquoted(SplitCodes, New, Set).
split_unquoted(_, [], []) --> [].
/** @pred split_quoted(+ _Line_,+ _Separators_, GroupQuotes, SingleQuotes, - _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the character codes in _Separators_ as separators, but treat text within quotes as a single unit. As an
example, consider:
~~~~~{.prolog}
?- split_quoted("Hello * I \"am free\""," *",S).
S = ["Hello","I","am free"] ?
no
~~~~~
*/
split_quoted( [0'"], _More) --> %0'"
"\"".
split_quoted( [0'\\ ,C|New], More) -->
%0'"
"\\",
[C],
split_quoted(New, More).
split_quoted( [C|New], More) --> %0'"
[C],
split_quoted(New, More).
/** @pred fields(+ _Line_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the blank characters as field separators.
*/
fields(String, Strings) :-
fields(" ", Strings, String, []).
/** @pred fields(+ _Line_,+ _Separators_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
using the character codes in _Separators_ as separators for
fields. If two separators occur in a row, the field is considered
empty. As an example, consider:
~~~~~{.prolog}
?- fields("Hello I am free"," *",S).
S = ["Hello","","I","am","","free"] ?
~~~~~
*/
fields(String, FieldsCodes, Strings) :-
dofields(FieldsCodes, First, More, String, []),
(
First = [], More = []
->
Strings = []
;
Strings = [First|More]
).
dofields(FieldsCodes, [], New.More) -->
[C],
{ member(C, FieldsCodes) }, !,
dofields(FieldsCodes, New, More).
dofields(FieldsCodes, [C|New], Set) -->
[C], !,
dofields(FieldsCodes, New, Set).
dofields(_, [], []) --> [].
/** @pred glue(+ _Words_,+ _Separator_,- _Line_)
Unify _Line_ with string obtained by glueing _Words_ with
the character code _Separator_.
*/
glue([], _, []).
glue([A], _, A) :- !.
glue([H|T], [B|_], Merged) :-
append(H, [B|Rest], Merged),
glue(T, [B], Rest).
/** @pred copy_line(+ _StreamInput_,+ _StreamOutput_)
Copy a line from _StreamInput_ to _StreamOutput_.
*/
copy_line(StreamInp, StreamOut) :-
read_line_to_codes(StreamInp, Line),
format(StreamOut, '~s~n', [Line]).
/** @pred filter(+ _StreamInp_, + _StreamOut_, + _Goal_)
For every line _LineIn_ in stream _StreamInp_, execute
`call(Goal,LineIn,LineOut)`, and output _LineOut_ to
stream _StreamOut_. If `call(Goal,LineIn,LineOut)` fails,
nothing will be output but execution continues with the next
line. As an example, consider a procedure to select the second and
fifth field of a CSV table :
~~~~~{.prolog}
select(Sep, In, Out) :-
fields(In, Sep, [_,F2,_,_,F5|_]),
fields(Out,Sep, [F2,F5]).
select :-
filter(",",
~~~~~
*/
filter(StreamInp, StreamOut, Command) :-
repeat,
read_line_to_codes(StreamInp, Line),
(
Line == end_of_file
->
!
;
call(Command, Line, NewLine),
ground(NewLine),
format(StreamOut, '~s~n', [NewLine]),
fail
).
/** @pred process(+ _StreamInp_, + _Goal_) is meta
For every line _LineIn_ in stream _StreamInp_, call
`call(Goal,LineIn)`.
*/
process(StreamInp, Command) :-
repeat,
read_line_to_codes(StreamInp, Line),
(
Line == end_of_file
->
!
;
call(Command, Line),
fail
).
/**
* @pred file_filter(+ _FileIn_, + _FileOut_, + _Goal_) is meta
*
* @param _FileIn_ File to process
* @param _FileOut_ Output file, often user_error
* @param _Goal_ to be metacalled, receives FileIn and FileOut as
* extra arguments
*
* @return succeeds
For every line _LineIn_ in file _FileIn_, execute
`call(Goal,LineIn,LineOut)`, and output _LineOut_ to file
_FileOut_.
The input stream is accessible through the alias `filter_input`, and
the output stream is accessible through `filter_output`.
*/
file_filter(Inp, Out, Command) :-
open(Inp, read, StreamInp, [alias(filter_input)]),
open(Out, write, StreamOut),
filter(StreamInp, StreamOut, Command),
close(StreamInp),
close(StreamOut).
/** @pred file_filter_with_initialization(+ _FileIn_, + _FileOut_, + _Goal_, + _FormatCommand_, + _Arguments_)
Same as file_filter/3, but before starting the filter execute
`format/3` on the output stream, using _FormatCommand_ and
_Arguments_.
*/
file_filter_with_initialization(Inp, Out, Command, FormatString, Parameters) :-
open(Inp, read, StreamInp, [alias(filter_input)]),
open(Out, write, StreamOut, [alias(filter_output)]),
format(StreamOut, FormatString, Parameters),
filter(StreamInp, StreamOut, Command),
close(StreamInp),
close(StreamOut).
/** @pred file_filter_with_start_end(+ FileIn, + FileOut, + Goal, + StartGoal, + EndGoal)
Same as file_filter/3, but before starting the filter execute
_StartGoal_, and call _ENdGoal_ as an epilog.
The input stream are always accessible through `filter_output` and `filter_input`.
*/
file_filter_with_start_end(Inp, Out, Command, StartGoal, EndGoal) :-
open(Inp, read, StreamInp, [alias(filter_input)]),
open(Out, write, StreamOut, [alias(filter_output)]),
call( StartGoal, StreamInp, StreamOut ),
filter(StreamInp, StreamOut, Command),
call( EndGoal, StreamInp, StreamOut ),
close(StreamInp),
close(StreamOut).
/**
* @pred file_select(+ _FileIn_, + _Goal_) is meta
*
* @param _FileIn_ File to process
* @param _Goal_ to be metacalled, receives FileIn as
* extra arguments
*
* @return bindings to arguments of _Goal_.
For every line _LineIn_ in file _FileIn_, execute
`call(`Goal,LineIn)`.
The input stream is accessible through the alias `filter_input`, and
the output stream is accessible through `filter_output`.
*/
file_select(Inp, Command) :-
( retract(alias(F)) -> true ; F = '' ),
atom_concat(filter_input, F, Alias),
open(Inp, read, StreamInp, [Alias]),
atom_concat('_', F, NF),
assert( alias(NF) ),
repeat,
read_line_to_codes(StreamInp, Line),
(
Line == end_of_file
->
close(StreamInp),
retract(alias(NF)),
assert(alias(F)),
!,
atom_concat(filter_input, F, Alias),
fail
;
call(Command, Line)
).
/**
@}
*/

50
packages/python/swig/yap4py/prolog/listing.yap
View File

@ -1,50 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: listing.yap *
* Last rev: *
* mods: *
* comments: listing a prolog program *
* *
*************************************************************************/
/**
* @file library/listing.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 22:03:59 2015
*
* @brief Emulate SWI Prolog's listing.
*
*
*/
:- module(swi_listing,
[ listing/0,
listing/1,
portray_clause/1, % +Clause
portray_clause/2, % +Stream, +Clause
portray_clause/3 % +Stream, +Clause, +Options
]).
/*
* @defgroup swi_listing SWI Prolog listing emulation
* @ingroup library
emulates listing.pl, but just the interface for now.
*/
:- meta_predicate portray_clause( +, + , : ).
portray_clause(Stream, Term, M:Options) :-
portray_clause( Stream, Term ).

630
packages/python/swig/yap4py/prolog/lists.yap
View File

@ -1,630 +0,0 @@
/**
* @file library/lists.yap
* @author Bob Welham, Lawrence Byrd, and R. A. O'Keefe. Contributions from Vitor Santos Costa, Jan Wielemaker and others.
* @date 1999
*
* @addtogroup lists The Prolog Library
*
* @ingroup library
*
* @{
*
* @brief List Manipulation Predicates
*
*
*/
% This file has been included as an YAP library by Vitor Santos Costa, 1999
:- module(lists,
[
append/3,
append/2,
delete/3,
intersection/3,
flatten/2,
last/2,
list_concat/2,
max_list/2,
list_to_set/2,
member/2,
memberchk/2,
min_list/2,
nextto/3,
nth/3,
nth/4,
nth0/3,
nth0/4,
nth1/3,
nth1/4,
numlist/3,
permutation/2,
prefix/2,
remove_duplicates/2,
reverse/2,
same_length/2,
select/3,
selectchk/3,
sublist/2,
substitute/4,
subtract/3,
suffix/2,
sum_list/2,
sum_list/3,
sumlist/2
]).
/** @defgroup lists List Manipulation
@ingroup library
@{
The following list manipulation routines are available once included
with the `use_module(library(lists))` command.
*/
/** @pred list_concat(+ _Lists_,? _List_)
True when _Lists_ is a list of lists and _List_ is the
concatenation of _Lists_.
*/
/** @pred max_list(? _Numbers_, ? _Max_)
True when _Numbers_ is a list of numbers, and _Max_ is the maximum.
*/
/** @pred min_list(? _Numbers_, ? _Min_)
True when _Numbers_ is a list of numbers, and _Min_ is the minimum.
*/
/** @pred nth(? _N_, ? _List_, ? _Elem_)
The same as nth1/3.
*/
/** @pred nth(? _N_, ? _List_, ? _Elem_, ? _Rest_)
Same as `nth1/4`.
*/
/** @pred nth0(? _N_, ? _List_, ? _Elem_)
True when _Elem_ is the Nth member of _List_,
counting the first as element 0. (That is, throw away the first
N elements and unify _Elem_ with the next.) It can only be used to
select a particular element given the list and index. For that
task it is more efficient than member/2
*/
/** @pred nth0(? _N_, ? _List_, ? _Elem_, ? _Rest_)
Unifies _Elem_ with the Nth element of _List_,
counting from 0, and _Rest_ with the other elements. It can be used
to select the Nth element of _List_ (yielding _Elem_ and _Rest_), or to
insert _Elem_ before the Nth (counting from 1) element of _Rest_, when
it yields _List_, e.g. `nth0(2, List, c, [a,b,d,e])` unifies List with
`[a,b,c,d,e]`. `nth/4` is the same except that it counts from 1. `nth0/4`
can be used to insert _Elem_ after the Nth element of _Rest_.
*/
/** @pred nth1(+ _Index_,? _List_,? _Elem_)
Succeeds when the _Index_-th element of _List_ unifies with
_Elem_. Counting starts at 1.
Set environment variable. _Name_ and _Value_ should be
instantiated to atoms or integers. The environment variable will be
passed to `shell/[0-2]` and can be requested using `getenv/2`.
They also influence expand_file_name/2.
*/
/** @pred nth1(? _N_, ? _List_, ? _Elem_)
The same as nth0/3, except that it counts from
1, that is `nth(1, [H|_], H)`.
*/
/** @pred nth1(? _N_, ? _List_, ? _Elem_, ? _Rest_)
Unifies _Elem_ with the Nth element of _List_, counting from 1,
and _Rest_ with the other elements. It can be used to select the
Nth element of _List_ (yielding _Elem_ and _Rest_), or to
insert _Elem_ before the Nth (counting from 1) element of
_Rest_, when it yields _List_, e.g. `nth(3, List, c, [a,b,d,e])` unifies List with `[a,b,c,d,e]`. `nth/4`
can be used to insert _Elem_ after the Nth element of _Rest_.
*/
/** @pred numlist(+ _Low_, + _High_, + _List_)
If _Low_ and _High_ are integers with _Low_ =<
_High_, unify _List_ to a list `[Low, Low+1, ...High]`. See
also between/3.
*/
/** @pred permutation(+ _List_,? _Perm_)
True when _List_ and _Perm_ are permutations of each other.
*/
/** @pred remove_duplicates(+ _List_, ? _Pruned_)
Removes duplicated elements from _List_. Beware: if the _List_ has
non-ground elements, the result may surprise you.
*/
/** @pred same_length(? _List1_, ? _List2_)
True when _List1_ and _List2_ are both lists and have the same number
of elements. No relation between the values of their elements is
implied.
Modes `same_length(-,+)` and `same_length(+,-)` generate either list given
the other; mode `same_length(-,-)` generates two lists of the same length,
in which case the arguments will be bound to lists of length 0, 1, 2, ...
*/
%% @pred append(? _Lists_,? _Combined_)
%
% Concatenate a list of lists. Is true if Lists is a list of
% lists, and List is the concatenation of these lists.
%
% @param ListOfLists must be a list of -possibly- partial lists
append(ListOfLists, List) :-
% must_be(list, ListOfLists),
append_(ListOfLists, List).
append_([], []).
append_([L], L).
append_([L1,L2], L) :-
append(L1,L2,L).
append_([L1,L2|[L3|LL]], L) :-
append(L1,L2,LI),
append_([LI|[L3|LL]],L).
/** @pred last(+ _List_,? _Last_)
True when _List_ is a list and _Last_ is identical to its last element.
d(_, [X], L).
*/
last([H|List], Last) :-
last(List, H, Last).
last([], Last, Last).
last([H|List], _, Last) :-
last(List, H, Last).
% nextto(X, Y, List)
% is true when X and Y appear side-by-side in List. It could be written as
% nextto(X, Y, List) :- append(_, [X,Y,_], List).
% It may be used to enumerate successive pairs from the list.
nextto(X,Y, [X,Y|_]).
nextto(X,Y, [_|List]) :-
nextto(X,Y, List).
% nth0(?N, +List, ?Elem) is true when Elem is the Nth member of List,
% counting the first as element 0. (That is, throw away the first
% N elements and unify Elem with the next.) It can only be used to
% select a particular element given the list and index. For that
% task it is more efficient than nmember.
% nth(+N, +List, ?Elem) is the same as nth0, except that it counts from
% 1, that is nth(1, [H|_], H).
nth0(V, In, Element) :- var(V), !,
generate_nth(0, V, In, Element).
nth0(0, [Head|_], Head) :- !.
nth0(N, [_|Tail], Elem) :-
M is N-1,
find_nth0(M, Tail, Elem).
find_nth0(0, [Head|_], Head) :- !.
find_nth0(N, [_|Tail], Elem) :-
M is N-1,
find_nth0(M, Tail, Elem).
nth1(V, In, Element) :- var(V), !,
generate_nth(1, V, In, Element).
nth1(1, [Head|_], Head) :- !.
nth1(N, [_|Tail], Elem) :-
nonvar(N), !,
M is N-1, % should be succ(M, N)
find_nth(M, Tail, Elem).
nth(V, In, Element) :- var(V), !,
generate_nth(1, V, In, Element).
nth(1, [Head|_], Head) :- !.
nth(N, [_|Tail], Elem) :-
nonvar(N), !,
M is N-1, % should be succ(M, N)
find_nth(M, Tail, Elem).
find_nth(1, [Head|_], Head) :- !.
find_nth(N, [_|Tail], Elem) :-
M is N-1,
find_nth(M, Tail, Elem).
generate_nth(I, I, [Head|_], Head).
generate_nth(I, IN, [_|List], El) :-
I1 is I+1,
generate_nth(I1, IN, List, El).
% nth0(+N, ?List, ?Elem, ?Rest) unifies Elem with the Nth element of List,
% counting from 0, and Rest with the other elements. It can be used
% to select the Nth element of List (yielding Elem and Rest), or to
% insert Elem before the Nth (counting from 1) element of Rest, when
% it yields List, e.g. nth0(2, List, c, [a,b,d,e]) unifies List with
% [a,b,c,d,e]. nth is the same except that it counts from 1. nth
% can be used to insert Elem after the Nth element of Rest.
nth0(V, In, Element, Tail) :- var(V), !,
generate_nth(0, V, In, Element, Tail).
nth0(0, [Head|Tail], Head, Tail) :- !.
nth0(N, [Head|Tail], Elem, [Head|Rest]) :-
M is N-1,
nth0(M, Tail, Elem, Rest).
find_nth0(0, [Head|Tail], Head, Tail) :- !.
find_nth0(N, [Head|Tail], Elem, [Head|Rest]) :-
M is N-1,
find_nth0(M, Tail, Elem, Rest).
nth1(V, In, Element, Tail) :- var(V), !,
generate_nth(1, V, In, Element, Tail).
nth1(1, [Head|Tail], Head, Tail) :- !.
nth1(N, [Head|Tail], Elem, [Head|Rest]) :-
M is N-1,
nth1(M, Tail, Elem, Rest).
nth(V, In, Element, Tail) :- var(V), !,
generate_nth(1, V, In, Element, Tail).
nth(1, [Head|Tail], Head, Tail) :- !.
nth(N, [Head|Tail], Elem, [Head|Rest]) :-
M is N-1,
nth(M, Tail, Elem, Rest).
find_nth(1, [Head|Tail], Head, Tail) :- !.
find_nth(N, [Head|Tail], Elem, [Head|Rest]) :-
M is N-1,
find_nth(M, Tail, Elem, Rest).
generate_nth(I, I, [Head|Tail], Head, Tail).
generate_nth(I, IN, [E|List], El, [E|Tail]) :-
I1 is I+1,
generate_nth(I1, IN, List, El, Tail).
% permutation(List, Perm)
% is true when List and Perm are permutations of each other. Of course,
% if you just want to test that, the best way is to keysort/2 the two
% lists and see if the results are the same. Or you could use list_to_bag
% (from BagUtl.Pl) to see if they convert to the same bag. The point of
% perm is to generate permutations. The arguments may be either way round,
% the only effect will be the order in which the permutations are tried.
% Be careful: this is quite efficient, but the number of permutations of an
% N-element list is N!, even for a 7-element list that is 5040.
permutation([], []).
permutation(List, [First|Perm]) :-
select(First, List, Rest), % tries each List element in turn
permutation(Rest, Perm).
% prefix(Part, Whole) iff Part is a leading substring of Whole
prefix([], _).
prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
prefix(Rest_of_part, Rest_of_whole).
% remove_duplicates(List, Pruned)
% removes duplicated elements from List. Beware: if the List has
% non-ground elements, the result may surprise you.
remove_duplicates([], []).
remove_duplicates([Elem|L], [Elem|NL]) :-
delete(L, Elem, Temp),
remove_duplicates(Temp, NL).
% reverse(List, Reversed)
% is true when List and Reversed are lists with the same elements
% but in opposite orders. rev/2 is a synonym for reverse/2.
reverse(List, Reversed) :-
reverse(List, [], Reversed).
reverse([], Reversed, Reversed).
reverse([Head|Tail], Sofar, Reversed) :-
reverse(Tail, [Head|Sofar], Reversed).
% same_length(?List1, ?List2)
% is true when List1 and List2 are both lists and have the same number
% of elements. No relation between the values of their elements is
% implied.
% Modes same_length(-,+) and same_length(+,-) generate either list given
% the other; mode same_length(-,-) generates two lists of the same length,
% in which case the arguments will be bound to lists of length 0, 1, 2, ...
same_length([], []).
same_length([_|List1], [_|List2]) :-
same_length(List1, List2).
/** @pred selectchk(? _Element_, ? _List_, ? _Residue_)
Semi-deterministic selection from a list. Steadfast: defines as
~~~~~{.prolog}
selectchk(Elem, List, Residue) :-
select(Elem, List, Rest0), !,
Rest = Rest0.
~~~~~
*/
selectchk(Elem, List, Rest) :-
select(Elem, List, Rest0), !,
Rest = Rest0.
/** @pred select(? _Element_, ? _List_, ? _Residue_)
True when _Set_ is a list, _Element_ occurs in _List_, and
_Residue_ is everything in _List_ except _Element_ (things
stay in the same order).
*/
select(Element, [Element|Rest], Rest).
select(Element, [Head|Tail], [Head|Rest]) :-
select(Element, Tail, Rest).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sublist(?Sub, +List) is nondet.
%
% True if all elements of Sub appear in List in the same order.
%
% ALlo, both `append(_,Sublist,S)` and `append(S,_,List)` hold.
sublist(L, L).
sublist(Sub, [H|T]) :-
'$sublist1'(T, H, Sub).
'$sublist1'(Sub, _, Sub).
'$sublist1'([H|T], _, Sub) :-
'$sublist1'(T, H, Sub).
'$sublist1'([H|T], X, [X|Sub]) :-
'$sublist1'(T, H, Sub).
% substitute(X, XList, Y, YList)
% is true when XList and YList only differ in that the elements X in XList
% are replaced by elements Y in the YList.
substitute(X, XList, Y, YList) :-
substitute2(XList, X, Y, YList).
substitute2([], _, _, []).
substitute2([X0|XList], X, Y, [Y|YList]) :-
X == X0, !,
substitute2(XList, X, Y, YList).
substitute2([X0|XList], X, Y, [X0|YList]) :-
substitute2(XList, X, Y, YList).
/** @pred suffix(? _Suffix_, ? _List_)
Holds when `append(_,Suffix,List)` holds.
*/
suffix(Suffix, Suffix).
suffix(Suffix, [_|List]) :-
suffix(Suffix,List).
/** @pred sumlist(? _Numbers_, ? _Total_)
True when _Numbers_ is a list of integers, and _Total_ is their
sum. The same as sum_list/2, please do use sum_list/2
instead.
*/
sumlist(Numbers, Total) :-
sumlist(Numbers, 0, Total).
/** @pred sum_list(? _Numbers_, + _SoFar_, ? _Total_)
True when _Numbers_ is a list of numbers, and _Total_ is the sum of their total plus _SoFar_.
*/
sum_list(Numbers, SoFar, Total) :-
sumlist(Numbers, SoFar, Total).
/** @pred sum_list(? _Numbers_, ? _Total_)
True when _Numbers_ is a list of numbers, and _Total_ is their sum.
*/
sum_list(Numbers, Total) :-
sumlist(Numbers, 0, Total).
sumlist([], Total, Total).
sumlist([Head|Tail], Sofar, Total) :-
Next is Sofar+Head,
sumlist(Tail, Next, Total).
% list_concat(Lists, List)
% is true when Lists is a list of lists, and List is the
% concatenation of these lists.
list_concat([], []).
list_concat([H|T], L) :-
list_concat(H, L, Li),
list_concat(T, Li).
list_concat([], L, L).
list_concat([H|T], [H|Lf], Li) :-
list_concat(T, Lf, Li).
/** @pred flatten(+ _List_, ? _FlattenedList_)
Flatten a list of lists _List_ into a single list
_FlattenedList_.
~~~~~{.prolog}
?- flatten([[1],[2,3],[4,[5,6],7,8]],L).
L = [1,2,3,4,5,6,7,8] ? ;
no
~~~~~
*/
flatten(X,Y) :- flatten_list(X,Y,[]).
flatten_list(V) --> {var(V)}, !, [V].
flatten_list([]) --> !.
flatten_list([H|T]) --> !, flatten_list(H),flatten_list(T).
flatten_list(H) --> [H].
max_list([H|L],Max) :-
max_list(L,H,Max).
max_list([],Max,Max).
max_list([H|L],Max0,Max) :-
(
H > Max0
->
max_list(L,H,Max)
;
max_list(L,Max0,Max)
).
min_list([H|L],Max) :-
min_list(L,H,Max).
min_list([],Max,Max).
min_list([H|L],Max0,Max) :-
(
H < Max0
->
min_list(L, H, Max)
;
min_list(L, Max0, Max)
).
%% numlist(+Low, +High, -List) is semidet.
%
% List is a list [Low, Low+1, ... High]. Fails if High < Low.%
%
% @error type_error(integer, Low)
% @error type_error(integer, High)
numlist(L, U, Ns) :-
must_be(integer, L),
must_be(integer, U),
L =< U,
numlist_(L, U, Ns).
numlist_(U, U, OUT) :- !, OUT = [U].
numlist_(L, U, [L|Ns]) :-
succ(L, L2),
numlist_(L2, U, Ns).
/** @pred intersection(+ _Set1_, + _Set2_, + _Set3_)
Succeeds if _Set3_ unifies with the intersection of _Set1_ and
_Set2_. _Set1_ and _Set2_ are lists without duplicates. They
need not be ordered.
The code was copied from SWI-Prolog's list library.
*/
% copied from SWI lists library.
intersection([], _, []) :- !.
intersection([X|T], L, Intersect) :-
memberchk(X, L), !,
Intersect = [X|R],
intersection(T, L, R).
intersection([_|T], L, R) :-
intersection(T, L, R).
%% subtract(+Set, +Delete, -Result) is det.
%
% Delete all elements from `Set' that occur in `Delete' (a set)
% and unify the result with `Result'. Deletion is based on
% unification using memberchk/2. The complexity is |Delete|*|Set|.
%
% @see ord_subtract/3.
subtract([], _, []) :- !.
subtract([E|T], D, R) :-
memberchk(E, D), !,
subtract(T, D, R).
subtract([H|T], D, [H|R]) :-
subtract(T, D, R).
%% list_to_set(+List, ?Set) is det.
%
% True when Set has the same element as List in the same order.
% The left-most copy of the duplicate is retained. The complexity
% of this operation is |List|^2.
%
% @see sort/2.
list_to_set(List, Set) :-
list_to_set_(List, Set0),
Set = Set0.
list_to_set_([], R) :-
close_list(R).
list_to_set_([H|T], R) :-
memberchk(H, R), !,
list_to_set_(T, R).
close_list([]) :- !.
close_list([_|T]) :-
close_list(T).
%% @}
/** @} */

188
packages/python/swig/yap4py/prolog/log2md.yap
View File

@ -1,188 +0,0 @@
/**
* @file log2md.yap
* @author Vitor Santos Costa
*
*
*/
:- op(650,yfx, <-- ),
op(650,yfx, <-* ).
:- module( log2md,
[open_log/1,
log_title/1,
log_section/1,
log_subsection/1,
log_paragraph/1,
log_unit/2,
(<--)/2,
(<-*)/2,
log_goal/1,
log_goal/1 as log_clause,
out/1,
out/2,
outln/1,
outln/2] ).
:- use_module( library( maplist) ).
/**
*
*
* @defgroup Log2MD Log Output of Tests in Markdown format.
*
* @ingroup Regression System Tests
*
* These primitives support writing a user-specified log of execution to an
* output file. The output file can be used for testing or debugging.
*
* Primitives include the ability to write a title, a Prolog clause or
* goal, and hooks for tracing calls. The log_goal/2 can be used to
* start a goal. Arguments of the form `<--/2` and `*->/2` can be used to
* track calls.
*
* The output format is markdown.
*/
open_log(F) :-
open( F, write, _Out, [alias(log)]).
/**
* @pred log_title( +String ) is det
*
* @param [in] S is a Prolog atom or string describing a title.
*
*/
log_title( S ) :-
out( '## Report on ~a~n~n', [S]).
/**
* @pred log_section( +String ) is det
*
* @param [in] S is a Prolog atom or string describing a title.
*
*/
log_section( S ) :-
out( '### Report on ~a~n~n', [S]).
/**
* @pred log_section( +String ) is det
*
* @param [in] S is a Prolog atom or string describing a title.
*
*/
log_subsection( S ) :-
out( '#### Report on ~a~n~n', [S]).
/**
* @pred log_section( +String ) is det
*
* @param [in] S is a Prolog atom or string describing a title.
*
*/
log_paragraph( S ) :-
out( '##### Report on ~a~n~n', [S]).
/**
* @pred log_unit( +String, + Level ) is det
*
* @param [in] _String_ is a Prolog atom or string describing a title
* @param [in] _Level_ is an integer number larager than 1 (do notice that )
*large numbers may be ignored ).
*
*
*/
log_unit( S ) :-
out( '## Report on ~a~n~n', [S]).
/**
* @pred clause( +Term ) is det
*
* @param [in] Term is a Prolog clause or goal that it is going to
* be printed out using portray_clause/2.
*
*/
log_goal( DecoratedClause ) :-
take_decorations(DecoratedClause, Clause),
out( '~~~~~~~~{.prolog}~n'),
portray_clause( user_error , Clause ),
portray_clause( log , Clause ),
out( '~~~~~~~~~n', []).
take_decorations( G, G ) :-
var(G),
!.
take_decorations(_ <-- G, NG ) :-
!,
take_decorations( G, NG ).
take_decorations(_ <-* G, NG ) :-
!,
take_decorations( G, NG ).
take_decorations(G, NG ) :-
G =.. [F|Args],
maplist( take_decorations, Args, NArgs ),
NG =.. [F|NArgs].
:- meta_predicate ( + <-- 0 ),
( + <-* 0 ).
/**
* @pred log_goal( +Tag , :Goal )
*
* @param [in] evaluate goal _Goal_ with output before,
* during and after the goal has been evaluated.
*
*/
A <-* Goal :-
(
outln(A),
log_goal( Goal ),
call( Goal )
*->
out('succeded as~n'), log_goal(Goal)
;
out( 'failed~n'),
fail
).
/**
* @pred `<--`( +Tag , :Goal )
*
* @param [in] output goal _Goal_ before and after being evaluated, but only
* taking the first solution. The _Tag_ must be an atom or a string.
*
*/
Tag <-- Goal :-
(
outln(Tag),
log_goal( Goal ),
call( Goal )
->
out('succeded as~n'),
log_goal(Goal),
fail
;
out(failed)
).
/**
* @pred out(+Format, +Args)
*
* @param [in] format the string given Args . The output is sent to
* user_error and to a stream with alias `log`;
*
*/
out(Format, Args) :-
format( log, Format, Args),
format( user_error, Format, Args).
out(Format) :-
format( log, Format, []),
format( user_error, Format, []).
outln(Format, Args) :-
out(Format, Args), out('~n').
outln(Format) :-
out(Format), out('~n').

384
packages/python/swig/yap4py/prolog/mapargs.yap
View File

@ -1,384 +0,0 @@
/**
* @file library/mapargs.yap
* @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa
* @date 4 August 1984 and Ken Johnson 11-8-87
*
* @brief Macros to apply a predicate to all sub-terms of a term.
*
*
*/
:- module(mapargs,[ mapargs/2, % :Goal, +S
mapargs/3, % :Goal, +S, -S
mapargs/4, % :Goal, +S, -S1, -S2
mapargs/5, % :Goal, +S, -S1, -S2, -S3
mapargs/6, % :Goal, +S, -S1, -S2, -S3, -S4
sumargs/4,
foldargs/4, % :Pred, +S, ?V0, ?V
foldargs/5, % :Pred, +S, ?S1, ?V0, ?V
foldargs/6, % :Pred, +S, ?S1, ?S2, ?V0, ?V
foldargs/7 % :Pred, +S, ?S1, ?S2, ?S3, ?V0, ?V
]).
/**
* @defgroup mapargs Apply a predicate to all arguments of a term
* @ingroup library
*/
:- use_module(library(maputils)).
:- use_module(library(lists), [append/3]).
:- meta_predicate
mapargs(1,+),
mapargs_args(1,+,+),
mapargs(2,+,-),
mapargs_args(2,+,-,+),
mapargs(3,+,-,-),
mapargs_args(2,+,-,-,+),
mapargs(4,+,-,-,-),
mapargs_args(2,+,-,-,-,+),
mapargs(5,+,-,-,-,-),
mapargs_args(2,+,-,-,-,-,+),
sumargs(3,+,+,-),
sumargs_args(3,+,+,-,+),
foldargs(3, +, +, -),
foldargs(4, +, ?, +, -),
foldargs(5, +, ?, ?, +, -),
foldargs(6, +, ?, ?, ?, +, -).
mapargs(Pred, TermIn) :-
functor(TermIn, _F, N),
mapargs_args(Pred, TermIn, 0, N).
mapargs_args(Pred, TermIn, I, N) :-
( I == N -> true ;
I1 is I+1,
arg(I1, TermIn, InArg),
call(Pred, InArg),
mapargs_args(Pred, TermIn, I1, N) ).
mapargs(Pred, TermIn, TermOut) :-
functor(TermIn, F, N),
functor(TermOut, F, N),
mapargs_args(Pred, TermIn, TermOut, 0, N).
mapargs_args(Pred, TermIn, TermOut, I, N) :-
( I == N -> true ;
I1 is I+1,
arg(I1, TermIn, InArg),
arg(I1, TermOut, OutArg),
call(Pred, InArg, OutArg),
mapargs_args(Pred, TermIn, TermOut, I1, N) ).
mapargs(Pred, TermIn, TermOut1, TermOut2) :-
functor(TermIn, F, N),
functor(TermOut1, F, N),
functor(TermOut2, F, N),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, 0, N).
mapargs_args(Pred, TermIn, TermOut1, TermOut2, I, N) :-
( I == N -> true ;
I1 is I+1,
arg(I1, TermIn, InArg),
arg(I1, TermOut1, OutArg1),
arg(I1, TermOut2, OutArg2),
call(Pred, InArg, OutArg1, OutArg2),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, I1, N) ).
mapargs(Pred, TermIn, TermOut1, TermOut2, TermOut3) :-
functor(TermIn, F, N),
functor(TermOut1, F, N),
functor(TermOut2, F, N),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, 0, N).
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, I, N) :-
( I == N -> true ;
I1 is I+1,
arg(I1, TermIn, InArg),
arg(I1, TermOut1, OutArg1),
arg(I1, TermOut2, OutArg2),
arg(I1, TermOut3, OutArg3),
call(Pred, InArg, OutArg1, OutArg2, OutArg3),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, I1, N) ).
mapargs(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4) :-
functor(TermIn, F, N),
functor(TermOut1, F, N),
functor(TermOut2, F, N),
functor(TermOut3, F, N),
functor(TermOut4, F, N),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, 0, N).
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, I, N) :-
( I == 0 -> true ;
I1 is I+1,
arg(I1, TermIn, InArg),
arg(I1, TermOut1, OutArg1),
arg(I1, TermOut2, OutArg2),
arg(I1, TermOut3, OutArg3),
arg(I1, TermOut4, OutArg4),
call(Pred, InArg, OutArg1, OutArg2, OutArg3, OutArg4),
mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, I1, N) ).
sumargs(Pred, Term, A0, A1) :-
functor(Term, _, N),
sumargs(Pred, Term, A0, A1, N).
sumargs_args(_, _, A0, A1, 0) :-
!,
A0 = A1.
sumargs_args(Pred, Term, A1, A3, N) :-
arg(N, Term, Arg),
N1 is N - 1,
call(Pred, Arg, A1, A2),
sumargs_args(Pred, Term, A2, A3, N1).
foldargs(Goal, S, V0, V) :-
functor(S, _, Ar),
foldargs_(Goal, S, V0, V, 0, Ar).
foldargs_(Goal, S, V0, V, I, N) :-
( I == N -> V0 = V ;
I1 is I+1,
arg(I1, S, A),
call(Goal, A, V0, V1),
foldargs_(Goal, S, V1, V, I1, N) ).
foldargs(Goal, S, O1, V0, V) :-
functor(S, N, Ar),
functor(O1, N, Ar),
foldargs_(Goal, S, O1, V0, V, 0, Ar).
foldargs_(Goal, S, O1, V0, V, I, N) :-
( I == N -> V0 = V ;
I1 is I+1,
arg(I1, S, A),
arg(I1, O1, A1),
call(Goal, A, A1, V0, V1),
foldargs_(Goal, S, O1, V1, V, I1, N) ).
foldargs(Goal, S, O1, O2, V0, V) :-
functor(S, N, Ar),
functor(O1, N, Ar),
functor(O2, N, Ar),
foldargs_(Goal, S, O1, O2, V0, V, 0, Ar).
foldargs_(Goal, S, O1, O2, V0, V, I, N) :-
( I == N -> V0 = V ;
I1 is I+1,
arg(I1, S, A),
arg(I1, O1, A1),
arg(I1, O2, A2),
call(Goal, A, A1, A2, V0, V1),
foldargs_(Goal, S, O1, O2, V1, V, I1, N) ).
foldargs(Goal, S, O1, O2, O3, V0, V) :-
functor(S, N, Ar),
functor(O1, N, Ar),
functor(O2, N, Ar),
functor(O3, N, Ar),
foldargs_(Goal, S, O1, O2, O3, V0, V, 0, Ar).
foldargs_(Goal, S, O1, O2, O3, V0, V, I, N) :-
( I == N -> V0 = V ;
I1 is I+1,
arg(I1, S, A),
arg(I1, O1, A1),
arg(I1, O2, A2),
arg(I1, O3, A3),
call(Goal, A, A1, A2, A3, V0, V1),
foldargs_(Goal, S, O1, O2, O3, V1, V, I1, N) ).
goal_expansion(mapargs(Meta, In), (functor(In, _Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(mapargs, 1, Proto, GoalName),
append(MetaVars, [In, 0, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, I, Ar], RecursionHead),
append_args(Pred, [AIn], Apply),
append_args(HeadPrefix, [In, I1, Ar], RecursiveCall),
compile_aux([
(RecursionHead :- I == 0 -> true ; I1 is I+1, arg(I1, In, AIn), Apply, RecursiveCall )
], Mod).
goal_expansion(mapargs(Meta, In, Out), (functor(In, Name, Ar), functor(Out, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(mapargs, 2, Proto, GoalName),
append(MetaVars, [In, Out, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out, I], RecursionHead),
append_args(Pred, [AIn, AOut], Apply),
append_args(HeadPrefix, [In, Out, I1], RecursiveCall),
compile_aux([
(RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out, AOut), Apply, I1 is I-1, RecursiveCall )
], Mod).
goal_expansion(mapargs(Meta, In, Out1, Out2), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(mapargs, 3, Proto, GoalName),
append(MetaVars, [In, Out1, Out2, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, Out2, I], RecursionHead),
append_args(Pred, [AIn, AOut1, AOut2], Apply),
append_args(HeadPrefix, [In, Out1, Out2, I1], RecursiveCall),
compile_aux([
(RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), Apply, I1 is I-1, RecursiveCall )
], Mod).
goal_expansion(mapargs(Meta, In, Out1, Out2, Out3), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out3, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(mapargs, 4, Proto, GoalName),
append(MetaVars, [In, Out1, Out2, Out3, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, Out2, Out3, I], RecursionHead),
append_args(Pred, [AIn, AOut1, AOut2, AOut3], Apply),
append_args(HeadPrefix, [In, Out1, Out2, Out3, I1], RecursiveCall),
compile_aux([
(RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), arg(I, Out3, AOut3), Apply, I1 is I-1, RecursiveCall )
], Mod).
goal_expansion(mapargs(Meta, In, Out1, Out2, Out3, Out4), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out3, Name, Ar), functor(Out4, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(mapargs, 4, Proto, GoalName),
append(MetaVars, [In, Out1, Out2, Out3, Out4, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, Out2, Out3, Out4, I], RecursionHead),
append_args(Pred, [AIn, AOut1, AOut2, AOut3, AOut4], Apply),
append_args(HeadPrefix, [In, Out1, Out2, Out3, Out4, I1], RecursiveCall),
compile_aux([
(RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), arg(I, Out3, AOut3), arg(I, Out4, AOut4), Apply, I1 is I-1, RecursiveCall )
], Mod).
goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
prolog_load_context(module, Mod),
Goal = (
Term =.. [_|TermArgs],
sumlist(Meta, TermArgs, AccIn, AccOut)
).
goal_expansion(foldargs(Meta, In, Acc0, AccF), (functor(In, _Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(foldargs, 1, Proto, GoalName),
append(MetaVars, [In, Acc0, AccF, 0, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, VAcc0, VAccF, I, Ar], RecursionHead),
append_args(Pred, [AIn, VAcc0, VAccI], Apply),
append_args(HeadPrefix, [In, VAccI, VAccF, I1, Ar], RecursiveCall),
compile_aux([
(RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), Apply, RecursiveCall )
], Mod).
goal_expansion(foldargs(Meta, In, Out1, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(foldargs, 2, Proto, GoalName),
append(MetaVars, [In, Out1, Acc0, AccF, 0, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, VAcc0, VAccF, I, Ar], RecursionHead),
append_args(Pred, [AIn, AOut1, VAcc0, VAccI], Apply),
append_args(HeadPrefix, [In, Out1, VAccI, VAccF, I1, Ar], RecursiveCall),
compile_aux([
(RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), Apply, RecursiveCall )
], Mod).
goal_expansion(foldargs(Meta, In, Out1, Out2, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(foldargs, 3, Proto, GoalName),
append(MetaVars, [In, Out1, Out2, Acc0, AccF, 0, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, Out2, VAcc0, VAccF, I, Ar], RecursionHead),
append_args(Pred, [AIn, AOut1, AOut2, VAcc0, VAccI], Apply),
append_args(HeadPrefix, [In, Out1, Out2, VAccI, VAccF, I1, Ar], RecursiveCall),
compile_aux([
(RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), arg(I1, Out2, AOut2), Apply, RecursiveCall )
], Mod).
goal_expansion(foldargs(Meta, In, Out1, Out2, Out3, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), functor(Out3, Name, Ar), Mod:Goal)) :-
goal_expansion_allowed,
callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
% the new goal
pred_name(foldargs, 4, Proto, GoalName),
append(MetaVars, [In, Out1, Out2, Out3, Acc0, AccF, 0, Ar], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
% the new predicate declaration
append_args(HeadPrefix, [In, Out1, Out2, Out3, VAcc0, VAccF, I, Ar], RecursionHead),
append_args(Pred, [AIn, AOut1, AOut2, AOut3, VAcc0, VAccI], Apply),
append_args(HeadPrefix, [In, Out1, Out2, Out3, VAccI, VAccF, I1, Ar], RecursiveCall),
compile_aux([
(RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), arg(I1, Out2, AOut2), arg(I1, Out3, AOut3), Apply, RecursiveCall )
], Mod).

1295
packages/python/swig/yap4py/prolog/maplist.yap
View File

File diff suppressed because it is too large Load Diff

106
packages/python/swig/yap4py/prolog/maputils.yap
View File

@ -1,106 +0,0 @@
/**
* @file maputils.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 22:48:58 2015
*
* @brief Auxiliary routines for map... libraries
*
*
*/
%%%%%%%%%%%%%%%%%%%%
% map utilities
%%%%%%%%%%%%%%%%%%%%
:- module(maputils,
[compile_aux/2,
goal_expansion_allowed/0,
pred_name/4,
aux_preds/5,
append_args/3]).
/**
* @addtogroup maplist
*
* Auxiliary routines
*
*@{
*/
:- use_module(library(lists), [append/3]).
:- dynamic number_of_expansions/1.
number_of_expansions(0).
%
% compile auxiliary routines for term expansion
%
compile_aux([Clause|Clauses], Module) :-
% compile the predicate declaration if needed
( Clause = (Head :- _)
; Clause = Head ),
!,
functor(Head, F, N),
( current_predicate(Module:F/N)
->
true
;
% format("*** Creating auxiliary predicate ~q~n", [F/N]),
% checklist(portray_clause, [Clause|Clauses]),
compile_term([Clause|Clauses], Module)
).
compile_term([], _).
compile_term([Clause|Clauses], Module) :-
assert_static(Module:Clause),
compile_term(Clauses, Module).
append_args(Term, Args, NewTerm) :-
Term =.. [Meta|OldArgs],
append(OldArgs, Args, GoalArgs),
NewTerm =.. [Meta|GoalArgs].
aux_preds(Meta, _, _, _, _) :-
var(Meta), !,
fail.
aux_preds(_:Meta, MetaVars, Pred, PredVars, Proto) :- !,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto).
aux_preds(Meta, MetaVars, Pred, PredVars, Proto) :-
Meta =.. [F|Args],
aux_args(Args, MetaVars, PredArgs, PredVars, ProtoArgs),
Pred =.. [F|PredArgs],
Proto =.. [F|ProtoArgs].
aux_args([], [], [], [], []).
aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
ground(Arg), !,
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
pred_name(Macro, Arity, _ , Name) :-
prolog_load_context(file, FullFileName),
file_base_name( FullFileName, File ),
prolog_load_context(term_position, Pos),
stream_position_data( line_count, Pos, Line ), !,
transformation_id(Id),
atomic_concat(['$$$ for ',Macro,'/',Arity,', line ',Line,' in ',File,' ',Id], Name).
pred_name(Macro, Arity, _ , Name) :-
transformation_id(Id),
atomic_concat(['$$$__expansion__ for ',Macro,'/',Arity,' ',Id], Name).
transformation_id(Id) :-
retract(number_of_expansions(Id)),
Id1 is Id+1,
assert(number_of_expansions(Id1)).
%% goal_expansion_allowed is semidet.
%
% `True` if we can use
% goal-expansion.
goal_expansion_allowed :-
once( prolog_load_context(_, _) ), % make sure we are compiling.
\+ current_prolog_flag(xref, true).
/**
@}
*/

328
packages/python/swig/yap4py/prolog/matlab.yap
View File

@ -1,328 +0,0 @@
/**
* @file matlab.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 22:51:48 2015
*
* @brief YAP Matlab interface.
*
*
*/
:- module(matlab,
[start_matlab/1,
close_matlab/0,
matlab_on/0,
matlab_eval_string/1,
matlab_eval_string/2,
matlab_cells/2,
matlab_cells/3,
matlab_initialized_cells/4,
matlab_zeros/2,
matlab_zeros/3,
matlab_zeros/4,
matlab_matrix/4,
matlab_vector/2,
matlab_vector/3,
matlab_set/4,
matlab_get_variable/2,
matlab_item/3,
matlab_item/4,
matlab_item1/3,
matlab_item1/4,
matlab_sequence/3,
matlab_call/2]).
/** @defgroup matlab MATLAB Package Interface
@ingroup library
@{
The MathWorks MATLAB is a widely used package for array
processing. YAP now includes a straightforward interface to MATLAB. To
actually use it, you need to install YAP calling `configure` with
the `--with-matlab=DIR` option, and you need to call
`use_module(library(lists))` command.
Accessing the matlab dynamic libraries can be complicated. In Linux
machines, to use this interface, you may have to set the environment
variable <tt>LD_LIBRARY_PATH</tt>. Next, follows an example using bash in a
64-bit Linux PC:
~~~~~
export LD_LIBRARY_PATH=''$MATLAB_HOME"/sys/os/glnxa64:''$MATLAB_HOME"/bin/glnxa64:''$LD_LIBRARY_PATH"
~~~~~
where `MATLAB_HOME` is the directory where matlab is installed
at. Please replace `ax64` for `x86` on a 32-bit PC.
*/
/*
@pred start_matlab(+ _Options_)
Start a matlab session. The argument _Options_ may either be the
empty string/atom or the command to call matlab. The command may fail.
*/
/** @pred close_matlab
Stop the current matlab session.
*/
/** @pred matlab_cells(+ _SizeX_, + _SizeY_, ? _Array_)
MATLAB will create an empty array of cells of size _SizeX_ and
_SizeY_, and if _Array_ is bound to an atom, store the array
in the matlab variable with name _Array_. Corresponds to the
MATLAB command `cells`.
*/
/** @pred matlab_cells(+ _Size_, ? _Array_)
MATLAB will create an empty vector of cells of size _Size_, and if
_Array_ is bound to an atom, store the array in the matlab
variable with name _Array_. Corresponds to the MATLAB command `cells`.
*/
/** @pred matlab_eval_string(+ _Command_)
Holds if matlab evaluated successfully the command _Command_.
*/
/** @pred matlab_eval_string(+ _Command_, - _Answer_)
MATLAB will evaluate the command _Command_ and unify _Answer_
with a string reporting the result.
*/
/** @pred matlab_get_variable(+ _MatVar_, - _List_)
Unify MATLAB variable _MatVar_ with the List _List_.
*/
/** @pred matlab_initialized_cells(+ _SizeX_, + _SizeY_, + _List_, ? _Array_)
MATLAB will create an array of cells of size _SizeX_ and
_SizeY_, initialized from the list _List_, and if _Array_
is bound to an atom, store the array in the matlab variable with name
_Array_.
*/
/** @pred matlab_item(+ _MatVar_, + _X_, + _Y_, ? _Val_)
Read or set MATLAB _MatVar_( _X_, _Y_) from/to _Val_. Use
`C` notation for matrix access (ie, starting from 0).
*/
/** @pred matlab_item(+ _MatVar_, + _X_, ? _Val_)
Read or set MATLAB _MatVar_( _X_) from/to _Val_. Use
`C` notation for matrix access (ie, starting from 0).
*/
/** @pred matlab_item1(+ _MatVar_, + _X_, + _Y_, ? _Val_)
Read or set MATLAB _MatVar_( _X_, _Y_) from/to _Val_. Use
MATLAB notation for matrix access (ie, starting from 1).
*/
/** @pred matlab_item1(+ _MatVar_, + _X_, ? _Val_)
Read or set MATLAB _MatVar_( _X_) from/to _Val_. Use
MATLAB notation for matrix access (ie, starting from 1).
*/
/** @pred matlab_matrix(+ _SizeX_, + _SizeY_, + _List_, ? _Array_)
MATLAB will create an array of floats of size _SizeX_ and _SizeY_,
initialized from the list _List_, and if _Array_ is bound to
an atom, store the array in the matlab variable with name _Array_.
*/
/** @pred matlab_on
Holds if a matlab session is on.
*/
/** @pred matlab_sequence(+ _Min_, + _Max_, ? _Array_)
MATLAB will create a sequence going from _Min_ to _Max_, and
if _Array_ is bound to an atom, store the sequence in the matlab
variable with name _Array_.
*/
/** @pred matlab_set(+ _MatVar_, + _X_, + _Y_, + _Value_)
Call MATLAB to set element _MatVar_( _X_, _Y_) to
_Value_. Notice that this command uses the MATLAB array access
convention.
*/
/** @pred matlab_vector(+ _Size_, + _List_, ? _Array_)
MATLAB will create a vector of floats of size _Size_, initialized
from the list _List_, and if _Array_ is bound to an atom,
store the array in the matlab variable with name _Array_.
*/
/** @pred matlab_zeros(+ _SizeX_, + _SizeY_, + _SizeZ_, ? _Array_)
MATLAB will create an array of zeros of size _SizeX_, _SizeY_,
and _SizeZ_. If _Array_ is bound to an atom, store the array
in the matlab variable with name _Array_. Corresponds to the
MATLAB command `zeros`.
*/
/** @pred matlab_zeros(+ _SizeX_, + _SizeY_, ? _Array_)
MATLAB will create an array of zeros of size _SizeX_ and
_SizeY_, and if _Array_ is bound to an atom, store the array
in the matlab variable with name _Array_. Corresponds to the
MATLAB command `zeros`.
*/
/** @pred matlab_zeros(+ _Size_, ? _Array_)
MATLAB will create a vector of zeros of size _Size_, and if
_Array_ is bound to an atom, store the array in the matlab
variable with name _Array_. Corresponds to the MATLAB command
`zeros`.
*/
:- ensure_loaded(library(lists)).
tell_warning :-
print_message(warning,functionality(matlab)).
:- ( catch(load_foreign_files([matlab], ['eng','mx','ut'], init_matlab),_,fail) -> true ; tell_warning).
matlab_eval_sequence(S) :-
atomic_concat(S,S1),
matlab_eval_string(S1).
matlab_eval_sequence(S,O) :-
atomic_concat(S,S1),
matlab_eval_string(S1,O).
matlab_vector( Vec, L) :-
length(Vec, LV),
matlab_vector(LV, Vec, L).
matlab_sequence(Min,Max,L) :-
mksequence(Min,Max,Vector),
Dim is (Max-Min)+1,
matlab_matrix(1,Dim,Vector,L).
mksequence(Min,Min,[Min]) :- !.
mksequence(Min,Max,[Min|Vector]) :-
Min1 is Min+1,
mksequence(Min1,Max,Vector).
matlab_call(S,Out) :-
S=..[Func|Args],
build_args(Args,L0,[]),
process_arg_entry(L0,L),
build_output(Out,Lf,['= ',Func|L]),
atomic_concat(Lf,Command),
matlab_eval_string(Command).
matlab_call(S,Out,Result) :-
S=..[Func|Args],
build_args(Args,L0,[]),
process_arg_entry(L0,L),
build_output(Out,Lf,[' = ',Func|L]),
atomic_concat(Lf,Command),
matlab_eval_string(Command,Result).
build_output(Out,['[ '|L],L0) :-
is_list(Out), !,
build_outputs(Out,L,[']'|L0]).
build_output(Out,Lf,L0) :-
build_arg(Out,Lf,L0).
build_outputs([],L,L).
build_outputs([Out|Outs],[Out,' '|L],L0) :-
build_outputs(Outs,L,L0).
build_args([],L,L).
build_args([Arg],Lf,L0) :- !,
build_arg(Arg,Lf,[')'|L0]).
build_args([Arg|Args],L,L0) :-
build_arg(Arg,L,[', '|L1]),
build_args(Args,L1,L0).
build_arg(V,_,_) :- var(V), !,
throw(error(instantiation_error)).
build_arg(Arg,[Arg|L],L) :- atomic(Arg), !.
build_arg(\S0,['\'',S0,'\''|L],L) :-
atom(S0), !.
build_arg([S1|S2],['['|L],L0) :-
is_list(S2), !,
build_arglist([S1|S2],L,L0).
build_arg([S1|S2],L,L0) :- !,
build_arg(S1,L,['.'|L1]),
build_arg(S2,L1,L0).
build_arg(S1:S2,L,L0) :- !,
build_arg(S1,L,[':'|L1]),
build_arg(S2,L1,L0).
build_arg(F,[N,'{'|L],L0) :- %N({A}) = N{A}
F=..[N,{A}], !,
build_arg(A,L,['}'|L0]).
build_arg(F,[N,'('|L],L0) :-
F=..[N|As],
build_args(As,L,L0).
build_arglist([A],L,L0) :- !,
build_arg(A,L,[' ]'|L0]).
build_arglist([A|As],L,L0) :-
build_arg(A,L,[' ,'|L1]),
build_arglist(As,L1,L0).
build_string([],['\''|L],L).
build_string([S0|S],[C|Lf],L0) :-
char_code(C,S0),
build_string(S,Lf,L0).
process_arg_entry([],[]) :- !.
process_arg_entry(L,['('|L]).
/** @} */

1403
packages/python/swig/yap4py/prolog/matrix.yap
View File

File diff suppressed because it is too large Load Diff

232
packages/python/swig/yap4py/prolog/nb.yap
View File

@ -1,232 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: nb.yap *
* Last rev: 5/12/99 *
* mods: *
* comments: non-backtrackable data-structures *
* *
*************************************************************************/
/**
* @file nb.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 23:18:13 2015
*
* @brief stub for global (non-backtrackable) variables.
*
*
*/
:- module(nb, [
nb_create_accumulator/2,
nb_add_to_accumulator/2,
nb_accumulator_value/2,
nb_queue/1,
nb_queue/2,
nb_queue_close/3,
nb_queue_enqueue/2,
nb_queue_dequeue/2,
nb_queue_peek/2,
nb_queue_empty/1,
nb_queue_size/2,
nb_queue_replace/3,
nb_heap/2,
nb_heap_close/1,
nb_heap_add/3,
nb_heap_del/3,
nb_heap_peek/3,
nb_heap_empty/1,
nb_heap_size/2,
nb_beam/2,
nb_beam_close/1,
nb_beam_add/3,
nb_beam_del/3,
nb_beam_peek/3,
nb_beam_empty/1,
% nb_beam_check/1,
nb_beam_size/2]).
/** @defgroup nb Non-Backtrackable Data Structures
@ingroup library
@{
The following routines implement well-known data-structures using global
non-backtrackable variables (implemented on the Prolog stack). The
data-structures currently supported are Queues, Heaps, and Beam for Beam
search. They are allowed through `library(nb)`.
*/
/** @pred nb_beam(+ _DefaultSize_,- _Beam_)
Create a _Beam_ with default size _DefaultSize_. Note that size
is fixed throughout.
*/
/** @pred nb_beam_add(+ _Beam_, + _Key_, + _Value_)
Add _Key_- _Value_ to the beam _Beam_. The key is sorted on
_Key_ only.
*/
/** @pred nb_beam_close(+ _Beam_)
Close the beam _Beam_: no further elements can be added.
*/
/** @pred nb_beam_del(+ _Beam_, - _Key_, - _Value_)
Remove element _Key_- _Value_ with smallest _Value_ in beam
_Beam_. Fail if the beam is empty.
*/
/** @pred nb_beam_empty(+ _Beam_)
Succeeds if _Beam_ is empty.
*/
/** @pred nb_beam_peek(+ _Beam_, - _Key_, - _Value_))
_Key_- _Value_ is the element with smallest _Key_ in the beam
_Beam_. Fail if the beam is empty.
*/
/** @pred nb_beam_size(+ _Beam_, - _Size_)
Unify _Size_ with the number of elements in the beam _Beam_.
*/
/** @pred nb_heap(+ _DefaultSize_,- _Heap_)
Create a _Heap_ with default size _DefaultSize_. Note that size
will expand as needed.
*/
/** @pred nb_heap_add(+ _Heap_, + _Key_, + _Value_)
Add _Key_- _Value_ to the heap _Heap_. The key is sorted on
_Key_ only.
*/
/** @pred nb_heap_close(+ _Heap_)
Close the heap _Heap_: no further elements can be added.
*/
/** @pred nb_heap_del(+ _Heap_, - _Key_, - _Value_)
Remove element _Key_- _Value_ with smallest _Value_ in heap
_Heap_. Fail if the heap is empty.
*/
/** @pred nb_heap_empty(+ _Heap_)
Succeeds if _Heap_ is empty.
*/
/** @pred nb_heap_peek(+ _Heap_, - _Key_, - _Value_))
_Key_- _Value_ is the element with smallest _Key_ in the heap
_Heap_. Fail if the heap is empty.
*/
/** @pred nb_heap_size(+ _Heap_, - _Size_)
Unify _Size_ with the number of elements in the heap _Heap_.
*/
/** @pred nb_queue(- _Queue_)
Create a _Queue_.
*/
/** @pred nb_queue_close(+ _Queue_, - _Head_, ? _Tail_)
Unify the queue _Queue_ with a difference list
_Head_- _Tail_. The queue will now be empty and no further
elements can be added.
*/
/** @pred nb_queue_dequeue(+ _Queue_, - _Element_)
Remove _Element_ from the front of the queue _Queue_. Fail if
the queue is empty.
*/
/** @pred nb_queue_empty(+ _Queue_)
Succeeds if _Queue_ is empty.
*/
/** @pred nb_queue_enqueue(+ _Queue_, + _Element_)
Add _Element_ to the front of the queue _Queue_.
*/
/** @pred nb_queue_peek(+ _Queue_, - _Element_)
_Element_ is the front of the queue _Queue_. Fail if
the queue is empty.
*/
/** @pred nb_queue_size(+ _Queue_, - _Size_)
Unify _Size_ with the number of elements in the queue _Queue_.
*/
/** @} */

501
packages/python/swig/yap4py/prolog/ordsets.yap
View File

@ -1,501 +0,0 @@
/**
* @file ordsets.yap
* @author : R.A.O'Keefe
* @date 22 May 1983
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date 1999
* @brief
*
*
*/
% This file has been included as an YAP library by Vitor Santos Costa, 1999
:- module(ordsets, [
list_to_ord_set/2, % List -> Set
merge/3, % OrdList x OrdList -> OrdList
ord_add_element/3, % Set x Elem -> Set
ord_del_element/3, % Set x Elem -> Set
ord_disjoint/2, % Set x Set ->
ord_insert/3, % Set x Elem -> Set
ord_member/2, % Set -> Elem
ord_intersect/2, % Set x Set ->
ord_intersect/3, % Set x Set -> Set
ord_intersection/3, % Set x Set -> Set
ord_intersection/4, % Set x Set -> Set x Set
ord_seteq/2, % Set x Set ->
ord_setproduct/3, % Set x Set -> Set
ord_subset/2, % Set x Set ->
ord_subtract/3, % Set x Set -> Set
ord_symdiff/3, % Set x Set -> Set
ord_union/2, % Set^2 -> Set
ord_union/3, % Set x Set -> Set
ord_union/4, % Set x Set -> Set x Set,
ord_empty/1, % -> Set
ord_memberchk/2 % Element X Set
]).
/** @defgroup ordsets Ordered Sets
* @ingroup library
* @{
The following ordered set manipulation routines are available once
included with the `use_module(library(ordsets))` command. An
ordered set is represented by a list having unique and ordered
elements. Output arguments are guaranteed to be ordered sets, if the
relevant inputs are. This is a slightly patched version of Richard
O'Keefe's original library.
In this module, sets are represented by ordered lists with no
duplicates. Thus {c,r,a,f,t} would be [a,c,f,r,t]. The ordering
is defined by the @< family of term comparison predicates, which
is the ordering used by sort/2 and setof/3.
The benefit of the ordered representation is that the elementary
set operations can be done in time proportional to the Sum of the
argument sizes rather than their Product. Some of the unordered
set routines, such as member/2, length/2, select/3 can be used
unchanged. The main difficulty with the ordered representation is
remembering to use it!
*/
/** @pred ord_add_element(+ _Set1_, + _Element_, ? _Set2_)
Inserting _Element_ in _Set1_ returns _Set2_. It should give
exactly the same result as `merge(Set1, [Element], Set2)`, but a
bit faster, and certainly more clearly. The same as ord_insert/3.
*/
/** @pred ord_del_element(+ _Set1_, + _Element_, ? _Set2_)
Removing _Element_ from _Set1_ returns _Set2_.
*/
/** @pred ord_disjoint(+ _Set1_, + _Set2_)
Holds when the two ordered sets have no element in common.
*/
/** @pred ord_insert(+ _Set1_, + _Element_, ? _Set2_)
Inserting _Element_ in _Set1_ returns _Set2_. It should give
exactly the same result as `merge(Set1, [Element], Set2)`, but a
bit faster, and certainly more clearly. The same as ord_add_element/3.
*/
/** @pred ord_intersect(+ _Set1_, + _Set2_)
Holds when the two ordered sets have at least one element in common.
*/
/** @pred ord_intersection(+ _Set1_, + _Set2_, ? _Intersection_)
Holds when Intersection is the ordered representation of _Set1_
and _Set2_.
*/
/** @pred ord_intersection(+ _Set1_, + _Set2_, ? _Intersection_, ? _Diff_)
Holds when Intersection is the ordered representation of _Set1_
and _Set2_. _Diff_ is the difference between _Set2_ and _Set1_.
*/
/** @pred ord_member(+ _Element_, + _Set_)
Holds when _Element_ is a member of _Set_.
*/
/** @pred ord_seteq(+ _Set1_, + _Set2_)
Holds when the two arguments represent the same set.
*/
/** @pred ord_setproduct(+ _Set1_, + _Set2_, - _Set_)
If Set1 and Set2 are ordered sets, Product will be an ordered
set of x1-x2 pairs.
*/
/** @pred ord_subset(+ _Set1_, + _Set2_)
Holds when every element of the ordered set _Set1_ appears in the
ordered set _Set2_.
*/
/** @pred ord_subtract(+ _Set1_, + _Set2_, ? _Difference_)
Holds when _Difference_ contains all and only the elements of _Set1_
which are not also in _Set2_.
*/
/** @pred ord_symdiff(+ _Set1_, + _Set2_, ? _Difference_)
Holds when _Difference_ is the symmetric difference of _Set1_
and _Set2_.
*/
/** @pred ord_union(+ _Set1_, + _Set2_, ? _Union_)
Holds when _Union_ is the union of _Set1_ and _Set2_.
*/
/** @pred ord_union(+ _Set1_, + _Set2_, ? _Union_, ? _Diff_)
Holds when _Union_ is the union of _Set1_ and _Set2_ and
_Diff_ is the difference.
*/
/** @pred ord_union(+ _Sets_, ? _Union_)
Holds when _Union_ is the union of the lists _Sets_.
*/
/*
:- mode
list_to_ord_set(+, ?),
merge(+, +, -),
ord_disjoint(+, +),
ord_disjoint(+, +, +, +, +),
ord_insert(+, +, ?),
ord_insert(+, +, +, +, ?),
ord_intersect(+, +),
ord_intersect(+, +, +, +, +),
ord_intersect(+, +, ?),
ord_intersect(+, +, +, +, +, ?),
ord_seteq(+, +),
ord_subset(+, +),
ord_subset(+, +, +, +, +),
ord_subtract(+, +, ?),
ord_subtract(+, +, +, +, +, ?),
ord_symdiff(+, +, ?),
ord_symdiff(+, +, +, +, +, ?),
ord_union(+, +, ?),
ord_union(+, +, +, +, +, ?).
*/
%% @pred list_to_ord_set(+List, ?Set)
% is true when Set is the ordered representation of the set represented
% by the unordered representation List. The only reason for giving it
% a name at all is that you may not have realised that sort/2 could be
% used this way.
list_to_ord_set(List, Set) :-
sort(List, Set).
%% @ored merge(+List1, +List2, -Merged)
% is true when Merged is the stable merge of the two given lists.
% If the two lists are not ordered, the merge doesn't mean a great
% deal. Merging is perfectly well defined when the inputs contain
% duplicates, and all copies of an element are preserved in the
% output, e.g. merge("122357", "34568", "12233455678"). Study this
% routine carefully, as it is the basis for all the rest.
merge([Head1|Tail1], [Head2|Tail2], [Head2|Merged]) :-
Head1 @> Head2, !,
merge([Head1|Tail1], Tail2, Merged).
merge([Head1|Tail1], List2, [Head1|Merged]) :-
List2 \== [], !,
merge(Tail1, List2, Merged).
merge([], List2, List2) :- !.
merge(List1, [], List1).
%% @ored ord_disjoint(+Set1, +Set2)
% is true when the two ordered sets have no element in common. If the
% arguments are not ordered, I have no idea what happens.
ord_disjoint([], _) :- !.
ord_disjoint(_, []) :- !.
ord_disjoint([Head1|Tail1], [Head2|Tail2]) :-
compare(Order, Head1, Head2),
ord_disjoint(Order, Head1, Tail1, Head2, Tail2).
ord_disjoint(<, _, Tail1, Head2, Tail2) :-
ord_disjoint(Tail1, [Head2|Tail2]).
ord_disjoint(>, Head1, Tail1, _, Tail2) :-
ord_disjoint([Head1|Tail1], Tail2).
%% @ored ord_insert(+Set1, +Element, ?Set2)
% ord_add_element(+Set1, +Element, ?Set2)
% is the equivalent of add_element for ordered sets. It should give
% exactly the same result as merge(Set1, [Element], Set2), but a bit
% faster, and certainly more clearly.
ord_add_element([], Element, [Element]).
ord_add_element([Head|Tail], Element, Set) :-
compare(Order, Head, Element),
ord_insert(Order, Head, Tail, Element, Set).
ord_insert([], Element, [Element]).
ord_insert([Head|Tail], Element, Set) :-
compare(Order, Head, Element),
ord_insert(Order, Head, Tail, Element, Set).
ord_insert(<, Head, Tail, Element, [Head|Set]) :-
ord_insert(Tail, Element, Set).
ord_insert(=, Head, Tail, _, [Head|Tail]).
ord_insert(>, Head, Tail, Element, [Element,Head|Tail]).
%% @pred ord_intersect(+Set1, +Set2)
% is true when the two ordered sets have at least one element in common.
% Note that the test is == rather than = .
ord_intersect([Head1|Tail1], [Head2|Tail2]) :-
compare(Order, Head1, Head2),
ord_intersect(Order, Head1, Tail1, Head2, Tail2).
ord_intersect(=, _, _, _, _).
ord_intersect(<, _, Tail1, Head2, Tail2) :-
ord_intersect(Tail1, [Head2|Tail2]).
ord_intersect(>, Head1, Tail1, _, Tail2) :-
ord_intersect([Head1|Tail1], Tail2).
ord_intersect(L1, L2, L) :-
ord_intersection(L1, L2, L).
%% @pred ord_intersection(+Set1, +Set2, ?Intersection)
% is true when Intersection is the ordered representation of Set1
% and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection([], _, []) :- !.
ord_intersection([_|_], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection) :-
( Head1 == Head2 ->
Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail)
;
Head1 @< Head2 ->
ord_intersection(Tail1, [Head2|Tail2], Intersection)
;
ord_intersection([Head1|Tail1], Tail2, Intersection)
).
%% @pred ord_intersection(+Set1, +Set2, ?Intersection, ?Difference)
% is true when Intersection is the ordered representation of Set1
% and Set2, provided that Set1 and Set2 are ordered sets.
ord_intersection([], L, [], L) :- !.
ord_intersection([_|_], [], [], []) :- !.
ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection, Difference) :-
( Head1 == Head2 ->
Intersection = [Head1|Tail],
ord_intersection(Tail1, Tail2, Tail, Difference)
;
Head1 @< Head2 ->
ord_intersection(Tail1, [Head2|Tail2], Intersection, Difference)
;
Difference = [Head2|HDifference],
ord_intersection([Head1|Tail1], Tail2, Intersection, HDifference)
).
% ord_seteq(+Set1, +Set2)
% is true when the two arguments represent the same set. Since they
% are assumed to be ordered representations, they must be identical.
ord_seteq(Set1, Set2) :-
Set1 == Set2.
% ord_subset(+Set1, +Set2)
% is true when every element of the ordered set Set1 appears in the
% ordered set Set2.
ord_subset([], _) :- !.
ord_subset([Head1|Tail1], [Head2|Tail2]) :-
compare(Order, Head1, Head2),
ord_subset(Order, Head1, Tail1, Head2, Tail2).
ord_subset(=, _, Tail1, _, Tail2) :-
ord_subset(Tail1, Tail2).
ord_subset(>, Head1, Tail1, _, Tail2) :-
ord_subset([Head1|Tail1], Tail2).
% ord_subtract(+Set1, +Set2, ?Difference)
% is true when Difference contains all and only the elements of Set1
% which are not also in Set2.
ord_subtract(Set1, [], Set1) :- !.
ord_subtract([], _, []) :- !.
ord_subtract([Head1|Tail1], [Head2|Tail2], Difference) :-
compare(Order, Head1, Head2),
ord_subtract(Order, Head1, Tail1, Head2, Tail2, Difference).
ord_subtract(=, _, Tail1, _, Tail2, Difference) :-
ord_subtract(Tail1, Tail2, Difference).
ord_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
ord_subtract(Tail1, [Head2|Tail2], Difference).
ord_subtract(>, Head1, Tail1, _, Tail2, Difference) :-
ord_subtract([Head1|Tail1], Tail2, Difference).
% ord_del_element(+Set1, Element, ?Rest)
% is true when Rest contains the elements of Set1
% except for Set1
ord_del_element([], _, []).
ord_del_element([Head1|Tail1], Head2, Rest) :-
compare(Order, Head1, Head2),
ord_del_element(Order, Head1, Tail1, Head2, Rest).
ord_del_element(=, _, Tail1, _, Tail1).
ord_del_element(<, Head1, Tail1, Head2, [Head1|Difference]) :-
ord_del_element(Tail1, Head2, Difference).
ord_del_element(>, Head1, Tail1, _, [Head1|Tail1]).
%% @pred ord_symdiff(+Set1, +Set2, ?Difference)
% is true when Difference is the symmetric difference of Set1 and Set2.
ord_symdiff(Set1, [], Set1) :- !.
ord_symdiff([], Set2, Set2) :- !.
ord_symdiff([Head1|Tail1], [Head2|Tail2], Difference) :-
compare(Order, Head1, Head2),
ord_symdiff(Order, Head1, Tail1, Head2, Tail2, Difference).
ord_symdiff(=, _, Tail1, _, Tail2, Difference) :-
ord_symdiff(Tail1, Tail2, Difference).
ord_symdiff(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
ord_symdiff(Tail1, [Head2|Tail2], Difference).
ord_symdiff(>, Head1, Tail1, Head2, Tail2, [Head2|Difference]) :-
ord_symdiff([Head1|Tail1], Tail2, Difference).
% ord_union(+Set1, +Set2, ?Union)
% is true when Union is the union of Set1 and Set2. Note that when
% something occurs in both sets, we want to retain only one copy.
ord_union([S|Set1], [], [S|Set1]).
ord_union([], Set2, Set2).
ord_union([Head1|Tail1], [Head2|Tail2], Union) :-
compare(Order, Head1, Head2),
ord_union(Order, Head1, Tail1, Head2, Tail2, Union).
ord_union(=, Head, Tail1, _, Tail2, [Head|Union]) :-
ord_union(Tail1, Tail2, Union).
ord_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
ord_union(Tail1, [Head2|Tail2], Union).
ord_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
ord_union([Head1|Tail1], Tail2, Union).
%% @pred ord_union(+Set1, +Set2, ?Union, ?Difference)
% is true when Union is the union of Set1 and Set2 and Difference is the
% difference between Set2 and Set1.
ord_union(Set1, [], Set1, []) :- !.
ord_union([], Set2, Set2, Set2) :- !.
ord_union([Head1|Tail1], [Head2|Tail2], Union, Diff) :-
compare(Order, Head1, Head2),
ord_union(Order, Head1, Tail1, Head2, Tail2, Union, Diff).
ord_union(=, Head, Tail1, _, Tail2, [Head|Union], Diff) :-
ord_union(Tail1, Tail2, Union, Diff).
ord_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union], Diff) :-
ord_union(Tail1, [Head2|Tail2], Union, Diff).
ord_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union], [Head2|Diff]) :-
ord_union([Head1|Tail1], Tail2, Union, Diff).
%% @pred ord_setproduct(+Set1, +Set2, ?Product)
% is in fact identical to setproduct(Set1, Set2, Product).
% If Set1 and Set2 are ordered sets, Product will be an ordered
% set of x1-x2 pairs. Note that we cannot solve for Set1 and
% Set2, because there are infinitely many solutions when
% Product is empty, and may be a large number in other cases.
ord_setproduct([], _, []).
ord_setproduct([H|T], L, Product) :-
ord_setproduct(L, H, Product, Rest),
ord_setproduct(T, L, Rest).
ord_setproduct([], _, L, L).
ord_setproduct([H|T], X, [X-H|TX], TL) :-
ord_setproduct(T, X, TX, TL).
ord_member(El,[H|T]):-
compare(Op,El,H),
ord_member(Op,El,T).
ord_member(=,_,_).
ord_member(>,El,[H|T]) :-
compare(Op,El,H),
ord_member(Op,El,T).
ord_union([], []).
ord_union([Set|Sets], Union) :-
length([Set|Sets], NumberOfSets),
ord_union_all(NumberOfSets, [Set|Sets], Union, []).
ord_union_all(N,Sets0,Union,Sets) :-
( N=:=1 -> Sets0=[Union|Sets]
; N=:=2 -> Sets0=[Set1,Set2|Sets],
ord_union(Set1,Set2,Union)
; A is N>>1,
Z is N-A,
ord_union_all(A, Sets0, X, Sets1),
ord_union_all(Z, Sets1, Y, Sets),
ord_union(X, Y, Union)
).
ord_empty([]).
ord_memberchk(Element, [E|_]) :- E == Element, !.
ord_memberchk(Element, [_|Set]) :-
ord_memberchk(Element, Set).
/** @} */

1920
packages/python/swig/yap4py/prolog/os/chartypes.yap
View File

File diff suppressed because it is too large Load Diff

173
packages/python/swig/yap4py/prolog/os/edio.yap
View File

@ -1,173 +0,0 @@
%
% Edinburgh IO.
/**
* @file edio.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Wed Jan 20 01:07:02 2016
*
* @brief Input/Output according to the DEC-10 Prolog. PLease consider using the ISO
* standard predicates for new code.
*
*
*/
%
/** @pred see(+ _S_)
If _S_ is a currently opened input stream then it is assumed to be
the current input stream. If _S_ is an atom it is taken as a
filename. If there is no input stream currently associated with it, then
it is opened for input, and the new input stream thus created becomes
the current input stream. If it is not possible to open the file, an
error occurs. If there is a single opened input stream currently
associated with the file, it becomes the current input stream; if there
are more than one in that condition, then one of them is chosen.
When _S_ is a stream not currently opened for input, an error may be
reported, depending on the state of the `file_errors` flag. If
_S_ is neither a stream nor an atom the predicates just fails.
*/
see(user) :- !, set_input(user_input).
see(F) :- var(F), !,
'$do_error'(instantiation_error,see(F)).
see(F) :- current_input(Stream),
'$user_file_name'(Stream,F).
see(F) :- current_stream(_,read,Stream), '$user_file_name'(Stream,F), !,
set_input(Stream).
see(Stream) :- '$stream'(Stream), current_stream(_,read,Stream), !,
set_input(Stream).
see(F) :- open(F,read,Stream), set_input(Stream).
/** @pred seeing(- _S_)
The current input stream is unified with _S_.
*/
seeing(File) :- current_input(Stream),
stream_property(Stream,file_name(NFile)),
(
stream_property(user_input,file_name(NFile))
->
File = user
;
NFile = File
).
/** @pred seen
Closes the current input stream, as opened by see/1. Standard input
stream goes to the original ùser_input`.
*/
seen :- current_input(Stream), close(Stream), set_input(user).
/** @pred tell(+ _S_)
If _S_ is a currently opened stream for output, it becomes the
current output stream. If _S_ is an atom it is taken to be a
filename. If there is no output stream currently associated with it,
then it is opened for output, and the new output stream created becomes
the current output stream. Existing files are clobbered, use append/1 to ext end a file.
If it is not possible to open the file, an
error occurs. If there is a single opened output stream currently
associated with the file, then it becomes the current output stream; if
there are more than one in that condition, one of them is chosen.
Whenever _S_ is a stream not currently opened for output, an error
may be reported, depending on the state of the file_errors flag. The
predicate just fails, if _S_ is neither a stream nor an atom.
*/
tell(user) :- !, set_output(user_output).
tell(F) :- var(F), !,
'$do_error'(instantiation_error,tell(F)).
tell(F) :-
current_output(Stream),
stream_property(Stream,file_name(F)),
!.
tell(F) :-
current_stream(_,write,Stream),
'$user_file_name'(Stream, F), !,
set_output(Stream).
tell(Stream) :-
'$stream'(Stream),
current_stream(_,write,Stream), !,
set_output(Stream).
tell(F) :-
open(F,write,Stream),
set_output(Stream).
/** @pred append(+ _S_)
If _S_ is a currently opened stream for output, it becomes the
current output stream. If _S_ is an atom it is taken to be a
filename. If there is no output stream currently associated with it,
then it is opened for output in *append* mode, that is, by adding new data to the end of the file.
The new output stream created becomes
the current output stream. If it is not possible to open the file, an
error occurs. If there is a single opened output stream currently
associated with the file, then it becomes the current output stream; if
there are more than one in that condition, one of them is chosen.
Whenever _S_ is a stream not currently opened for output, an error
may be reported, depending on the state of the file_errors flag. The
predicate just fails, if _S_ is neither a stream nor an atom.
*/
tell(user) :- !, set_output(user_output).
tell(F) :- var(F), !,
'$do_error'(instantiation_error,tell(F)).
tell(F) :-
current_output(Stream),
stream_property(Stream,file_name(F)),
!.
tell(F) :-
current_stream(_,write,Stream),
'$user_file_name'(Stream, F), !,
set_output(Stream).
tell(Stream) :-
'$stream'(Stream),
current_stream(_,write,Stream), !,
set_output(Stream).
tell(F) :-
open(F,write,Stream),
set_output(Stream).
/** @pred telling(- _S_)
The current output stream is unified with _S_.
*/
telling(File) :-
current_output(Stream),
stream_property(Stream,file_name(NFile)),
( stream_property(user_output,file_name(NFile)) -> File = user ; File = NFile ).
/** @pred told
Closes the current output stream, and the user's terminal becomes again
the current output stream. It is important to remember to close streams
after having finished using them, as the maximum number of
simultaneously opened streams is 17.
*/
told :- current_output(Stream),
!,
set_output(user_output),
close(Stream).

561
packages/python/swig/yap4py/prolog/pl/absf.yap
View File

@ -1,561 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
* *
*************************************************************************/
/**
@file absf.yap
@author L.Damas, V.S.Costa
@defgroup AbsoluteFileName File Name Resolution
@ingroup builtins
Support for file name resolution through absolute_file_name/3 and
friends. These utility built-ins describe a list of directories that
are used by load_files/2 to search. They include pre-compiled paths
plus user-defined directories, directories based on environment
variables and registry information to search for files.
@{
*/
:- system_module( absf, [absolute_file_name/2,
absolute_file_name/3,
add_to_path/1,
add_to_path/2,
path/1,
remove_from_path/1], ['$full_filename'/3,
'$system_library_directories'/2]).
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_lists', [member/2]).
/**
@pred absolute_file_name( -File:atom, +Path:atom, +Options:list) is nondet
_Options_ is a list of options to guide the conversion:
- extensions(+ _ListOfExtensions_)
List of file-name suffixes to add to try adding to the file. The
Default is the empty suffix, `''`. For each extension,
absolute_file_name/3 will first add the extension and then verify
the conditions imposed by the other options. If the condition
fails, the next extension of the list is tried. Extensions may
be specified both with dot, as `.ext`, or without, as plain
`ext`.
- relative_to(+ _FileOrDir_ )
Resolve the path relative to the given directory or directory the
holding the given file. Without this option, paths are resolved
relative to the working directory (see working_directory/2) or,
if _Spec_ is atomic and absolute_file_name/3 is executed
in a directive, it uses the current source-file as reference.
- access(+ _Mode_ )
Imposes the condition access_file( _File_ , _Mode_ ). _Mode_ is one of `read`, `write`, `append`, `exist` or
`none` (default).
See also access_file/2.
- file_type(+ _Type_ )
Defines suffixes matching one of several pre-specified type of files. Default mapping is as follows:
1. `txt` implies `[ '' ]`,
2. `prolog` implies `['.yap', '.pl', '.prolog', '']`,
3. `executable` implies `['.so', ',dylib', '.dll']` depending on the Operating system,
4. `qly` implies `['.qly', '']`,
5. `directory` implies `['']`,
6. The file-type `source` is an alias for `prolog` designed to support compatibility with SICStus Prolog. See also prolog_file_type/2.
Notice that this predicate only
returns non-directories, unless the option `file_type(directory)` is
specified, or unless `access(none)`.
- file_errors(`fail`/`error`)
If `error` (default), throw `existence_error` exception
if the file cannot be found. If `fail`, stay silent.
- solutions(`first`/`all`)
If `first` (default), commit to the first solution. Otherwise
absolute_file_name will enumerate all solutions via backtracking.
- expand(`true`/`false`)
If `true` (default is `false`) and _Spec_ is atomic, call
expand_file_name/2 followed by member/2 on _Spec_ before
proceeding. This is originally a SWI-Prolog extension, but
whereas SWI-Prolog implements its own conventions, YAP uses the
shell's `glob` primitive.
Notice that in `glob` mode YAP will fail if it cannot find a matching file, as `glob`
implicitely tests for existence when checking for patterns.
- glob(`Pattern`)
If _Pattern_ is atomic, add the pattern as a suffix to the current expansion, and call
expand_file_name/2 followed by member/2 on the result. This is originally a SICStus Prolog exception.
Both `glob` and `expand` rely on the same underlying
mechanism. YAP gives preference to `glob`.
- verbose_file_search(`true`/`false`)
If `true` (default is `false`) output messages during
search. This is often helpful when debugging. Corresponds to the
SWI-Prolog flag `verbose_file_search` (also available in YAP).
Compatibility considerations to common argument-order in ISO as well
as SICStus absolute_file_name/3 forced us to be flexible here.
If the last argument is a list and the second not, the arguments are
swapped, thus the call
~~~~~~~~~~~~
?- absolute_file_name( 'pl/absf.yap', [], Path)
~~~~~~~~~~~~
is valid as well.
*/
absolute_file_name(File,TrueFileName,Opts) :-
( var(TrueFileName) ->
true ;
atom(TrueFileName), TrueFileName \= []
),
!,
absolute_file_name(File,Opts,TrueFileName).
absolute_file_name(File,Opts,TrueFileName) :-
'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
/**
@pred absolute_file_name(+Name:atom,+Path:atom) is nondet
Converts the given file specification into an absolute path, using default options. See absolute_file_name/3 for details on the options.
*/
absolute_file_name(V,Out) :- var(V),
!, % absolute_file_name needs commenting.
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !.
absolute_file_name(File0,File) :-
'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
'$full_filename'(F0, F, G) :-
'$absolute_file_name'(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
expand(true)],F,G).
'$absolute_file_name'(File,LOpts,TrueFileName, G) :-
% must_be_of_type( atom, File ),
( var(File) -> instantiation_error(File) ; true),
abs_file_parameters(LOpts,Opts),
current_prolog_flag(open_expands_filename, OldF),
current_prolog_flag( fileerrors, PreviousFileErrors ),
current_prolog_flag( verbose_file_search, PreviousVerbose ),
get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
get_abs_file_parameter( expand, Opts, Expand ),
set_prolog_flag( verbose_file_search, Verbose ),
get_abs_file_parameter( file_errors, Opts, FErrors ),
get_abs_file_parameter( solutions, Opts, First ),
( FErrors == fail -> FileErrors = false ; FileErrors = true ),
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag(file_name_variables, Expand),
'$absf_trace'(File),
'$absf_trace_options'(LOpts),
HasSol = t(no),
(
% look for solutions
'$find_in_path'(File, Opts,TrueFileName),
( (First == first -> ! ; nb_setarg(1, HasSol, yes) ),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
'$absf_trace'(' |------- found ~a', [TrueFileName])
;
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag( verbose_file_search, Verbose ),
set_prolog_flag( file_name_variables, Expand ),
'$absf_trace'(' |------- restarted search for ~a', [File]),
fail
)
;
% finished
% stop_low_level_trace,
'$absf_trace'(' !------- failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
set_prolog_flag(file_name_variables, OldF),
% check if no solution
arg(1,HasSol,no),
FileErrors = error,
'$do_error'(existence_error(file,File),G)
).
% This sequence must be followed:
% user and user_input are special;
% library(F) must check library_directories
% T(F) must check file_search_path
% all must try search in path
'$find_in_path'(user,_,user_input) :- !.
'$find_in_path'(user_input,_,user_input) :- !.
'$find_in_path'(user_output,_,user_ouput) :- !.
'$find_in_path'(user_error,_,user_error) :- !.
'$find_in_path'(Name, Opts, File) :-
% ( atom(Name) -> true ; start_low_level_trace ),
get_abs_file_parameter( file_type, Opts, Type ),
get_abs_file_parameter( access, Opts, Access ),
get_abs_file_parameter( expand, Opts, Expand ),
'$absf_trace'('start with ~w', [Name]),
'$core_file_name'(Name, Opts, CorePath, []),
'$absf_trace'(' after name/library unfolding: ~w', [Name]),
'$variable_expansion'(CorePath, Opts,ExpandedPath),
'$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]),
'$prefix'(ExpandedPath, Opts, Path , []),
'$absf_trace'(' after prefix expansion: ~s', [Path]),
atom_codes( APath, Path ),
(
Expand = true
->
expand_file_name( APath, EPaths),
'$absf_trace'(' after shell globbing: ~w', [EPaths]),
lists:member(EPath, EPaths)
;
EPath = APath
),
real_path( EPath, File),
'$absf_trace'(' after canonical path name: ~a', [File]),
'$check_file'( File, Type, Access ),
'$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]).
% allow paths in File Name
'$core_file_name'(Name, Opts) -->
'$file_name'(Name, Opts, E),
'$suffix'(E, Opts),
'$glob'(Opts).
%
% handle library(lists) or foreign(jpl)
%
'$file_name'(Name, Opts, E) -->
{ Name =.. [Lib, P0] },
!,
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
'$absf_trace'(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ '$absf_trace'(' ~w next', [P0]) },
'$cat_file_name'(P0, E).
'$file_name'(Name, Opts, E) -->
'$cat_file_name'(Name, E ).
/*
(
{
get_abs_file_parameter( file_type, Opts, Lib ),
nonvar(Lib)
}
->
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
'$absf_trace'(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ '$absf_trace'(' ~w next', [P0]) }
;
[]
).
*/
'$cat_file_name'(A/B, E ) -->
'$cat_file_name'(A, _),
'$dir',
'$cat_file_name'(B, E).
'$cat_file_name'(File, F) -->
{ atom(File), atom_codes(File, F) },
!,
F.
'$cat_file_name'(File, S) -->
{string(File), string_to_codes(File, S) },
!,
S.
'$variable_expansion'( Path, Opts, APath ) :-
get_abs_file_parameter( expand, Opts, true ),
!,
'$expand_file_name'( Path, APath ).
'$variable_expansion'( Path, _, Path ).
'$var'(S) -->
"{", !, '$id'(S), "}".
'$var'(S) -->
'$id'(S).
'$drive'(C) -->
'$id'(C),
":\\\\".
'$id'([C|S]) --> [C],
{ C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
C >= "0", C =< "9" ; C =:= "_" },
!,
'$id'(S).
'$id'([]) --> [].
% always verify if a directory
'$check_file'(F, directory, _) :-
!,
exists_directory(F).
'$check_file'(_F, _Type, none) :- !.
'$check_file'(F, _Type, exist) :-
'$access_file'(F, exist). % if it has a type cannot be a directory..
'$check_file'(F, _Type, Access) :-
'$access_file'(F, Access),
\+ exists_directory(F). % if it has a type cannot be a directory..
'$suffix'(Last, _Opts) -->
{ lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
'$absf_trace'(' suffix in ~s', [Last]),
!.
'$suffix'(_, Opts) -->
{
(
get_abs_file_parameter( extensions, Opts, Exts ),
Exts \= []
->
lists:member(Ext, Exts),
'$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
;
get_abs_file_parameter( file_type, Opts, Type ),
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType)
),
'$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]),
atom_codes(Ext, Cs)
},
'$add_suffix'(Cs).
'$suffix'(_,_Opts) -->
'$absf_trace'(' try no suffix', []).
'$add_suffix'(Cs) -->
{ Cs = [0'. |_Codes] }
->
Cs
;
".", Cs.
'$glob'(Opts) -->
{
get_abs_file_parameter( glob, Opts, G ),
G \= '',
atom_codes( G, Gs )
},
!,
'$dir',
Gs.
'$glob'(_Opts) -->
[].
'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
!.
'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
lists:member(ExpFile, ExpFiles),
file_base_name( ExpFile, Base ),
Base \= '.',
Base \='..'.
'$prefix'( CorePath, _Opts) -->
{ is_absolute_file_name( CorePath ) },
!,
CorePath.
'$prefix'( CorePath, Opts) -->
{ get_abs_file_parameter( relative_to, Opts, Prefix ),
Prefix \= '',
'$absf_trace'(' relative_to ~a', [Prefix]),
sub_atom(Prefix, _, 1, 0, Last),
atom_codes(Prefix, S)
},
!,
S,
'$dir'(Last),
CorePath.
'$prefix'( CorePath, _) -->
{
recorded('$path',Prefix,_),
'$absf_trace'(' try YAP path database ~a', [Prefix]),
sub_atom(Prefix, _, _, 1, Last),
atom_codes(Prefix, S) },
S,
'$dir'(Last),
CorePath.
'$prefix'(CorePath, _ ) -->
'$absf_trace'(' empty prefix', []),
CorePath.
'$dir' --> { current_prolog_flag(windows, true) },
"\\",
!.
'$dir' --> "/".
'$dir'('/') --> !.
'$dir'('\\') --> { current_prolog_flag(windows, true) },
!.
'$dir'(_) --> '$dir'.
%
%
%
'$system_library_directories'(library, Dir) :-
user:library_directory( Dir ).
% '$split_by_sep'(0, 0, Dirs, Dir).
'$system_library_directories'(foreign, Dir) :-
user:foreign_directory( Dir ).
% compatibility with old versions
%
% search the current directory first.
'$system_library_directories'(commons, Dir) :-
user:commons_directory( Dir ).
% enumerate all paths separated by a path_separator.
'$paths'(Cs, C) :-
atom(Cs),
( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
sub_atom(Cs, N0, 1, N, Sep),
!,
(
sub_atom(Cs,0,N0,_,C)
;
sub_atom(Cs,_,N,0,RC),
'$paths'(RC, C)
).
'$paths'(S, S).
'$absf_trace'(Msg, Args ) -->
{ current_prolog_flag( verbose_file_search, true ) },
{ print_message( informational, absolute_file_path( Msg, Args ) ) },
!.
'$absf_trace'(_Msg, _Args ) --> [].
'$absf_trace'(Msg, Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( Msg, Args ) ),
!.
'$absf_trace'(_Msg, _Args ).
'$absf_trace'( File ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( File ) ),
!.
'$absf_trace'( _File ).
'$absf_trace_options'(Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, arguments( Args ) ),
!.
'$absf_trace_options'( _Args ).
/** @pred prolog_file_name( +File, -PrologFileaNme)
Unify _PrologFileName_ with the Prolog file associated to _File_.
*/
prolog_file_name(File, PrologFileName) :-
var(File), !,
'$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
prolog_file_name(user, Out) :- !, Out = user.
prolog_file_name(File, PrologFileName) :-
atom(File), !,
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
/**
@pred path(-Directories:list) is det,deprecated
YAP specific procedure that returns a list of user-defined directories
in the library search-path.We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
'$in_path'(X) :-
recorded('$path',Path,_),
atom_codes(Path,S),
( S = "" -> X = '.' ;
atom_codes(X,S) ).
/**
@pred add_to_path(+Directory:atom) is det,deprecated
YAP-specific predicate to include directory in library search path.
We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
add_to_path(New) :-
add_to_path(New,last).
/**
@pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
YAP-specific predicate to include directory in front or back of
library search path. We suggest using user:file_search_path/2 for
compatibility with other Prologs and more extensive functionality.
*/
add_to_path(New,Pos) :-
atom(New), !,
'$check_path'(New,Str),
atom_codes(Path,Str),
'$add_to_path'(Path,Pos).
'$add_to_path'(New,_) :-
recorded('$path',New,R),
erase(R),
fail.
'$add_to_path'(New,last) :-
!,
recordz('$path',New,_).
'$add_to_path'(New,first) :-
recorda('$path',New,_).
/** @pred remove_from_path(+Directory:atom) is det,deprecated
@}
*/
remove_from_path(New) :- '$check_path'(New,Path),
recorded('$path',Path,R), erase(R).
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
'$check_path'([],[]).
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).

364
packages/python/swig/yap4py/prolog/pl/arith.yap
View File

@ -1,364 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arith.yap *
* Last rev: *
* mods: *
* comments: arithmetical optimization *
* *
*************************************************************************/
% the default mode is on
%% @file arith.yap
:- system_module( '$_arith', [compile_expressions/0,
expand_exprs/2,
plus/3,
succ/2], ['$c_built_in'/3]).
:- private( [do_c_built_in/3,
do_c_built_metacall/3,
expand_expr/3,
expand_expr/5,
expand_expr/6] ).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_modules', ['$clean_cuts'/2]).
/** @defgroup CompilerAnalysis Internal Clause Rewriting
@ingroup YAPCompilerSettings
YAP supports several clause optimisation mechanisms, that
are designed to improve execution of arithmetic
and term construction built-ins. In other words, during the
compilation process a clause is rewritten twice:
1. first, perform user-defined goal_expansion as described
in the predicates goal_expansion/1 and goal_expansion/2.
2. Perform expansion of some built-ins like:
+ pruning operators, like ->/2 and *->/2
+ arithmetic, including early evaluation of constant expressions
+ specialise versions for some built-ins, if we are aware of the
run-time execution mode
The user has some control over this process, through some
built-ins and through execution flsgs.
*/
%% @{
/** @pred expand_exprs(- _O_,+ _N_)
Control term expansion during compilation.
Enables low-level optimizations. It reports the current state by
unifying _O_ with the previous state. It then puts YAP in state _N_
(`on` or `off`)/ _On_ is equivalent to compile_expressions/0 and `off`
is equivalent to do_not_compile_expressions/0.
This predicate is useful when debugging, to ensure execution close to the original source.
*/
expand_exprs(Old,New) :-
(get_value('$c_arith',true) ->
Old = on ;
Old = off ),
'$set_arith_expan'(New).
'$set_arith_expan'(on) :- set_value('$c_arith',true).
'$set_arith_expan'(off) :- set_value('$c_arith',[]).
/** @pred compile_expressions
After a call to this predicate, arithmetical expressions will be compiled.
(see example below). This is the default behavior.
*/
compile_expressions :- set_value('$c_arith',true).
/** @pred do_not_compile_expressions
After a call to this predicate, arithmetical expressions will not be compiled.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
?- source, do_not_compile_expressions.
yes
?- [user].
| p(X) :- X is 2 * (3 + 8).
| :- end_of_file.
?- compile_expressions.
yes
?- [user].
| q(X) :- X is 2 * (3 + 8).
| :- end_of_file.
:- listing.
p(A):-
A is 2 * (3 + 8).
q(A):-
A is 22.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
do_not_compile_expressions :- set_value('$c_arith',[]).
'$c_built_in'(IN, M, H, OUT) :-
get_value('$c_arith',true), !,
do_c_built_in(IN, M, H, OUT).
'$c_built_in'(IN, _, _H, IN).
do_c_built_in(G, M, H, OUT) :- var(G), !,
do_c_built_metacall(G, M, H, OUT).
do_c_built_in(Mod:G, _, H, OUT) :-
'$yap_strip_module'(Mod:G, M1, G1),
var(G1), !,
do_c_built_metacall(G1, M1, H, OUT).
do_c_built_in('$do_error'( Error, Goal), M, Head,
(clause_location(Call, Caller),
strip_module(M:Goal,M1,NGoal),
throw(error(Error,
[[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]]
)
)
)
) :- !.
do_c_built_in(X is Y, M, H, P) :-
primitive(X), !,
do_c_built_in(X =:= Y, M, H, P).
do_c_built_in(X is Y, M, H, (P,A=X)) :-
nonvar(X), !,
do_c_built_in(A is Y, M, H, P).
do_c_built_in(X is Y, _, _, P) :-
nonvar(Y), % Don't rewrite variables
!,
(
number(Y) ->
P = ( X = Y); % This case reduces to an unification
expand_expr(Y, P0, X0),
'$drop_is'(X0, X, P0, P)
).
do_c_built_in(phrase(NT,Xs), Mod, H, NTXsNil) :-
'$_arith':do_c_built_in(phrase(NT,Xs,[]), Mod, H, NTXsNil).
do_c_built_in(phrase(NT,Xs0,Xs), Mod, _, NewGoal) :-
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal ).
do_c_built_in(Comp0, _, _, R) :- % now, do it for comparisons
'$compop'(Comp0, Op, E, F),
!,
'$compop'(Comp, Op, U, V),
expand_expr(E, P, U),
expand_expr(F, Q, V),
'$do_and'(P, Q, R0),
'$do_and'(R0, Comp, R).
do_c_built_in(P, _M, _H, P).
do_c_built_metacall(G1, Mod, _, '$execute_wo_mod'(G1,Mod)) :-
var(Mod), !.
do_c_built_metacall(G1, Mod, _, '$execute_in_mod'(G1,Mod)) :-
atom(Mod), !.
do_c_built_metacall(G1, Mod, _, call(Mod:G1)).
'$do_and'(true, P, P) :- !.
'$do_and'(P, true, P) :- !.
'$do_and'(P, Q, (P,Q)).
% V is the result of the simplification,
% X the result of the initial expression
% and the last argument is how we are writing this result
'$drop_is'(V, V1, P0, G) :-
var(V),
!, % usual case
V = V1,
P0 = G.
'$drop_is'(V, X, P0, P) :- % atoms
'$do_and'(P0, X is V, P).
% Table of arithmetic comparisons
'$compop'(X < Y, < , X, Y).
'$compop'(X > Y, > , X, Y).
'$compop'(X=< Y,=< , X, Y).
'$compop'(X >=Y, >=, X, Y).
'$compop'(X=:=Y,=:=, X, Y).
'$compop'(X=\=Y,=\=, X, Y).
'$composed_built_in'(V) :- var(V), !,
fail.
'$composed_built_in'(('$current_choice_point'(_),NG,'$$cut_by'(_))) :- !,
'$composed_built_in'(NG).
'$composed_built_in'((_,_)).
'$composed_built_in'((_;_)).
'$composed_built_in'((_|_)).
'$composed_built_in'((_->_)).
'$composed_built_in'(_:G) :-
'$composed_built_in'(G).
'$composed_built_in'(\+G) :-
'$composed_built_in'(G).
'$composed_built_in'(not(G)) :-
'$composed_built_in'(G).
% expanding an expression:
% first argument is the expression not expanded,
% second argument the expanded expression
% third argument unifies with the result from the expression
expand_expr(V, true, V) :-
var(V), !.
expand_expr([T], E, V) :- !,
expand_expr(T, E, V).
expand_expr(String, _E, V) :-
string( String ), !,
string_codes(String, [V]).
expand_expr(A, true, A) :-
atomic(A), !.
expand_expr(T, E, V) :-
T =.. [O, A], !,
expand_expr(A, Q, X),
expand_expr(O, X, V, Q, E).
expand_expr(T, E, V) :-
T =.. [O, A, B], !,
expand_expr(A, Q, X),
expand_expr(B, R, Y),
expand_expr(O, X, Y, V, Q, S),
'$do_and'(R, S, E).
% expanding an expression of the form:
% O is Op(X),
% after having expanded into Q
% and giving as result P (the last argument)
expand_expr(Op, X, O, Q, Q) :-
number(X),
catch(is( O, Op, X),_,fail), !. % do not do error handling at compile time
expand_expr(Op, X, O, Q, P) :-
'$unary_op_as_integer'(Op,IOp),
'$do_and'(Q, is( O, IOp, X), P).
% expanding an expression of the form:
% O is Op(X,Y),
% after having expanded into Q
% and giving as result P (the last argument)
% included is some optimization for:
% incrementing and decrementing,
% the elementar arithmetic operations [+,-,*,//]
expand_expr(Op, X, Y, O, Q, Q) :-
number(X), number(Y),
catch(is( O, Op, X, Y),_,fail), !.
expand_expr(+, X, Y, O, Q, P) :- !,
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$plus'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(-, X, Y, O, Q, P) :-
var(X), number(Y),
Z is -Y, !,
expand_expr(+, Z, X, O, Q, P).
expand_expr(-, X, Y, O, Q, P) :- !,
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$minus'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(*, X, Y, O, Q, P) :- !,
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$times'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(//, X, Y, O, Q, P) :-
nonvar(Y), Y == 0, !,
'$binary_op_as_integer'(//,IOp),
'$do_and'(Q, is(O,IOp,X,Y), P).
expand_expr(//, X, Y, O, Q, P) :- !,
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$div'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(/\, X, Y, O, Q, P) :- !,
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$and'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(\/, X, Y, O, Q, P) :- !,
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$or'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(<<, X, Y, O, Q, P) :-
var(X), number(Y), Y < 0,
Z is -Y, !,
expand_expr(>>, X, Z, O, Q, P).
expand_expr(<<, X, Y, O, Q, P) :- !,
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$sll'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(>>, X, Y, O, Q, P) :-
var(X), number(Y), Y < 0,
Z is -Y, !,
expand_expr(<<, X, Z, O, Q, P).
expand_expr(>>, X, Y, O, Q, P) :- !,
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
'$do_and'(E, '$slr'(X1,Y1,O), F),
'$do_and'(Q, F, P).
expand_expr(Op, X, Y, O, Q, P) :-
'$binary_op_as_integer'(Op,IOp),
'$do_and'(Q, is(O,IOp,X,Y), P).
'$preprocess_args_for_commutative'(X, Y, X, Y, true) :-
var(X), var(Y), !.
'$preprocess_args_for_commutative'(X, Y, X, Y, true) :-
var(X), integer(Y), \+ '$bignum'(Y), !.
'$preprocess_args_for_commutative'(X, Y, X, Z, Z = Y) :-
var(X), !.
'$preprocess_args_for_commutative'(X, Y, Y, X, true) :-
integer(X), \+ '$bignum'(X), var(Y), !.
'$preprocess_args_for_commutative'(X, Y, Z, X, Z = Y) :-
integer(X), \+ '$bignum'(X), !.
'$preprocess_args_for_commutative'(X, Y, Z, W, E) :-
'$do_and'(Z = X, Y = W, E).
'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
var(X), var(Y), !.
'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
var(X), integer(Y), \+ '$bignum'(Y), !.
'$preprocess_args_for_non_commutative'(X, Y, X, Z, Z = Y) :-
var(X), !.
'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
integer(X), \+ '$bignum'(X), var(Y), !.
'$preprocess_args_for_non_commutative'(X, Y, X, Z, Z = Y) :-
integer(X), \+ '$bignum'(X), !.
'$preprocess_args_for_non_commutative'(X, Y, Z, W, E) :-
'$do_and'(Z = X, Y = W, E).
'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod) :-
callable(NT),
atom(Mod).
%% contains_illegal_dcgnt(+Term) is semidet.
%
% True if Term contains a non-terminal we cannot deal with using
% goal-expansion. The test is too general approximation, but safe.
'$contains_illegal_dcgnt'(NT) :-
functor(NT, _, A),
between(1, A, I),
arg(I, NT, AI),
nonvar(AI),
( AI = ! ; AI = phrase(_,_,_) ), !.
% write(contains_illegal_nt(NT)), % JW: we do not want to write
% nl.
'$harmless_dcgexception'(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
'$harmless_dcgexception'(type_error(callable,_)). % ex: phrase(27,L)
:- set_value('$c_arith',true).
/**
@}
*/

168
packages/python/swig/yap4py/prolog/pl/arithpreds.yap
View File

@ -1,168 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arithpreds.yap *
* Last rev: *
* mods: *
* comments: arithmetical predicates *
* *
*************************************************************************/
%% @{
/**
@file arithpreds.yap
@addtogroup arithmetic_preds
*/
:- system_module(arithmetic_predicates, [
plus/3,
succ/2], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
/** @pred succ(? _Int1_:int, ? _Int2_:int) is det
*
True if _Int2_ = _Int1_ + 1 and _Int1_ \>= 0. At least
one of the arguments must be instantiated to a natural number. This
predicate raises the domain-error not_less_than_zero if called with
a negative integer. E.g. `succ(X, 0)` fails silently and `succ(X, -1)`
raises a domain-error. The behaviour to deal with natural numbers
only was defined by Richard O'Keefe to support the common
count-down-to-zero in a natural way.
*/
% M and N nonnegative integers, N is the successor of M
succ(M,N) :-
(
var(M)
->
(
integer(N),
N > 0
->
'$plus'(N,-1,M)
;
'$succ_error'(M,N)
)
;
integer(M),
M >= 0
->
(
var(N)
->
'$plus'(M,1,N)
;
integer(N),
N > 0
->
'$plus'(M,1,N)
;
'$succ_error'(M,N)
)
;
'$succ_error'(M,N)
).
'$succ_error'(M,N) :-
var(M),
var(N), !,
'$do_error'(instantiation_error,succ(M,N)).
'$succ_error'(M,N) :-
nonvar(M),
\+ integer(M),
'$do_error'(type_error(integer, M),succ(M,N)).
'$succ_error'(M,N) :-
nonvar(M),
M < 0,
'$do_error'(domain_error(not_less_than_zero, M),succ(M,N)).
'$succ_error'(M,N) :-
nonvar(N),
\+ integer(N),
'$do_error'(type_error(integer, N),succ(M,N)).
'$succ_error'(M,N) :-
nonvar(N),
N < 0,
'$do_error'(domain_error(not_less_than_zero, N),succ(M,N)).
/** @pred plus(? _Int1_:int, ? _Int2_:int, ? _Int3_:int) is det
True if _Int3_ = _Int1_ + _Int2_. At least two of the
three arguments must be instantiated to integers.
@}
*/
plus(X, Y, Z) :-
(
var(X)
->
(
integer(Y), integer(Z)
->
'$minus'(Z,Y,X)
;
'$plus_error'(X,Y,Z)
)
;
integer(X)
->
(
var(Y)
->
(
integer(Z)
->
'$minus'(Z,X,Y)
;
'$plus_error'(X,Y,Z)
)
;
integer(Y)
->
(
integer(Z)
->
'$minus'(Z,Y,X)
;
var(Z)
->
'$plus'(X,Y,Z)
;
'$plus_error'(X,Y,Z)
)
;
'$plus_error'(X,Y,Z)
)
;
'$plus_error'(X,Y,Z)
).
'$plus_error'(X,Y,Z) :-
nonvar(X),
\+ integer(X),
'$do_error'(type_error(integer, X),plus(X,Y,Z)).
'$plus_error'(X,Y,Z) :-
nonvar(Y),
\+ integer(Y),
'$do_error'(type_error(integer, Y),plus(X,Y,Z)).
'$plus_error'(X,Y,Z) :-
nonvar(Z),
\+ integer(Z),
'$do_error'(type_error(integer, Z),plus(X,Y,Z)).
'$plus_error'(X,Y,Z) :-
'$do_error'(instantiation_error,plus(X,Y,Z)).

107
packages/python/swig/yap4py/prolog/pl/arrays.yap
View File

@ -1,107 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: arrays.yap *
* Last rev: *
* mods: *
* comments: Array Manipulation *
* *
*************************************************************************/
%% @{
/**
@addtogroup YAPArrays
*/
%
% These are the array built-in predicates. They will only work if
% YAP_ARRAYS is defined in Yap.h
%
/** @pred array(+ _Name_, + _Size_)
Creates a new dynamic array. The _Size_ must evaluate to an
integer. The _Name_ may be either an atom (named array) or an
unbound variable (anonymous array).
Dynamic arrays work as standard compound terms, hence space for the
array is recovered automatically on backtracking.
*/
array(Obj, Size) :-
'$create_array'(Obj, Size).
% arithmetical optimization
'$c_arrays'((P:-Q),(NP:-QF)) :- !,
'$c_arrays_body'(Q, QI),
'$c_arrays_head'(P, NP, QI, QF).
'$c_arrays'(P, NP) :-
'$c_arrays_fact'(P, NP).
'$c_arrays_body'(P, P) :-
var(P), !.
'$c_arrays_body'((P0,Q0), (P,Q)) :- !,
'$c_arrays_body'(P0, P),
'$c_arrays_body'(Q0, Q).
'$c_arrays_body'((P0;Q0), (P;Q)) :- !,
'$c_arrays_body'(P0, P),
'$c_arrays_body'(Q0, Q).
'$c_arrays_body'((P0->Q0), (P->Q)) :- !,
'$c_arrays_body'(P0, P),
'$c_arrays_body'(Q0, Q).
'$c_arrays_body'(P, NP) :- '$c_arrays_lit'(P, NP).
%
% replace references to arrays to references to built-ins.
%
'$c_arrays_lit'(G, GL) :-
'$array_references'(G, NG, VL),
'$add_array_entries'(VL, NG, GL).
'$c_arrays_head'(G, NG, B, NB) :-
'$array_references'(G, NG, VL),
'$add_array_entries'(VL, B, NB).
'$c_arrays_fact'(G, NG) :-
'$array_references'(G, IG, VL),
(VL = [] -> NG = G;
NG = (IG :- NB), '$add_array_entries'(VL, true, NB)).
'$add_array_entries'([], NG, NG).
'$add_array_entries'([Head|Tail], G, (Head, NG)) :-
'$add_array_entries'(Tail, G, NG).
/** @pred static_array_properties(? _Name_, ? _Size_, ? _Type_)
Show the properties size and type of a static array with name
_Name_. Can also be used to enumerate all current
static arrays.
This built-in will silently fail if the there is no static array with
that name.
*/
static_array_properties(Name, Size, Type) :-
atom(Name), !,
'$static_array_properties'(Name, Size, Type).
static_array_properties(Name, Size, Type) :-
var(Name), !,
current_atom(Name),
'$static_array_properties'(Name, Size, Type).
static_array_properties(Name, Size, Type) :-
'$do_error'(type_error(atom,Name),static_array_properties(Name,Size,Type)).
%% @}

211
packages/python/swig/yap4py/prolog/pl/atoms.yap
View File

@ -1,211 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
* *
*************************************************************************/
/**
* @file atoms.yap
*
*/
:- system_module( '$_atoms', [
atom_concat/2,
string_concat/2,
atomic_list_concat/2,
atomic_list_concat/3,
current_atom/1], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
/**
* @addtogroup Predicates_on_Atoms
*
*/
/** @pred atom_concat(+ As, ? A)
The predicate holds when the first argument is a list of atoms, and the
second unifies with the atom obtained by concatenating all the atoms in
the first list.
*/
atom_concat(Xs,At) :-
( var(At) ->
'$atom_concat'(Xs, At )
;
'$atom_concat_constraints'(Xs, 0, At, Unbound),
'$process_atom_holes'(Unbound)
).
% the constraints are of the form hole: HoleAtom, Begin, Atom, End
'$atom_concat_constraints'([At], 0, At, []) :- !.
'$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
% just slice first atom
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
atom(At0), !,
sub_atom(At0, 0, _Sz, L, _Ata ),
sub_atom(At, _, L, 0, Atr ), %remainder
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our atom
'$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
% end of a run
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
atom(At0), !,
sub_atom(At, Next, _Sz, L, At0),
sub_atom(At, 0, Next, Next, At1),
sub_atom(At, _, L, 0, Atr), %remainder
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
'$process_atom_holes'([]).
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
sub_atom(At1, Next, _, 0, At0),
'$process_atom_holes'(Unbound).
'$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
sub_atom(At1, Next, Sz, _Left, At0),
Follow is Next+Sz,
'$process_atom_holes'(Unbound).
/** @pred atomic_list_concat(+ _As_,? _A_)
The predicate holds when the first argument is a list of atomic terms, and
the second unifies with the atom obtained by concatenating all the
atomic terms in the first list. The first argument thus may contain
atoms or numbers.
*/
atomic_list_concat(L,At) :-
atomic_concat(L, At).
/** @pred atomic_list_concat(? _As_,+ _Separator_,? _A_)
Creates an atom just like atomic_list_concat/2, but inserts
_Separator_ between each pair of atoms. For example:
~~~~~{.prolog}
?- atomic_list_concat([gnu, gnat], `, `, A).
A = `gnu, gnat`
~~~~~
YAP emulates the SWI-Prolog version of this predicate that can also be
used to split atoms by instantiating _Separator_ and _Atom_ as
shown below.
~~~~~{.prolog}
?- atomic_list_concat(L, -, 'gnu-gnat').
L = [gnu, gnat]
~~~~~
*/
atomic_list_concat(L, El, At) :-
var(El), !,
'$do_error'(instantiation_error,atomic_list_concat(L,El,At)).
atomic_list_concat(L, El, At) :-
ground(L), !,
'$add_els'(L,El,LEl),
atomic_concat(LEl, At).
atomic_list_concat(L, El, At) :-
nonvar(At), !,
'$atomic_list_concat_all'( At, El, L).
'$atomic_list_concat_all'( At, El, [A|L]) :-
sub_atom(At, Pos, 1, Left, El), !,
sub_atom(At, 0, Pos, _, A),
sub_atom(At, _, Left, 0, At1),
'$atomic_list_concat_all'( At1, El, L).
'$atomic_list_concat_all'( At, _El, [At]).
'$add_els'([A,B|L],El,[A,El|NL]) :- !,
'$add_els'([B|L],El,NL).
'$add_els'(L,_,L).
%
% small compatibility hack
'$singletons_in_term'(T,VL) :-
'$variables_in_term'(T,[],V10),
'$sort'(V10, V1),
'$non_singletons_in_term'(T,[],V20),
'$sort'(V20, V2),
'$subtract_lists_of_variables'(V2,V1,VL).
'$subtract_lists_of_variables'([],VL,VL).
'$subtract_lists_of_variables'([_|_],[],[]) :- !.
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],VL) :-
V1 == V2, !,
'$subtract_lists_of_variables'(VL1,VL2,VL).
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
/** @pred current_atom( _A_)
Checks whether _A_ is a currently defined atom. It is used to find all
currently defined atoms by backtracking.
*/
current_atom(A) :- % check
atom(A), !.
current_atom(A) :- % generate
'$current_atom'(A).
string_concat(Xs,At) :-
( var(At) ->
'$string_concat'(Xs, At )
;
'$string_concat_constraints'(Xs, 0, At, Unbound),
'$process_string_holes'(Unbound)
).
% the constraints are of the form hole: HoleString, Begin, String, End
'$string_concat_constraints'([At], 0, At, []) :- !.
'$string_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
% just slice first string
'$string_concat_constraints'([At0|Xs], 0, At, Unbound) :-
string(At0), !,
sub_string(At, 0, _Sz, L, At0 ),
sub_string(At, _, L, 0, Atr ), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our string
'$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
% end of a run
'$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
string(At0), !,
sub_string(At, Next, _Sz, L, At0),
sub_string(At, 0, Next, Next, At1),
sub_string(At, _, L, 0, Atr), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound).
'$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
'$process_string_holes'([]).
'$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
sub_string(At1, Next, _, 0, At0),
'$process_string_holes'(Unbound).
'$process_string_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
sub_string(At1, Next, Sz, _Left, At0),
Follow is Next+Sz,
'$process_string_holes'(Unbound).
/**
@}
*/

515
packages/python/swig/yap4py/prolog/pl/attributes.yap
View File

@ -1,515 +0,0 @@
pattr/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: atts.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: attribute support for Prolog *
* *
*************************************************************************/
/**
@file attributes.yap
@defgroup New_Style_Attribute_Declarations SWI Compatible attributes
@{
@ingroup attributes
*/
:- module('attributes', [delayed_goals/4]).
:- use_system_module( '$_boot', ['$undefp'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$coroutining', [attr_unify_hook/2]).
:- use_system_module( attributes, [all_attvars/1,
bind_attvar/1,
del_all_atts/1,
del_all_module_atts/2,
get_all_swi_atts/2,
get_module_atts/2,
modules_with_attributes/1,
put_att_term/2,
put_module_atts/2,
unbind_attvar/1,
woken_att_do/4]).
:- dynamic attributes:existing_attribute/4.
:- dynamic attributes:modules_with_attributes/1.
:- dynamic attributes:attributed_module/3.
:- multifile
attributes:attributed_module/3.
:- dynamic existing_attribute/4.
:- dynamic modules_with_attributes/1.
:- dynamic attributed_module/3.
/** @pred get_attr(+ _Var_,+ _Module_,- _Value_)
Request the current _value_ for the attribute named _Module_. If
_Var_ is not an attributed variable or the named attribute is not
associated to _Var_ this predicate fails silently. If _Module_
is not an atom, a type error is raised.
*/
prolog:get_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:get_module_atts(Var, AttTerm).
/**
@pred put_attr(+ _Var_,+ _Module_,+ _Value_)
If _Var_ is a variable or attributed variable, set the value for the
attribute named _Module_ to _Value_. If an attribute with this
name is already associated with _Var_, the old value is replaced.
Backtracking will restore the old value (i.e., an attribute is a mutable
term. See also `setarg/3`). This predicate raises a representation error if
_Var_ is not a variable and a type error if _Module_ is not an atom.
*/
prolog:put_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:put_module_atts(Var, AttTerm).
/** @pred del_attr(+ _Var_,+ _Module_)
Delete the named attribute. If _Var_ loses its last attribute it
is transformed back into a traditional Prolog variable. If _Module_
is not an atom, a type error is raised. In all other cases this
predicate succeeds regardless whether or not the named attribute is
present.
*/
prolog:del_attr(Var, Mod) :-
functor(AttTerm, Mod, 2),
attributes:del_all_module_atts(Var, AttTerm).
/** @pred del_attrs(+ _Var_)
If _Var_ is an attributed variable, delete <em>all</em> its
attributes. In all other cases, this predicate succeeds without
side-effects.
*/
prolog:del_attrs(Var) :-
attributes:del_all_atts(Var).
/**
@pred get_attrs(+ _Var_,- _Attributes_)
Get all attributes of _Var_. _Attributes_ is a term of the form
`att( _Module_, _Value_, _MoreAttributes_)`, where _MoreAttributes_ is
`[]` for the last attribute.
*/
prolog:get_attrs(AttVar, SWIAtts) :-
attributes:get_all_swi_atts(AttVar,SWIAtts).
/** @pred put_attrs(+ _Var_,+ _Attributes_)
Set all attributes of _Var_. See get_attrs/2 for a description of
_Attributes_.
*/
prolog:put_attrs(_, []).
prolog:put_attrs(V, Atts) :-
cvt_to_swi_atts(Atts, YapAtts),
attributes:put_att_term(V, YapAtts).
cvt_to_swi_atts([], _).
cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
ModAttribute =.. [Mod, YapAtts, Attribute],
cvt_to_swi_atts(Atts, YapAtts).
/** @pred copy_term(? _TI_,- _TF_,- _Goals_)
Term _TF_ is a variant of the original term _TI_, such that for
each variable _V_ in the term _TI_ there is a new variable _V'_
in term _TF_ without any attributes attached. Attributed
variables are thus converted to standard variables. _Goals_ is
unified with a list that represents the attributes. The goal
`maplist(call, _Goals_)` can be called to recreate the
attributes.
Before the actual copying, `copy_term/3` calls
`attribute_goals/1` in the module where the attribute is
defined.
*/
prolog:copy_term(Term, Copy, Gs) :-
term_attvars(Term, Vs),
( Vs == []
-> Gs = [],
copy_term(Term, Copy)
; findall(Term-Gs,
'$attributes':residuals_and_delete_attributes(Vs, Gs, Term),
[Copy-Gs])
).
residuals_and_delete_attributes(Vs, Gs, Term) :-
attvars_residuals(Vs, Gs, []),
delete_attributes(Term).
attvars_residuals([]) --> [].
attvars_residuals([V|Vs]) -->
{ nonvar(V) }, !,
attvars_residuals(Vs).
attvars_residuals([V|Vs]) -->
( { get_attrs(V, As) }
-> attvar_residuals(As, V)
; []
),
attvars_residuals(Vs).
%
% wake_up_goal is called by the system whenever a suspended goal
% resumes.
%
/* The first case may happen if this variable was used for dif.
In this case, we need a way to keep the original
suspended goal around
*/
%'$wake_up_goal'([Module1|Continuation],G) :-
% '$write'(4,vsc_woke:G+[Module1|Continuation]:'
%'), fail.
prolog:'$wake_up_goal'([Module1|Continuation], LG) :-
% writeln( [Module1|Continuation]:LG),
execute_woken_system_goals(LG),
do_continuation(Continuation, Module1).
%
% in the first two cases restore register immediately and proceed
% to continuation. In the last case take care with modules, but do
% not act as if a meta-call.
%
%
do_continuation('$cut_by'(X), _) :- !,
'$$cut_by'(X).
do_continuation('$restore_regs'(X), _) :- !,
% yap_flag(gc_trace,verbose),
% garbage_collect,
'$restore_regs'(X).
do_continuation('$restore_regs'(X,Y), _) :- !,
% yap_flag(gc_trace,verbose),
% garbage_collect,
'$restore_regs'(X,Y).
do_continuation(Continuation, Module1) :-
execute_continuation(Continuation,Module1).
execute_continuation(Continuation, Module1) :-
'$undefined'(Continuation, Module1), !,
'$current_module'( M ),
current_prolog_flag( M:unknown, Default ),
'$undefp'([Module1|Continuation] , Default ).
execute_continuation(Continuation, Mod) :-
% do not do meta-expansion nor any fancy stuff.
'$execute0'(Continuation, Mod).
execute_woken_system_goals([]).
execute_woken_system_goals(['$att_do'(V,New)|LG]) :-
execute_woken_system_goals(LG),
call_atts(V,New).
%
% what to do when an attribute gets bound
%
call_atts(V,_) :-
nonvar(V), !.
call_atts(V,_) :-
'$att_bound'(V), !.
call_atts(V,New) :-
attributes:get_all_swi_atts(V,SWIAtts),
(
'$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes)
->
LGoals = [],
DoNotBind = false
;
attributes:woken_att_do(V, New, LGoals, DoNotBind)
),
( DoNotBind == true
->
attributes:unbind_attvar(V)
;
attributes:bind_attvar(V)
),
do_hook_attributes(SWIAtts, New),
lcall(LGoals).
do_hook_attributes([], _).
do_hook_attributes(att(Mod,Att,Atts), Binding) :-
('$undefined'(attr_unify_hook(Att,Binding), Mod)
->
true
;
Mod:attr_unify_hook(Att, Binding)
),
do_hook_attributes(Atts, Binding).
lcall([]).
lcall([Mod:Gls|Goals]) :-
lcall2(Gls,Mod),
lcall(Goals).
lcall2([], _).
lcall2([Goal|Goals], Mod) :-
call(Mod:Goal),
lcall2(Goals, Mod).
/** @pred call_residue_vars(: _G_, _L_)
Call goal _G_ and unify _L_ with a list of all constrained variables created <em>during</em> execution of _G_:
~~~~~
?- dif(X,Z), call_residue_vars(dif(X,Y),L).
dif(X,Z), call_residue_vars(dif(X,Y),L).
L = [Y],
dif(X,Z),
dif(X,Y) ? ;
no
~~~~~
*/
prolog:call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
attributes:all_attvars(Vs),
% this should not be actually strictly necessary right now.
% but it makes it a safe bet.
sort(Vs, Vss),
sort(Vs0, Vs0s),
'$ord_remove'(Vss, Vs0s, Residue).
'$ord_remove'([], _, []).
'$ord_remove'([V|Vs], [], [V|Vs]).
'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
( V1 == V2 ->
'$ord_remove'(Vss, Vs0s, Residue)
;
V1 @< V2 ->
Residue = [V1|ResidueF],
'$ord_remove'(Vss, [V2|Vs0s], ResidueF)
;
'$ord_remove'([V1|Vss], Vs0s, Residue)
).
/** @pred attribute_goals(+ _Var_,- _Gs_,+ _GsRest_)
This nonterminal, if it is defined in a module, is used by _copy_term/3_
to project attributes of that module to residual goals. It is also
used by the toplevel to obtain residual goals after executing a query.
Normal user code should deal with put_attr/3, get_attr/3 and del_attr/2.
The routines in this section fetch or set the entire attribute list of a
variables. Use of these predicates is anticipated to be restricted to
printing and other special purpose operations.
*/
/** @pred _Module_:attribute_goal( _-Var_, _-Goal_)
User-defined procedure, called to convert the attributes in _Var_ to
a _Goal_. Should fail when no interpretation is available.
*/
attvar_residuals(att(Module,Value,As), V) -->
( { nonvar(V) }
-> % a previous projection predicate could have instantiated
% this variable, for example, to avoid redundant goals
[]
; generate_goals( V, As, Value, Module)
).
generate_goals( V, _, Value, Module) -->
{ attributes:module_has_attributes(Module) },
% like run, put attributes back first
{ Value =.. [Name,_|Vs],
NValue =.. [Name,_|Vs],
attributes:put_module_atts(V,NValue)
},
{ current_predicate(Module:attribute_goal/2) },
{ call(Module:attribute_goal(V, Goal)) },
dot_list(Goal),
[put_attr(V, Module, Value)].
generate_goals( V, _, _Value , Module) -->
{ '$pred_exists'(attribute_goals(_,_,_), Module) },
call(Module:attribute_goals(V) ).
attributes:module_has_attributes(Mod) :-
attributes:attributed_module(Mod, _, _), !.
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
dot_list((A,B)) --> !, dot_list(A), dot_list(B).
dot_list(A) --> [A].
delete_attributes(Term) :-
term_attvars(Term, Vs),
delete_attributes_(Vs).
delete_attributes_([]).
delete_attributes_([V|Vs]) :-
del_attrs(V),
delete_attributes_(Vs).
/** @pred call_residue(: _G_, _L_)
Call goal _G_. If subgoals of _G_ are still blocked, return
a list containing these goals and the variables they are blocked in. The
goals are then considered as unblocked. The next example shows a case
where dif/2 suspends twice, once outside call_residue/2,
and the other inside:
~~~~~
?- dif(X,Y),
call_residue((dif(X,Y),(X = f(Z) ; Y = f(Z))), L).
X = f(Z),
L = [[Y]-dif(f(Z),Y)],
dif(f(Z),Y) ? ;
Y = f(Z),
L = [[X]-dif(X,f(Z))],
dif(X,f(Z)) ? ;
no
~~~~~
The system only reports one invocation of dif/2 as having
suspended.
*/
prolog:call_residue(Goal,Residue) :-
var(Goal), !,
'$do_error'(instantiation_error,call_residue(Goal,Residue)).
prolog:call_residue(Module:Goal,Residue) :-
atom(Module), !,
call_residue(Goal,Module,Residue).
prolog:call_residue(Goal,Residue) :-
'$current_module'(Module),
call_residue(Goal,Module,Residue).
call_residue(Goal,Module,Residue) :-
prolog:call_residue_vars(Module:Goal,NewAttVars),
(
attributes:modules_with_attributes([_|_])
->
project_attributes(NewAttVars, Module:Goal)
;
true
),
copy_term(Goal, Goal, Residue).
attributes:delayed_goals(G, Vs, NVs, Gs) :-
project_delayed_goals(G),
% term_factorized([G|Vs], [_|NVs], Gs).
copy_term([G|Vs], [_|NVs], Gs).
project_delayed_goals(G) :-
% SICStus compatible step,
% just try to simplify store by projecting constraints
% over query variables.
% called by top_level to find out about delayed goals
attributes:modules_with_attributes([_|_]), !,
attributes:all_attvars(LAV),
LAV = [_|_],
project_attributes(LAV, G), !.
project_delayed_goals(_).
attributed(G, Vs) :-
term_variables(G, LAV),
att_vars(LAV, Vs).
att_vars([], []).
att_vars([V|LGs], [V|AttVars]) :- attvar(V), !,
att_vars(LGs, AttVars).
att_vars([_|LGs], AttVars) :-
att_vars(LGs, AttVars).
% make sure we set the suspended goal list to its previous state!
% make sure we have installed a SICStus like constraint solver.
/** @pred _Module_:project_attributes(+AttrVars, +Goal)
Given a goal _Goa]l_ with variables _QueryVars_ and list of attributed
variables _AttrVars_, project all attributes in _AttrVars_ to
_QueryVars_. Although projection is constraint system dependent,
typically this will involve expressing all constraints in terms of
_QueryVars_ and considering all remaining variables as existentially
quantified.
Projection interacts with attribute_goal/2 at the Prolog top
level. When the query succeeds, the system first calls
project_attributes/2. The system then calls
attribute_goal/2 to get a user-level representation of the
constraints. Typically, project_attributes/2 will convert from the
original constraints into a set of new constraints on the projection,
and these constraints are the ones that will have an
attribute_goal/2 handler.
*/
project_attributes(AllVs, G) :-
attributes:modules_with_attributes(LMods),
LMods = [_|_],
term_variables(G, InputVs),
pick_att_vars(InputVs, AttIVs),
project_module(LMods, AttIVs, AllVs).
pick_att_vars([],[]).
pick_att_vars([V|L],[V|NL]) :- attvar(V), !,
pick_att_vars(L,NL).
pick_att_vars([_|L],NL) :-
pick_att_vars(L,NL).
project_module([], _, _).
project_module([Mod|LMods], LIV, LAV) :-
'$pred_exists'(project_attributes(LIV, LAV),Mod),
call(Mod:project_attributes(LIV, LAV)), !,
attributes:all_attvars(NLAV),
project_module(LMods,LIV,NLAV).
project_module([_|LMods], LIV, LAV) :-
project_module(LMods,LIV,LAV).
%% @}

1661
packages/python/swig/yap4py/prolog/pl/boot.yap
View File

File diff suppressed because it is too large Load Diff

140
packages/python/swig/yap4py/prolog/pl/bootlists.yap
View File

@ -1,140 +0,0 @@
/**
* @file bootlists.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 09:54:00 2015
*
* @addtogroup lists
* @{
*/
:- system_module( '$_lists', [], []).
:- set_prolog_flag(source, true). % source.
% memberchk(+Element, +Set)
% means the same thing, but may only be used to test whether a known
% Element occurs in a known Set. In return for this limited use, it
% is more efficient when it is applicable.
/** @pred memberchk(+ _Element_, + _Set_)
As member/2, but may only be used to test whether a known
_Element_ occurs in a known Set. In return for this limited use, it
is more efficient when it is applicable.
*/
lists:memberchk(X,[X|_]) :- !.
lists:memberchk(X,[_|L]) :-
lists:memberchk(X,L).
%% member(?Element, ?Set)
% is true when Set is a list, and Element occurs in it. It may be used
% to test for an element or to enumerate all the elements by backtracking.
% Indeed, it may be used to generate the Set!
/** @pred member(? _Element_, ? _Set_)
True when _Set_ is a list, and _Element_ occurs in it. It may be used
to test for an element or to enumerate all the elements by backtracking.
*/
lists:member(X,[X|_]).
lists:member(X,[_|L]) :-
lists:member(X,L).
%% @pred identical_member(?Element, ?Set) is nondet
%
% identical_member holds true when Set is a list, and Element is
% exactly identical to one of the elements that occurs in it.
lists:identical_member(X,[Y|M]) :-
(
X == Y
;
M \= [], lists:identical_member(X,M)
).
/** @pred append(? _List1_,? _List2_,? _List3_)
Succeeds when _List3_ unifies with the concatenation of _List1_
and _List2_. The predicate can be used with any instantiation
pattern (even three variables).
*/
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
lists:append(T, L, R).
:- set_prolog_flag(source, true). % :- no_source.
% lists:delete(List, Elem, Residue)
% is true when List is a list, in which Elem may or may not occur, and
% Residue is a copy of List with all elements identical to Elem lists:deleted.
/** @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) :-
Head = Elem,
lists:delete(List, Elem, Residue).
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).
:- set_prolog_flag(source, false). % disable source.
% length of a list.
/** @pred length(? _L_,? _S_)
Unify the well-defined list _L_ with its length. The procedure can
be used to find the length of a pre-defined list, or to build a list
of length _S_.
*/
prolog:length(L, M) :-
'$skip_list'(L, M, M0, R),
( var(R) -> '$$_length'(R, M, M0) ;
R == []
).
%
% in case A1 is unbound or a difference list, things get tricky
%
'$$_length'(R, M, M0) :-
( var(M) -> '$$_length1'(R,M,M0)
; M >= M0 -> '$$_length2'(R,M,M0) ).
%
% Size is unbound, generate lists
%
'$$_length1'([], M, M).
'$$_length1'([_|L], O, N) :-
M is N + 1,
'$$_length1'(L, O, M).
%
% Size is bound, generate single list
%
'$$_length2'(NL, O, N) :-
( N =:= O -> NL = [];
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
%% @}

152
packages/python/swig/yap4py/prolog/pl/callcount.yap
View File

@ -1,152 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: callcount.yap *
* Last rev: 8/2/02 *
* mods: *
* comments: Some profiling predicates available in yap *
* *
*************************************************************************/
%% @{
/** @defgroup Profiling Profiling Prolog Programs
@ingroup extensions
YAP includes two profilers. The count profiler keeps information on the
number of times a predicate was called. This information can be used to
detect what are the most commonly called predicates in the program. The
count profiler can be compiled by setting YAP's flag profiling
to `on`. The time-profiler is a `gprof` profiler, and counts
how many ticks are being spent on specific predicates, or on other
system functions such as internal data-base accesses or garbage collects.
The YAP profiling sub-system is currently under
development. Functionality for this sub-system will increase with newer
implementation.
*/
%% @{
/** @defgroup Call_Counting Counting Calls
@ingroup Profiling
Predicates compiled with YAP's flag call_counting set to
`on` update counters on the numbers of calls and of
retries. Counters are actually decreasing counters, so that they can be
used as timers. Three counters are available:
+ `calls`: number of predicate calls since execution started or since
system was reset;
+ `retries`: number of retries for predicates called since
execution started or since counters were reset;
+ `calls_and_retries`: count both on predicate calls and
retries.
These counters can be used to find out how many calls a certain
goal takes to execute. They can also be used as timers.
The code for the call counters piggybacks on the profiling
code. Therefore, activating the call counters also activates the profiling
counters.
These are the predicates that access and manipulate the call counters.
*/
:- system_module( '$_callcount', [call_count/3,
call_count_data/3,
call_count_reset/0], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
/** @pred call_count_data(- _Calls_, - _Retries_, - _CallsAndRetries_)
Give current call count data. The first argument gives the current value
for the _Calls_ counter, next the _Retries_ counter, and last
the _CallsAndRetries_ counter.
*/
call_count_data(Calls, Retries, Both) :-
'$call_count_info'(Calls, Retries, Both).
/** @pred call_count_reset
Reset call count counters. All timers are also reset.
*/
call_count_reset :-
'$call_count_reset'.
/** @pred call_count(? _CallsMax_, ? _RetriesMax_, ? _CallsAndRetriesMax_)
Set call counters as timers. YAP will generate an exception
if one of the instantiated call counters decreases to 0:
+ _CallsMax_
throw the exception `call_counter` when the
counter `calls` reaches 0;
+ _RetriesMax_
throw the exception `retry_counter` when the
counter `retries` reaches 0;
+ _CallsAndRetriesMax_
throw the exception
`call_and_retry_counter` when the counter `calls_and_retries`
reaches 0.
YAP will ignore counters that are called with unbound arguments.
Next, we show a simple example of how to use call counters:
~~~~~{.prolog}
?- yap_flag(call_counting,on), [-user]. l :- l. end_of_file. yap_flag(call_counting,off).
yes
yes
?- catch((call_count(10000,_,_),l),call_counter,format("limit_exceeded.~n",[])).
limit_exceeded.
yes
~~~~~
Notice that we first compile the looping predicate `l/0` with
call_counting `on`. Next, we catch/3 to handle an
exception when `l/0` performs more than 10000 reductions.
*/
call_count(Calls, Retries, Both) :-
'$check_if_call_count_on'(Calls, CallsOn),
'$check_if_call_count_on'(Retries, RetriesOn),
'$check_if_call_count_on'(Both, BothOn),
'$call_count_set'(Calls, CallsOn, Retries, RetriesOn, Both, BothOn).
'$check_if_call_count_on'(Calls, 1) :- integer(Calls), !.
'$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
'$check_if_call_count_on'(Calls, A) :-
'$do_error'(type_error(integer,Calls),call_count(A)).
%% @}
/**
@}
*/

173
packages/python/swig/yap4py/prolog/pl/checker.yap
View File

@ -1,173 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: checker.yap *
* comments: style checker for Prolog *
* *
* Last rev: $Date: 2008-03-31 22:56:22 $,$Author: vsc $ *
* *
*************************************************************************/
:- system_module( style_checker, [no_style_check/1,
style_check/1], ['$check_term'/5,
'$sv_warning'/2,
'$syntax_check_discontiguous'/2,
'$syntax_check_multiple'/2,
'$syntax_check_single_var'/2]).
%% @{
/**
@defgroup YAPStyle Checker
@ingroup YAPCompilerSettings
YAP implements a style-checker thay currently verifies whether:
1 named variables occur once in a clause.
2 clauses from dofferent predicates are mixed together.
3 clauses for the same predicate occur in different files.
One can declare a predicate to be discontiguous (see the
discontiguous/1 declaration) and/or multifile/1.
*/
/*
@pred style_check(+ _X_)
Turns on style checking according to the attribute specified by _X_,
which must be one of the following:
+ single_var
Checks single occurrences of named variables in a clause.
+ discontiguous
Checks non-contiguous clauses for the same predicate in a file.
+ multiple
Checks the presence of clauses for the same predicate in more than one
file when the predicate has not been declared as `multifile`
+ all
Performs style checking for all the cases mentioned above.
By default, style checking is disabled in YAP unless we are in
`sicstus` or `iso` language mode.
The style_check/1 built-in is now deprecated. Please use
`set_prolog_flag/1` instead.
**/
%
% A Small style checker for YAP
:- op(1150, fx, [multifile,discontiguous]).
style_check(V) :- var(V), !, fail.
style_check(V) :-
\+atom(V),
\+ is_list(V),
V \= + _,
V \= - _, !,
'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
style_check(V) :-
\+atom(V),
\+ is_list(V),
V \= + _,
V \= + _, !,
'$do_error'( domain_error(style_name, V), style_check(V) ).
style_check(all) :-
style_check( [ singleton, discontiguous, multiple ] ).
style_check(+X) :-
style_check(X).
style_check(single_var) :-
style_check( singleton ).
style_check(singleton) :-
yap_flag( single_var_warnings, true ).
style_check(-single_var) :-
yap_flag( single_var_warnings, false ).
style_check(-singleton) :-
yap_flag( single_var_warnings, false ).
style_check(discontiguous) :-
yap_flag( discontiguous_warnings, true ).
style_check(-discontiguous) :-
yap_flag( discontiguous_warnings, false ).
style_check(multiple) :-
yap_flag( redefine_warnings, true ).
style_check(-multiple) :-
yap_flag( redefine_warnings, false ).
style_check(no_effect).
style_check(+no_effect) .
style_check(-no_effect).
style_check(var_branches).
style_check(+var_branches) :-
'$style_checker'( [ var_branches ] ).
style_check(-var_branches) :-
'$style_checker'( [ -var_branches ] ).
style_check(atom).
style_check(+atom) :-
'$style_checker'( [ atom ] ).
style_check(-atom) :-
'$style_checker'( [ -atom ] ).
style_check(charset) :-
'$style_checker'( [ charset ] ).
style_check(+charset) :-
'$style_checker'( [ charset ] ).
style_check(-charset) :-
'$style_checker'( [ -charset ] ).
style_check('?'(Info) ) :-
L = [ singleton, discontiguous, multiple ],
( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
style_check([]).
style_check([H|T]) :- style_check(H), style_check(T).
/** @pred no_style_check(+ _X_)
Turns off style checking according to the attribute specified by
_X_, which have the same meaning as in style_check/1.
The no_style_check/1 built-in is now deprecated. Please use
`set_prolog_flag/1` instead.
**/
no_style_check(V) :- var(V), !, fail.
no_style_check(all) :-
'$style_checker'( [ -singleton, -discontiguous, -multiple ] ).
no_style_check(-single_var) :-
'$style_checker'( [ -singleton ] ).
no_style_check(-singleton) :-
'$style_checker'( [ -singleton ] ).
no_style_check(-discontiguous) :-
'$style_checker'( [ -discontiguous ] ).
no_style_check(-multiple) :-
'$style_checker'( [ -multiple ] ).
no_style_check([]).
no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
/** @pred discontiguous(+ _G_) is iso
Avoid warnings from the sytax checker.
Declare that the predicate _G_ or list of predicates are discontiguous
procedures, that is, clauses for discontigous procedures may be
separated by clauses from other procedures.
*/
discontiguous(P) :- '$discontiguous'(P).
/*
@}
*/

1604
packages/python/swig/yap4py/prolog/pl/consult.yap
View File

File diff suppressed because it is too large Load Diff

648
packages/python/swig/yap4py/prolog/pl/control.yap
View File

@ -1,648 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: control.yap *
* Last rev: 20/08/09 *
* mods: *
* comments: control predicates available in yap *
* *
*************************************************************************/
/**
* @file control.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 10:26:35 2015
*
* @brief Control Predicates
*
*
*/
:- system_module( '$_control', [at_halt/1,
b_getval/2,
break/0,
call/2,
call/3,
call/4,
call/5,
call/6,
call/7,
call/8,
call/9,
call/10,
call/11,
call/12,
call_cleanup/2,
call_cleanup/3,
forall/2,
garbage_collect/0,
garbage_collect_atoms/0,
gc/0,
grow_heap/1,
grow_stack/1,
halt/0,
halt/1,
if/3,
ignore/1,
nb_getval/2,
nogc/0,
notrace/1,
once/1,
prolog_current_frame/1,
prolog_initialization/1,
setup_call_catcher_cleanup/4,
setup_call_cleanup/3,
version/0,
version/1], ['$run_atom_goal'/1,
'$set_toplevel_hook'/1]).
:- use_system_module( '$_boot', ['$call'/4,
'$disable_debugging'/0,
'$do_live'/0,
'$enable_debugging'/0,
'$system_catch'/4,
'$version'/0]).
:- use_system_module( '$_debug', ['$init_debugger'/0]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_utils', ['$getval_exception'/3]).
:- use_system_module( '$coroutining', [freeze_goal/2]).
/**
@addtogroup YAPControl
%% @{
*/
/** @pred once(: _G_) is iso
Execute the goal _G_ only once. The predicate is defined by:
~~~~~{.prolog}
once(G) :- call(G), !.
~~~~~
Note that cuts inside once/1 can only cut the other goals inside
once/1.
*/
once(G) :-
strip_module(G, M, C),
'$meta_call'(C, M),
!.
/** @pred forall(: _Cond_,: _Action_)
For all alternative bindings of _Cond_ _Action_ can be
proven. The example verifies that all arithmetic statements in the list
_L_ are correct. It does not say which is wrong if one proves wrong.
~~~~~{.prolog}
?- forall(member(Result = Formula, [2 = 1 + 1, 4 = 2 * 2]),
Result =:= Formula).
~~~~~
*/
/** @pred forall(+ _Cond_,+ _Action_)
For all alternative bindings of _Cond_ _Action_ can be proven.
The next example verifies that all arithmetic statements in the list
_L_ are correct. It does not say which is wrong if one proves wrong.
~~~~~
?- forall(member(Result = Formula, [2 = 1 + 1, 4 = 2 * 2]),
Result =:= Formula).
~~~~~
*/
forall(Cond, Action) :- \+((Cond, \+(Action))).
/** @pred ignore(: _Goal_)
Calls _Goal_ as once/1, but succeeds, regardless of whether
`Goal` succeeded or not. Defined as:
~~~~~{.prolog}
ignore(Goal) :-
Goal, !.
ignore(_).
~~~~~
*/
ignore(Goal) :- (Goal->true;true).
notrace(G) :-
strip_module(G, M, G1),
( '$$save_by'(CP),
'$debug_stop'( State ),
'$call'(G1, CP, G, M),
'$$save_by'(CP2),
(CP == CP2 -> ! ; '$debug_state'( NState ), ( true ; '$debug_restart'(NState), fail ) ),
'$debug_restart'( State )
;
'$debug_restart'( State ),
fail
).
/** @pred if(? _G_,? _H_,? _I_)
Call goal _H_ once per each solution of goal _H_. If goal
_H_ has no solutions, call goal _I_.
The built-in `if/3` is similar to `->/3`, with the difference
that it will backtrack over the test goal. Consider the following
small data-base:
~~~~~{.prolog}
a(1). b(a). c(x).
a(2). b(b). c(y).
~~~~~
Execution of an `if/3` query will proceed as follows:
~~~~~{.prolog}
?- if(a(X),b(Y),c(Z)).
X = 1,
Y = a ? ;
X = 1,
Y = b ? ;
X = 2,
Y = a ? ;
X = 2,
Y = b ? ;
no
~~~~~
The system will backtrack over the two solutions for `a/1` and the
two solutions for `b/1`, generating four solutions.
Cuts are allowed inside the first goal _G_, but they will only prune
over _G_.
If you want _G_ to be deterministic you should use if-then-else, as
it is both more efficient and more portable.
*/
if(X,Y,Z) :-
(
CP is '$last_choice_pt',
'$call'(X,CP,if(X,Y,Z),M),
'$execute'(X),
'$clean_ifcp'(CP),
'$call'(Y,CP,if(X,Y,Z),M)
;
'$call'(Z,CP,if(X,Y,Z),M)
).
call(X,A) :- '$execute'(X,A).
call(X,A1,A2) :- '$execute'(X,A1,A2).
/** @pred call(+ _Closure_,...,? _Ai_,...) is iso
Meta-call where _Closure_ is a closure that is converted into a goal by
appending the _Ai_ additional arguments. The number of arguments varies
between 0 and 10.
*/
call(X,A1,A2,A3) :- '$execute'(X,A1,A2,A3).
call(X,A1,A2,A3,A4) :- '$execute'(X,A1,A2,A3,A4).
call(X,A1,A2,A3,A4,A5) :- '$execute'(X,A1,A2,A3,A4,A5).
call(X,A1,A2,A3,A4,A5,A6) :- '$execute'(X,A1,A2,A3,A4,A5,A6).
call(X,A1,A2,A3,A4,A5,A6,A7) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7).
call(X,A1,A2,A3,A4,A5,A6,A7,A8) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8).
call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9).
call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10).
call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11).
/** @pred call_cleanup(: _Goal_, : _CleanUpGoal_)
This is similar to call_cleanup/1 but with an additional
_CleanUpGoal_ which gets called after _Goal_ is finished.
*/
call_cleanup(Goal, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
call_cleanup(Goal, Catcher, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
/** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
Calls `(Setup, Goal)`. For each sucessful execution of _Setup_,
calling _Goal_, the cleanup handler _Cleanup_ is guaranteed to be
called exactly once. This will happen after _Goal_ completes, either
through failure, deterministic success, commit, or an exception.
_Setup_ will contain the goals that need to be protected from
asynchronous interrupts such as the ones received from
`call_with_time_limit/2` or thread_signal/2. In most uses, _Setup_
will perform temporary side-effects required by _Goal_ that are
finally undone by _Cleanup_.
*/
setup_call_cleanup(Setup,Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
/** @pred call_with_args(+ _Name_,...,? _Ai_,...)
Meta-call where _Name_ is the name of the procedure to be called and
the _Ai_ are the arguments. The number of arguments varies between 0
and 10. New code should use `call/N` for better portability.
If _Name_ is a complex term, then call_with_args/n behaves as
call/n:
~~~~~{.prolog}
call(p(X1,...,Xm), Y1,...,Yn) :- p(X1,...,Xm,Y1,...,Yn).
~~~~~
*/
%%% Some "dirty" predicates
% Only efective if yap compiled with -DDEBUG
% this predicate shows the code produced by the compiler
'$show_code' :- '$debug'(0'f). %' just make emacs happy
/** @pred grow_heap(+ _Size_)
Increase heap size _Size_ kilobytes.
*/
grow_heap(X) :- '$grow_heap'(X).
/** @pred grow_stack(+ _Size_)
Increase stack size _Size_ kilobytes
*/
grow_stack(X) :- '$grow_stack'(X).
%
% gc() expects to be called from "call". Make sure it has an
% environment to return to.
%
%garbage_collect :- save(dump), '$gc', save(dump2).
/** @pred garbage_collect
The goal `garbage_collect` forces a garbage collection.
*/
garbage_collect :-
'$gc'.
/** @pred gc
The goal `gc` enables garbage collection. The same as
`yap_flag(gc,on)`.
*/
gc :-
yap_flag(gc,on).
/** @pred nogc
The goal `nogc` disables garbage collection. The same as
`yap_flag(gc,off)`.
*/
nogc :-
yap_flag(gc,off).
/** @pred garbage_collect_atoms
The goal `garbage_collect` forces a garbage collection of the atoms
in the data-base. Currently, only atoms are recovered.
*/
garbage_collect_atoms :-
'$atom_gc'.
'$force_environment_for_gc'.
'$good_list_of_character_codes'(V) :- var(V), !.
'$good_list_of_character_codes'([]).
'$good_list_of_character_codes'([X|L]) :-
'$good_character_code'(X),
'$good_list_of_character_codes'(L).
'$good_character_code'(X) :- var(X), !.
'$good_character_code'(X) :- integer(X), X > -2, X < 256.
/** @pred prolog_initialization( _G_)
Add a goal to be executed on system initialization. This is compatible
with SICStus Prolog's initialization/1.
*/
prolog_initialization(G) :- var(G), !,
'$do_error'(instantiation_error,initialization(G)).
prolog_initialization(T) :- callable(T), !,
'$assert_init'(T).
prolog_initialization(T) :-
'$do_error'(type_error(callable,T),initialization(T)).
'$assert_init'(T) :- recordz('$startup_goal',T,_), fail.
'$assert_init'(_).
/** @pred version
Write YAP's boot message.
*/
version :- '$version'.
/** @pred version(- _Message_)
Add a message to be written when yap boots or after aborting. It is not
possible to remove messages.
*/
version(V) :- var(V), !,
'$do_error'(instantiation_error,version(V)).
version(T) :- atom(T), !, '$assert_version'(T).
version(T) :-
'$do_error'(type_error(atom,T),version(T)).
'$assert_version'(T) :- recordz('$version',T,_), fail.
'$assert_version'(_).
'$set_toplevel_hook'(_) :-
recorded('$toplevel_hooks',_,R),
erase(R),
fail.
'$set_toplevel_hook'(H) :-
recorda('$toplevel_hooks',H,_),
fail.
'$set_toplevel_hook'(_).
%% @}
%% @{
%% @addtogroup Global_Variables
/** @pred nb_getval(+ _Name_, - _Value_)
The nb_getval/2 predicate is a synonym for b_getval/2,
introduced for compatibility and symmetry. As most scenarios will use
a particular global variable either using non-backtrackable or
backtrackable assignment, using nb_getval/2 can be used to
document that the variable is used non-backtrackable.
*/
/** @pred nb_getval(+ _Name_,- _Value_)
The nb_getval/2 predicate is a synonym for b_getval/2, introduced for
compatibility and symmetry. As most scenarios will use a particular
global variable either using non-backtrackable or backtrackable
assignment, using nb_getval/2 can be used to document that the
variable is used non-backtrackable.
*/
nb_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) ->
nb_getval(GlobalVariable, Val)
;
'$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val))
).
/** @pred b_getval(+ _Name_, - _Value_)
Get the value associated with the global variable _Name_ and unify
it with _Value_. Note that this unification may further
instantiate the value of the global variable. If this is undesirable
the normal precautions (double negation or copy_term/2) must be
taken. The b_getval/2 predicate generates errors if _Name_ is not
an atom or the requested variable does not exist.
Notice that for compatibility with other systems _Name_ <em>must</em> be already associated with a term: otherwise the system will generate an error.
*/
/** @pred b_getval(+ _Name_,- _Value_)
Get the value associated with the global variable _Name_ and unify
it with _Value_. Note that this unification may further instantiate
the value of the global variable. If this is undesirable the normal
precautions (double negation or copy_term/2) must be taken. The
b_getval/2 predicate generates errors if _Name_ is not an atom or
the requested variable does not exist.
*/
b_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) ->
true
;
'$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val))
).
%% @}
%% @{
%% @addtogroup YAPControl
/* This is the break predicate,
it saves the importante data about current streams and
debugger state */
'$debug_state'(state(Trace, Debug, Jump, Run, SPY_GN, GList)) :-
'$init_debugger',
nb_getval('$trace',Trace),
nb_getval('$debug_jump',Jump),
nb_getval('$debug_run',Run),
current_prolog_flag(debug, Debug),
nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList).
'$debug_stop'( State ) :-
'$debug_state'( State ),
b_setval('$trace',off),
% 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),
set_prolog_flag(debug, Debug),
b_setval('$debug_jump',Jump),
b_setval('$debug_run',Run),
b_setval('$trace',Trace),
'$enable_debugging'.
/** @pred break
Suspends the execution of the current goal and creates a new execution
level similar to the top level, displaying the following message:
~~~~~{.prolog}
[ Break (level <number>) ]
~~~~~
telling the depth of the break level just entered. To return to the
previous level just type the end-of-file character or call the
end_of_file predicate. This predicate is especially useful during
debugging.
*/
break :-
'$init_debugger',
nb_getval('$trace',Trace),
nb_setval('$trace',off),
nb_getval('$debug_jump',Jump),
nb_getval('$debug_run',Run),
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),
current_prolog_flag(break_level, BL ),
NBL is BL+1,
set_prolog_flag(break_level, NBL ),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!,
set_value('$live','$true'),
b_setval('$spy_glist',GList),
nb_setval('$spy_gn',SPY_GN),
set_input(InpStream),
set_output(OutStream),
set_prolog_flag(debug, Debug),
nb_setval('$debug_jump',Jump),
nb_setval('$debug_run',Run),
nb_setval('$trace',Trace),
set_prolog_flag(break_level, BL ),
'$break'( false ).
at_halt(G) :-
recorda('$halt', G, _),
fail.
at_halt(_).
/** @pred halt is iso
Halts Prolog, and exits to the calling application. In YAP,
halt/0 returns the exit code `0`.
*/
halt :-
print_message(informational, halt),
fail.
halt :-
halt(0).
/** @pred halt(+ _I_) is iso
Halts Prolog, and exits to 1the calling application returning the code
given by the integer _I_.
*/
halt(_) :-
recorded('$halt', G, _),
catch(once(G), Error, user:'$Error'(Error)),
fail.
halt(X) :-
'$sync_mmapped_arrays',
set_value('$live','$false'),
'$halt'(X).
prolog_current_frame(Env) :-
Env is '$env'.
'$run_atom_goal'(GA) :-
'$current_module'(Module),
atom_to_term(GA, G, _),
catch(once(Module:G), Error,user:'$Error'(Error)).
'$add_dot_to_atom_goal'([],[0'.]) :- !. %'
'$add_dot_to_atom_goal'([0'.],[0'.]) :- !.
'$add_dot_to_atom_goal'([C|Gs0],[C|Gs]) :-
'$add_dot_to_atom_goal'(Gs0,Gs).
/**
@}
*/

581
packages/python/swig/yap4py/prolog/pl/corout.yap
View File

@ -1,581 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: corout.pl *
* Last rev: *
* mods: *
* comments: Coroutines implementation *
* *
*************************************************************************/
/**
* @file corout.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Mon Nov 16 22:47:27 2015
* *
*/
:- module('$coroutining',[
op(1150, fx, block)
%dif/2,
%when/2,
%block/1,
%wait/1,
%frozen/2
]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
/**
* @defgroup corout Implementing Attributed Variables and Co-Routining
*
* @ingroup attributes
* @{
* @brief Support for co-routining
*
*
”” */
/** @pred attr_unify_hook(+ _AttValue_,+ _VarValue_)
Hook that must be defined in the module an attributed variable refers
to. Is is called <em>after</em> the attributed variable has been
unified with a non-var term, possibly another attributed variable.
_AttValue_ is the attribute that was associated to the variable
in this module and _VarValue_ is the new value of the variable.
Normally this predicate fails to veto binding the variable to
_VarValue_, forcing backtracking to undo the binding. If
_VarValue_ is another attributed variable the hook often combines
the two attribute and associates the combined attribute with
_VarValue_ using put_attr/3.
*/
attr_unify_hook(DelayList, _) :-
wake_delays(DelayList).
wake_delays([]).
wake_delays([Delay|List]) :-
wake_delay(Delay),
wake_delays(List).
%
% Interface to attributed variables.
%
wake_delay(redo_dif(Done, X, Y)) :-
redo_dif(Done, X, Y).
wake_delay(redo_freeze(Done, V, Goal)) :-
redo_freeze(Done, V, Goal).
wake_delay(redo_eq(Done, X, Y, Goal)) :-
redo_eq(Done, X, Y, Goal, _G).
wake_delay(redo_ground(Done, X, Goal)) :-
redo_ground(Done, X, Goal).
attribute_goals(Var) -->
{ get_attr(Var, '$coroutining', Delays) },
attgoal_for_delays(Delays, Var).
attgoal_for_delays([], _V) --> [].
attgoal_for_delays([G|AllAtts], V) -->
attgoal_for_delay(G, V),
attgoal_for_delays(AllAtts, V).
attgoal_for_delay(redo_dif(Done, X, Y), V) -->
{ var(Done), first_att(dif(X,Y), V) }, !,
[prolog:dif(X,Y)].
attgoal_for_delay(redo_freeze(Done, V, Goal), V) -->
{ var(Done) }, !,
{ remove_when_declarations(Goal, NoWGoal) },
[ prolog:freeze(V,NoWGoal) ].
attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) -->
{ var(Done), first_att(Goal, V) }, !,
[ prolog:when(X=Y,Goal) ].
attgoal_for_delay(redo_ground(Done, X, Goal), _V) -->
{ var(Done) }, !,
[ prolog:when(ground(X),Goal) ].
attgoal_for_delay(_, _V) --> [].
remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
remove_when_declarations(Goal, NoWGoal).
remove_when_declarations(Goal, Goal).
%
% operators defined in this module:
%
/**
@pred freeze(? _X_,: _G_)
Delay execution of goal _G_ until the variable _X_ is bound.
*/
prolog:freeze(V, G) :-
var(V), !,
freeze_goal(V,G).
prolog:freeze(_, G) :-
'$execute'(G).
freeze_goal(V,VG) :-
var(VG), !,
'$current_module'(M),
internal_freeze(V, redo_freeze(_Done,V,M:VG)).
freeze_goal(V,M:G) :- !,
internal_freeze(V, redo_freeze(_Done,V,M:G)).
freeze_goal(V,G) :-
'$current_module'(M),
internal_freeze(V, redo_freeze(_Done,V,M:G)).
%
%
% Dif is tricky because we need to wake up on the two variables being
% bound together, or on any variable of the term being bound to
% another. Also, the day YAP fully supports infinite rational trees,
% dif should work for them too. Hence, term comparison should not be
% implemented in Prolog.
%
% This is the way dif works. The '$can_unify' predicate does not know
% anything about dif semantics, it just compares two terms for
% equaility and is based on compare. If it succeeds without generating
% a list of variables, the terms are equal and dif fails. If it fails,
% dif succeeds.
%
% If it succeeds but it creates a list of variables, dif creates
% suspension records for all these variables on the '$redo_dif'(V,
% X, Y) goal. V is a flag that says whether dif has completed or not,
% X and Y are the original goals. Whenever one of these variables is
% bound, it calls '$redo_dif' again. '$redo_dif' will then check whether V
% was bound. If it was, dif has succeeded and redo_dif just
% exits. Otherwise, '$redo_dif' will call dif again to see what happened.
%
% Dif needs two extensions from the suspension engine:
%
% First, it needs
% for the engine to be careful when binding two suspended
% variables. Basically, in this case the engine must be sure to wake
% up one of the goals, as they may make dif fail. The way the engine
% does so is by searching the list of suspended variables, and search
% whether they share a common suspended goal. If they do, that
% suspended goal is added to the WokenList.
%
% Second, thanks to dif we may try to suspend on the same variable
% several times. dif calls a special version of freeze that checks
% whether that is in fact the case.
%
/** @pred dif( _X_, _Y_)
Succeed if the two arguments do not unify. A call to dif/2 will
suspend if unification may still succeed or fail, and will fail if they
always unify.
*/
prolog:dif(X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)).
prolog:dif(_, _).
dif_suspend_on_lvars([], _).
dif_suspend_on_lvars([H|T], G) :-
internal_freeze(H, G),
dif_suspend_on_lvars(T, G).
%
% This predicate is called whenever a variable dif was suspended on is
% bound. Note that dif may have already executed successfully.
%
% Three possible cases: dif has executed and Done is bound; we redo
% dif and the two terms either unify, hence we fail, or may unify, and
% we try to increase the number of suspensions; last, the two terms
% did not unify, we are done, so we succeed and bind the Done variable.
%
redo_dif(Done, _, _) :- nonvar(Done), !.
redo_dif(Done, X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)).
redo_dif('$done', _, _).
redo_freeze(Done, V, G0) :-
% If you called nonvar as condition for when, then you may find yourself
% here.
%
% someone else (that is Cond had ;) did the work, do nothing
%
(nonvar(Done) -> true ;
%
% We still have some more conditions: continue the analysis.
%
G0 = when(C, G, Done) -> when(C, G, Done) ;
%
% check if the variable was really bound
%
var(V) -> internal_freeze(V, redo_freeze(Done,V,G0)) ;
%
% I can't believe it: we're done and can actually execute our
% goal. Notice we have to say we are done, otherwise someone else in
% the disjunction might decide to wake up the goal themselves.
%
Done = '$done', '$execute'(G0) ).
%
% eq is a combination of dif and freeze
redo_eq(Done, _, _, _, _) :- nonvar(Done), !.
redo_eq(_, X, Y, _, G) :-
'$can_unify'(X, Y, LVars),
LVars = [_|_], !,
dif_suspend_on_lvars(LVars, G).
redo_eq(Done, _, _, when(C, G, Done), _) :- !,
when(C, G, Done).
redo_eq('$done', _ ,_ , Goal, _) :-
'$execute'(Goal).
%
% ground is similar to freeze
redo_ground(Done, _, _) :- nonvar(Done), !.
redo_ground(Done, X, Goal) :-
'$non_ground'(X, Var), !,
internal_freeze(Var, redo_ground(Done, X, Goal)).
redo_ground(Done, _, when(C, G, Done)) :- !,
when(C, G, Done).
redo_ground('$done', _, Goal) :-
'$execute'(Goal).
%
% support for when/2 built-in
%
/** @pred when(+ _C_,: _G_)
Delay execution of goal _G_ until the conditions _C_ are
satisfied. The conditions are of the following form:
+ _C1_, _C2_
Delay until both conditions _C1_ and _C2_ are satisfied.
+ _C1_; _C2_
Delay until either condition _C1_ or condition _C2_ is satisfied.
+ ?=( _V1_, _C2_)
Delay until terms _V1_ and _V1_ have been unified.
+ nonvar( _V_)
Delay until variable _V_ is bound.
+ ground( _V_)
Delay until variable _V_ is ground.
Note that when/2 will fail if the conditions fail.
*/
prolog:when(Conds,Goal) :-
'$current_module'(Mod),
prepare_goal_for_when(Goal, Mod, ModG),
when(Conds, ModG, Done, [], LG), !,
%write(vsc:freezing(LG,Done)),nl,
suspend_when_goals(LG, Done).
prolog:when(_,Goal) :-
'$execute'(Goal).
%
% support for when/2 like declaration.
%
%
% when will block on a conjunction or disjunction of nonvar, ground,
% ?=, where ?= is both terms being bound together
%
%
'$declare_when'(Cond, G) :-
generate_code_for_when(Cond, G, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$declare_when'(_,_).
%
% use a meta interpreter for now
%
generate_code_for_when(Conds, G,
( G :- when(Conds, ModG, Done, [], LG), !,
suspend_when_goals(LG, Done)) ) :-
'$current_module'(Mod),
prepare_goal_for_when(G, Mod, ModG).
%
% make sure we have module info for G!
%
prepare_goal_for_when(G, Mod, Mod:call(G)) :- var(G), !.
prepare_goal_for_when(M:G, _, M:G) :- !.
prepare_goal_for_when(G, Mod, Mod:G).
%
% now for the important bit
%
% Done is used to synchronise: when it is bound someone else did the
% goal and we can give up.
%
% when/5 and when_suspend succeds when there is need to suspend a goal
%
%
when(V, G, _Done, LG, LG) :- var(V), !,
'$do_error'(instantiation_error,when(V,G)).
when(nonvar(V), G, Done, LG0, LGF) :-
when_suspend(nonvar(V), G, Done, LG0, LGF).
when(?=(X,Y), G, Done, LG0, LGF) :-
when_suspend(?=(X,Y), G, Done, LG0, LGF).
when(ground(T), G, Done, LG0, LGF) :-
when_suspend(ground(T), G, Done, LG0, LGF).
when((C1, C2), G, Done, LG0, LGF) :-
% leave it open to continue with when.
(
when(C1, when(C2, G, Done), Done, LG0, LGI)
->
LGI = LGF
;
% we solved C1, great, now we just have to solve C2!
when(C2, G, Done, LG0, LGF)
).
when((G1 ; G2), G, Done, LG0, LGF) :-
when(G1, G, Done, LG0, LGI),
when(G2, G, Done, LGI, LGF).
%
% Auxiliary predicate called from within a conjunction.
% Repeat basic code for when, as inserted in first clause for predicate.
%
when(_, _, Done) :-
nonvar(Done), !.
when(Cond, G, Done) :-
when(Cond, G, Done, [], LG),
!,
suspend_when_goals(LG, Done).
when(_, G, '$done') :-
'$execute'(G).
%
% Do something depending on the condition!
%
% some one else did the work.
%
when_suspend(_, _, Done, _, []) :- nonvar(Done), !.
%
% now for the serious stuff.
%
when_suspend(nonvar(V), G, Done, LG0, LGF) :-
try_freeze(V, G, Done, LG0, LGF).
when_suspend(?=(X,Y), G, Done, LG0, LGF) :-
try_eq(X, Y, G, Done, LG0, LGF).
when_suspend(ground(X), G, Done, LG0, LGF) :-
try_ground(X, G, Done, LG0, LGF).
try_freeze(V, G, Done, LG0, LGF) :-
var(V),
LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0].
try_eq(X, Y, G, Done, LG0, LGF) :-
'$can_unify'(X, Y, LVars), LVars = [_|_],
LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0].
try_ground(X, G, Done, LG0, LGF) :-
'$non_ground'(X, Var), % the C predicate that succeds if
% finding out the term is nonground
% and gives the first variable it
% finds. Notice that this predicate
% must know about svars.
LGF = ['$coroutining':internal_freeze(Var, redo_ground(Done, X, G))| LG0].
%
% When executing a when, if nobody succeeded, we need to create suspensions.
%
suspend_when_goals([], _).
suspend_when_goals(['$coroutining':internal_freeze(V, G)|Ls], Done) :-
var(Done), !,
internal_freeze(V, G),
suspend_when_goals(Ls, Done).
suspend_when_goals([dif_suspend_on_lvars(LVars, G)|LG], Done) :-
var(Done), !,
dif_suspend_on_lvars(LVars, G),
suspend_when_goals(LG, Done).
suspend_when_goals([_|_], _).
%
% Support for wait declarations on goals.
% Or we also use the more powerful, SICStus like, "block" declarations.
%
% block or wait declarations must precede the first clause.
%
%
% I am using the simplest solution now: I'll add an extra clause at
% the beginning of the procedure to do this work. This creates a
% choicepoint and make things a bit slower, but it's probably not as
% significant as the remaining overheads.
%
prolog:'$block'(Conds) :-
generate_blocking_code(Conds, _, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
prolog:'$block'(_).
generate_blocking_code(Conds, G, Code) :-
extract_head_for_block(Conds, G),
recorded('$blocking_code','$code'(G,OldConds),R), !,
erase(R),
functor(G, Na, Ar),
'$current_module'(M),
abolish(M:Na, Ar),
generate_blocking_code((Conds,OldConds), G, Code).
generate_blocking_code(Conds, G, (G :- (If, !, when(When, G)))) :-
extract_head_for_block(Conds, G),
recorda('$blocking_code','$code'(G,Conds),_),
generate_body_for_block(Conds, G, If, When).
%
% find out what we are blocking on.
%
extract_head_for_block((C1, _), G) :- !,
extract_head_for_block(C1, G).
extract_head_for_block(C, G) :-
functor(C, Na, Ar),
functor(G, Na, Ar).
%
% If we suspend on the conditions, we should continue
% execution. If we don't suspend we should fail so that we can take
% the next clause. To
% know what we have to do we just test how many variables we suspended
% on ;-).
%
%
% We generate code as follows:
%
% block a(-,-,?)
%
% (var(A1), var(A2) -> true ; fail), !, when((nonvar(A1);nonvar(A2)),G).
%
% block a(-,-,?), a(?,-, -)
%
% (var(A1), var(A2) -> true ; (var(A2), var(A3) -> true ; fail)), !,
% when(((nonvar(A1);nonvar(A2)),(nonvar(A2);nonvar(A3))),G).
generate_body_for_block((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !,
generate_for_cond_in_block(C1, G, Code1, WhenConds),
generate_body_for_block(C2, G, Code2, OtherWhenConds).
generate_body_for_block(C, G, (Code -> true ; fail), WhenConds) :-
generate_for_cond_in_block(C, G, Code, WhenConds).
generate_for_cond_in_block(C, G, Code, Whens) :-
C =.. [_|Args],
G =.. [_|GArgs],
fetch_out_variables_for_block(Args,GArgs,L0Vars),
add_blocking_vars(L0Vars, LVars),
generate_for_each_arg_in_block(LVars, Code, Whens).
add_blocking_vars([], [_]) :- !.
add_blocking_vars(LV, LV).
fetch_out_variables_for_block([], [], []).
fetch_out_variables_for_block(['?'|Args], [_|GArgs], LV) :-
fetch_out_variables_for_block(Args, GArgs, LV).
fetch_out_variables_for_block(['-'|Args], [GArg|GArgs],
[GArg|LV]) :-
fetch_out_variables_for_block(Args, GArgs, LV).
generate_for_each_arg_in_block([], false, true).
generate_for_each_arg_in_block([V], var(V), nonvar(V)) :- !.
generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :-
generate_for_each_arg_in_block(L, If, Whens).
%
% The wait declaration is a simpler and more efficient version of block.
%
prolog:'$wait'(Na/Ar) :-
functor(S, Na, Ar),
arg(1, S, A),
'$current_module'(M),
'$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail.
prolog:'$wait'(_).
/** @pred frozen( _X_, _G_)
Unify _G_ with a conjunction of goals suspended on variable _X_,
or `true` if no goal has suspended.
*/
prolog:frozen(V, LG) :-
var(V), !,
'$attributes':attvars_residuals([V], Gs, []),
simplify_frozen( Gs, SGs ),
list_to_conj( SGs, LG ).
prolog:frozen(V, G) :-
'$do_error'(uninstantiation_error(V),frozen(V,G)).
simplify_frozen( [prolog:freeze(_, G)|Gs], [G|NGs] ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [prolog:when(_, G)|Gs], [G|NGs] ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [prolog:dif(_, _)|Gs], NGs ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [], [] ).
list_to_conj([], true).
list_to_conj([El], El).
list_to_conj([E,E1|Els], (E,C) ) :-
list_to_conj([E1|Els], C).
%internal_freeze(V,G) :-
% attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail.
internal_freeze(V,G) :-
update_att(V, G).
update_att(V, G) :-
attributes:get_module_atts(V, '$coroutining'(_,Gs)),
not_vmember(G, Gs), !,
attributes:put_module_atts(V, '$coroutining'(_,[G|Gs])).
update_att(V, G) :-
attributes:put_module_atts(V, '$coroutining'(_,[G])).
not_vmember(_, []).
not_vmember(V, [V1|DonesSoFar]) :-
V \== V1,
not_vmember(V, DonesSoFar).
first_att(T, V) :-
term_variables(T, Vs),
check_first_attvar(Vs, V).
check_first_attvar([V|_Vs], V0) :- attvar(V), !, V == V0.
check_first_attvar([_|Vs], V0) :-
check_first_attvar(Vs, V0).
/**
@}
*/

189
packages/python/swig/yap4py/prolog/pl/dbload.yap
View File

@ -1,189 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: dbload.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Compact Loading of Facts in YAP *
* *
*************************************************************************/
:- module('$db_load',
[]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
%%% @file dbload.yap
%%% @defgroup YAPBigLoad
%%% @brief Fast and Exo Loading
/*!
* @pred load_mega_clause( +Stream ) is detail
* Load a single predicare composed of facts with the same size.
*/
load_mega_clause( Stream ) :-
% line_spec( Stream, Line),
repeat,
( fact( Stream ), fail ;
stream_property(Stream, at_end_of_file( on )) ).
'$input_lines'(R, csv, Lines ) :-
'$process_lines'(R, Lines, _Type ),
close(R).
/*!
* @pred load_db( +Files ) is det
* Load files each one containing as single predicare composed of facts with the same size.
*/
prolog:load_db(Fs) :-
'$current_module'(M0),
prolog_flag(agc_margin,Old,0),
dbload(Fs,M0,load_db(Fs)),
load_facts,
prolog_flag(agc_margin,_,Old),
clean_up.
dbload(Fs, _, G) :-
var(Fs),
'$do_error'(instantiation_error,G).
dbload([], _, _) :- !.
dbload([F|Fs], M0, G) :- !,
dbload(F, M0, G),
dbload(Fs, M0, G).
dbload(M:F, _M0, G) :- !,
dbload(F, M, G).
dbload(F, M0, G) :-
atom(F), !,
do_dbload(F, M0, G).
dbload(F, _, G) :-
'$do_error'(type_error(atom,F),G).
do_dbload(F0, M0, G) :-
'$full_filename'(F0, F, G),
assert(dbprocess(F, M0)),
open(F, read, R),
check_dbload_stream(R, M0),
close(R).
check_dbload_stream(R, M0) :-
repeat,
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_count(T, M0),
fail
).
dbload_count(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
% dbload_check_term(T),
(
dbloading(Na,Arity,M,_,NaAr,_) ->
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I)
;
atomic_concat([Na,'__',Arity,'__',M],NaAr),
assert(dbloading(Na,Arity,M,T,NaAr,0)),
nb_setval(NaAr,1)
).
get_module(M1:T0,_,T,M) :- !,
get_module(T0, M1, T , M).
get_module(T,M,T,M).
load_facts :-
!, % yap_flag(exo_compilation, on), !.
load_exofacts.
load_facts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
load_facts :-
dbprocess(F, M),
open(F, read, R),
dbload_add_facts(R, M),
close(R),
fail.
load_facts.
dbload_add_facts(R, M) :-
repeat,
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_add_fact(T, M),
fail
).
dbload_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
dbassert(T,Handle,I0).
load_exofacts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
load_exofacts :-
dbprocess(F, M),
open(F, read, R),
exodb_add_facts(R, M),
close(R),
fail.
load_exofacts.
exodb_add_facts(R, M) :-
repeat,
catch(protected_exodb_add_fact(R, M), _, fail),
!.
protected_exodb_add_fact(R, M) :-
repeat,
read(R,T),
( T == end_of_file -> !;
exodb_add_fact(T, M),
fail
).
exodb_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
exoassert(T,Handle,I0).
clean_up :-
retractall(dbloading(_,_,_,_,_,_)),
retractall(dbprocess(_,_)),
fail.
clean_up.
%% @}

1169
packages/python/swig/yap4py/prolog/pl/debug.yap
View File

File diff suppressed because it is too large Load Diff

35
packages/python/swig/yap4py/prolog/pl/depth_bound.yap
View File

@ -1,35 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: corout.pl *
* Last rev: *
* mods: *
* comments: Coroutines implementation *
* *
*************************************************************************/
/**
@defgroup DepthLimited Depth Limited Search
@ingroup extensions
YAP implements various extensions to the default Prolog search. One of
the most iseful s restricting the maximum search depth.
*/
:-
system_module( '$_depth_bound', [depth_bound_call/2], []).
%depth_bound_call(A,D) :-
%write(depth_bound_call(A,D)), nl, fail.
depth_bound_call(A,D) :-
'$execute_under_depth_limit'(A,D).

93
packages/python/swig/yap4py/prolog/pl/dialect.yap
View File

@ -1,93 +0,0 @@
:- module(dialect,
[
exists_source/1,
source_exports/2
]).
:- use_system_module( '$_errors', ['$do_error'/2]).
% @pred expects_dialect(+Dialect)
%
% True if YAP can enable support for a different Prolog dialect.
% Currently there is support for bprolog, hprolog and swi-prolog.
% Notice that this support may be incomplete.
%
% The
prolog:expects_dialect(yap) :- !,
eraseall('$dialect'),
recorda('$dialect',yap,_).
prolog:expects_dialect(Dialect) :-
check_dialect(Dialect),
eraseall('$dialect'),
load_files(library(dialect/Dialect),[silent(true),if(not_loaded)]),
( current_predicate(Dialect:setup_dialect/0)
-> Dialect:setup_dialect
; true
),
recorda('$dialect',Dialect,_).
check_dialect(Dialect) :-
var(Dialect),!,
'$do_error'(instantiation_error,(:- expects_dialect(Dialect))).
check_dialect(Dialect) :-
\+ atom(Dialect),!,
'$do_error'(type_error(Dialect),(:- expects_dialect(Dialect))).
check_dialect(Dialect) :-
exists_source(library(dialect/Dialect)), !.
check_dialect(Dialect) :-
'$do_error'(domain_error(dialect,Dialect),(:- expects_dialect(Dialect))).
%% exists_source(+Source) is semidet.
%
% True if Source (a term valid for load_files/2) exists. Fails
% without error if this is not the case. The predicate is intended
% to be used with :- if, as in the example below. See also
% source_exports/2.
%
% ==
% :- if(exists_source(library(error))).
% :- use_module_library(error).
% :- endif.
% ==
%exists_source(Source) :-
% exists_source(Source, _Path).
exists_source(Source, Path) :-
absolute_file_name(Source, Path,
[ file_type(prolog),
access(read),
file_errors(fail)
]).
%% source_exports(+Source, +Export) is semidet.
%% source_exports(+Source, -Export) is nondet.
%
% True if Source exports Export. Fails without error if this is
% not the case. See also exists_source/1.
%
% @tbd Should we also allow for source_exports(-Source, +Export)?
source_exports(Source, Export) :-
open_source(Source, In),
catch(call_cleanup(exports(In, Exports), close(In)), _, fail),
( ground(Export)
-> lists:memberchk(Export, Exports)
; lists:member(Export, Exports)
).
%% open_source(+Source, -In:stream) is semidet.
%
% Open a source location.
open_source(File, In) :-
exists_source(File, Path),
open(Path, read, In),
( peek_char(In, #)
-> skip(In, 10)
; true
).
exports(In, Exports) :-
read(In, Term),
Term = (:- module(_Name, Exports)).

263
packages/python/swig/yap4py/prolog/pl/directives.yap
View File

@ -1,263 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: directives.yap *
* Last rev: *
* mods: *
* comments: directing system execution *
* *
*************************************************************************/
:- system_module( '$_directives', [user_defined_directive/2], ['$all_directives'/1,
'$exec_directives'/5]).
:- use_system_module( '$_boot', ['$command'/4,
'$system_catch'/4]).
:- use_system_module( '$_consult', ['$elif'/2,
'$else'/1,
'$endif'/1,
'$if'/2,
'$include'/2,
'$initialization'/1,
'$initialization'/2,
'$load_files'/3,
'$require'/2,
'$set_encoding'/1,
'$use_module'/3]).
:- use_system_module( '$_modules', ['$meta_predicate'/2,
'$module'/3,
'$module'/4,
'$module_transparent'/2]).
:- use_system_module( '$_preddecls', ['$discontiguous'/2,
'$dynamic'/2]).
:- use_system_module( '$_preds', ['$noprofile'/2,
'$public'/2]).
:- use_system_module( '$_threads', ['$thread_local'/2]).
'$all_directives'(_:G1) :- !,
'$all_directives'(G1).
'$all_directives'((G1,G2)) :- !,
'$all_directives'(G1),
'$all_directives'(G2).
'$all_directives'(G) :- !,
'$directive'(G).
%:- '$multifile'( '$directive'/1, prolog ).
:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1.
'$directive'(block(_)).
'$directive'(char_conversion(_,_)).
'$directive'(compile(_)).
'$directive'(consult(_)).
'$directive'(discontiguous(_)).
'$directive'(dynamic(_)).
'$directive'(elif(_)).
'$directive'(else).
'$directive'(encoding(_)).
'$directive'(endif).
'$directive'(ensure_loaded(_)).
'$directive'(expects_dialect(_)).
'$directive'(if(_)).
'$directive'(include(_)).
'$directive'(initialization(_)).
'$directive'(initialization(_,_)).
'$directive'(license(_)).
'$directive'(meta_predicate(_)).
'$directive'(module(_,_)).
'$directive'(module(_,_,_)).
'$directive'(module_transparent(_)).
'$directive'(multifile(_)).
'$directive'(noprofile(_)).
'$directive'(public(_)).
'$directive'(op(_,_,_)).
'$directive'(require(_)).
'$directive'(set_prolog_flag(_,_)).
'$directive'(reconsult(_)).
'$directive'(reexport(_)).
'$directive'(reexport(_,_)).
'$directive'(predicate_options(_,_,_)).
'$directive'(thread_initialization(_)).
'$directive'(thread_local(_)).
'$directive'(uncutable(_)).
'$directive'(use_module(_)).
'$directive'(use_module(_,_)).
'$directive'(use_module(_,_,_)).
'$directive'(wait(_)).
'$exec_directives'((G1,G2), Mode, M, VL, Pos) :-
!,
'$exec_directives'(G1, Mode, M, VL, Pos),
'$exec_directives'(G2, Mode, M, VL, Pos).
'$exec_directives'(G, Mode, M, VL, Pos) :-
'$exec_directive'(G, Mode, M, VL, Pos).
'$exec_directive'(multifile(D), _, M, _, _) :-
'$system_catch'('$multifile'(D, M), M,
Error,
user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M, _, _) :-
'$discontiguous'(D,M).
/** @pred initialization
Execute the goals defined by initialization/1. Only the first answer is
considered.
*/
'$exec_directive'(initialization(D), _, M, _, _) :-
'$initialization'(M:D).
'$exec_directive'(initialization(D,OPT), _, M, _, _) :-
'$initialization'(M:D, OPT).
'$exec_directive'(thread_initialization(D), _, M, _, _) :-
'$thread_initialization'(M:D).
'$exec_directive'(expects_dialect(D), _, _, _, _) :-
expects_dialect(D).
'$exec_directive'(encoding(Enc), _, _, _, _) :-
'$set_encoding'(Enc).
'$exec_directive'(include(F), Status, _, _, _) :-
'$include'(F, Status).
% don't declare modules into Prolog Module
'$exec_directive'(module(N,P), Status, _, _, _) :-
'$module'(Status,N,P).
'$exec_directive'(module(N,P,Op), Status, _, _, _) :-
'$module'(Status,N,P,Op).
'$exec_directive'(meta_predicate(P), _, M, _, _) :-
strip_module(M:P,M0,P0),
'$meta_predicate'(M0:P0).
'$exec_directive'(module_transparent(P), _, M, _, _) :-
'$module_transparent'(P, M).
'$exec_directive'(noprofile(P), _, M, _, _) :-
'$noprofile'(P, M).
'$exec_directive'(require(Ps), _, M, _, _) :-
'$require'(Ps, M).
'$exec_directive'(dynamic(P), _, M, _, _) :-
'$dynamic'(P, M).
'$exec_directive'(thread_local(P), _, M, _, _) :-
'$thread_local'(P, M).
'$exec_directive'(op(P,OPSEC,OP), _, _, _, _) :-
'$current_module'(M),
op(P,OPSEC,M:OP).
'$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :-
set_prolog_flag(F,V).
'$exec_directive'(ensure_loaded(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)).
'$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :-
char_conversion(IN,OUT).
'$exec_directive'(public(P), _, M, _, _) :-
'$public'(P, M).
'$exec_directive'(compile(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], compile(Fs)).
'$exec_directive'(reconsult(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], reconsult(Fs)).
'$exec_directive'(consult(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [consult(consult)], consult(Fs)).
'$exec_directive'(use_module(F), _, M, _, _) :-
use_module(M:F).
'$exec_directive'(reexport(F), _, M, _, _) :-
'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)).
'$exec_directive'(reexport(F,Spec), _, M, _, _) :-
'$load_files'(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)], reexport(F, Spec)).
'$exec_directive'(use_module(F, Is), _, M, _, _) :-
use_module(M:F, Is).
'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-
'$use_module'(Mod,F,Is).
'$exec_directive'(block(BlockSpec), _, _, _, _) :-
'$block'(BlockSpec).
'$exec_directive'(wait(BlockSpec), _, _, _, _) :-
'$wait'(BlockSpec).
'$exec_directive'(table(PredSpec), _, M, _, _) :-
'$table'(PredSpec, M).
'$exec_directive'(uncutable(PredSpec), _, M, _, _) :-
'$uncutable'(PredSpec, M).
'$exec_directive'(if(Goal), Context, M, _, _) :-
'$if'(M:Goal, Context).
'$exec_directive'(else, Context, _, _, _) :-
'$else'(Context).
'$exec_directive'(elif(Goal), Context, M, _, _) :-
'$elif'(M:Goal, Context).
'$exec_directive'(endif, Context, _, _, _) :-
'$endif'(Context).
'$exec_directive'(license(_), Context, _, _, _) :-
Context \= top.
'$exec_directive'(predicate_options(PI, Arg, Options), Context, Module, VL, Pos) :-
Context \= top,
predopts:expand_predicate_options(PI, Arg, Options, Clauses),
'$assert_list'(Clauses, Context, Module, VL, Pos).
'$assert_list'([], _Context, _Module, _VL, _Pos).
'$assert_list'([Clause|Clauses], Context, Module, VL, Pos) :-
'$command'(Clause, VL, Pos, Context),
'$assert_list'(Clauses, Context, Module, VL, Pos).
%
% allow users to define their own directives.
%
user_defined_directive(Dir,_) :-
'$directive'(Dir), !.
user_defined_directive(Dir,Action) :-
functor(Dir,Na,Ar),
functor(NDir,Na,Ar),
'$current_module'(M, prolog),
assert_static(prolog:'$directive'(NDir)),
assert_static(prolog:('$exec_directive'(Dir, _, _, _, _) :- Action)),
'$current_module'(_, M).
'$thread_initialization'(M:D) :-
eraseall('$thread_initialization'),
recorda('$thread_initialization',M:D,_),
fail.
'$thread_initialization'(M:D) :-
'$initialization'(M:D).
%
% This command is very different depending on the language mode we are in.
%
% ISO only wants directives in files
% SICStus accepts everything in files
% YAP accepts everything everywhere
%
'$process_directive'(G, top, M, VL, Pos) :-
current_prolog_flag(language_mode, yap), !, /* strict_iso on */
'$process_directive'(G, consult, M, VL, Pos).
'$process_directive'(G, top, M, _, _) :-
!,
'$do_error'(context_error((:-M:G),clause),query).
%
% default case
%
'$process_directive'(Gs, Mode, M, VL, Pos) :-
'$all_directives'(Gs), !,
'$exec_directives'(Gs, Mode, M, VL, Pos).
%
% ISO does not allow goals (use initialization).
%
'$process_directive'(D, _, M, _VL, _Pos) :-
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus do.
%
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
'$execute'(M:G),
!.
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
format(user_error,':- ~w:~w failed.~n',[M,G]).

44
packages/python/swig/yap4py/prolog/pl/eam.yap
View File

@ -1,44 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* BEAM extends the YAP Prolog system to support the EAM *
* *
* Copyright Ricardo Lopes and Universidade do Porto 2000-2006 *
* *
**************************************************************************
* *
* File: eam.yap *
* Last rev: 6/4/2006 *
* mods: *
* comments: Some utility predicates needed by BEAM *
* *
*************************************************************************/
:- system_module( '$_eam', [eamconsult/1,
eamtrans/2], []).
eamtrans(A,A):- var(A),!.
eamtrans((A,B),(C,D)):- !, eamtrans(A,C),eamtrans(B,D).
eamtrans((X is Y) ,(skip_while_var(Vars), X is Y )):- !, '$variables_in_term'(Y,[],Vars).
eamtrans((X =\= Y),(skip_while_var(Vars), X =\= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X =:= Y),(skip_while_var(Vars), X =:= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X >= Y) ,(skip_while_var(Vars), X >= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X > Y) ,(skip_while_var(Vars), X > Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X < Y) ,(skip_while_var(Vars), X < Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X =< Y) ,(skip_while_var(Vars), X =< Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X @>= Y) ,(skip_while_var(Vars), X @>= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X @> Y) ,(skip_while_var(Vars), X @> Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X @< Y) ,(skip_while_var(Vars), X @< Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X @=< Y) ,(skip_while_var(Vars), X @=< Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X \= Y) ,(skip_while_var(Vars), X \= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans((X \== Y),(skip_while_var(Vars), X \== Y )):- !, '$variables_in_term'(X + Y,[],Vars).
eamtrans(B,B).
eamconsult(File):- eam, eam, %fails if eam is disable
assert((user:term_expansion((A :- B),(A :- C)):- eamtrans(B,C))),
eam, ( consult(File) ; true), eam,
abolish(user:term_expansion,2).

339
packages/python/swig/yap4py/prolog/pl/error.yap
View File

@ -1,339 +0,0 @@
/**
@file pl/error.yap
@author Jan Wielemaker
@author Richard O'Keefe
@author adapted to YAP by Vitor Santos Costa
*/
:- module(system(error,
[ must_be_of_type/2, % +Type, +Term
must_be_of_type/3, % +Type, +Term, +Comment
must_be/2, % +Type, +Term
must_be/3, % +Type, +Term, +Comment
type_error/2, % +Type, +Term
% must_be_in_domain/2, % +Domain, +Term
% must_be_in_domain/3, % +Domain, +Term, +Comment
domain_error/3, % +Domain, +Values, +Term
existence_error/2, % +Type, +Term
permission_error/3, % +Action, +Type, +Term
must_be_instantiated/1, % +Term
must_bind_to_type/2, % +Type, ?Term
instantiation_error/1, % +Term
representation_error/1, % +Reason
is_of_type/2 % +Type, +Term
]), []) .
/**
@defgroup error Error generating support
@ingroup YAPError
This SWI module provides predicates to simplify error generation and
checking. Adapted to use YAP built-ins.
Its implementation is based on a discussion on the SWI-Prolog
mailinglist on best practices in error handling. The utility predicate
must_be/2 provides simple run-time type validation. The *_error
predicates are simple wrappers around throw/1 to simplify throwing the
most common ISO error terms.
YAP reuses the code with some extensions, and supports interfacing to some C-builtins.
@{
*/
:- multifile
has_type/2.
%% @pred type_error(+Type, +Term).
%% @pred domain_error(+Type, +Value, +Term).
%% @pred existence_error(+Type, +Term).
%% @pred permission_error(+Action, +Type, +Term).
%% @pred instantiation_error(+Term).
%% @pred representation_error(+Reason).
%
% Throw ISO compliant error messages.
type_error(Type, Term) :-
throw(error(type_error(Type, Term), _)).
domain_error(Type, Term) :-
throw(error(domain_error(Type, Term), _)).
existence_error(Type, Term) :-
throw(error(existence_error(Type, Term), _)).
permission_error(Action, Type, Term) :-
throw(error(permission_error(Action, Type, Term), _)).
instantiation_error(_Term) :-
throw(error(instantiation_error, _)).
representation_error(Reason) :-
throw(error(representation_error(Reason), _)).
%% must_be_of_type(+Type, @Term) is det.
%
% True if Term satisfies the type constraints for Type. Defined
% types are =atom=, =atomic=, =between=, =boolean=, =callable=,
% =chars=, =codes=, =text=, =compound=, =constant=, =float=,
% =integer=, =nonneg=, =positive_integer=, =negative_integer=,
% =nonvar=, =number=, =oneof=, =list=, =list_or_partial_list=,
% =symbol=, =var=, =rational= and =string=.
%
% Most of these types are defined by an arity-1 built-in predicate
% of the same name. Below is a brief definition of the other
% types.
%
% | boolean | one of =true= or =false= |
% | chars | Proper list of 1-character atoms |
% | codes | Proper list of Unicode character codes |
% | text | One of =atom=, =string=, =chars= or =codes= |
% | between(L,U) | Number between L and U (including L and U) |
% | nonneg | Integer >= 0 |
% | positive_integer | Integer > 0 |
% | negative_integer | Integer < 0 |
% | oneof(L) | Ground term that is member of L |
% | list(Type) | Proper list with elements of Type |
% | list_or_partial_list | A list or an open list (ending in a variable) |
% | predicate_indicator | a predicate indicator of the form M:N/A or M:N//A |
%
% @throws instantiation_error if Term is insufficiently
% instantiated and type_error(Type, Term) if Term is not of Type.
must_be(Type, X) :-
must_be_of_type(Type, X).
must_be(Type, X, Comment) :-
must_be_of_type(Type, X, Comment).
must_be_of_type(callable, X) :-
!,
is_callable(X, _).
must_be_of_type(atom, X) :-
!,
is_atom(X, _).
must_be_of_type(module, X) :-
!,
is_atom(X, _).
must_be_of_type(predicate_indicator, X) :-
!,
is_predicate_indicator(X, _).
must_be_of_type(Type, X) :-
( has_type(Type, X)
-> true
; is_not(Type, X)
).
inline(must_be_of_type( atom, X ), is_atom(X, _) ).
inline(must_be_of_type( module, X ), is_module(X, _) ).
inline(must_be_of_type( callable, X ), is_callable(X, _) ).
inline(must_be_of_type( callable, X ), is_callable(X, _) ).
inline(must_be_atom( X ), is_callable(X, _) ).
inline(must_be_module( X ), is_atom(X, _) ).
must_be_of_type(predicate_indicator, X, Comment) :-
!,
is_predicate_indicator(X, Comment).
must_be_of_type(callable, X, Comment) :-
!,
is_callable(X, Comment).
must_be_of_type(Type, X, _Comment) :-
( has_type(Type, X)
-> true
; is_not(Type, X)
).
must_bind_to_type(Type, X) :-
( may_bind_to_type(Type, X)
-> true
; is_not(Type, X)
).
%% @predicate is_not(+Type, @Term)
%
% Throws appropriate error. It is _known_ that Term is not of type
% Type.
%
% @throws type_error(Type, Term)
% @throws instantiation_error
is_not(list, X) :- !,
not_a_list(list, X).
is_not(list(_), X) :- !,
not_a_list(list, X).
is_not(list_or_partial_list, X) :- !,
type_error(list, X).
is_not(chars, X) :- !,
not_a_list(chars, X).
is_not(codes, X) :- !,
not_a_list(codes, X).
is_not(var,_X) :- !,
representation_error(variable).
is_not(rational, X) :- !,
not_a_rational(X).
is_not(Type, X) :-
( var(X)
-> instantiation_error(X)
; ground_type(Type), \+ ground(X)
-> instantiation_error(X)
; type_error(Type, X)
).
ground_type(ground).
ground_type(oneof(_)).
ground_type(stream).
ground_type(text).
ground_type(string).
not_a_list(Type, X) :-
'$skip_list'(_, X, Rest),
( var(Rest)
-> instantiation_error(X)
; type_error(Type, X)
).
not_a_rational(X) :-
( var(X)
-> instantiation_error(X)
; X = rdiv(N,D)
-> must_be(integer, N), must_be(integer, D),
type_error(rational,X)
; type_error(rational,X)
).
%% is_of_type(+Type, @Term) is semidet.
%
% True if Term satisfies Type.
is_of_type(Type, Term) :-
has_type(Type, Term).
%% has_type(+Type, @Term) is semidet.
%
% True if Term satisfies Type.
has_type(impossible, _) :- instantiation_error(_).
has_type(any, _).
has_type(atom, X) :- atom(X).
has_type(atomic, X) :- atomic(X).
has_type(between(L,U), X) :- ( integer(L)
-> integer(X), between(L,U,X)
; number(X), X >= L, X =< U
).
has_type(boolean, X) :- (X==true;X==false), !.
has_type(callable, X) :- callable(X).
has_type(chars, X) :- chars(X).
has_type(codes, X) :- codes(X).
has_type(text, X) :- text(X).
has_type(compound, X) :- compound(X).
has_type(constant, X) :- atomic(X).
has_type(float, X) :- float(X).
has_type(ground, X) :- ground(X).
has_type(integer, X) :- integer(X).
has_type(nonneg, X) :- integer(X), X >= 0.
has_type(positive_integer, X) :- integer(X), X > 0.
has_type(negative_integer, X) :- integer(X), X < 0.
has_type(nonvar, X) :- nonvar(X).
has_type(number, X) :- number(X).
has_type(oneof(L), X) :- ground(X), lists:memberchk(X, L).
has_type(proper_list, X) :- is_list(X).
has_type(list, X) :- is_list(X).
has_type(list_or_partial_list, X) :- is_list_or_partial_list(X).
has_type(symbol, X) :- atom(X).
has_type(var, X) :- var(X).
has_type(rational, X) :- rational(X).
has_type(string, X) :- string(X).
has_type(stream, X) :- is_stream(X).
has_type(list(Type), X) :- is_list(X), element_types(X, Type).
%% may_bind_to_type(+Type, @Term) is semidet.
%
% True if _Term_ or term _Term\theta_ satisfies _Type_.
may_bind_to_type(_, X ) :- var(X), !.
may_bind_to_type(impossible, _) :- instantiation_error(_).
may_bind_to_type(any, _).
may_bind_to_type(atom, X) :- atom(X).
may_bind_to_type(atomic, X) :- atomic(X).
may_bind_to_type(between(L,U), X) :- ( integer(L)
-> integer(X), between(L,U,X)
; number(X), X >= L, X =< U
).
may_bind_to_type(boolean, X) :- (X==true;X==false), !.
may_bind_to_type(callable, X) :- callable(X).
may_bind_to_type(chars, X) :- chars(X).
may_bind_to_type(codes, X) :- codes(X).
may_bind_to_type(text, X) :- text(X).
may_bind_to_type(compound, X) :- compound(X).
may_bind_to_type(constant, X) :- atomic(X).
may_bind_to_type(float, X) :- float(X).
may_bind_to_type(ground, X) :- ground(X).
may_bind_to_type(integer, X) :- integer(X).
may_bind_to_type(nonneg, X) :- integer(X), X >= 0.
may_bind_to_type(positive_integer, X) :- integer(X), X > 0.
may_bind_to_type(negative_integer, X) :- integer(X), X < 0.
may_bind_to_type(predicate_indicator, X) :-
(
X = M:PI
->
may_bind_to_type( atom, M),
may_bind_to_type(predicate_indicator, PI)
;
X = N/A
->
may_bind_to_type( atom, N),
may_bind_to_type(integer, A)
;
X = N//A
->
may_bind_to_type( atom, N),
may_bind_to_type(integer, A)
).
may_bind_to_type(nonvar, _X).
may_bind_to_type(number, X) :- number(X).
may_bind_to_type(oneof(L), X) :- ground(X), lists:memberchk(X, L).
may_bind_to_type(proper_list, X) :- is_list(X).
may_bind_to_type(list, X) :- is_list(X).
may_bind_to_type(list_or_partial_list, X) :- is_list_or_partial_list(X).
may_bind_to_type(symbol, X) :- atom(X).
may_bind_to_type(var, X) :- var(X).
may_bind_to_type(rational, X) :- rational(X).
may_bind_to_type(string, X) :- string(X).
may_bind_to_type(stream, X) :- is_stream(X).
may_bind_to_type(list(Type), X) :- is_list(X), element_types(X, Type).
chars(0) :- !, fail.
chars([]).
chars([H|T]) :-
atom(H), atom_length(H, 1),
chars(T).
codes(x) :- !, fail.
codes([]).
codes([H|T]) :-
integer(H), between(1, 0x10ffff, H),
codes(T).
text(X) :-
( atom(X)
; string(X)
; chars(X)
; codes(X)
), !.
element_types([], _).
element_types([H|T], Type) :-
must_be(Type, H),
element_types(T, Type).
is_list_or_partial_list(L0) :-
'$skip_list'(_, L0,L),
( var(L) -> true ; L == [] ).
must_be_instantiated(X) :-
( var(X) -> instantiation_error(X) ; true).
must_be_instantiated(X, Comment) :-
( var(X) -> instantiation_error(X, Comment) ; true).
%% @}

149
packages/python/swig/yap4py/prolog/pl/errors.yap
View File

@ -1,149 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: errors.yap *
* comments: error messages for YAP *
* *
* *
* *
*************************************************************************/
/** @defgroup YAPError Error Handling
@ingroup YAPControl
The error handler is called when there is an execution error or a
warning needs to be displayed. The handlers include a number of hooks
to allow user-control.
Errors are terms of the form:
- error( domain_error( Domain, Culprit )`
- error( evaluation_error( Expression, Culprit )`
- error( existence_error( Object, Culprit )`
- error( instantiation_error )`
- error( permission_error( Error, Permission, Culprit)`
- error( representation_error( Domain, Culprit )`
- error( resource_error( Resource, Culprit )`
- error( syntax_error( Error )`
- error( system_error( Domain, Culprit )`
- error( type_error( Type, Culprit )`
- error( uninstantiation_error( Culprit )`
@{
*/
:- system_module( '$_errors', [system_error/2], ['$Error'/1,
'$do_error'/2,
system_error/3,
system_error/2]).
:- use_system_module( '$messages', [file_location/2,
generate_message/3,
translate_message/4]).
/**
* @pred system_error( +Error, +Cause)
*
* Generate a system error _Error_, informing the possible cause _Cause_.
*
*/
system_error(Type,Goal) :-
'$do_error'(Type,Goal).
'$do_error'(Type,Goal) :-
% format('~w~n', [Type]),
ancestor_location(Call, Caller),
throw(error(Type, [
[g|g(Goal)],
[p|Call],
[e|Caller]])).
/**
* @pred system_error( +Error, +Cause, +Culprit)
*
* Generate a system error _Error_, informing the source goal _Cause_ and a possible _Culprit_.
*
*
* ~~~~~~~~~~
* ~~~~~~~~~~
*
*
*/
system_error(Type,Goal,Culprit) :-
% format('~w~n', [Type]),
ancestor_location(Call, Caller),
throw(error(Type, [
[i|Culprit],
[g|g(Goal)],
[p|Call],
[e|Caller]])).
'$do_pi_error'(type_error(callable,Name/0),Message) :- !,
'$do_error'(type_error(callable,Name),Message).
'$do_pi_error'(Error,Message) :- !,
'$do_error'(Error,Message).
'$Error'(E) :-
'$LoopError'(E,top).
'$LoopError'(_, _) :-
flush_output(user_output),
flush_output(user_error),
fail.
'$LoopError'(Error, Level) :- !,
'$process_error'(Error, Level),
fail.
'$LoopError'(_, _) :-
flush_output,
'$close_error',
fail.
'$process_error'('$forward'(Msg), _) :-
!,
throw( '$forward'(Msg) ).
'$process_error'(abort, Level) :-
!,
(
Level \== top
->
throw( abort )
;
current_prolog_flag(break_level, 0)
->
print_message(informational,abort(user)),
fail
;
current_prolog_flag(break_level, I0),
I is I0-1,
current_prolog_flag(break_level, I),
throw(abort)
).
'$process_error'(error(thread_cancel(_Id), _G),top) :-
!.
'$process_error'(error(thread_cancel(Id), G), _) :-
!,
throw(error(thread_cancel(Id), G)).
'$process_error'(error(permission_error(module,redefined,A),B), Level) :-
Level \= top, !,
throw(error(permission_error(module,redefined,A),B)).
'$process_error'(Error, _Level) :-
functor(Error, Severity, _),
print_message(Severity, Error), !.
%'$process_error'(error(Msg, Where), _) :-
% print_message(error,error(Msg, [g|Where])), !.
'$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)).
%% @}

128
packages/python/swig/yap4py/prolog/pl/eval.yap
View File

@ -1,128 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: eval.yap *
* Last rev: *
* mods: *
* comments: optimise disjunction handling *
* *
*************************************************************************/
:- system_module( '$_eval', [], ['$full_clause_optimisation'/4]).
:- use_system_module( terms, [new_variables_in_term/3,
variables_within_term/3]).
:- multifile '$full_clause_optimisation'/4.
'$add_extra_safe'('$plus'(_,_,V)) --> !, [V].
'$add_extra_safe'('$minus'(_,_,V)) --> !, [V].
'$add_extra_safe'('$times'(_,_,V)) --> !, [V].
'$add_extra_safe'('$div'(_,_,V)) --> !, [V].
'$add_extra_safe'('$and'(_,_,V)) --> !, [V].
'$add_extra_safe'('$or'(_,_,V)) --> !, [V].
'$add_extra_safe'('$sll'(_,_,V)) --> !, [V].
'$add_extra_safe'('$slr'(_,_,V)) --> !, [V].
'$add_extra_safe'(C=D,A,B) :-
!,
( compound(C) ->
'$variables_in_term'(C,E,A)
;
E=A
),
( compound(D) ->
'$variables_in_term'(D,B,E)
;
B=E
).
'$add_extra_safe'(_) --> [].
'$gen_equals'([], [], _, O, O).
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, NO) :- V == NV, !,
'$gen_equals'(Commons,NCommons, LV0, O, NO).
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
'$vmember'(V,LV0),
OO = (V=NV,'$safe'(NV),NO),
'$gen_equals'(Commons,NCommons, LV0, O, NO).
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
OO = (V=NV,NO),
'$gen_equals'(Commons,NCommons, LV0, O, NO).
'$safe_guard'((A,B), M) :- !,
'$safe_guard'(A, M),
'$safe_guard'(B, M).
'$safe_guard'((A;B), M) :- !,
'$safe_guard'(A, M),
'$safe_guard'(B, M).
'$safe_guard'(A, M) :- !,
'$safe_builtin'(A, M).
'$safe_builtin'(G, Mod) :-
'$predicate_flags'(G, Mod, Fl, Fl),
Fl /\ 0x00008880 =\= 0.
'$vmember'(V,[V1|_]) :- V == V1, !.
'$vmember'(V,[_|LV0]) :-
'$vmember'(V,LV0).
'$localise_disj_vars'((B;B2), M, (NB ; NB2), LV, LV0, LEqs) :- !,
'$localise_vars'(B, M, NB, LV, LV0, LEqs),
'$localise_disj_vars'(B2, M, NB2, LV, LV0, LEqs).
'$localise_disj_vars'(B2, M, NB, LV, LV0, LEqs) :-
'$localise_vars'(B2, M, NB, LV, LV0, LEqs).
'$localise_vars'((A->B), M, (A->NB), LV, LV0, LEqs) :-
'$safe_guard'(A, M), !,
'$variables_in_term'(A, LV, LV1),
'$localise_vars'(B, M, NB, LV1, LV0, LEqs).
'$localise_vars'((A;B), M, (NA;NB), LV1, LV0, LEqs) :- !,
'$localise_vars'(A, M, NA, LV1, LV0, LEqs),
'$localise_disj_vars'(B, M, NB, LV1, LV0, LEqs).
'$localise_vars'(((A,B),C), M, NG, LV, LV0, LEqs) :- !,
'$flatten_bd'((A,B),C,NB),
'$localise_vars'(NB, M, NG, LV, LV0, LEqs).
'$localise_vars'((!,B), M, (!,NB), LV, LV0, LEqs) :- !,
'$localise_vars'(B, M, NB, LV, LV0, LEqs).
'$localise_vars'((X=Y,B), M, (X=Y,NB1), LV, LV0, LEqs) :-
var(X), var(Y), !,
'$localise_vars'(B, M, NB1, LV, LV0, [X,Y|LEqs]).
'$localise_vars'((G,B), M, (G,NB1), LV, LV0, LEqs) :-
'$safe_builtin'(G, M), !,
'$variables_in_term'(G, LV, LV1),
'$add_extra_safe'(G, NLV0, LV0),
'$localise_vars'(B, M, NB1, LV1, NLV0, LEqs).
'$localise_vars'((G1,B1), _, O, LV, LV0, LEqs) :- !,
terms:variables_within_term(LV, B1, Commons),
terms:new_variables_in_term(LV, B1, New),
copy_term(Commons+New+LEqs+B1, NCommons+NNew+NLEqs+NB1),
NNew = New,
NLEqs = LEqs,
'$gen_equals'(Commons, NCommons, LV0, (G1,NB1), O).
'$localise_vars'(G, _, G, _, _, _).
'$flatten_bd'((A,B),R,NB) :- !,
'$flatten_bd'(B,R,R1),
'$flatten_bd'(A,R1,NB).
'$flatten_bd'(A,R,(A,R)).
% the idea here is to make global variables in disjunctions
% local.
'$localise_vars_opt'(H, M, (B1;B2), (NB1;NB2)) :-
'$variables_in_term'(H, [], LV),
'$localise_vars'(B1, M, NB1, LV, LV, []),
'$localise_disj_vars'(B2, M, NB2, LV, LV, []).
%, portray_clause((H:-BF))
'$full_clause_optimisation'(H, M, B0, BF) :-
'$localise_vars_opt'(H, M, B0, BF), !.

106
packages/python/swig/yap4py/prolog/pl/flags.yap
View File

@ -1,106 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: flags.yap *
* Last rev: *
* mods: *
* comments: controlling YAP *
* *
*************************************************************************/
/**
* @file flagd.ysp
*
* @defgroup Flags Yap Flags
*n@{}
* @ingroup builtins
* @}@[ ]
*/
:- system_module( '$_flags', [create_prolog_flag/3,
current_prolog_flag/2,
no_source/0,
prolog_flag/2,
prolog_flag/3,
set_prolog_flag/2,
source/0,
source_mode/2,
yap_flag/2,
yap_flag/3], []).
'$adjust_language'(cprolog) :-
% '$switch_log_upd'(0),
'$syntax_check_mode'(_,off),
'$syntax_check_single_var'(_,off),
'$syntax_check_discontiguous'(_,off),
'$syntax_check_multiple'(_,off),
'$swi_set_prolog_flag'(character_escapes, false), % disable character escapes.
'$set_yap_flags'(14,1),
'$set_fpu_exceptions'(true),
unknown(_,fail).
'$adjust_language'(sicstus) :-
'$switch_log_upd'(1),
leash(full),
'$syntax_check_mode'(_,on),
'$syntax_check_single_var'(_,on),
'$syntax_check_discontiguous'(_,on),
'$syntax_check_multiple'(_,on),
'$transl_to_on_off'(X1,on),
'$set_yap_flags'(5,X1),
'$force_char_conversion',
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
'$set_fpu_exceptions'(true),
'$swi_set_prolog_flag'(fileerrors, true),
unknown(_,error).
'$adjust_language'(iso) :-
'$switch_log_upd'(1),
style_check(all),
fileerrors,
'$transl_to_on_off'(X1,on),
% CHAR_CONVERSION
'$set_yap_flags'(5,X1),
'$force_char_conversion',
% ALLOW_ASSERTING_STATIC
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
'$set_fpu_exceptions'(true),
unknown(_,error).
/** @pred create_prolog_flag(+ _Flag_,+ _Value_,+ _Options_)
Create a new YAP Prolog flag. _Options_ include
* `type(+_Type_)` with _Type_ one of `boolean`, `integer`, `float`, `atom`
and `term` (that is, any ground term)
* `access(+_Access_)` with _Access_ one of `read_only` or `read_write`
* `keeep(+_Keep_) protect existing flag.
*/
create_prolog_flag(Name, Value, Options) :-
'$flag_domain_from_value'( Value, Type ),
'$create_prolog_flag'(Name, Value, [type(Type)|Options]).
'$flag_domain_from_value'(true, boolean) :- !.
'$flag_domain_from_value'(false, boolean) :- !.
'$flag_domain_from_value'(Value, integer) :- integer(Value), !.
'$flag_domain_from_value'(Value, float) :- float(Value), !.
'$flag_domain_from_value'(Value, atom) :- atom(Value), !.
'$flag_domain_from_value'(_, term).
/**
@}
*/

325
packages/python/swig/yap4py/prolog/pl/grammar.yap
View File

@ -1,325 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: grammar.pl *
* Last rev: *
* mods: *
* comments: BNF grammar for Prolog *
* *
*************************************************************************/
/**
* @file grammar.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 10:20:55 2015
*
* @brief Grammar Rules
*
*
*/
/**
@defgroup Grammars Grammar Rules
@ingroup builtins
@{
Grammar rules in Prolog are both a convenient way to express definite
clause grammars and an extension of the well known context-free grammars.
A grammar rule is of the form:
~~~~~
head --> body
~~~~~
where both \a head and \a body are sequences of one or more items
linked by the standard conjunction operator `,`.
<em>Items can be:</em>
+
a <em>non-terminal</em> symbol may be either a complex term or an atom.
+
a <em>terminal</em> symbol may be any Prolog symbol. Terminals are
written as Prolog lists.
+
an <em>empty body</em> is written as the empty list `[ ]`.
+
<em>extra conditions</em> may be inserted as Prolog procedure calls, by being
written inside curly brackets `{` and `}`.
+
the left side of a rule consists of a nonterminal and an optional list
of terminals.
+
alternatives may be stated in the right-hand side of the rule by using
the disjunction operator `;`.
+
the <em>cut</em> and <em>conditional</em> symbol (`->`) may be inserted in the
right hand side of a grammar rule
Grammar related built-in predicates:
*/
:- system_module( '$_grammar', [!/2,
(',')/4,
(->)/4,
('.')/4,
(;)/4,
'C'/3,
[]/2,
[]/4,
(\+)/3,
phrase/2,
phrase/3,
{}/3,
('|')/4], ['$do_error'/2]).
% :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal).
% :- meta_predicate ^(?,1,?,?).
% ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs).
/*
Variables X in grammar rule bodies are translated as
if phrase(X) had been written, where phrase/3 is obvious.
Also, phrase/2-3 check their first argument.
*/
prolog:'$translate_rule'(Rule, (NH :- B) ) :-
source_module( SM ),
'$yap_strip_module'( SM:Rule, M0, (LP-->RP) ),
t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)),
'$yap_strip_module'( M0:NH0, M, NH1 ),
( M == SM -> NH = NH1 ; NH = M:NH1 ),
(var(NGs) ->
t_body(RP, _, last, S, SR, B1)
;
t_body((RP,{NGs}), _, last, S, SR, B1)
),
t_tidy(B1, B).
t_head(V, _, _, _, _, G0) :- var(V), !,
'$do_error'(instantiation_error,G0).
t_head((H,List), NH, NGs, S, S1, G0) :- !,
t_hgoal(H, NH, S, SR, G0),
t_hlist(List, S1, SR, NGs, G0).
t_head(H, NH, _, S, SR, G0) :-
t_hgoal(H, NH, S, SR, G0).
t_hgoal(V, _, _, _, G0) :- var(V), !,
'$do_error'(instantiation_error,G0).
t_hgoal(M:H, M:NH, S, SR, G0) :- !,
t_hgoal(H, NH, S, SR, G0).
t_hgoal(H, NH, S, SR, _) :-
extend([S,SR],H,NH).
t_hlist(V, _, _, _, G0) :- var(V), !,
'$do_error'(instantiation_error,G0).
t_hlist([], _, _, true, _).
t_hlist(String, S0, SR, SF, G0) :- string(String), !,
string_codes( String, X ),
t_hlist( X, S0, SR, SF, G0).
t_hlist([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
t_hlist([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
t_hlist(List, S0, S1, G0, Goal).
t_hlist(T, _, _, _, Goal) :-
'$do_error'(type_error(list,T),Goal).
%
% Two extra variables:
% ToFill tells whether we need to explictly close the chain of
% variables.
% Last tells whether we are the ones who should close that chain.
%
t_body(Var, filled_in, _, S, S1, phrase(Var,S,S1)) :-
var(Var),
!.
t_body(!, to_fill, last, S, S1, (!, S1 = S)) :- !.
t_body(!, _, _, S, S, !) :- !.
t_body([], to_fill, last, S, S1, S1=S) :- !.
t_body([], _, _, S, S, true) :- !.
t_body(X, FilledIn, Last, S, SR, OS) :- string(X), !,
string_codes( X, Codes),
t_body(Codes, FilledIn, Last, S, SR, OS).
t_body([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !.
t_body([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !,
t_body(R, filled_in, Last, SR1, SR, RB).
t_body({T}, to_fill, last, S, S1, (T, S1=S)) :- !.
t_body({T}, _, _, S, S, T) :- !.
t_body((T,R), ToFill, Last, S, SR, (Tt,Rt)) :- !,
t_body(T, ToFill, not_last, S, SR1, Tt),
t_body(R, ToFill, Last, SR1, SR, Rt).
t_body((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
t_body(T, ToFill, not_last, S, SR1, Tt),
t_body(R, ToFill, Last, SR1, SR, Rt).
t_body(\+T, ToFill, _, S, SR, (Tt->fail ; S=SR)) :- !,
t_body(T, ToFill, not_last, S, _, Tt).
t_body((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
t_body(T, _, last, S, SR, Tt),
t_body(R, _, last, S, SR, Rt).
t_body((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
t_body(T, _, last, S, SR, Tt),
t_body(R, _, last, S, SR, Rt).
t_body(M:G, ToFill, Last, S, SR, M:NG) :- !,
t_body(G, ToFill, Last, S, SR, NG).
t_body(T, filled_in, _, S, SR, Tt) :-
extend([S,SR], T, Tt).
extend(More, OldT, NewT) :-
OldT =.. OldL,
lists:append(OldL, More, NewL),
NewT =.. NewL.
t_tidy(P,P) :- var(P), !.
t_tidy((P1;P2), (Q1;Q2)) :- !,
t_tidy(P1, Q1),
t_tidy(P2, Q2).
t_tidy((P1->P2), (Q1->Q2)) :- !,
t_tidy(P1, Q1),
t_tidy(P2, Q2).
t_tidy(((P1,P2),P3), Q) :-
t_tidy((P1,(P2,P3)), Q).
t_tidy((true,P1), Q1) :- !,
t_tidy(P1, Q1).
t_tidy((P1,true), Q1) :- !,
t_tidy(P1, Q1).
t_tidy((P1,P2), (Q1,Q2)) :- !,
t_tidy(P1, Q1),
t_tidy(P2, Q2).
t_tidy(A, A).
/** @pred `C`( _S1_, _T_, _S2_)
This predicate is used by the grammar rules compiler and is defined as
`C`([H|T],H,T)`.
*/
prolog:'C'([X|S],X,S).
/** @pred phrase(+ _P_, _L_)
This predicate succeeds when _L_ is a phrase of type _P_. The
same as `phrase(P,L,[])`.
Both this predicate and the previous are used as a convenient way to
start execution of grammar rules.
*/
prolog:phrase(PhraseDef, WordList) :-
prolog:phrase(PhraseDef, WordList, []).
/** @pred phrase(+ _P_, _L_, _R_)
This predicate succeeds when the difference list ` _L_- _R_`
is a phrase of type _P_.
*/
prolog:phrase(V, S0, S) :-
var(V),
!,
'$do_error'(instantiation_error,phrase(V,S0,S)).
prolog:phrase([H|T], S0, S) :-
!,
S0 = [H|S1],
'$phrase_list'(T, S1, S).
prolog:phrase([], S0, S) :-
!,
S0 = S.
prolog:phrase(P, S0, S) :-
call(P, S0, S).
'$phrase_list'([], S, S).
'$phrase_list'([H|T], [H|S1], S0) :-
'$phrase_list'(T, S1, S0).
prolog:!(S, S).
prolog:[](S, S).
prolog:[](H, T, S0, S) :- lists:append([H|T], S, S0).
prolog:'.'(H,T, S0, S) :-
lists:append([H|T], S, S0).
prolog:{}(Goal, S0, S) :-
Goal,
S0 = S.
prolog:','(A,B, S0, S) :-
t_body((A,B), _, last, S0, S, Goal),
'$execute'(Goal).
prolog:';'(A,B, S0, S) :-
t_body((A;B), _, last, S0, S, Goal),
'$execute'(Goal).
prolog:('|'(A,B, S0, S)) :-
t_body((A|B), _, last, S0, S, Goal),
'$execute'(Goal).
prolog:'->'(A,B, S0, S) :-
t_body((A->B), _, last, S0, S, Goal),
'$execute'(Goal).
prolog:'\\+'(A, S0, S) :-
t_body(\+ A, _, last, S0, S, Goal),
'$execute'(Goal).
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat),
throw(error(Pat,ImplDep))
)
),
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
Mod:NT \== NewGoal0,
% apply translation only if we are safe
\+ '$contains_illegal_dcgnt'(NT),
!,
( var(Xsc), Xsc \== Xs0c
-> Xs = Xsc, NewGoal1 = NewGoal0
; NewGoal1 = (NewGoal0, Xsc = Xs)
),
( var(Xs0c)
-> Xs0 = Xs0c,
NewGoal2 = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2
),
'$yap_strip_module'(Mod:NewGoal2, M, NewGoal3),
(nonvar(NewGoal3) -> NewGoal = M:NewGoal3
;
var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M)
;
NewGoal = '$execute_in_mod'(NewGoal3,M)
).
do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :-
nonvar(NT), nonvar(Mod), !,
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal).
do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :-
nonvar(NT), nonvar(Mod),
'$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal).
/**
@}
*/

63
packages/python/swig/yap4py/prolog/pl/ground.yap
View File

@ -1,63 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: ground.pl *
* Last rev: *
* mods: *
* comments: Variables and ground *
* *
*************************************************************************/
/*
% grounds all free variables
% as terms of the form '$VAR'(N)
numbervars('$VAR'(M), M, N) :- !,
succ(M, N).
numbervars(Atomic, M, M) :-
atomic(Atomic), !.
numbervars(Term, M, N) :-
functor(Term, _, Arity),
'$numbervars'(0,Arity, Term, M, N).
'$numbervars'(A, A, _, N, N) :- !.
'$numbervars'(A,Arity, Term, M, N) :-
'$succ'(A,An),
arg(An, Term, Arg),
numbervars(Arg, M, K), !,
'$numbervars'(An, Arity, Term, K, N).
ground(Term) :-
nonvar(Term), % This term is not a variable,
functor(Term, _, Arity),
'$ground'(Arity, Term). % and none of its arguments are.
'$ground'(0, _) :- !.
'$ground'(N, Term) :-
'$predc'(N,M),
arg(N, Term, ArgN),
ground(ArgN),
'$ground'(M, Term).
numbervars(Term, M, N) :-
'$variables_in_term'(Term, [], L),
'$numbermarked_vars'(L, M, N).
'$numbermarked_vars'([], M, M).
'$numbermarked_vars'([V|L], M, N) :-
attvar(V), !,
'$numbermarked_vars'(L, M, N).
'$numbermarked_vars'(['$VAR'(M)|L], M, N) :-
M1 is M+1,
'$numbermarked_vars'(L, M1, N).
*/

255
packages/python/swig/yap4py/prolog/pl/hacks.yap
View File

@ -1,255 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: utilities for messing around in YAP internals. *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2008-03-24 23:48:47 $,$Author: vsc $ *
* *
* *
*************************************************************************/
%% @file pl/hacks.yap
:- module('$hacks',
[display_stack_info/4,
display_stack_info/6,
display_pc/4,
fully_strip_module/3,
code_location/3]).
/** hacks:context_variables(-NamedVariables)
Access variable names.
Unify NamedVariables with a list of terms _Name_=_V_
giving the names of the variables occurring in the last term read.
Notice that variable names option must have been on.
*/
hacks:context_variables(NamedVariables) :-
'$context_variables'(NamedVariables).
prolog:'$stack_dump' :-
yap_hacks:current_choicepoints(CPs),
yap_hacks:current_continuations([Env|Envs]),
yap_hacks:continuation(Env,_,ContP,_),
length(CPs, LCPs),
length(Envs, LEnvs),
format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Clause Goal~n',[LCPs,LEnvs]),
display_stack_info(CPs, Envs, 20, ContP, StackInfo, []),
run_formats(StackInfo, user_error).
run_formats([], _).
run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args),
run_formats(StackInfo, Stream).
display_stack_info(CPs,Envs,Lim,PC) :-
display_stack_info(CPs,Envs,Lim,PC,Lines,[]),
flush_output(user_output),
flush_output(user_error),
print_message_lines(user_error, '', Lines).
code_location(Info,Where,Location) :-
integer(Where) , !,
pred_for_code(Where,Name,Arity,Mod,Clause),
construct_code(Clause,Name,Arity,Mod,Info,Location).
code_location(Info,_,Info).
construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode),
atom_codes(ArityAtom,ArityCode),
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
construct_code(0,_,_,_,Location,Location) :- !.
construct_code(Cl,Name,Arity,Mod,Where,Location) :-
number_codes(Arity,ArityCode),
atom_codes(ArityAtom,ArityCode),
number_codes(Cl,ClCode),
atom_codes(ClAtom,ClCode),
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
pred_for_code(Where,Name,Arity,Mod,Clause),
'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
'$prepare_loc'(Info,_,Info).
display_pc(PC, PP, Source) -->
{ integer(PC) },
{ pred_for_code(PC,Name,Arity,Mod,Clause) },
pc_code(Clause, PP, Name, Arity, Mod, Source).
pc_code(0,_PP,_Name,_Arity,_Mod, 'top level or system code' - []) --> !.
pc_code(-1,_PP,Name,Arity,Mod, '~a:~q/~d' - [Mod,Name,Arity]) --> !,
{ functor(S, Name,Arity),
nth_clause(Mod:S,1,Ref),
clause_property(Ref, file(File)),
clause_property(Ref, line_count(Line)) },
[ '~a:~d:0, ' - [File,Line] ].
pc_code(Cl,Name,Arity,Mod, 'clause ~d for ~a:~q/~d'-[Cl,Mod,Name,Arity]) -->
{ Cl > 0 },
{ functor(S, Name,Arity),
nth_clause(Mod:S,Cl,Ref),
clause_property(Ref, file(File)),
clause_property(Ref, line_count(Line)) },
[ '~a:~d:0, ' - [File,Line] ].
display_stack_info(_,_,0,_) --> !.
display_stack_info([],[],_,_) --> [].
display_stack_info([CP|CPs],[],I,_) -->
show_lone_cp(CP),
{ I1 is I-1 },
display_stack_info(CPs,[],I1,_).
display_stack_info([],[Env|Envs],I,Cont) -->
show_env(Env, Cont, NCont),
{ I1 is I-1 },
display_stack_info([], Envs, I1, NCont).
display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) -->
{
yap_hacks:continuation(Env, _, NCont, CB),
I1 is I-1
},
( { CP == Env, CB < CP } ->
% if we follow choice-point and we cut to before choice-point
% we are the same goal
show_cp(CP, ''), %
display_stack_info(LCPs, LEnvs, I1, NCont)
;
{ CP > Env } ->
show_cp(CP, ' < '),
display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
;
show_env(Env,Cont,NCont),
display_stack_info([CP|LCPs],LEnvs,I1,NCont)
).
show_cp(CP, Continuation) -->
{ yap_hacks:choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo) },
( { Goal = (_;_) }
->
{ scratch_goal(Name,Arity,Mod,Caller) },
[ '0x~16r~t*~16+ ~d~16+ ~q ~n'-
[Addr, ClNo, Caller] ]
;
[ '0x~16r~t *~16+~a ~d~16+ ~q:' -
[Addr, Continuation, ClNo, Mod]]
),
{ prolog_flag( debugger_print_options, Opts) },
{clean_goal(Goal,Mod,G)},
['~@.~n' - write_term(G,Opts)].
show_env(Env,Cont,NCont) -->
{
yap_hacks:continuation(Env, Addr, NCont, _),
format('0x~16r 0x~16r~n',[Env,NCont]),
yap_hacks:cp_to_predicate(Cont, Mod, Name, Arity, ClId)
},
[ '0x~16r~t ~16+ ~d~16+ ~q:' -
[Addr, ClId, Mod] ],
{scratch_goal(Name, Arity, Mod, G)},
{ prolog_flag( debugger_print_options, Opts) },
['~@.~n' - write_term(G,Opts)].
clean_goal(G,Mod,NG) :-
beautify_hidden_goal(G,Mod,[NG],[]), !.
clean_goal(G,_,G).
scratch_goal(N,0,Mod,Mod:N) :-
!.
scratch_goal(N,A,Mod,NG) :-
list_of_qmarks(A,L),
G=..[N|L],
(
beautify_hidden_goal(G,Mod,[NG],[])
;
G = NG
),
!.
list_of_qmarks(0,[]) :- !.
list_of_qmarks(I,[?|L]) :-
I1 is I-1,
list_of_qmarks(I1,L).
fully_strip_module( T, M, TF) :-
'$yap_strip_module'( T, M, TF).
beautify_hidden_goal('$yes_no'(G,_Query), prolog) -->
!,
{ Call =.. [(?), G] },
[Call].
beautify_hidden_goal('$do_yes_no'(G,Mod), prolog) -->
[Mod:G].
beautify_hidden_goal('$query'(G,VarList), prolog) -->
[query(G,VarList)].
beautify_hidden_goal('$enter_top_level', prolog) -->
['TopLevel'].
% The user should never know these exist.
beautify_hidden_goal('$csult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)].
beautify_hidden_goal('$use_module'(Files,Mod,Is),prolog) -->
[use_module(Mod,Files,Is)].
beautify_hidden_goal('$continue_with_command'(reconsult,V,P,G,Source),prolog) -->
['Assert'(G,V,P,Source)].
beautify_hidden_goal('$continue_with_command'(consult,V,P,G,Source),prolog) -->
['Assert'(G,V,P,Source)].
beautify_hidden_goal('$continue_with_command'(top,V,P,G,_),prolog) -->
['Query'(G,V,P)].
beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
['TopLevel'(Command,G,V,P,Source)].
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
['DebuggerCall'(M:G, InControl, Redo)].
beautify_hidden_goal('$do_spy'(Goal, Mod, _CP, InControl),prolog) -->
['DebuggerCall'(Mod:Goal, InControl)].
beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
[catch(Mod:G, Exc, Handler)].
beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
[catch(G, Exc, Handler)].
beautify_hidden_goal('$execute_command'(Query,V,P,Option,Source),prolog) -->
[toplevel_query(Query, V, P, Option, Source)].
beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) -->
[(:- Gs)].
beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
[execute_load_file(Stream, consult=Option)].
beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
[load_files(Files,Opts)].
beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
[Name].
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)].
beautify_hidden_goal('$undefp'([Mod|G]),prolog) -->
['CallUndefined'(Mod:G)].
beautify_hidden_goal('$undefp'(?),prolog) -->
['CallUndefined'(?:?)].
beautify_hidden_goal(repeat,prolog) -->
[repeat].
beautify_hidden_goal('$recorded_with_key'(A,B,C),prolog) -->
[recorded(A,B,C)].
beautify_hidden_goal('$findall_with_common_vars'(Templ,Gen,Answ),prolog) -->
[findall(Templ,Gen,Answ)].
beautify_hidden_goal('$bagof'(Templ,Gen,Answ),prolog) -->
[bagof(Templ,Gen,Answ)].
beautify_hidden_goal('$setof'(Templ,Gen,Answ),prolog) -->
[setof(Templ,Gen,Answ)].
beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
[findall(T,G,S,A)].
beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
[listing(M:G)].
beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
[call(M:G)].
beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
[call(M:G0)].
beautify_hidden_goal('$current_predicate'(Na,M,S,_),prolog) -->
[current_predicate(Na,M:S)].
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
[listing(Stream,M:Pred)].

384
packages/python/swig/yap4py/prolog/pl/init.yap
View File

@ -1,384 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
** Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: init.yap *
* Last rev: *
* mods: *
* comments: initializing the full prolog system *
* *
*************************************************************************/
/**
@file init.yap
@{
@defgroup library The Prolog library
@}
@addtogroup YAPControl
@ingroup builtins
@{
*/
:- system_module( '$_init', [!/0,
':-'/1,
'?-'/1,
[]/0,
extensions_to_present_answer/1,
fail/0,
false/0,
goal_expansion/2,
goal_expansion/3,
otherwise/0,
term_expansion/2,
version/2,
'$do_log_upd_clause'/6,
'$do_log_upd_clause0'/6,
'$do_log_upd_clause_erase'/6,
'$do_static_clause'/5], [
'$system_module'/1]).
:- use_system_module( '$_boot', ['$cut_by'/1]).
%:- start_low_level_trace.
% This is the YAP init file
% should be consulted first step after booting
% These are pseudo declarations
% so that the user will get a redefining system predicate
:- '$init_pred_flag_vals'('$flag_info'(a,0), prolog).
/** @pred fail is iso
Always fails.
*/
fail :- fail.
/** @pred false is iso
The same as fail.
*/
false :- fail.
otherwise.
!.
(:- G) :- '$execute'(G), !.
(?- G) :- '$execute'(G).
'$$!'(CP) :- '$cut_by'(CP).
[] :- true.
:- set_value('$doindex',true).
% just create a choice-point
% the 6th argument marks the time-stamp.
'$do_log_upd_clause'(_,_,_,_,_,_).
'$do_log_upd_clause'(A,B,C,D,E,_) :-
'$continue_log_update_clause'(A,B,C,D,E).
'$do_log_upd_clause'(_,_,_,_,_,_).
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
'$do_log_upd_clause_erase'(A,B,C,D,E,_) :-
'$continue_log_update_clause_erase'(A,B,C,D,E).
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
'$do_log_upd_clause0'(_,_,_,_,_,_).
'$do_log_upd_clause0'(A,B,C,D,_,_) :-
'$continue_log_update_clause'(A,B,C,D).
'$do_log_upd_clause0'(_,_,_,_,_,_).
'$do_static_clause'(_,_,_,_,_).
'$do_static_clause'(A,B,C,D,E) :-
'$continue_static_clause'(A,B,C,D,E).
'$do_static_clause'(_,_,_,_,_).
:- bootstrap('arith.yap').
:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- compile_expressions.
:- bootstrap('bootutils.yap').
:- bootstrap('bootlists.yap').
:- bootstrap('consult.yap').
:- bootstrap('preddecls.yap').
:- bootstrap('preddyns.yap').
:- bootstrap('meta.yap').
:- bootstrap('newmod.yap').
:- bootstrap('atoms.yap').
:- bootstrap('os.yap').
:- bootstrap('grammar.yap').
:- bootstrap('directives.yap').
:- bootstrap('absf.yap').
:- dynamic prolog:'$parent_module'/2.
:- [
'preds.yap',
'modules.yap'
].
:- use_module('error.yap').
:- [
'errors.yap',
'utils.yap',
'control.yap',
'flags.yap'
].
:- [
% lists is often used.
'yio.yap',
'debug.yap',
'checker.yap',
'depth_bound.yap',
'ground.yap',
'listing.yap',
'arithpreds.yap',
% modules must be after preds, otherwise we will have trouble
% with meta-predicate expansion being invoked
% must follow grammar
'eval.yap',
'signals.yap',
'profile.yap',
'callcount.yap',
'load_foreign.yap',
% 'save.yap',
'setof.yap',
'sort.yap',
'statistics.yap',
'strict_iso.yap',
'tabling.yap',
'threads.yap',
'eam.yap',
'yapor.yap',
'qly.yap',
'spy.yap',
'udi.yap'].
:- meta_predicate(log_event(+,:)).
:- dynamic prolog:'$user_defined_flag'/4.
:- multifile prolog:debug_action_hook/1.
:- multifile prolog:'$system_predicate'/2.
:- ['protect.yap'].
version(yap,[6,3]).
:- op(1150,fx,(mode)).
:- dynamic 'extensions_to_present_answer'/1.
:- ['arrays.yap'].
%:- start_low_level_trace.
:- multifile user:portray_message/2.
:- dynamic user:portray_message/2.
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined
procedure that is called after term expansion when compiling or
asserting goals for each sub-goal in a clause. The first argument is
bound to the goal and the second to the module under which the goal
_G_ will execute. If goal_expansion/3 succeeds the new
sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the defaultyap+flrules.
*/
:- multifile user:goal_expansion/3.
:- dynamic user:goal_expansion/3.
:- multifile user:goal_expansion/2.
:- dynamic user:goal_expansion/2.
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
:- multifile goal_expansion/2.
:- dynamic goal_expansion/2.
:- use_module('messages.yap').
:- ['undefined.yap'].
:- use_module('hacks.yap').
:- use_module('attributes.yap').
:- use_module('corout.yap').
:- use_module('dialect.yap').
:- use_module('dbload.yap').
:- use_module('../library/ypp.yap').
:- use_module('../os/chartypes.yap').
:- ensure_loaded('../os/edio.yap').
yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character
:- set_prolog_flag(generate_debug_info,true).
%
% cleanup ensure loaded and recover some data-base space.
%
:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
:- ( recorded('$module',_,R), erase(R), fail ; true ).
:- set_value('$user_module',user), '$protect'.
:- style_check([+discontiguous,+multiple,+single_var]).
%
% moved this to init_gc in gc.c to separate the alpha
%
% :- yap_flag(gc,on).
% :- yap_flag(gc_trace,verbose).
:- multifile
prolog:comment_hook/3.
:- source.
:- module(user).
/** @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.
:- dynamic term_expansion/2.
:- multifile system:term_expansion/2.
:- dynamic system:term_expansion/2.
:- multifile swi:swi_predicate_table/4.
/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_)
Hook predicate that may be define in the module `user` to intercept
messages from print_message/2. _Term_ and _Kind_ are the
same as passed to print_message/2. _Lines_ is a list of
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.
:- dynamic user:message_hook/3.
/** @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.
If this hook predicate succeeds it must instantiate the _Action_ argument to the atom `fail` to make the operation fail silently, `retry` to tell Prolog to retry the operation or `error` to make the system generate an exception. The action `retry` only makes sense if this hook modified the environment such that the operation can now succeed without error.
+ `undefined_predicate`
_Context_ is instantiated to a predicate-indicator ( _Module:Name/Arity_). If the predicate fails Prolog will generate an existence_error exception. The hook is intended to implement alternatives to the SWI built-in autoloader, such as autoloading code from a database. Do not use this hook to suppress existence errors on predicates. See also `unknown`.
+ `undefined_global_variable`
_Context_ is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action retry.
*/
:- multifile user:exception/3.
:- dynamic user:exception/3.
:- reconsult('pathconf.yap').
/*
Add some tests
*/
:- yap_flag(user:unknown,error).
/*
:- if(predicate_property(run_tests, static)).
aa b.
p(X,Y) :- Y is X*X.
prefix(information, '% ', S, user_error) --> [].
:- format('~d~n', [a]).
:- format('~d~n', []).
:- p(X,Y).
a(1).
a.
a(2).
a(2).
lists:member(1,[1]).
clause_to_indicator(T, M:Name/Arity) :- ,
strip_module(T, M, T1),
pred_arity( T1, Name, Arity ).
:- endif.
*/

330
packages/python/swig/yap4py/prolog/pl/listing.yap
View File

@ -1,330 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: listing.pl *
* Last rev: *
* mods: *
* comments: listing a prolog program *
* *
*************************************************************************/
:- system_module( '$_listing', [listing/0,
listing/1,
portray_clause/1,
portray_clause/2], []).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_preds', ['$clause'/4,
'$current_predicate'/4]).
/* listing : Listing clauses in the database
*/
/** @pred listing
vxuLists in the current output stream all the clauses for which source code
is available (these include all clauses for dynamic predicates and
clauses for static predicates compiled when source mode was `on`).
- listing/0 lists in the current module
- listing/1 receives a generalization of the predicate indicator:
+ `listing(_)` will list the whole sources.
+ `listing(lists:_)` will list the module lists.
+ `listing(lists:append)` will list all `append` predicates in the module lists.
+ `listing(lists:append/_)` will do the same.
+ listing(lists:append/3)` will list the popular `append/3` predicate in the module lists.
- listing/2 is similar to listing/1, but t he first argument is a stream reference.
The `listing` family of built-ins does not enumerate predicates whose
name starts with a `$` character.
*/
listing :-
current_output(Stream),
'$current_module'(Mod),
\+ system_module(Mod),
Mod \= prolog,
Mod \= system,
\+ '$hidden_atom'( Mod ),
current_predicate( Name, Mod:Pred ),
\+ '$undefined'(Pred, Mod), % skip predicates exported from prolog.
functor(Pred,Name,Arity),
'$listing'(Name,Arity,Mod,Stream),
fail.
listing.
/** @pred listing(+ _P_)
Lists predicate _P_ if its source code is available.
*/
listing(MV) :-
current_output(Stream),
listing(Stream, MV).
listing(Stream, MV) :-
strip_module( MV, M, I),
'$mlisting'(Stream, I, M).
listing(_Stream, []) :- !.
listing(Stream, [MV|MVs]) :- !,
listing(Stream, MV),
listing(Stream, MVs).
'$mlisting'(Stream, MV, M) :-
( var(MV) ->
MV = NA,
'$do_listing'(Stream, M, NA)
;
atom(MV) ->
MV/_ = NA,
'$do_listing'(Stream, M, NA)
;
MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, NA/Ar2, M), Ar2 >= 2, Ar is Ar2-2 )
;
MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(Ar) ) ->
'$do_listing'(Stream, M, MV)
;
MV = M1:PP -> '$mlisting'(Stream, PP, M1)
;
'$do_error'(type_error(predicate_indicator,MV),listing(Stream, MV) )
).
'$do_listing'(Stream, M, Name/Arity) :-
( current_predicate(Name, M:Pred),
functor( Pred, Name, Arity),
\+ '$undefined'(Pred, M),
'$listing'(Name,Arity,M,Stream),
fail
;
true
).
%
% at this point we are ground and we know who we want to list.
%
'$listing'(Name, Arity, M, Stream) :-
% skip by default predicates starting with $
functor(Pred,Name,Arity),
'$list_clauses'(Stream,M,Pred).
'$listing'(_,_,_,_).
'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
'$funcspec'(Name,Name,_) :- atom(Name), !.
'$funcspec'(Name,_,_) :-
'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
'$list_clauses'(Stream, M, Pred) :-
'$predicate_flags'(Pred,M,Flags,Flags),
(Flags /\ 0x48602000 =\= 0
->
nl(Stream),
fail
;
!
).
'$list_clauses'(Stream, M, Pred) :-
( '$is_dynamic'(Pred, M) -> true ; '$is_log_updatable'(Pred, M) ),
functor( Pred, N, Ar ),
'$current_module'(Mod),
(
M == Mod
->
format( Stream, ':- dynamic ~q/~d.~n', [N,Ar])
;
format( Stream, ':- dynamic ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
'$is_thread_local'(Pred, M),
functor( Pred, N, Ar ),
'$current_module'(Mod),
(
M == Mod
->
format( Stream, ':- thread_local ~q/~d.~n', [N,Ar])
;
format( Stream, ':- thread_local ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
'$is_multifile'(Pred, M),
functor( Pred, N, Ar ),
'$current_module'(Mod),
(
M == Mod
->
format( Stream, ':- multifile ~q/~d.~n', [N,Ar])
;
format( Stream, ':- multifile ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
'$is_metapredicate'(Pred, M),
functor( Pred, Name, Arity ),
prolog:'$meta_predicate'(Name,M,Arity,PredDef),
'$current_module'(Mod),
(
M == Mod
->
format( Stream, ':- ~q.~n', [PredDef])
;
format( Stream, ':- ~q:~q.~n', [M,PredDef])
),
fail.
'$list_clauses'(Stream, _M, _Pred) :-
nl( Stream ),
fail.
'$list_clauses'(Stream, M, Pred) :-
'$predicate_flags'(Pred,M,Flags,Flags),
% has to be dynamic, source, or log update.
Flags /\ 0x08402000 =\= 0,
'$clause'(Pred, M, Body, _),
'$current_module'(Mod),
( M \= Mod -> H = M:Pred ; H = Pred ),
'$portray_clause'(Stream,(H:-Body)),
fail.
/** @pred portray_clause(+ _S_,+ _C_)
Write clause _C_ on stream _S_ as if written by listing/0.
*/
portray_clause(Stream, Clause) :-
copy_term_nat(Clause, CopiedClause),
'$portray_clause'(Stream, CopiedClause),
fail.
portray_clause(_, _).
/** @pred portray_clause(+ _C_)
Write clause _C_ as if written by listing/0.
*/
portray_clause(Clause) :-
current_output(Stream),
portray_clause(Stream, Clause).
'$portray_clause'(Stream, (Pred :- true)) :- !,
'$beautify_vars'(Pred),
format(Stream, '~q.~n', [Pred]).
'$portray_clause'(Stream, (Pred:-Body)) :- !,
'$beautify_vars'((Pred:-Body)),
format(Stream, '~q :-', [Pred]),
'$write_body'(Body, 3, ',', Stream),
format(Stream, '.~n', []).
'$portray_clause'(Stream, Pred) :-
'$beautify_vars'(Pred),
format(Stream, '~q.~n', [Pred]).
'$write_body'(X,I,T,Stream) :- var(X), !,
'$beforelit'(T,I,Stream),
writeq(Stream, '_').
'$write_body'((P,Q), I, T, Stream) :-
!,
'$write_body'(P,I,T, Stream),
put(Stream, 0',),
'$write_body'(Q,I,',',Stream).
'$write_body'((P->Q;S),I,_, Stream) :-
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',Stream),
format(Stream, '~n~*c->',[I,0' ]),
'$write_disj'((Q;S),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P->Q|S),I,_,Stream) :-
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I,'(',Stream),
format(Stream, '~n~*c->',[I,0' ]),
'$write_disj'((Q|S),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P->Q),I,_,Stream) :-
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',Stream),
format(Stream, '~n~*c->',[I,0' ]),
'$write_body'(Q,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P;Q),I,_,Stream) :-
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_disj'((P;Q),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P|Q),I,_,Stream) :-
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_disj'((P|Q),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'(X,I,T,Stream) :-
'$beforelit'(T,I,Stream),
writeq(Stream,X).
'$write_disj'((Q;S),I0,I,C,Stream) :- !,
'$write_body'(Q,I,C,Stream),
format(Stream, '~n~*c;',[I0,0' ]),
'$write_disj'(S,I0,I,';',Stream).
'$write_disj'((Q|S),I0,I,C,Stream) :- !,
'$write_body'(Q,I,C,Stream),
format(Stream, '~n~*c|',[I0,0' ]),
'$write_disj'(S,I0,I,'|',Stream).
'$write_disj'(S,_,I,C,Stream) :-
'$write_body'(S,I,C,Stream).
'$beforelit'('(',_,Stream) :-
!,
format(Stream,' ',[]).
'$beforelit'(_,I,Stream) :- format(Stream,'~n~*c',[I,0' ]).
'$beautify_vars'(T) :-
'$list_get_vars'(T,[],L),
msort(L,SL),
'$list_transform'(SL,0).
'$list_get_vars'(V,L,[V|L] ) :- var(V), !.
'$list_get_vars'(Atomic, M, M) :-
primitive(Atomic), !.
'$list_get_vars'([Arg|Args], M, N) :- !,
'$list_get_vars'(Arg, M, K),
'$list_get_vars'(Args, K, N).
'$list_get_vars'(Term, M, N) :-
Term =.. [_|Args],
'$list_get_vars'(Args, M, N).
'$list_transform'([],_) :- !.
'$list_transform'([X,Y|L],M) :-
X == Y,
X = '$VAR'(M),
!,
N is M+1,
'$list_transform'(L,N).
'$list_transform'(['$VAR'(-1)|L],M) :- !,
'$list_transform'(L,M).
'$list_transform'([_|L],M) :-
'$list_transform'(L,M).

244
packages/python/swig/yap4py/prolog/pl/load_foreign.yap
View File

@ -1,244 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: load_foreign.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Utility predicates for load_foreign *
* *
*************************************************************************/
:- system_module( '$_load_foreign', [load_foreign_files/3,
open_shared_object/2,
open_shared_object/3], ['$import_foreign'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_modules', ['$do_import'/3]).
/**
@defgroup LoadForeign Access to Foreign Language Programs
@ingroup fli_c_cx
@{
*/
/** @pred load_foreign_files( _Files_, _Libs_, _InitRoutine_)
should be used, from inside YAP, to load object files produced by the C
compiler. The argument _ObjectFiles_ should be a list of atoms
specifying the object files to load, _Libs_ is a list (possibly
empty) of libraries to be passed to the unix loader (`ld`) and
InitRoutine is the name of the C routine (to be called after the files
are loaded) to perform the necessary declarations to YAP of the
predicates defined in the files.
YAP will search for _ObjectFiles_ in the current directory first. If
it cannot find them it will search for the files using the environment
variable:
+ YAPLIBDIR
if defined, or in the default library.
YAP supports the SWI-Prolog interface to loading foreign code, the shlib package.
*/
load_foreign_files(Objs,Libs,Entry) :-
source_module(M),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
'$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)),
'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
(
recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
->
'$load_foreign_files'(NewObjs,NewLibs,Entry),
(
prolog_load_context(file, F)
->
ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
;
true
)
;
true
),
!.
/** @pred load_absolute_foreign_files( _Files_, _Libs_, _InitRoutine_)
Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_.
*/
load_absolute_foreign_files(Objs,Libs,Entry) :-
source_module(M),
(
recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
->
'$load_foreign_files'(Objs,Libs,Entry),
(
prolog_load_context(file, F)
->
ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
;
true
)
;
true
),
!.
'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_objs_for_load_foreign_files'([],[],_) :- !.
'$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !,
'$check_obj_for_load_foreign_files'(Obj,NObj,G),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,G).
'$check_objs_for_load_foreign_files'(Objs,_,G) :-
'$do_error'(type_error(list,Objs),G).
'$check_obj_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !,
( atom(Obj), Obj1 = foreign(Obj) ; Obj1 = Obj ),
absolute_file_name(foreign(Obj),[file_type(executable),
access(read),
expand(true),
file_errors(fail)
], NewObj).
'$check_obj_for_load_foreign_files'(Obj,_,G) :-
'$do_error'(type_error(atom,Obj),G).
'$check_libs_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_libs_for_load_foreign_files'([],[],_) :- !.
'$check_libs_for_load_foreign_files'([Lib|Libs],[NLib|NLibs],G) :- !,
'$check_lib_for_load_foreign_files'(Lib,NLib,G),
'$check_libs_for_load_foreign_files'(Libs,NLibs,G).
'$check_libs_for_load_foreign_files'(Libs,_,G) :-
'$do_error'(type_error(list,Libs),G).
'$check_lib_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_lib_for_load_foreign_files'(Lib,NLib,_) :- atom(Lib), !,
'$process_obj_suffix'(Lib,NewLib),
'$checklib_prefix'(NewLib,NLib).
'$check_lib_for_load_foreign_files'(Lib,_,G) :-
'$do_error'(type_error(atom,Lib),G).
'$process_obj_suffix'(Obj,Obj) :-
current_prolog_flag(shared_object_extension, ObjSuffix),
sub_atom(Obj, _, _, 0, ObjSuffix), !.
'$process_obj_suffix'(Obj,NewObj) :-
current_prolog_flag(shared_object_extension, ObjSuffix),
atom_concat([Obj,'.',ObjSuffix],NewObj).
'$checklib_prefix'(F,F) :- is_absolute_file_name(F), !.
'$checklib_prefix'(F, F) :-
sub_atom(F, 0, _, _, lib), !.
'$checklib_prefix'(F, Lib) :-
atom_concat(lib, F, Lib).
'$import_foreign'(F, M0, M) :-
M \= M0,
predicate_property(M0:P,built_in),
predicate_property(M0:P,file(F)),
functor(P, N, K),
'$do_import'(N/K-N/K, M0, M),
fail.
'$import_foreign'(_F, _M0, _M).
'$check_entry_for_load_foreign_files'(V,G) :- var(V), !,
'$do_error'(instantiation_error,G).
'$check_entry_for_load_foreign_files'(Entry,_) :- atom(Entry), !.
'$check_entry_for_load_foreign_files'(Entry,G) :-
'$do_error'(type_error(atom,Entry),G).
/** @pred open_shared_object(+ _File_, - _Handle_)
File is the name of a shared object file (called dynamic load
library in MS-Windows). This file is attached to the current process
and _Handle_ is unified with a handle to the library. Equivalent to
`open_shared_object(File, [], Handle)`. See also
load_foreign_library/1 and `load_foreign_library/2`.
On errors, an exception `shared_object`( _Action_,
_Message_) is raised. _Message_ is the return value from
dlerror().
*/
open_shared_object(File, Handle) :-
open_shared_object(File, [], Handle).
/** @pred open_shared_object(+ _File_, - _Handle_, + _Options_)
As `open_shared_object/2`, but allows for additional flags to
be passed. _Options_ is a list of atoms. `now` implies the
symbols are
resolved immediately rather than lazily (default). `global` implies
symbols of the loaded object are visible while loading other shared
objects (by default they are local). Note that these flags may not
be supported by your operating system. Check the documentation of
`dlopen()` or equivalent on your operating system. Unsupported
flags are silently ignored.
*/
open_shared_object(File, Opts, Handle) :-
'$open_shared_opts'(Opts, open_shared_object(File, Opts, Handle), OptsI),
'$open_shared_object'(File, OptsI, Handle),
prolog_load_context(module, M),
ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ).
'$open_shared_opts'(Opts, G, _OptsI) :-
var(Opts), !,
'$do_error'(instantiation_error,G).
'$open_shared_opts'([], _, 0) :- !.
'$open_shared_opts'([Opt|Opts], G, V) :-
'$open_shared_opts'(Opts, G, V0),
'$open_shared_opt'(Opt, G, OptV),
V0 is V \/ OptV.
'$open_shared_opt'(Opt, G, _) :-
var(Opt), !,
'$do_error'(instantiation_error,G).
'$open_shared_opt'(now, __, 1) :- !.
'$open_shared_opt'(global, __, 2) :- !.
'$open_shared_opt'(Opt, Goal, _) :-
'$do_error'(domain_error(open_shared_object_option,Opt),Goal).
/** @pred call_shared_object_function(+ _Handle_, + _Function_)
Call the named function in the loaded shared library. The function is
called without arguments and the return-value is ignored. YAP supports
installing foreign language predicates using calls to 'UserCCall()`,
`PL_register_foreign()`, and friends.
*/
call_shared_object_function( Handle, Function) :-
'$call_shared_object_function'( Handle, Function),
prolog_load_context(module, M),
ignore( recordzifnot( '$foreign', M:'$swi_foreign'( Handle, Function ), _) ).
%% @}
/** @pred $slave is det
Called at boot-time when Prolog is run from another language (eg, Java, Python, Android)
*/
'$slave' :-
getenv( '__PYVENV_LAUNCHER__', _ ),
use_module( library(python) ).

987
packages/python/swig/yap4py/prolog/pl/messages.yap
View File

@ -1,987 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: utilities for displaying messages in YAP. *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2008-07-16 10:58:59 $,$Author: vsc $ *
* *
* *
*************************************************************************/
/**
* @file messages.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 10:22:26 2015
*
* @brief The YAP Message Handler
*
*
*/
/**
@defgroup Messages Message Handling
@ingroup YAPControl
The interaction between YAP and the user relies on YAP's ability to
portray messages. These messages range from prompts to error
information. All message processing is performed through the builtin
print_message/2, in two steps:
+ The message is processed into a list of commands
+ The commands in the list are sent to the `format/3` builtin
in sequence.
The first argument to print_message/2 specifies the importance of
the message. The options are:
+ `error`
error handling
+ `warning`
compilation and run-time warnings,
+ `informational`
generic informational messages
+ `help`
help messages (not currently implemented in YAP)
+ `query`
query used in query processing (not currently implemented in YAP)
+ `silent`,M,Na,Ar,File, FilePos]],
[nl, nl].
caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) },
['~*|called from
messages that do not produce output but that can be intercepted by hooks.
The next table shows the main predicates and hooks associated to message
handling in YAP:
An error record comsists of An ISO compatible descriptor of the format
error(errror_kind(Culprit,..), Info)
In YAP, the infoo field describes:
- what() more detauls on the event
- input_stream, may be ine of;
- loop_sream
- file()
- none
- prolog_source(_) a record containing file, line, predicate, and clause
that activated the goal, or a list therof. YAP tries to search for the user
code generatinng the error.
- c_source(0), a record containing the line of C-code thhat caused the event. This
is reported under systm debugging mode, or if this is user code.
- stream_source() - a record containg data on the the I/O stream datum causisng the evwnt.
- user_message () - ttext on the event.
@{
*/
:- module(system('$messages'),
[system_message/4,
prefix/6,
prefix/5,
file_location/3]).
:- use_system_module( user, [message_hook/3]).
:- multifile prolog:message/3.
:- multifile user:message_hook/3.
/** @pred message_to_string(+ _Term_, - _String_)
Translates a message-term into a string object. Primarily intended for SWI-Prolog emulation.
*/
prolog:message_to_string(Event, Message) :-
translate_message(Event, warning, Message, []).
%% @pred compose_message(+Term, +Level, +Lines, -Lines0) is det
%
% Print the message if the user did not intercept the message.
% The first is used for errors and warnings that can be related
% to source-location. Note that syntax errors have their own
% source-location and should therefore not be handled this way.
compose_message( Term, Level ) -->
[' ~w:'- [Level]
],
prolog:message(Term), !.
compose_message( query(_QueryResult,_), _Level) -->
[].
compose_message( absolute_file_path(File), _Level) -->
[ '~N~n absolute_file of ~w' - [File] ].
compose_message( absolute_file_path(Msg, Args), _Level) -->
[ ' : ' - [],
Msg - Args,
nl ].
compose_message( arguments([]), _Level) -->
[].
compose_message( arguments([A|As]), Level) -->
[ ' ~w' - [A],
nl ],
compose_message( arguments(As), Level).
compose_message( ancestors([]), _Level) -->
[ 'There are no ancestors.' ].
compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) -->
[ 'There is already a spy point on ~w:~w/~w.' - [M,F,N] ].
compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,ok), _Level) -->
[ 'Spy point set on ~w:~w/~w.' - [M,F,N] ].
compose_message( breakp(bp(debugger,_,_,M:F/N,_),remove,last), _Level) -->
[ 'Spy point on ~w:~w/~w removed.' - [M,F,N] ].
compose_message( breakp(no,breakpoint_for,M:F/N), _Level) -->
[ 'There is no spy point on ~w:~w/~w.' - [M,F,N] ].
compose_message( breakpoints([]), _Level) -->
[ 'There are no spy-points set.' ].
compose_message( breakpoints(L), _Level) -->
[ 'Spy-points set on:' ],
list_of_preds(L).
compose_message( clauses_not_together(P), _Level) -->
[ 'Discontiguous definition of ~q.' - [P] ].
compose_message( debug(debug), _Level) -->
[ 'Debug mode on.' - [] ].
compose_message( debug(off), _Level) -->
[ 'Debug mode off.'- [] ].
compose_message( debug(trace), _Level) -->
[ 'Trace mode on.'- [] ].
compose_message( declaration(Args,Action), _Level) -->
[ 'declaration ~w ~w.' - [Args,Action] ].
compose_message( defined_elsewhere(P,F), _Level) -->
[ 'predicate ~q previously defined in file ~w' - [P,F] ].
compose_message( functionality(Library), _Level) -->
[ '~q not available' - [Library] ].
compose_message( import(Pred,To,From,private), _Level) -->
[ 'Importing private predicate ~w:~w to ~w.' - [From,Pred,To] ].
compose_message( redefine_imported(M,M0,PI), _Level) -->
{ source_location(ParentF, Line) },
[ '~w:~w: Module ~w redefines imported predicate ~w:~w.' - [ParentF, Line, M,M0,PI] ].
compose_message( leash([]), _Level) -->
[ 'No leashing.' ].
compose_message( leash([A|B]), _Level) -->
[ 'Leashing set to ~w.' - [[A|B]] ].
compose_message( no, _Level) -->
[ 'no' - [] ].
compose_message( no_match(P), _Level) -->
[ 'No matching predicate for ~w.' - [P] ].
compose_message( leash([A|B]), _Level) -->
[ 'Leashing set to ~w.' - [[A|B]] ].
compose_message( halt, _Level) --> !,
[ 'YAP execution halted.'-[] ].
compose_message( false, _Level) --> !,
[ 'false.'-[] ].
compose_message( '$abort', _Level) --> !,
[ 'YAP execution aborted'-[] ].
compose_message( abort(user), _Level) --> !,
[ 'YAP execution aborted' - [] ].
compose_message( loading(_,F), _Level) --> { F == user }, !.
compose_message( loading(What,FileName), _Level) --> !,
[ '~a ~w...' - [What, FileName] ].
compose_message( loaded(_,user,_,_,_), _Level) --> !.
compose_message( loaded(included,AbsFileName,Mod,Time,Space), _Level) --> !,
[ '~a included in module ~a, ~d msec ~d bytes' -
[AbsFileName,Mod,Time,Space] ].
compose_message( loaded(What,AbsoluteFileName,Mod,Time,Space), _Level) --> !,
[ '~a ~a in module ~a, ~d msec ~d bytes' -
[What, AbsoluteFileName,Mod,Time,Space] ].
compose_message(trace_command(-1), _Leve) -->
[ 'EOF is not a valid debugger command.' ].
compose_message(trace_command(C), _Leve) -->
[ '~c is not a valid debugger command.' - [C] ].
compose_message(trace_help, _Leve) -->
[ ' Please enter a valid debugger command (h for help).' ].
compose_message(version(Version), _Leve) -->
[ '~a' - [Version] ].
compose_message(myddas_version(Version), _Leve) -->
[ 'MYDDAS version ~a' - [Version] ].
compose_message(yes, _Level) --> !,
[ 'yes'- [] ].
compose_message(Term, Level) -->
{ '$show_consult_level'(LC) },
location(Term, Level, LC),
main_message( Term, Level, LC ),
c_goal( Term, Level ),
caller( Term, Level ),
extra_info( Term, Level ),
!,
[nl,nl].
compose_message(Term, Level) -->
{ Level == error -> true ; Level == warning },
{ '$show_consult_level'(LC) },
main_message( Term, Level, LC),
[nl,nl].
location(error(syntax_error(_),info(between(_,LN,_), FileName, _)), _ , _) -->
!,
[ '~a:~d:~d ' - [FileName,LN,0] ] .
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
!,
[ '~a:~d:0 ' - [FileName,LN] ] .
location( error(_,Term), Level, LC ) -->
{ source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !,
display_consulting( F0, Level, LC ),
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
location( error(_,Term), Level, LC ) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
display_consulting( File, Level, LC ),
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message(error(Msg,Info), _, _) --> {var(Info)}, !,
[ ' error: uninstantiated message ~w~n.' - [Msg], nl ].
main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream,Term)), Level, LC ) -->
!,
[' ~a: syntax error ~s' - [Level,Msg]],
[nl],
( syntax_error_term( between(L0,LM,LF), Term, LC )
->
[]
;
[' ~a: failed_processing syntax error term ~q' - [Level,Term]],
[nl]
).
main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), Level, _LC) -->
!,
% {writeln(ci)},
{ clause_to_indicator(P, I) },
[ ' ~a: singleton variable~*c ~s in ~q.' - [ Level, NVs, 0's, SVsL, I] ],
{ svs(SVs,SVs,SVsL),
( SVs = [_] -> NVs = 0 ; NVs = 1 )
}.
main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_), Level, _LC) -->
!,
[ ' ~a: ~a redefines ~q from ~a.' - [Level,File, Mod:N/A, I0] ].
main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) , Level, _LC)-->
!,
[ ' ~a: discontiguous definition for ~p.' - [Level,Mod:N/A] ].
main_message(error(consistency_error(Who)), Level, _LC) -->
!,
[ ' ~a: has argument ~a not consistent with type.'-[Level,Who] ].
main_message(error(domain_error(Who , Type), _Where), Level, _LC) -->
!,
[ ' ~a: ~q does not belong to domain ~a,' - [Level,Type,Who], nl ].
main_message(error(evaluation_error(What), _Where), Level, _LC) -->
!,
[ ' ~a: ~w during evaluation of arithmetic expressions,' - [Level,What], nl ].
main_message(error(evaluation_error(What, Who), _Where), Level, _LC) -->
!,
[ ' ~a: ~w caused ~a during evaluation of arithmetic expressions,' - [Level,Who,What], nl ].
main_message(error(existence_error(Type , Who), _Where), Level, _LC) -->
!,
[ ' ~a: ~q ~q could not be found,' - [Level,Type, Who], nl ].
main_message(error(permission_error(Op, Type, Id), _Where), Level, _LC) -->
[ ' ~a: ~q is not allowed in ~a ~q,' - [Level, Op, Type,Id], nl ].
main_message(error(instantiation_error, _Where), Level, _LC) -->
[ ' ~a: unbound variable' - [Level], nl ].
main_message(error(representation_error(Type)), Level, _LC) -->
[ ' ~a: ~a representation error ~a' - [Level, Type], nl ].
main_message(error(type_error(Type,Who), _What), Level, _LC) -->
[ ' ~a: ~q should be of type ~a' - [Level,Who,Type]],
[ nl ].
main_message(error(system_error(Who), _What), Level, _LC) -->
[ ' ~a: ~q error' - [Level,Who]],
[ nl ].
main_message(error(uninstantiation_error(T),_), Level, _LC) -->
[ ' ~a: found ~q, expected unbound variable ' - [Level,T], nl ].
display_consulting( F, Level, LC) -->
{ LC > 0,
source_location(F0, L),
F \= F0
}, !,
[ '~a:~d:0: ~a while compiling.'-[F0,L,Level], nl ].
display_consulting(_F, _, _LC) -->
[].
caller( error(_,Term), _) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },
{ lists:memberchk([g|g(Call)], Term) },
!,
['~*|goal was ~q' - [10,Call]],
[nl],
['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) },
!,
['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) },
!,
['~*|goal ~q '-[10,Call]],
[nl].
caller( _, _) -->
[].
c_goal( error(_,Term), Level ) -->
{ lists:memberchk([c|c(File, Line, Func)], Term ) },
!,
['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]],
[nl].
c_goal( _, _Level ) --> [].
prolog_message(X) -->
system_message(X).
system_message(error(Msg,Info)) -->
( { var(Msg) } ; { var(Info)} ), !,
['bad error ~w' - [error(Msg,Info)]].
system_message(error(consistency_error(Who),Where)) -->
[ 'CONSISTENCY ERROR (arguments not compatible with format)- ~w ~w' - [Who,Where] ].
system_message(error(context_error(Goal,Who),Where)) -->
[ 'CONTEXT ERROR- ~w: ~w appeared in ~w' - [Goal,Who,Where] ].
system_message(error(domain_error(DomainType,Opt), Where)) -->
[ 'DOMAIN ERROR- ~w: ' - Where],
domain_error(DomainType, Opt).
system_message(error(format_argument_type(Type,Arg), Where)) -->
[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]].
system_message(error(existence_error(directory,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
system_message(error(existence_error(key,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
system_message(error(existence_error(mutex,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w is an erased mutex' - [Where,Key] ].
system_message(existence_error(prolog_flag,F)) -->
[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
system_message(error(existence_error(prolog_flag,P), Where)) --> !,
[ 'EXISTENCE ERROR- ~w: prolog flag ~w is undefined' - [Where,P] ].
system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ].
system_message(error(existence_error(stream,Stream), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ].
system_message(error(existence_error(thread,Thread), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
system_message(error(existence_error(variable,Var), Where)) -->
[ 'EXISTENCE ERROR- ~w: variable ~w does not exist' - [Where,Var] ].
system_message(error(existence_error(Name,F), W)) -->
{ object_name(Name, ObjName) },
[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].
system_message(error(evaluation_error(int_overflow), Where)) -->
[ 'INTEGER OVERFLOW ERROR- ~w' - [Where] ].
system_message(error(evaluation_error(float_overflow), Where)) -->
[ 'FLOATING POINT OVERFLOW ERROR- ~w' - [Where] ].
system_message(error(evaluation_error(undefined), Where)) -->
[ 'UNDEFINED ARITHMETIC RESULT ERROR- ~w' - [Where] ].
system_message(error(evaluation_error(underflow), Where)) -->
[ 'UNDERFLOW ERROR- ~w' - [Where] ].
system_message(error(evaluation_error(float_underflow), Where)) -->
[ 'FLOATING POINT UNDERFLOW ERROR- ~w' - [Where] ].
system_message(error(evaluation_error(zero_divisor), Where)) -->
[ 'ZERO DIVISOR ERROR- ~w' - [Where] ].
system_message(error(not_implemented(Type, What), Where)) -->
[ '~w: ~w not implemented- ~w' - [Where, Type, What] ].
system_message(error(operating_SYSTEM_ERROR_INTERNAL, Where)) -->
[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
system_message(error(out_of_heap_error, Where)) -->
[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_stack_error, Where)) -->
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_trail_error, Where)) -->
[ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_attvars_error, Where)) -->
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_auxspace_error, Where)) -->
[ 'OUT OF AUXILIARY STACK SPACE ERROR- ~w' - [Where] ].
system_message(error(permission_error(access,private_procedure,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot see clauses for ~w' - [Where,P] ].
system_message(error(permission_error(access,static_procedure,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot access static procedure ~w' - [Where,P] ].
system_message(error(permission_error(alias,new,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ].
system_message(error(permission_error(create,Name,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,Name,P] ].
system_message(error(permission_error(import,M1:I,redefined,SecondMod), Where)) -->
[ 'PERMISSION ERROR- loading ~w: modules ~w and ~w both define ~w' - [Where,M1,SecondMod,I] ].
system_message(error(permission_error(input,binary_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot read from binary stream ~w' - [Where,Stream] ].
system_message(error(permission_error(input,closed_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: trying to read from closed stream ~w' - [Where,Stream] ].
system_message(error(permission_error(input,past_end_of_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: past end of stream ~w' - [Where,Stream] ].
system_message(error(permission_error(input,stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot read from ~w' - [Where,Stream] ].
system_message(error(permission_error(input,text_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot read from text stream ~w' - [Where,Stream] ].
system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
system_message(error(permission_error(modify,flag,W), _)) -->
[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
system_message(error(permission_error(modify,operator,W), Q)) -->
[ 'PERMISSION ERROR- ~w: cannot modify operator ~q' - [Q,W] ].
system_message(error(permission_error(modify,dynamic_procedure,F), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying dynamic procedure ~w' - [Where,F] ].
system_message(error(permission_error(modify,static_procedure,F), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying static procedure ~w' - [Where,F] ].
system_message(error(permission_error(modify,static_procedure_in_use,_), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying a static procedure in use' - [Where] ].
system_message(error(permission_error(modify,table,P), _)) -->
[ 'PERMISSION ERROR- cannot table procedure ~w' - [P] ].
system_message(error(permission_error(module,redefined,Mod), Who)) -->
[ 'PERMISSION ERROR ~w- redefining module ~a in a different file' - [Who,Mod] ].
system_message(error(permission_error(open,source_sink,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot open file ~w' - [Where,Stream] ].
system_message(error(permission_error(output,binary_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot
write to binary stream ~w' - [Where,Stream] ].
system_message(error(permission_error(output,stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot write to ~w' - [Where,Stream] ].
system_message(error(permission_error(output,text_stream,Stream), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot write to text stream ~w' - [Where,Stream] ].
system_message(error(permission_error(resize,array,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot resize array ~w' - [Where,P] ].
system_message(error(permission_error(unlock,mutex,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot unlock mutex ~w' - [Where,P] ].
system_message(error(representation_error(character), Where)) -->
[ 'REPRESENTATION ERROR- ~w: expected character' - [Where] ].
system_message(error(representation_error(character_code), Where)) -->
[ 'REPRESENTATION ERROR- ~w: expected character code' - [Where] ].
system_message(error(representation_error(max_arity), Where)) -->
[ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ].
system_message(error(representation_error(variable), Where)) -->
[ 'REPRESENTATION ERROR- ~w: should be a variable' - [Where] ].
system_message(error(resource_error(code_space), Where)) -->
[ 'RESOURCE ERROR- not enough code space' - [Where] ].
system_message(error(resource_error(huge_int), Where)) -->
[ 'RESOURCE ERROR- too large an integer in absolute value' - [Where] ].
system_message(error(resource_error(memory), Where)) -->
[ 'RESOURCE ERROR- not enough virtual memory' - [Where] ].
system_message(error(resource_error(stack), Where)) -->
[ 'RESOURCE ERROR- not enough stack' - [Where] ].
system_message(error(resource_error(streams), Where)) -->
[ 'RESOURCE ERROR- could not find a free stream' - [Where] ].
system_message(error(resource_error(threads), Where)) -->
[ 'RESOURCE ERROR- too many open threads' - [Where] ].
system_message(error(resource_error(trail), Where)) -->
[ 'RESOURCE ERROR- not enough trail space' - [Where] ].
system_message(error(signal(SIG,_), _)) -->
[ 'UNEXPECTED SIGNAL: ~a' - [SIG] ].
% SWI like I/O error message.
system_message(error(unhandled_exception,Throw)) -->
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
system_message(error(uninstantiation_error(TE), _Where)) -->
[ 'UNINSTANTIATION ERROR - expected unbound term, got ~q' - [TE] ].
system_message(Messg) -->
[ '~q' - Messg ].
domain_error(array_overflow, Opt) --> !,
[ 'invalid static index ~w for array' - Opt ].
domain_error(array_type, Opt) --> !,
[ 'invalid static array type ~w' - Opt ].
domain_error(builtin_procedure, _) --> !,
[ 'non-iso built-in procedure' ].
domain_error(character_code_list, Opt) --> !,
[ 'invalid list of codes ~w' - [Opt] ].
domain_error(close_option, Opt) --> !,
[ 'invalid close option ~w' - [Opt] ].
domain_error(delete_file_option, Opt) --> !,
[ 'invalid list of options ~w' - [Opt] ].
domain_error(encoding, Opt) --> !,
[ 'invalid encoding ~w' - [Opt] ].
domain_error(flag_value, [Opt,Flag]) --> !,
[ 'invalid value ~w for flag ~w' - [Opt,Flag] ].
domain_error(flag_value, Opt) --> !,
[ 'invalid value ~w for flag' - [Opt] ].
domain_error(io_mode, Opt) --> !,
[ 'invalid io mode ~w' - [Opt] ].
domain_error(mutable, Opt) --> !,
[ 'invalid id mutable ~w' - [Opt] ].
domain_error(module_decl_options, Opt) --> !,
[ 'expect module declaration options, found ~w' - [Opt] ].
domain_error(non_empty_list, Opt) --> !,
[ 'found empty list' - [Opt] ].
domain_error(not_less_than_zero, Opt) --> !,
[ 'number ~w less than zero' - [Opt] ].
domain_error(not_newline, Opt) --> !,
[ 'number ~w not newline' - [Opt] ].
domain_error(not_zero, Opt) --> !,
[ '~w is not allowed in the domain' - [Opt] ].
domain_error(operator_priority, Opt) --> !,
[ '~w invalid operator priority' - [Opt] ].
domain_error(operator_specifier, Opt) --> !,
[ 'invalid operator specifier ~w' - [Opt] ].
domain_error(out_of_range, Opt) --> !,
[ 'expression ~w is out of range' - [Opt] ].
domain_error(predicate_spec, Opt) --> !,
[ '~w invalid predicate specifier' - [Opt] ].
domain_error(radix, Opt) --> !,
[ 'invalid radix ~w' - [Opt] ].
domain_error(read_option, Opt) --> !,
[ '~w invalid option to read_term' - [Opt] ].
domain_error(semantics_indicator, Opt) --> !,
[ 'predicate indicator, got ~w' - [Opt] ].
domain_error(shift_count_overflow, Opt) --> !,
[ 'shift count overflow in ~w' - [Opt] ].
domain_error(source_sink, Opt) --> !,
[ '~w is not a source sink term' - [Opt] ].
domain_error(stream, Opt) --> !,
[ '~w is not a stream' - [Opt] ].
domain_error(stream_or_alias, Opt) --> !,
[ '~w is not a stream (or alias)' - [Opt] ].
domain_error(stream_encoding, Opt) --> !,
[ '~w is not a supported stream encoding' - [Opt] ].
domain_error(stream_position, Opt) --> !,
[ '~w is not a stream position' - [Opt] ].
domain_error(stream_property, Opt) --> !,
[ '~w is not a stream property' - [Opt] ].
domain_error(syntax_error_handler, Opt) --> !,
[ '~w is not a syntax error handler' - [Opt] ].
domain_error(table, Opt) --> !,
[ 'non-tabled procedure ~w' - [Opt] ].
domain_error(thread_create_option, Opt) --> !,
[ '~w is not a thread_create option' - [Opt] ].
domain_error(time_out_spec, Opt) --> !,
[ '~w is not valid specificatin for time_out' - [Opt] ].
domain_error(unimplemented_option, Opt) --> !,
[ '~w is not yet implemented' - [Opt] ].
domain_error(write_option, Opt) --> !,
[ '~w invalid write option' - [Opt] ].
domain_error(Domain, Opt) -->
[ '~w not a valid element for ~w' - [Opt,Domain] ].
extra_info( error(_,Extra), _ ) -->
{lists:memberchk([i|Msg], Extra)}, !,
['~*|user provided data is: ~q' - [10,Msg]],
[nl].
extra_info( _, _ ) -->
[].
object_name(array, array).
object_name(atom, atom).
object_name(atomic, atomic).
object_name(byte, byte).
object_name(callable, 'callable goal').
object_name(char, char).
object_name(character_code, 'character code').
object_name(compound, 'compound term').
object_name(db_reference, 'data base reference').
object_name(evaluable, 'evaluable term').
object_name(file, file).
object_name(float, float).
object_name(in_byte, byte).
object_name(in_character, character).
object_name(integer, integer).
object_name(key, 'database key').
object_name(leash_mode, 'leash mode').
object_name(library, library).
object_name(list, list).
object_name(message_queue, 'message queue').
object_name(mutex, mutex).
object_name(number, number).
object_name(operator, operator).
object_name(pointer, pointer).
object_name(predicate_indicator, 'predicate indicator').
object_name(source_sink, file).
object_name(unsigned_byte, 'unsigned byte').
object_name(unsigned_char, 'unsigned char').
object_name(variable, 'unbound variable').
svs([A=VA], [A=VA], S) :- !,
atom_string(A, S).
svs([A=VA,B=VB], [A=VA,B=VB], SN) :- !,
atom_string(A, S),
atom_string(B, S1),
string_concat([S,` and `,S1], SN).
svs([A=_], _, SN) :- !,
atom_string(A, S),
string_concat(`, and `,S, SN).
svs([A=V|L], [A=V|L], SN) :- !,
atom_string(A, S),
svs(L, [A=V|L], S1 ),
string_concat([ S, S1], SN).
svs([A=_V|L], All, SN) :- !,
atom_string(A, S),
svs(L, All, S1 ),
string_concat([`, `, S, S1], SN).
list_of_preds([]) --> [].
list_of_preds([P|L]) -->
['~q' - [P]],
list_of_preds(L).
syntax_error_term(between(_I,_J,_L),LTaL,LC) -->
['term between lines ~d and ~d' - [_I,_L], nl ],
syntax_error_tokens(LTaL, LC).
syntax_error_tokens([], _LC) --> [].
syntax_error_tokens([T|L], LC) -->
syntax_error_token(T, LC),
syntax_error_tokens(L, LC).
syntax_error_token(atom(A), _LC) --> !,
[ '~q' - [A] ].
syntax_error_token(number(N), _LC) --> !,
[ '~w' - [N] ].
syntax_error_token(var(_,S), _LC) --> !,
[ '~a' - [S] ].
syntax_error_token(string(S), _LC) --> !,
[ '`~s`' - [S] ].
syntax_error_token(error, _LC) --> !,
[ ' <== HERE ==> ' ].
syntax_error_token('EOT', _LC) --> !,
[ '.' - [], nl ].
syntax_error_token('(', _LC) --> !,
[ '( '- [] ].
syntax_error_token('{', _LC) --> !,
[ '{ '- [] ].
syntax_error_token('[', _LC) --> !,
[ '[' - [] ].
syntax_error_token(')', _LC) --> !,
[ ' )'- [] ].
syntax_error_token(']', _LC) --> !,
[ ']'- [] ].
syntax_error_token('}', _LC) --> !,
[ ' }' - [] ].
syntax_error_token(',', _LC) --> !,
[ ', ' - [] ].
syntax_error_token('.', _LC) --> !,
[ '.' - [] ].
syntax_error_token(';', _LC) --> !,
[ '; ' - [] ].
syntax_error_token(':', _LC) --> !,
[ ':' - [] ].
syntax_error_token('|', _LC) --> !,
[ '|' - [] ].
syntax_error_token('l', _LC) --> !,
[ '|' - [] ].
syntax_error_token(nl, LC) --> !,
[ '~*| ' -[LC], nl ].
syntax_error_token(B, _LC) --> !,
[ nl, 'bad_token: ~q' - [B], nl ].
print_lines( S, _, Key) -->
[nl, end(Key0)],
{ Key == Key0 },
!,
{ nl(S),
flush_output(S) }.
print_lines( S, _, Key) -->
[flush, end(Key0)],
{ Key == Key0 },
!,
{ flush_output(S) }.
print_lines(S, _, Key) -->
[ end(Key0) ],
{ Key0 == Key }, !,
{ nl(S) }.
print_lines( S, Prefix, Key) -->
[at_same_line],
!,
print_lines( S, Prefix, Key).
print_lines( S, Prefixes, Key) -->
[nl],
!,
{ nl(S),
Prefixes = [PrefixS - Cmds|More],
format(S, PrefixS, Cmds)
},
{
More == []
->
NPrefixes = Prefixes
;
NPrefixes = More
},
print_lines( S, NPrefixes, Key).
print_lines( S, Prefixes, Key) -->
[flush],
!,
{ flush_output(S) },
print_lines( S, Prefixes, Key ).
print_lines(S, Prefixes, Key) -->
[end(_OtherKey)],
!,
print_lines( S, Prefixes, Key ).
% consider this a message within the message
print_lines(S, Prefixes, Key) -->
[begin(Severity, OtherKey)],
!,
{ prefix( Severity, P ) },
print_message_lines(S, [P], OtherKey),
print_lines( S, Prefixes, Key ).
print_lines(S, Prefixes, Key) -->
[prefix(Fmt-Args)],
!,
print_lines( S, [Fmt-Args|Prefixes], Key ).
print_lines(S, Prefixes, Key) -->
[prefix(Fmt)],
{ atom( Fmt ) ; string( Fmt ) },
!,
print_lines( S, [Fmt-[]|Prefixes], Key ).
print_lines(S, Prefixes, Key) -->
[Fmt-Args],
!,
{ format(S, Fmt, Args) },
print_lines( S, Prefixes, Key ).
print_lines(S, Prefixes, Key) -->
[format(Fmt,Args)],
!,
{ format(S, Fmt, Args) },
print_lines( S, Prefixes, Key ).
% deprecated....
print_lines(S, Prefixes, Key) -->
[ Fmt ],
{ atom(Fmt) ; string( Fmt ) },
!,
{ format(S, Fmt, []) },
print_lines(S, Prefixes, Key).
print_lines(S, _Prefixes, _Key) -->
[ Msg ],
{ format(S, 'Illegal message Component: ~q !!!.~n', [Msg]) }.
prefix(help, '~N'-[]).
prefix(query, '~N'-[]).
prefix(debug, '~N'-[]).
prefix(warning, '~N'-[]).
/* { thread_self(Id) },
( { Id == main }
-> [ 'warning, ' - [] ]
; { atom(Id) }
-> ['warning [Thread ~a ], ' - [Id] ]
; ['warning [Thread ~d ], ' - [Id] ]
).
*/
prefix(error, '~N'-[]).
/*
{ thread_self(Id) },
( { Id == main }
-> [ 'error ' ]
; { thread_main_name(Id) }
-> [ 'error [ Thread ~w ] ' - [Id] ]
),
!.
prefix(error, '', user_error) -->
{ thread_self(Id) },
( { Id == main }
-> [ 'error ' - [], nl ]
; { atom(Id) }
-> [ 'error [ Thread ~a ] ' - [Id], nl ]
; [ 'error [ Thread ~d ] ' - [Id], nl ]
).
*/
prefix(banner, '~N'-[]).
prefix(informational, '~N~*|% '-[LC]) :-
'$show_consult_level'(LC).
prefix(debug(_), '~N% '-[]).
prefix(information, '~N% '-[]).
clause_to_indicator(T, MNameArity) :-
strip_module(T, M0, T1),
pred_arity( T1, M0, MNameArity ).
pred_arity(V, M, M:call/1) :- var(V), !.
pred_arity((:- _Path), _M, prolog:(:-)/1 ) :- !.
pred_arity((?- _Path), _M, prolog:(?)/1 ) :- !.
pred_arity((H:-_),M, MNameArity) :-
nonvar(H),
!,
strip_module(M:H, M1, H1),
pred_arity( H1, M1, MNameArity).
pred_arity((H-->_), M, M2:Name//Arity) :-
nonvar(H),
!,
strip_module(M:H, M1, H1),
pred_arity( H1, M1, M2:Name/Arity).
% special for a, [x] --> b, [y].
pred_arity((H,_), M, MNameArity) :-
nonvar(H),
!,
strip_module(M:H, M1, H1),
pred_arity( H1, M1, MNameArity).
pred_arity(Name/Arity, M, M:Name/Arity) :-
!.
pred_arity(Name//Arity, M, M:Name//Arity) :-
!.
pred_arity(H,M, M:Name/Arity) :-
functor(H,Name,Arity).
translate_message(Term, Level) -->
compose_message(Term, Level), !.
translate_message(Term, _) -->
{ Term = error(_, _) },
[ 'Unknown exception: ~p'-[Term] ].
translate_message(Term, _) -->
[ 'Unknown message: ~p'-[Term] ].
% print_message_lines(+Stream, +Prefix, +Lines)
%
% Quintus/SICStus/SWI compatibility predicate to print message lines
% using a prefix.
/** @pred print_message_lines(+ _Stream_, + _Prefix_, + _Lines_)
Print a message (see print_message/2) that has been translated to
a list of message elements. The elements of this list are:
+ _Format_-_Args_
Where _Format_ is an atom and _Args_ is a list
of format argument. Handed to `format/3`.
+ `flush`
If this appears as the last element, _Stream_ is flushed
(see `flush_output/1`) and no final newline is generated.
+ `at_same_line`
If this appears as first element, no prefix is printed for
the line and the line-position is not forced to 0
(see `format/1`, `~N`).
+ `prefix`(Prefix)
define a prefix for the next line, say `''` will be seen as an
empty prefix.
(see `format/1`, `~N`).
+ `<Format>`
Handed to `format/3` as `format(Stream, Format, [])`, may get confused
with other commands.
+ nl
A new line is started and if the message is not complete
the _Prefix_ is printed too.
*/
prolog:print_message_lines(S, Prefix0, Lines) :-
Lines = [begin(_, Key)|Msg],
(
atom(Prefix0)
->
Prefix = Prefix0-[]
;
string(Prefix0)
->
Prefix = Prefix0-[]
;
Prefix = Prefix0
),
(Msg = [at_same_line|Msg1]
->
print_lines(S, [Prefix], Key, Msg1, [])
;
print_lines(S, [Prefix], Key, [Prefix|Msg], [])
).
/** @pred prolog:print_message(+ Severity, +Term)
The predicate print_message/2 is used to print messages, notably from
exceptions, in a human-readable format. _Kind_ is one of
`informational`, `banner`, `warning`, `error`, `help` or `silent`. In YAP, the message is always outut to the stream user_error.
If the Prolog flag verbose is `silent`, messages with
_Kind_ `informational`, or `banner` are treated as
silent. See `-q` in [Running_YAP_Interactively].
This predicate first translates the _Term_ into a list of `message
lines` (see print_message_lines/3 for details). Next it will
call the hook message_hook/3 to allow the user intercepting the
message. If message_hook/3 fails it will print the message unless
_Kind_ is silent.
If you need to report errors from your own predicates, we advise you to
stick to the existing error terms if you can; but should you need to
invent new ones, you can define corresponding error messages by
asserting clauses for `prolog:message/2`. You will need to declare
the predicate as multifile.
Note: errors in the implementation of print_message/2 are very
confusing to YAP (who will process the error?). So we write this small
stub to ensure everything os ok
*/
prolog:print_message(Severity, Msg) :-
(
var(Severity)
->
!,
format(user_error, 'malformed message ~q: message level is unbound~n', [Msg])
;
var(Msg)
->
!,
format(user_error, 'uninstantiated message~n', [])
;
Severity == silent
->
true
;
'$pred_exists'(portray_message(_,_),user),
user:portray_message(Severity, Msg)
),
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose_load, silent),
stream_property(_Stream, alias(loop_stream) ),
Level = informational,
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose, silent),
Level \= error,
Level \= warning,
!.
prolog:print_message(_, _Msg) :-
% first step at hook processing
'$nb_getval'('$if_skip_mode',skip,fail),
!.
prolog:print_message(force(_Severity), Msg) :- !,
print(user_error,Msg).
% This predicate has more hooks than a pirate ship!
prolog:print_message(Severity, Term) :-
prolog:message( Term,Lines0, [ end(Id)]),
Lines = [begin(Severity, Id)| Lines0],
(
user:message_hook(Term, Severity, Lines)
->
true
;
prefix( Severity, Prefix ),
prolog:print_message_lines(user_error, Prefix, Lines)
),
!.
prolog:print_message(Severity, Term) :-
translate_message( Term, Severity, Lines0, [ end(Id)]),
Lines = [begin(Severity, Id)| Lines0],
(
user:message_hook(Term, Severity, Lines)
->
true
;
prefix( Severity, Prefix ),
prolog:print_message_lines(user_error, Prefix, Lines)
),
!.
prolog:print_message(Severity, _Term) :-
format('No handler for ~a message ~q,~n',[Severity, _Term]).
/**
@}
*/

582
packages/python/swig/yap4py/prolog/pl/meta.yap
View File

@ -1,582 +0,0 @@
/**
@defgroup YAPMetaPredicates Using Meta-Calls with Modules
@ingroup YAPModules
@{
@pred meta_predicate(_G1_,...., _Gn) is directive
Declares that this predicate manipulates references to predicates.
Each _Gi_ is a mode specification.
If the argument is `:`, it does not refer directly to a predicate
but must be module expanded. If the argument is an integer, the argument
is a goal or a closure and must be expanded. Otherwise, the argument is
not expanded. Note that the system already includes declarations for all
built-ins.
For example, the declaration for call/1 and setof/3 are:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:- meta_predicate call(0), setof(?,0,?).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
meta_predicate declaration
implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
*/
% directive now meta_predicate Ps :- $meta_predicate(Ps).
:- dynamic prolog:'$meta_predicate'/4.
:- multifile prolog:'$meta_predicate'/4,
'$inline'/2,
'$full_clause_optimisation'/4.
'$meta_predicate'(M:P) :-
var(P),
'$do_error'(instantiation_error,meta_predicate(M:P)).
'$meta_predicate'(M:P) :-
var(M),
'$do_error'(instantiation_error,meta_predicate(M:P)).
'$meta_predicate'(M:(P,Ps)) :- !,
'$meta_predicate'(M:P),
'$meta_predicate'(M:Ps).
'$meta_predicate'( M:D ) :-
'$yap_strip_module'( M:D, M1, P),
'$install_meta_predicate'(M1:P).
'$install_meta_predicate'(M1:P) :-
functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M),
( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
asserta(prolog:'$meta_predicate'(F,M,N,P)),
'$predicate_flags'(P, M1, Fl, Fl),
NFlags is Fl \/ 0x200000,
'$predicate_flags'(P, M1, Fl, NFlags).
% comma has its own problems.
:- '$install_meta_predicate'(prolog:','(0,0)).
%% handle module transparent predicates by defining a
%% new context module.
'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
'$yap_strip_module'(HM:H, M, NH),
'$module_transparent'(_, M, _, NH), !.
'$is_mt'(_H, B, _HM, _SM, BM, B, BM).
% I assume the clause has been processed, so the
% var case is long gone! Yes :)
'$clean_cuts'(G,('$current_choicepoint'(DCP),NG)) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,G).
'$clean_cuts'(G,DCP,NG) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,_,G).
'$conj_has_cuts'(V,_,V, _) :- var(V), !.
'$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !.
'$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !,
'$conj_has_cuts'(G1, DCP, NG1, OK),
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !,
'$conj_has_cuts'(G1, DCP, NG1, OK),
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK).
'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !,
% G1: the system must have done it already
'$conj_has_cuts'(G2, DCP, NG2, OK),
'$conj_has_cuts'(G3, DCP, NG3, OK).
'$conj_has_cuts'(G,_,G, _).
% return list of vars in expanded positions on the head of a clause.
%
% these variables should not be expanded by meta-calls in the body of the goal.
%
% should be defined before caller.
%
'$module_u_vars'(M, H, UVars) :-
'$do_module_u_vars'(M:H,UVars).
'$do_module_u_vars'(M:H,UVars) :-
functor(H,F,N),
'$meta_predicate'(F,M,N,D), !,
'$do_module_u_vars'(N,D,H,UVars).
'$do_module_u_vars'(_,[]).
'$do_module_u_vars'(0,_,_,[]) :- !.
'$do_module_u_vars'(I,D,H,LF) :-
arg(I,D,X), ( X=':' -> true ; integer(X)),
arg(I,H,A), '$uvar'(A, LF, L), !,
I1 is I-1,
'$do_module_u_vars'(I1,D,H,L).
'$do_module_u_vars'(I,D,H,L) :-
I1 is I-1,
'$do_module_u_vars'(I1,D,H,L).
'$uvar'(Y, [Y|L], L) :- var(Y), !.
% support all/3
'$uvar'(same( G, _), LF, L) :-
'$uvar'(G, LF, L).
'$uvar'('^'( _, G), LF, L) :-
'$uvar'(G, LF, L).
/**
* @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_)
*
* expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore
*
* @return
*/
'$meta_expand'(G, _, CM, HVars, OG) :-
var(G),
!,
(
lists:identical_member(G, HVars)
->
OG = G
;
OG = CM:G
).
% nothing I can do here:
'$meta_expand'(G0, PredDef, CM, HVars, NG) :-
G0 =.. [Name|GArgs],
PredDef =.. [Name|GDefs],
functor(PredDef, Name, Arity ),
length(NGArgs, Arity),
NG =.. [Name|NGArgs],
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
'$expand_args'([], _, [], _, []).
'$expand_args'([A|GArgs], CM, [M|GDefs], HVars, [NA|NGArgs]) :-
( M == ':' -> true ; number(M) ),
!,
'$expand_arg'(A, CM, HVars, NA),
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
'$expand_args'([A|GArgs], CM, [_|GDefs], HVars, [A|NGArgs]) :-
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
% check if an argument should be expanded
'$expand_arg'(G, CM, HVars, OG) :-
var(G),
!,
( lists:identical_member(G, HVars) -> OG = G; OG = CM:G).
'$expand_arg'(G, CM, _HVars, NCM:NG) :-
'$yap_strip_module'(CM:G, NCM, NG).
% expand module names in a body
% args are:
% goals to expand
% code to pass to listing
% code to pass to compiler
% head module HM
% source module SM
% current module for looking up preds M
%
% to understand the differences, you can consider:
%
% a:(d:b(X)) :- g:c(X), d(X), user:hello(X)).
%
% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
%
% d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
%
% on the other hand,
%
% a:(d:b(X) :- c(X), d(X), d:e(X)).
%
% will give
%
% d:b(X) :- a:c(a:X), a:d(X), e(X).
%
%
% head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les.
% goals or arguments/sub-arguments?
% I cannot use call here because of format/3
% modules:
% A4: module for body of clause (this is the one used in looking up predicates)
% A5: context module (this is the current context
% A6: head module (this is the one used in compiling and accessing).
%
%
%'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):- writeln(V), fail.
'$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :-
var(V),
!,
( lists:identical_member(V, HVars)
->
'$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
;
( atom(BM)
->
NG = call(BM:V),
NGO = '$execute_in_mod'(V,BM)
;
'$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
)
).
'$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :-
'$yap_strip_module'( BM:V, CM, G),
nonvar(CM),
!,
'$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH).
'$expand_goals'(CM0:V,NG,NGO,HM,SM,BM,HVarsH) :-
strip_module( CM0:V, CM, G),
!,
'$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH).
% if I don't know what the module is, I cannot do anything to the goal,
% so I just put a call for later on.
'$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :-
var(BM),
!,
NG = call(BM:V),
NGO = '$execute_wo_mod'(V,BM).
'$expand_goals'(depth_bound_call(G,D),
depth_bound_call(G1,D),
('$set_depth_limit_for_next_call'(D),GO),
HM,SM,BM,HVars) :-
'$expand_goals'(G,G1,GO,HM,SM,BM,HVars),
'$composed_built_in'(GO), !.
'$expand_goals'((A,B),(A1,B1),(AO,BO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- var(A), !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A*->B;C),(A1*->B1;C1),
(
yap_hacks:current_choicepoint(DCP),
AO,
yap_hacks:cut_at(DCP),BO
;
CO
),
HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
'$clean_cuts'(AOO, AO),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$expand_goals'(C,C1,CO,HM,SM,BM,HVars).
'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A|B),(A1|B1),(AO|BO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A->B),(A1->B1),(AO->BO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
'$clean_cuts'(AOO, AO),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
nonvar(G),
G = (A = B),
!.
'$expand_goals'(\+A,\+A1,('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> false;true),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
'$expand_goals'(once(A),once(A1),
('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$clean_cuts'(AO0, CP, AO).
'$expand_goals'(ignore(A),ignore(A1),
('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> true ; true),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_goals'(forall(A,B),forall(A1,B1),
((AO, ( BO-> false ; true)) -> false ; true),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_goals'(not(A),not(A1),('$current_choice_point'(CP),AO,'$$cut_by'(CP) -> fail; true),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
'$expand_goals'(if(A,B,C),if(A1,B1,C1),
('$current_choicepoint'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_goals'((A*->B;C),(A1*->B1;C1),
('$current_choicepoint'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_goals'((A*->B),(A1*->B1),
('$current_choicepoint'(DCP),AO,BO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_goals'(true,true,true,_,_,_,_) :- !.
'$expand_goals'(fail,fail,fail,_,_,_,_) :- !.
'$expand_goals'(false,false,false,_,_,_,_) :- !.
'$expand_goals'(G, G1, GO, HM, SM, BM, HVars) :-
'$yap_strip_module'(BM:G, NBM, GM),
'$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars).
'$import_expansion'(M:G, M1:G1) :-
'$imported_predicate'(G, M, G1, M1),
!.
'$import_expansion'(MG, MG).
'$meta_expansion'(GMG, BM, HVars, GM:GF) :-
'$yap_strip_module'(GMG, GM, G ),
functor(G, F, Arity ),
'$meta_predicate'(F, GM, Arity, PredDef),
!,
'$meta_expand'(G, PredDef, BM, HVars, GF).
'$meta_expansion'(GMG, _BM, _HVars, GM:G) :-
'$yap_strip_module'(GMG, GM, G ).
/**
* @brief Perform meta-variable and user expansion on a goal _G_
*
* given the example
~~~~~
:- module(m, []).
o:p(B) :- n:g, X is 2+3, call(B).
~~~~~
*
* @param G input goal, without module quantification.
* @param G1F output, non-optimised for debugging
* @param GOF output, optimised, ie, `n:g`, `prolog:(X is 2+3)`, `call(m:B)`, where `prolog` does not need to be explicit
* @param GOF output, optimised, `n:g`, `prolog:(X=5)`, `call(m:B)`
* @param HM head module, input, o
* @param HM source module, input, m
* @param M current module, input, `n`, `m`, `m`
* @param HVars-H, list of meta-variables and initial head, `[]` and `p(B)`
*
*
*/
'$expand_goal'(G0, G1F, GOF, HM, SM, BM, HVars-H) :-
'$yap_strip_module'( BM:G0, M0N, G0N),
'$user_expansion'(M0N:G0N, M1:G1),
'$import_expansion'(M1:G1, M2:G2),
'$meta_expansion'(M2:G2, M1, HVars, M2:B1F),
'$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M2, H).
'$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :-
'$match_mod'(G, HM, SM, BM, G1F),
'$c_built_in'(G1F, BM, H, GO),
'$yap_strip_module'(BM:GO, MO, IGO),
'$match_mod'(IGO, HM, SM, MO, GOF).
'$user_expansion'(M0N:G0N, M1:G1) :-
'_user_expand_goal'(M0N:G0N, M:G),
!,
( M:G == M0N:G0N
->
M1:G1 = M:G
;
'$user_expansion'(M:G, M1:G1)
).
'$user_expansion'(MG, MG).
'$match_mod'(G, HMod, SMod, M, O) :-
(
% \+ '$is_multifile'(G1,M),
%->
'$is_system_predicate'(G,prolog)
->
O = G
;
M == HMod, M == SMod
->
O = G
;
O = M:G
).
'$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !.
'$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !.
'$build_up'(HM, NH, SM, B1, (NH :- B1), BO, ( NH :- BO)) :- HM == SM, !.
'$build_up'(HM, NH, _SM, B1, (NH :- B1), BO, ( HM:NH :- BO)) :- !.
'$expand_clause_body'(V, _NH1, _HM1, _SM, M, call(M:V), call(M:V) ) :-
var(V), !.
'$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !.
'$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :-
'$module_u_vars'(HM , H, UVars), % collect head variables in
% expanded positions
% support for SWI's meta primitive.
'$is_mt'(H, B, HM, SM, M, IB, BM),
'$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H),
(
'$full_clause_optimisation'(H, BM, BO1, BO)
->
true
;
BO = BO1
).
%
% check if current module redefines an imported predicate.
% and remove import.
%
'$not_imported'(H, Mod) :-
recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
NM \= Mod,
functor(NH,N,Ar),
print_message(warning,redefine_imported(Mod,NM,N/Ar)),
erase(R),
fail.
'$not_imported'(_, _).
'$verify_import'(_M:G, prolog:G) :-
'$is_system_predicate'(G, prolog).
'$verify_import'(M:G, NM:NG) :-
'$get_undefined_pred'(G, M, NG, NM),
!.
'$verify_import'(MG, MG).
% expand arguments of a meta-predicate
% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
% expand module names in a clause (interface predicate).
% A1: Input Clause
% A2: Output Class to Compiler (lives in module HM)
% A3: Output Class to clause/2 and listing (lives in module HM)
%
% modules:
% A6: head module (this is the one used in compiling and accessing).
% A5: context module (this is the current context
% A4: module for body of clause (this is the one used in looking up predicates)
%
% has to be last!!!
'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
'$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module.
'$head_and_body'(HB, H, B), % HB is H :- B.
'$yap_strip_module'(SM:H, HM, NH), % further module expansion
'$not_imported'(NH, HM),
'$yap_strip_module'(SM:B, BM, B0), % further module expansion
'$expand_clause_body'(B0, NH, HM, SM0, BM, B1, BO),
'$build_up'(HM, NH, SM0, B1, Cl1, BO, ClO).
expand_goal(Input, Output) :-
'$expand_meta_call'(Input, [], Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF).
:- '$meta_predicate'(prolog:(
abolish(:),
abolish(:,+),
all(?,0,-),
assert(:),
assert(:,+),
assert_static(:),
asserta(:),
asserta(:,+),
asserta_static(:),
assertz(:),
assertz(:,+),
assertz_static(:),
at_halt(0),
bagof(?,0,-),
bb_get(:,-),
bb_put(:,+),
bb_delete(:,?),
bb_update(:,?,?),
call(0),
call(1,?),
call(2,?,?),
call(3,?,?,?),
call_with_args(0),
call_with_args(1,?),
call_with_args(2,?,?),
call_with_args(3,?,?,?),
call_with_args(4,?,?,?,?),
call_with_args(5,?,?,?,?,?),
call_with_args(6,?,?,?,?,?,?),
call_with_args(7,?,?,?,?,?,?,?),
call_with_args(8,?,?,?,?,?,?,?,?),
call_with_args(9,?,?,?,?,?,?,?,?,?),
call_cleanup(0,0),
call_cleanup(0,?,0),
call_residue(0,?),
call_residue_vars(0,?),
call_shared_object_function(:,+),
catch(0,?,0),
clause(:,?),
clause(:,?,?),
compile(:),
consult(:),
current_predicate(:),
current_predicate(?,:),
db_files(:),
depth_bound_call(0,+),
discontiguous(:),
ensure_loaded(:),
exo_files(:),
findall(?,0,-),
findall(?,0,-,?),
forall(0,0),
format(+,:),
format(+,+,:),
freeze(?,0),
hide_predicate(:),
if(0,0,0),
ignore(0),
incore(0),
multifile(:),
nospy(:),
not(0),
notrace(0),
once(0),
phrase(2,?),
phrase(2,?,+),
predicate_property(:,?),
predicate_statistics(:,-,-,-),
on_exception(+,0,0),
qsave_program(+,:),
reconsult(:),
retract(:),
retract(:,?),
retractall(:),
reconsult(:),
setof(?,0,-),
setup_call_cleanup(0,0,0),
setup_call_catcher_cleanup(0,0,?,0),
spy(:),
stash_predicate(:),
use_module(:),
use_module(:,?),
use_module(?,:,?),
when(+,0),
with_mutex(+,0),
with_output_to(?,0),
'->'(0 , 0),
'*->'(0 , 0),
';'(0 , 0),
% ','(0 , 0),
^(+,0),
{}(0,?,?),
','(2,2,?,?),
;(2,2,?,?),
'|'(2,2,?,?),
->(2,2,?,?),
\+(2,?,?),
\+( 0 )
)).

785
packages/python/swig/yap4py/prolog/pl/modules.yap
View File

@ -1,785 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: modules.pl *
* Last rev: *
* mods: *
* comments: module support *
* *
*************************************************************************/
/**
@file modules.yap
**/
:- system_module( '$_modules', [abolish_module/1,
add_import_module/3,
current_module/1,
current_module/2,
delete_import_module/2,
expand_goal/2,
export/1,
export_list/2,
export_resource/1,
import_module/2,
ls_imports/0,
module/1,
module_property/2,
set_base_module/1,
source_module/1,
use_module/1,
use_module/2,
use_module/3], ['$add_to_imports'/3,
'$clean_cuts'/2,
'$convert_for_export'/7,
'$do_import'/3,
'$extend_exports'/3,
'$get_undefined_pred'/4,
'$imported_predicate'/4,
'$meta_expand'/6,
'$meta_predicate'/2,
'$meta_predicate'/4,
'$module'/3,
'$module'/4,
'$module_expansion'/6,
'$module_transparent'/2,
'$module_transparent'/4]).
:- use_system_module( '$_arith', ['$c_built_in'/3]).
:- use_system_module( '$_consult', ['$lf_opt'/3,
'$load_files'/3]).
:- use_system_module( '$_debug', ['$skipeol'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_eval', ['$full_clause_optimisation'/4]).
:- multifile '$system_module'/1.
:- '$purge_clauses'(module(_,_), prolog).
:- '$purge_clauses'('$module'(_,_), prolog).
:- '$purge_clauses'(use_module(_), prolog).
:- '$purge_clauses'(use_module(_,_), prolog).
%
% start using default definition of module.
%
/**
\pred use_module( +Files ) is directive
@load a module file
This predicate loads the file specified by _Files_, importing all
their public predicates into the current type-in module. It is
implemented as if by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
use_module(F) :-
load_files(F, [if(not_loaded),must_be_module(true)]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Notice that _Files_ may be a single file, or a list with a number
files. The _Files_ are loaded in YAP only once, even if they have been
updated meanwhile. YAP should also verify whether the files actually
define modules. Please consult load_files/3 for other options when
loading a file.
Predicate name clashes between two different modules may arise, either
when trying to import predicates that are also defined in the current
type-in module, or by trying to import the same predicate from two
different modules.
In the first case, the local predicate is considered to have priority
and use_module/1 simply gives a warning. As an example, if the file
`a.pl` contains:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- module( a, [a/1] ).
:- use_module(b).
a(1).
a(X) :- b(X).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
and the file `b.pl` contains:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- module( b, [a/1,b/1] ).
a(2).
b(1).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
YAP will execute as follows:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
?- [a].
% consulting .../a.pl...
% consulting .../b.pl...
% consulted .../b.pl in module b, 0 msec 0 bytes
% consulted .../a.pl in module a, 1 msec 0 bytes
true.
?- a(X).
X = 1 ? ;
X = 1.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The example shows that the query `a(X)`has a single answer, the one
defined in `a.pl`. Calls to `a(X)`succeed in the top-level, because
the module `a` was loaded into `user`. On the other hand, `b(X)`is not
exported by `a.pl`, and is not available to calls, although it can be
accessed as a predicate in the module 'a' by using the `:` operator.
Next, consider the three files `c.pl`, `d1.pl`, and `d2.pl`:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
% c.pl
:- module( c, [a/1] ).
:- use_module([d1, d2]).
a(X) :-
b(X).
a(X) :-
c(X).
a(X) :-
d(X).
% d1.pl
:- module( d1, [b/1,c/1] ).
vvb(2).
c(3).
% d2.pl
:- module( d2, [b/1,d/1] ).
b(1).
d(4).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The result is as follows:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
./yap -l c
YAP 6.3.4 (x86_64-darwin13.3.0): Tue Jul 15 10:42:11 CDT 2014
ERROR!!
at line 3 in o/d2.pl,
PERMISSION ERROR- loading .../c.pl: modules d1 and d2 both define b/1
?- a(X).
X = 2 ? ;
ERROR!!
EXISTENCE ERROR- procedure c/1 is undefined, called from context prolog:$user_call/2
Goal was c:c(_131290)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The state of the module system after this error is undefined.
**/
use_module(F) :- '$load_files'(F,
[if(not_loaded),must_be_module(true)], use_module(F)).
/**
\pred use_module(+Files, +Imports)
loads a module file but only imports the named predicates
This predicate loads the file specified by _Files_, importing their
public predicates specified by _Imports_ into the current type-in
module. It is implemented as if by:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
use_module(Files, Imports) :-
load_files(Files, [if(not_loaded),must_be_module(true),imports(Imports)]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The _Imports_ argument may be use to specify which predicates one
wants to load. It can also be used to give the predicates a different name. As an example,
the graphs library is implemented on top of the red-black trees library, and some predicates are just aliases:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
:- use_module(library(rbtrees), [
rb_min/3 as min_assoc,
rb_max/3 as max_assoc,
...]).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unfortunately it is still not possible to change argument order.
**/
use_module(F,Is) :-
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
'$module'(O,N,P,Opts) :- !,
'$module'(O,N,P),
'$process_module_decls_options'(Opts,module(Opts,N,P)).
'$process_module_decls_options'(Var,Mod) :-
var(Var), !,
'$do_error'(instantiation_error,Mod).
'$process_module_decls_options'([],_) :- !.
'$process_module_decls_options'([H|L],M) :- !,
'$process_module_decls_option'(H,M),
'$process_module_decls_options'(L,M).
'$process_module_decls_options'(T,M) :-
'$do_error'(type_error(list,T),M).
'$process_module_decls_option'(Var,M) :-
var(Var),
'$do_error'(instantiation_error,M).
'$process_module_decls_option'(At,M) :-
atom(At), !,
use_module(M:At).
'$process_module_decls_option'(library(L),M) :- !,
use_module(M:library(L)).
'$process_module_decls_option'(hidden(Bool),M) :- !,
'$process_hidden_module'(Bool, M).
'$process_module_decls_option'(Opt,M) :-
'$do_error'(domain_error(module_decl_options,Opt),M).
'$process_hidden_module'(TNew,M) :-
'$convert_true_off_mod3'(TNew, New, M),
source_mode(Old, New),
'$prepare_restore_hidden'(Old,New).
'$convert_true_off_mod3'(true, off, _) :- !.
'$convert_true_off_mod3'(false, on, _) :- !.
'$convert_true_off_mod3'(X, _, M) :-
'$do_error'(domain_error(module_decl_options,hidden(X)),M).
'$prepare_restore_hidden'(Old,Old) :- !.
'$prepare_restore_hidden'(Old,New) :-
recorda('$system_initialization', source_mode(New,Old), _).
'$extend_exports'(HostF, Exports, DonorF ) :-
( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ),
( recorded('$module','$module'( HostF, HostM, SourceF, _, _),_) -> true ; HostF = user_input ),
recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
'$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
lists:append( AllReExports, AllExports, Everything0 ),
sort( Everything0, Everything ),
( source_location(_, Line) -> true ; Line = 0 ),
recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_).
'$module_produced by'(M, M0, N, K) :-
recorded('$import','$import'(M,M0,_,_,N,K),_), !.
'$module_produced by'(M, M0, N, K) :-
recorded('$import','$import'(MI,M0,G1,_,N,K),_),
functor(G1, N1, K1),
'$module_produced by'(M,MI,N1,K1).
/** @pred current_module( ? Mod:atom) is nondet
Succeeds if _M_ is a user-visible modules. A module is defined as soon as some
predicate defined in the module is loaded, as soon as a goal in the
module is called, or as soon as it becomes the current type-in module.
*/
current_module(Mod) :-
'$all_current_modules'(Mod),
\+ '$hidden_atom'(Mod).
/** @pred current_module( ? Mod:atom, ? _F_ : file ) is nondet
Succeeds if _M_ is a module associated with the file _F_, that is, if _File_ is the source for _M_. If _M_ is not declared in a file, _F_ unifies with `user`.
*/
current_module(Mod,TFN) :-
( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ).
system_module(Mod) :-
( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
'$is_system_module'(Mod).
'$trace_module'(X) :-
telling(F),
tell('P0:debug'),
write(X),nl,
tell(F), fail.
'$trace_module'(_).
'$trace_module'(X,Y) :- X==Y, !.
'$trace_module'(X,Y) :-
telling(F),
tell('~/.dbg.modules'),
write('***************'), nl,
portray_clause(X),
portray_clause(Y),
tell(F),fail.
'$trace_module'(_,_).
'$continue_imported'(Mod,Mod,Pred,Pred) :-
'$pred_exists'(Pred, Mod),
!.
'$continue_imported'(FM,Mod,FPred,Pred) :-
recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_),
'$continue_imported'(FM, IM, FPred, IPred), !.
'$continue_imported'(FM,Mod,FPred,Pred) :-
prolog:'$parent_module'(Mod,IM),
'$continue_imported'(FM, IM, FPred, Pred).
% be careful here not to generate an undefined exception.
'$imported_predicate'(G, _ImportingMod, G, prolog) :-
nonvar(G), '$is_system_predicate'(G, prolog), !.
'$imported_predicate'(G, ImportingMod, G0, ExportingMod) :-
( var(G) -> true ;
var(ImportingMod) -> true ;
'$undefined'(G, ImportingMod)
),
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
ExportingMod \= ImportingMod,
!.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I),
!.
% SWI builtin
'$get_undefined_pred'(G, _ImportingMod, G, user) :-
nonvar(G),
'$pred_exists'(G, user), !.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
prolog_flag(autoload, true),
prolog_flag(unknown, OldUnk, fail),
(
'$autoload'(G, ImportingMod, ExportingModI, swi)
->
prolog_flag(unknown, _, OldUnk)
;
prolog_flag(unknown, _, OldUnk),
fail
),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% autoload
% parent module mechanism
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
'$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
'$autoload'(G, _ImportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
'$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect),
call(Dialect:index(Name,Arity,ExportingMod,_)),
!.
'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :-
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 ).
'$autoloader_find_predicate'(G,ExportingModI) :-
'$nb_getval'('$autoloader_set', true, false), !,
autoloader:find_predicate(G,ExportingModI).
'$autoloader_find_predicate'(G,ExportingModI) :-
yap_flag(autoload, true, false),
yap_flag( unknown, Unknown, fail),
yap_flag(debug, Debug, false), !,
load_files([library(autoloader),
autoloader:library('INDEX'),
swi:library('dialect/swi/INDEX')],
[autoload(true),if(not_loaded)]),
nb_setval('$autoloader_set', true),
yap_flag(autoload, _, true),
yap_flag( unknown, _, Unknown),
yap_flag( debug, _, Debug),
autoloader:find_predicate(G,ExportingModI).
/**
be associated to a new file.
\param[in] _Module_ is the name of the module to declare
\param[in] _MSuper_ is the name of the context module. Use `prolog`or `system`
if you do not need a context.
\param[in] _File_ is the canonical name of the file from which the module is loaded
\param[in] Line is the line-number of the :- module/2 directive.
\param[in] If _Redefine_ `true`, allow associating the module to a new file
*/
'$declare_module'(Name, _Super, Context, _File, _Line) :-
add_import_module(Name, Context, start).
/**
\pred abolish_module( + Mod) is det
get rid of a module and of all predicates included in the module.
*/
abolish_module(Mod) :-
recorded('$module','$module'(_,Mod,_,_,_),R), erase(R),
fail.
abolish_module(Mod) :-
recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
fail.
abolish_module(Mod) :-
'$current_predicate'(Na,Mod,S,_),
functor(S, Na, Ar),
abolish(Mod:Na/Ar),
fail.
abolish_module(_).
export(Resource) :-
var(Resource),
'$do_error'(instantiation_error,export(Resource)).
export([]) :- !.
export([Resource| Resources]) :- !,
export_resource(Resource),
export(Resources).
export(Resource) :-
export_resource(Resource).
export_resource(Resource) :-
var(Resource), !,
'$do_error'(instantiation_error,export(Resource)).
export_resource(P) :-
P = F/N, atom(F), number(N), N >= 0, !,
'$current_module'(Mod),
( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
erase(R),
recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line),_)
; prolog_load_context(file, File) ->
recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
).
export_resource(P0) :-
P0 = F//N, atom(F), number(N), N >= 0, !,
N1 is N+2, P = F/N1,
'$current_module'(Mod),
( recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
erase(R),
recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line ),_)
; prolog_load_context(file, File) ->
recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
; recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
).
export_resource(op(Prio,Assoc,Name)) :- !,
op(Prio,Assoc,prolog:Name).
export_resource(op(Prio,Assoc,Name)) :- !,
op(Prio,Assoc,user:Name).
export_resource(Resource) :-
'$do_error'(type_error(predicate_indicator,Resource),export(Resource)).
export_list(Module, List) :-
recorded('$module','$module'(_,Module,_,List,_),_).
'$add_to_imports'([], _, _).
% no need to import from the actual module
'$add_to_imports'([T|Tab], Module, ContextModule) :-
'$do_import'(T, Module, ContextModule),
'$add_to_imports'(Tab, Module, ContextModule).
'$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)),
functor(S, N1, K),
% reexport predicates if they are undefined in the current module.
\+ '$undefined'(S,ContextMod), !.
'$do_import'( N/K-N1/K, Mod, ContextMod) :-
functor(G,N,K),
'$follow_import_chain'(Mod,G,M0,G0),
G0=..[_N0|Args],
G1=..[N1|Args],
( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod == prolog ->
recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
fail
;
recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
fail
;
true
)
;
true
).
'$follow_import_chain'(M,G,M0,G0) :-
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
'$follow_import_chain'(M1,G1,M0,G0).
'$follow_import_chain'(M,G,M,G).
% trying to import Mod:N/K into ContextM
'$check_import'(Mod, ContextM, N, K) :-
recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
% dereference MI to M1, in order to find who
% is actually generating
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
M2 \= M1, !,
'$redefine_import'( M1, M2, Mod, ContextM, N/K).
'$check_import'(_,_,_,_).
'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
'$nb_getval'('$lf_status', TOpts, fail),
'$lf_opt'(redefine_module, TOpts, Action), !,
'$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
'$redefine_action'(false, M1, M2, Mod, ContextM, N/K).
'$redefine_action'(ask, M1, M2, M, _, N/K) :-
stream_property(user_input,tty(true)), !,
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
format(user_error,' Do you want to import it from ~w ? [y, n, e or h] ',M),
'$mod_scan'(C),
( C == e -> halt(1) ;
C == y ).
'$redefine_action'(true, M1, _, _, _, _) :- !,
recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
unload_file(F).
'$redefine_action'(false, M1, M2, _M, ContextM, N/K) :-
recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_),
'$current_module'(_, M2),
'$do_error'(permission_error(import,M1:N/K,redefined,M2),F).
'$mod_scan'(C) :-
get_char(C),
'$skipeol'(C),
(C == y -> true; C == n).
/**
@pred set_base_module( +ExportingModule ) is det
All exported predicates from _ExportingModule_ are automatically available to the
current source module.
This built-in was introduced by SWI-Prolog. In YAP, by default, modules only
inherit from `prolog`. This extension allows predicates in the current
module (see module/2 and module/1) to inherit from `user` or other modules.
*/
set_base_module(ExportingModule) :-
var(ExportingModule),
'$do_error'(instantiation_error,set_base_module(ExportingModule)).
set_base_module(ExportingModule) :-
atom(ExportingModule), !,
'$current_module'(Mod),
retractall(prolog:'$parent_module'(Mod,_)),
asserta(prolog:'$parent_module'(Mod,ExportingModule)).
set_base_module(ExportingModule) :-
'$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)).
/**
* @pred import_module( +ImportingModule, +ExportingModule ) is det
* All exported predicates from _ExportingModule_
* are automatically available to the
* source module _ImportModule_.
This innovation was introduced by SWI-Prolog. By default, modules only
inherit from `prolog` and `user`. This extension allows predicates in
any module to inherit from `user` and other modules.
*/
import_module(Mod, ImportModule) :-
var(Mod),
'$do_error'(instantiation_error,import_module(Mod, ImportModule)).
import_module(Mod, ImportModule) :-
atom(Mod), !,
prolog:'$parent_module'(Mod,ImportModule).
import_module(Mod, EM) :-
'$do_error'(type_error(atom,Mod),import_module(Mod, EM)).
/**
@pred add_import_module( + _Module_, + _ImportModule_ , +_Pos_) is det
Add all exports in _ImportModule_ as available to _Module_.
All exported predicates from _ExportModule_ are made available to the
source module _ImportModule_. If _Position_ is bound to `start` the
module _ImportModule_ is tried first, if _Position_ is bound to `end`,
the module is consulted last.
*/
add_import_module(Mod, ImportModule, Pos) :-
var(Mod),
'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, Pos) :-
var(Pos),
'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, start) :-
atom(Mod), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)),
asserta(prolog:'$parent_module'(Mod,ImportModule)).
add_import_module(Mod, ImportModule, end) :-
atom(Mod), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)),
assertz(prolog:'$parent_module'(Mod,ImportModule)).
add_import_module(Mod, ImportModule, Pos) :-
\+ atom(Mod), !,
'$do_error'(type_error(atom,Mod),add_import_module(Mod, ImportModule, Pos)).
add_import_module(Mod, ImportModule, Pos) :-
'$do_error'(domain_error(start_end,Pos),add_import_module(Mod, ImportModule, Pos)).
/**
@pred delete_import_module( + _ExportModule_, + _ImportModule_ ) is det
Exports in _ImportModule_ are no longer available to _Module_.
All exported predicates from _ExportModule_ are discarded from the
ones used vy the source module _ImportModule_.
*/
delete_import_module(Mod, ImportModule) :-
var(Mod),
'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
var(ImportModule),
'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
atom(Mod),
atom(ImportModule), !,
retractall(prolog:'$parent_module'(Mod,ImportModule)).
delete_import_module(Mod, ImportModule) :-
\+ atom(Mod), !,
'$do_error'(type_error(atom,Mod),delete_import_module(Mod, ImportModule)).
delete_import_module(Mod, ImportModule) :-
'$do_error'(type_error(atom,ImportModule),delete_import_module(Mod, ImportModule)).
'$set_source_module'(Source0, SourceF) :-
prolog_load_context(module, Source0), !,
module(SourceF).
'$set_source_module'(Source0, SourceF) :-
current_module(Source0, SourceF).
/**
@pred module_property( +Module, ? _Property_ ) is nondet
Enumerate non-deterministically the main properties of _Module_ .
Reports the following properties of _Module_:
+ `class`( ?_Class_ ): whether it is a `system`, `library`, or `user` module.
+ `line_count`(?_Ls_): number of lines in source file (if there is one).
+ `file`(?_F_): source file for _Module_ (if there is one).
+ `exports`(-Es): list of all predicate symbols and
operator symbols exported or re-exported by this module.
*/
module_property(Mod, Prop) :-
var(Mod),
!,
recorded('$module','$module'(_,Mod,_,_Es,_),_),
module_property(Mod, Prop).
module_property(Mod, class(L)) :-
'$module_class'(Mod, L).
module_property(Mod, line_count(L)) :-
recorded('$module','$module'(_F,Mod,_,_,L),_).
module_property(Mod, file(F)) :-
recorded('$module','$module'(F,Mod,_,_,_),_).
module_property(Mod, exports(Es)) :-
(
recorded('$module','$module'(_,Mod,_,Es,_),_)
->
true
;
Mod==user
->
findall( P, (current_predicate(user:P)), Es)
;
Mod==prolog
->
findall( N/A, (predicate_property(Mod:P0, public),functor(P0,N,A)), Es)
).
'$module_class'( Mod, system) :- '$is_system_module'( Mod ), !.
'$module_class'( Mod, library) :- '$library_module'( Mod ), !.
'$module_class'(_Mod, user) :- !.
'$module_class'( _, temporary) :- fail.
'$module_class'( _, test) :- fail.
'$module_class'( _, development) :- fail.
'$library_module'(M1) :-
recorded('$module','$module'(_, M1, library(_), _MyExports,_Line),_).
ls_imports :-
recorded('$import','$import'(M0,M,G0,G,_N,_K),_R),
numbervars(G0+G, 0, _),
format('~a:~w <- ~a:~w~n', [M, G, M0, G0]),
fail.
ls_imports.
unload_module(Mod) :-
clause( '$meta_predicate'(_F,Mod,_N,_P), _, R),
erase(R),
fail.
unload_module(Mod) :-
recorded('$multifile_defs','$defined'(_FileName,_Name,_Arity,Mod), R),
erase(R),
fail.
unload_module(Mod) :-
recorded( '$foreign', Mod:_Foreign, R),
erase(R),
fail.
% remove imported modules
unload_module(Mod) :-
setof( M, recorded('$import',_G0^_G^_N^_K^_R^'$import'(Mod,M,_G0,_G,_N,_K),_R), Ms),
recorded('$module','$module'( _, Mod, _, _, Exports), _),
lists:member(M, Ms),
current_op(X, Y, M:Op),
lists:member( op(X, Y, Op), Exports ),
op(X, 0, M:Op),
fail.
unload_module(Mod) :-
recorded('$module','$module'( _, Mod, _, _, Exports), _),
lists:member( op(X, _Y, Op), Exports ),
op(X, 0, Mod:Op),
fail.
unload_module(Mod) :-
current_predicate(Mod:P),
abolish(P),
fail.
unload_module(Mod) :-
recorded('$import','$import'(Mod,_M,_G0,_G,_N,_K),R),
erase(R),
fail.
unload_module(Mod) :-
recorded('$module','$module'( _, Mod, _, _, _), R),
erase(R),
fail.
/* debug */
module_state :-
recorded('$module','$module'(HostF,HostM,SourceF, Everything, Line),_),
format('HostF ~a, HostM ~a, SourceF ~w, Line ~d,~n Everything ~w.~n', [HostF,HostM,SourceF, Line, Everything]),
recorded('$import','$import'(HostM,M,G0,G,_N,_K),_R),
format(' ~w:~w :- ~w:~w.~n',[M,G,HostM,G0]),
fail.
module_state.

246
packages/python/swig/yap4py/prolog/pl/newmod.yap
View File

@ -1,246 +0,0 @@
/**
@pred module(+M) is det
set the type-in module
Defines _M_ to be the current working or type-in module. All files
which are not bound to a module are assumed to belong to the working
module (also referred to as type-in module). To compile a non-module
file into a module which is not the working one, prefix the file name
with the module name, in the form ` _Module_: _File_`, when
loading the file.
**/
module(N) :-
var(N),
'$do_error'(instantiation_error,module(N)).
module(N) :-
atom(N), !,
% set it as current module.
'$current_module'(_,N).
module(N) :-
'$do_error'(type_error(atom,N),module(N)).
/**
\pred module(+ Module:atom, +ExportList:list) is directive
define a new module
This directive defines the file where it appears as a _module file_;
it must be the first declaration in the file. _Module_ must be an
atom specifying the module name; _ExportList_ must be a list
containing the module's public predicates specification, in the form
`[predicate_name/arity,...]`. The _ExportList_ can include
operator declarations for operators that are exported by the module.
The public predicates of a module file can be made accessible to other
files through loading the source file, using the directives
use_module/1 or use_module/2,
ensure_loaded/1 and the predicates
consult/1 or reconsult/1. The
non-public predicates of a module file are not supposed to be visible
to other modules; they can, however, be accessed by prefixing the module
name with the `:/2` operator.
**/
'$module_dec'(system(N, Ss), Ps) :- !,
new_system_module(N),
'$mk_system_predicates'( Ss , N ),
'$module_dec'(N, Ps).
'$module_dec'(system(N), Ps) :- !,
new_system_module(N),
% '$mk_system_predicates'( Ps , N ),
'$module_dec'(N, Ps).
'$module_dec'(N, Ps) :-
source_location(F,Line),
'$nb_getval'( '$user_source_file', F0 , fail),
'$add_module_on_file'(N, F, Line,F0, Ps),
'$current_module'(_M0,N).
'$mk_system_predicates'( Ps, _N ) :-
lists:member(Name/A , Ps),
'$new_system_predicate'(Name, A, prolog),
fail.
'$mk_system_predicates'( _Ps, _N ).
/*
declare_module(Mod) -->
arguments(file(+file:F),
line(+integer:L),
parent(+module:P),
type(+module_type:T),
exports(+list(exports):E),
Props, P0) -> true ; Props = P0),
( deleteline(L), P0, P1) -> true ; P0 == P1),
( delete(parent(P), P1, P2) -> true ; P1 == P2),
( delete(line(L), P2, P3) -> true ; P3 == P4),
( delete(file(F), Props, P0) -> true ; Props = P0),
( delete(file(F), Props, P0) -> true ; Props = P0),
( delete(file(F), Props, P0) -> true ; Props = P0),
de
*/
'$module'(_,N,P) :-
'$module_dec'(N,P).
/** set_module_property( +Mod, +Prop)
Set a property for a module. Currently this includes:
- base module, a module from where we automatically import all definitions, see add_import_module/2.
- the export list
- module class is currently ignored.
*/
set_module_property(Mod, base(Base)) :-
must_be_of_type( module, Mod),
add_import_module(Mod, Base, start).
set_module_property(Mod, exports(Exports)) :-
must_be_of_type( module, Mod),
'$add_module_on_file'(Mod, user_input, 1, '/dev/null', Exports).
set_module_property(Mod, exports(Exports, File, Line)) :-
must_be_of_type( module, Mod),
'$add_module_on_file'(Mod, File, Line, '/dev/null', Exports).
set_module_property(Mod, class(Class)) :-
must_be_of_type( module, Mod),
must_be_of_type( atom, Class).
'$add_module_on_file'(DonorMod, DonorF, _LineF, SourceF, Exports) :-
recorded('$module','$module'(OtherF, DonorMod, _, _, _, _),R),
% the module has been found, are we reconsulting?
(
DonorF \= OtherF
->
'$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
;
recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _, _), R),
erase( R ),
fail
).
'$add_module_on_file'(DonorM, DonorF, Line, SourceF, Exports) :-
'$current_module'( HostM ),
( recorded('$module','$module'( HostF, HostM, _, _, _, _),_) -> true ; HostF = user_input ),
% first build the initial export table
'$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
sort( AllExports0, AllExports ),
'$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
% last, export everything to the host: if the loading crashed you didn't actually do
% no evil.
recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_),
( recorded('$source_file','$source_file'( DonorF, Time, _), R), erase(R),
recorda('$source_file','$source_file'( DonorF, Time, DonorM), _) ).
'$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :-
'$simple_conversion'(Exports, Tab, MyExports).
'$convert_for_export'([], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$clean_conversion'([], Exports, Module, ContextModule, Tab, MyExports, Goal).
'$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
'$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
'$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
'$simple_conversion'(MyExports, Tab, _).
'$simple_conversion'([], [], []).
'$simple_conversion'([F/N|Exports], [F/N-F/N|Tab], [F/N|E]) :-
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab], [F/N2|E]) :-
N2 is N+1,
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
N2 is N+1,
'$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
'$simple_conversion'(Exports, Tab, E).
'$clean_conversion'([], _, _, _, [], [], _).
'$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
( lists:memberchk(N1/A1, List)
->
true
;
'$bad_export'((N1/A1 as N2), Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
(
lists:memberchk(N1/A1, List)
->
true
;
'$bad_export'(N1/A1, Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [N1/A2|MyExports], Goal) :- !,
A2 is A1+2,
(
lists:memberchk(N1/A2, List)
->
true
;
'$bad_export'(N1//A1, Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([N1//A1 as N2|Ps], List, Module, ContextModule, [N2/A2-N1/A2|Tab], [N2/A2|MyExports], Goal) :- !,
A2 is A1+2,
(
lists:memberchk(N2/A2, List)
->
true
;
'$bad_export'((N1//A1 as A2), Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
(
lists:memberchk(op(Prio,Assoc,Name), List)
->
true
;
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
'$do_error'(domain_error(module_export_predicates,P), Goal).
'$bad_export'(_, _Module, _ContextModule) :- !.
'$bad_export'(Name/Arity, Module, ContextModule) :-
functor(P, Name, Arity),
predicate_property(Module:P, _), !,
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
'$bad_export'(Name//Arity, Module, ContextModule) :-
Arity2 is Arity+2,
functor(P, Name, Arity2),
predicate_property(Module:P, _), !,
print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
'$bad_export'(Indicator, Module, ContextModule) :- !,
print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
'$neg_conversion'([], Exports, _, _, Exports, _).
'$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
(
lists:delete(List, N1/A1, RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(N1/A1, Module, ContextModule)
).
'$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
A2 is A1+2,
(
lists:delete(List, N1/A2, RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(N1//A1, Module, ContextModule)
).
'$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
(
lists:delete(List, op(Prio,Assoc,Name), RList)
->
'$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
;
'$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
).
'$clean_conversion'([P|_], _List, _, _, _, Goal) :-
'$do_error'(domain_error(module_export_predicates,P), Goal).

222
packages/python/swig/yap4py/prolog/pl/os.yap
View File

@ -1,222 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
*************************************************************************/
:- system_module( '$os', [
cd/0,
cd/1,
getcwd/1,
ls/0,
pwd/0,
unix/1,
putenv/2,
getenv/2,
setenv/2
], [] ).
:- use_system_module( '$_errors', ['$do_error'/2]).
/**
@defgroup YAPOS Access to Operating System Functionality
@ingroup builtins
The following built-in predicates allow access to underlying
Operating System functionality.
%% @{
*/
/** @pred cd
Changes the current directory (on UNIX environments) to the user's home directory.
*/
cd :-
cd('~').
/** @pred cd(+ _D_)
Changes the current directory (on UNIX environments).
*/
cd(F) :-
absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
working_directory(_, Dir).
/** @pred getcwd(- _D_)
Unify the current directory, represented as an atom, with the argument
_D_.
*/
getcwd(Dir) :- working_directory(Dir, Dir).
/** @pred ls
Prints a list of all files in the current directory.
*/
ls :-
getcwd(X),
'$load_system_ls'(X,L),
'$do_print_files'(L).
'$load_system_ls'(X,L) :-
'$undefined'(directory_files(X, L), system),
load_files(library(system),[silent(true)]),
fail.
'$load_system_ls'(X,L) :-
system:directory_files(X, L).
'$do_print_files'([]) :-
nl.
'$do_print_files'([F| Fs]) :-
'$do_print_file'(F),
'$do_print_files'(Fs).
'$do_print_file'('.') :- !.
'$do_print_file'('..') :- !.
'$do_print_file'(F) :- atom_concat('.', _, F), !.
'$do_print_file'(F) :-
write(F), write(' ').
/** @pred pwd
Prints the current directory.
*/
pwd :-
getcwd(X),
write(X), nl.
/** @pred unix(+ _S_)
Access to Unix-like functionality:
+ argv/1
Return a list of arguments to the program. These are the arguments that
follow a `--`, as in the usual Unix convention.
+ cd/0
Change to home directory.
+ cd/1
Change to given directory. Acceptable directory names are strings or
atoms.
+ environ/2
If the first argument is an atom, unify the second argument with the
value of the corresponding environment variable.
+ getcwd/1
Unify the first argument with an atom representing the current directory.
+ putenv/2
Set environment variable _E_ to the value _S_. If the
environment variable _E_ does not exist, create a new one. Both the
environment variable and the value must be atoms.
+ shell/1
Execute command under current shell. Acceptable commands are strings or
atoms.
+ system/1
Execute command with `/bin/sh`. Acceptable commands are strings or
atoms.
+ shell/0
Execute a new shell.
*/
unix(V) :- var(V), !,
'$do_error'(instantiation_error,unix(V)).
unix(argv(L)) :-
current_prolog_flag(argv, L).
unix(cd) :- cd('~').
unix(cd(A)) :- cd(A).
unix(environ(X,Y)) :- '$do_environ'(X,Y).
unix(getcwd(X)) :- getcwd(X).
unix(shell(V)) :- var(V), !,
'$do_error'(instantiation_error,unix(shell(V))).
unix(shell(A)) :- atom(A), !, '$shell'(A).
unix(shell(A)) :- string(A), !, '$shell'(A).
unix(shell(V)) :-
'$do_error'(type_error(atomic,V),unix(shell(V))).
unix(system(V)) :- var(V), !,
'$do_error'(instantiation_error,unix(system(V))).
unix(system(A)) :- atom(A), !, system(A).
unix(system(A)) :- string(A), !, system(A).
unix(system(V)) :-
'$do_error'(type_error(atom,V),unix(system(V))).
unix(shell) :- sh.
unix(putenv(X,Y)) :- '$putenv'(X,Y).
'$is_list_of_atoms'(V,_) :- var(V),!.
'$is_list_of_atoms'([],_) :- !.
'$is_list_of_atoms'([H|L],L0) :- !,
'$check_if_head_may_be_atom'(H,L0),
'$is_list_of_atoms'(L,L0).
'$is_list_of_atoms'(H,L0) :-
'$do_error'(type_error(list,H),unix(argv(L0))).
'$check_if_head_may_be_atom'(H,_) :-
var(H), !.
'$check_if_head_may_be_atom'(H,_) :-
atom(H), !.
'$check_if_head_may_be_atom'(H,L0) :-
'$do_error'(type_error(atom,H),unix(argv(L0))).
'$do_environ'(X, Y) :-
var(X), !,
'$do_error'(instantiation_error,unix(environ(X,Y))).
'$do_environ'(X, Y) :- atom(X), !,
'$getenv'(X,Y).
'$do_environ'(X, Y) :-
'$do_error'(type_error(atom,X),unix(environ(X,Y))).
/** @pred putenv(+ _E_,+ _S_)
Set environment variable _E_ to the value _S_. If the
environment variable _E_ does not exist, create a new one. Both the
environment variable and the value must be atoms.
*/
putenv(Na,Val) :-
'$putenv'(Na,Val).
getenv(Na,Val) :-
'$getenv'(Na,Val).
/** @pred setenv(+ _Name_,+ _Value_)
Set environment variable. _Name_ and _Value_ should be
instantiated to atoms or integers. The environment variable will be
passed to `shell/[0-2]` and can be requested using `getenv/2`.
They also influence expand_file_name/2.
*/
setenv(Na,Val) :-
'$putenv'(Na,Val).
/**
@}
*/

189
packages/python/swig/yap4py/prolog/pl/pathconf.yap
View File

@ -1,189 +0,0 @@
/**
@defgroup pathconf Configuration of the Prolog file search path
@ingroup AbsoluteFileName
Prolog systems search follow a complex search on order to track down files.
@{
**/
:- module(user).
/**
@pred library_directory(?Directory:atom) is nondet, dynamic
Dynamic, multi-file predicate that succeeds when _Directory_ is a
current library directory name. Asserted in the user module.
Library directories are the places where files specified in the form
`library( _File_ )` are searched by the predicates consult/1,
reconsult/1, use_module/1, ensure_loaded/1, and load_files/2.
This directory is initialized by a rule that calls the system predicate
system_library/1.
*/
:- multifile library_directory/1.
:- dynamic library_directory/1.
%% Specifies the set of directories where
% one can find Prolog libraries.
%
library_directory(Home) :-
current_prolog_flag(prolog_library_directory, Home),
Home \= ''.
% 1. honor YAPSHAREDIR
library_directory( Dir ) :-
getenv( 'YAPSHAREDIR', Dir).
%% 2. honor user-library
library_directory( '~/share/Yap' ).
%% 3. honor current directory
library_directory( '.' ).
%% 4. honor default location.
library_directory( Dir ) :-
system_library( Dir ).
/**
@pred commons_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Commons Prolog Initiative.
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
:- dynamic commons_directory/1.
:- multifile commons_directory/1.
commons_directory( Path ):-
system_commons( Path ).
/**
@pred foreign_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Foreign Prolog Initiative.
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
:- multifile foreign_directory/1.
:- dynamic foreign_directory/1.
%foreign_directory( Path ):-
foreign_directory(Home) :-
current_prolog_flag(prolog_foreign_directory, Home),
Home \= ''.
foreign_directory( '.').
foreign_directory(yap('lib/Yap')).
foreign_directory( Path ):-
system_foreign( Path ).
/**
@pred prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic
This multifile/dynamic predicate relates a file extension _Suffix_
to a language or file type _Handler_. By
default, it supports the extensions yap, pl, and prolog for prolog files and
uses one of dll, so, or dylib for shared objects. Initial definition is:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog
prolog_file_type(yap, prolog).
prolog_file_type(pl, prolog).
prolog_file_type(prolog, prolog).
prolog_file_type(qly, prolog).
prolog_file_type(qly, qly).
prolog_file_type(A, prolog) :-
current_prolog_flag(associate, A),
A \== prolog,
A \==pl,
A \== yap.
prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
prolog_file_type(pyd, executable).
~~~~~~~~~~~~~~~~~~~~~
*/
:- dynamic prolog_file_type/2.
prolog_file_type(yap, prolog).
prolog_file_type(pl, prolog).
prolog_file_type(prolog, prolog).
prolog_file_type(A, prolog) :-
current_prolog_flag(associate, A),
A \== prolog,
A \== pl,
A \== yap.
prolog_file_type(qly, qly).
prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
prolog_file_type(pyd, executable).
/**
@pred file_search_path(+Name:atom, -Directory:atom) is nondet
Allows writing file names as compound terms. The _Name_ and
_DIRECTORY_ must be atoms. The predicate may generate multiple
solutions. The predicate is originally defined as follows:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog
file_search_path(library, Dir) :-
library_directory(Dir).
file_search_path(commons, Dir) :-
commons_directory(Dir).
file_search_path(swi, Home) :-
current_prolog_flag(home, Home).
file_search_path(yap, Home) :-
current_prolog_flag(home, Home).
file_search_path(system, Dir) :-
prolog_flag(host_type, Dir).
file_search_path(foreign, Dir) :-
foreign_directory(Dir).
file_search_path(executable, Dir) :-
foreign_directory(Dir).
file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)
-> atomic_list_concat(B, ;, A)
; atomic_list_concat(B, :, A)
),
lists:member(C, B)
).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Thus, `compile(library(A))` will search for a file using
library_directory/1 to obtain the prefix,
whereas 'compile(system(A))` would look at the `host_type` flag.
*/
:- multifile file_search_path/2.
:- dynamic file_search_path/2.
file_search_path(library, Dir) :-
library_directory(Dir).
file_search_path(commons, Dir) :-
commons_directory(Dir).
file_search_path(swi, Home) :-
current_prolog_flag(home, Home).
file_search_path(yap, Home) :-
current_prolog_flag(home, Home).
file_search_path(system, Dir) :-
prolog_flag(host_type, Dir).
file_search_path(foreign, Dir) :-
foreign_directory(Dir).
file_search_path(executable, Dir) :-
foreign_directory(Dir).
file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)
-> atomic_list_concat(B, ;, A)
; atomic_list_concat(B, :, A)
),
lists:member(C, B)
).
%% @}

270
packages/python/swig/yap4py/prolog/pl/preddecls.yap
View File

@ -1,270 +0,0 @@
/*************************************************************************
* *
* 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 *
* *
*************************************************************************/
:- system_module( '$_preddecls', [(discontiguous)/1,
(dynamic)/1,
(multifile)/1,
(discontiguous)/1], ['$check_multifile_pred'/3,
'$discontiguous'/2,
'$dynamic'/2]).
:- use_system_module( '$_consult', ['$add_multifile'/3]).
:- use_system_module( '$_errors', ['$do_error'/2]).
'$log_upd'(1).
/**
@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
during execution time, whether they are meta-predicates, or whether they can be
defined across multiple files. We next join some of these declarations.
*/
%
% can only do as goal in YAP mode.
%
/** @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.
~~~~~
a more convenient form can be used:
~~~~~
:- dynamic son/3, father/2, mother/2.
~~~~~
or, equivalently,
~~~~~
:- dynamic [son/3, father/2, mother/2].
~~~~~
Note:
a predicate is assumed to be dynamic when
asserted before being defined.
*/
dynamic(X) :-
current_prolog_flag(language, yap), !,
'$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'(X,M) :- var(M), !,
'$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'(A//N,Mod) :- integer(N), !,
N1 is N+2,
'$dynamic'(A/N1,Mod).
'$dynamic'(A/N,Mod) :-
functor(G, A, N),
'$mk_d'(G,Mod).
/** @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).
'$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) :-
'$predicate_flags'(T,Mod,F,F),
NF is F\/0x00400000,
'$predicate_flags'(T,Mod,F,NF).
/** @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.
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.
**/
multifile(P) :-
strip_module(P, OM, Pred),
'$multifile'(Pred, OM).
'$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).
'$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,
'$predicate_flags'(Hd,M,Fl,NFl),
'$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,')'),
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.
/**
@pred module_transparent( + _Preds_ ) is directive
_Preds_ is a list of predicates that can access the calling context.
This predicate was implemented to achieve compatibility with the older
module expansion system in SWI-Prolog. Please use meta_predicate/1 for
new code.
_Preds_ is a comma separated sequence of name/arity predicate
indicators (like in dynamic/1). Each goal associated with a
transparent declared predicate will inherit the context module from
its caller.
*/
:- dynamic('$module_transparent'/4).
'$module_transparent'((P,Ps), M) :- !,
'$module_transparent'(P, M),
'$module_transparent'(Ps, M).
'$module_transparent'(M:D, _) :- !,
'$module_transparent'(D, M).
'$module_transparent'(F/N, M) :-
'$module_transparent'(F,M,N,_), !.
'$module_transparent'(F/N, M) :-
functor(P,F,N),
asserta(prolog:'$module_transparent'(F,M,N,P)),
'$predicate_flags'(P, M, Fl, Fl),
NFlags is Fl \/ 0x200004,
'$predicate_flags'(P, M, Fl, NFlags).

Some files were not shown because too many files have changed in this diff Show More