diff --git a/C/adtdefs.c b/C/adtdefs.c index e486176c2..b5aff1ed3 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -147,6 +147,32 @@ static inline Atom SearchAtom(const unsigned char *p, Atom a) { return (NIL); } +Atom +Yap_AtomInUse(const char *atom) { /* lookup atom in atom table */ + uint64_t hash; + const unsigned char *p; + Atom a, na = NIL; + AtomEntry *ae; + size_t sz = AtomHashTableSize; + + /* compute hash */ + p =( const unsigned char *) atom; + + hash = HashFunction(p); + hash = hash % sz; + /* we'll start by holding a read lock in order to avoid contention */ + READ_LOCK(HashChain[hash].AERWLock); + a = HashChain[hash].Entry; + /* search atom in chain */ + na = SearchAtom(p, a); + ae = RepAtom(na); + if (na != NIL ) { + READ_UNLOCK(HashChain[hash].AERWLock); + return (na); + } + READ_UNLOCK(HashChain[hash].AERWLock); + return NIL; +} static Atom LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ diff --git a/C/atomic.c b/C/atomic.c index e3016935d..a23ac1b57 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -592,8 +592,9 @@ restart_aux: The predicate holds when at least one of the arguments is - ground (otherwise, YAP will generate an error event. _A_ must be unifiable with an atom, and the - argument _L_ with the list of the character codes for string _A_. + ground (otherwise, YAP will generate an error event. _A_ must be unifiable + with an atom, and the argument _L_ with the list of the character codes for + string _A_. */ @@ -620,7 +621,7 @@ restart_aux: } /* error handling */ } else { - Yap_ThrowError( TYPE_ERROR_ATOM, t1, NULL); + Yap_ThrowError(TYPE_ERROR_ATOM, t1, NULL); } if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) { goto restart_aux; @@ -727,14 +728,14 @@ static Int number_chars(USES_REGS1) { pop_text_stack(l); return Yap_unify(ARG1, tf); } - pop_text_stack(l); + pop_text_stack(l); LOCAL_ActiveError->errorRawTerm = 0; Yap_ThrowExistingError(); return false; } - pop_text_stack(l); + pop_text_stack(l); return true; } @@ -1377,7 +1378,7 @@ restart_aux: LOCAL_Error_TYPE = TYPE_ERROR_LIST; } else { seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); - seq_tv_t *out = (seq_tv_t *)Malloc( sizeof(seq_tv_t)); + seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t)); int i = 0; if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; @@ -1465,9 +1466,7 @@ error: if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { goto restart_aux; } - { - return FALSE; - } + { return FALSE; } } static Int atomics_to_string2(USES_REGS1) { @@ -2766,6 +2765,8 @@ void Yap_InitAtomPreds(void) { Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0); Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0); Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0); + Yap_InitCPred("text_to_string", 2, downcase_text_to_string, 0); + Yap_InitCPred("text_to_atom", 2, downcase_text_to_string, 0); Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0); Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0); Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0); diff --git a/C/c_interface.c b/C/c_interface.c index 84ecd3929..1a30a292a 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2271,8 +2271,8 @@ X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze, char *b; BACKUP_MACHINE_REGS(); - b = Yap_TermToBuffer(t, enc, flags); - strncpy(buf, b, sze); + b = Yap_TermToBuffer(t, flags); + strncpy(buf, b, sze-1); buf[sze] = 0; RECOVER_MACHINE_REGS(); return true; @@ -2371,7 +2371,7 @@ X_API void YAP_FlushAllStreams(void) { X_API void YAP_Throw(Term t) { BACKUP_MACHINE_REGS(); LOCAL_ActiveError->errorNo = THROW_EVENT; - LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0); + LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0); Yap_JumpToEnv(); RECOVER_MACHINE_REGS(); } @@ -2381,7 +2381,7 @@ X_API void YAP_AsyncThrow(Term t) { BACKUP_MACHINE_REGS(); LOCAL_PrologMode |= AsyncIntMode; LOCAL_ActiveError->errorNo = THROW_EVENT; - LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, LOCAL_encoding, 0); + LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0); Yap_JumpToEnv(); LOCAL_PrologMode &= ~AsyncIntMode; RECOVER_MACHINE_REGS(); diff --git a/C/errors.c b/C/errors.c index 3abd55edb..daf573a35 100755 --- a/C/errors.c +++ b/C/errors.c @@ -324,7 +324,7 @@ bool Yap_PrintWarning(Term twarning) { PredEntry *pred = RepPredProp(PredPropByFunc( FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)", - Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f)); + Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f)); Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); bool rc; Term ts[2], err; @@ -332,7 +332,7 @@ bool Yap_PrintWarning(Term twarning) { if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && (err = LOCAL_ActiveError->errorNo)) { fprintf(stderr, "%% Warning %s while processing error: %s %s\n", - Yap_TermToBuffer(twarning, ENC_ISO_UTF8, + Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); return false; @@ -648,7 +648,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, r->culprit = NULL; } else { r->culprit = Yap_TermToBuffer( - where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + where, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); } if (LOCAL_consult_level > 0) { r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE; @@ -1149,7 +1149,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) { n = t2; } i->errorGoal = Yap_TermToBuffer( - n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + n, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); } Yap_prolog_add_culprit(i PASS_REGS); return i; diff --git a/C/exec.c b/C/exec.c index 56987beb8..4386810c9 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1460,7 +1460,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { */ /* reset the registers so that we don't have trash in abstract * machine */ - pop_text_stack(i+1); + pop_text_stack(i + 1); Yap_set_fpu_exceptions( getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); P = (yamop *)FAILCODE; @@ -1470,12 +1470,12 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { } break; case 3: { /* saved state */ // LOCAL_ActiveError = err_info; - pop_text_stack(i+1); + pop_text_stack(i + 1); LOCAL_CBorder = OldBorder; LOCAL_RestartEnv = sighold; LOCAL_PrologMode = UserMode; - LOCAL_DoingUndefp = false; -Yap_CloseSlots(sls); + LOCAL_DoingUndefp = false; + Yap_CloseSlots(sls); return false; } case 4: @@ -1485,16 +1485,16 @@ Yap_CloseSlots(sls); // LOCAL_ActiveError = err_info; while (B) { LOCAL_ActiveError->errorNo = ABORT_EVENT; - pop_text_stack(i+1); + pop_text_stack(i + 1); Yap_CloseSlots(sls); Yap_JumpToEnv(); } LOCAL_PrologMode = UserMode; - LOCAL_DoingUndefp = false; - P = (yamop *)FAILCODE; + LOCAL_DoingUndefp = false; + P = (yamop *)FAILCODE; LOCAL_RestartEnv = sighold; Yap_CloseSlots(sls); - pop_text_stack(i+1); + pop_text_stack(i + 1); return false; break; case 5: @@ -1517,15 +1517,15 @@ Yap_CloseSlots(sls); (CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) { LOCAL_RestartEnv = sighold; LOCAL_CBorder = OldBorder; - pop_text_stack(i+1); - return false; + pop_text_stack(i + 1); + return false; } P = FAILCODE; } } YENV = ASP; YENV[E_CB] = Unsigned(B); - pop_text_stack(i+1); + pop_text_stack(i + 1); out = Yap_absmi(0); /* make sure we don't leave a FAIL signal hanging around */ Yap_get_signal(YAP_FAIL_SIGNAL); @@ -1533,7 +1533,7 @@ Yap_CloseSlots(sls); CalculateStackGap(PASS_REGS1); LOCAL_CBorder = OldBorder; LOCAL_RestartEnv = sighold; - pop_text_stack(i+1); + pop_text_stack(i + 1); return out; } @@ -2116,7 +2116,8 @@ static Int jump_env(USES_REGS1) { } // Yap_DebugPlWriteln(t); // char *buf = Yap_TermToBuffer(t, ENC_ISO_UTF8, - // Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + // Quote_illegal_f | Ignore_ops_f | + // Unfold_cyclics_f); // __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " throw(%s)", buf); LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); bool out = JumpToEnv(PASS_REGS1); @@ -2124,7 +2125,7 @@ static Int jump_env(USES_REGS1) { LCL0 - (CELL *)B > LOCAL_CBorder) { // we're failing up to the top layer } - pop_text_stack(LOCAL_MallocDepth+1); + pop_text_stack(LOCAL_MallocDepth + 1); return out; } diff --git a/C/flags.c b/C/flags.c index 5711565a0..e762e41ce 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * -* * -************************************************************************** -* * -* File: flags.c * -* Last rev: * -* mods: * -* comments: abstract machine definitions * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * + * * + ************************************************************************** + * * + * File: flags.c * + * Last rev: * + * mods: * + * comments: abstract machine definitions * + * * + *************************************************************************/ /** @file C/flags.c @@ -80,22 +80,29 @@ static void newFlag(Term fl, Term val); static Int current_prolog_flag(USES_REGS1); static Int set_prolog_flag(USES_REGS1); -#include "Yatom.h" #include "YapEval.h" +#include "Yatom.h" #include "yapio.h" -#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) { NAME, WRITABLE, DEF, INIT, HELPER } +#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) \ + { NAME, WRITABLE, DEF, INIT, HELPER } #define START_LOCAL_FLAGS static flag_info local_flags_setup[] = { -#define END_LOCAL_FLAGS LZERO_FLAG}; +#define END_LOCAL_FLAGS \ + LZERO_FLAG \ + } \ + ; #define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = { -#define END_GLOBAL_FLAGS GZERO_FLAG}; - - -#define GZERO_FLAG { NULL, false, NULL, NULL, NULL } -#define LZERO_FLAG { NULL, false, NULL, NULL, NULL } +#define END_GLOBAL_FLAGS \ + GZERO_FLAG \ + } \ + ; +#define GZERO_FLAG \ + { NULL, false, NULL, NULL, NULL } +#define LZERO_FLAG \ + { NULL, false, NULL, NULL, NULL } #include "YapGFlagInfo.h" @@ -111,8 +118,7 @@ static Term indexer(Term inp) { "set_prolog_flag index in {off,single,compact,multi,on,max}"); return TermZERO; } - Yap_Error(TYPE_ERROR_ATOM, inp, - "set_prolog_flag index to an atom"); + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom"); return TermZERO; } @@ -133,14 +139,16 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) { return true; } /* bad argument, but still an atom */ - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " - "string flag, use one string, " - "atom, codes or chars", + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + "bad option %s for backquoted " + "string flag, use one string, " + "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { - Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should " - "be {string,atom,codes,chars}", + Yap_Error(TYPE_ERROR_ATOM, t2, + "set_prolog_flag(double_quotes, %s), should " + "be {string,atom,codes,chars}", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } @@ -168,9 +176,10 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) { new->flags |= BCKQ_CHARS; return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " - "string flag, use one string, " - "atom, codes or chars", + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + "bad option %s for backquoted " + "string flag, use one string, " + "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { @@ -186,7 +195,6 @@ static bool bqs(Term t2) { return bqf1(new, t2 PASS_REGS); } - static bool sqf1(ModEntry *new, Term t2 USES_REGS) { new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING); if (IsAtomTerm(t2)) { @@ -203,9 +211,10 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) { new->flags |= SNGQ_CHARS; return true; } - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted " - "string flag, use one string, " - "atom, codes or chars", + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, + "bad option %s for backquoted " + "string flag, use one string, " + "atom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE); return false; } else { @@ -215,7 +224,6 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) { } } - static bool sqf(Term t2) { CACHE_REGS ModEntry *new = Yap_GetModuleEntry(CurrentModule); @@ -239,8 +247,9 @@ static Term isaccess(Term inp) { static Term stream(Term inp) { if (IsVarTerm(inp)) return inp; - if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f | - Socket_Stream_f, + if (Yap_CheckStream(inp, + Input_Stream_f | Output_Stream_f | Append_Stream_f | + Socket_Stream_f, "yap_flag/3") >= 0) return inp; return 0; @@ -249,19 +258,19 @@ static Term stream(Term inp) { static bool set_error_stream(Term inp) { if (IsVarTerm(inp)) return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream)); - return Yap_SetErrorStream( inp ); + return Yap_SetErrorStream(inp); } static bool set_input_stream(Term inp) { if (IsVarTerm(inp)) return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream)); - return Yap_SetInputStream( inp ); + return Yap_SetInputStream(inp); } static bool set_output_stream(Term inp) { if (IsVarTerm(inp)) return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream)); - return Yap_SetOutputStream( inp ); + return Yap_SetOutputStream(inp); } static Term isground(Term inp) { @@ -731,10 +740,10 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { if (IsVarTerm(tout)) { Term t; while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) { - if (!Yap_gc(2, ENV, gc_P(P, CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return false; - } + if (!Yap_gc(2, ENV, gc_P(P, CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return false; + } } } else if (IsAtomOrIntTerm(t2)) tarr[fv->FlagOfVE].at = t2; @@ -782,7 +791,6 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { return bqf1(me, t2 PASS_REGS); } else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) { return sqf1(me, t2 PASS_REGS); - } // bad key? return false; @@ -850,8 +858,7 @@ static Int cont_yap_flag(USES_REGS1) { Term modt = CurrentModule; tflag = Yap_StripModule(tflag, &modt); while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG && - i != BACK_QUOTES_FLAG && - i != SINGLE_QUOTES_FLAG && + i != BACK_QUOTES_FLAG && i != SINGLE_QUOTES_FLAG && i != DOUBLE_QUOTES_FLAG) i++; if (i == gmax) @@ -1056,14 +1063,16 @@ void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) { Atom at = new->AtomOfME; if (at == AtomProlog || CurrentModule == PROLOG_MODULE) { - new->flags = - M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM; + new->flags = M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | + BCKQ_STRING | SNGQ_ATOM; if (at == AtomUser) - new->flags = UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM; + new->flags = + UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM; } else if (cme && cme->flags && cme != new) { new->flags = cme->flags; } else { - new->flags = (UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING |SNGQ_ATOM); + new->flags = + (UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM); } // printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags); } @@ -1391,8 +1400,9 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, return false; } CACHE_REGS - const char *us = (const char *)s; - t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1, GLOBAL_MaxPriority); + const char *us = (const char *)s; + t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1, + GLOBAL_MaxPriority); if (!t0) return false; if (IsAtomTerm(t0) || IsIntTerm(t0)) { @@ -1439,8 +1449,9 @@ do_prolog_flag_property(Term tflag, xarg *args; prolog_flag_property_choices_t i; bool rc = true; - args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, - PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); + args = + Yap_ArgList2ToVector(opts, prolog_flag_property_defs, + PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); if (args == NULL) { Yap_Error(LOCAL_Error_TYPE, opts, NULL); return false; @@ -1527,9 +1538,8 @@ static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */ lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name)); } else { if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG || - i == SINGLE_QUOTES_FLAG || - i == DOUBLE_QUOTES_FLAG || - i == BACK_QUOTES_FLAG) { + i == SINGLE_QUOTES_FLAG || i == DOUBLE_QUOTES_FLAG || + i == BACK_QUOTES_FLAG) { Term labs[2]; labs[0] = MkVarTerm(); labs[1] = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name)); @@ -1607,8 +1617,9 @@ static Int do_create_prolog_flag(USES_REGS1) { prolog_flag_property_choices_t i; Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3); - args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, - PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); + args = + Yap_ArgList2ToVector(opts, prolog_flag_property_defs, + PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); if (args == NULL) { Yap_Error(LOCAL_Error_TYPE, opts, NULL); return false; @@ -1660,15 +1671,15 @@ static Int do_create_prolog_flag(USES_REGS1) { } /** -* Init System Prolog flags. This is done in two phases: -* early on, it takes care of the atomic flags that are required by other -*modules; -* later, it looks at flags that are structured terms -* -* @param bootstrap: wether this is done before stack initialization, or -*afterwards. -* Complex terms can only be built in the second step. -*/ + * Init System Prolog flags. This is done in two phases: + * early on, it takes care of the atomic flags that are required by other + *modules; + * later, it looks at flags that are structured terms + * + * @param bootstrap: wether this is done before stack initialization, or + *afterwards. + * Complex terms can only be built in the second step. + */ void Yap_InitFlags(bool bootstrap) { CACHE_REGS @@ -1722,7 +1733,7 @@ void Yap_InitFlags(bool bootstrap) { */ Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag, 0); - Yap_InitCPredBack("yap_flag", 3, 1, prolog_flag, cont_yap_flag, 0); + Yap_InitCPredBack("yap_flag", 3, 1, yap_flag, cont_yap_flag, 0); Yap_InitCPredBack("prolog_flag", 2, 1, current_prolog_flag2, cont_current_prolog_flag, 0); Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2, diff --git a/C/text.c b/C/text.c index f9b4d0c4a..b1b78aeb9 100644 --- a/C/text.c +++ b/C/text.c @@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) { return new; } -static size_t MaxTmp(USES_REGS1) { - - return 1025; -} +static size_t MaxTmp(USES_REGS1) { return 1025; } static Term Globalize(Term v USES_REGS) { if (!IsVarTerm(v = Deref(v))) { @@ -231,7 +228,8 @@ static Term Globalize(Term v USES_REGS) { return v; } -static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) { +static void *codes2buf(Term t0, void *b0, bool get_codes, + bool fixed USES_REGS) { unsigned char *st0, *st, ar[16]; Term t = t0; size_t length = 0; @@ -242,13 +240,14 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) return st0; } if (!IsPairTerm(t)) { - Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes"); - return NULL; + Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes"); + return NULL; } bool codes = IsIntegerTerm(HeadOfTerm(t)); - if (get_codes !=codes && fixed) { + if (get_codes != codes && fixed) { if (codes) { - Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), "scanning list of codes"); + Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), + "scanning list of codes"); } else { Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms"); } @@ -266,7 +265,8 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) } Int code = IntegerOfTerm(hd); if (code < 0) { - Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, "scanning list of character codes, found %d", code); + Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, + "scanning list of character codes, found %d", code); return NULL; } length += put_utf8(ar, code); @@ -420,137 +420,146 @@ static yap_error_number gen_type_error(int flags) { // static int cnt; unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { - +#define POPRET(x) return pop_output_text_stack(lvl, x) int lvl = push_text_stack(); + char *out = NULL; + yap_error_number err0 = LOCAL_Error_TYPE; /* we know what the term is */ if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { if (!(inp->type & YAP_STRING_TERM)) { if (IsVarTerm(inp->val.t)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { LOCAL_Error_TYPE = TYPE_ERROR_STRING; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { - LOCAL_ActiveError->errorRawTerm = inp->val.t; - LOCAL_Error_TYPE = TYPE_ERROR_LIST; + LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { LOCAL_Error_TYPE = TYPE_ERROR_TEXT; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } } + if (err0 != LOCAL_Error_TYPE) { + Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in"); + } } if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); Atom at = AtomOfTerm(inp->val.t); if (RepAtom(at)->UStrOfAE[0] == 0) { - unsigned char *o = Malloc(4); - memset(o, 0, 4); - return pop_output_text_stack(lvl, o); + out = Malloc(4); + memset(out, 0, 4); + POPRET( out ); } if (inp->type & YAP_STRING_WITH_BUFFER) { pop_text_stack(lvl); return at->UStrOfAE; } - size_t sz = strlen(at->StrOfAE); - void *o = Malloc(sz + 1); - strcpy(o, at->StrOfAE); - return pop_output_text_stack(lvl, o); + { + size_t sz = strlen(at->StrOfAE); + out = Malloc(sz + 1); + strcpy(out, at->StrOfAE); + POPRET( out ); + } } if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); const char *s = StringOfTerm(inp->val.t); if (s[0] == 0) { - char *o = Malloc(4); - memset(o, 0, 4); - return pop_output_text_stack(lvl, o); + out = Malloc(4); + memset(out, 0, 4); + POPRET( out ); + } + if (inp->type & YAP_STRING_WITH_BUFFER) { + pop_text_stack(lvl); + return (unsigned char *)UStringOfTerm(inp->val.t); + } + { + inp->type |= YAP_STRING_IN_TMP; + size_t sz = strlen(s); + out = Malloc(sz + 1); + strcpy(out, s); + POPRET( out ); + } + } else if (IsPairOrNilTerm(inp->val.t)) { + if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == + (YAP_STRING_CODES | YAP_STRING_ATOMS))) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS); + POPRET( out ); + // this is a term, extract to a sfer, and representation is wide + } + if (inp->type & YAP_STRING_CODES) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a sfer, and representation is wide + POPRET( out ); + } + if (inp->type & YAP_STRING_ATOMS) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a buffer, and representation is wide + POPRET( out ); } - if (inp->type & YAP_STRING_WITH_BUFFER) - return (unsigned char *)UStringOfTerm(inp->val.t); - inp->type |= YAP_STRING_IN_TMP; - size_t sz = strlen(s); - char *o = Malloc(sz + 1); - strcpy(o, s); - return pop_output_text_stack(lvl, o); - } - if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == - (YAP_STRING_CODES | YAP_STRING_ATOMS)) && - IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a buffer, and representation is wide } if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { // ASCII, so both LATIN1 and UTF-8 // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(2 * MaxTmp(PASS_REGS1)); - if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, + out = Malloc(2 * MaxTmp(PASS_REGS1)); + if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) { - AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); + AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), out, char); } - return pop_output_text_stack(lvl, s); + POPRET( out ); } if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { - char *s; - // Yap_DebugPlWriteln(inp->val.t); - if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) { + out = Malloc(2 * MaxTmp(PASS_REGS1)); + if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) { pop_text_stack(lvl); return NULL; } - return pop_output_text_stack(lvl, s); - } + POPRET(out); + } #if USE_GMP if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(MaxTmp()); - if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) { - AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); + out = Malloc(MaxTmp()); + if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1, + 10)) { + AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), out, char); } - return inp->val.uc = pop_output_text_stack(lvl, s); + POPRET(out); } #endif if (inp->type & YAP_STRING_TERM) { - // Yap_DebugPlWriteln(inp->val.t); - char *s = (char *)Yap_TermToBuffer(inp->val.t, ENC_ISO_UTF8, 0); - return inp->val.uc = pop_output_text_stack(lvl, s); - } - if (inp->type & YAP_STRING_CHARS) { pop_text_stack(lvl); - if (inp->enc == ENC_ISO_LATIN1) { - return latin2utf8(inp); - } else if (inp->enc == ENC_ISO_ASCII) { - return inp->val.uc; - } else { // if (inp->enc == ENC_ISO_UTF8) { + return Yap_TermToBuffer(inp->val.t, 0); + } + + if (inp->type & YAP_STRING_CHARS) { + if (inp->enc == ENC_ISO_ASCII) { + pop_text_stack(lvl); return inp->val.uc; } + + if (inp->enc == ENC_ISO_LATIN1) { + POPRET( (char*)latin2utf8(inp)); + } + + if (inp->enc == ENC_ISO_UTF8) { + pop_text_stack(lvl); + return inp->val.c; + } } - pop_text_stack(lvl); if (inp->type & YAP_STRING_WCHARS) { // printf("%S\n",inp->val.w); - return wchar2utf8(inp); + POPRET( (char *)wchar2utf8(inp) ); } + pop_text_stack(lvl); return NULL; } diff --git a/C/tracer.c b/C/tracer.c index 301640d5f..c4de2fb23 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -87,7 +87,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, continue; } } - const char *sn = Yap_TermToBuffer(args[i], LOCAL_encoding, + const char *sn = Yap_TermToBuffer(args[i], Quote_illegal_f | Handle_vars_f); size_t sz; if (sn == NULL) { diff --git a/C/write.c b/C/write.c index a09895663..9abc1af3f 100644 --- a/C/write.c +++ b/C/write.c @@ -384,9 +384,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { wglb.lw = separator; wglb.stream = GLOBAL_Stream + sno; wrputf(f, &wglb); - so = Yap_MemExportStreamPtr(sno); - *s = BaseMalloc(strlen(so) + 1); - strcpy(*s, so); + *s = Yap_MemExportStreamPtr(sno); Yap_CloseStream(sno); return true; } @@ -1255,28 +1253,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, pop_text_stack(lvl); } -char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) { - CACHE_REGS - int sno = Yap_open_buf_write_stream(enc, flags); - const char *sf; - - if (sno < 0) - return NULL; - if (t == 0) - return NULL; - else - t = Deref(t); - if (enc) - GLOBAL_Stream[sno].encoding = enc; - else - GLOBAL_Stream[sno].encoding = LOCAL_encoding; - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); - - sf = Yap_MemExportStreamPtr(sno); - size_t len = strlen(sf); - char *new = malloc(len + 1); - strcpy(new, sf); - Yap_CloseStream(sno); - return new; -} diff --git a/C/yap-args.c b/C/yap-args.c index b1abc3ae9..e7be80153 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -203,13 +203,13 @@ static bool consult(const char *b_file USES_REGS) { } else { YAP_CompileClause(t); } - } while (true); yap_error_descriptor_t *errd; if ((errd = Yap_GetException(LOCAL_ActiveError))) { fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (long int) errd->errorLine, errd->classAsText, errd->errorAsText); } + } while (true); BACKUP_MACHINE_REGS(); YAP_EndConsult(c_stream, &osno, full); if (!Yap_AddAlias(AtomLoopStream, osno)) { diff --git a/CMakeLists.txt b/CMakeLists.txt index 1ae14e4ae..2365fd4bd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -554,7 +554,7 @@ IF (WITH_PYTHON) ENDIF (WITH_PYTHON) option(WITH_R - "Allow YAP->R" ON) + "Use R Interface" ON) IF (WITH_R) include_directories(packages/real ) diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index d4af76497..d955eada6 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -19,7 +19,7 @@ extern "C" { #include "YapInterface.h" #include "iopreds.h" -X_API char *Yap_TermToBuffer(Term t, encoding_t encodingp, int flags); +X_API char *Yap_TermToBuffer(Term t, int flags); X_API void YAP_UserCPredicate(const char *, YAP_UserCPred, arity_t arity); X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, arity_t, @@ -30,35 +30,32 @@ X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, #if YAP_PYTHON X_API bool do_init_python(void); #endif - - } -static void YAPCatchError() - { - if (LOCAL_CommittedError != nullptr && - LOCAL_CommittedError->errorNo != YAP_NO_ERROR ) { - // Yap_PopTermFromDB(info->errorTerm); - // throw throw YAPError( ); - Term es[2]; - es[0] = TermError; - es[1] = MkErrorTerm(LOCAL_CommittedError); - Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2); - YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es)); - // Yap_PopTermFromDB(info->errorTerm); - // throw throw YAPError( SOURCE(), ); - } else if (LOCAL_ActiveError != nullptr && - LOCAL_ActiveError->errorNo != YAP_NO_ERROR ) { - // Yap_PopTermFromDB(info->errorTerm); - // throw throw YAPError( ); - Term es[2]; - es[0] = TermError; - es[1] = MkErrorTerm(LOCAL_ActiveError); - Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2); - YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es)); - // Yap_PopTermFromDB(info->errorTerm); - // throw throw YAPError( SOURCE(), ); - } +static void YAPCatchError() { + if (LOCAL_CommittedError != nullptr && + LOCAL_CommittedError->errorNo != YAP_NO_ERROR) { + // Yap_PopTermFromDB(info->errorTerm); + // throw throw YAPError( ); + Term es[2]; + es[0] = TermError; + es[1] = MkErrorTerm(LOCAL_CommittedError); + Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2); + YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es)); + // Yap_PopTermFromDB(info->errorTerm); + // throw throw YAPError( SOURCE(), ); + } else if (LOCAL_ActiveError != nullptr && + LOCAL_ActiveError->errorNo != YAP_NO_ERROR) { + // Yap_PopTermFromDB(info->errorTerm); + // throw throw YAPError( ); + Term es[2]; + es[0] = TermError; + es[1] = MkErrorTerm(LOCAL_ActiveError); + Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2); + YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es)); + // Yap_PopTermFromDB(info->errorTerm); + // throw throw YAPError( SOURCE(), ); + } } YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) { @@ -334,7 +331,7 @@ std::vector YAPPairTerm::listToArray() { if (l < 0) { throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr); } - std::vector o = * new std::vector(l); + std::vector o = *new std::vector(l); int i = 0; Term t = gt(); while (t != TermNil) { @@ -483,7 +480,7 @@ const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a); } void YAPQuery::openQuery() { CACHE_REGS - if (ap == NULL || ap->OpcodeOfPred == UNDEF_OPCODE) { + if (ap == NULL || ap->OpcodeOfPred == UNDEF_OPCODE) { ap = rewriteUndefQuery(); } setNext(); @@ -512,7 +509,7 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) { YAPCatchError(); Yap_CloseHandles(q.CurSlot); - pop_text_stack(q.lvl+1); + pop_text_stack(q.lvl + 1); RECOVER_MACHINE_REGS(); return result; @@ -522,45 +519,46 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) { #if YAP_PYTHON // PyThreadState *_save; - //std::cerr << "mgoal " << YAPTerm(t).text() << "\n"; // _save = PyEval_SaveThread(); #endif CACHE_REGS BACKUP_MACHINE_REGS(); Term *ts = nullptr; - q.CurSlot = Yap_StartSlots(); - q.p = P; - q.cp = CP; - PredEntry *ap = nullptr; - if (IsStringTerm(tmod)) - tmod = MkAtomTerm(Yap_LookupAtom(StringOfTerm(tmod))); - YAPPredicate *p = new YAPPredicate(t, tmod, ts, "C++"); - if (p == nullptr || (ap = p->ap) == nullptr || - ap->OpcodeOfPred == UNDEF_OPCODE) { - ap = rewriteUndefEngineQuery(ap, t, tmod); - } - if (IsApplTerm(t)) - ts = RepAppl(t) + 1; - else if (IsPairTerm(t)) - ts = RepPair(t); - /* legal ap */ - arity_t arity = ap->ArityOfPE; + q.CurSlot = Yap_StartSlots(); + q.p = P; + q.cp = CP; + PredEntry *ap = nullptr; + if (IsStringTerm(tmod)) + tmod = MkAtomTerm(Yap_LookupAtom(StringOfTerm(tmod))); + YAPPredicate *p = new YAPPredicate(t, tmod, ts, "C++"); + if (p == nullptr || (ap = p->ap) == nullptr || + ap->OpcodeOfPred == UNDEF_OPCODE) { + ap = rewriteUndefEngineQuery(ap, t, tmod); + } + if (IsApplTerm(t)) + ts = RepAppl(t) + 1; + else if (IsPairTerm(t)) + ts = RepPair(t); + /* legal ap */ + arity_t arity = ap->ArityOfPE; - for (arity_t i = 0; i < arity; i++) { - XREGS[i + 1] = ts[i]; - } - ts = nullptr; - bool result; - // allow Prolog style exception handling - // don't forget, on success these guys may create slots - //__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); + for (arity_t i = 0; i < arity; i++) { + XREGS[i + 1] = ts[i]; + } + ts = nullptr; + bool result; + // allow Prolog style exception handling + // don't forget, on success these guys may create slots + //__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); - result = (bool)YAP_EnterGoal(ap, nullptr, &q); - YAP_LeaveGoal(result && !release, &q); - // PyEval_RestoreThread(_save); - RECOVER_MACHINE_REGS(); - return result; + result = (bool)YAP_EnterGoal(ap, nullptr, &q); + //std::cerr << "mgoal " << YAPTerm(t).text() << "\n"; + + YAP_LeaveGoal(result && !release, &q); + // PyEval_RestoreThread(_save); + RECOVER_MACHINE_REGS(); + return result; } /** * called when a query must be terminated and its state fully recovered, @@ -666,31 +664,29 @@ goal = YAPApplTerm(f, nts); } #endif - YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) { BACKUP_MACHINE_REGS(); try { arity_t arity = p.ap->ArityOfPE; - if (arity) { - goal = YAPApplTerm(YAPFunctor(p.ap->FunctorOfPred), ts).term(); - for (arity_t i = 0; i < arity; i++) - XREGS[i + 1] = ts[i].term(); - openQuery(); - } else { - goal = MkAtomTerm((Atom)(p.ap->FunctorOfPred)); - openQuery(); + if (arity) { + goal = YAPApplTerm(YAPFunctor(p.ap->FunctorOfPred), ts).term(); + for (arity_t i = 0; i < arity; i++) + XREGS[i + 1] = ts[i].term(); + openQuery(); + } else { + goal = MkAtomTerm((Atom)(p.ap->FunctorOfPred)); + openQuery(); + } + names = TermNil; + } catch (...) { } - names = TermNil; -} catch (...) { - - } -RECOVER_MACHINE_REGS(); + RECOVER_MACHINE_REGS(); } bool YAPQuery::next() { CACHE_REGS bool result = false; - //std::cerr << "next " << YAPTerm(goal).text() << "\n"; + // std::cerr << "next " << YAPTerm(goal).text() << "\n"; sigjmp_buf buf, *oldp = LOCAL_RestartEnv; e = nullptr; @@ -702,7 +698,7 @@ bool YAPQuery::next() { __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); if (q_state == 0) { - //Yap_do_low_level_trace = 1; + // Yap_do_low_level_trace = 1; result = (bool)YAP_EnterGoal(ap, nullptr, &q_h); } else { LOCAL_AllowRestart = q_open; @@ -710,19 +706,18 @@ bool YAPQuery::next() { } q_state = 1; __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "out %d", result); -if (!result) { + if (!result) { YAP_LeaveGoal(result, &q_h); q_open = false; } - YAPCatchError(); + YAPCatchError(); RECOVER_MACHINE_REGS(); LOCAL_RestartEnv = oldp; return result; } PredEntry *YAPQuery::rewriteUndefQuery() { - ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall - , 1, &goal)); + ARG1 = goal = Yap_SaveTerm(Yap_MkApplTerm(FunctorCall, 1, &goal)); return ap = PredCall; } @@ -894,7 +889,7 @@ PredEntry *YAPPredicate::getPred(Term &t, CELL *&out) { ap = RepPredProp(PredPropByAtom(AtomOfTerm(t), m)); return ap; } else if (IsPairTerm(t)) { - Term ts[2], *s = ( out ? out : ts ); + Term ts[2], *s = (out ? out : ts); Functor FunctorConsult = Yap_MkFunctor(Yap_LookupAtom("consult"), 1); s[1] = t; s[0] = m; @@ -909,7 +904,7 @@ PredEntry *YAPPredicate::getPred(Term &t, CELL *&out) { } else { ap = RepPredProp(PredPropByFunc(f, m)); if (out) - memmove( out, RepAppl(t) + 1, ap->ArityOfPE*sizeof(CELL) ); + memmove(out, RepAppl(t) + 1, ap->ArityOfPE * sizeof(CELL)); else out = RepAppl(t) + 1; } @@ -1017,12 +1012,12 @@ std::stringstream s; void YAPEngine::reSet() { /* ignore flags for now */ - if (B && B->cp_b && B->cp_ap != NOCODE ) - YAP_LeaveGoal(false, &q); + if (B && B->cp_b && B->cp_ap != NOCODE) + YAP_LeaveGoal(false, &q); LOCAL_ActiveError->errorNo = YAP_NO_ERROR; if (LOCAL_CommittedError) { LOCAL_CommittedError->errorNo = YAP_NO_ERROR; - free(LOCAL_CommittedError ); + free(LOCAL_CommittedError); LOCAL_CommittedError = NULL; } } diff --git a/CXX/yapt.hh b/CXX/yapt.hh index d841e9cbc..f07505234 100644 --- a/CXX/yapt.hh +++ b/CXX/yapt.hh @@ -223,19 +223,15 @@ public: /// return a string with a textual representation of the term virtual const char *text() { CACHE_REGS - encoding_t enc = LOCAL_encoding; char *os; BACKUP_MACHINE_REGS(); - if (!(os = Yap_TermToBuffer(Yap_GetFromSlot(t), enc, Handle_vars_f))) { + if (!(os = Yap_TermToBuffer(Yap_GetFromSlot(t), Handle_vars_f))) { RECOVER_MACHINE_REGS(); return 0; } RECOVER_MACHINE_REGS(); - size_t length = strlen(os); - char *sm = (char *)malloc(length + 1); - strcpy(sm, os); - return sm; + return os; }; /// return a handle to the term diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 0e626dd11..8a35204b3 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -56,29 +56,26 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 ~~~ */ - - YAP_FLAG(ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p", NULL), /**< how to present answers, default is `~p`. */ #if __ANDROID__ YAP_FLAG(ANDROID_FLAG, "android", false, booleanFlag, "true", NULL), /**< - read-only boolean, a machine running an Google's Android version of the Linux Operating System */ + read-only boolean, a machine running an Google's Android version of the + Linux Operating System */ #endif - #if __APPLE__ YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**< read-only boolean, a machine running an Apple Operating System */ #endif YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), /**< read-only atom, it describes the ISA used in this version of YAP. - Available from YAP_AEH. + Available from YAP_ARCH. */ - YAP_FLAG(ARGV_FLAG, "argv", false, argv, "@boot", NULL), YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, booleanFlag, "true", NULL), - /**< `arithmetic_exceptions` + /**< Read-write flag telling whether arithmetic exceptions generate Prolog exceptions. If enabled: @@ -99,7 +96,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 ProbLog. */ YAP_FLAG(BACK_QUOTES_FLAG, "back_quotes", true, isatom, "true", bqs), - /**> + /**< If _Value_ is unbound, tell whether a back quoted list of characters token is converted to a list of atoms, `chars`, to a list of integers, `codes`, or to a single atom, `atom`. If _Value_ is bound, set to @@ -132,20 +129,22 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 Writable flag telling whether a character escapes are enabled, `true`, or disabled, `false`. The default value for this flag is `true`. */ - YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", true, booleanFlag, "true", NULL), + YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", + true, booleanFlag, "true", NULL), /**< `compiled_at ` - Read-only flag that gives the time when the main YAP binary was compiled. It - is obtained staight from the __TIME__ macro, as defined in the C99. - */ YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, + Read-only flag that gives the time when the main YAP binary was compiled. + It is obtained staight from the __TIME__ macro, as defined in the C99. + */ + YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, NULL), YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), - /**< + /**< - If _Value_ is unbound, tell whether debugging is `true` or - `false`. If _Value_ is bound to `true` enable debugging, and if - it is bound to `false` disable debugging. - */ + If _Value_ is unbound, tell whether debugging is `true` or + `false`. If _Value_ is bound to `true` enable debugging, and if + it is bound to `false` disable debugging. +*/ YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true", NULL), @@ -155,15 +154,18 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 */ YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true, list_option, - "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]", + "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]", NULL), YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, booleanFlag, "false", NULL), - YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom, "user", NULL), + YAP_FLAG(DEFAULT_PARENT_MODULE_FLAG, "default_parent_module", true, isatom, + "user", NULL), /**< - * A module to be inherited by all other modules. Default is user that reexports prolog. + * A module to be inherited by all other modules. Default is user that + * reexports prolog. * - * Set it to `prolog` for SICStus Prolog like resolution, to `user` for SWI-like. + * Set it to `prolog` for SICStus Prolog like resolution, to `user` for + * SWI-like. */ YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL), /**< @@ -275,11 +277,11 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth", true, nat, "0", NULL), - /**< `Index_sub_term_search_depth ` + /**< `Index_sub_term_search_depth ` - Maximum bound on searching sub-terms for indexing, if `0` (default) no - bound. - */ + Maximum bound on searching sub-terms for indexing, if `0` (default) no + bound. +*/ YAP_FLAG(INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true, isatom, "normal", NULL), /**< `informational_messages ` @@ -297,6 +299,8 @@ vxu `on` consider `$` a lower case character. value `toward_zero` for the current version of YAP. */ YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL), + YAP_FLAG(JUPYTER_FLAG, "jupyter", false, booleanFlag, "true", NULL), /**< + read-only boolean, a machine running Jupyter */ YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), /**< `language ` @@ -322,7 +326,7 @@ vxu `on` consider `$` a lower case character. Read-only flag telling the maximum arity of a functor. Takes the value `unbounded` for the current version of YAP. */ - YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, + YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, "INT_MAX", NULL), YAP_FLAG(MAX_THREADS_FLAG, "max_threads", false, at2n, "MAX_THREADS", NULL), YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL), @@ -348,15 +352,14 @@ vxu `on` consider `$` a lower case character. providing access to shared libraries (`.so` files) or to dynamic link libraries (`.DLL` files). */ - /**< `module_independent_operators ` + /**< `module_independent_operators ` - If `true` an operator declaration will be valid for every module in the - program. This is for compatibility with old software that - might expect module-independent operators. - */ - YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, - "module_independent_operators", true, booleanFlag, - "false", NULL), + If `true` an operator declaration will be valid for every module in the + program. This is for compatibility with old software that + might expect module-independent operators. +*/ + YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", + true, booleanFlag, "false", NULL), YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL), @@ -372,14 +375,14 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true, isatom, "determinism", NULL), - /**< `prompt_alternatives_on(atom, - changeable) ` + /**< `prompt_alternatives_on(atom, + changeable) ` - SWI-Compatible option, determines prompting for alternatives in the Prolog - toplevel. Default is groundness, YAP prompts for alternatives if - and only if the query contains variables. The alternative, default in - SWI-Prolog is determinism which implies the system prompts for - alternatives if the goal succeeded while leaving choicepoints. */ + SWI-Compatible option, determines prompting for alternatives in the Prolog + toplevel. Default is groundness, YAP prompts for alternatives if + and only if the query contains variables. The alternative, default in + SWI-Prolog is determinism which implies the system prompts for + alternatives if the goal succeeded while leaving choicepoints. */ YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag, "true", NULL), YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false", @@ -389,6 +392,15 @@ vxu `on` consider `$` a lower case character. enable the use of the readline library for console interactions, true by default if readline was found. */ + YAP_FLAG(REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, + "true", NULL), /**< + +If _Value_ is unbound, tell whether warnings for procedures defined +in several different files are `on` or +`off`. If _Value_ is bound to `on` enable these warnings, +and if it is bound to `off` disable them. The default for YAP is +`off`, unless we are in `sicstus` or `iso` mode. +*/ YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true", NULL), YAP_FLAG(RESOURCE_DATABASE_FLAG, "resource_database", false, isatom, @@ -424,6 +436,15 @@ vxu `on` consider `$` a lower case character. /**< `single_quoted text is usuallly interpreted as atoms. This flagTerm allows other inerpretations such as strings_contains_strings */ + YAP_FLAG(SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, + "true", NULL), /**< + If `true` (default `true`) YAP checks for singleton + variables when loading files. A singleton variable is a + variable that appears ony once in a clause. The name + must start with a capital letter, variables whose name + starts with underscore are never considered singleton. + + */ YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL), /**< `signals` @@ -482,8 +503,7 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), - YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, - booleanFlag, "true", + YAP_FLAG(TOPLEVEL_HOOK_FLAG, "toplevel_hook", true, booleanFlag, "true", NULL), /**< `toplevel_hook ` @@ -493,7 +513,7 @@ vxu `on` consider `$` a lower case character. backtracked into. */ - YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag, + YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag, "true", NULL), YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true, list_option, "[quoted(true),numbervars(true),portrayed(true)]", @@ -527,9 +547,9 @@ vxu `on` consider `$` a lower case character. are `silent`, `warning` and `error`. The first two create the flag on-the-fly, with `warning` printing a message. The value `error` is consistent with ISO: it raises an existence error and does not create the - flag. See also `create_prolog_flag/3`. The default is`error`, and developers - are encouraged to use `create_prolog_flag/3` to create flags for their - library. + flag. See also `create_prolog_flag/3`. The default is`error`, and + developers are encouraged to use `create_prolog_flag/3` to create flags for + their library. */ YAP_FLAG(UNKNOWN_FLAG, "unknown", true, isatom, "error", Yap_unknown), /**< `unknown is iso` diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 24c16cc53..22cce7aa7 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -1,21 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * -* * -************************************************************************** -* * -* File: YapLFlagInfo.h * -* Last rev: * -* mods: * -* comments: local flag enumeration. * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * + * * + ************************************************************************** + * * + * File: YapLFlagInfo.h * Last rev: + ** mods: * comments: local flag enumeration. * + * * + *************************************************************************/ /** @file YapLFlagInfo.h @@ -30,74 +28,75 @@ START_LOCAL_FLAGS - /** + `autoload`: set the system to look for undefined procedures */ -YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ), -/** + `read-only flag, that tells if Prolog is in an inner top-level */ -YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ), -YAP_FLAG( CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true" , NULL ), /** + `call_counting` +/** + `autoload`: set the system to look for undefined procedures */ +YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL), + /** + `read-only flag, that tells if Prolog is in an inner top-level */ + YAP_FLAG(BREAK_LEVEL_FLAG, "break_level", true, nat, "0", NULL), + YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true", + NULL), /** + `call_counting` - Predicates compiled with this flag set maintain a counter on the numbers of proceduree calls and of retries. These counters are decreasing counters, and they can be used as timers. Three counters are available: + Predicates compiled with this flag set maintain a counter + on the numbers of proceduree calls and of retries. These counters + are decreasing counters, and they can be used as timers. Three + counters are available: - calls: number of predicate calls since execution started or since system was reset; - retries: number of retries for predicates called since execution started or since counters were reset; - calls_and_retries: count both on predicate calls and retries. - These counters can be used to find out how many calls a certain goal takes to execute. They can also be force the computatiom yp - stopping. + calls: number of predicate calls since execution started or + since system was reset; retries: number of retries for predicates + called since execution started or since counters were reset; + calls_and_retries: count both on predicate calls and + retries. These counters can be used to find out how many calls a + certain goal takes to execute. They can also be force the + computatiom yp stopping. - If `on` `fileerrors` is `on`, if `off` (default) - `fileerrors` is disabled. - */ -YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ), -YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /** + `fileerrors` + If `on` `fileerrors` is `on`, if `off` (default) + `fileerrors` is disabled. + */ + YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc), + YAP_FLAG(FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true", + NULL), /** + `fileerrors` - If `on` `fileerrors` is `on`, if `off` (default) - `fileerrors` is disabled. - */ -YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /** + `language_mode` + If `on` `fileerrors` is `on`, if `off` (default) + `fileerrors` is disabled. + */ + YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap", + NULL), /** + `language_mode` - wweter native mode or trying to emulate a different Prolog. - */ -YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /** + `redefine_warnings ` + wweter native mode or trying to emulate a different Prolog. + */ + YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, + "true", NULL), /** + `stack_dump_on_error ` - If _Value_ is unbound, tell whether warnings for procedures defined -in several different files are `on` or -`off`. If _Value_ is bound to `on` enable these warnings, -and if it is bound to `off` disable them. The default for YAP is -`off`, unless we are in `sicstus` or `iso` mode. - */ -YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, "true" , NULL ), /** + `single_var_warnings` - If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton. - - */ -YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, "false" , NULL ), /** + `stack_dump_on_error ` - - If `true` show a stack dump when YAP finds an error. The default is +If `true` show a stack dump when YAP finds an error. The default is `off`. - */ -YAP_FLAG( STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose" , NULL ), -YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error" , NULL ), /** + `syntax_errors` +*/ + YAP_FLAG(STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose", + NULL), + YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error", + NULL), /** + `syntax_errors` - Control action to be taken after syntax errors while executing read/1, +Control action to be taken after syntax errors while executing read/1, `read/2`, or `read_term/3`: - + `dec10` ++ `dec10` Report the syntax error and retry reading the term. - + `fail` ++ `fail` Report the syntax error and fail. - + `error` ++ `error` Report the syntax error and generate an error (default). - + `quiet` ++ `quiet` Just fail - */ -YAP_FLAG( TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user" , typein ), /** + `typein_module ` +*/ + YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user", + typein), /** + `typein_module ` - If bound, set the current working or type-in module to the argument, +If bound, set the current working or type-in module to the argument, which must be an atom. If unbound, unify the argument with the current working module. - */ - YAP_FLAG( USER_ERROR_FLAG, "user_error", true, stream, "user_error" , set_error_stream ), /** + `user_error1` +*/ + YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error", + set_error_stream), /** + `user_error1` - If the second argument is bound to a stream, set user_error to +If the second argument is bound to a stream, set user_error to this stream. If the second argument is unbound, unify the argument with the current user_error stream. By default, the user_error stream is set to a stream @@ -105,30 +104,32 @@ corresponding to the Unix `stderr` stream. The next example shows how to use this flag: ~~~{.prolog} - ?- open( '/dev/null', append, Error, - [alias(mauri_tripa)] ). +?- open( '/dev/null', append, Error, +[alias(mauri_tripa)] ). - Error = '$stream'(3) ? ; +Error = '$stream'(3) ? ; - no - ?- set_prolog_flag(user_error, mauri_tripa). +no +?- set_prolog_flag(user_error, mauri_tripa). - close(mauri_tripa). +close(mauri_tripa). - yes - ?- +yes +?- ~~~ - We execute three commands. First, we open a stream in write mode and +We execute three commands. First, we open a stream in write mode and give it an alias, in this case `mauri_tripa`. Next, we set user_error to the stream via the alias. Note that after we did so prompts from the system were redirected to the stream `mauri_tripa`. Last, we close the stream. At this point, YAP automatically redirects the user_error alias to the original `stderr`. - */ -YAP_FLAG( USER_INPUT_FLAG, "user_input", true, stream, "user_input" , set_input_stream ), - YAP_FLAG( USER_OUTPUT_FLAG, "user_output", true, stream, "user_output" , set_output_stream ), +*/ + YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input", + set_input_stream), + YAP_FLAG(USER_OUTPUT_FLAG, "user_output", true, stream, "user_output", + set_output_stream), -END_LOCAL_FLAGS + END_LOCAL_FLAGS -/// @} + /// @} diff --git a/H/Yapproto.h b/H/Yapproto.h index 1d170177e..89c85cc56 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -35,6 +35,7 @@ extern int Yap_HasOp(Atom); extern struct operator_entry * Yap_GetOpPropForAModuleHavingALock(struct AtomEntryStruct *, Term); extern Atom Yap_LookupAtom(const char *); +extern Atom Yap_AtomInUse(const char *atom); extern Atom Yap_ULookupAtom(const unsigned char *); extern Atom Yap_LookupAtomWithLength(const char *, size_t); extern Atom Yap_FullLookupAtom(const char *); diff --git a/H/Yatom.h b/H/Yatom.h index 0b1906f7e..522bc507f 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1298,7 +1298,7 @@ INLINE_ONLY bool IsFlagProperty(PropFlags flags) { /* Proto types */ -extern char *Yap_TermToBuffer(Term t, encoding_t encoding, int flags); +extern char *Yap_TermToBuffer(Term t, int flags); extern Term Yap_BufferToTerm(const char *s, Term opts); diff --git a/cmake/FindLibR.cmake b/cmake/FindLibR.cmake index d6a05569d..1bdfe994e 100755 --- a/cmake/FindLibR.cmake +++ b/cmake/FindLibR.cmake @@ -1,7 +1,7 @@ # # FindLibR.cmake # -# Copyright (C) 2009-11 by RStudio, Inc. +# Copyright (C) 2009-18 by RStudio, Inc. # # This program is licensed to you under the terms of version 3 of the # GNU Affero General Public License. This program is distributed WITHOUT @@ -21,11 +21,24 @@ if(APPLE) find_library(LIBR_LIBRARIES R) - if(LIBR_LIBRARIES) + + if(LIBR_LIBRARIES MATCHES ".*\\.framework") set(LIBR_HOME "${LIBR_LIBRARIES}/Resources" CACHE PATH "R home directory") set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory") set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory") set(LIBR_EXECUTABLE "${LIBR_HOME}/R" CACHE PATH "R executable") + else() + get_filename_component(_LIBR_LIBRARIES "${LIBR_LIBRARIES}" REALPATH) + get_filename_component(_LIBR_LIBRARIES_DIR "${_LIBR_LIBRARIES}" PATH) + set(LIBR_EXECUTABLE "${_LIBR_LIBRARIES_DIR}/../bin/R") + execute_process( + COMMAND ${LIBR_EXECUTABLE} "--slave" "--vanilla" "-e" "cat(R.home())" + OUTPUT_VARIABLE LIBR_HOME + ) + set(LIBR_HOME ${LIBR_HOME} CACHE PATH "R home directory") + set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory") + set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory") + set(LIBR_LIB_DIR "${LIBR_HOME}/lib" CACHE PATH "R lib directory") endif() # detection for UNIX & Win32 @@ -103,12 +116,15 @@ else() set(LIBR_INCLUDE_DIRS "${LIBR_HOME}/include" CACHE PATH "R include directory") set(LIBR_DOC_DIR "${LIBR_HOME}/doc" CACHE PATH "R doc directory") - # set library hint path based on whether we are doing a special session 64 build - if(LIBR_FIND_WINDOWS_64BIT) - set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64") - else() - set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/i386") - endif() + # set library hint path for 64-bit build + set(LIBR_ARCH "x64") + set(LIBRARY_ARCH_HINT_PATH "${LIBR_HOME}/bin/x64") + + # call dll2lib.R to ensure export files are generated + execute_process( + COMMAND "${LIBR_HOME}/bin/${LIBR_ARCH}/Rscript.exe" "dll2lib.R" + WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}/tools" + RESULT_VARIABLE LIBR_DLL2LIB_RESULT) endif() @@ -173,6 +189,7 @@ find_package_handle_standard_args(LibR DEFAULT_MSG if(LIBR_FOUND) message(STATUS "Found R: ${LIBR_HOME}") + get_filename_component(LIBR_BIN_DIR "${LIBR_EXECUTABLE}" PATH CACHE) endif() # mark low-level variables from FIND_* calls as advanced diff --git a/include/YapDefs.h b/include/YapDefs.h index fac25cc84..a48254343 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -203,6 +203,8 @@ typedef struct yap_boot_params { const char *INPUT_STARTUP; //> bootstrapping mode: YAP is not properly installed bool install; + //> jupyter mode: YAP is in space + bool jupyter; //> generats a saved space at this path const char *OUTPUT_STARTUP; //> if NON-0, minimal size for Heap or Code Area diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 059c9a175..568ecf6a2 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -70,7 +70,6 @@ Moyle. All rights reserved. static atom_t ATOM_nil; -extern int PL_unify_termv(term_t l, va_list args); extern X_API Atom YAP_AtomFromSWIAtom(atom_t at); extern X_API atom_t YAP_SWIAtomFromAtom(Atom at); @@ -818,6 +817,14 @@ X_API int PL_unify_bool(term_t t, int a) { return Yap_unify(Yap_GetFromSlot(t), iterm); } +X_API int PL_put_bool(term_t t, int a) { + CACHE_REGS + CELL *pt = Yap_AddressFromHandle( t ); + Term iterm = (a ? MkAtomTerm(AtomTrue) : MkAtomTerm(AtomFalse)); + *pt = iterm; + return true; +} + #if USE_GMP /******************************* @@ -1273,7 +1280,7 @@ YAP: NO EQUIVALENT */ X_API int PL_raise_exception(term_t exception) { CACHE_REGS LOCAL_Error_TYPE = THROW_EVENT; - LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(Yap_GetFromHandle(exception), LOCAL_encoding, TermNil); + LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(Yap_GetFromHandle(exception), 0); //Yap_PutException(Yap_GetFromSlot(exception)); Yap_RaiseException(); return 0; @@ -1321,7 +1328,7 @@ X_API int PL_unify_atom_chars(term_t t, const char *s) { Atom at; while ((at = Yap_CharsToAtom(s, ENC_ISO_LATIN1 PASS_REGS)) == 0L) { if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_unify_atom_nchars")) - return FALSE; + return true; } Yap_AtomIncreaseHold(at); return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(at)); diff --git a/os/charsio.c b/os/charsio.c index f2205d8c5..f531d312e 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -990,16 +990,11 @@ leaving the current stream position unaltered. */ static Int peek_code(USES_REGS1) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); + int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek_code/2"); Int ch; if (sno < 0) return FALSE; - if (GLOBAL_Stream[sno].status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2"); - return FALSE; - } if ((ch = Yap_peek(sno)) < 0) { #ifdef PEEK_EOF UNLOCK(GLOBAL_Stream[sno].streamlock); diff --git a/os/fmem.c b/os/fmem.c index 0257f0c6c..53f9274ca 100644 --- a/os/fmem.c +++ b/os/fmem.c @@ -203,7 +203,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) { return -1; st = GLOBAL_Stream + sno; - st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f; + st->status = Output_Stream_f | InMemory_Stream_f; + if (st->nbuf) + st->status |= FreeOnClose_Stream_f; st->linepos = 0; st->charcount = 0; st->linecount = 1; @@ -212,15 +214,15 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) { st->buf.on = true; st->nbuf = NULL; st->nsize = 0; + st->status |= Seekable_Stream_f; #if HAVE_OPEN_MEMSTREAM st->file = open_memstream(&st->nbuf, &st->nsize); // setbuf(st->file, NULL); - st->status |= Seekable_Stream_f; -#else - st->file = fmemopen((void *)st->nbuf, st->nsize, "w"); if (!st->nbuf) { return -1; } +#else + st->file = fmemopen((void *)st->nbuf, st->nsize, "w+"); #endif Yap_DefaultStreamOps(st); UNLOCK(st->streamlock); @@ -257,35 +259,41 @@ open_mem_write_stream(USES_REGS1) /* $open_mem_write_stream(-Stream) */ * by other writes.. */ char *Yap_MemExportStreamPtr(int sno) { - char *s; - if (fflush(GLOBAL_Stream[sno].file) == 0) { - s = GLOBAL_Stream[sno].nbuf; - // s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0'; - return s; + + if (fflush(GLOBAL_Stream[sno].file) < 0) { + return NULL; } - return NULL; + size_t len = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END); + char *buf = malloc(len+1); +#if HAVE_OPEN_MEMSTREAM + char *s = GLOBAL_Stream[sno].nbuf; + memcpy(buf, s, len); + // s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0'; +#else + fread(buf, sz, 1, GLOBAL_Stream[sno].file); +#endif + buf[len] = '\0'; + return buf; } static Int peek_mem_write_stream( USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */ Int sno = Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2"); - Int i; Term tf = ARG2; CELL *HI; - const char *ptr; + char *ptr; + int ch; if (sno < 0) return (FALSE); -restart: + char *p = ptr = Yap_MemExportStreamPtr(sno); + restart: HI = HR; - if (fflush(GLOBAL_Stream[sno].file) == 0) { - i = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END); - ptr = GLOBAL_Stream[sno].nbuf; - } - while (i > 0) { - --i; - tf = MkPairTerm(MkIntTerm(ptr[i]), tf); + while ((ch = *p++)) { + HR[0] = MkIntTerm(ch); + HR[1] = AbsPair(HR+2); + HR += 2; if (HR + 1024 >= ASP) { UNLOCK(GLOBAL_Stream[sno].streamlock); HR = HI; @@ -294,14 +302,14 @@ restart: Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return (FALSE); } - i = GLOBAL_Stream[sno].u.mem_string.pos; - tf = ARG2; LOCK(GLOBAL_Stream[sno].streamlock); goto restart; } } + HR[-1] = tf; UNLOCK(GLOBAL_Stream[sno].streamlock); - return (Yap_unify(ARG3, tf)); + free(ptr); + return (Yap_unify(ARG3, AbsPair(HI))); } void Yap_MemOps(StreamDesc *st) { diff --git a/os/iopreds.c b/os/iopreds.c index 9cea702d5..fee269474 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1129,13 +1129,14 @@ static void check_bom(int sno, StreamDesc *st) { bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode, Term file_name, encoding_t encoding, stream_flags_t flags, void *vfs) { - fprintf(stderr,"+ %s --> %d\n", name, sno); + // fprintf(stderr,"+ %s --> %d\n", name, sno); StreamDesc *st = &GLOBAL_Stream[sno]; - __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", - io_mode, CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, - name, - sno); - if (io_mode == NULL) + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid", "init %s %s:%s stream <%d>", io_mode, + CurrentModule == 0 ? "prolog" + : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, + name, sno); + if (io_mode == NULL) Yap_Error(PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, MkIntegerTerm(sno), "File opened with NULL Permissions"); if (strchr(io_mode, 'a')) { @@ -1232,13 +1233,10 @@ typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t; static const param_t open_defs[] = {OPEN_DEFS()}; #undef PAR - -static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, Term user_name, - encoding_t enc) -{ +static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, + Term user_name, encoding_t enc) { struct vfs *vfsp = NULL; const char *fname; - if (IsAtomTerm(tin)) fname = RepAtom(AtomOfTerm(tin))->StrOfAE; @@ -1290,9 +1288,10 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, return false; } buf = pop_output_text_stack(i, buf); - Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf,32)); + Atom nat = Yap_LookupAtom(Yap_StrPrefix(buf, 32)); sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding, - MEM_BUF_MALLOC, nat, MkAtomTerm(NameOfFunctor(f))); + MEM_BUF_MALLOC, nat, + MkAtomTerm(NameOfFunctor(f))); return Yap_OpenBufWriteStream(PASS_REGS1); } } else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) { @@ -1364,9 +1363,9 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) { } else { open_mode = AtomOfTerm(t2); } - /* get options */ - xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END, - DOMAIN_ERROR_OPEN_OPTION); + /* get options */ + xarg *args = + Yap_ArgListToVector(tlist, open_defs, OPEN_END, DOMAIN_ERROR_OPEN_OPTION); if (args == NULL) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) { Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3"); @@ -1375,7 +1374,7 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) { } /* done */ st->status = 0; - const char *s_encoding; + const char *s_encoding; if (args[OPEN_ENCODING].used) { tenc = args[OPEN_ENCODING].tvalue; s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; @@ -1436,14 +1435,14 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) { "type is ~a, must be one of binary or text", t); } } - + st = &GLOBAL_Stream[sno]; - if (!fill_stream(sno, st, file_name,io_mode,st->user_name,st->encoding)) { + if (!fill_stream(sno, st, file_name, io_mode, st->user_name, st->encoding)) { return false; } -if (args[OPEN_BOM].used) { + if (args[OPEN_BOM].used) { if (args[OPEN_BOM].tvalue == TermTrue) { avoid_bom = false; needs_bom = true; @@ -1671,9 +1670,8 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name, st = GLOBAL_Stream + sno; // fname = Yap_VF(fname); - - if (fill_stream(sno, st, tin,io_mode,user_name,enc)) - return sno; + if (fill_stream(sno, st, tin, io_mode, user_name, enc)) + return sno; return -1; } @@ -1868,13 +1866,13 @@ static Int always_prompt_user(USES_REGS1) { return (TRUE); } - /** @pred close(+ _S_) is iso +/** @pred close(+ _S_) is iso Closes the stream _S_. If _S_ does not stand for a stream currently opened an error is reported. The streams user_input, user_output, and user_error can never be closed. */ - static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ +static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ int sno = CheckStream( ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); if (sno < 0) diff --git a/os/streams.c b/os/streams.c index b0748e835..8e5baa2bc 100644 --- a/os/streams.c +++ b/os/streams.c @@ -683,7 +683,7 @@ static xarg *generate_property(int sno, Term t2, } static Int cont_stream_property(USES_REGS1) { /* current_stream */ - bool det; + bool det = false; xarg *args; int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1)); stream_property_choices_t p = STREAM_PROPERTY_END; @@ -705,7 +705,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; - Yap_Error(LOCAL_Error_TYPE, t2, NULL); + Yap_ThrowError(LOCAL_Error_TYPE, t2, NULL); return false; } cut_fail(); @@ -714,16 +714,17 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) { // one solution only i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue)); - free(args) UNLOCK(GLOBAL_Stream[i].streamlock); + UNLOCK(GLOBAL_Stream[i].streamlock); if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) { + free(args); cut_fail(); } - cut_succeed(); + det = true; } LOCK(GLOBAL_Stream[i].streamlock); rc = do_stream_property(i, args PASS_REGS); UNLOCK(GLOBAL_Stream[i].streamlock); - if (IsVarTerm(t1)) { + if (!det && IsVarTerm(t1)) { if (rc) rc = Yap_unify(ARG1, Yap_MkStream(i)); if (p == STREAM_PROPERTY_END) { @@ -743,7 +744,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ } } else { // done - det = (p == STREAM_PROPERTY_END); + det = det || (p == STREAM_PROPERTY_END); } free(args); if (rc) { @@ -998,7 +999,7 @@ static void CloseStream(int sno) { // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "close stream <%d>", // sno); VFS_t *me; - fprintf( stderr, "- %d\n",sno); + //fprintf( stderr, "- %d\n",sno); if ((me = GLOBAL_Stream[sno].vfs) != NULL && GLOBAL_Stream[sno].file == NULL) { if (me->close) { diff --git a/os/writeterm.c b/os/writeterm.c index fe2b279f3..c4586f8ec 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -672,7 +672,7 @@ static Int term_to_string(USES_REGS1) { Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1); const char *s; if (IsVarTerm(t2)) { - s = Yap_TermToBuffer(ARG1, LOCAL_encoding, Quote_illegal_f | Handle_vars_f); + s = Yap_TermToBuffer(t1, Quote_illegal_f | Handle_vars_f); if (!s || !MkStringTerm(s)) { Yap_Error(RESOURCE_ERROR_HEAP, t1, "Could not get memory from the operating system"); @@ -692,7 +692,7 @@ static Int term_to_atom(USES_REGS1) { Term t2 = Deref(ARG2), ctl, rc = false; Atom at; if (IsVarTerm(t2)) { - const char *s = Yap_TermToBuffer(Deref(ARG1), LOCAL_encoding, + const char *s = Yap_TermToBuffer(Deref(ARG1), Quote_illegal_f | Handle_vars_f); if (!s || !(at = Yap_UTF8ToAtom((const unsigned char *)s))) { Yap_Error(RESOURCE_ERROR_HEAP, t2, @@ -711,6 +711,25 @@ static Int term_to_atom(USES_REGS1) { Yap_unify(rc, ARG1); } +char *Yap_TermToBuffer(Term t, int flags) { + CACHE_REGS + int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags); + + if (sno < 0) + return NULL; + if (t == 0) + return NULL; + else + t = Deref(t); + GLOBAL_Stream[sno].encoding = LOCAL_encoding; + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); + + char *new = Yap_MemExportStreamPtr(sno); + Yap_CloseStream(sno); + return new; +} + void Yap_InitWriteTPreds(void) { Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag); Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag); diff --git a/os/yapio.h b/os/yapio.h index 2fd961bcc..76ee6f0bb 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -89,7 +89,7 @@ extern int Yap_GetCharForSIGINT(void); extern Int Yap_StreamToFileNo(Term); extern int Yap_OpenStream(Term tin, const char* io_mode, Term user_name, encoding_t enc); extern int Yap_FileStream(FILE*, char *, Term, int, VFS_t *); -extern char *Yap_TermToBuffer(Term t, encoding_t encoding, int flags); +extern char *Yap_TermToBuffer(Term t, int flags); extern char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, encoding_t *encoding, int flags); extern int Yap_GetFreeStreamD(void); diff --git a/packages/python/py2pl.c b/packages/python/py2pl.c index 889c40c08..d6606001f 100644 --- a/packages/python/py2pl.c +++ b/packages/python/py2pl.c @@ -46,11 +46,12 @@ foreign_t assign_to_symbol(term_t t, PyObject *e) { PyObject *dic; if (!lookupPySymbol(s, NULL, &dic)) dic = py_Main; - Py_INCREF(e); + Py_INCREF(e); return PyObject_SetAttrString(dic, s, e) == 0; } -foreign_t python_to_term(PyObject *pVal, term_t t) { +foreign_t python_to_term(PyObject *pVal, term_t t) +{ bool rc = true; term_t to = PL_new_term_ref(); // fputs(" <<*** ",stderr); PyObject_Print(pVal,stderr,0); @@ -89,14 +90,14 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { #else const char *s = PyUnicode_AsUTF8(pVal); #endif -// if (PyDict_GetItemString(py_Atoms, s)) -// rc = rc && PL_unify_atom_chars(t, s); -// else + if (Yap_AtomInUse(s)) rc = rc && PL_unify_atom_chars(t, s); - } else if (PyByteArray_Check(pVal)) { - rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal)); - #if PY_MAJOR_VERSION < 3 - } else if (PyString_Check(pVal)) { + else + rc = rc && PL_unify_string_chars(t, s); + } else if (PyByteArray_Check(pVal)) { + rc = rc && PL_unify_string_chars(t, PyByteArray_AsString(pVal)); +#if PY_MAJOR_VERSION < 3 + } else if (PyString_Check(pVal)) { rc = rc && PL_unify_string_chars(t, PyString_AsString(pVal)); #endif } else if (PyTuple_Check(pVal)) { @@ -130,15 +131,18 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { } if (PL_unify_functor(t, f)) { for (i = 0; i < sz; i++) { - if (!PL_get_arg(i + 1, t, to)) + term_t to = PL_new_term_ref(); + if (!PL_get_arg(i + 1, t, to)) rc = false; PyObject *p = PyTuple_GetItem(pVal, i); if (p == NULL) { PyErr_Clear(); p = Py_None; - } - rc = rc && python_to_term(p, to); - } + } else { + rc = rc && python_to_term(p, to); + } + PL_reset_term_refs(to); + } } else { rc = false; } @@ -150,11 +154,13 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { for (i = 0; i < sz; i++) { PyObject *obj; + term_t to = PL_new_term_ref(); rc = rc && PL_unify_list(t, to, t); if ((obj = PyList_GetItem(pVal, i)) == NULL) { obj = Py_None; } rc = rc && python_to_term(obj, to); + PL_reset_term_refs(to); if (!rc) return false; } @@ -163,7 +169,6 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { // Yap_DebugPlWrite(yt); fputs("[***]\n", stderr); } else if (PyDict_Check(pVal)) { Py_ssize_t pos = 0; - term_t to = PL_new_term_ref(), ti = to; int left = PyDict_Size(pVal); PyObject *key, *value; @@ -173,6 +178,7 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { while (PyDict_Next(pVal, &pos, &key, &value)) { term_t tkey = PL_new_term_ref(), tval = PL_new_term_ref(), tint, tnew = PL_new_term_ref(); + term_t to = PL_new_term_ref(); /* do something interesting with the values... */ if (!python_to_term(key, tkey)) { continue; @@ -191,21 +197,22 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { PL_reset_term_refs(tkey); rc = false; } - if (!PL_unify(ti, tint)) { + if (!PL_unify(to, tint)) { rc = false; } - ti = tnew; - PL_reset_term_refs(tkey); } rc = rc && PL_unify(t, to); } } else { rc = rc && repr_term(pVal, t); } - PL_reset_term_refs(to); + return rc; } + + + X_API YAP_Term pythonToYAP(PyObject *pVal) { term_t t = PL_new_term_ref(); @@ -215,12 +222,13 @@ X_API YAP_Term pythonToYAP(PyObject *pVal) { } YAP_Term tt = YAP_GetFromSlot(t); PL_reset_term_refs(t); - //Py_DECREF(pVal); + // Py_DECREF(pVal); return tt; } PyObject *py_Local, *py_Global; + /** * assigns the Python RHS to a Prolog term LHS, ie LHS = RHS * @@ -317,7 +325,7 @@ bool python_assign(term_t t, PyObject *exp, PyObject *context) { if (PySequence_Check(o) && PyInt_Check(i)) { long int j; j = PyInt_AsLong(i); - return PySequence_SetItem(o, i, exp) == 0; + return PySequence_SetItem(o, i, exp) == 0; } #endif if (PyDict_Check(o)) { diff --git a/packages/python/swig/yap4py/yapi.py b/packages/python/swig/yap4py/yapi.py index 06aff6c4c..5f135e122 100644 --- a/packages/python/swig/yap4py/yapi.py +++ b/packages/python/swig/yap4py/yapi.py @@ -41,6 +41,18 @@ class Engine( YAPEngine ): self.goal(release) +class JupyterEngine( Engine ): + + def __init__(self, args=None,self_contained=False,**kwargs): + # type: (object) -> object + if not args: + args = EngineArgs(**kwargs) + args.jupyter = True + Engine.__init__(self, args) + self.goal(set_prolog_flag('verbose', 'silent'),True) + self.goal(compile(library('jupyter')), True) + self.goal(set_prolog_flag('verbose', 'normal'), True) + class EngineArgs( YAPEngineArgs ): """ Interface to Engine Options class""" def __init__(self, args=None,**kwargs): diff --git a/packages/python/yap_kernel/CMakeLists.txt b/packages/python/yap_kernel/CMakeLists.txt index 02422978c..91420dd99 100644 --- a/packages/python/yap_kernel/CMakeLists.txt +++ b/packages/python/yap_kernel/CMakeLists.txt @@ -273,14 +273,15 @@ set (RESOURCES #yap_kernel/resources/logo-32x32.png #yap_kernel/resourcess/logo-64x64.png ) - -set (RENAMED_RESOURCES + +set (RENAMED_RESOURCES yap_kernel/resources/logo-32x32.png yap_kernel/resources/logo-64x64.png # yap_kernel/resources/codemirror/mode/prolog/prolog.js ) set (PL_SOURCES yap_ipython/prolog/jupyter.yap yap_ipython/prolog/complete.yap + yap_ipython/prolog/verify.yap ) set(FILES ${PYTHON_SOURCES} ${PL_SOURCES} ${EXTRAS} ${RESOURCES}) @@ -321,11 +322,13 @@ add_custom_target(YAP_KERNEL ALL DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png yap.tgz ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${CMAKE_CURRENT_BINARY_DIR}/yap.tgz ) - + install(CODE "execute_process( COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps . COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec + ERROR_VARIABLE setupErr + OUTPUT_VARIABLE setupOut WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})") install(FILES ${PL_SOURCES} DESTINATION ${libpl} ) diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap index abc85b04e..c82125571 100644 --- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap +++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap @@ -4,6 +4,7 @@ * @brief JUpyter support. */ +:- yap_flag(gc_trace,verbose). % :- module( jupyter, % [jupyter_query/3, @@ -35,7 +36,11 @@ jupyter_cell( _Caller, _, Line ) :- !. jupyter_cell( Caller, _, Line ) :- Self := Caller.query, - python_query(Self,Line). + catch( + python_query(Self,Line), + E=error(A,B), + system_error(A,B) + ). restreams(call) :- streams(true). @@ -55,42 +60,37 @@ jupyter_consult(Cell) :- % Name = 'Inp', % stream_property(Stream, file_name(Name) ), % setup_call_cleanup( - open_mem_read_stream( Cell, Stream), - load_files(user:'jupyter cell',[stream(Stream)]). + catch( + ( + Options = [], + open_mem_read_stream( Cell, Stream), + load_files(user:'jupyter cell',[stream(Stream)| Options]) + ), + E=error(A,B), + (close(Stream), system_error(A,B)) + ), + fail. +jupyter_consult(_Cell). blank(Text) :- + atom(Text), + !, atom_codes(Text, L), maplist( code_type(space), L). - -:- dynamic cell_stream/1. +blank(Text) :- + string(Text), + !, + string_codes(Text, L), + maplist( code_type(space), L). streams(false) :- - nb_setval(jupyter_cell, false), - retract(cell_stream(S)), - close(S), - fail. -streams(false). + close(user_input), + close(user_output), + close(user_error). streams(true) :- - streams( false ), - nb_setval(jupyter_cell, true), -% \+ current_stream('/python/input',_,_), open('/python/input', read, Input, [alias(user_input),bom(false),script(false)]), - assert( cell_stream( Input) ), - set_prolog_flag(user_input,Input), - fail. -streams(true) :- -% \+ current_stream('/python/sys.stdout',_,_), open('/python/sys.stdout', append, Output, [alias(user_output)]), - set_prolog_flag(user_output, Output), - assert( cell_stream( Output) ), - fail. -streams(true) :- - % \+ current_stream('/python/sys.stderr',_,_), - open('/python/sys.stderr', append, Error, [alias(user_error)]), - assert( cell_stream( Error) ), - set_prolog_flag(user_error, Error), - fail. -streams(true). + open('/python/sys.stderr', append, Error, [alias(user_error)]). ready(_Self, Line ) :- blank( Line ), diff --git a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap new file mode 100644 index 000000000..e951d38bf --- /dev/null +++ b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap @@ -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). diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py index 16063ea3d..562f2bd34 100644 --- a/packages/python/yap_kernel/yap_ipython/yapi.py +++ b/packages/python/yap_kernel/yap_ipython/yapi.py @@ -510,10 +510,9 @@ class YAPRun: def __init__(self, shell): self.shell = shell - self.yapeng = Engine() + self.yapeng = JupyterEngine() global engine engine = self.yapeng - self.yapeng.goal(use_module(library("jupyter")),True) self.query = None self.os = None self.it = None @@ -573,7 +572,6 @@ class YAPRun: except Exception as e: sys.stderr.write('Exception after', self.bindings, '\n') has_raised = True - self.yapeng.mgoal(streams(False),"user", True) return False,[] @@ -730,13 +728,13 @@ class YAPRun: # state = tracer.runfunc(jupyter_query( self, cell ) ) self.shell.last_execution_succeeded = True self.result.result = (True, dicts) - self.yapeng.mgoal(streams(False),"user", True) except Exception as e: has_raised = True self.result.result = False self.yapeng.mgoal(streams(False),"user", True) + self.yapeng.mgoal(streams(False),"user", True) self.shell.last_execution_succeeded = not has_raised # Reset this so later displayed values do not modify the diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index 0151bee32..a05d633dd 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -2,30 +2,12 @@ # PROJECT ( YAP_REAL C ) -# -# - This module locates an installed R distribution. -# -# Defines the following: -# R_COMMAND - Path to R command -# R_HOME - Path to 'R home', as reported by R -# R_INCLUDE_DIR - Path to R include directory -# R_LIBRARY_BASE - Path to R library -# R_LIBRARY_BLAS - Path to Rblas / blas library -# R_LIBRARY_LAPACK - Path to Rlapack / lapack library -# R_LIBRARY_READLINE - Path to readline library -# R_LIBRARIES - Array of: R_LIBRARY_BASE, R_LIBRARY_BLAS, R_LIBRARY_LAPACK, R_LIBRARY_BASE [, R_LIBRARY_READLINE] -# -# VTK_R_HOME - (deprecated, use R_HOME instead) Path to 'R home', as reported by R -# -# Variable search order: -# 1. Attempt to locate and set R_COMMAND -# If unsuccessful, generate error and prompt user to manually set R_COMMAND -# 2. Use R_COMMAND to set R_HOME -# 3. Locate other libraries in the priority: -# 1. Within a user-built instance of R at R_HOME -# 2. Within an installed instance of R -# 3. Within external system libraries -# + +# LIBR_FOUND +# LIBR_HOME +# LIBR_INCLUDE_DIRS +# LIBR_DOC_DIR +# LIBR_LIBRARIES if (R_LIBRARIES AND R_INCLUDE_DIR) set_package_properties(R PROPERTIES diff --git a/pl/absf.yap b/pl/absf.yap index 58d56817d..df1967057 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -302,8 +302,7 @@ absolute_file_name(File0,File) :- !, F. '$cat_file_name'(File, S) --> - {string(File), string_to_codes(File, S) }, - !, + {string(File), string_codes(File, S) }, S. diff --git a/pl/boot.yap b/pl/boot.yap index 94ebc41d8..46287f3cb 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -121,9 +121,11 @@ print_message(L,E) :- ). '$undefp0'([M|G], _Action) :- - stream_property( loop_stream, file_name(F)), - stream_property( loop_stream, line_number(L)), - format(user_error,'~a:~d error undefined: call to ~w~n',[F,L,M:G]), + stream_property( loop_stream, [file_name(F), line_number(L)]), + format(user_error,'~a:~d error undefined:',[F,L]), + fail + ; + format(user_error,' call to ~w~n',[M:G]), fail. :- '$undefp_handler'('$undefp0'(_,_),prolog). @@ -262,6 +264,7 @@ initialize_prolog :- :- c_compile( 'preds.yap' ). :- c_compile( 'modules.yap' ). :- c_compile( 'grammar.yap' ). +:- c_compile( 'protect.yap' ). :- ['absf.yap']. @@ -314,11 +317,7 @@ initialize_prolog :- :- multifile prolog:'$system_predicate'/2. -:- ['protect.yap']. - -version(yap,[6,4]). - -:- op(1150,fx,(mode)). +:- '$opdec'(1150,fx,(mode),prolog). :- dynamic 'extensions_to_present_answer'/1. diff --git a/pl/consult.yap b/pl/consult.yap index 6cb1e38b9..c00331f1d 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -220,8 +220,10 @@ SWI-compatible option where if _Autoload_ is `true` undefined % compilation_mode(compact,source,assert_all) => implemented % register(true, false) => implemented % -load_files(Files,Opts) :- - '$load_files'(Files,Opts,load_files(Files,Opts)). +load_files(Files0,Opts) :- + '$yap_strip_module'(Files0,M,Files), + '$load_files'(Files,M,Opts,M:load_files(Files,Opts)). + '$lf_option'(autoload, 1, false). '$lf_option'(derived_from, 2, false). @@ -232,7 +234,14 @@ load_files(Files,Opts) :- '$lf_option'(qcompile, 7, Current) :- '__NB_getval__'('$qcompile', Current, Current = never). '$lf_option'(silent, 8, _). -'$lf_option'(skip_unix_header, 9, true). +'$lf_option'(skip_unix_header, 9, Skip) :- + stream_property(Stream,[alias(loop_stream),tty(TTy),reposition(Rep)]), + ( Rep == true + -> + (TTy = true -> Skip = false ; Skip = true) + ; + Skip = false + ). '$lf_option'(compilation_mode, 10, Flag) :- current_prolog_flag(source, YFlag), ( YFlag == false -> Flag = compact ; Flag = source ). @@ -271,42 +280,70 @@ load_files(Files,Opts) :- '$lf_option'(Op, Id, _), setarg( Id, TOpts, Val ). -'$load_files'(Files, Opts, Call) :- - ( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> - '$lf_opt'(autoload, OldTOpts, OldAutoload) - ; - '$lf_option'(last_opt, LastOpt), - functor( OldTOpts, opt, LastOpt ), - '$lf_opt'('$context_module', OldTOpts, user) - ), - '$lf_option'(last_opt, LastOpt), - functor( TOpts, opt, LastOpt ), - ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), - '$lf_opt'('$location', TOpts, ParentF:Line), - '$lf_opt'('$files', TOpts, Files), - '$lf_opt'('$call', TOpts, Call), - '$lf_opt'('$options', TOpts, Opts), - '$lf_opt'('$parent_topts', TOpts, OldTOpts), - '$process_lf_opts'(Opts,TOpts,Files,Call), - '$lf_default_opts'(1, LastOpt, TOpts), - '$lf_opt'(stream, TOpts, Stream), - ( nonvar(Stream) -> - '$set_lf_opt'('$from_stream', TOpts, true ) - ; - '$check_files'(Files,load_files(Files,Opts)) - ), - '$check_use_module'(Call,UseModule), - '$lf_opt'('$use_module', TOpts, UseModule), - '$current_module'(M0), - ( '$lf_opt'(autoload, TOpts, Autoload), - var(Autoload) -> - Autoload = OldAutoload - ; - true - ), - % make sure we can run consult - '$init_consult', - '$lf'(Files, M0, Call, TOpts). +'$load_files'([user], M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [stream(S)|Opts], Call). +'$load_files'(user, M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [stream(S)|Opts], Call). +'$load_files'([-user], M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(-user, M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'([user_input], M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [stream(S)|Opts], Call). +'$load_files'(user_input, M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [stream(S)|Opts], Call). +'$load_files'([-user_input], M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(-user_input, M,Opts, Call) :- + '$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(Files, M, Opts, Call) :- + '$load_files__'(Files, M, Opts, Call). +'$load_files__'(Files, M, Opts, Call) :- + '$lf_option'(last_opt, LastOpt), + ( '__NB_getval__'('$lf_status', OldTOpts, fail), + nonvar(OldTOpts) + -> + '$lf_opt'(autoload, OldTOpts, OldAutoload), + '$lf_opt'('$context_module', OldTOpts, OldContextModule) + ; + current_prolog_flag(autoload, OldAutoload), + functor( OldTOpts, opt, LastOpt ), + '$lf_opt'(autoload, OldTOpts, OldAutoload), + '$lf_opt'('$context_module', OldTOpts, OldContextModule) + ), + functor( TOpts, opt, LastOpt ), + ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), + '$lf_opt'('$location', TOpts, ParentF:Line), + '$lf_opt'('$files', TOpts, Files), + '$lf_opt'('$call', TOpts, Call), + '$lf_opt'('$options', TOpts, Opts), + '$lf_opt'('$parent_topts', TOpts, OldTOpts), + '$process_lf_opts'(Opts,TOpts,Files,Call), + '$lf_default_opts'(1, LastOpt, TOpts), + '$lf_opt'(stream, TOpts, Stream), + ( nonvar(Stream) -> + '$set_lf_opt'('$from_stream', TOpts, true ) + ; + '$check_files'(Files,load_files(Files,Opts)) + ), + '$check_use_module'(Call,UseModule), + '$lf_opt'('$use_module', TOpts, UseModule), + ( '$lf_opt'(autoload, TOpts, Autoload), + var(Autoload) -> + Autoload = OldAutoload + ; + true + ), + % make sure we can run consult + '$init_consult', + '$lf'(Files, M, Call, TOpts). '$check_files'(Files, Call) :- var(Files), !, @@ -428,32 +465,12 @@ load_files(Files,Opts) :- '$lf'(V,_,Call, _ ) :- var(V), !, '$do_error'(instantiation_error,Call). '$lf'([], _, _, _) :- !. -'$lf'(M:X, _, Call, TOpts) :- !, - ( - atom(M) - -> - '$lf'(X, M, Call, TOpts) - ; - '$do_error'(type_error(atom,M),Call) - ). '$lf'([F|Fs], Mod, Call, TOpts) :- !, % clean up after each consult ( '$lf'(F,Mod,Call, TOpts), fail; '$lf'(Fs, Mod, Call, TOpts), fail; true ). -'$lf'(user, Mod, Call, TOpts) :- - !, - stream_property( S, alias( user_input )), - '$set_lf_opt'('$from_stream', TOpts, true), - '$set_lf_opt'( stream , TOpts, S), - '$lf'(S, Mod, Call, TOpts). -'$lf'(user_input, Mod, Call, TOpts ) :- - !, - stream_property( S, alias( user_input )), - '$set_lf_opt'('$from_stream', TOpts, true), - '$set_lf_opt'( stream , TOpts, S), - '$lf'(S, Mod, Call, TOpts). '$lf'(File, Mod, Call, TOpts) :- '$lf_opt'(stream, TOpts, Stream), b_setval('$user_source_file', File), @@ -544,10 +561,10 @@ When the files are not module files, ensure_loaded/1 loads them _F_ must be a list containing the names of the files to load. */ ensure_loaded(Fs) :- - '$load_files'(Fs, [if(not_loaded)],ensure_loaded(Fs)). + load_files(Fs, [if(not_loaded)]). compile(Fs) :- - '$load_files'(Fs, [], compile(Fs)). + load_files(Fs, []). /** @pred [ _F_ ] @@ -581,9 +598,9 @@ consult(Fs) :- '$consult'(Fs,Module) :- current_prolog_flag(language_mode, iso), % SICStus Prolog compatibility !, - '$load_files'(Module:Fs,[],consult(Fs)). + load_files(Module:Fs,[]). '$consult'(Fs, Module) :- - '$load_files'(Module:Fs,[consult(consult)],consult(Fs)). + load_files(Module:Fs,[consult(consult)]). /** @@ -616,7 +633,7 @@ Example: */ reconsult(Fs) :- - '$load_files'(Fs, [], reconsult(Fs)). + load_files(Fs, []). /* exo_files(+ _Files_) @@ -636,7 +653,7 @@ different forms of indexing, as shown in @cite x. */ exo_files(Fs) :- - '$load_files'(Fs, [consult(exo), if(not_loaded)], exo_files(Fs)). + load_files(Fs, [consult(exo), if(not_loaded)]). /** @@ -667,7 +684,7 @@ YAP implements load_db/1 as a two-step non-optimised process. First, db_files/1 itself is just a call to load_files/2. */ db_files(Fs) :- - '$load_files'(Fs, [consult(db), if(not_loaded)], exo_files(Fs)). + load_files(Fs, [consult(db), if(not_loaded)]). '$csult'(Fs, _M) :- @@ -677,9 +694,9 @@ db_files(Fs) :- !. '$csult'(Fs, M) :- '$extract_minus'(Fs, MFs), !, - '$load_files'(M:MFs,[],[M:Fs]). + load_files(M:MFs,[]). '$csult'(Fs, M) :- - '$load_files'(M:Fs,[consult(consult)],[M:Fs]). + load_files(M:Fs,[consult(consult)]). '$extract_minus'([], []). '$extract_minus'([-F|Fs], [F|MFs]) :- @@ -1099,7 +1116,7 @@ just goes through every loaded file and verifies whether reloading is needed. make :- recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_), - '$load_files'(F1, [if(changed)],make), + load_files(F1, [if(changed)]), fail. make. @@ -1260,11 +1277,11 @@ use_module(M,F,Is) :- '$use_module'(M,M1,F,Is) :- nonvar(F), !, ( var(M) -> - '$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)), + load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)]), absolute_file_name( F, F1, [expand(true),file_type(prolog)] ), recorded('$module','$module'(F1,M,_,_,_),_) ; -'$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) +load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) ). '$use_module'(M,M1,F,Is) :- nonvar(M), !, @@ -1272,11 +1289,11 @@ use_module(M,F,Is) :- ( recorded('$module','$module'(F0,M,_,_,_),_) -> - '$load_files'(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) + load_files(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)]) ; nonvar(F0) -> - '$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) + load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)]) ; '$do_error'(instantiation_error,use_module(M,F,Is)) ). diff --git a/pl/directives.yap b/pl/directives.yap index 21d403bc1..38540758b 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -45,7 +45,6 @@ '$include'/2, '$initialization'/1, '$initialization'/2, - '$load_files'/3, '$require'/2, '$set_encoding'/1, '$use_module'/3]). @@ -176,23 +175,23 @@ considered. '$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :- set_prolog_flag(F,V). '$exec_directive'(ensure_loaded(Fs), _, M, _, _) :- - '$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)). + load_files(M:Fs, [if(changed)]). '$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :- char_conversion(IN,OUT). '$exec_directive'(public(P), _, M, _, _) :- '$public'(P, M). '$exec_directive'(compile(Fs), _, M, _, _) :- - '$load_files'(M:Fs, [], compile(Fs)). + load_files(M:Fs, []). '$exec_directive'(reconsult(Fs), _, M, _, _) :- - '$load_files'(M:Fs, [], reconsult(Fs)). + load_files(M:Fs, []). '$exec_directive'(consult(Fs), _, M, _, _) :- - '$load_files'(M:Fs, [consult(consult)], consult(Fs)). + load_files(M:Fs, [consult(consult)]). '$exec_directive'(use_module(F), _, M, _, _) :- use_module(M:F). '$exec_directive'(reexport(F), _, M, _, _) :- - '$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)). + load_files(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)]). '$exec_directive'(reexport(F,Spec), _, M, _, _) :- - '$load_files'(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)], reexport(F, Spec)). + load_files(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)]). '$exec_directive'(use_module(F, Is), _, M, _, _) :- use_module(M:F, Is). '$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :- diff --git a/pl/errors.yap b/pl/errors.yap index 38190aa2b..27819fb48 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -57,7 +57,7 @@ Errors are terms of the form: * Generate a system error _Error_, informing the possible cause _Cause_. * */ -system_error(Type,Goal) :- +prolog:system_error(Type,Goal) :- '$do_error'(Type,Goal). diff --git a/pl/hacks.yap b/pl/hacks.yap index 0b0c299cd..62692dbed 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -232,9 +232,9 @@ beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) --> [(:- Gs)]. beautify_hidden_goal('$loop'(Stream,Option),prolog) --> [execute_load_file(Stream, consult=Option)]. -beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) --> - [load_files(Files,Opts)]. -beautify_hidden_goal('$load_files'(_,_,Name),prolog) --> +beautify_hidden_goal('$load_files'(Files,M,Opts,?),prolog) --> + [load_files(M:Files,Opts)]. +beautify_hidden_goal('$load_files'(_,_,_,Name),prolog) --> [Name]. beautify_hidden_goal('$reconsult'(Files,Mod),prolog) --> [reconsult(Mod:Files)]. diff --git a/pl/imports.yap b/pl/imports.yap index 46dc2a7f6..665f4f675 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -9,6 +9,11 @@ /** * @ingroup ModuleBuiltins * @{ + * + * YAP follows the following protovol: + * - predicate is in current module; + * - predicate is in user + * - predicate will be autoloaded, SWI style. */ :- '$mk_dynamic'('$parent_module'(_,_),prolog). @@ -22,7 +27,6 @@ '$pred_exists'(G, user). % autoload '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- - recorded('$dialect',swi,_), prolog_flag(autoload, true), prolog_flag(unknown, OldUnk, fail), ( @@ -38,7 +42,7 @@ '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- '$parent_module'(ImportingMod,ExportingModI), '$continue_imported'(ExportingMod, ExportingModI, G0, G). -'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- +'$get_undefined_predicates'(G, _ImportingMod, G0, ExportingMod) :- yap_flag(default_parent_module,ExportingModI), '$continue_imported'(ExportingMod, ExportingModI, G0, G). diff --git a/pl/init.yap b/pl/init.yap index c7c1bcb89..330bc76c4 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -33,17 +33,20 @@ nb_setval('$chr_toplevel_show_store',false). '$init_consult' :- - set_value('$open_expands_filename',true), - nb_setval('$assert_all',off), - nb_setval('$if_level',0), - nb_setval('$endif',off), - nb_setval('$initialization_goals',off), - nb_setval('$included_file',[]), - nb_setval('$loop_streams',[]), - \+ '$undefined'('$init_preds',prolog), - '$init_preds', - fail. -'$init_consult'. + set_value('$open_expands_filename',true), + nb_setval('$assert_all',off), + nb_setval('$if_level',0), + nb_setval('$endif',off), + nb_setval('$initialization_goals',off), + nb_setval('$included_file',[]), + nb_setval('$loop_streams',[]), + ( + '$undefined'('$init_preds',prolog) + -> + true + ; + '$init_preds' + ). '$init_win_graphics' :- '$undefined'(window_title(_,_), system), !. diff --git a/pl/messages.yap b/pl/messages.yap index 6abc04b58..7e6115c98 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -259,11 +259,11 @@ location( error(_,Info), Level, LC ) --> { '$error_descriptor'(Info, Desc) }, { - '$query_exception'(prologPredFile, Desc, File), - '$query_exception'(prologPredLine, Desc, FilePos), - '$query_exception'(prologPredModule, Desc, M), - '$query_exception'(prologPredName, Desc, Na), - '$query_exception'(prologPredArity, Desc, Ar) + query_exception(prologPredFile, Desc, File), + query_exception(prologPredLine, Desc, FilePos), + query_exception(prologPredModule, Desc, M), + query_exception(prologPredName, Desc, Na), + query_exception(prologPredArity, Desc, Ar) }, !, display_consulting( File, Level, Info, LC ), @@ -271,9 +271,9 @@ location( error(_,Info), Level, LC ) --> location( error(_,Info), Level, LC ) --> { '$error_descriptor'(Info, Desc) }, { - '$query_exception'(errorFile, Desc, File), - '$query_exception'(errorLine, Desc, FilePos), - '$query_exception'(errorFunction, Desc, F) + query_exception(errorFile, Desc, File), + query_exception(errorLine, Desc, FilePos), + query_exception(errorFunction, Desc, F) }, !, display_consulting( File, Level, Info, LC ), @@ -295,6 +295,10 @@ main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term [' ~a: failed_processing syntax error term ~q' - [Level,Term]], [nl] ). +main_message( error(syntax_error(_Msg), Info), Level, LC ) --> + !, + [' ~a: syntax error ~s' - [Level,Msg]], + [nl]. main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) --> !, % {writeln(ci)}, @@ -342,8 +346,8 @@ main_message(error(uninstantiation_error(T),_), Level, _LC) --> display_consulting( F, Level, Info, LC) --> { LC > 0, '$error_descriptor'(Info, Desc), - '$query_exception'(prologParserFile, Desc, F0), - '$query_exception'(prologarserLine, Desc, L), + query_exception(prologParserFile, Desc, F0), + query_exception(prologarserLine, Desc, L), F \= F0 }, !, [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. @@ -358,7 +362,7 @@ display_consulting(_F, _, _, _LC) --> caller( Info, _) --> { '$error_descriptor'(Info, Desc) }, - ({ '$query_exception'(errorGoal, Desc, Call), + ({ query_exception(errorGoal, Desc, Call), Call = M:(H :- G) } -> @@ -372,12 +376,12 @@ caller( Info, _) --> ; [] ), - { '$query_exception'(prologPredFile, Desc, File), + { query_exception(prologPredFile, Desc, File), File \= [], - '$query_exception'(prologPredLine, Desc, FilePos), - '$query_exception'(prologPredModule, Desc, M), - '$query_exception'(prologPredName, Desc, Na), - '$query_exception'(prologPredArity, Desc, Ar) + query_exception(prologPredLine, Desc, FilePos), + query_exception(prologPredModule, Desc, M), + query_exception(prologPredName, Desc, Na), + query_exception(prologPredArity, Desc, Ar) }, !, [nl], @@ -388,10 +392,10 @@ caller( _, _) --> c_goal( Info, Level ) --> { '$error_descriptor'(Info, Desc) }, - { '$query_exception'(errorFile, Desc, File), + { query_exception(errorFile, Desc, File), Func \= [], - '$query_exception'(errorFunction, Desc, File), - '$query_exception'(errorLine, Desc, Line) + query_exception(errorFunction, Desc, File), + query_exception(errorLine, Desc, Line) }, !, ['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]], @@ -620,7 +624,7 @@ domain_error(Domain, Opt) --> extra_info( error(_,Extra), _ ) --> { - '$query_exception'(prologPredFile, Extra, Msg), + query_exception(prologPredFile, Extra, Msg), Msg \= [] }, !, @@ -1048,6 +1052,12 @@ prolog:print_message(_Severity, _Term) :- '$error_descriptor'( exception(Info), Info ). +query_exception(K0,[H|L],V) :- + (atom(K0) -> atom_to_string(K0, K) ; K = K0), + !, + lists:member(K=V,[H|L]). +query_exception(K,V) :- + '$query_exception'(K,V). /** @} diff --git a/pl/modules.yap b/pl/modules.yap index 5747add74..6aba25b45 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -201,8 +201,8 @@ The state of the module system after this error is undefined. **/ -use_module(F) :- '$load_files'(F, - [if(not_loaded),must_be_module(true)], use_module(F)). +use_module(F) :- load_files(F, + [if(not_loaded),must_be_module(true)]). /** @@ -235,7 +235,7 @@ Unfortunately it is still not possible to change argument order. **/ use_module(F,Is) :- - '$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)). + load_files(F, [if(not_loaded),must_be_module(true),imports(Is)]). '$module'(O,N,P,Opts) :- !, '$module'(O,N,P), diff --git a/pl/protect.yap b/pl/protect.yap index 23f8a6a8f..7d9bc46dd 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -36,12 +36,12 @@ */ -'$protect' :- +prolog:'$protect' :- '$all_current_modules'(M), ( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ), new_system_module( M ), fail. -'$protect' :- +prolog:'$protect' :- '$current_predicate'(Name,M,P,_), '$is_system_module'(M), functor(P,Name,Arity), @@ -50,13 +50,13 @@ functor(P,Name,Arity), '$hide_predicate'(P,M), fail. -'$protect' :- +prolog:'$protect' :- current_atom(Name), sub_atom(Name,0,1,_, '$'), \+ '$visible'(Name), hide_atom(Name), fail. -'$protect'. +prolog:'$protect'. % hide all atoms who start by '$'