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);
}
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
LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */

19
C/atomic.c
View File

@ -592,8 +592,9 @@ restart_aux:
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
argument _L_ with the list of the character codes for string _A_.
ground (otherwise, YAP will generate an error event. _A_ must be unifiable
with an atom, and the argument _L_ with the list of the character codes for
string _A_.
*/
@ -620,7 +621,7 @@ restart_aux:
}
/* error handling */
} else {
Yap_ThrowError( TYPE_ERROR_ATOM, t1, NULL);
Yap_ThrowError(TYPE_ERROR_ATOM, t1, NULL);
}
if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) {
goto restart_aux;
@ -727,14 +728,14 @@ static Int number_chars(USES_REGS1) {
pop_text_stack(l);
return Yap_unify(ARG1, tf);
}
pop_text_stack(l);
pop_text_stack(l);
LOCAL_ActiveError->errorRawTerm = 0;
Yap_ThrowExistingError();
return false;
}
pop_text_stack(l);
pop_text_stack(l);
return true;
}
@ -1377,7 +1378,7 @@ restart_aux:
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else {
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc( sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t));
int i = 0;
if (!inpv) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
@ -1465,9 +1466,7 @@ error:
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux;
}
{
return FALSE;
}
{ return FALSE; }
}
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("upcase_text_to_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("upcase_text_to_string", 2, upcase_text_to_string, 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;
BACKUP_MACHINE_REGS();
b = Yap_TermToBuffer(t, enc, flags);
strncpy(buf, b, sze);
b = Yap_TermToBuffer(t, flags);
strncpy(buf, b, sze-1);
buf[sze] = 0;
RECOVER_MACHINE_REGS();
return true;
@ -2371,7 +2371,7 @@ X_API void YAP_FlushAllStreams(void) {
X_API void YAP_Throw(Term t) {
BACKUP_MACHINE_REGS();
LOCAL_ActiveError->errorNo = THROW_EVENT;
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0);
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
Yap_JumpToEnv();
RECOVER_MACHINE_REGS();
}
@ -2381,7 +2381,7 @@ X_API void YAP_AsyncThrow(Term t) {
BACKUP_MACHINE_REGS();
LOCAL_PrologMode |= AsyncIntMode;
LOCAL_ActiveError->errorNo = THROW_EVENT;
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0);
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
Yap_JumpToEnv();
LOCAL_PrologMode &= ~AsyncIntMode;
RECOVER_MACHINE_REGS();

8
C/errors.c
View File

@ -324,7 +324,7 @@ bool Yap_PrintWarning(Term twarning) {
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
__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);
bool rc;
Term ts[2], err;
@ -332,7 +332,7 @@ bool Yap_PrintWarning(Term twarning) {
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
(err = LOCAL_ActiveError->errorNo)) {
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),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false;
@ -648,7 +648,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->culprit = NULL;
} else {
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) {
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;
}
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);
return i;

29
C/exec.c
View File

@ -1460,7 +1460,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
*/
/* reset the registers so that we don't have trash in abstract
* machine */
pop_text_stack(i+1);
pop_text_stack(i + 1);
Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE;
@ -1470,12 +1470,12 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
} break;
case 3: { /* saved state */
// LOCAL_ActiveError = err_info;
pop_text_stack(i+1);
pop_text_stack(i + 1);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls);
LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls);
return false;
}
case 4:
@ -1485,16 +1485,16 @@ Yap_CloseSlots(sls);
// LOCAL_ActiveError = err_info;
while (B) {
LOCAL_ActiveError->errorNo = ABORT_EVENT;
pop_text_stack(i+1);
pop_text_stack(i + 1);
Yap_CloseSlots(sls);
Yap_JumpToEnv();
}
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
P = (yamop *)FAILCODE;
LOCAL_DoingUndefp = false;
P = (yamop *)FAILCODE;
LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls);
pop_text_stack(i+1);
pop_text_stack(i + 1);
return false;
break;
case 5:
@ -1517,15 +1517,15 @@ Yap_CloseSlots(sls);
(CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder;
pop_text_stack(i+1);
return false;
pop_text_stack(i + 1);
return false;
}
P = FAILCODE;
}
}
YENV = ASP;
YENV[E_CB] = Unsigned(B);
pop_text_stack(i+1);
pop_text_stack(i + 1);
out = Yap_absmi(0);
/* make sure we don't leave a FAIL signal hanging around */
Yap_get_signal(YAP_FAIL_SIGNAL);
@ -1533,7 +1533,7 @@ Yap_CloseSlots(sls);
CalculateStackGap(PASS_REGS1);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
pop_text_stack(i+1);
pop_text_stack(i + 1);
return out;
}
@ -2116,7 +2116,8 @@ static Int jump_env(USES_REGS1) {
}
// Yap_DebugPlWriteln(t);
// 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);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1);
@ -2124,7 +2125,7 @@ static Int jump_env(USES_REGS1) {
LCL0 - (CELL *)B > LOCAL_CBorder) {
// we're failing up to the top layer
}
pop_text_stack(LOCAL_MallocDepth+1);
pop_text_stack(LOCAL_MallocDepth + 1);
return out;
}

157
C/flags.c
View File

@ -1,19 +1,19 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: flags.c *
* Last rev: *
* mods: *
* comments: abstract machine definitions *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: flags.c *
* Last rev: *
* mods: *
* comments: abstract machine definitions *
* *
*************************************************************************/
/** @file C/flags.c
@ -80,22 +80,29 @@ static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1);
static Int set_prolog_flag(USES_REGS1);
#include "Yatom.h"
#include "YapEval.h"
#include "Yatom.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 END_LOCAL_FLAGS LZERO_FLAG};
#define END_LOCAL_FLAGS \
LZERO_FLAG \
} \
;
#define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = {
#define END_GLOBAL_FLAGS GZERO_FLAG};
#define GZERO_FLAG { NULL, false, NULL, NULL, NULL }
#define LZERO_FLAG { NULL, false, NULL, NULL, NULL }
#define END_GLOBAL_FLAGS \
GZERO_FLAG \
} \
;
#define GZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#define LZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#include "YapGFlagInfo.h"
@ -111,8 +118,7 @@ static Term indexer(Term inp) {
"set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag index to an atom");
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
return TermZERO;
}
@ -133,14 +139,16 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true;
}
/* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
Yap_Error(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
@ -168,9 +176,10 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
@ -186,7 +195,6 @@ static bool bqs(Term t2) {
return bqf1(new, t2 PASS_REGS);
}
static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING);
if (IsAtomTerm(t2)) {
@ -203,9 +211,10 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= SNGQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
@ -215,7 +224,6 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
}
}
static bool sqf(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
@ -239,8 +247,9 @@ static Term isaccess(Term inp) {
static Term stream(Term inp) {
if (IsVarTerm(inp))
return inp;
if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
if (Yap_CheckStream(inp,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
"yap_flag/3") >= 0)
return inp;
return 0;
@ -249,19 +258,19 @@ static Term stream(Term inp) {
static bool set_error_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream));
return Yap_SetErrorStream( inp );
return Yap_SetErrorStream(inp);
}
static bool set_input_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream));
return Yap_SetInputStream( inp );
return Yap_SetInputStream(inp);
}
static bool set_output_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream));
return Yap_SetOutputStream( inp );
return Yap_SetOutputStream(inp);
}
static Term isground(Term inp) {
@ -731,10 +740,10 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
if (IsVarTerm(tout)) {
Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
}
} else if (IsAtomOrIntTerm(t2))
tarr[fv->FlagOfVE].at = t2;
@ -782,7 +791,6 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
return bqf1(me, t2 PASS_REGS);
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
return sqf1(me, t2 PASS_REGS);
}
// bad key?
return false;
@ -850,8 +858,7 @@ static Int cont_yap_flag(USES_REGS1) {
Term modt = CurrentModule;
tflag = Yap_StripModule(tflag, &modt);
while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG &&
i != BACK_QUOTES_FLAG &&
i != SINGLE_QUOTES_FLAG &&
i != BACK_QUOTES_FLAG && i != SINGLE_QUOTES_FLAG &&
i != DOUBLE_QUOTES_FLAG)
i++;
if (i == gmax)
@ -1056,14 +1063,16 @@ void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) {
Atom at = new->AtomOfME;
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
new->flags =
M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM;
new->flags = M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES |
BCKQ_STRING | SNGQ_ATOM;
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) {
new->flags = cme->flags;
} 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);
}
@ -1391,8 +1400,9 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return false;
}
CACHE_REGS
const char *us = (const char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1, GLOBAL_MaxPriority);
const char *us = (const char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1,
GLOBAL_MaxPriority);
if (!t0)
return false;
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
@ -1439,8 +1449,9 @@ do_prolog_flag_property(Term tflag,
xarg *args;
prolog_flag_property_choices_t i;
bool rc = true;
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
@ -1527,9 +1538,8 @@ static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
} else {
if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG ||
i == SINGLE_QUOTES_FLAG ||
i == DOUBLE_QUOTES_FLAG ||
i == BACK_QUOTES_FLAG) {
i == SINGLE_QUOTES_FLAG || i == DOUBLE_QUOTES_FLAG ||
i == BACK_QUOTES_FLAG) {
Term labs[2];
labs[0] = MkVarTerm();
labs[1] = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
@ -1607,8 +1617,9 @@ static Int do_create_prolog_flag(USES_REGS1) {
prolog_flag_property_choices_t i;
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
@ -1660,15 +1671,15 @@ static Int do_create_prolog_flag(USES_REGS1) {
}
/**
* Init System Prolog flags. This is done in two phases:
* early on, it takes care of the atomic flags that are required by other
*modules;
* later, it looks at flags that are structured terms
*
* @param bootstrap: wether this is done before stack initialization, or
*afterwards.
* Complex terms can only be built in the second step.
*/
* Init System Prolog flags. This is done in two phases:
* early on, it takes care of the atomic flags that are required by other
*modules;
* later, it looks at flags that are structured terms
*
* @param bootstrap: wether this is done before stack initialization, or
*afterwards.
* Complex terms can only be built in the second step.
*/
void Yap_InitFlags(bool bootstrap) {
CACHE_REGS
@ -1722,7 +1733,7 @@ void Yap_InitFlags(bool bootstrap) {
*/
Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag,
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,
cont_current_prolog_flag, 0);
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2,

171
C/text.c
View File

@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) {
return new;
}
static size_t MaxTmp(USES_REGS1) {
return 1025;
}
static size_t MaxTmp(USES_REGS1) { return 1025; }
static Term Globalize(Term v USES_REGS) {
if (!IsVarTerm(v = Deref(v))) {
@ -231,7 +228,8 @@ static Term Globalize(Term v USES_REGS) {
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];
Term t = t0;
size_t length = 0;
@ -242,13 +240,14 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS)
return st0;
}
if (!IsPairTerm(t)) {
Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
return NULL;
Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
return NULL;
}
bool codes = IsIntegerTerm(HeadOfTerm(t));
if (get_codes !=codes && fixed) {
if (get_codes != codes && fixed) {
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 {
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);
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;
}
length += put_utf8(ar, code);
@ -420,137 +420,146 @@ static yap_error_number gen_type_error(int flags) {
// static int cnt;
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();
char *out = NULL;
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
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) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t);
if (RepAtom(at)->UStrOfAE[0] == 0) {
unsigned char *o = Malloc(4);
memset(o, 0, 4);
return pop_output_text_stack(lvl, o);
out = Malloc(4);
memset(out, 0, 4);
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl);
return at->UStrOfAE;
}
size_t sz = strlen(at->StrOfAE);
void *o = Malloc(sz + 1);
strcpy(o, at->StrOfAE);
return pop_output_text_stack(lvl, o);
{
size_t sz = strlen(at->StrOfAE);
out = Malloc(sz + 1);
strcpy(out, at->StrOfAE);
POPRET( out );
}
}
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
const char *s = StringOfTerm(inp->val.t);
if (s[0] == 0) {
char *o = Malloc(4);
memset(o, 0, 4);
return pop_output_text_stack(lvl, o);
out = Malloc(4);
memset(out, 0, 4);
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER) {
pop_text_stack(lvl);
return (unsigned char *)UStringOfTerm(inp->val.t);
}
{
inp->type |= YAP_STRING_IN_TMP;
size_t sz = strlen(s);
out = Malloc(sz + 1);
strcpy(out, s);
POPRET( out );
}
} else if (IsPairOrNilTerm(inp->val.t)) {
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS))) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS);
POPRET( out );
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide
POPRET( out );
}
if (inp->type & YAP_STRING_ATOMS) {
// Yap_DebugPlWriteln(inp->val.t);
out = (char *)Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS);
// this is a term, extract to a buffer, and representation is wide
POPRET( out );
}
if (inp->type & YAP_STRING_WITH_BUFFER)
return (unsigned char *)UStringOfTerm(inp->val.t);
inp->type |= YAP_STRING_IN_TMP;
size_t sz = strlen(s);
char *o = Malloc(sz + 1);
strcpy(o, s);
return pop_output_text_stack(lvl, o);
}
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(
lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
// ASCII, so both LATIN1 and UTF-8
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = Malloc(2 * MaxTmp(PASS_REGS1));
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
out = Malloc(2 * MaxTmp(PASS_REGS1));
if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
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)) {
char *s;
// Yap_DebugPlWriteln(inp->val.t);
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) {
out = Malloc(2 * MaxTmp(PASS_REGS1));
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) {
pop_text_stack(lvl);
return NULL;
}
return pop_output_text_stack(lvl, s);
}
POPRET(out);
}
#if USE_GMP
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = Malloc(MaxTmp());
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
out = Malloc(MaxTmp());
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1,
10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), out, char);
}
return inp->val.uc = pop_output_text_stack(lvl, s);
POPRET(out);
}
#endif
if (inp->type & YAP_STRING_TERM) {
// Yap_DebugPlWriteln(inp->val.t);
char *s = (char *)Yap_TermToBuffer(inp->val.t, ENC_ISO_UTF8, 0);
return inp->val.uc = pop_output_text_stack(lvl, s);
}
if (inp->type & YAP_STRING_CHARS) {
pop_text_stack(lvl);
if (inp->enc == ENC_ISO_LATIN1) {
return latin2utf8(inp);
} else if (inp->enc == ENC_ISO_ASCII) {
return inp->val.uc;
} else { // if (inp->enc == ENC_ISO_UTF8) {
return Yap_TermToBuffer(inp->val.t, 0);
}
if (inp->type & YAP_STRING_CHARS) {
if (inp->enc == ENC_ISO_ASCII) {
pop_text_stack(lvl);
return inp->val.uc;
}
if (inp->enc == ENC_ISO_LATIN1) {
POPRET( (char*)latin2utf8(inp));
}
if (inp->enc == ENC_ISO_UTF8) {
pop_text_stack(lvl);
return inp->val.c;
}
}
pop_text_stack(lvl);
if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w);
return wchar2utf8(inp);
POPRET( (char *)wchar2utf8(inp) );
}
pop_text_stack(lvl);
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;
}
}
const char *sn = Yap_TermToBuffer(args[i], LOCAL_encoding,
const char *sn = Yap_TermToBuffer(args[i],
Quote_illegal_f | Handle_vars_f);
size_t sz;
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.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb);
so = Yap_MemExportStreamPtr(sno);
*s = BaseMalloc(strlen(so) + 1);
strcpy(*s, so);
*s = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno);
return true;
}
@ -1255,28 +1253,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
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 {
YAP_CompileClause(t);
}
} while (true);
yap_error_descriptor_t *errd;
if ((errd =
Yap_GetException(LOCAL_ActiveError))) {
fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (long int) errd->errorLine, errd->classAsText,
errd->errorAsText);
}
} while (true);
BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full);
if (!Yap_AddAlias(AtomLoopStream, osno)) {

2
CMakeLists.txt
View File

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

169
CXX/yapi.cpp
View File

@ -19,7 +19,7 @@ extern "C" {
#include "YapInterface.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_UserCPredicateWithArgs(const char *, YAP_UserCPred, arity_t,
@ -30,35 +30,32 @@ X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred,
#if YAP_PYTHON
X_API bool do_init_python(void);
#endif
}
static void YAPCatchError()
{
if (LOCAL_CommittedError != nullptr &&
LOCAL_CommittedError->errorNo != YAP_NO_ERROR ) {
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( );
Term es[2];
es[0] = TermError;
es[1] = MkErrorTerm(LOCAL_CommittedError);
Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2);
YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es));
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( SOURCE(), );
} else if (LOCAL_ActiveError != nullptr &&
LOCAL_ActiveError->errorNo != YAP_NO_ERROR ) {
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( );
Term es[2];
es[0] = TermError;
es[1] = MkErrorTerm(LOCAL_ActiveError);
Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2);
YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es));
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( SOURCE(), );
}
static void YAPCatchError() {
if (LOCAL_CommittedError != nullptr &&
LOCAL_CommittedError->errorNo != YAP_NO_ERROR) {
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( );
Term es[2];
es[0] = TermError;
es[1] = MkErrorTerm(LOCAL_CommittedError);
Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2);
YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es));
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( SOURCE(), );
} else if (LOCAL_ActiveError != nullptr &&
LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( );
Term es[2];
es[0] = TermError;
es[1] = MkErrorTerm(LOCAL_ActiveError);
Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2);
YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es));
// Yap_PopTermFromDB(info->errorTerm);
// throw throw YAPError( SOURCE(), );
}
}
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
@ -334,7 +331,7 @@ std::vector<Term> YAPPairTerm::listToArray() {
if (l < 0) {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr);
}
std::vector<Term> o = * new std::vector<Term>(l);
std::vector<Term> o = *new std::vector<Term>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
@ -483,7 +480,7 @@ const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a); }
void YAPQuery::openQuery() {
CACHE_REGS
if (ap == NULL || ap->OpcodeOfPred == UNDEF_OPCODE) {
if (ap == NULL || ap->OpcodeOfPred == UNDEF_OPCODE) {
ap = rewriteUndefQuery();
}
setNext();
@ -512,7 +509,7 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) {
YAPCatchError();
Yap_CloseHandles(q.CurSlot);
pop_text_stack(q.lvl+1);
pop_text_stack(q.lvl + 1);
RECOVER_MACHINE_REGS();
return result;
@ -522,45 +519,46 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
#if YAP_PYTHON
// PyThreadState *_save;
//std::cerr << "mgoal " << YAPTerm(t).text() << "\n";
// _save = PyEval_SaveThread();
#endif
CACHE_REGS
BACKUP_MACHINE_REGS();
Term *ts = nullptr;
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
PredEntry *ap = nullptr;
if (IsStringTerm(tmod))
tmod = MkAtomTerm(Yap_LookupAtom(StringOfTerm(tmod)));
YAPPredicate *p = new YAPPredicate(t, tmod, ts, "C++");
if (p == nullptr || (ap = p->ap) == nullptr ||
ap->OpcodeOfPred == UNDEF_OPCODE) {
ap = rewriteUndefEngineQuery(ap, t, tmod);
}
if (IsApplTerm(t))
ts = RepAppl(t) + 1;
else if (IsPairTerm(t))
ts = RepPair(t);
/* legal ap */
arity_t arity = ap->ArityOfPE;
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
PredEntry *ap = nullptr;
if (IsStringTerm(tmod))
tmod = MkAtomTerm(Yap_LookupAtom(StringOfTerm(tmod)));
YAPPredicate *p = new YAPPredicate(t, tmod, ts, "C++");
if (p == nullptr || (ap = p->ap) == nullptr ||
ap->OpcodeOfPred == UNDEF_OPCODE) {
ap = rewriteUndefEngineQuery(ap, t, tmod);
}
if (IsApplTerm(t))
ts = RepAppl(t) + 1;
else if (IsPairTerm(t))
ts = RepPair(t);
/* legal ap */
arity_t arity = ap->ArityOfPE;
for (arity_t i = 0; i < arity; i++) {
XREGS[i + 1] = ts[i];
}
ts = nullptr;
bool result;
// allow Prolog style exception handling
// don't forget, on success these guys may create slots
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
for (arity_t i = 0; i < arity; i++) {
XREGS[i + 1] = ts[i];
}
ts = nullptr;
bool result;
// allow Prolog style exception handling
// don't forget, on success these guys may create slots
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
result = (bool)YAP_EnterGoal(ap, nullptr, &q);
YAP_LeaveGoal(result && !release, &q);
// PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS();
return result;
result = (bool)YAP_EnterGoal(ap, nullptr, &q);
//std::cerr << "mgoal " << YAPTerm(t).text() << "\n";
YAP_LeaveGoal(result && !release, &q);
// PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS();
return result;
}
/**
* called when a query must be terminated and its state fully recovered,
@ -666,31 +664,29 @@ goal = YAPApplTerm(f, nts);
}
#endif
YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) {
BACKUP_MACHINE_REGS();
try {
arity_t arity = p.ap->ArityOfPE;
if (arity) {
goal = YAPApplTerm(YAPFunctor(p.ap->FunctorOfPred), ts).term();
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i].term();
openQuery();
} else {
goal = MkAtomTerm((Atom)(p.ap->FunctorOfPred));
openQuery();
if (arity) {
goal = YAPApplTerm(YAPFunctor(p.ap->FunctorOfPred), ts).term();
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i].term();
openQuery();
} else {
goal = MkAtomTerm((Atom)(p.ap->FunctorOfPred));
openQuery();
}
names = TermNil;
} catch (...) {
}
names = TermNil;
} catch (...) {
}
RECOVER_MACHINE_REGS();
RECOVER_MACHINE_REGS();
}
bool YAPQuery::next() {
CACHE_REGS
bool result = false;
//std::cerr << "next " << YAPTerm(goal).text() << "\n";
// std::cerr << "next " << YAPTerm(goal).text() << "\n";
sigjmp_buf buf, *oldp = LOCAL_RestartEnv;
e = nullptr;
@ -702,7 +698,7 @@ bool YAPQuery::next() {
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
if (q_state == 0) {
//Yap_do_low_level_trace = 1;
// Yap_do_low_level_trace = 1;
result = (bool)YAP_EnterGoal(ap, nullptr, &q_h);
} else {
LOCAL_AllowRestart = q_open;
@ -710,19 +706,18 @@ bool YAPQuery::next() {
}
q_state = 1;
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "out %d", result);
if (!result) {
if (!result) {
YAP_LeaveGoal(result, &q_h);
q_open = false;
}
YAPCatchError();
YAPCatchError();
RECOVER_MACHINE_REGS();
LOCAL_RestartEnv = oldp;
return result;
}
PredEntry *YAPQuery::rewriteUndefQuery() {
ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall
, 1, &goal));
ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall, 1, &goal));
return ap = PredCall;
}
@ -894,7 +889,7 @@ PredEntry *YAPPredicate::getPred(Term &t, CELL *&out) {
ap = RepPredProp(PredPropByAtom(AtomOfTerm(t), m));
return ap;
} else if (IsPairTerm(t)) {
Term ts[2], *s = ( out ? out : ts );
Term ts[2], *s = (out ? out : ts);
Functor FunctorConsult = Yap_MkFunctor(Yap_LookupAtom("consult"), 1);
s[1] = t;
s[0] = m;
@ -909,7 +904,7 @@ PredEntry *YAPPredicate::getPred(Term &t, CELL *&out) {
} else {
ap = RepPredProp(PredPropByFunc(f, m));
if (out)
memmove( out, RepAppl(t) + 1, ap->ArityOfPE*sizeof(CELL) );
memmove(out, RepAppl(t) + 1, ap->ArityOfPE * sizeof(CELL));
else
out = RepAppl(t) + 1;
}
@ -1017,12 +1012,12 @@ std::stringstream s;
void YAPEngine::reSet() {
/* ignore flags for now */
if (B && B->cp_b && B->cp_ap != NOCODE )
YAP_LeaveGoal(false, &q);
if (B && B->cp_b && B->cp_ap != NOCODE)
YAP_LeaveGoal(false, &q);
LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
if (LOCAL_CommittedError) {
LOCAL_CommittedError->errorNo = YAP_NO_ERROR;
free(LOCAL_CommittedError );
free(LOCAL_CommittedError);
LOCAL_CommittedError = NULL;
}
}

8
CXX/yapt.hh
View File

@ -223,19 +223,15 @@ public:
/// return a string with a textual representation of the term
virtual const char *text() {
CACHE_REGS
encoding_t enc = LOCAL_encoding;
char *os;
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();
return 0;
}
RECOVER_MACHINE_REGS();
size_t length = strlen(os);
char *sm = (char *)malloc(length + 1);
strcpy(sm, os);
return sm;
return os;
};
/// return a handle to the term

114
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),
/**< how to present answers, default is `~p`. */
#if __ANDROID__
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
#if __APPLE__
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running an Apple Operating System */
#endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**<
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(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true,
booleanFlag, "true", NULL),
/**< `arithmetic_exceptions`
/**<
Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled:
@ -99,7 +96,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
ProbLog.
*/
YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs),
/**>
/**<
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,
`codes`, or to a single atom, `atom`. If _Value_ is bound, set to
@ -132,20 +129,22 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
Writable flag telling whether a character escapes are enabled,
`true`, or disabled, `false`. The default value for this flag is
`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 `
Read-only flag that gives the time when the main YAP binary was compiled. 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,
Read-only flag that gives the time when the main YAP binary was compiled.
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,
NULL),
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
/**<
/**<
If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging.
*/
If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging.
*/
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL),
@ -155,15 +154,18 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
*/
YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option,
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
NULL),
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
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),
/**<
@ -275,11 +277,11 @@ vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth",
true, nat, "0", NULL),
/**< `Index_sub_term_search_depth `
/**< `Index_sub_term_search_depth `
Maximum bound on searching sub-terms for indexing, if `0` (default) no
bound.
*/
Maximum bound on searching sub-terms for indexing, if `0` (default) no
bound.
*/
YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true,
isatom, "normal", NULL),
/**< `informational_messages `
@ -297,6 +299,8 @@ vxu `on` consider `$` a lower case character.
value `toward_zero` for the current version of YAP.
*/
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),
/**< `language `
@ -322,7 +326,7 @@ vxu `on` consider `$` a lower case character.
Read-only flag telling the maximum arity of a functor. Takes the value
`unbounded` for the current version of YAP.
*/
YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n,
YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n,
"INT_MAX", NULL),
YAP_FLAG(MAX_THREADS_FLAG, "max_threads", false, at2n, "MAX_THREADS", NULL),
YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL),
@ -348,15 +352,14 @@ vxu `on` consider `$` a lower case character.
providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files).
*/
/**< `module_independent_operators `
/**< `module_independent_operators `
If `true` an operator declaration will be valid for every module in the
program. This is for compatibility with old software that
might expect module-independent operators.
*/
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG,
"module_independent_operators", true, booleanFlag,
"false", NULL),
If `true` an operator declaration will be valid for every module in the
program. This is for compatibility with old software that
might expect module-independent operators.
*/
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
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),
@ -372,14 +375,14 @@ vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true,
isatom, "determinism", NULL),
/**< `prompt_alternatives_on(atom,
changeable) `
/**< `prompt_alternatives_on(atom,
changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog
toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if
and only if the query contains variables. The alternative, default in
SWI-Prolog is <tt>determinism</tt> which implies the system prompts for
alternatives if the goal succeeded while leaving choicepoints. */
SWI-Compatible option, determines prompting for alternatives in the Prolog
toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if
and only if the query contains variables. The alternative, default in
SWI-Prolog is <tt>determinism</tt> which implies the system prompts for
alternatives if the goal succeeded while leaving choicepoints. */
YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag,
"true", NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false",
@ -389,6 +392,15 @@ vxu `on` consider `$` a lower case character.
enable the use of the readline library for console interactions, true by
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",
NULL),
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
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),
/**< `signals`
@ -482,8 +503,7 @@ vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true,
booleanFlag, "true",
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true",
NULL),
/**< `toplevel_hook `
@ -493,7 +513,7 @@ vxu `on` consider `$` a lower case character.
backtracked into.
*/
YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag,
YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag,
"true", NULL),
YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true,
list_option, "[quoted(true),numbervars(true),portrayed(true)]",
@ -527,9 +547,9 @@ vxu `on` consider `$` a lower case character.
are `silent`, `warning` and `error`. The first two create the flag
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
flag. See also `create_prolog_flag/3`. The default is`error`, and developers
are encouraged to use `create_prolog_flag/3` to create flags for their
library.
flag. See also `create_prolog_flag/3`. The default is`error`, and
developers are encouraged to use `create_prolog_flag/3` to create flags for
their library.
*/
YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown),
/**< `unknown is iso`

159
H/YapLFlagInfo.h
View File

@ -1,21 +1,19 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: YapLFlagInfo.h *
* Last rev: *
* mods: *
* comments: local flag enumeration. *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: YapLFlagInfo.h * Last rev:
** mods: * comments: local flag enumeration. *
* *
*************************************************************************/
/** @file YapLFlagInfo.h
@ -30,74 +28,75 @@
START_LOCAL_FLAGS
/** + `autoload`: set the system to look for undefined procedures */
YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ),
/** + `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( CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true" , NULL ), /** + `call_counting`
/** + `autoload`: set the system to look for undefined procedures */
YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
/** + `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(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;
retries: number of retries for predicates called since execution started or since counters were reset;
calls_and_retries: count both on predicate calls and retries.
These counters can be used to find out how many calls a certain goal takes to execute. They can also be force the computatiom yp
stopping.
calls: number of predicate calls since execution started or
since system was reset; retries: number of retries for predicates
called since execution started or since counters were reset;
calls_and_retries: count both on predicate calls and
retries. These counters can be used to find out how many calls a
certain goal takes to execute. They can also be force the
computatiom yp stopping.
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ),
YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /** + `language_mode`
If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled.
*/
YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), /** + `language_mode`
wweter native mode or trying to emulate a different Prolog.
*/
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /** + `redefine_warnings `
wweter native mode or trying to emulate a different Prolog.
*/
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`.
*/
YAP_FLAG( STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose" , NULL ),
YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error" , NULL ), /** + `syntax_errors`
*/
YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
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`:
+ `dec10`
+ `dec10`
Report the syntax error and retry reading the term.
+ `fail`
+ `fail`
Report the syntax error and fail.
+ `error`
+ `error`
Report the syntax error and generate an error (default).
+ `quiet`
+ `quiet`
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
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
the current user_error stream.
By default, the user_error stream is set to a stream
@ -105,30 +104,32 @@ corresponding to the Unix `stderr` stream.
The next example shows how to use this flag:
~~~{.prolog}
?- open( '/dev/null', append, Error,
[alias(mauri_tripa)] ).
?- open( '/dev/null', append, Error,
[alias(mauri_tripa)] ).
Error = '$stream'(3) ? ;
Error = '$stream'(3) ? ;
no
?- set_prolog_flag(user_error, mauri_tripa).
no
?- set_prolog_flag(user_error, mauri_tripa).
close(mauri_tripa).
close(mauri_tripa).
yes
?-
yes
?-
~~~
We execute three commands. First, we open a stream in write mode and
We execute three commands. First, we open a stream in write mode and
give it an alias, in this case `mauri_tripa`. Next, we set
user_error to the stream via the alias. Note that after we did so
prompts from the system were redirected to the stream
`mauri_tripa`. Last, we close the stream. At this point, YAP
automatically redirects the user_error alias to the original
`stderr`.
*/
YAP_FLAG( USER_INPUT_FLAG, "user_input", true, stream, "user_input" , set_input_stream ),
YAP_FLAG( USER_OUTPUT_FLAG, "user_output", true, stream, "user_output" , set_output_stream ),
*/
YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input",
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 *
Yap_GetOpPropForAModuleHavingALock(struct AtomEntryStruct *, Term);
extern Atom Yap_LookupAtom(const char *);
extern Atom Yap_AtomInUse(const char *atom);
extern Atom Yap_ULookupAtom(const unsigned char *);
extern Atom Yap_LookupAtomWithLength(const char *, size_t);
extern Atom Yap_FullLookupAtom(const char *);

2
H/Yatom.h
View File

@ -1298,7 +1298,7 @@ INLINE_ONLY bool IsFlagProperty(PropFlags flags) {
/* 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);

33
cmake/FindLibR.cmake
View File

@ -1,7 +1,7 @@
#
# 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
# GNU Affero General Public License. This program is distributed WITHOUT
@ -21,11 +21,24 @@
if(APPLE)
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_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory")
set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory")
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()
# detection for UNIX & Win32
@ -103,12 +116,15 @@ else()
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 library hint path based on whether we are doing a special session 64 build
if(LIBR_FIND_WINDOWS_64BIT)
set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64")
else()
set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/i386")
endif()
# set library hint path for 64-bit build
set(LIBR_ARCH "x64")
set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64")
# call dll2lib.R to ensure export files are generated
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()
@ -173,6 +189,7 @@ find_package_handle_standard_args(LibR DEFAULT_MSG
if(LIBR_FOUND)
message(STATUS "Found R: ${LIBR_HOME}")
get_filename_component(LIBR_BIN_DIR "${LIBR_EXECUTABLE}" PATH CACHE)
endif()
# 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;
//> bootstrapping mode: YAP is not properly installed
bool install;
//> jupyter mode: YAP is in space
bool jupyter;
//> generats a saved space at this path
const char *OUTPUT_STARTUP;
//> 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;
extern int PL_unify_termv(term_t l, va_list args);
extern X_API Atom YAP_AtomFromSWIAtom(atom_t 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);
}
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
/*******************************
@ -1273,7 +1280,7 @@ YAP: NO EQUIVALENT */
X_API int PL_raise_exception(term_t exception) {
CACHE_REGS
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_RaiseException();
return 0;
@ -1321,7 +1328,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s) {
Atom at;
while ((at = Yap_CharsToAtom(s, ENC_ISO_LATIN1 PASS_REGS)) == 0L) {
if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_unify_atom_nchars"))
return FALSE;
return true;
}
Yap_AtomIncreaseHold(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 */
/* 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;
if (sno < 0)
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) {
#ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock);

54
os/fmem.c
View File

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

48
os/iopreds.c
View File

@ -1129,13 +1129,14 @@ static void check_bom(int sno, StreamDesc *st) {
bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode,
Term file_name, encoding_t encoding, stream_flags_t flags,
void *vfs) {
fprintf(stderr,"+ %s --> %d\n", name, sno);
// fprintf(stderr,"+ %s --> %d\n", name, sno);
StreamDesc *st = &GLOBAL_Stream[sno];
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>",
io_mode, CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
name,
sno);
if (io_mode == NULL)
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", io_mode,
CurrentModule == 0 ? "prolog"
: RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
name, sno);
if (io_mode == NULL)
Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno),
"File opened with NULL Permissions");
if (strchr(io_mode, 'a')) {
@ -1232,13 +1233,10 @@ typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t;
static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, Term user_name,
encoding_t enc)
{
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
Term user_name, encoding_t enc) {
struct vfs *vfsp = NULL;
const char *fname;
if (IsAtomTerm(tin))
fname = RepAtom(AtomOfTerm(tin))->StrOfAE;
@ -1290,9 +1288,10 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
return false;
}
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,
MEM_BUF_MALLOC, nat, MkAtomTerm(NameOfFunctor(f)));
MEM_BUF_MALLOC, nat,
MkAtomTerm(NameOfFunctor(f)));
return Yap_OpenBufWriteStream(PASS_REGS1);
}
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
@ -1364,9 +1363,9 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
} else {
open_mode = AtomOfTerm(t2);
}
/* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END,
DOMAIN_ERROR_OPEN_OPTION);
/* get options */
xarg *args =
Yap_ArgListToVector(tlist, open_defs, OPEN_END, DOMAIN_ERROR_OPEN_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
@ -1375,7 +1374,7 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
}
/* done */
st->status = 0;
const char *s_encoding;
const char *s_encoding;
if (args[OPEN_ENCODING].used) {
tenc = args[OPEN_ENCODING].tvalue;
s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE;
@ -1436,14 +1435,14 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
"type is ~a, must be one of binary or text", t);
}
}
st = &GLOBAL_Stream[sno];
if (!fill_stream(sno, st, file_name,io_mode,st->user_name,st->encoding)) {
if (!fill_stream(sno, st, file_name, io_mode, st->user_name, st->encoding)) {
return false;
}
if (args[OPEN_BOM].used) {
if (args[OPEN_BOM].used) {
if (args[OPEN_BOM].tvalue == TermTrue) {
avoid_bom = false;
needs_bom = true;
@ -1671,9 +1670,8 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
st = GLOBAL_Stream + sno;
// fname = Yap_VF(fname);
if (fill_stream(sno, st, tin,io_mode,user_name,enc))
return sno;
if (fill_stream(sno, st, tin, io_mode, user_name, enc))
return sno;
return -1;
}
@ -1868,13 +1866,13 @@ static Int always_prompt_user(USES_REGS1) {
return (TRUE);
}
/** @pred close(+ _S_) is iso
/** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream
currently opened an error is reported. The streams user_input,
user_output, and user_error can never be closed.
*/
static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0)

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 */
bool det;
bool det = false;
xarg *args;
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
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 == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION;
Yap_Error(LOCAL_Error_TYPE, t2, NULL);
Yap_ThrowError(LOCAL_Error_TYPE, t2, NULL);
return false;
}
cut_fail();
@ -714,16 +714,17 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) {
// one solution only
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))) {
free(args);
cut_fail();
}
cut_succeed();
det = true;
}
LOCK(GLOBAL_Stream[i].streamlock);
rc = do_stream_property(i, args PASS_REGS);
UNLOCK(GLOBAL_Stream[i].streamlock);
if (IsVarTerm(t1)) {
if (!det && IsVarTerm(t1)) {
if (rc)
rc = Yap_unify(ARG1, Yap_MkStream(i));
if (p == STREAM_PROPERTY_END) {
@ -743,7 +744,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
}
} else {
// done
det = (p == STREAM_PROPERTY_END);
det = det || (p == STREAM_PROPERTY_END);
}
free(args);
if (rc) {
@ -998,7 +999,7 @@ static void CloseStream(int sno) {
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>",
// sno);
VFS_t *me;
fprintf( stderr, "- %d\n",sno);
//fprintf( stderr, "- %d\n",sno);
if ((me = GLOBAL_Stream[sno].vfs) != NULL &&
GLOBAL_Stream[sno].file == NULL) {
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);
const char *s;
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)) {
Yap_Error(RESOURCE_ERROR_HEAP, t1,
"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;
Atom at;
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);
if (!s || !(at = Yap_UTF8ToAtom((const unsigned char *)s))) {
Yap_Error(RESOURCE_ERROR_HEAP, t2,
@ -711,6 +711,25 @@ static Int term_to_atom(USES_REGS1) {
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) {
Yap_InitCPred("write_term", 2, write_term2, 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_OpenStream(Term tin, const char* io_mode, Term user_name, encoding_t enc);
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,
encoding_t *encoding, int flags);
extern int Yap_GetFreeStreamD(void);

48
packages/python/py2pl.c
View File

@ -46,11 +46,12 @@ foreign_t assign_to_symbol(term_t t, PyObject *e) {
PyObject *dic;
if (!lookupPySymbol(s, NULL, &dic))
dic = py_Main;
Py_INCREF(e);
Py_INCREF(e);
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;
term_t to = PL_new_term_ref();
// fputs(" <<*** ",stderr); PyObject_Print(pVal,stderr,0);
@ -89,14 +90,14 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
#else
const char *s = PyUnicode_AsUTF8(pVal);
#endif
// if (PyDict_GetItemString(py_Atoms, s))
// rc = rc && PL_unify_atom_chars(t, s);
// else
if (Yap_AtomInUse(s))
rc = rc && PL_unify_atom_chars(t, s);
} else if (PyByteArray_Check(pVal)) {
rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal));
#if PY_MAJOR_VERSION < 3
} else if (PyString_Check(pVal)) {
else
rc = rc && PL_unify_string_chars(t, s);
} else if (PyByteArray_Check(pVal)) {
rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal));
#if PY_MAJOR_VERSION < 3
} else if (PyString_Check(pVal)) {
rc = rc && PL_unify_string_chars(t, PyString_AsString(pVal));
#endif
} else if (PyTuple_Check(pVal)) {
@ -130,15 +131,18 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
}
if (PL_unify_functor(t, f)) {
for (i = 0; i < sz; i++) {
if (!PL_get_arg(i + 1, t, to))
term_t to = PL_new_term_ref();
if (!PL_get_arg(i + 1, t, to))
rc = false;
PyObject *p = PyTuple_GetItem(pVal, i);
if (p == NULL) {
PyErr_Clear();
p = Py_None;
}
rc = rc && python_to_term(p, to);
}
} else {
rc = rc && python_to_term(p, to);
}
PL_reset_term_refs(to);
}
} else {
rc = false;
}
@ -150,11 +154,13 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
for (i = 0; i < sz; i++) {
PyObject *obj;
term_t to = PL_new_term_ref();
rc = rc && PL_unify_list(t, to, t);
if ((obj = PyList_GetItem(pVal, i)) == NULL) {
obj = Py_None;
}
rc = rc && python_to_term(obj, to);
PL_reset_term_refs(to);
if (!rc)
return false;
}
@ -163,7 +169,6 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
// Yap_DebugPlWrite(yt); fputs("[***]\n", stderr);
} else if (PyDict_Check(pVal)) {
Py_ssize_t pos = 0;
term_t to = PL_new_term_ref(), ti = to;
int left = PyDict_Size(pVal);
PyObject *key, *value;
@ -173,6 +178,7 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
while (PyDict_Next(pVal, &pos, &key, &value)) {
term_t tkey = PL_new_term_ref(), tval = PL_new_term_ref(), tint,
tnew = PL_new_term_ref();
term_t to = PL_new_term_ref();
/* do something interesting with the values... */
if (!python_to_term(key, tkey)) {
continue;
@ -191,21 +197,22 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
PL_reset_term_refs(tkey);
rc = false;
}
if (!PL_unify(ti, tint)) {
if (!PL_unify(to, tint)) {
rc = false;
}
ti = tnew;
PL_reset_term_refs(tkey);
}
rc = rc && PL_unify(t, to);
}
} else {
rc = rc && repr_term(pVal, t);
}
PL_reset_term_refs(to);
return rc;
}
X_API YAP_Term pythonToYAP(PyObject *pVal) {
term_t t = PL_new_term_ref();
@ -215,12 +222,13 @@ X_API YAP_Term pythonToYAP(PyObject *pVal) {
}
YAP_Term tt = YAP_GetFromSlot(t);
PL_reset_term_refs(t);
//Py_DECREF(pVal);
// Py_DECREF(pVal);
return tt;
}
PyObject *py_Local, *py_Global;
/**
* assigns the Python RHS to a Prolog term LHS, ie LHS = RHS
*
@ -317,7 +325,7 @@ bool python_assign(term_t t, PyObject *exp, PyObject *context) {
if (PySequence_Check(o) && PyInt_Check(i)) {
long int j;
j = PyInt_AsLong(i);
return PySequence_SetItem(o, i, exp) == 0;
return PySequence_SetItem(o, i, exp) == 0;
}
#endif
if (PyDict_Check(o)) {

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

@ -41,6 +41,18 @@ class Engine( YAPEngine ):
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 ):
""" Interface to Engine Options class"""
def __init__(self, args=None,**kwargs):

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

@ -273,14 +273,15 @@ set (RESOURCES
#yap_kernel/resources/logo-32x32.png
#yap_kernel/resourcess/logo-64x64.png
)
set (RENAMED_RESOURCES
set (RENAMED_RESOURCES
yap_kernel/resources/logo-32x32.png
yap_kernel/resources/logo-64x64.png
# yap_kernel/resources/codemirror/mode/prolog/prolog.js
)
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})
@ -321,11 +322,13 @@ add_custom_target(YAP_KERNEL ALL
DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png yap.tgz ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${CMAKE_CURRENT_BINARY_DIR}/yap.tgz
)
install(CODE "execute_process(
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 yap_kernel.kernelspec
ERROR_VARIABLE setupErr
OUTPUT_VARIABLE setupOut
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})")
install(FILES ${PL_SOURCES} DESTINATION ${libpl} )

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

@ -4,6 +4,7 @@
* @brief JUpyter support.
*/
:- yap_flag(gc_trace,verbose).
% :- module( jupyter,
% [jupyter_query/3,
@ -35,7 +36,11 @@ jupyter_cell( _Caller, _, Line ) :-
!.
jupyter_cell( Caller, _, Line ) :-
Self := Caller.query,
python_query(Self,Line).
catch(
python_query(Self,Line),
E=error(A,B),
system_error(A,B)
).
restreams(call) :-
streams(true).
@ -55,42 +60,37 @@ jupyter_consult(Cell) :-
% Name = 'Inp',
% stream_property(Stream, file_name(Name) ),
% setup_call_cleanup(
open_mem_read_stream( Cell, Stream),
load_files(user:'jupyter cell',[stream(Stream)]).
catch(
(
Options = [],
open_mem_read_stream( Cell, 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) :-
atom(Text),
!,
atom_codes(Text, L),
maplist( code_type(space), L).
:- dynamic cell_stream/1.
blank(Text) :-
string(Text),
!,
string_codes(Text, L),
maplist( code_type(space), L).
streams(false) :-
nb_setval(jupyter_cell, false),
retract(cell_stream(S)),
close(S),
fail.
streams(false).
close(user_input),
close(user_output),
close(user_error).
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)]),
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)]),
set_prolog_flag(user_output, Output),
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).
open('/python/sys.stderr', append, Error, [alias(user_error)]).
ready(_Self, 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):
self.shell = shell
self.yapeng = Engine()
self.yapeng = JupyterEngine()
global engine
engine = self.yapeng
self.yapeng.goal(use_module(library("jupyter")),True)
self.query = None
self.os = None
self.it = None
@ -573,7 +572,6 @@ class YAPRun:
except Exception as e:
sys.stderr.write('Exception after', self.bindings, '\n')
has_raised = True
self.yapeng.mgoal(streams(False),"user", True)
return False,[]
@ -730,13 +728,13 @@ class YAPRun:
# state = tracer.runfunc(jupyter_query( self, cell ) )
self.shell.last_execution_succeeded = True
self.result.result = (True, dicts)
self.yapeng.mgoal(streams(False),"user", True)
except Exception as e:
has_raised = True
self.result.result = False
self.yapeng.mgoal(streams(False),"user", True)
self.yapeng.mgoal(streams(False),"user", True)
self.shell.last_execution_succeeded = not has_raised
# 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 )
#
# - This module locates an installed R distribution.
#
# Defines the following:
# R_COMMAND - Path to R command
# R_HOME - Path to 'R home', as reported by R
# 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
#
# LIBR_FOUND
# LIBR_HOME
# LIBR_INCLUDE_DIRS
# LIBR_DOC_DIR
# LIBR_LIBRARIES
if (R_LIBRARIES AND R_INCLUDE_DIR)
set_package_properties(R PROPERTIES

3
pl/absf.yap
View File

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

15
pl/boot.yap
View File

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

163
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
% register(true, false) => implemented
%
load_files(Files,Opts) :-
'$load_files'(Files,Opts,load_files(Files,Opts)).
load_files(Files0,Opts) :-
'$yap_strip_module'(Files0,M,Files),
'$load_files'(Files,M,Opts,M:load_files(Files,Opts)).
'$lf_option'(autoload, 1, false).
'$lf_option'(derived_from, 2, false).
@ -232,7 +234,14 @@ load_files(Files,Opts) :-
'$lf_option'(qcompile, 7, Current) :-
'__NB_getval__'('$qcompile', Current, Current = never).
'$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) :-
current_prolog_flag(source, YFlag),
( YFlag == false -> Flag = compact ; Flag = source ).
@ -271,42 +280,70 @@ load_files(Files,Opts) :-
'$lf_option'(Op, Id, _),
setarg( Id, TOpts, Val ).
'$load_files'(Files, Opts, Call) :-
( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) ->
'$lf_opt'(autoload, OldTOpts, OldAutoload)
;
'$lf_option'(last_opt, LastOpt),
functor( OldTOpts, opt, LastOpt ),
'$lf_opt'('$context_module', OldTOpts, user)
),
'$lf_option'(last_opt, LastOpt),
functor( TOpts, opt, LastOpt ),
( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ),
'$lf_opt'('$location', TOpts, ParentF:Line),
'$lf_opt'('$files', TOpts, Files),
'$lf_opt'('$call', TOpts, Call),
'$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
'$process_lf_opts'(Opts,TOpts,Files,Call),
'$lf_default_opts'(1, LastOpt, TOpts),
'$lf_opt'(stream, TOpts, Stream),
( nonvar(Stream) ->
'$set_lf_opt'('$from_stream', TOpts, true )
;
'$check_files'(Files,load_files(Files,Opts))
),
'$check_use_module'(Call,UseModule),
'$lf_opt'('$use_module', TOpts, UseModule),
'$current_module'(M0),
( '$lf_opt'(autoload, TOpts, Autoload),
var(Autoload) ->
Autoload = OldAutoload
;
true
),
% make sure we can run consult
'$init_consult',
'$lf'(Files, M0, Call, TOpts).
'$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, [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)
;
current_prolog_flag(autoload, OldAutoload),
functor( OldTOpts, opt, LastOpt ),
'$lf_opt'(autoload, OldTOpts, OldAutoload),
'$lf_opt'('$context_module', OldTOpts, OldContextModule)
),
functor( TOpts, opt, LastOpt ),
( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ),
'$lf_opt'('$location', TOpts, ParentF:Line),
'$lf_opt'('$files', TOpts, Files),
'$lf_opt'('$call', TOpts, Call),
'$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
'$process_lf_opts'(Opts,TOpts,Files,Call),
'$lf_default_opts'(1, LastOpt, TOpts),
'$lf_opt'(stream, TOpts, Stream),
( nonvar(Stream) ->
'$set_lf_opt'('$from_stream', TOpts, true )
;
'$check_files'(Files,load_files(Files,Opts))
),
'$check_use_module'(Call,UseModule),
'$lf_opt'('$use_module', TOpts, UseModule),
( '$lf_opt'(autoload, TOpts, Autoload),
var(Autoload) ->
Autoload = OldAutoload
;
true
),
% make sure we can run consult
'$init_consult',
'$lf'(Files, M, Call, TOpts).
'$check_files'(Files, Call) :-
var(Files), !,
@ -428,32 +465,12 @@ load_files(Files,Opts) :-
'$lf'(V,_,Call, _ ) :- var(V), !,
'$do_error'(instantiation_error,Call).
'$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) :- !,
% clean up after each consult
( '$lf'(F,Mod,Call, TOpts), fail;
'$lf'(Fs, Mod, Call, TOpts), fail;
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_opt'(stream, TOpts, Stream),
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.
*/
ensure_loaded(Fs) :-
'$load_files'(Fs, [if(not_loaded)],ensure_loaded(Fs)).
load_files(Fs, [if(not_loaded)]).
compile(Fs) :-
'$load_files'(Fs, [], compile(Fs)).
load_files(Fs, []).
/**
@pred [ _F_ ]
@ -581,9 +598,9 @@ consult(Fs) :-
'$consult'(Fs,Module) :-
current_prolog_flag(language_mode, iso), % SICStus Prolog compatibility
!,
'$load_files'(Module:Fs,[],consult(Fs)).
load_files(Module:Fs,[]).
'$consult'(Fs, Module) :-
'$load_files'(Module:Fs,[consult(consult)],consult(Fs)).
load_files(Module:Fs,[consult(consult)]).
/**
@ -616,7 +633,7 @@ Example:
*/
reconsult(Fs) :-
'$load_files'(Fs, [], reconsult(Fs)).
load_files(Fs, []).
/* exo_files(+ _Files_)
@ -636,7 +653,7 @@ different forms of indexing, as shown in @cite x.
*/
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(Fs) :-
'$load_files'(Fs, [consult(db), if(not_loaded)], exo_files(Fs)).
load_files(Fs, [consult(db), if(not_loaded)]).
'$csult'(Fs, _M) :-
@ -677,9 +694,9 @@ db_files(Fs) :-
!.
'$csult'(Fs, M) :-
'$extract_minus'(Fs, MFs), !,
'$load_files'(M:MFs,[],[M:Fs]).
load_files(M:MFs,[]).
'$csult'(Fs, M) :-
'$load_files'(M:Fs,[consult(consult)],[M:Fs]).
load_files(M:Fs,[consult(consult)]).
'$extract_minus'([], []).
'$extract_minus'([-F|Fs], [F|MFs]) :-
@ -1099,7 +1116,7 @@ just goes through every loaded file and verifies whether reloading is needed.
make :-
recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_),
'$load_files'(F1, [if(changed)],make),
load_files(F1, [if(changed)]),
fail.
make.
@ -1260,11 +1277,11 @@ use_module(M,F,Is) :-
'$use_module'(M,M1,F,Is) :-
nonvar(F), !,
( 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)] ),
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) :-
nonvar(M), !,
@ -1272,11 +1289,11 @@ use_module(M,F,Is) :-
(
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)
->
'$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))
).

13
pl/directives.yap
View File

@ -45,7 +45,6 @@
'$include'/2,
'$initialization'/1,
'$initialization'/2,
'$load_files'/3,
'$require'/2,
'$set_encoding'/1,
'$use_module'/3]).
@ -176,23 +175,23 @@ considered.
'$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :-
set_prolog_flag(F,V).
'$exec_directive'(ensure_loaded(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)).
load_files(M:Fs, [if(changed)]).
'$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :-
char_conversion(IN,OUT).
'$exec_directive'(public(P), _, M, _, _) :-
'$public'(P, M).
'$exec_directive'(compile(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], compile(Fs)).
load_files(M:Fs, []).
'$exec_directive'(reconsult(Fs), _, M, _, _) :-
'$load_files'(M:Fs, [], reconsult(Fs)).
load_files(M:Fs, []).
'$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, _, _) :-
use_module(M:F).
'$exec_directive'(reexport(F), _, M, _, _) :-
'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)).
load_files(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)]).
'$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, _, _) :-
use_module(M: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_.
*
*/
system_error(Type,Goal) :-
prolog:system_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)].
beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
[execute_load_file(Stream, consult=Option)].
beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
[load_files(Files,Opts)].
beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
beautify_hidden_goal('$load_files'(Files,M,Opts,?),prolog) -->
[load_files(M:Files,Opts)].
beautify_hidden_goal('$load_files'(_,_,_,Name),prolog) -->
[Name].
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)].

8
pl/imports.yap
View File

@ -9,6 +9,11 @@
/**
* @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).
@ -22,7 +27,6 @@
'$pred_exists'(G, user).
% autoload
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
prolog_flag(autoload, true),
prolog_flag(unknown, OldUnk, fail),
(
@ -38,7 +42,7 @@
'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :-
'$parent_module'(ImportingMod,ExportingModI),
'$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),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).

25
pl/init.yap
View File

@ -33,17 +33,20 @@
nb_setval('$chr_toplevel_show_store',false).
'$init_consult' :-
set_value('$open_expands_filename',true),
nb_setval('$assert_all',off),
nb_setval('$if_level',0),
nb_setval('$endif',off),
nb_setval('$initialization_goals',off),
nb_setval('$included_file',[]),
nb_setval('$loop_streams',[]),
\+ '$undefined'('$init_preds',prolog),
'$init_preds',
fail.
'$init_consult'.
set_value('$open_expands_filename',true),
nb_setval('$assert_all',off),
nb_setval('$if_level',0),
nb_setval('$endif',off),
nb_setval('$initialization_goals',off),
nb_setval('$included_file',[]),
nb_setval('$loop_streams',[]),
(
'$undefined'('$init_preds',prolog)
->
true
;
'$init_preds'
).
'$init_win_graphics' :-
'$undefined'(window_title(_,_), system), !.

50
pl/messages.yap
View File

@ -259,11 +259,11 @@ location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
'$query_exception'(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
query_exception(prologPredFile, Desc, File),
query_exception(prologPredLine, Desc, FilePos),
query_exception(prologPredModule, Desc, M),
query_exception(prologPredName, Desc, Na),
query_exception(prologPredArity, Desc, Ar)
},
!,
display_consulting( File, Level, Info, LC ),
@ -271,9 +271,9 @@ location( error(_,Info), Level, LC ) -->
location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
'$query_exception'(errorFile, Desc, File),
'$query_exception'(errorLine, Desc, FilePos),
'$query_exception'(errorFunction, Desc, F)
query_exception(errorFile, Desc, File),
query_exception(errorLine, Desc, FilePos),
query_exception(errorFunction, Desc, F)
},
!,
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]],
[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) -->
!,
% {writeln(ci)},
@ -342,8 +346,8 @@ main_message(error(uninstantiation_error(T),_), Level, _LC) -->
display_consulting( F, Level, Info, LC) -->
{ LC > 0,
'$error_descriptor'(Info, Desc),
'$query_exception'(prologParserFile, Desc, F0),
'$query_exception'(prologarserLine, Desc, L),
query_exception(prologParserFile, Desc, F0),
query_exception(prologarserLine, Desc, L),
F \= F0
}, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
@ -358,7 +362,7 @@ display_consulting(_F, _, _, _LC) -->
caller( Info, _) -->
{ '$error_descriptor'(Info, Desc) },
({ '$query_exception'(errorGoal, Desc, Call),
({ query_exception(errorGoal, Desc, Call),
Call = M:(H :- G)
}
->
@ -372,12 +376,12 @@ caller( Info, _) -->
;
[]
),
{ '$query_exception'(prologPredFile, Desc, File),
{ query_exception(prologPredFile, Desc, File),
File \= [],
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
query_exception(prologPredLine, Desc, FilePos),
query_exception(prologPredModule, Desc, M),
query_exception(prologPredName, Desc, Na),
query_exception(prologPredArity, Desc, Ar)
},
!,
[nl],
@ -388,10 +392,10 @@ caller( _, _) -->
c_goal( Info, Level ) -->
{ '$error_descriptor'(Info, Desc) },
{ '$query_exception'(errorFile, Desc, File),
{ query_exception(errorFile, Desc, File),
Func \= [],
'$query_exception'(errorFunction, Desc, File),
'$query_exception'(errorLine, Desc, Line)
query_exception(errorFunction, Desc, File),
query_exception(errorLine, Desc, 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), _ ) -->
{
'$query_exception'(prologPredFile, Extra, Msg),
query_exception(prologPredFile, Extra, Msg),
Msg \= []
},
!,
@ -1048,6 +1052,12 @@ prolog:print_message(_Severity, _Term) :-
'$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,
[if(not_loaded),must_be_module(true)], use_module(F)).
use_module(F) :- load_files(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) :-
'$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),

8
pl/protect.yap
View File

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