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

Merge /home/vsc/yap

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-07-13 14:43:00 +01:00
commit 04fa39126c
44 changed files with 901 additions and 724 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
C/adtdefs.c
View File

@ -147,6 +147,32 @@ static inline Atom SearchAtom(const unsigned char *p, Atom a) {
return (NIL); return (NIL);
} }
Atom
Yap_AtomInUse(const char *atom) { /* lookup atom in atom table */
uint64_t hash;
const unsigned char *p;
Atom a, na = NIL;
AtomEntry *ae;
size_t sz = AtomHashTableSize;
/* compute hash */
p =( const unsigned char *) atom;
hash = HashFunction(p);
hash = hash % sz;
/* we'll start by holding a read lock in order to avoid contention */
READ_LOCK(HashChain[hash].AERWLock);
a = HashChain[hash].Entry;
/* search atom in chain */
na = SearchAtom(p, a);
ae = RepAtom(na);
if (na != NIL ) {
READ_UNLOCK(HashChain[hash].AERWLock);
return (na);
}
READ_UNLOCK(HashChain[hash].AERWLock);
return NIL;
}
static Atom static Atom
LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */

11
C/atomic.c
View File

@ -592,8 +592,9 @@ restart_aux:
The predicate holds when at least one of the arguments is The predicate holds when at least one of the arguments is
ground (otherwise, YAP will generate an error event. _A_ must be unifiable with an atom, and the ground (otherwise, YAP will generate an error event. _A_ must be unifiable
argument _L_ with the list of the character codes for string _A_. with an atom, and the argument _L_ with the list of the character codes for
string _A_.
*/ */
@ -1465,9 +1466,7 @@ error:
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux; goto restart_aux;
} }
{ { return FALSE; }
return FALSE;
}
} }
static Int atomics_to_string2(USES_REGS1) { static Int atomics_to_string2(USES_REGS1) {
@ -2766,6 +2765,8 @@ void Yap_InitAtomPreds(void) {
Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0); Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0);
Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0); Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0);
Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0); Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0);
Yap_InitCPred("text_to_string", 2, downcase_text_to_string, 0);
Yap_InitCPred("text_to_atom", 2, downcase_text_to_string, 0);
Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0); Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0);
Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0); Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0);
Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0); Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0);

8
C/c_interface.c
View File

@ -2271,8 +2271,8 @@ X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze,
char *b; char *b;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
b = Yap_TermToBuffer(t, enc, flags); b = Yap_TermToBuffer(t, flags);
strncpy(buf, b, sze); strncpy(buf, b, sze-1);
buf[sze] = 0; buf[sze] = 0;
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return true; return true;
@ -2371,7 +2371,7 @@ X_API void YAP_FlushAllStreams(void) {
X_API void YAP_Throw(Term t) { X_API void YAP_Throw(Term t) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
LOCAL_ActiveError->errorNo = THROW_EVENT; LOCAL_ActiveError->errorNo = THROW_EVENT;
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0); LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
Yap_JumpToEnv(); Yap_JumpToEnv();
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -2381,7 +2381,7 @@ X_API void YAP_AsyncThrow(Term t) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
LOCAL_PrologMode |= AsyncIntMode; LOCAL_PrologMode |= AsyncIntMode;
LOCAL_ActiveError->errorNo = THROW_EVENT; LOCAL_ActiveError->errorNo = THROW_EVENT;
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0); LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
Yap_JumpToEnv(); Yap_JumpToEnv();
LOCAL_PrologMode &= ~AsyncIntMode; LOCAL_PrologMode &= ~AsyncIntMode;
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();

8
C/errors.c
View File

@ -324,7 +324,7 @@ bool Yap_PrintWarning(Term twarning) {
PredEntry *pred = RepPredProp(PredPropByFunc( PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)", __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f)); Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc; bool rc;
Term ts[2], err; Term ts[2], err;
@ -332,7 +332,7 @@ bool Yap_PrintWarning(Term twarning) {
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
(err = LOCAL_ActiveError->errorNo)) { (err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n", fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning, ENC_ISO_UTF8, Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false; return false;
@ -648,7 +648,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->culprit = NULL; r->culprit = NULL;
} else { } else {
r->culprit = Yap_TermToBuffer( r->culprit = Yap_TermToBuffer(
where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); where, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
} }
if (LOCAL_consult_level > 0) { if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE; r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
@ -1149,7 +1149,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
n = t2; n = t2;
} }
i->errorGoal = Yap_TermToBuffer( i->errorGoal = Yap_TermToBuffer(
n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); n, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
} }
Yap_prolog_add_culprit(i PASS_REGS); Yap_prolog_add_culprit(i PASS_REGS);
return i; return i;

3
C/exec.c
View File

@ -2116,7 +2116,8 @@ static Int jump_env(USES_REGS1) {
} }
// Yap_DebugPlWriteln(t); // Yap_DebugPlWriteln(t);
// char *buf = Yap_TermToBuffer(t, ENC_ISO_UTF8, // char *buf = Yap_TermToBuffer(t, ENC_ISO_UTF8,
// Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); // Quote_illegal_f | Ignore_ops_f |
// Unfold_cyclics_f);
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " throw(%s)", buf); // __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " throw(%s)", buf);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1); bool out = JumpToEnv(PASS_REGS1);

71
C/flags.c
View File

@ -80,22 +80,29 @@ static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1); static Int current_prolog_flag(USES_REGS1);
static Int set_prolog_flag(USES_REGS1); static Int set_prolog_flag(USES_REGS1);
#include "Yatom.h"
#include "YapEval.h" #include "YapEval.h"
#include "Yatom.h"
#include "yapio.h" #include "yapio.h"
#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) { NAME, WRITABLE, DEF, INIT, HELPER } #define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) \
{ NAME, WRITABLE, DEF, INIT, HELPER }
#define START_LOCAL_FLAGS static flag_info local_flags_setup[] = { #define START_LOCAL_FLAGS static flag_info local_flags_setup[] = {
#define END_LOCAL_FLAGS LZERO_FLAG}; #define END_LOCAL_FLAGS \
LZERO_FLAG \
} \
;
#define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = { #define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = {
#define END_GLOBAL_FLAGS GZERO_FLAG}; #define END_GLOBAL_FLAGS \
GZERO_FLAG \
} \
#define GZERO_FLAG { NULL, false, NULL, NULL, NULL } ;
#define LZERO_FLAG { NULL, false, NULL, NULL, NULL }
#define GZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#define LZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#include "YapGFlagInfo.h" #include "YapGFlagInfo.h"
@ -111,8 +118,7 @@ static Term indexer(Term inp) {
"set_prolog_flag index in {off,single,compact,multi,on,max}"); "set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
"set_prolog_flag index to an atom");
return TermZERO; return TermZERO;
} }
@ -133,13 +139,15 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true; return true;
} }
/* bad argument, but still an atom */ /* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should " Yap_Error(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}", "be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
@ -168,7 +176,8 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS; new->flags |= BCKQ_CHARS;
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
@ -186,7 +195,6 @@ static bool bqs(Term t2) {
return bqf1(new, t2 PASS_REGS); return bqf1(new, t2 PASS_REGS);
} }
static bool sqf1(ModEntry *new, Term t2 USES_REGS) { static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING); new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING);
if (IsAtomTerm(t2)) { if (IsAtomTerm(t2)) {
@ -203,7 +211,8 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= SNGQ_CHARS; new->flags |= SNGQ_CHARS;
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
@ -215,7 +224,6 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
} }
} }
static bool sqf(Term t2) { static bool sqf(Term t2) {
CACHE_REGS CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule); ModEntry *new = Yap_GetModuleEntry(CurrentModule);
@ -239,7 +247,8 @@ static Term isaccess(Term inp) {
static Term stream(Term inp) { static Term stream(Term inp) {
if (IsVarTerm(inp)) if (IsVarTerm(inp))
return inp; return inp;
if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f | if (Yap_CheckStream(inp,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f, Socket_Stream_f,
"yap_flag/3") >= 0) "yap_flag/3") >= 0)
return inp; return inp;
@ -782,7 +791,6 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
return bqf1(me, t2 PASS_REGS); return bqf1(me, t2 PASS_REGS);
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) { } else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
return sqf1(me, t2 PASS_REGS); return sqf1(me, t2 PASS_REGS);
} }
// bad key? // bad key?
return false; return false;
@ -850,8 +858,7 @@ static Int cont_yap_flag(USES_REGS1) {
Term modt = CurrentModule; Term modt = CurrentModule;
tflag = Yap_StripModule(tflag, &modt); tflag = Yap_StripModule(tflag, &modt);
while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG && while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG &&
i != BACK_QUOTES_FLAG && i != BACK_QUOTES_FLAG && i != SINGLE_QUOTES_FLAG &&
i != SINGLE_QUOTES_FLAG &&
i != DOUBLE_QUOTES_FLAG) i != DOUBLE_QUOTES_FLAG)
i++; i++;
if (i == gmax) if (i == gmax)
@ -1056,14 +1063,16 @@ void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) {
Atom at = new->AtomOfME; Atom at = new->AtomOfME;
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) { if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
new->flags = new->flags = M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES |
M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM; BCKQ_STRING | SNGQ_ATOM;
if (at == AtomUser) if (at == AtomUser)
new->flags = UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM; new->flags =
UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM;
} else if (cme && cme->flags && cme != new) { } else if (cme && cme->flags && cme != new) {
new->flags = cme->flags; new->flags = cme->flags;
} else { } else {
new->flags = (UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM); new->flags =
(UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM);
} }
// printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags); // printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags);
} }
@ -1392,7 +1401,8 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
} }
CACHE_REGS CACHE_REGS
const char *us = (const char *)s; const char *us = (const char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1, GLOBAL_MaxPriority); t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1,
GLOBAL_MaxPriority);
if (!t0) if (!t0)
return false; return false;
if (IsAtomTerm(t0) || IsIntTerm(t0)) { if (IsAtomTerm(t0) || IsIntTerm(t0)) {
@ -1439,7 +1449,8 @@ do_prolog_flag_property(Term tflag,
xarg *args; xarg *args;
prolog_flag_property_choices_t i; prolog_flag_property_choices_t i;
bool rc = true; bool rc = true;
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
@ -1527,8 +1538,7 @@ static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name)); lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
} else { } else {
if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG || if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG ||
i == SINGLE_QUOTES_FLAG || i == SINGLE_QUOTES_FLAG || i == DOUBLE_QUOTES_FLAG ||
i == DOUBLE_QUOTES_FLAG ||
i == BACK_QUOTES_FLAG) { i == BACK_QUOTES_FLAG) {
Term labs[2]; Term labs[2];
labs[0] = MkVarTerm(); labs[0] = MkVarTerm();
@ -1607,7 +1617,8 @@ static Int do_create_prolog_flag(USES_REGS1) {
prolog_flag_property_choices_t i; prolog_flag_property_choices_t i;
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3); Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
@ -1722,7 +1733,7 @@ void Yap_InitFlags(bool bootstrap) {
*/ */
Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag, Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag,
0); 0);
Yap_InitCPredBack("yap_flag", 3, 1, prolog_flag, cont_yap_flag, 0); Yap_InitCPredBack("yap_flag", 3, 1, yap_flag, cont_yap_flag, 0);
Yap_InitCPredBack("prolog_flag", 2, 1, current_prolog_flag2, Yap_InitCPredBack("prolog_flag", 2, 1, current_prolog_flag2,
cont_current_prolog_flag, 0); cont_current_prolog_flag, 0);
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2, Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2,

129
C/text.c
View File

@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) {
return new; return new;
} }
static size_t MaxTmp(USES_REGS1) { static size_t MaxTmp(USES_REGS1) { return 1025; }
return 1025;
}
static Term Globalize(Term v USES_REGS) { static Term Globalize(Term v USES_REGS) {
if (!IsVarTerm(v = Deref(v))) { if (!IsVarTerm(v = Deref(v))) {
@ -231,7 +228,8 @@ static Term Globalize(Term v USES_REGS) {
return v; return v;
} }
static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) { static void *codes2buf(Term t0, void *b0, bool get_codes,
bool fixed USES_REGS) {
unsigned char *st0, *st, ar[16]; unsigned char *st0, *st, ar[16];
Term t = t0; Term t = t0;
size_t length = 0; size_t length = 0;
@ -248,7 +246,8 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS)
bool codes = IsIntegerTerm(HeadOfTerm(t)); bool codes = IsIntegerTerm(HeadOfTerm(t));
if (get_codes != codes && fixed) { if (get_codes != codes && fixed) {
if (codes) { if (codes) {
Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), "scanning list of codes"); Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t),
"scanning list of codes");
} else { } else {
Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms"); Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms");
} }
@ -266,7 +265,8 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS)
} }
Int code = IntegerOfTerm(hd); Int code = IntegerOfTerm(hd);
if (code < 0) { if (code < 0) {
Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, "scanning list of character codes, found %d", code); Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd,
"scanning list of character codes, found %d", code);
return NULL; return NULL;
} }
length += put_utf8(ar, code); length += put_utf8(ar, code);
@ -420,137 +420,146 @@ static yap_error_number gen_type_error(int flags) {
// static int cnt; // static int cnt;
unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
#define POPRET(x) return pop_output_text_stack(lvl, x)
int lvl = push_text_stack(); int lvl = push_text_stack();
char *out = NULL;
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */ /* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) { if (!(inp->type & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) { if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM; LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t; LOCAL_ActiveError->errorRawTerm = inp->val.t;
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
LOCAL_Error_TYPE = TYPE_ERROR_TEXT; LOCAL_Error_TYPE = TYPE_ERROR_TEXT;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} }
} }
if (err0 != LOCAL_Error_TYPE) {
Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in");
}
} }
if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) { if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t); Atom at = AtomOfTerm(inp->val.t);
if (RepAtom(at)->UStrOfAE[0] == 0) { if (RepAtom(at)->UStrOfAE[0] == 0) {
unsigned char *o = Malloc(4); out = Malloc(4);
memset(o, 0, 4); memset(out, 0, 4);
return pop_output_text_stack(lvl, o); POPRET( out );
} }
if (inp->type & YAP_STRING_WITH_BUFFER) { if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl); pop_text_stack(lvl);
return at->UStrOfAE; return at->UStrOfAE;
} }
{
size_t sz = strlen(at->StrOfAE); size_t sz = strlen(at->StrOfAE);
void *o = Malloc(sz + 1); out = Malloc(sz + 1);
strcpy(o, at->StrOfAE); strcpy(out, at->StrOfAE);
return pop_output_text_stack(lvl, o); POPRET( out );
}
} }
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
const char *s = StringOfTerm(inp->val.t); const char *s = StringOfTerm(inp->val.t);
if (s[0] == 0) { if (s[0] == 0) {
char *o = Malloc(4); out = Malloc(4);
memset(o, 0, 4); memset(out, 0, 4);
return pop_output_text_stack(lvl, o); POPRET( out );
} }
if (inp->type & YAP_STRING_WITH_BUFFER) if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl);
return (unsigned char *)UStringOfTerm(inp->val.t); return (unsigned char *)UStringOfTerm(inp->val.t);
}
{
inp->type |= YAP_STRING_IN_TMP; inp->type |= YAP_STRING_IN_TMP;
size_t sz = strlen(s); size_t sz = strlen(s);
char *o = Malloc(sz + 1); out = Malloc(sz + 1);
strcpy(o, s); strcpy(out, s);
return pop_output_text_stack(lvl, o); POPRET( out );
} }
} else if (IsPairOrNilTerm(inp->val.t)) {
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS)) && (YAP_STRING_CODES | YAP_STRING_ATOMS))) {
IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack( out = (char *)Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS);
lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS)); POPRET( out );
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
} }
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_CODES) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack( out = (char *)Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS);
lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
POPRET( out );
} }
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_ATOMS) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack( out = (char *)Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS);
lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
POPRET( out );
}
} }
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
// ASCII, so both LATIN1 and UTF-8 // ASCII, so both LATIN1 and UTF-8
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
char *s; out = Malloc(2 * MaxTmp(PASS_REGS1));
s = Malloc(2 * MaxTmp(PASS_REGS1)); if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
IntegerOfTerm(inp->val.t)) < 0) { IntegerOfTerm(inp->val.t)) < 0) {
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), out, char);
} }
return pop_output_text_stack(lvl, s); POPRET( out );
} }
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
char *s; out = Malloc(2 * MaxTmp(PASS_REGS1));
// Yap_DebugPlWriteln(inp->val.t); if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) {
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) {
pop_text_stack(lvl); pop_text_stack(lvl);
return NULL; return NULL;
} }
return pop_output_text_stack(lvl, s); POPRET(out);
} }
#if USE_GMP #if USE_GMP
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
char *s; out = Malloc(MaxTmp());
s = Malloc(MaxTmp()); if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1,
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) { 10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), out, char);
} }
return inp->val.uc = pop_output_text_stack(lvl, s); POPRET(out);
} }
#endif #endif
if (inp->type & YAP_STRING_TERM) { if (inp->type & YAP_STRING_TERM) {
// Yap_DebugPlWriteln(inp->val.t); pop_text_stack(lvl);
char *s = (char *)Yap_TermToBuffer(inp->val.t, ENC_ISO_UTF8, 0); return Yap_TermToBuffer(inp->val.t, 0);
return inp->val.uc = pop_output_text_stack(lvl, s);
} }
if (inp->type & YAP_STRING_CHARS) { if (inp->type & YAP_STRING_CHARS) {
if (inp->enc == ENC_ISO_ASCII) {
pop_text_stack(lvl); pop_text_stack(lvl);
return inp->val.uc;
}
if (inp->enc == ENC_ISO_LATIN1) { if (inp->enc == ENC_ISO_LATIN1) {
return latin2utf8(inp); POPRET( (char*)latin2utf8(inp));
} else if (inp->enc == ENC_ISO_ASCII) {
return inp->val.uc;
} else { // if (inp->enc == ENC_ISO_UTF8) {
return inp->val.uc;
}
} }
if (inp->enc == ENC_ISO_UTF8) {
pop_text_stack(lvl); pop_text_stack(lvl);
return inp->val.c;
}
}
if (inp->type & YAP_STRING_WCHARS) { if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w); // printf("%S\n",inp->val.w);
return wchar2utf8(inp); POPRET( (char *)wchar2utf8(inp) );
} }
pop_text_stack(lvl);
return NULL; return NULL;
} }

2
C/tracer.c
View File

@ -87,7 +87,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
continue; continue;
} }
} }
const char *sn = Yap_TermToBuffer(args[i], LOCAL_encoding, const char *sn = Yap_TermToBuffer(args[i],
Quote_illegal_f | Handle_vars_f); Quote_illegal_f | Handle_vars_f);
size_t sz; size_t sz;
if (sn == NULL) { if (sn == NULL) {

29
C/write.c
View File

@ -384,9 +384,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) {
wglb.lw = separator; wglb.lw = separator;
wglb.stream = GLOBAL_Stream + sno; wglb.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb); wrputf(f, &wglb);
so = Yap_MemExportStreamPtr(sno); *s = Yap_MemExportStreamPtr(sno);
*s = BaseMalloc(strlen(so) + 1);
strcpy(*s, so);
Yap_CloseStream(sno); Yap_CloseStream(sno);
return true; return true;
} }
@ -1255,28 +1253,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
pop_text_stack(lvl); pop_text_stack(lvl);
} }
char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(enc, flags);
const char *sf;
if (sno < 0)
return NULL;
if (t == 0)
return NULL;
else
t = Deref(t);
if (enc)
GLOBAL_Stream[sno].encoding = enc;
else
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
sf = Yap_MemExportStreamPtr(sno);
size_t len = strlen(sf);
char *new = malloc(len + 1);
strcpy(new, sf);
Yap_CloseStream(sno);
return new;
}

2
C/yap-args.c
View File

@ -203,13 +203,13 @@ static bool consult(const char *b_file USES_REGS) {
} else { } else {
YAP_CompileClause(t); YAP_CompileClause(t);
} }
} while (true);
yap_error_descriptor_t *errd; yap_error_descriptor_t *errd;
if ((errd = if ((errd =
Yap_GetException(LOCAL_ActiveError))) { Yap_GetException(LOCAL_ActiveError))) {
fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (long int) errd->errorLine, errd->classAsText, fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (long int) errd->errorLine, errd->classAsText,
errd->errorAsText); errd->errorAsText);
} }
} while (true);
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full); YAP_EndConsult(c_stream, &osno, full);
if (!Yap_AddAlias(AtomLoopStream, osno)) { if (!Yap_AddAlias(AtomLoopStream, osno)) {

2
CMakeLists.txt
View File

@ -554,7 +554,7 @@ IF (WITH_PYTHON)
ENDIF (WITH_PYTHON) ENDIF (WITH_PYTHON)
option(WITH_R option(WITH_R
"Allow YAP->R" ON) "Use R Interface" ON)
IF (WITH_R) IF (WITH_R)
include_directories(packages/real ) include_directories(packages/real )

15
CXX/yapi.cpp
View File

@ -19,7 +19,7 @@ extern "C" {
#include "YapInterface.h" #include "YapInterface.h"
#include "iopreds.h" #include "iopreds.h"
X_API char *Yap_TermToBuffer(Term t, encoding_t encodingp, int flags); X_API char *Yap_TermToBuffer(Term t, int flags);
X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, arity_t arity); X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, arity_t arity);
X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, arity_t, X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, arity_t,
@ -30,12 +30,9 @@ X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred,
#if YAP_PYTHON #if YAP_PYTHON
X_API bool do_init_python(void); X_API bool do_init_python(void);
#endif #endif
} }
static void YAPCatchError() static void YAPCatchError() {
{
if (LOCAL_CommittedError != nullptr && if (LOCAL_CommittedError != nullptr &&
LOCAL_CommittedError->errorNo != YAP_NO_ERROR) { LOCAL_CommittedError->errorNo != YAP_NO_ERROR) {
// Yap_PopTermFromDB(info->errorTerm); // Yap_PopTermFromDB(info->errorTerm);
@ -522,7 +519,6 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
#if YAP_PYTHON #if YAP_PYTHON
// PyThreadState *_save; // PyThreadState *_save;
//std::cerr << "mgoal " << YAPTerm(t).text() << "\n"; //std::cerr << "mgoal " << YAPTerm(t).text() << "\n";
// _save = PyEval_SaveThread(); // _save = PyEval_SaveThread();
#endif #endif
@ -557,6 +553,8 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); //__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
result = (bool)YAP_EnterGoal(ap, nullptr, &q); result = (bool)YAP_EnterGoal(ap, nullptr, &q);
//std::cerr << "mgoal " << YAPTerm(t).text() << "\n";
YAP_LeaveGoal(result && !release, &q); YAP_LeaveGoal(result && !release, &q);
// PyEval_RestoreThread(_save); // PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
@ -666,7 +664,6 @@ goal = YAPApplTerm(f, nts);
} }
#endif #endif
YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) { YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
try { try {
@ -682,7 +679,6 @@ YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) {
} }
names = TermNil; names = TermNil;
} catch (...) { } catch (...) {
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -721,8 +717,7 @@ if (!result) {
} }
PredEntry *YAPQuery::rewriteUndefQuery() { PredEntry *YAPQuery::rewriteUndefQuery() {
ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall, 1, &goal));
, 1, &goal));
return ap = PredCall; return ap = PredCall;
} }

8
CXX/yapt.hh
View File

@ -223,19 +223,15 @@ public:
/// return a string with a textual representation of the term /// return a string with a textual representation of the term
virtual const char *text() { virtual const char *text() {
CACHE_REGS CACHE_REGS
encoding_t enc = LOCAL_encoding;
char *os; char *os;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
if (!(os = Yap_TermToBuffer(Yap_GetFromSlot(t), enc, Handle_vars_f))) { if (!(os = Yap_TermToBuffer(Yap_GetFromSlot(t), Handle_vars_f))) {
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return 0; return 0;
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
size_t length = strlen(os); return os;
char *sm = (char *)malloc(length + 1);
strcpy(sm, os);
return sm;
}; };
/// return a handle to the term /// return a handle to the term

66
H/YapGFlagInfo.h
View File

@ -56,29 +56,26 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
~~~ ~~~
*/ */
YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL), YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL),
/**< how to present answers, default is `~p`. */ /**< how to present answers, default is `~p`. */
#if __ANDROID__ #if __ANDROID__
YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**< YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running an Google's Android version of the Linux Operating System */ read-only boolean, a machine running an Google's Android version of the
Linux Operating System */
#endif #endif
#if __APPLE__ #if __APPLE__
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**< YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running an Apple Operating System */ read-only boolean, a machine running an Apple Operating System */
#endif #endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**< YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**<
read-only atom, it describes the ISA used in this version of YAP. read-only atom, it describes the ISA used in this version of YAP.
Available from YAP_AEH. Available from YAP_ARCH.
*/ */
YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL), YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL),
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true,
booleanFlag, "true", NULL), booleanFlag, "true", NULL),
/**< `arithmetic_exceptions` /**<
Read-write flag telling whether arithmetic exceptions generate Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled: Prolog exceptions. If enabled:
@ -99,7 +96,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
ProbLog. ProbLog.
*/ */
YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs), YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs),
/**> /**<
If _Value_ is unbound, tell whether a back quoted list of characters If _Value_ is unbound, tell whether a back quoted list of characters
token is converted to a list of atoms, `chars`, to a list of integers, token is converted to a list of atoms, `chars`, to a list of integers,
`codes`, or to a single atom, `atom`. If _Value_ is bound, set to `codes`, or to a single atom, `atom`. If _Value_ is bound, set to
@ -132,12 +129,14 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
Writable flag telling whether a character escapes are enabled, Writable flag telling whether a character escapes are enabled,
`true`, or disabled, `false`. The default value for this flag is `true`, or disabled, `false`. The default value for this flag is
`true`. */ `true`. */
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", true, booleanFlag, "true", NULL), YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
/**< `compiled_at ` /**< `compiled_at `
Read-only flag that gives the time when the main YAP binary was compiled. It Read-only flag that gives the time when the main YAP binary was compiled.
is obtained staight from the __TIME__ macro, as defined in the C99. It is obtained staight from the __TIME__ macro, as defined in the C99.
*/ YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, */
YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL), NULL),
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
/**< /**<
@ -159,11 +158,14 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
NULL), NULL),
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
booleanFlag, "false", NULL), booleanFlag, "false", NULL),
YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom, "user", NULL), YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom,
"user", NULL),
/**< /**<
* A module to be inherited by all other modules. Default is user that reexports prolog. * A module to be inherited by all other modules. Default is user that
* reexports prolog.
* *
* Set it to `prolog` for SICStus Prolog like resolution, to `user` for SWI-like. * Set it to `prolog` for SICStus Prolog like resolution, to `user` for
* SWI-like.
*/ */
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL), YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL),
/**< /**<
@ -297,6 +299,8 @@ vxu `on` consider `$` a lower case character.
value `toward_zero` for the current version of YAP. value `toward_zero` for the current version of YAP.
*/ */
YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL), YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL),
YAP_FLAG(JUPYTER_FLAG, "jupyter", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running Jupyter */
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL),
/**< `language ` /**< `language `
@ -354,9 +358,8 @@ vxu `on` consider `$` a lower case character.
program. This is for compatibility with old software that program. This is for compatibility with old software that
might expect module-independent operators. might expect module-independent operators.
*/ */
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
"module_independent_operators", true, booleanFlag, true, booleanFlag, "false", NULL),
"false", NULL),
YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL),
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL),
@ -389,6 +392,15 @@ vxu `on` consider `$` a lower case character.
enable the use of the readline library for console interactions, true by enable the use of the readline library for console interactions, true by
default if readline was found. */ default if readline was found. */
YAP_FLAG(REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag,
"true", NULL), /**<
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
`off`. If _Value_ is bound to `on` enable these warnings,
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
*/
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true", YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true",
NULL), NULL),
YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom, YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom,
@ -424,6 +436,15 @@ vxu `on` consider `$` a lower case character.
/**< `single_quoted text is usuallly interpreted as atoms. This flagTerm /**< `single_quoted text is usuallly interpreted as atoms. This flagTerm
allows other inerpretations such as strings_contains_strings */ allows other inerpretations such as strings_contains_strings */
YAP_FLAG(SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag,
"true", NULL), /**<
If `true` (default `true`) YAP checks for singleton
variables when loading files. A singleton variable is a
variable that appears ony once in a clause. The name
must start with a capital letter, variables whose name
starts with underscore are never considered singleton.
*/
YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL), YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL),
/**< `signals` /**< `signals`
@ -482,8 +503,7 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true",
booleanFlag, "true",
NULL), NULL),
/**< `toplevel_hook ` /**< `toplevel_hook `
@ -527,9 +547,9 @@ vxu `on` consider `$` a lower case character.
are `silent`, `warning` and `error`. The first two create the flag are `silent`, `warning` and `error`. The first two create the flag
on-the-fly, with `warning` printing a message. The value `error` is on-the-fly, with `warning` printing a message. The value `error` is
consistent with ISO: it raises an existence error and does not create the consistent with ISO: it raises an existence error and does not create the
flag. See also `create_prolog_flag/3`. The default is`error`, and developers flag. See also `create_prolog_flag/3`. The default is`error`, and
are encouraged to use `create_prolog_flag/3` to create flags for their developers are encouraged to use `create_prolog_flag/3` to create flags for
library. their library.
*/ */
YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown), YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown),
/**< `unknown is iso` /**< `unknown is iso`

65
H/YapLFlagInfo.h
View File

@ -10,10 +10,8 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: YapLFlagInfo.h * * File: YapLFlagInfo.h * Last rev:
* Last rev: * ** mods: * comments: local flag enumeration. *
* mods: *
* comments: local flag enumeration. *
* * * *
*************************************************************************/ *************************************************************************/
@ -34,48 +32,47 @@ START_LOCAL_FLAGS
YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
/** + `read-only flag, that tells if Prolog is in an inner top-level */ /** + `read-only flag, that tells if Prolog is in an inner top-level */
YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL), YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL),
YAP_FLAG( CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true" , NULL ), /** + `call_counting` YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL), /** + `call_counting`
Predicates compiled with this flag set maintain a counter on the numbers of proceduree calls and of retries. These counters are decreasing counters, and they can be used as timers. Three counters are available: Predicates compiled with this flag set maintain a counter
on the numbers of proceduree calls and of retries. These counters
are decreasing counters, and they can be used as timers. Three
counters are available:
calls: number of predicate calls since execution started or since system was reset; calls: number of predicate calls since execution started or
retries: number of retries for predicates called since execution started or since counters were reset; since system was reset; retries: number of retries for predicates
calls_and_retries: count both on predicate calls and retries. called since execution started or since counters were reset;
These counters can be used to find out how many calls a certain goal takes to execute. They can also be force the computatiom yp calls_and_retries: count both on predicate calls and
stopping. retries. These counters can be used to find out how many calls a
certain goal takes to execute. They can also be force the
computatiom yp stopping.
If `on` `fileerrors` is `on`, if `off` (default) If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled. `fileerrors` is disabled.
*/ */
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc), YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /** + `fileerrors` YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default) If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled. `fileerrors` is disabled.
*/ */
YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /** + `language_mode` YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), /** + `language_mode`
wweter native mode or trying to emulate a different Prolog. wweter native mode or trying to emulate a different Prolog.
*/ */
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /** + `redefine_warnings ` YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag,
"true", NULL), /** + `stack_dump_on_error `
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
`off`. If _Value_ is bound to `on` enable these warnings,
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
*/
YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, "true" , NULL ), /** + `single_var_warnings`
If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton.
*/
YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, "false" , NULL ), /** + `stack_dump_on_error `
If `true` show a stack dump when YAP finds an error. The default is If `true` show a stack dump when YAP finds an error. The default is
`off`. `off`.
*/ */
YAP_FLAG( STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose" , NULL ), YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error" , NULL ), /** + `syntax_errors` NULL),
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL), /** + `syntax_errors`
Control action to be taken after syntax errors while executing read/1, Control action to be taken after syntax errors while executing read/1,
`read/2`, or `read_term/3`: `read/2`, or `read_term/3`:
@ -88,14 +85,16 @@ Report the syntax error and generate an error (default).
+ `quiet` + `quiet`
Just fail Just fail
*/ */
YAP_FLAG( TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user" , typein ), /** + `typein_module ` YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein), /** + `typein_module `
If bound, set the current working or type-in module to the argument, If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current which must be an atom. If unbound, unify the argument with the current
working module. working module.
*/ */
YAP_FLAG( USER_ERROR_FLAG, "user_error", true, stream, "user_error" , set_error_stream ), /** + `user_error1` YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error",
set_error_stream), /** + `user_error1`
If the second argument is bound to a stream, set user_error to If the second argument is bound to a stream, set user_error to
this stream. If the second argument is unbound, unify the argument with this stream. If the second argument is unbound, unify the argument with
@ -126,8 +125,10 @@ prompts from the system were redirected to the stream
automatically redirects the user_error alias to the original automatically redirects the user_error alias to the original
`stderr`. `stderr`.
*/ */
YAP_FLAG( USER_INPUT_FLAG, "user_input", true, stream, "user_input" , set_input_stream ), YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input",
YAP_FLAG( USER_OUTPUT_FLAG, "user_output", true, stream, "user_output" , set_output_stream ), set_input_stream),
YAP_FLAG(USER_OUTPUT_FLAG, "user_output", true, stream, "user_output",
set_output_stream),
END_LOCAL_FLAGS END_LOCAL_FLAGS

1
H/Yapproto.h
View File

@ -35,6 +35,7 @@ extern int Yap_HasOp(Atom);
extern struct operator_entry * extern struct operator_entry *
Yap_GetOpPropForAModuleHavingALock(struct AtomEntryStruct *, Term); Yap_GetOpPropForAModuleHavingALock(struct AtomEntryStruct *, Term);
extern Atom Yap_LookupAtom(const char *); extern Atom Yap_LookupAtom(const char *);
extern Atom Yap_AtomInUse(const char *atom);
extern Atom Yap_ULookupAtom(const unsigned char *); extern Atom Yap_ULookupAtom(const unsigned char *);
extern Atom Yap_LookupAtomWithLength(const char *, size_t); extern Atom Yap_LookupAtomWithLength(const char *, size_t);
extern Atom Yap_FullLookupAtom(const char *); extern Atom Yap_FullLookupAtom(const char *);

2
H/Yatom.h
View File

@ -1298,7 +1298,7 @@ INLINE_ONLY bool IsFlagProperty(PropFlags flags) {
/* Proto types */ /* Proto types */
extern char *Yap_TermToBuffer(Term t, encoding_t encoding, int flags); extern char *Yap_TermToBuffer(Term t, int flags);
extern Term Yap_BufferToTerm(const char *s, Term opts); extern Term Yap_BufferToTerm(const char *s, Term opts);

31
cmake/FindLibR.cmake
View File

@ -1,7 +1,7 @@
# #
# FindLibR.cmake # FindLibR.cmake
# #
# Copyright (C) 2009-11 by RStudio, Inc. # Copyright (C) 2009-18 by RStudio, Inc.
# #
# This program is licensed to you under the terms of version 3 of the # This program is licensed to you under the terms of version 3 of the
# GNU Affero General Public License. This program is distributed WITHOUT # GNU Affero General Public License. This program is distributed WITHOUT
@ -21,11 +21,24 @@
if(APPLE) if(APPLE)
find_library(LIBR_LIBRARIES R) find_library(LIBR_LIBRARIES R)
if(LIBR_LIBRARIES)
if(LIBR_LIBRARIES MATCHES ".*\\.framework")
set(LIBR_HOME "${LIBR_LIBRARIES}/Resources" CACHE PATH "R home directory") set(LIBR_HOME "${LIBR_LIBRARIES}/Resources" CACHE PATH "R home directory")
set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory") set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory")
set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory") set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory")
set(LIBR_EXECUTABLE "${LIBR_HOME}/R" CACHE PATH "R executable") set(LIBR_EXECUTABLE "${LIBR_HOME}/R" CACHE PATH "R executable")
else()
get_filename_component(_LIBR_LIBRARIES "${LIBR_LIBRARIES}" REALPATH)
get_filename_component(_LIBR_LIBRARIES_DIR "${_LIBR_LIBRARIES}" PATH)
set(LIBR_EXECUTABLE "${_LIBR_LIBRARIES_DIR}/../bin/R")
execute_process(
COMMAND ${LIBR_EXECUTABLE} "--slave" "--vanilla" "-e" "cat(R.home())"
OUTPUT_VARIABLE LIBR_HOME
)
set(LIBR_HOME ${LIBR_HOME} CACHE PATH "R home directory")
set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory")
set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory")
set(LIBR_LIB_DIR "${LIBR_HOME}/lib" CACHE PATH "R lib directory")
endif() endif()
# detection for UNIX & Win32 # detection for UNIX & Win32
@ -103,12 +116,15 @@ else()
set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory") set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory")
set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory") set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory")
# set library hint path based on whether we are doing a special session 64 build # set library hint path for 64-bit build
if(LIBR_FIND_WINDOWS_64BIT) set(LIBR_ARCH "x64")
set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64") set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64")
else()
set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/i386") # call dll2lib.R to ensure export files are generated
endif() execute_process(
COMMAND "${LIBR_HOME}/bin/${LIBR_ARCH}/Rscript.exe" "dll2lib.R"
WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}/tools"
RESULT_VARIABLE LIBR_DLL2LIB_RESULT)
endif() endif()
@ -173,6 +189,7 @@ find_package_handle_standard_args(LibR DEFAULT_MSG
if(LIBR_FOUND) if(LIBR_FOUND)
message(STATUS "Found R: ${LIBR_HOME}") message(STATUS "Found R: ${LIBR_HOME}")
get_filename_component(LIBR_BIN_DIR "${LIBR_EXECUTABLE}" PATH CACHE)
endif() endif()
# mark low-level variables from FIND_* calls as advanced # mark low-level variables from FIND_* calls as advanced

2
include/YapDefs.h
View File

@ -203,6 +203,8 @@ typedef struct yap_boot_params {
const char *INPUT_STARTUP; const char *INPUT_STARTUP;
//> bootstrapping mode: YAP is not properly installed //> bootstrapping mode: YAP is not properly installed
bool install; bool install;
//> jupyter mode: YAP is in space
bool jupyter;
//> generats a saved space at this path //> generats a saved space at this path
const char *OUTPUT_STARTUP; const char *OUTPUT_STARTUP;
//> if NON-0, minimal size for Heap or Code Area //> if NON-0, minimal size for Heap or Code Area

13
library/dialect/swi/fli/swi.c
View File

@ -70,7 +70,6 @@ Moyle. All rights reserved.
static atom_t ATOM_nil; static atom_t ATOM_nil;
extern int PL_unify_termv(term_t l, va_list args);
extern X_API Atom YAP_AtomFromSWIAtom(atom_t at); extern X_API Atom YAP_AtomFromSWIAtom(atom_t at);
extern X_API atom_t YAP_SWIAtomFromAtom(Atom at); extern X_API atom_t YAP_SWIAtomFromAtom(Atom at);
@ -818,6 +817,14 @@ X_API int PL_unify_bool(term_t t, int a) {
return Yap_unify(Yap_GetFromSlot(t), iterm); return Yap_unify(Yap_GetFromSlot(t), iterm);
} }
X_API int PL_put_bool(term_t t, int a) {
CACHE_REGS
CELL *pt = Yap_AddressFromHandle( t );
Term iterm = (a ? MkAtomTerm(AtomTrue) : MkAtomTerm(AtomFalse));
*pt = iterm;
return true;
}
#if USE_GMP #if USE_GMP
/******************************* /*******************************
@ -1273,7 +1280,7 @@ YAP: NO EQUIVALENT */
X_API int PL_raise_exception(term_t exception) { X_API int PL_raise_exception(term_t exception) {
CACHE_REGS CACHE_REGS
LOCAL_Error_TYPE = THROW_EVENT; LOCAL_Error_TYPE = THROW_EVENT;
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(Yap_GetFromHandle(exception), LOCAL_encoding, TermNil); LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(Yap_GetFromHandle(exception), 0);
//Yap_PutException(Yap_GetFromSlot(exception)); //Yap_PutException(Yap_GetFromSlot(exception));
Yap_RaiseException(); Yap_RaiseException();
return 0; return 0;
@ -1321,7 +1328,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s) {
Atom at; Atom at;
while ((at = Yap_CharsToAtom(s, ENC_ISO_LATIN1 PASS_REGS)) == 0L) { while ((at = Yap_CharsToAtom(s, ENC_ISO_LATIN1 PASS_REGS)) == 0L) {
if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_unify_atom_nchars")) if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_unify_atom_nchars"))
return FALSE; return true;
} }
Yap_AtomIncreaseHold(at); Yap_AtomIncreaseHold(at);
return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at)); return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at));

7
os/charsio.c
View File

@ -990,16 +990,11 @@ leaving the current stream position unaltered.
*/ */
static Int peek_code(USES_REGS1) { /* at_end_of_stream */ static Int peek_code(USES_REGS1) { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek_code/2");
Int ch; Int ch;
if (sno < 0) if (sno < 0)
return FALSE; return FALSE;
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2");
return FALSE;
}
if ((ch = Yap_peek(sno)) < 0) { if ((ch = Yap_peek(sno)) < 0) {
#ifdef PEEK_EOF #ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);

52
os/fmem.c
View File

@ -203,7 +203,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
return -1; return -1;
st = GLOBAL_Stream + sno; st = GLOBAL_Stream + sno;
st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f; st->status = Output_Stream_f | InMemory_Stream_f;
if (st->nbuf)
st->status |= FreeOnClose_Stream_f;
st->linepos = 0; st->linepos = 0;
st->charcount = 0; st->charcount = 0;
st->linecount = 1; st->linecount = 1;
@ -212,15 +214,15 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->buf.on = true; st->buf.on = true;
st->nbuf = NULL; st->nbuf = NULL;
st->nsize = 0; st->nsize = 0;
st->status |= Seekable_Stream_f;
#if HAVE_OPEN_MEMSTREAM #if HAVE_OPEN_MEMSTREAM
st->file = open_memstream(&st->nbuf, &st->nsize); st->file = open_memstream(&st->nbuf, &st->nsize);
// setbuf(st->file, NULL); // setbuf(st->file, NULL);
st->status |= Seekable_Stream_f;
#else
st->file = fmemopen((void *)st->nbuf, st->nsize, "w");
if (!st->nbuf) { if (!st->nbuf) {
return -1; return -1;
} }
#else
st->file = fmemopen((void *)st->nbuf, st->nsize, "w+");
#endif #endif
Yap_DefaultStreamOps(st); Yap_DefaultStreamOps(st);
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
@ -257,35 +259,41 @@ open_mem_write_stream(USES_REGS1) /* $open_mem_write_stream(-Stream) */
* by other writes.. * by other writes..
*/ */
char *Yap_MemExportStreamPtr(int sno) { char *Yap_MemExportStreamPtr(int sno) {
char *s;
if (fflush(GLOBAL_Stream[sno].file) == 0) { if (fflush(GLOBAL_Stream[sno].file) < 0) {
s = GLOBAL_Stream[sno].nbuf;
// s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0';
return s;
}
return NULL; return NULL;
} }
size_t len = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END);
char *buf = malloc(len+1);
#if HAVE_OPEN_MEMSTREAM
char *s = GLOBAL_Stream[sno].nbuf;
memcpy(buf, s, len);
// s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0';
#else
fread(buf, sz, 1, GLOBAL_Stream[sno].file);
#endif
buf[len] = '\0';
return buf;
}
static Int peek_mem_write_stream( static Int peek_mem_write_stream(
USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */ USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */
Int sno = Int sno =
Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2"); Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2");
Int i;
Term tf = ARG2; Term tf = ARG2;
CELL *HI; CELL *HI;
const char *ptr; char *ptr;
int ch;
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
char *p = ptr = Yap_MemExportStreamPtr(sno);
restart: restart:
HI = HR; HI = HR;
if (fflush(GLOBAL_Stream[sno].file) == 0) { while ((ch = *p++)) {
i = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END); HR[0] = MkIntTerm(ch);
ptr = GLOBAL_Stream[sno].nbuf; HR[1] = AbsPair(HR+2);
} HR += 2;
while (i > 0) {
--i;
tf = MkPairTerm(MkIntTerm(ptr[i]), tf);
if (HR + 1024 >= ASP) { if (HR + 1024 >= ASP) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
HR = HI; HR = HI;
@ -294,14 +302,14 @@ restart:
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return (FALSE); return (FALSE);
} }
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
goto restart; goto restart;
} }
} }
HR[-1] = tf;
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify(ARG3, tf)); free(ptr);
return (Yap_unify(ARG3, AbsPair(HI)));
} }
void Yap_MemOps(StreamDesc *st) { void Yap_MemOps(StreamDesc *st) {

26
os/iopreds.c
View File

@ -1129,12 +1129,13 @@ static void check_bom(int sno, StreamDesc *st) {
bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode, bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode,
Term file_name, encoding_t encoding, stream_flags_t flags, Term file_name, encoding_t encoding, stream_flags_t flags,
void *vfs) { void *vfs) {
fprintf(stderr,"+ %s --> %d\n", name, sno); // fprintf(stderr,"+ %s --> %d\n", name, sno);
StreamDesc *st = &GLOBAL_Stream[sno]; StreamDesc *st = &GLOBAL_Stream[sno];
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", __android_log_print(
io_mode, CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", io_mode,
name, CurrentModule == 0 ? "prolog"
sno); : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
name, sno);
if (io_mode == NULL) if (io_mode == NULL)
Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno), Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno),
"File opened with NULL Permissions"); "File opened with NULL Permissions");
@ -1232,14 +1233,11 @@ typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t;
static const param_t open_defs[] = {OPEN_DEFS()}; static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR #undef PAR
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, Term user_name, Term user_name, encoding_t enc) {
encoding_t enc)
{
struct vfs *vfsp = NULL; struct vfs *vfsp = NULL;
const char *fname; const char *fname;
if (IsAtomTerm(tin)) if (IsAtomTerm(tin))
fname = RepAtom(AtomOfTerm(tin))->StrOfAE; fname = RepAtom(AtomOfTerm(tin))->StrOfAE;
else if (IsStringTerm(tin)) else if (IsStringTerm(tin))
@ -1292,7 +1290,8 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
buf = pop_output_text_stack(i, buf); buf = pop_output_text_stack(i, buf);
Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf, 32)); Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf, 32));
sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding, sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding,
MEM_BUF_MALLOC, nat, MkAtomTerm(NameOfFunctor(f))); MEM_BUF_MALLOC, nat,
MkAtomTerm(NameOfFunctor(f)));
return Yap_OpenBufWriteStream(PASS_REGS1); return Yap_OpenBufWriteStream(PASS_REGS1);
} }
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) { } else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
@ -1365,8 +1364,8 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
open_mode = AtomOfTerm(t2); open_mode = AtomOfTerm(t2);
} }
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END, xarg *args =
DOMAIN_ERROR_OPEN_OPTION); Yap_ArgListToVector(tlist, open_defs, OPEN_END, DOMAIN_ERROR_OPEN_OPTION);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3"); Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
@ -1671,7 +1670,6 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
st = GLOBAL_Stream + sno; st = GLOBAL_Stream + sno;
// fname = Yap_VF(fname); // fname = Yap_VF(fname);
if (fill_stream(sno, st, tin, io_mode, user_name, enc)) if (fill_stream(sno, st, tin, io_mode, user_name, enc))
return sno; return sno;
return -1; return -1;

15
os/streams.c
View File

@ -683,7 +683,7 @@ static xarg *generate_property(int sno, Term t2,
} }
static Int cont_stream_property(USES_REGS1) { /* current_stream */ static Int cont_stream_property(USES_REGS1) { /* current_stream */
bool det; bool det = false;
xarg *args; xarg *args;
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1)); int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
stream_property_choices_t p = STREAM_PROPERTY_END; stream_property_choices_t p = STREAM_PROPERTY_END;
@ -705,7 +705,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION;
Yap_Error(LOCAL_Error_TYPE, t2, NULL); Yap_ThrowError(LOCAL_Error_TYPE, t2, NULL);
return false; return false;
} }
cut_fail(); cut_fail();
@ -714,16 +714,17 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) { if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) {
// one solution only // one solution only
i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue)); i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue));
free(args) UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) { if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) {
free(args);
cut_fail(); cut_fail();
} }
cut_succeed(); det = true;
} }
LOCK(GLOBAL_Stream[i].streamlock); LOCK(GLOBAL_Stream[i].streamlock);
rc = do_stream_property(i, args PASS_REGS); rc = do_stream_property(i, args PASS_REGS);
UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
if (IsVarTerm(t1)) { if (!det && IsVarTerm(t1)) {
if (rc) if (rc)
rc = Yap_unify(ARG1, Yap_MkStream(i)); rc = Yap_unify(ARG1, Yap_MkStream(i));
if (p == STREAM_PROPERTY_END) { if (p == STREAM_PROPERTY_END) {
@ -743,7 +744,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
} }
} else { } else {
// done // done
det = (p == STREAM_PROPERTY_END); det = det || (p == STREAM_PROPERTY_END);
} }
free(args); free(args);
if (rc) { if (rc) {
@ -998,7 +999,7 @@ static void CloseStream(int sno) {
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>", // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>",
// sno); // sno);
VFS_t *me; VFS_t *me;
fprintf( stderr, "- %d\n",sno); //fprintf( stderr, "- %d\n",sno);
if ((me = GLOBAL_Stream[sno].vfs) != NULL && if ((me = GLOBAL_Stream[sno].vfs) != NULL &&
GLOBAL_Stream[sno].file == NULL) { GLOBAL_Stream[sno].file == NULL) {
if (me->close) { if (me->close) {

23
os/writeterm.c
View File

@ -672,7 +672,7 @@ static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1); Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s; const char *s;
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
s = Yap_TermToBuffer(ARG1, LOCAL_encoding, Quote_illegal_f | Handle_vars_f); s = Yap_TermToBuffer(t1, Quote_illegal_f | Handle_vars_f);
if (!s || !MkStringTerm(s)) { if (!s || !MkStringTerm(s)) {
Yap_Error(RESOURCE_ERROR_HEAP, t1, Yap_Error(RESOURCE_ERROR_HEAP, t1,
"Could not get memory from the operating system"); "Could not get memory from the operating system");
@ -692,7 +692,7 @@ static Int term_to_atom(USES_REGS1) {
Term t2 = Deref(ARG2), ctl, rc = false; Term t2 = Deref(ARG2), ctl, rc = false;
Atom at; Atom at;
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
const char *s = Yap_TermToBuffer(Deref(ARG1), LOCAL_encoding, const char *s = Yap_TermToBuffer(Deref(ARG1),
Quote_illegal_f | Handle_vars_f); Quote_illegal_f | Handle_vars_f);
if (!s || !(at = Yap_UTF8ToAtom((const unsigned char *)s))) { if (!s || !(at = Yap_UTF8ToAtom((const unsigned char *)s))) {
Yap_Error(RESOURCE_ERROR_HEAP, t2, Yap_Error(RESOURCE_ERROR_HEAP, t2,
@ -711,6 +711,25 @@ static Int term_to_atom(USES_REGS1) {
Yap_unify(rc, ARG1); Yap_unify(rc, ARG1);
} }
char *Yap_TermToBuffer(Term t, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags);
if (sno < 0)
return NULL;
if (t == 0)
return NULL;
else
t = Deref(t);
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
char *new = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
return new;
}
void Yap_InitWriteTPreds(void) { void Yap_InitWriteTPreds(void) {
Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag); Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag);
Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag); Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag);

2
os/yapio.h
View File

@ -89,7 +89,7 @@ extern int Yap_GetCharForSIGINT(void);
extern Int Yap_StreamToFileNo(Term); extern Int Yap_StreamToFileNo(Term);
extern int Yap_OpenStream(Term tin, const char* io_mode, Term user_name, encoding_t enc); extern int Yap_OpenStream(Term tin, const char* io_mode, Term user_name, encoding_t enc);
extern int Yap_FileStream(FILE*, char *, Term, int, VFS_t *); extern int Yap_FileStream(FILE*, char *, Term, int, VFS_t *);
extern char *Yap_TermToBuffer(Term t, encoding_t encoding, int flags); extern char *Yap_TermToBuffer(Term t, int flags);
extern char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, extern char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length,
encoding_t *encoding, int flags); encoding_t *encoding, int flags);
extern int Yap_GetFreeStreamD(void); extern int Yap_GetFreeStreamD(void);

28
packages/python/py2pl.c
View File

@ -50,7 +50,8 @@ foreign_t assign_to_symbol(term_t t, PyObject *e) {
return PyObject_SetAttrString(dic, s, e) == 0; return PyObject_SetAttrString(dic, s, e) == 0;
} }
foreign_t python_to_term(PyObject *pVal, term_t t) { foreign_t python_to_term(PyObject *pVal, term_t t)
{
bool rc = true; bool rc = true;
term_t to = PL_new_term_ref(); term_t to = PL_new_term_ref();
// fputs(" <<*** ",stderr); PyObject_Print(pVal,stderr,0); // fputs(" <<*** ",stderr); PyObject_Print(pVal,stderr,0);
@ -89,10 +90,10 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
#else #else
const char *s = PyUnicode_AsUTF8(pVal); const char *s = PyUnicode_AsUTF8(pVal);
#endif #endif
// if (PyDict_GetItemString(py_Atoms, s)) if (Yap_AtomInUse(s))
// rc = rc && PL_unify_atom_chars(t, s);
// else
rc = rc && PL_unify_atom_chars(t, s); rc = rc && PL_unify_atom_chars(t, s);
else
rc = rc && PL_unify_string_chars(t, s);
} else if (PyByteArray_Check(pVal)) { } else if (PyByteArray_Check(pVal)) {
rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal)); rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal));
#if PY_MAJOR_VERSION < 3 #if PY_MAJOR_VERSION < 3
@ -130,15 +131,18 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
} }
if (PL_unify_functor(t, f)) { if (PL_unify_functor(t, f)) {
for (i = 0; i < sz; i++) { for (i = 0; i < sz; i++) {
term_t to = PL_new_term_ref();
if (!PL_get_arg(i + 1, t, to)) if (!PL_get_arg(i + 1, t, to))
rc = false; rc = false;
PyObject *p = PyTuple_GetItem(pVal, i); PyObject *p = PyTuple_GetItem(pVal, i);
if (p == NULL) { if (p == NULL) {
PyErr_Clear(); PyErr_Clear();
p = Py_None; p = Py_None;
} } else {
rc = rc && python_to_term(p, to); rc = rc && python_to_term(p, to);
} }
PL_reset_term_refs(to);
}
} else { } else {
rc = false; rc = false;
} }
@ -150,11 +154,13 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
for (i = 0; i < sz; i++) { for (i = 0; i < sz; i++) {
PyObject *obj; PyObject *obj;
term_t to = PL_new_term_ref();
rc = rc && PL_unify_list(t, to, t); rc = rc && PL_unify_list(t, to, t);
if ((obj = PyList_GetItem(pVal, i)) == NULL) { if ((obj = PyList_GetItem(pVal, i)) == NULL) {
obj = Py_None; obj = Py_None;
} }
rc = rc && python_to_term(obj, to); rc = rc && python_to_term(obj, to);
PL_reset_term_refs(to);
if (!rc) if (!rc)
return false; return false;
} }
@ -163,7 +169,6 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
// Yap_DebugPlWrite(yt); fputs("[***]\n", stderr); // Yap_DebugPlWrite(yt); fputs("[***]\n", stderr);
} else if (PyDict_Check(pVal)) { } else if (PyDict_Check(pVal)) {
Py_ssize_t pos = 0; Py_ssize_t pos = 0;
term_t to = PL_new_term_ref(), ti = to;
int left = PyDict_Size(pVal); int left = PyDict_Size(pVal);
PyObject *key, *value; PyObject *key, *value;
@ -173,6 +178,7 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
while (PyDict_Next(pVal, &pos, &key, &value)) { while (PyDict_Next(pVal, &pos, &key, &value)) {
term_t tkey = PL_new_term_ref(), tval = PL_new_term_ref(), tint, term_t tkey = PL_new_term_ref(), tval = PL_new_term_ref(), tint,
tnew = PL_new_term_ref(); tnew = PL_new_term_ref();
term_t to = PL_new_term_ref();
/* do something interesting with the values... */ /* do something interesting with the values... */
if (!python_to_term(key, tkey)) { if (!python_to_term(key, tkey)) {
continue; continue;
@ -191,21 +197,22 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
PL_reset_term_refs(tkey); PL_reset_term_refs(tkey);
rc = false; rc = false;
} }
if (!PL_unify(ti, tint)) { if (!PL_unify(to, tint)) {
rc = false; rc = false;
} }
ti = tnew;
PL_reset_term_refs(tkey);
} }
rc = rc && PL_unify(t, to); rc = rc && PL_unify(t, to);
} }
} else { } else {
rc = rc && repr_term(pVal, t); rc = rc && repr_term(pVal, t);
} }
PL_reset_term_refs(to);
return rc; return rc;
} }
X_API YAP_Term pythonToYAP(PyObject *pVal) { X_API YAP_Term pythonToYAP(PyObject *pVal) {
term_t t = PL_new_term_ref(); term_t t = PL_new_term_ref();
@ -221,6 +228,7 @@ X_API YAP_Term pythonToYAP(PyObject *pVal) {
PyObject *py_Local, *py_Global; PyObject *py_Local, *py_Global;
/** /**
* assigns the Python RHS to a Prolog term LHS, ie LHS = RHS * assigns the Python RHS to a Prolog term LHS, ie LHS = RHS
* *

12
packages/python/swig/yap4py/yapi.py
View File

@ -41,6 +41,18 @@ class Engine( YAPEngine ):
self.goal(release) self.goal(release)
class JupyterEngine( Engine ):
def __init__(self, args=None,self_contained=False,**kwargs):
# type: (object) -> object
if not args:
args = EngineArgs(**kwargs)
args.jupyter = True
Engine.__init__(self, args)
self.goal(set_prolog_flag('verbose', 'silent'),True)
self.goal(compile(library('jupyter')), True)
self.goal(set_prolog_flag('verbose', 'normal'), True)
class EngineArgs( YAPEngineArgs ): class EngineArgs( YAPEngineArgs ):
""" Interface to Engine Options class""" """ Interface to Engine Options class"""
def __init__(self, args=None,**kwargs): def __init__(self, args=None,**kwargs):

3
packages/python/yap_kernel/CMakeLists.txt
View File

@ -281,6 +281,7 @@ set (RENAMED_RESOURCES
) )
set (PL_SOURCES yap_ipython/prolog/jupyter.yap yap_ipython/prolog/complete.yap set (PL_SOURCES yap_ipython/prolog/jupyter.yap yap_ipython/prolog/complete.yap
yap_ipython/prolog/verify.yap
) )
set(FILES ${PYTHON_SOURCES} ${PL_SOURCES} ${EXTRAS} ${RESOURCES}) set(FILES ${PYTHON_SOURCES} ${PL_SOURCES} ${EXTRAS} ${RESOURCES})
@ -326,6 +327,8 @@ add_custom_target(YAP_KERNEL ALL
COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps . COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps .
COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec
ERROR_VARIABLE setupErr
OUTPUT_VARIABLE setupOut
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})") WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})")
install(FILES ${PL_SOURCES} DESTINATION ${libpl} ) install(FILES ${PL_SOURCES} DESTINATION ${libpl} )

54
packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap
View File

@ -4,6 +4,7 @@
* @brief JUpyter support. * @brief JUpyter support.
*/ */
:- yap_flag(gc_trace,verbose).
% :- module( jupyter, % :- module( jupyter,
% [jupyter_query/3, % [jupyter_query/3,
@ -35,7 +36,11 @@ jupyter_cell( _Caller, _, Line ) :-
!. !.
jupyter_cell( Caller, _, Line ) :- jupyter_cell( Caller, _, Line ) :-
Self := Caller.query, Self := Caller.query,
python_query(Self,Line). catch(
python_query(Self,Line),
E=error(A,B),
system_error(A,B)
).
restreams(call) :- restreams(call) :-
streams(true). streams(true).
@ -55,42 +60,37 @@ jupyter_consult(Cell) :-
% Name = 'Inp', % Name = 'Inp',
% stream_property(Stream, file_name(Name) ), % stream_property(Stream, file_name(Name) ),
% setup_call_cleanup( % setup_call_cleanup(
catch(
(
Options = [],
open_mem_read_stream( Cell, Stream), open_mem_read_stream( Cell, Stream),
load_files(user:'jupyter cell',[stream(Stream)]). load_files(user:'jupyter cell',[stream(Stream)| Options])
),
E=error(A,B),
(close(Stream), system_error(A,B))
),
fail.
jupyter_consult(_Cell).
blank(Text) :- blank(Text) :-
atom(Text),
!,
atom_codes(Text, L), atom_codes(Text, L),
maplist( code_type(space), L). maplist( code_type(space), L).
blank(Text) :-
:- dynamic cell_stream/1. string(Text),
!,
string_codes(Text, L),
maplist( code_type(space), L).
streams(false) :- streams(false) :-
nb_setval(jupyter_cell, false), close(user_input),
retract(cell_stream(S)), close(user_output),
close(S), close(user_error).
fail.
streams(false).
streams(true) :- streams(true) :-
streams( false ),
nb_setval(jupyter_cell, true),
% \+ current_stream('/python/input',_,_),
open('/python/input', read, Input, [alias(user_input),bom(false),script(false)]), open('/python/input', read, Input, [alias(user_input),bom(false),script(false)]),
assert( cell_stream( Input) ),
set_prolog_flag(user_input,Input),
fail.
streams(true) :-
% \+ current_stream('/python/sys.stdout',_,_),
open('/python/sys.stdout', append, Output, [alias(user_output)]), open('/python/sys.stdout', append, Output, [alias(user_output)]),
set_prolog_flag(user_output, Output), open('/python/sys.stderr', append, Error, [alias(user_error)]).
assert( cell_stream( Output) ),
fail.
streams(true) :-
% \+ current_stream('/python/sys.stderr',_,_),
open('/python/sys.stderr', append, Error, [alias(user_error)]),
assert( cell_stream( Error) ),
set_prolog_flag(user_error, Error),
fail.
streams(true).
ready(_Self, Line ) :- ready(_Self, Line ) :-
blank( Line ), blank( Line ),

62
packages/python/yap_kernel/yap_ipython/prolog/verify.yap Normal file
View File

@ -0,0 +1,62 @@
/**
* @file jupyter.yap4py
*
* @brief JUpyter support.
*/
% :- module( verify,
% [all_clear/4,
% errors/2,
% ready/2,
s % completion/2,
% ]
%% ).
:- use_module(library(hacks)).
:- use_module(library(lists)).
:- use_module(library(maplist)).
:- use_module(library(python)).
:- use_module(library(yapi)).
:- python_import(sys).
p_errors( Errors, Cell) :-
blank( Cell ),
!.
p_errors( Errors, Cell) :-
no_errors( Errors , Cell ).
no_errors( _Errors , Text ) :-
blank(Text).
no_errors( Errors , Text ) :-
setup_call_cleanup(
open_esh( Errors , Text, Stream),
esh(Errors , Stream),
close_esh( Errors , Stream )
).
syntax(_Errors , E) :- writeln(user_error, E), fail.
syntax(Errors , error(syntax_error(Cause),info(between(_,LN,_), _FileName, CharPos, Details))) :-
Errors.errors := [t(Cause,LN,CharPos,Details)] + Errors.errors,
!.
syntax(_Errors , E) :- throw(E).
open_esh(_Errors , Text, Stream) :-
open_mem_read_stream( Text, Stream ).
esh(Errors , Stream) :-
repeat,
catch(
read_clause(Stream, Cl, [term_position(_Pos), syntax_errors(fail)] ),
Error,
syntax(Errors , Error)
),
Cl == end_of_file,
!.
close_esh( _Errors , Stream ) :-
close(Stream).

6
packages/python/yap_kernel/yap_ipython/yapi.py
View File

@ -510,10 +510,9 @@ class YAPRun:
def __init__(self, shell): def __init__(self, shell):
self.shell = shell self.shell = shell
self.yapeng = Engine() self.yapeng = JupyterEngine()
global engine global engine
engine = self.yapeng engine = self.yapeng
self.yapeng.goal(use_module(library("jupyter")),True)
self.query = None self.query = None
self.os = None self.os = None
self.it = None self.it = None
@ -573,7 +572,6 @@ class YAPRun:
except Exception as e: except Exception as e:
sys.stderr.write('Exception after', self.bindings, '\n') sys.stderr.write('Exception after', self.bindings, '\n')
has_raised = True has_raised = True
self.yapeng.mgoal(streams(False),"user", True)
return False,[] return False,[]
@ -730,13 +728,13 @@ class YAPRun:
# state = tracer.runfunc(jupyter_query( self, cell ) ) # state = tracer.runfunc(jupyter_query( self, cell ) )
self.shell.last_execution_succeeded = True self.shell.last_execution_succeeded = True
self.result.result = (True, dicts) self.result.result = (True, dicts)
self.yapeng.mgoal(streams(False),"user", True)
except Exception as e: except Exception as e:
has_raised = True has_raised = True
self.result.result = False self.result.result = False
self.yapeng.mgoal(streams(False),"user", True) self.yapeng.mgoal(streams(False),"user", True)
self.yapeng.mgoal(streams(False),"user", True)
self.shell.last_execution_succeeded = not has_raised self.shell.last_execution_succeeded = not has_raised
# Reset this so later displayed values do not modify the # Reset this so later displayed values do not modify the

30
packages/real/CMakeLists.txt
View File

@ -2,30 +2,12 @@
# PROJECT ( YAP_REAL C ) # PROJECT ( YAP_REAL C )
#
# - This module locates an installed R distribution. # LIBR_FOUND
# # LIBR_HOME
# Defines the following: # LIBR_INCLUDE_DIRS
# R_COMMAND - Path to R command # LIBR_DOC_DIR
# R_HOME - Path to 'R home', as reported by R # LIBR_LIBRARIES
# R_INCLUDE_DIR - Path to R include directory
# R_LIBRARY_BASE - Path to R library
# R_LIBRARY_BLAS - Path to Rblas / blas library
# R_LIBRARY_LAPACK - Path to Rlapack / lapack library
# R_LIBRARY_READLINE - Path to readline library
# R_LIBRARIES - Array of: R_LIBRARY_BASE, R_LIBRARY_BLAS, R_LIBRARY_LAPACK, R_LIBRARY_BASE [, R_LIBRARY_READLINE]
#
# VTK_R_HOME - (deprecated, use R_HOME instead) Path to 'R home', as reported by R
#
# Variable search order:
# 1. Attempt to locate and set R_COMMAND
# If unsuccessful, generate error and prompt user to manually set R_COMMAND
# 2. Use R_COMMAND to set R_HOME
# 3. Locate other libraries in the priority:
# 1. Within a user-built instance of R at R_HOME
# 2. Within an installed instance of R
# 3. Within external system libraries
#
if (R_LIBRARIES AND R_INCLUDE_DIR) if (R_LIBRARIES AND R_INCLUDE_DIR)
set_package_properties(R PROPERTIES set_package_properties(R PROPERTIES

3
pl/absf.yap
View File

@ -302,8 +302,7 @@ absolute_file_name(File0,File) :-
!, !,
F. F.
'$cat_file_name'(File, S) --> '$cat_file_name'(File, S) -->
{string(File), string_to_codes(File, S) }, {string(File), string_codes(File, S) },
!,
S. S.

15
pl/boot.yap
View File

@ -121,9 +121,11 @@ print_message(L,E) :-
). ).
'$undefp0'([M|G], _Action) :- '$undefp0'([M|G], _Action) :-
stream_property( loop_stream, file_name(F)), stream_property( loop_stream, [file_name(F), line_number(L)]),
stream_property( loop_stream, line_number(L)), format(user_error,'~a:~d error undefined:',[F,L]),
format(user_error,'~a:~d error undefined: call to ~w~n',[F,L,M:G]), fail
;
format(user_error,' call to ~w~n',[M:G]),
fail. fail.
:- '$undefp_handler'('$undefp0'(_,_),prolog). :- '$undefp_handler'('$undefp0'(_,_),prolog).
@ -262,6 +264,7 @@ initialize_prolog :-
:- c_compile( 'preds.yap' ). :- c_compile( 'preds.yap' ).
:- c_compile( 'modules.yap' ). :- c_compile( 'modules.yap' ).
:- c_compile( 'grammar.yap' ). :- c_compile( 'grammar.yap' ).
:- c_compile( 'protect.yap' ).
:- ['absf.yap']. :- ['absf.yap'].
@ -314,11 +317,7 @@ initialize_prolog :-
:- multifile prolog:'$system_predicate'/2. :- multifile prolog:'$system_predicate'/2.
:- ['protect.yap']. :- '$opdec'(1150,fx,(mode),prolog).
version(yap,[6,4]).
:- op(1150,fx,(mode)).
:- dynamic 'extensions_to_present_answer'/1. :- dynamic 'extensions_to_present_answer'/1.

107
pl/consult.yap
View File

@ -220,8 +220,10 @@ SWI-compatible option where if _Autoload_ is `true` undefined
% compilation_mode(compact,source,assert_all) => implemented % compilation_mode(compact,source,assert_all) => implemented
% register(true, false) => implemented % register(true, false) => implemented
% %
load_files(Files,Opts) :- load_files(Files0,Opts) :-
'$load_files'(Files,Opts,load_files(Files,Opts)). '$yap_strip_module'(Files0,M,Files),
'$load_files'(Files,M,Opts,M:load_files(Files,Opts)).
'$lf_option'(autoload, 1, false). '$lf_option'(autoload, 1, false).
'$lf_option'(derived_from, 2, false). '$lf_option'(derived_from, 2, false).
@ -232,7 +234,14 @@ load_files(Files,Opts) :-
'$lf_option'(qcompile, 7, Current) :- '$lf_option'(qcompile, 7, Current) :-
'__NB_getval__'('$qcompile', Current, Current = never). '__NB_getval__'('$qcompile', Current, Current = never).
'$lf_option'(silent, 8, _). '$lf_option'(silent, 8, _).
'$lf_option'(skip_unix_header, 9, true). '$lf_option'(skip_unix_header, 9, Skip) :-
stream_property(Stream,[alias(loop_stream),tty(TTy),reposition(Rep)]),
( Rep == true
->
(TTy = true -> Skip = false ; Skip = true)
;
Skip = false
).
'$lf_option'(compilation_mode, 10, Flag) :- '$lf_option'(compilation_mode, 10, Flag) :-
current_prolog_flag(source, YFlag), current_prolog_flag(source, YFlag),
( YFlag == false -> Flag = compact ; Flag = source ). ( YFlag == false -> Flag = compact ; Flag = source ).
@ -271,15 +280,44 @@ load_files(Files,Opts) :-
'$lf_option'(Op, Id, _), '$lf_option'(Op, Id, _),
setarg( Id, TOpts, Val ). setarg( Id, TOpts, Val ).
'$load_files'(Files, Opts, Call) :- '$load_files'([user], M,Opts, Call) :-
( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> current_input(S),
'$lf_opt'(autoload, OldTOpts, OldAutoload) '$load_files__'(user, M, [stream(S)|Opts], Call).
'$load_files'(user, M,Opts, Call) :-
current_input(S),
'$load_files__'(user, M, [stream(S)|Opts], Call).
'$load_files'([-user], M,Opts, Call) :-
current_input(S),
'$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'(-user, M,Opts, Call) :-
current_input(S),
'$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'([user_input], M,Opts, Call) :-
current_input(S),
'$load_files__'(user_input, M, [stream(S)|Opts], Call).
'$load_files'(user_input, M,Opts, Call) :-
current_input(S),
'$load_files__'(user_input, M, [stream(S)|Opts], Call).
'$load_files'([-user_input], M,Opts, Call) :-
current_input(S),
'$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'(-user_input, M,Opts, Call) :-
'$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'(Files, M, Opts, Call) :-
'$load_files__'(Files, M, Opts, Call).
'$load_files__'(Files, M, Opts, Call) :-
'$lf_option'(last_opt, LastOpt),
( '__NB_getval__'('$lf_status', OldTOpts, fail),
nonvar(OldTOpts)
->
'$lf_opt'(autoload, OldTOpts, OldAutoload),
'$lf_opt'('$context_module', OldTOpts, OldContextModule)
; ;
'$lf_option'(last_opt, LastOpt), current_prolog_flag(autoload, OldAutoload),
functor( OldTOpts, opt, LastOpt ), functor( OldTOpts, opt, LastOpt ),
'$lf_opt'('$context_module', OldTOpts, user) '$lf_opt'(autoload, OldTOpts, OldAutoload),
'$lf_opt'('$context_module', OldTOpts, OldContextModule)
), ),
'$lf_option'(last_opt, LastOpt),
functor( TOpts, opt, LastOpt ), functor( TOpts, opt, LastOpt ),
( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ),
'$lf_opt'('$location', TOpts, ParentF:Line), '$lf_opt'('$location', TOpts, ParentF:Line),
@ -297,7 +335,6 @@ load_files(Files,Opts) :-
), ),
'$check_use_module'(Call,UseModule), '$check_use_module'(Call,UseModule),
'$lf_opt'('$use_module', TOpts, UseModule), '$lf_opt'('$use_module', TOpts, UseModule),
'$current_module'(M0),
( '$lf_opt'(autoload, TOpts, Autoload), ( '$lf_opt'(autoload, TOpts, Autoload),
var(Autoload) -> var(Autoload) ->
Autoload = OldAutoload Autoload = OldAutoload
@ -306,7 +343,7 @@ load_files(Files,Opts) :-
), ),
% make sure we can run consult % make sure we can run consult
'$init_consult', '$init_consult',
'$lf'(Files, M0, Call, TOpts). '$lf'(Files, M, Call, TOpts).
'$check_files'(Files, Call) :- '$check_files'(Files, Call) :-
var(Files), !, var(Files), !,
@ -428,32 +465,12 @@ load_files(Files,Opts) :-
'$lf'(V,_,Call, _ ) :- var(V), !, '$lf'(V,_,Call, _ ) :- var(V), !,
'$do_error'(instantiation_error,Call). '$do_error'(instantiation_error,Call).
'$lf'([], _, _, _) :- !. '$lf'([], _, _, _) :- !.
'$lf'(M:X, _, Call, TOpts) :- !,
(
atom(M)
->
'$lf'(X, M, Call, TOpts)
;
'$do_error'(type_error(atom,M),Call)
).
'$lf'([F|Fs], Mod, Call, TOpts) :- !, '$lf'([F|Fs], Mod, Call, TOpts) :- !,
% clean up after each consult % clean up after each consult
( '$lf'(F,Mod,Call, TOpts), fail; ( '$lf'(F,Mod,Call, TOpts), fail;
'$lf'(Fs, Mod, Call, TOpts), fail; '$lf'(Fs, Mod, Call, TOpts), fail;
true true
). ).
'$lf'(user, Mod, Call, TOpts) :-
!,
stream_property( S, alias( user_input )),
'$set_lf_opt'('$from_stream', TOpts, true),
'$set_lf_opt'( stream , TOpts, S),
'$lf'(S, Mod, Call, TOpts).
'$lf'(user_input, Mod, Call, TOpts ) :-
!,
stream_property( S, alias( user_input )),
'$set_lf_opt'('$from_stream', TOpts, true),
'$set_lf_opt'( stream , TOpts, S),
'$lf'(S, Mod, Call, TOpts).
'$lf'(File, Mod, Call, TOpts) :- '$lf'(File, Mod, Call, TOpts) :-
'$lf_opt'(stream, TOpts, Stream), '$lf_opt'(stream, TOpts, Stream),
b_setval('$user_source_file', File), b_setval('$user_source_file', File),
@ -544,10 +561,10 @@ When the files are not module files, ensure_loaded/1 loads them
_F_ must be a list containing the names of the files to load. _F_ must be a list containing the names of the files to load.
*/ */
ensure_loaded(Fs) :- ensure_loaded(Fs) :-
'$load_files'(Fs, [if(not_loaded)],ensure_loaded(Fs)). load_files(Fs, [if(not_loaded)]).
compile(Fs) :- compile(Fs) :-
'$load_files'(Fs, [], compile(Fs)). load_files(Fs, []).
/** /**
@pred [ _F_ ] @pred [ _F_ ]
@ -581,9 +598,9 @@ consult(Fs) :-
'$consult'(Fs,Module) :- '$consult'(Fs,Module) :-
current_prolog_flag(language_mode, iso), % SICStus Prolog compatibility current_prolog_flag(language_mode, iso), % SICStus Prolog compatibility
!, !,
'$load_files'(Module:Fs,[],consult(Fs)). load_files(Module:Fs,[]).
'$consult'(Fs, Module) :- '$consult'(Fs, Module) :-
'$load_files'(Module:Fs,[consult(consult)],consult(Fs)). load_files(Module:Fs,[consult(consult)]).
/** /**
@ -616,7 +633,7 @@ Example:
*/ */
reconsult(Fs) :- reconsult(Fs) :-
'$load_files'(Fs, [], reconsult(Fs)). load_files(Fs, []).
/* exo_files(+ _Files_) /* exo_files(+ _Files_)
@ -636,7 +653,7 @@ different forms of indexing, as shown in @cite x.
*/ */
exo_files(Fs) :- exo_files(Fs) :-
'$load_files'(Fs, [consult(exo), if(not_loaded)], exo_files(Fs)). load_files(Fs, [consult(exo), if(not_loaded)]).
/** /**
@ -667,7 +684,7 @@ YAP implements load_db/1 as a two-step non-optimised process. First,
db_files/1 itself is just a call to load_files/2. db_files/1 itself is just a call to load_files/2.
*/ */
db_files(Fs) :- db_files(Fs) :-
'$load_files'(Fs, [consult(db), if(not_loaded)], exo_files(Fs)). load_files(Fs, [consult(db), if(not_loaded)]).
'$csult'(Fs, _M) :- '$csult'(Fs, _M) :-
@ -677,9 +694,9 @@ db_files(Fs) :-
!. !.
'$csult'(Fs, M) :- '$csult'(Fs, M) :-
'$extract_minus'(Fs, MFs), !, '$extract_minus'(Fs, MFs), !,
'$load_files'(M:MFs,[],[M:Fs]). load_files(M:MFs,[]).
'$csult'(Fs, M) :- '$csult'(Fs, M) :-
'$load_files'(M:Fs,[consult(consult)],[M:Fs]). load_files(M:Fs,[consult(consult)]).
'$extract_minus'([], []). '$extract_minus'([], []).
'$extract_minus'([-F|Fs], [F|MFs]) :- '$extract_minus'([-F|Fs], [F|MFs]) :-
@ -1099,7 +1116,7 @@ just goes through every loaded file and verifies whether reloading is needed.
make :- make :-
recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_), recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_),
'$load_files'(F1, [if(changed)],make), load_files(F1, [if(changed)]),
fail. fail.
make. make.
@ -1260,11 +1277,11 @@ use_module(M,F,Is) :-
'$use_module'(M,M1,F,Is) :- '$use_module'(M,M1,F,Is) :-
nonvar(F), !, nonvar(F), !,
( var(M) -> ( var(M) ->
'$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)), load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)]),
absolute_file_name( F, F1, [expand(true),file_type(prolog)] ), absolute_file_name( F, F1, [expand(true),file_type(prolog)] ),
recorded('$module','$module'(F1,M,_,_,_),_) recorded('$module','$module'(F1,M,_,_,_),_)
; ;
'$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is))
). ).
'$use_module'(M,M1,F,Is) :- '$use_module'(M,M1,F,Is) :-
nonvar(M), !, nonvar(M), !,
@ -1272,11 +1289,11 @@ use_module(M,F,Is) :-
( (
recorded('$module','$module'(F0,M,_,_,_),_) recorded('$module','$module'(F0,M,_,_,_),_)
-> ->
'$load_files'(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) load_files(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)])
; ;
nonvar(F0) nonvar(F0)
-> ->
'$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)])
; ;
'$do_error'(instantiation_error,use_module(M,F,Is)) '$do_error'(instantiation_error,use_module(M,F,Is))
). ).

13
pl/directives.yap
View File

@ -45,7 +45,6 @@
'$include'/2, '$include'/2,
'$initialization'/1, '$initialization'/1,
'$initialization'/2, '$initialization'/2,
'$load_files'/3,
'$require'/2, '$require'/2,
'$set_encoding'/1, '$set_encoding'/1,
'$use_module'/3]). '$use_module'/3]).
@ -176,23 +175,23 @@ considered.
'$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :- '$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :-
set_prolog_flag(F,V). set_prolog_flag(F,V).
'$exec_directive'(ensure_loaded(Fs), _, M, _, _) :- '$exec_directive'(ensure_loaded(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)). load_files(M:Fs, [if(changed)]).
'$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :- '$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :-
char_conversion(IN,OUT). char_conversion(IN,OUT).
'$exec_directive'(public(P), _, M, _, _) :- '$exec_directive'(public(P), _, M, _, _) :-
'$public'(P, M). '$public'(P, M).
'$exec_directive'(compile(Fs), _, M, _, _) :- '$exec_directive'(compile(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], compile(Fs)). load_files(M:Fs, []).
'$exec_directive'(reconsult(Fs), _, M, _, _) :- '$exec_directive'(reconsult(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], reconsult(Fs)). load_files(M:Fs, []).
'$exec_directive'(consult(Fs), _, M, _, _) :- '$exec_directive'(consult(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [consult(consult)], consult(Fs)). load_files(M:Fs, [consult(consult)]).
'$exec_directive'(use_module(F), _, M, _, _) :- '$exec_directive'(use_module(F), _, M, _, _) :-
use_module(M:F). use_module(M:F).
'$exec_directive'(reexport(F), _, M, _, _) :- '$exec_directive'(reexport(F), _, M, _, _) :-
'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)). load_files(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)]).
'$exec_directive'(reexport(F,Spec), _, M, _, _) :- '$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)). load_files(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)]).
'$exec_directive'(use_module(F, Is), _, M, _, _) :- '$exec_directive'(use_module(F, Is), _, M, _, _) :-
use_module(M:F, Is). use_module(M:F, Is).
'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :- '$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-

2
pl/errors.yap
View File

@ -57,7 +57,7 @@ Errors are terms of the form:
* Generate a system error _Error_, informing the possible cause _Cause_. * Generate a system error _Error_, informing the possible cause _Cause_.
* *
*/ */
system_error(Type,Goal) :- prolog:system_error(Type,Goal) :-
'$do_error'(Type,Goal). '$do_error'(Type,Goal).

6
pl/hacks.yap
View File

@ -232,9 +232,9 @@ beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) -->
[(:- Gs)]. [(:- Gs)].
beautify_hidden_goal('$loop'(Stream,Option),prolog) --> beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
[execute_load_file(Stream, consult=Option)]. [execute_load_file(Stream, consult=Option)].
beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) --> beautify_hidden_goal('$load_files'(Files,M,Opts,?),prolog) -->
[load_files(Files,Opts)]. [load_files(M:Files,Opts)].
beautify_hidden_goal('$load_files'(_,_,Name),prolog) --> beautify_hidden_goal('$load_files'(_,_,_,Name),prolog) -->
[Name]. [Name].
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) --> beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)]. [reconsult(Mod:Files)].

8
pl/imports.yap
View File

@ -9,6 +9,11 @@
/** /**
* @ingroup ModuleBuiltins * @ingroup ModuleBuiltins
* @{ * @{
*
* YAP follows the following protovol:
* - predicate is in current module;
* - predicate is in user
* - predicate will be autoloaded, SWI style.
*/ */
:- '$mk_dynamic'('$parent_module'(_,_),prolog). :- '$mk_dynamic'('$parent_module'(_,_),prolog).
@ -22,7 +27,6 @@
'$pred_exists'(G, user). '$pred_exists'(G, user).
% autoload % autoload
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
prolog_flag(autoload, true), prolog_flag(autoload, true),
prolog_flag(unknown, OldUnk, fail), prolog_flag(unknown, OldUnk, fail),
( (
@ -38,7 +42,7 @@
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :-
'$parent_module'(ImportingMod,ExportingModI), '$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G). '$continue_imported'(ExportingMod, ExportingModI, G0, G).
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_predicates'(G, _ImportingMod, G0, ExportingMod) :-
yap_flag(default_parent_module,ExportingModI), yap_flag(default_parent_module,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G). '$continue_imported'(ExportingMod, ExportingModI, G0, G).

11
pl/init.yap
View File

@ -40,10 +40,13 @@
nb_setval('$initialization_goals',off), nb_setval('$initialization_goals',off),
nb_setval('$included_file',[]), nb_setval('$included_file',[]),
nb_setval('$loop_streams',[]), nb_setval('$loop_streams',[]),
\+ '$undefined'('$init_preds',prolog), (
'$init_preds', '$undefined'('$init_preds',prolog)
fail. ->
'$init_consult'. true
;
'$init_preds'
).
'$init_win_graphics' :- '$init_win_graphics' :-
'$undefined'(window_title(_,_), system), !. '$undefined'(window_title(_,_), system), !.

50
pl/messages.yap
View File

@ -259,11 +259,11 @@ location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) }, { '$error_descriptor'(Info, Desc) },
{ {
'$query_exception'(prologPredFile, Desc, File), query_exception(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos), query_exception(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M), query_exception(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na), query_exception(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar) query_exception(prologPredArity, Desc, Ar)
}, },
!, !,
display_consulting( File, Level, Info, LC ), display_consulting( File, Level, Info, LC ),
@ -271,9 +271,9 @@ location( error(_,Info), Level, LC ) -->
location( error(_,Info), Level, LC ) --> location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) }, { '$error_descriptor'(Info, Desc) },
{ {
'$query_exception'(errorFile, Desc, File), query_exception(errorFile, Desc, File),
'$query_exception'(errorLine, Desc, FilePos), query_exception(errorLine, Desc, FilePos),
'$query_exception'(errorFunction, Desc, F) query_exception(errorFunction, Desc, F)
}, },
!, !,
display_consulting( File, Level, Info, LC ), display_consulting( File, Level, Info, LC ),
@ -295,6 +295,10 @@ main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term
[' ~a: failed_processing syntax error term ~q' - [Level,Term]], [' ~a: failed_processing syntax error term ~q' - [Level,Term]],
[nl] [nl]
). ).
main_message( error(syntax_error(_Msg), Info), Level, LC ) -->
!,
[' ~a: syntax error ~s' - [Level,Msg]],
[nl].
main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) --> main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) -->
!, !,
% {writeln(ci)}, % {writeln(ci)},
@ -342,8 +346,8 @@ main_message(error(uninstantiation_error(T),_), Level, _LC) -->
display_consulting( F, Level, Info, LC) --> display_consulting( F, Level, Info, LC) -->
{ LC > 0, { LC > 0,
'$error_descriptor'(Info, Desc), '$error_descriptor'(Info, Desc),
'$query_exception'(prologParserFile, Desc, F0), query_exception(prologParserFile, Desc, F0),
'$query_exception'(prologarserLine, Desc, L), query_exception(prologarserLine, Desc, L),
F \= F0 F \= F0
}, !, }, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
@ -358,7 +362,7 @@ display_consulting(_F, _, _, _LC) -->
caller( Info, _) --> caller( Info, _) -->
{ '$error_descriptor'(Info, Desc) }, { '$error_descriptor'(Info, Desc) },
({ '$query_exception'(errorGoal, Desc, Call), ({ query_exception(errorGoal, Desc, Call),
Call = M:(H :- G) Call = M:(H :- G)
} }
-> ->
@ -372,12 +376,12 @@ caller( Info, _) -->
; ;
[] []
), ),
{ '$query_exception'(prologPredFile, Desc, File), { query_exception(prologPredFile, Desc, File),
File \= [], File \= [],
'$query_exception'(prologPredLine, Desc, FilePos), query_exception(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M), query_exception(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na), query_exception(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar) query_exception(prologPredArity, Desc, Ar)
}, },
!, !,
[nl], [nl],
@ -388,10 +392,10 @@ caller( _, _) -->
c_goal( Info, Level ) --> c_goal( Info, Level ) -->
{ '$error_descriptor'(Info, Desc) }, { '$error_descriptor'(Info, Desc) },
{ '$query_exception'(errorFile, Desc, File), { query_exception(errorFile, Desc, File),
Func \= [], Func \= [],
'$query_exception'(errorFunction, Desc, File), query_exception(errorFunction, Desc, File),
'$query_exception'(errorLine, Desc, Line) query_exception(errorLine, Desc, Line)
}, },
!, !,
['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]], ['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]],
@ -620,7 +624,7 @@ domain_error(Domain, Opt) -->
extra_info( error(_,Extra), _ ) --> extra_info( error(_,Extra), _ ) -->
{ {
'$query_exception'(prologPredFile, Extra, Msg), query_exception(prologPredFile, Extra, Msg),
Msg \= [] Msg \= []
}, },
!, !,
@ -1048,6 +1052,12 @@ prolog:print_message(_Severity, _Term) :-
'$error_descriptor'( exception(Info), Info ). '$error_descriptor'( exception(Info), Info ).
query_exception(K0,[H|L],V) :-
(atom(K0) -> atom_to_string(K0, K) ; K = K0),
!,
lists:member(K=V,[H|L]).
query_exception(K,V) :-
'$query_exception'(K,V).
/** /**
@} @}

6
pl/modules.yap
View File

@ -201,8 +201,8 @@ The state of the module system after this error is undefined.
**/ **/
use_module(F) :- '$load_files'(F, use_module(F) :- load_files(F,
[if(not_loaded),must_be_module(true)], use_module(F)). [if(not_loaded),must_be_module(true)]).
/** /**
@ -235,7 +235,7 @@ Unfortunately it is still not possible to change argument order.
**/ **/
use_module(F,Is) :- use_module(F,Is) :-
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)). load_files(F, [if(not_loaded),must_be_module(true),imports(Is)]).
'$module'(O,N,P,Opts) :- !, '$module'(O,N,P,Opts) :- !,
'$module'(O,N,P), '$module'(O,N,P),

8
pl/protect.yap
View File

@ -36,12 +36,12 @@
*/ */
'$protect' :- prolog:'$protect' :-
'$all_current_modules'(M), '$all_current_modules'(M),
( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ), ( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ),
new_system_module( M ), new_system_module( M ),
fail. fail.
'$protect' :- prolog:'$protect' :-
'$current_predicate'(Name,M,P,_), '$current_predicate'(Name,M,P,_),
'$is_system_module'(M), '$is_system_module'(M),
functor(P,Name,Arity), functor(P,Name,Arity),
@ -50,13 +50,13 @@
functor(P,Name,Arity), functor(P,Name,Arity),
'$hide_predicate'(P,M), '$hide_predicate'(P,M),
fail. fail.
'$protect' :- prolog:'$protect' :-
current_atom(Name), current_atom(Name),
sub_atom(Name,0,1,_, '$'), sub_atom(Name,0,1,_, '$'),
\+ '$visible'(Name), \+ '$visible'(Name),
hide_atom(Name), hide_atom(Name),
fail. fail.
'$protect'. prolog:'$protect'.
% hide all atoms who start by '$' % hide all atoms who start by '$'