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

merge text to term routines

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-12-04 12:52:42 -06:00
parent b07a35a993
commit 6a4dbd91ec
11 changed files with 1249 additions and 1359 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
C/c_interface.c
View File

@ -1379,8 +1379,9 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
else else
tv = 0; tv = 0;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, const unsigned char *us = (const unsigned char *)s;
GLOBAL_MaxPriority, tv))) { while (!(t = Yap_BufferToTermWithPrioBindings(
us, strlen(s) + 1, TermNil, GLOBAL_MaxPriority, tv))) {
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
if (!Yap_dogc(0, NULL PASS_REGS)) { if (!Yap_dogc(0, NULL PASS_REGS)) {

90
C/flags.c
View File

@ -51,9 +51,9 @@ static Term stream(Term inp);
static bool getenc(Term inp); static bool getenc(Term inp);
static bool typein(Term inp); static bool typein(Term inp);
static bool dqf(Term t2); static bool dqf(Term t2);
static bool set_error_stream( Term inp ); static bool set_error_stream(Term inp);
static bool set_input_stream( Term inp ); static bool set_input_stream(Term inp);
static bool set_output_stream( Term inp ); static bool set_output_stream(Term inp);
static void newFlag(Term fl, Term val); static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1); static Int current_prolog_flag(USES_REGS1);
@ -173,41 +173,38 @@ static Term isaccess(Term inp) {
} }
static Term stream(Term inp) { static Term stream(Term inp) {
if ( IsVarTerm(inp) ) if (IsVarTerm(inp))
return inp; return inp;
if (Yap_CheckStream( inp, Input_Stream_f | Output_Stream_f | if (Yap_CheckStream(inp, Input_Stream_f | Output_Stream_f | Append_Stream_f |
Append_Stream_f | Socket_Stream_f, "yap_flag/3" ) >= 0) Socket_Stream_f,
"yap_flag/3") >= 0)
return inp; return inp;
return 0; return 0;
} }
static bool static bool set_error_stream(Term inp) {
set_error_stream( Term inp ) { if (IsVarTerm(inp))
if( IsVarTerm(inp) ) return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream));
return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_error_stream ) ); LOCAL_c_error_stream = Yap_CheckStream(
LOCAL_c_error_stream = Yap_CheckStream( inp, Output_Stream_f | inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
Append_Stream_f | Socket_Stream_f, "yap_flag/3" );
return true;
}
static bool
set_input_stream( Term inp ) {
if( IsVarTerm(inp) )
return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_input_stream ) );
LOCAL_c_input_stream = Yap_CheckStream( inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3" );
return true; return true;
} }
static bool static bool set_input_stream(Term inp) {
set_output_stream( Term inp ) { if (IsVarTerm(inp))
if( IsVarTerm(inp) ) return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream));
return Yap_unify( inp, Yap_StreamUserName( LOCAL_c_output_stream ) ); LOCAL_c_input_stream =
LOCAL_c_output_stream = Yap_CheckStream( inp, Output_Stream_f | Yap_CheckStream(inp, Input_Stream_f | Socket_Stream_f, "yap_flag/3");
Append_Stream_f | Socket_Stream_f, "yap_flag/3" );
return true; return true;
} }
static bool set_output_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream));
LOCAL_c_output_stream = Yap_CheckStream(
inp, Output_Stream_f | Append_Stream_f | Socket_Stream_f, "yap_flag/3");
return true;
}
static Term isground(Term inp) { static Term isground(Term inp) {
return Yap_IsGroundTerm(inp) ? inp : TermZERO; return Yap_IsGroundTerm(inp) ? inp : TermZERO;
@ -1182,24 +1179,26 @@ static Int source_mode(USES_REGS1) {
static bool setInitialValue(bool bootstrap, flag_func f, const char *s, static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
flag_term *tarr) { flag_term *tarr) {
errno = 0; errno = 0;
const char *ss = (const char *)s;
if (f == booleanFlag) { if (f == booleanFlag) {
if (!bootstrap) { if (!bootstrap) {
return 0; return 0;
} }
if (!strcmp(s, "true")) { const char *ss = (const char *)s;
if (!strcmp(ss, "true")) {
tarr->at = TermTrue; tarr->at = TermTrue;
return true; return true;
} }
if (!strcmp(s, "false")) { if (!strcmp(ss, "false")) {
tarr->at = TermFalse; tarr->at = TermFalse;
return true; return true;
} }
if (!strcmp(s, "on")) { if (!strcmp(ss, "on")) {
tarr->at = TermTrue; tarr->at = TermTrue;
return true; return true;
} }
if (!strcmp(s, "off")) { if (!strcmp(ss, "off")) {
tarr->at = TermFalse; tarr->at = TermFalse;
return true; return true;
} }
@ -1210,7 +1209,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
if (!bootstrap) { if (!bootstrap) {
return 0; return 0;
} }
UInt r = strtoul(s, NULL, 10); UInt r = strtoul(ss, NULL, 10);
Term t; Term t;
if (errno) { if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
@ -1229,27 +1228,27 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
if (!bootstrap) { if (!bootstrap) {
return false; return false;
} }
if (!strcmp(s, "INT_MAX")) { if (!strcmp(ss, "INT_MAX")) {
tarr->at = MkIntTerm(Int_MAX); tarr->at = MkIntTerm(Int_MAX);
return true; return true;
} }
if (!strcmp(s, "MAX_THREADS")) { if (!strcmp(ss, "MAX_THREADS")) {
tarr->at = MkIntTerm(MAX_THREADS); tarr->at = MkIntTerm(MAX_THREADS);
return true; return true;
} }
if (!strcmp(s, "MAX_WORKERS")) { if (!strcmp(ss, "MAX_WORKERS")) {
tarr->at = MkIntTerm(MAX_WORKERS); tarr->at = MkIntTerm(MAX_WORKERS);
return true; return true;
} }
if (!strcmp(s, "INT_MIN")) { if (!strcmp(ss, "INT_MIN")) {
tarr->at = MkIntTerm(Int_MIN); tarr->at = MkIntTerm(Int_MIN);
return true; return true;
} }
if (!strcmp(s, "YAP_NUMERIC_VERSION")) { if (!strcmp(ss, "YAP_NUMERIC_VERSION")) {
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true; return true;
} }
if (!strcmp(s, "YAP_NUMERIC_VERSION")) { if (!strcmp(ss, "YAP_NUMERIC_VERSION")) {
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true; return true;
} }
@ -1297,7 +1296,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return true; return true;
} }
} }
} else if (strcmp(s, "@boot") == 0) { } else if (strcmp(ss, "@boot") == 0) {
if (bootstrap) { if (bootstrap) {
return true; return true;
} }
@ -1317,9 +1316,9 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return false; return false;
} }
CACHE_REGS CACHE_REGS
encoding_t encoding = ENC_ISO_UTF8; const unsigned char *us = (const unsigned char *)s;
t0 = t0 = Yap_BufferToTermWithPrioBindings(us, strlen(s) + 1, TermNil,
Yap_StringToTerm(s, strlen(s) + 1, &encoding, GLOBAL_MaxPriority, 0L); GLOBAL_MaxPriority, 0L);
if (!t0) if (!t0)
return false; return false;
if (IsAtomTerm(t0) || IsIntTerm(t0)) { if (IsAtomTerm(t0) || IsIntTerm(t0)) {
@ -1570,7 +1569,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
fv->type = isground; fv->type = isground;
} break; } break;
case PROLOG_FLAG_PROPERTY_SCOPE: case PROLOG_FLAG_PROPERTY_SCOPE:
free(args); free(args);
return false; return false;
case PROLOG_FLAG_PROPERTY_END: case PROLOG_FLAG_PROPERTY_END:
break; break;
@ -1621,8 +1620,9 @@ void Yap_InitFlags(bool bootstrap) {
while (f->name != NULL) { while (f->name != NULL) {
bool itf = setInitialValue(bootstrap, f->def, f->init, bool itf = setInitialValue(bootstrap, f->def, f->init,
LOCAL_Flags + LOCAL_flagCount); LOCAL_Flags + LOCAL_flagCount);
// Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1, // Term itf = Yap_BufferToTermWithPrioBindings(f->init,
// EBC_ISO_UTF8, GLOBAL_MaxPriority, &tp); // strlen(f->init)+1,
// LOBAL_MaxPriority, &tp);
if (itf) { if (itf) {
initFlag(f, LOCAL_flagCount, false); initFlag(f, LOCAL_flagCount, false);
} }

84
C/text.c
View File

@ -51,9 +51,7 @@ typedef struct TextBuffer_manager {
int lvl; int lvl;
} text_buffer_t; } text_buffer_t;
int push_text_stack(USES_REGS1) { int push_text_stack(USES_REGS1) { return LOCAL_TextBuffer->lvl++; }
return LOCAL_TextBuffer->lvl++;
}
int pop_text_stack(int i) { int pop_text_stack(int i) {
int lvl = LOCAL_TextBuffer->lvl; int lvl = LOCAL_TextBuffer->lvl;
@ -81,9 +79,9 @@ void *Malloc(size_t sz USES_REGS) {
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL); sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
struct mblock *o = malloc(sz); struct mblock *o = malloc(sz);
o->prev = LOCAL_TextBuffer->last[lvl]; o->prev = LOCAL_TextBuffer->last[lvl];
if (o->prev) { if (o->prev) {
o->prev->next = o; o->prev->next = o;
} }
if (LOCAL_TextBuffer->first[lvl]) { if (LOCAL_TextBuffer->first[lvl]) {
LOCAL_TextBuffer->last[lvl] = o; LOCAL_TextBuffer->last[lvl] = o;
} else { } else {
@ -206,7 +204,7 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp,
(*atoms)++; (*atoms)++;
if (*atoms < length) { if (*atoms < length) {
*tailp = l; *tailp = l;
return -REPRESENTATION_ERROR_CHARACTER_CODE; return -REPRESENTATION_ERROR_CHARACTER_CODE;
} else { } else {
AtomEntry *ae = RepAtom(AtomOfTerm(hd)); AtomEntry *ae = RepAtom(AtomOfTerm(hd));
if ((ae->StrOfAE)[1] != '\0') { if ((ae->StrOfAE)[1] != '\0') {
@ -386,35 +384,32 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t); Atom at = AtomOfTerm(inp->val.t);
if (lengp) if (lengp)
*lengp = strlen_utf8(at->UStrOfAE); *lengp = strlen_utf8(at->UStrOfAE);
return at->UStrOfAE; return at->UStrOfAE;
} }
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
if (lengp) if (lengp)
*lengp = strlen_utf8(UStringOfTerm(inp->val.t)); *lengp = strlen_utf8(UStringOfTerm(inp->val.t));
return (unsigned char *)UStringOfTerm(inp->val.t); return (unsigned char *)UStringOfTerm(inp->val.t);
} }
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS)) && (YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
IsPairOrNilTerm(inp->val.t)) { IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return return Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
} }
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
lengp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
} }
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
lengp PASS_REGS);
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
} }
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
@ -434,17 +429,21 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
} }
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
char *s; char *s;
size_t sz = 1024; size_t sz = 1024;
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
if (s0) if (s0) {
{ s = (char *)s0; sz = strlen(s);} s = (char *)s0;
else sz = strlen(s);
} else
s = Malloc(sz); s = Malloc(sz);
if (!s) if (!s)
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
while (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, sz - 1)) { while (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, sz - 1)) {
if (s0) { s = Malloc(sz=1024); s0 = NULL; } if (s0) {
else s = Realloc(s, sz+1024); s = Malloc(sz = 1024);
s0 = NULL;
} else
s = Realloc(s, sz + 1024);
} }
*lengp = strlen(s); *lengp = strlen(s);
return inp->val.uc = (unsigned char *)s; return inp->val.uc = (unsigned char *)s;
@ -634,11 +633,11 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) { static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
unsigned char *s = s0; unsigned char *s = s0;
int32_t ch; int32_t ch;
if ( leng == 0) { if (leng == 0) {
return Yap_LookupAtom(""); return Yap_LookupAtom("");
} }
if ( strlen_utf8(s0) <= leng) { if (strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0); return Yap_LookupAtom(s0);
} else { } else {
size_t n = get_utf8(s, 1, &ch); size_t n = get_utf8(s, 1, &ch);
unsigned char *buf = Malloc(n + 1); unsigned char *buf = Malloc(n + 1);
@ -720,18 +719,18 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out,
return leng; return leng;
} }
static Term write_number(unsigned char *s, seq_tv_t *out, int size, bool error_on USES_REGS) { static Term write_number(unsigned char *s, seq_tv_t *out, int size,
bool error_on USES_REGS) {
Term t; Term t;
int i = push_text_stack(); int i = push_text_stack();
t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on); t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on);
pop_text_stack(i); pop_text_stack(i);
return t; return t;
} }
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) { static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
Term o; Term o;
o = out->val.t = o = out->val.t = Yap_BufferToTerm(s, strlen(s) + 1, TermNil);
Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, 0L);
return o; return o;
} }
@ -746,7 +745,8 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
return out->val.t != 0; return out->val.t != 0;
} }
if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) { if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) {
if ((out->val.t = write_number(inp, out, leng,!(out->type & YAP_STRING_ATOM) PASS_REGS)) != 0L) { if ((out->val.t = write_number(
inp, out, leng, !(out->type & YAP_STRING_ATOM)PASS_REGS)) != 0L) {
// Yap_DebugPlWriteln(out->val.t); // Yap_DebugPlWriteln(out->val.t);
return true; return true;
@ -800,7 +800,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
out->val.t = write_number(inp, out, leng, true PASS_REGS); out->val.t = write_number(inp, out, leng, true PASS_REGS);
// Yap_DebugPlWriteln(out->val.t); // Yap_DebugPlWriteln(out->val.t);
return out->val.t != 0; return out->val.t != 0;
default: { return true ; } default: { return true; }
} }
return false; return false;
} }
@ -917,9 +917,9 @@ static unsigned char *concat(int n, void *sv[] USES_REGS) {
buf = Malloc(room + 1); buf = Malloc(room + 1);
buf0 = buf; buf0 = buf;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
#if _WIN32 || defined( __ANDROID__ ) #if _WIN32 || defined(__ANDROID__)
strcpy(buf, sv[i]); strcpy(buf, sv[i]);
buf = (char*)buf + strlen(buf); buf = (char *)buf + strlen(buf);
#else #else
buf = stpcpy(buf, sv[i]); buf = stpcpy(buf, sv[i]);
#endif #endif
@ -1021,7 +1021,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
next = 0; next = 0;
else else
next = cuts[i - 1]; next = cuts[i - 1];
if (i>0 && cuts[i] == 0) if (i > 0 && cuts[i] == 0)
break; break;
void *bufi = slice(next, cuts[i], buf PASS_REGS); void *bufi = slice(next, cuts[i], buf PASS_REGS);
if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) { if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) {
@ -1085,7 +1085,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) {
const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) { const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) {
CACHE_REGS CACHE_REGS
Atom at; Atom at;
arity_t arity = 0; arity_t arity = 0;
Functor f; Functor f;
char *s, *smax, *s0; char *s, *smax, *s0;
s = s0 = malloc(1024); s = s0 = malloc(1024);

2007
library/dialect/swi/os/pl-read.c
View File

File diff suppressed because it is too large Load Diff

156
library/dialect/swi/os/pl-yap.h
View File

@ -8,7 +8,7 @@
#include <libgen.h> #include <libgen.h>
/* depends on tag schema, but 4 should always do */ /* depends on tag schema, but 4 should always do */
#define LMASK_BITS 4 /* total # mask bits */ #define LMASK_BITS 4 /* total # mask bits */
#if HAVE_CTYPE_H #if HAVE_CTYPE_H
#include <ctype.h> #include <ctype.h>
@ -20,64 +20,63 @@
#define SIZE_VOIDP SIZEOF_INT_P #define SIZE_VOIDP SIZEOF_INT_P
#if SIZEOF_LONG_INT == 4
#if SIZEOF_LONG_INT==4
#define INT64_FORMAT "%lld" #define INT64_FORMAT "%lld"
#else #else
#define INT64_FORMAT "%ld" #define INT64_FORMAT "%ld"
#endif #endif
#define INTBITSIZE (sizeof(int)*8) #define INTBITSIZE (sizeof(int) * 8)
typedef module_t Module; typedef module_t Module;
typedef Term (*Func)(term_t); /* foreign functions */ typedef Term (*Func)(term_t); /* foreign functions */
extern const char *Yap_GetCurrentPredName(void); extern const char *Yap_GetCurrentPredName(void);
extern Int Yap_GetCurrentPredArity(void); extern Int Yap_GetCurrentPredArity(void);
extern term_t Yap_fetch_module_for_format(term_t args, Term *modp); extern term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern void Yap_setCurrentSourceLocation( void *rd ); extern void Yap_setCurrentSourceLocation(void *rd);
extern void *Yap_GetStreamHandle(Atom at); extern void *Yap_GetStreamHandle(Atom at);
extern void Yap_WriteAtom(IOSTREAM *s, Atom atom); extern void Yap_WriteAtom(IOSTREAM *s, Atom atom);
extern atom_t codeToAtom(int chrcode); extern atom_t codeToAtom(int chrcode);
#define valTermRef(t) ((Word)Yap_AddressFromSlot(t)) #define valTermRef(t) ((Word)Yap_AddressFromSlot(t))
#include "pl-codelist.h" #include "pl-codelist.h"
//move this to SWI // move this to SWI
#define GP_CREATE 2 /* create (in this module) */ #define GP_CREATE 2 /* create (in this module) */
#ifndef HAVE_MBSCOLL #ifndef HAVE_MBSCOLL
COMMON(int) mbscoll(const char *s1, const char *s2); COMMON(int) mbscoll(const char *s1, const char *s2);
#endif #endif
#ifndef HAVE_MBSCASECOLL #ifndef HAVE_MBSCASECOLL
COMMON(int) mbscasecoll(const char *s1, const char *s2); COMMON(int) mbscasecoll(const char *s1, const char *s2);
#endif #endif
COMMON(atom_t) TemporaryFile(const char *id, int *fdp); COMMON(atom_t) TemporaryFile(const char *id, int *fdp);
COMMON(char *) Getenv(const char *, char *buf, size_t buflen); COMMON(char *) Getenv(const char *, char *buf, size_t buflen);
/*** memory allocation stuff: SWI wraps around malloc */ /*** memory allocation stuff: SWI wraps around malloc */
#define stopItimer() #define stopItimer()
COMMON(word) pl_print(term_t term); COMMON(word) pl_print(term_t term);
COMMON(word) pl_write(term_t term); COMMON(word) pl_write(term_t term);
COMMON(word) pl_write_canonical(term_t term); COMMON(word) pl_write_canonical(term_t term);
COMMON(word) pl_write_term(term_t term, term_t options); COMMON(word) pl_write_term(term_t term, term_t options);
COMMON(word) pl_writeq(term_t term); COMMON(word) pl_writeq(term_t term);
static inline int static inline int get_procedure(term_t descr, predicate_t *proc, term_t he,
get_procedure(term_t descr, predicate_t *proc, term_t he, int f) { int f) {
CACHE_REGS CACHE_REGS
Term t = Yap_GetFromSlot(descr ); Term t = Yap_GetFromSlot(descr);
if (IsVarTerm(t)) return FALSE; if (IsVarTerm(t))
return FALSE;
if (IsAtomTerm(t)) if (IsAtomTerm(t))
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule)); *proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), CurrentModule));
else if (IsApplTerm(t)) { else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
@ -88,41 +87,38 @@ get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
return TRUE; return TRUE;
} }
/* TBD */ /* TBD */
extern word globalString(size_t size, char *s); extern word globalString(size_t size, char *s);
extern word globalWString(size_t size, wchar_t *s); extern word globalWString(size_t size, wchar_t *s);
#define allocHeap(n) allocHeap__LD(n PASS_LD) #define allocHeap(n) allocHeap__LD(n PASS_LD)
#define valHandle(r) valHandle__LD(r PASS_LD) #define valHandle(r) valHandle__LD(r PASS_LD)
Int YAP_PLArityOfSWIFunctor(functor_t f); Int YAP_PLArityOfSWIFunctor(functor_t f);
struct PL_blob_t* YAP_find_blob_type(Atom at); struct PL_blob_t *YAP_find_blob_type(Atom at);
void PL_license(const char *license, const char *module); void PL_license(const char *license, const char *module);
#define arityFunctor(f) YAP_PLArityOfSWIFunctor(f) #define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE) #define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE)
#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) )) #define isInteger(A) \
#define isString(A) (!IsVarTerm(A) && IsStringTerm(A) ) (!IsVarTerm(A) && (IsIntegerTerm((A)) || YAP_IsBigNumTerm((A))))
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) ) #define isString(A) (!IsVarTerm(A) && IsStringTerm(A))
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) ) #define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)))
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)))
#define isNil(A) ((A) == TermNil) #define isNil(A) ((A) == TermNil)
#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)) ) #define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)))
#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)) ) #define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)))
#define isVar(A) IsVarTerm((A)) #define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w)) #define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w)) #define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) AtomOfTerm(atom) #define atomValue(atom) AtomOfTerm(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term)) #define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static char * inline static char *atomName(Atom atom) {
atomName(Atom atom)
{
if (IsWideAtom(atom)) if (IsWideAtom(atom))
return (char *)(atom->WStrOfAE); return (char *)(atom->WStrOfAE);
return atom->StrOfAE; return atom->StrOfAE;
@ -131,16 +127,19 @@ atomName(Atom atom)
#define nameOfAtom(atom) nameOfAtom(atom) #define nameOfAtom(atom) nameOfAtom(atom)
#define atomBlobType(at) YAP_find_blob_type(at) #define atomBlobType(at) YAP_find_blob_type(at)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i)))) #define argTermP(w, i) ((Word)((YAP_ArgsOfTerm(w) + (i))))
#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); } #define deRef(t) \
#define canBind(t) FALSE // VSC: to implement while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { \
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C) t = (CELL *)(*(t)); \
}
#define canBind(t) FALSE // VSC: to implement
#define _PL_predicate(A, B, C, D) PL_predicate(A, B, C)
#define predicateHasClauses(pe) ((pe)->cs.p_code.NOfClauses != 0) #define predicateHasClauses(pe) ((pe)->cs.p_code.NOfClauses != 0)
#define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A))) #define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
Procedure resolveProcedure(functor_t f, Module module); Procedure resolveProcedure(functor_t f, Module module);
#define charEscapeWriteOption(A) FALSE // VSC: to implement #define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) Yap_InitSlot(*(A)) #define wordToTermRef(A) Yap_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A) #define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A) #define valInt(A) IntegerOfTerm(A)
@ -156,34 +155,32 @@ extern term_t Yap_CvtTerm(term_t ts);
wchar_t *nameOfWideAtom(atom_t atom); wchar_t *nameOfWideAtom(atom_t atom);
int isWideAtom(atom_t atom); int isWideAtom(atom_t atom);
inline static int inline static int charCode(Term w) {
charCode(Term w) if (IsAtomTerm(w)) {
{ if ( IsAtomTerm(w) ) Atom a = atomValue(w);
{
Atom a = atomValue(w);
if (IsWideAtom(a)) { if (IsWideAtom(a)) {
if (wcslen(a->WStrOfAE) == 1) if (wcslen(a->WStrOfAE) == 1)
return a->WStrOfAE[0]; return a->WStrOfAE[0];
return -1;
}
if (strlen(a->StrOfAE) == 1)
return ((unsigned char *)(a->StrOfAE))[0];
return -1; return -1;
} }
if (strlen(a->StrOfAE) == 1)
return ((unsigned char *)(a->StrOfAE))[0];
return -1;
}
return -1; return -1;
} }
#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD) #define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD)
#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD) #define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD)
#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD) #define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD)
#define PL_is_atom(t) PL_is_atom__LD(t PASS_LD) #define PL_is_atom(t) PL_is_atom__LD(t PASS_LD)
#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD) #define PL_is_variable(t) PL_is_variable__LD(t PASS_LD)
#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1) #define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1)
#define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD) #define PL_put_atom(t, a) PL_put_atom__LD(t, a PASS_LD)
#define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD) #define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD)
#define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD) #define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD)
#define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD) #define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD)
#define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD); #define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD);
@ -192,13 +189,12 @@ charCode(Term w)
unsigned int getUnknownModule(module_t m); unsigned int getUnknownModule(module_t m);
#if IN_PL_OS_C #if IN_PL_OS_C
static int static int stripostfix(const char *s, const char *e) {
stripostfix(const char *s, const char *e) size_t ls = strlen(s);
{ size_t ls = strlen(s);
size_t le = strlen(e); size_t le = strlen(e);
if ( ls >= le ) if (ls >= le)
return strcasecmp(&s[ls-le], e) == 0; return strcasecmp(&s[ls - le], e) == 0;
return FALSE; return FALSE;
} }
@ -209,9 +205,8 @@ stripostfix(const char *s, const char *e)
#include <signal.h> #include <signal.h>
#endif #endif
static inline void static inline void unblockSignal(int sig) {
unblockSignal(int sig) sigset_t set;
{ sigset_t set;
sigemptyset(&set); sigemptyset(&set);
sigaddset(&set, sig); sigaddset(&set, sig);
@ -220,10 +215,7 @@ unblockSignal(int sig)
// DEBUG(1, Sdprintf("Unblocked signal %d\n", sig)); // DEBUG(1, Sdprintf("Unblocked signal %d\n", sig));
} }
#else #else
static inline void static inline void unblockSignal(int sig) {}
unblockSignal(int sig)
{
}
#endif #endif
#define suspendTrace(x) #define suspendTrace(x)
@ -234,6 +226,8 @@ atom_t ATOM_;
intptr_t system_thread_id(void); intptr_t system_thread_id(void);
#endif #endif
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio,Term *bindingsp); extern Term Yap_BufferToTermWithPrioBindings(const char *s, size_t len,
encoding_t enc, int prio,
Term *bindingsp);
#endif /* PL_YAP_H */ #endif /* PL_YAP_H */

1
library/maplist.yap
View File

@ -1,3 +1,4 @@
/** /**
* @file maplist.yap * @file maplist.yap
* @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan> * @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>

4
library/system/CMakeLists.txt
View File

@ -10,9 +10,9 @@ set (TARGET sys)
endif() endif()
if (NOT ANDROID) if (NOT ANDROID AND WITH_OPENSSL)
# #
# this will support getting better cryptographic support, # this will evolve to getting better cryptographic support,
# but right now Open SSL is not supported enough. # but right now Open SSL is not supported enough.
# #
find_package (OpenSSL) find_package (OpenSSL)

13
os/iopreds.h
View File

@ -35,7 +35,6 @@ extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags, encoding_t encoding, stream_flags_t flags,
Atom open_mode); Atom open_mode);
#
#define Yap_CheckStream(arg, kind, msg) \ #define Yap_CheckStream(arg, kind, msg) \
Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckStream__(const char *, const char *, int, Term, int, extern int Yap_CheckStream__(const char *, const char *, int, Term, int,
@ -80,7 +79,7 @@ Int Yap_CloseSocket(int, socket_info, socket_domain);
#endif /* USE_SOCKET */ #endif /* USE_SOCKET */
extern Term Yap_read_term(int inp_stream, Term opts, int nargs); extern Term Yap_read_term(int inp_stream, Term opts, bool clauatse);
extern Term Yap_Parse(UInt prio, encoding_t enc, Term cmod); extern Term Yap_Parse(UInt prio, encoding_t enc, Term cmod);
extern void init_read_data(ReadData _PL_rd, struct stream_desc *s); extern void init_read_data(ReadData _PL_rd, struct stream_desc *s);
@ -98,16 +97,17 @@ static inline Int GetCurInpPos(StreamDesc *inp_stream) {
#define PlIOError(type, culprit, ...) \ #define PlIOError(type, culprit, ...) \
PlIOError__(__FILE__, __FUNCTION__, __LINE__, type, culprit, __VA_ARGS__) PlIOError__(__FILE__, __FUNCTION__, __LINE__, type, culprit, __VA_ARGS__)
extern Int PlIOError__(const char *, const char *, int, yap_error_number, Term, ...); extern Int PlIOError__(const char *, const char *, int, yap_error_number, Term,
...);
extern int GetFreeStreamD(void); extern int GetFreeStreamD(void);
extern Term Yap_MkStream(int n); extern Term Yap_MkStream(int n);
extern bool Yap_PrintWarning(Term twarning); extern bool Yap_PrintWarning(Term twarning);
extern void Yap_plwrite(Term, struct stream_desc *, int, int, int); extern void Yap_plwrite(Term, struct stream_desc *, int, int, int);
extern void Yap_WriteAtom(struct stream_desc *s, Atom atom); extern void Yap_WriteAtom(struct stream_desc *s, Atom atom);
extern bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS); extern bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS);
extern Term Yap_scan_num(struct stream_desc *, bool); extern Term Yap_scan_num(struct stream_desc *, bool);
@ -275,7 +275,8 @@ extern bool Yap_Exists(const char *f);
static inline void freeBuffer(const void *ptr) { static inline void freeBuffer(const void *ptr) {
CACHE_REGS CACHE_REGS
if (ptr == NULL || ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2 || ptr == AuxBase) if (ptr == NULL || ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2 ||
ptr == AuxBase)
return; return;
free((void *)ptr); free((void *)ptr);
} }

235
os/readterm.c
View File

@ -8,6 +8,7 @@
* * * *
************************************************************************** **************************************************************************
* * * *
read_term
* File: iopreds.c * * File: iopreds.c *
* Last rev: 5/2/88 * * Last rev: 5/2/88 *
* mods: * * mods: *
@ -184,6 +185,7 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
#define READ_DEFS() \ #define READ_DEFS() \
PAR("comments", list_filler, READ_COMMENTS) \ PAR("comments", list_filler, READ_COMMENTS) \
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
PAR("output", filler, READ_OUTPUT), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \ PAR("term_position", filler, READ_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
@ -206,6 +208,24 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t;
static const param_t read_defs[] = {READ_DEFS()}; static const param_t read_defs[] = {READ_DEFS()};
#undef PAR #undef PAR
static Term add_output(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail);
}
static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail);
}
static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail);
}
/** /**
* Syntax Error Handler * Syntax Error Handler
* *
@ -299,7 +319,7 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
typedef struct FEnv { typedef struct FEnv {
Term qq, tp, sp, np, vp, ce; Term qq, tp, sp, np, vp, ce;
Term tpos; /// initial position of the term to be read. Term tpos; /// initial position of the term to be read.
Term t; /// the output term Term t, t0; /// the output term
TokEntry *tokstart; /// the token list TokEntry *tokstart; /// the token list
TokEntry *toklast; /// the last token TokEntry *toklast; /// the last token
CELL *old_H; /// initial H, will be reset on stack overflow. CELL *old_H; /// initial H, will be reset on stack overflow.
@ -341,14 +361,18 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
} }
re->bq = getBackQuotesFlag(); re->bq = getBackQuotesFlag();
if (args[READ_MODULE].used) { if (args[READ_OUTPUT].used) {
fe->cmod = args[READ_MODULE].tvalue; fe->t0 = args[READ_OUTPUT].tvalue;
} else { } else {
fe->cmod = CurrentModule; fe->t0 = 0;
} }
if (fe->cmod == TermProlog) if (args[READ_MODULE].used) {
fe->cmod = PROLOG_MODULE; fe->cmod = args[READ_MODULE].tvalue;
if (args[READ_BACKQUOTED_STRING].used) { } else {
fe->cmod = CurrentModule;
if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE;
} if (args[READ_BACKQUOTED_STRING].used) {
if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) { if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) {
return false; return false;
} }
@ -562,6 +586,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v1, v2, v3, vc, tp; Term v1, v2, v3, vc, tp;
if (fe->t0 && !(Yap_unify(fe->t, fe->t0)))
return false;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart); v1 = get_variables(fe, tokstart);
else else
@ -598,6 +625,8 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos; Term v_vp, v_vnames, v_comments, v_pos;
if (fe->t0 && !Yap_unify(fe->t, fe->t0))
return false;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart); v_vp = get_variables(fe, tokstart);
else else
@ -630,7 +659,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
} }
static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
int nargs); bool clause);
static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream); static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream);
@ -681,8 +710,7 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
} }
static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
int nargs) { bool clause) {
CACHE_REGS
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
fe->old_TR = TR; fe->old_TR = TR;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -690,12 +718,10 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
LOCAL_eot_before_eof = false; LOCAL_eot_before_eof = false;
fe->tpos = StreamPosition(inp_stream); fe->tpos = StreamPosition(inp_stream);
fe->old_H = HR; fe->old_H = HR;
fe->reading_clause = nargs < 0; fe->reading_clause = clause;
if (fe->reading_clause) { if (clause) {
fe->nargs = -nargs;
fe->args = setClauseReadEnv(opts, fe, re, inp_stream); fe->args = setClauseReadEnv(opts, fe, re, inp_stream);
} else { } else {
fe->nargs = nargs;
fe->args = setReadEnv(opts, fe, re, inp_stream); fe->args = setReadEnv(opts, fe, re, inp_stream);
} }
if (fe->args == NULL) { if (fe->args == NULL) {
@ -848,7 +874,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
* *
* *
*/ */
Term Yap_read_term(int inp_stream, Term opts, int nargs) { Term Yap_read_term(int inp_stream, Term opts, bool clause) {
FEnv fe; FEnv fe;
REnv re; REnv re;
#if EMACS #if EMACS
@ -860,7 +886,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
while (true) { while (true) {
switch (state) { switch (state) {
case YAP_START_PARSING: case YAP_START_PARSING:
state = initParser(opts, &fe, &re, inp_stream, nargs); state = initParser(opts, &fe, &re, inp_stream, clause);
if (state == YAP_PARSING_FINISHED) { if (state == YAP_PARSING_FINISHED) {
pop_text_stack(lvl); pop_text_stack(lvl);
return 0; return 0;
@ -907,12 +933,8 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
static Int static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc; return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) !=
yhandle_t h = Yap_PushHandle(ARG1); 0;
if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0)
return FALSE;
Term tf = Yap_PopHandle(h);
return rc && Yap_unify(tf, rc);
} }
static Int read_term( static Int read_term(
@ -922,15 +944,13 @@ static Int read_term(
/* needs to change LOCAL_output_stream for write */ /* needs to change LOCAL_output_stream for write */
yhandle_t h = Yap_PushHandle(ARG2);
inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
if (inp_stream == -1) { if (inp_stream == -1) {
return (FALSE); return (FALSE);
} }
out = Yap_read_term(inp_stream, ARG3, 3); out = Yap_read_term(inp_stream, add_output(ARG1, ARG2), false);
UNLOCK(GLOBAL_Stream[inp_stream].streamlock); UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
Term tf = Yap_PopHandle(h); return out != 0L;
return out != 0L && Yap_unify(tf, out);
} }
#define READ_CLAUSE_DEFS() \ #define READ_CLAUSE_DEFS() \
@ -940,6 +960,7 @@ static Int read_term(
PAR("variables", filler, READ_CLAUSE_VARIABLES), \ PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR("output", isatom, READ_CLAUSE_OUTPUT), \
PAR(NULL, ok, READ_CLAUSE_END) PAR(NULL, ok, READ_CLAUSE_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
@ -966,6 +987,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL; return NULL;
} }
if (args[READ_CLAUSE_OUTPUT].used) {
fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue;
} else {
fe->t0 = 0;
}
if (args[READ_CLAUSE_MODULE].used) { if (args[READ_CLAUSE_MODULE].used) {
fe->cmod = args[READ_CLAUSE_MODULE].tvalue; fe->cmod = args[READ_CLAUSE_MODULE].tvalue;
} else { } else {
@ -977,6 +1003,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
fe->enc = GLOBAL_Stream[inp_stream].encoding; fe->enc = GLOBAL_Stream[inp_stream].encoding;
fe->sp = 0; fe->sp = 0;
fe->qq = 0; fe->qq = 0;
if (args[READ_CLAUSE_OUTPUT].used) {
fe->t0 = args[READ_CLAUSE_OUTPUT].tvalue;
} else {
fe->t0 = 0;
}
if (args[READ_CLAUSE_TERM_POSITION].used) { if (args[READ_CLAUSE_TERM_POSITION].used) {
fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue; fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue;
} else { } else {
@ -1018,30 +1049,28 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} }
/** /**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @pred read_clause( +Stream, -Clause, ?Opts) is det
* *
u* Same as read_clause/3, but from the standard input stream. * Same as read_clause/3, but from the standard input stream.
* *
*/ */
static Int read_clause2(USES_REGS1) { static Int read_clause2(USES_REGS1) {
Term rc; Term ctl = add_output(ARG1, ARG2);
yhandle_t h = Yap_InitSlot(ARG1); return Yap_read_term(LOCAL_c_input_stream, ctl, true);
rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), -2);
Term tf = Yap_GetFromSlot(h);
Yap_RecoverSlots(1, h);
return rc && Yap_unify(tf, rc);
} }
/** /**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @pred read_clause( +Stream, -Clause, ?Opts) is det
* *
* This predicate receives a set of options _OPts_ based on read_term/3, but * This predicate receives a set of options _OPts_ based on read_term/3, but
*specific *specific
* to readin clauses. The following options are considered: * to readin clauses. The following options are considered:
* *
* + The `comments` option unifies its argument with the comments in the term, * + The `comments` option unifies its argument with the comments in the
*term,
* represented as strings * represented as strings
* + The `process_comments` option calls a hook, it is current ignored by YAP. * + The `process_comments` option calls a hook, it is current ignored by
*YAP.
* + The `term_position` unifies its argument with a term describing the * + The `term_position` unifies its argument with a term describing the
* position of the term. * position of the term.
* + The `syntax_errors` flag controls response to syntactic errors, the * + The `syntax_errors` flag controls response to syntactic errors, the
@ -1057,27 +1086,14 @@ static Int read_clause(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream; int inp_stream;
Term out; Term out;
Term t3 = Deref(ARG3);
yhandle_t h = Yap_InitSlot(ARG2);
/* needs to change LOCAL_output_stream for write */ /* needs to change LOCAL_output_stream for write */
inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
if (inp_stream < 0) if (inp_stream < 0)
return false; return false;
out = Yap_read_term(inp_stream, t3, -3); out = Yap_read_term(inp_stream, add_output(ARG2, ARG3), true);
#if COMMENTED
if (LOCAL_SourceFileLineno == 707) {
char *s;
size_t length;
s = Yap_TermToString(out, &length, LOCAL_encoding, 0);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", "at %d %s",
LOCAL_SourceFileLineno, s);
}
#endif
UNLOCK(GLOBAL_Stream[inp_stream].streamlock); UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
Term tf = Yap_GetFromSlot(h); return out != 0;
Yap_RecoverSlots(1, h);
return out && Yap_unify(tf, out);
} }
/** /**
@ -1144,7 +1160,7 @@ static Int source_location(USES_REGS1) {
} }
/** /**
* @pred read(+ _Stream_, - _Term_ ) is iso * @pred read(+ Stream, -Term ) is iso
* *
* Reads term _T_ from the stream _S_ instead of from the current input * Reads term _T_ from the stream _S_ instead of from the current input
* stream. * stream.
@ -1163,12 +1179,12 @@ static Int read2(
if (inp_stream == -1) { if (inp_stream == -1) {
return (FALSE); return (FALSE);
} }
out = Yap_read_term(inp_stream, TermNil, 1); out = Yap_read_term(inp_stream, add_output(ARG2, TermNil), false);
UNLOCK(GLOBAL_Stream[inp_stream].streamlock); UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
return out && Yap_unify(ARG2, out); return out;
} }
/** @pred read(- _T_) is iso /** @pred read(- T) is iso
Reads the next term from the current input stream, and unifies it with Reads the next term from the current input stream, and unifies it with
_T_. The term must be followed by a dot (`.`) and any blank-character _T_. The term must be followed by a dot (`.`) and any blank-character
@ -1180,8 +1196,8 @@ the same stream may cause an error failure (see open/3).
*/ */
static Int read1( static Int read1(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
Term out = Yap_read_term(LOCAL_c_input_stream, TermNil, 1); Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1);
return out && Yap_unify(ARG1, out); return out;
} }
/** @pred fileerrors /** @pred fileerrors
@ -1252,38 +1268,35 @@ static Int style_checker(USES_REGS1) {
return TRUE; return TRUE;
} }
X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, Term Yap_BufferToTerm(const unsigned char *s, size_t len, Term opts) {
int prio, Term *bindingsp) {
CACHE_REGS
Term ctl;
int lvl = push_text_stack();
if (len == 0) {
Term rval = TermEof;
pop_text_stack(lvl);
return rval;
}
if (bindingsp) {
ctl = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
} else {
ctl = TermNil;
}
Term rval; Term rval;
int stream = Yap_open_buf_read_stream(s, len, encp, MEM_BUF_USER); int sno;
encoding_t L;
sno = Yap_open_buf_read_stream((char *)s, len, &L, MEM_BUF_USER);
rval = Yap_read_term(stream, ctl, 3); rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(stream); Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[stream].streamlock);
if (rval && bindingsp) {
*bindingsp = ArgOfTerm(1, ctl);
}
pop_text_stack(lvl);
return rval; return rval;
} }
X_API Term Yap_BufferToTermWithPrioBindings(const unsigned char *s, size_t len,
Term opts, int prio,
Term bindings) {
CACHE_REGS
Term ctl;
ctl = opts;
if (bindings) {
ctl = add_names(bindings, TermNil);
}
if (prio != 1200) {
ctl = add_priority(bindings, ctl);
}
return Yap_BufferToTerm(s, len, ctl);
}
/** /**
* @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_ * @pred read_term_from_atom( +Atom , -T , +Options )
* *
* read a term _T_ stored in constant _Atom_ according to _Options_ * read a term _T_ stored in constant _Atom_ according to _Options_
* *
@ -1291,14 +1304,19 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
* @param _T_ the output term _T_, may be any term * @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options. * @param _Options_ read_term/3 options.
* *
* @notes Originally from SWI-Prolog, in YAP only works with internalised atoms * @notes Originally from SWI-Prolog, in YAP only works with internalised
* Check read_term_from_atomic/3 for the general version. Also, the built-in is *atoms
* Check read_term_from_atomic/3 for the general version. Also, the built-in
*is
*supposed to *supposed to
* use YAP's internal encoding, so please avoid the encoding/1 option. * use YAP's internal encoding, so please avoid the encoding/1 option.
*/ */
static Int read_term_from_atom(USES_REGS1) { static Int read_term_from_atom(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1);
Atom at; Atom at;
const unsigned char *s;
size_t len;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1"); Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1");
return false; return false;
@ -1307,31 +1325,21 @@ static Int read_term_from_atom(USES_REGS1) {
return false; return false;
} else { } else {
at = AtomOfTerm(t1); at = AtomOfTerm(t1);
s = at->UStrOfAE;
len = strlen_utf8(s);
} }
if ((rc = Yap_AtomToTerm(at, Deref(ARG3))) == 0L) Term ctl = add_output(ARG2, ARG3);
return false;
return Yap_unify(rc, ARG2);
}
Term Yap_AtomToTerm(Atom a, Term opts) { return Yap_BufferToTerm(s, len, ctl);
Term rval;
int sno;
char *s = a->StrOfAE;
size_t len = strlen(s);
encoding_t enc = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);
return rval;
} }
/** /**
* @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ ) * @pred read_term_from_atomic( +Atomic , - T , +Options )
* *
* read a term _T_ stored in text _Atomic_ according to _Options_ * read a term _T_ stored in text _Atomic_ according to _Options_
* *
* @param _Atomic_ the source may be an atom, string, list of codes, or list of * @param _Atomic_ the source may be an atom, string, list of codes, or list
*of
*chars. *chars.
* @param _T_ the output term _T_, may be any term * @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options. * @param _Options_ read_term/3 options.
@ -1341,7 +1349,7 @@ Term Yap_AtomToTerm(Atom a, Term opts) {
* Encoding is fixed in atoms and strings. * Encoding is fixed in atoms and strings.
*/ */
static Int read_term_from_atomic(USES_REGS1) { static Int read_term_from_atomic(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1);
const unsigned char *s; const unsigned char *s;
size_t len; size_t len;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
@ -1353,20 +1361,15 @@ static Int read_term_from_atomic(USES_REGS1) {
} else { } else {
Term t = Yap_AtomicToString(t1 PASS_REGS); Term t = Yap_AtomicToString(t1 PASS_REGS);
s = UStringOfTerm(t); s = UStringOfTerm(t);
len = strlen_utf8((unsigned char *)s); len = strlen_utf8(s);
} }
char *ss = (char *)s; Term ctl = add_output(ARG2, ARG3);
encoding_t enc = ENC_ISO_UTF8;
int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER); return Yap_BufferToTerm(s, len, ctl);
rc = Yap_read_term(sno, Deref(ARG3), 3);
Yap_CloseStream(sno);
if (!rc)
return false;
return Yap_unify(rc, ARG2);
} }
/** /**
* @pred read_term_from_string( +_String_ , - _T_ , + _Options_ * @pred read_term_from_string( +String , - T , + Options )
* *
* read a term _T_ stored in constant _String_ according to _Options_ * read a term _T_ stored in constant _String_ according to _Options_
* *

4
os/writeterm.c
View File

@ -716,7 +716,9 @@ static Int term_to_atom(USES_REGS1) {
at = AtomOfTerm(t2); at = AtomOfTerm(t2);
} }
ctl = TermNil; ctl = TermNil;
return (rc = Yap_AtomToTerm(at, ctl)) && Yap_unify(rc, ARG1); return (rc = Yap_BufferToTerm(RepAtom(at)->UStrOfAE,
strlen(RepAtom(at)->StrOfAE), ctl)) &&
Yap_unify(rc, ARG1);
} }
void Yap_InitWriteTPreds(void) { void Yap_InitWriteTPreds(void) {

7
os/yapio.h
View File

@ -105,8 +105,6 @@ typedef enum mem_buf_source {
extern char *Yap_MemStreamBuf(int sno); extern char *Yap_MemStreamBuf(int sno);
extern X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
int prio, Term *bindingsp);
extern Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, extern Term Yap_StringToNumberTerm(const char *s, encoding_t *encp,
bool error_on); bool error_on);
extern int Yap_FormatFloat(Float f, char **s, size_t sz); extern int Yap_FormatFloat(Float f, char **s, size_t sz);
@ -115,7 +113,10 @@ extern int Yap_open_buf_read_stream(const char *buf, size_t nchars,
extern bool Yap_set_stream_to_buf(struct stream_desc *st, const char *buf, extern bool Yap_set_stream_to_buf(struct stream_desc *st, const char *buf,
size_t nchars); size_t nchars);
extern int Yap_open_buf_write_stream(encoding_t enc, memBufSource src); extern int Yap_open_buf_write_stream(encoding_t enc, memBufSource src);
extern Term Yap_AtomToTerm(Atom a, Term opts); extern Term Yap_BufferToTerm(const unsigned char *s, size_t sz, Term opts);
extern X_API Term Yap_BufferToTermWithPrioBindings(const unsigned char *s,
size_t sz, Term opts,
int prio, Term bindings);
extern FILE *Yap_GetInputStream(Term t, const char *m); extern FILE *Yap_GetInputStream(Term t, const char *m);
extern FILE *Yap_GetOutputStream(Term t, const char *m); extern FILE *Yap_GetOutputStream(Term t, const char *m);
extern char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max); extern char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max);