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

Merge /home/vsc/yap

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

26
C/adtdefs.c
View File

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

19
C/atomic.c
View File

@ -592,8 +592,9 @@ restart_aux:
The predicate holds when at least one of the arguments is The predicate holds when at least one of the arguments is
ground (otherwise, YAP will generate an error event. _A_ must be unifiable with an atom, and the ground (otherwise, YAP will generate an error event. _A_ must be unifiable
argument _L_ with the list of the character codes for string _A_. with an atom, and the argument _L_ with the list of the character codes for
string _A_.
*/ */
@ -620,7 +621,7 @@ restart_aux:
} }
/* error handling */ /* error handling */
} else { } else {
Yap_ThrowError( TYPE_ERROR_ATOM, t1, NULL); Yap_ThrowError(TYPE_ERROR_ATOM, t1, NULL);
} }
if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) { if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) {
goto restart_aux; goto restart_aux;
@ -727,14 +728,14 @@ static Int number_chars(USES_REGS1) {
pop_text_stack(l); pop_text_stack(l);
return Yap_unify(ARG1, tf); return Yap_unify(ARG1, tf);
} }
pop_text_stack(l); pop_text_stack(l);
LOCAL_ActiveError->errorRawTerm = 0; LOCAL_ActiveError->errorRawTerm = 0;
Yap_ThrowExistingError(); Yap_ThrowExistingError();
return false; return false;
} }
pop_text_stack(l); pop_text_stack(l);
return true; return true;
} }
@ -1377,7 +1378,7 @@ restart_aux:
LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else { } else {
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); 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; int i = 0;
if (!inpv) { if (!inpv) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
@ -1465,9 +1466,7 @@ error:
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux; goto restart_aux;
} }
{ { return FALSE; }
return FALSE;
}
} }
static Int atomics_to_string2(USES_REGS1) { static Int atomics_to_string2(USES_REGS1) {
@ -2766,6 +2765,8 @@ void Yap_InitAtomPreds(void) {
Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0); Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0);
Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0); Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0);
Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0); Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0);
Yap_InitCPred("text_to_string", 2, downcase_text_to_string, 0);
Yap_InitCPred("text_to_atom", 2, downcase_text_to_string, 0);
Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0); Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0);
Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0); Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0);
Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0); Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0);

8
C/c_interface.c
View File

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

8
C/errors.c
View File

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

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

157
C/flags.c
View File

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

171
C/text.c
View File

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

2
C/tracer.c
View File

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

29
C/write.c
View File

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

2
C/yap-args.c
View File

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

2
CMakeLists.txt
View File

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

169
CXX/yapi.cpp
View File

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

8
CXX/yapt.hh
View File

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

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), YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL),
/**< how to present answers, default is `~p`. */ /**< how to present answers, default is `~p`. */
#if __ANDROID__ #if __ANDROID__
YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**< YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running an Google's Android version of the Linux Operating System */ read-only boolean, a machine running an Google's Android version of the
Linux Operating System */
#endif #endif
#if __APPLE__ #if __APPLE__
YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**< YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running an Apple Operating System */ read-only boolean, a machine running an Apple Operating System */
#endif #endif
YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**< YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**<
read-only atom, it describes the ISA used in this version of YAP. read-only atom, it describes the ISA used in this version of YAP.
Available from YAP_AEH. Available from YAP_ARCH.
*/ */
YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL), YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL),
YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true,
booleanFlag, "true", NULL), booleanFlag, "true", NULL),
/**< `arithmetic_exceptions` /**<
Read-write flag telling whether arithmetic exceptions generate Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled: Prolog exceptions. If enabled:
@ -99,7 +96,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
ProbLog. ProbLog.
*/ */
YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs), YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs),
/**> /**<
If _Value_ is unbound, tell whether a back quoted list of characters If _Value_ is unbound, tell whether a back quoted list of characters
token is converted to a list of atoms, `chars`, to a list of integers, token is converted to a list of atoms, `chars`, to a list of integers,
`codes`, or to a single atom, `atom`. If _Value_ is bound, set to `codes`, or to a single atom, `atom`. If _Value_ is bound, set to
@ -132,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, Writable flag telling whether a character escapes are enabled,
`true`, or disabled, `false`. The default value for this flag is `true`, or disabled, `false`. The default value for this flag is
`true`. */ `true`. */
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", true, booleanFlag, "true", NULL), YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
/**< `compiled_at ` /**< `compiled_at `
Read-only flag that gives the time when the main YAP binary was compiled. It Read-only flag that gives the time when the main YAP binary was compiled.
is obtained staight from the __TIME__ macro, as defined in the C99. It is obtained staight from the __TIME__ macro, as defined in the C99.
*/ YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, */
YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL), NULL),
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
/**< /**<
If _Value_ is unbound, tell whether debugging is `true` or If _Value_ is unbound, tell whether debugging is `true` or
`false`. If _Value_ is bound to `true` enable debugging, and if `false`. If _Value_ is bound to `true` enable debugging, and if
it is bound to `false` disable debugging. it is bound to `false` disable debugging.
*/ */
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true", YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL), 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, YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option, list_option,
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]", "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
NULL), NULL),
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
booleanFlag, "false", NULL), booleanFlag, "false", NULL),
YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom, "user", NULL), YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom,
"user", NULL),
/**< /**<
* A module to be inherited by all other modules. Default is user that reexports prolog. * A module to be inherited by all other modules. Default is user that
* reexports prolog.
* *
* Set it to `prolog` for SICStus Prolog like resolution, to `user` for SWI-like. * Set it to `prolog` for SICStus Prolog like resolution, to `user` for
* SWI-like.
*/ */
YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL), YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL),
/**< /**<
@ -275,11 +277,11 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth", YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth",
true, nat, "0", NULL), 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 Maximum bound on searching sub-terms for indexing, if `0` (default) no
bound. bound.
*/ */
YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true, YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true,
isatom, "normal", NULL), isatom, "normal", NULL),
/**< `informational_messages ` /**< `informational_messages `
@ -297,6 +299,8 @@ vxu `on` consider `$` a lower case character.
value `toward_zero` for the current version of YAP. value `toward_zero` for the current version of YAP.
*/ */
YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL), YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL),
YAP_FLAG(JUPYTER_FLAG, "jupyter", false, booleanFlag, "true", NULL), /**<
read-only boolean, a machine running Jupyter */
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL),
/**< `language ` /**< `language `
@ -322,7 +326,7 @@ vxu `on` consider `$` a lower case character.
Read-only flag telling the maximum arity of a functor. Takes the value Read-only flag telling the maximum arity of a functor. Takes the value
`unbounded` for the current version of YAP. `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), "INT_MAX", NULL),
YAP_FLAG(MAX_THREADS_FLAG, "max_threads", false, at2n, "MAX_THREADS", 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), 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 providing access to shared libraries (`.so` files) or to dynamic link
libraries (`.DLL` files). libraries (`.DLL` files).
*/ */
/**< `module_independent_operators ` /**< `module_independent_operators `
If `true` an operator declaration will be valid for every module in the If `true` an operator declaration will be valid for every module in the
program. This is for compatibility with old software that program. This is for compatibility with old software that
might expect module-independent operators. might expect module-independent operators.
*/ */
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
"module_independent_operators", true, booleanFlag, true, booleanFlag, "false", NULL),
"false", NULL),
YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL),
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL),
@ -372,14 +375,14 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true, YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true,
isatom, "determinism", NULL), isatom, "determinism", NULL),
/**< `prompt_alternatives_on(atom, /**< `prompt_alternatives_on(atom,
changeable) ` changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog SWI-Compatible option, determines prompting for alternatives in the Prolog
toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if
and only if the query contains variables. The alternative, default in and only if the query contains variables. The alternative, default in
SWI-Prolog is <tt>determinism</tt> which implies the system prompts for SWI-Prolog is <tt>determinism</tt> which implies the system prompts for
alternatives if the goal succeeded while leaving choicepoints. */ alternatives if the goal succeeded while leaving choicepoints. */
YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag, YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag,
"true", NULL), "true", NULL),
YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false", 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 enable the use of the readline library for console interactions, true by
default if readline was found. */ default if readline was found. */
YAP_FLAG(REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag,
"true", NULL), /**<
If _Value_ is unbound, tell whether warnings for procedures defined
in several different files are `on` or
`off`. If _Value_ is bound to `on` enable these warnings,
and if it is bound to `off` disable them. The default for YAP is
`off`, unless we are in `sicstus` or `iso` mode.
*/
YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true", YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true",
NULL), NULL),
YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom, YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom,
@ -424,6 +436,15 @@ vxu `on` consider `$` a lower case character.
/**< `single_quoted text is usuallly interpreted as atoms. This flagTerm /**< `single_quoted text is usuallly interpreted as atoms. This flagTerm
allows other inerpretations such as strings_contains_strings */ allows other inerpretations such as strings_contains_strings */
YAP_FLAG(SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag,
"true", NULL), /**<
If `true` (default `true`) YAP checks for singleton
variables when loading files. A singleton variable is a
variable that appears ony once in a clause. The name
must start with a capital letter, variables whose name
starts with underscore are never considered singleton.
*/
YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL), YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL),
/**< `signals` /**< `signals`
@ -482,8 +503,7 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true",
booleanFlag, "true",
NULL), NULL),
/**< `toplevel_hook ` /**< `toplevel_hook `
@ -493,7 +513,7 @@ vxu `on` consider `$` a lower case character.
backtracked into. 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), "true", NULL),
YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true, YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true,
list_option, "[quoted(true),numbervars(true),portrayed(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 are `silent`, `warning` and `error`. The first two create the flag
on-the-fly, with `warning` printing a message. The value `error` is on-the-fly, with `warning` printing a message. The value `error` is
consistent with ISO: it raises an existence error and does not create the consistent with ISO: it raises an existence error and does not create the
flag. See also `create_prolog_flag/3`. The default is`error`, and developers flag. See also `create_prolog_flag/3`. The default is`error`, and
are encouraged to use `create_prolog_flag/3` to create flags for their developers are encouraged to use `create_prolog_flag/3` to create flags for
library. their library.
*/ */
YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown), YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown),
/**< `unknown is iso` /**< `unknown is iso`

159
H/YapLFlagInfo.h
View File

@ -1,21 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * * Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: YapLFlagInfo.h * * File: YapLFlagInfo.h * Last rev:
* Last rev: * ** mods: * comments: local flag enumeration. *
* mods: * * *
* comments: local flag enumeration. * *************************************************************************/
* *
*************************************************************************/
/** @file YapLFlagInfo.h /** @file YapLFlagInfo.h
@ -30,74 +28,75 @@
START_LOCAL_FLAGS START_LOCAL_FLAGS
/** + `autoload`: set the system to look for undefined procedures */ /** + `autoload`: set the system to look for undefined procedures */
YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ), YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
/** + `read-only flag, that tells if Prolog is in an inner top-level */ /** + `read-only flag, that tells if Prolog is in an inner top-level */
YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ), YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL),
YAP_FLAG( CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true" , NULL ), /** + `call_counting` YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL), /** + `call_counting`
Predicates compiled with this flag set maintain a counter on the numbers of proceduree calls and of retries. These counters are decreasing counters, and they can be used as timers. Three counters are available: Predicates compiled with this flag set maintain a counter
on the numbers of proceduree calls and of retries. These counters
are decreasing counters, and they can be used as timers. Three
counters are available:
calls: number of predicate calls since execution started or since system was reset; calls: number of predicate calls since execution started or
retries: number of retries for predicates called since execution started or since counters were reset; since system was reset; retries: number of retries for predicates
calls_and_retries: count both on predicate calls and retries. called since execution started or since counters were reset;
These counters can be used to find out how many calls a certain goal takes to execute. They can also be force the computatiom yp calls_and_retries: count both on predicate calls and
stopping. retries. These counters can be used to find out how many calls a
certain goal takes to execute. They can also be force the
computatiom yp stopping.
If `on` `fileerrors` is `on`, if `off` (default) If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled. `fileerrors` is disabled.
*/ */
YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ), YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /** + `fileerrors` YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true",
NULL), /** + `fileerrors`
If `on` `fileerrors` is `on`, if `off` (default) If `on` `fileerrors` is `on`, if `off` (default)
`fileerrors` is disabled. `fileerrors` is disabled.
*/ */
YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /** + `language_mode` YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), /** + `language_mode`
wweter native mode or trying to emulate a different Prolog. wweter native mode or trying to emulate a different Prolog.
*/ */
YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /** + `redefine_warnings ` YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag,
"true", NULL), /** + `stack_dump_on_error `
If _Value_ is unbound, tell whether warnings for procedures defined If `true` show a stack dump when YAP finds an error. The default is
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
`off`. `off`.
*/ */
YAP_FLAG( STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose" , NULL ), YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose",
YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error" , NULL ), /** + `syntax_errors` NULL),
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL), /** + `syntax_errors`
Control action to be taken after syntax errors while executing read/1, Control action to be taken after syntax errors while executing read/1,
`read/2`, or `read_term/3`: `read/2`, or `read_term/3`:
+ `dec10` + `dec10`
Report the syntax error and retry reading the term. Report the syntax error and retry reading the term.
+ `fail` + `fail`
Report the syntax error and fail. Report the syntax error and fail.
+ `error` + `error`
Report the syntax error and generate an error (default). Report the syntax error and generate an error (default).
+ `quiet` + `quiet`
Just fail Just fail
*/ */
YAP_FLAG( TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user" , typein ), /** + `typein_module ` YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein), /** + `typein_module `
If bound, set the current working or type-in module to the argument, If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current which must be an atom. If unbound, unify the argument with the current
working module. working module.
*/ */
YAP_FLAG( USER_ERROR_FLAG, "user_error", true, stream, "user_error" , set_error_stream ), /** + `user_error1` YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error",
set_error_stream), /** + `user_error1`
If the second argument is bound to a stream, set user_error to If the second argument is bound to a stream, set user_error to
this stream. If the second argument is unbound, unify the argument with this stream. If the second argument is unbound, unify the argument with
the current user_error stream. the current user_error stream.
By default, the user_error stream is set to a 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: The next example shows how to use this flag:
~~~{.prolog} ~~~{.prolog}
?- open( '/dev/null', append, Error, ?- open( '/dev/null', append, Error,
[alias(mauri_tripa)] ). [alias(mauri_tripa)] ).
Error = '$stream'(3) ? ; Error = '$stream'(3) ? ;
no no
?- set_prolog_flag(user_error, mauri_tripa). ?- 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 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 user_error to the stream via the alias. Note that after we did so
prompts from the system were redirected to the stream prompts from the system were redirected to the stream
`mauri_tripa`. Last, we close the stream. At this point, YAP `mauri_tripa`. Last, we close the stream. At this point, YAP
automatically redirects the user_error alias to the original automatically redirects the user_error alias to the original
`stderr`. `stderr`.
*/ */
YAP_FLAG( USER_INPUT_FLAG, "user_input", true, stream, "user_input" , set_input_stream ), YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input",
YAP_FLAG( USER_OUTPUT_FLAG, "user_output", true, stream, "user_output" , set_output_stream ), set_input_stream),
YAP_FLAG(USER_OUTPUT_FLAG, "user_output", true, stream, "user_output",
set_output_stream),
END_LOCAL_FLAGS END_LOCAL_FLAGS
/// @} /// @}

1
H/Yapproto.h
View File

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

2
H/Yatom.h
View File

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

33
cmake/FindLibR.cmake
View File

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

2
include/YapDefs.h
View File

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

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

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

7
os/charsio.c
View File

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

54
os/fmem.c
View File

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

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, bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode,
Term file_name, encoding_t encoding, stream_flags_t flags, Term file_name, encoding_t encoding, stream_flags_t flags,
void *vfs) { void *vfs) {
fprintf(stderr,"+ %s --> %d\n", name, sno); // fprintf(stderr,"+ %s --> %d\n", name, sno);
StreamDesc *st = &GLOBAL_Stream[sno]; StreamDesc *st = &GLOBAL_Stream[sno];
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", __android_log_print(
io_mode, CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", io_mode,
name, CurrentModule == 0 ? "prolog"
sno); : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
if (io_mode == NULL) name, sno);
if (io_mode == NULL)
Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno), Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno),
"File opened with NULL Permissions"); "File opened with NULL Permissions");
if (strchr(io_mode, 'a')) { 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()}; static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR #undef PAR
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, Term user_name, Term user_name, encoding_t enc) {
encoding_t enc)
{
struct vfs *vfsp = NULL; struct vfs *vfsp = NULL;
const char *fname; const char *fname;
if (IsAtomTerm(tin)) if (IsAtomTerm(tin))
fname = RepAtom(AtomOfTerm(tin))->StrOfAE; fname = RepAtom(AtomOfTerm(tin))->StrOfAE;
@ -1290,9 +1288,10 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
return false; return false;
} }
buf = pop_output_text_stack(i, buf); buf = pop_output_text_stack(i, buf);
Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf,32)); Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf, 32));
sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding, sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding,
MEM_BUF_MALLOC, nat, MkAtomTerm(NameOfFunctor(f))); MEM_BUF_MALLOC, nat,
MkAtomTerm(NameOfFunctor(f)));
return Yap_OpenBufWriteStream(PASS_REGS1); return Yap_OpenBufWriteStream(PASS_REGS1);
} }
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) { } else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
@ -1364,9 +1363,9 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
} else { } else {
open_mode = AtomOfTerm(t2); open_mode = AtomOfTerm(t2);
} }
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END, xarg *args =
DOMAIN_ERROR_OPEN_OPTION); Yap_ArgListToVector(tlist, open_defs, OPEN_END, DOMAIN_ERROR_OPEN_OPTION);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3"); Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
@ -1375,7 +1374,7 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
} }
/* done */ /* done */
st->status = 0; st->status = 0;
const char *s_encoding; const char *s_encoding;
if (args[OPEN_ENCODING].used) { if (args[OPEN_ENCODING].used) {
tenc = args[OPEN_ENCODING].tvalue; tenc = args[OPEN_ENCODING].tvalue;
s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; 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); "type is ~a, must be one of binary or text", t);
} }
} }
st = &GLOBAL_Stream[sno]; 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; return false;
} }
if (args[OPEN_BOM].used) { if (args[OPEN_BOM].used) {
if (args[OPEN_BOM].tvalue == TermTrue) { if (args[OPEN_BOM].tvalue == TermTrue) {
avoid_bom = false; avoid_bom = false;
needs_bom = true; needs_bom = true;
@ -1671,9 +1670,8 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
st = GLOBAL_Stream + sno; st = GLOBAL_Stream + sno;
// fname = Yap_VF(fname); // fname = Yap_VF(fname);
if (fill_stream(sno, st, tin, io_mode, user_name, enc))
if (fill_stream(sno, st, tin,io_mode,user_name,enc)) return sno;
return sno;
return -1; return -1;
} }
@ -1868,13 +1866,13 @@ static Int always_prompt_user(USES_REGS1) {
return (TRUE); return (TRUE);
} }
/** @pred close(+ _S_) is iso /** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream Closes the stream _S_. If _S_ does not stand for a stream
currently opened an error is reported. The streams user_input, currently opened an error is reported. The streams user_input,
user_output, and user_error can never be closed. 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( int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0) 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 */ static Int cont_stream_property(USES_REGS1) { /* current_stream */
bool det; bool det = false;
xarg *args; xarg *args;
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1)); int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
stream_property_choices_t p = STREAM_PROPERTY_END; stream_property_choices_t p = STREAM_PROPERTY_END;
@ -705,7 +705,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION;
Yap_Error(LOCAL_Error_TYPE, t2, NULL); Yap_ThrowError(LOCAL_Error_TYPE, t2, NULL);
return false; return false;
} }
cut_fail(); cut_fail();
@ -714,16 +714,17 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) { if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) {
// one solution only // one solution only
i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue)); i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue));
free(args) UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) { if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) {
free(args);
cut_fail(); cut_fail();
} }
cut_succeed(); det = true;
} }
LOCK(GLOBAL_Stream[i].streamlock); LOCK(GLOBAL_Stream[i].streamlock);
rc = do_stream_property(i, args PASS_REGS); rc = do_stream_property(i, args PASS_REGS);
UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
if (IsVarTerm(t1)) { if (!det && IsVarTerm(t1)) {
if (rc) if (rc)
rc = Yap_unify(ARG1, Yap_MkStream(i)); rc = Yap_unify(ARG1, Yap_MkStream(i));
if (p == STREAM_PROPERTY_END) { if (p == STREAM_PROPERTY_END) {
@ -743,7 +744,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
} }
} else { } else {
// done // done
det = (p == STREAM_PROPERTY_END); det = det || (p == STREAM_PROPERTY_END);
} }
free(args); free(args);
if (rc) { if (rc) {
@ -998,7 +999,7 @@ static void CloseStream(int sno) {
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>", // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>",
// sno); // sno);
VFS_t *me; VFS_t *me;
fprintf( stderr, "- %d\n",sno); //fprintf( stderr, "- %d\n",sno);
if ((me = GLOBAL_Stream[sno].vfs) != NULL && if ((me = GLOBAL_Stream[sno].vfs) != NULL &&
GLOBAL_Stream[sno].file == NULL) { GLOBAL_Stream[sno].file == NULL) {
if (me->close) { if (me->close) {

23
os/writeterm.c
View File

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

2
os/yapio.h
View File

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

48
packages/python/py2pl.c
View File

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

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

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

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

@ -273,14 +273,15 @@ set (RESOURCES
#yap_kernel/resources/logo-32x32.png #yap_kernel/resources/logo-32x32.png
#yap_kernel/resourcess/logo-64x64.png #yap_kernel/resourcess/logo-64x64.png
) )
set (RENAMED_RESOURCES set (RENAMED_RESOURCES
yap_kernel/resources/logo-32x32.png yap_kernel/resources/logo-32x32.png
yap_kernel/resources/logo-64x64.png yap_kernel/resources/logo-64x64.png
# yap_kernel/resources/codemirror/mode/prolog/prolog.js # yap_kernel/resources/codemirror/mode/prolog/prolog.js
) )
set (PL_SOURCES yap_ipython/prolog/jupyter.yap yap_ipython/prolog/complete.yap set (PL_SOURCES yap_ipython/prolog/jupyter.yap yap_ipython/prolog/complete.yap
yap_ipython/prolog/verify.yap
) )
set(FILES ${PYTHON_SOURCES} ${PL_SOURCES} ${EXTRAS} ${RESOURCES}) set(FILES ${PYTHON_SOURCES} ${PL_SOURCES} ${EXTRAS} ${RESOURCES})
@ -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 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( install(CODE "execute_process(
COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps . COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps .
COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec
ERROR_VARIABLE setupErr
OUTPUT_VARIABLE setupOut
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})") WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})")
install(FILES ${PL_SOURCES} DESTINATION ${libpl} ) install(FILES ${PL_SOURCES} DESTINATION ${libpl} )

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

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

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

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

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

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

30
packages/real/CMakeLists.txt
View File

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

3
pl/absf.yap
View File

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

15
pl/boot.yap
View File

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

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

13
pl/directives.yap
View File

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

2
pl/errors.yap
View File

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

6
pl/hacks.yap
View File

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

8
pl/imports.yap
View File

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

25
pl/init.yap
View File

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

50
pl/messages.yap
View File

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

6
pl/modules.yap
View File

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

8
pl/protect.yap
View File

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