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

86
C/text.c
View File

@ -51,9 +51,7 @@ typedef struct TextBuffer_manager {
int lvl;
} text_buffer_t;
int push_text_stack(USES_REGS1) {
return LOCAL_TextBuffer->lvl++;
}
int push_text_stack(USES_REGS1) { return LOCAL_TextBuffer->lvl++; }
int pop_text_stack(int i) {
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);
struct mblock *o = malloc(sz);
o->prev = LOCAL_TextBuffer->last[lvl];
if (o->prev) {
o->prev->next = o;
}
if (o->prev) {
o->prev->next = o;
}
if (LOCAL_TextBuffer->first[lvl]) {
LOCAL_TextBuffer->last[lvl] = o;
} else {
@ -206,7 +204,7 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp,
(*atoms)++;
if (*atoms < length) {
*tailp = l;
return -REPRESENTATION_ERROR_CHARACTER_CODE;
return -REPRESENTATION_ERROR_CHARACTER_CODE;
} else {
AtomEntry *ae = RepAtom(AtomOfTerm(hd));
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
// Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t);
if (lengp)
*lengp = strlen_utf8(at->UStrOfAE);
if (lengp)
*lengp = strlen_utf8(at->UStrOfAE);
return at->UStrOfAE;
}
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);
if (lengp)
*lengp = strlen_utf8(UStringOfTerm(inp->val.t));
return (unsigned char *)UStringOfTerm(inp->val.t);
if (lengp)
*lengp = strlen_utf8(UStringOfTerm(inp->val.t));
return (unsigned char *)UStringOfTerm(inp->val.t);
}
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
Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
return Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp 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 Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide,
lengp PASS_REGS);
return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, lengp 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 Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide,
lengp PASS_REGS);
return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS);
// this is a term, extract to a buffer, and representation is wide
}
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)) {
char *s;
size_t sz = 1024;
size_t sz = 1024;
// Yap_DebugPlWriteln(inp->val.t);
if (s0)
{ s = (char *)s0; sz = strlen(s);}
else
if (s0) {
s = (char *)s0;
sz = strlen(s);
} else
s = Malloc(sz);
if (!s)
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
if (!s)
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
while (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, sz - 1)) {
if (s0) { s = Malloc(sz=1024); s0 = NULL; }
else s = Realloc(s, sz+1024);
if (s0) {
s = Malloc(sz = 1024);
s0 = NULL;
} else
s = Realloc(s, sz + 1024);
}
*lengp = strlen(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) {
unsigned char *s = s0;
int32_t ch;
if ( leng == 0) {
return Yap_LookupAtom("");
}
if ( strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0);
if (leng == 0) {
return Yap_LookupAtom("");
}
if (strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0);
} else {
size_t n = get_utf8(s, 1, &ch);
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;
}
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;
int i = push_text_stack();
t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on);
pop_text_stack(i);
return t;
pop_text_stack(i);
return t;
}
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
Term o;
o = out->val.t =
Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, 0L);
o = out->val.t = Yap_BufferToTerm(s, strlen(s) + 1, TermNil);
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;
}
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);
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);
// Yap_DebugPlWriteln(out->val.t);
return out->val.t != 0;
default: { return true ; }
default: { return true; }
}
return false;
}
@ -917,9 +917,9 @@ static unsigned char *concat(int n, void *sv[] USES_REGS) {
buf = Malloc(room + 1);
buf0 = buf;
for (i = 0; i < n; i++) {
#if _WIN32 || defined( __ANDROID__ )
#if _WIN32 || defined(__ANDROID__)
strcpy(buf, sv[i]);
buf = (char*)buf + strlen(buf);
buf = (char *)buf + strlen(buf);
#else
buf = stpcpy(buf, sv[i]);
#endif
@ -1021,14 +1021,14 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
next = 0;
else
next = cuts[i - 1];
if (i>0 && cuts[i] == 0)
if (i > 0 && cuts[i] == 0)
break;
void *bufi = slice(next, cuts[i], buf PASS_REGS);
if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) {
return false;
}
}
return true;
}
@ -1085,7 +1085,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) {
const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) {
CACHE_REGS
Atom at;
arity_t arity = 0;
arity_t arity = 0;
Functor f;
char *s, *smax, *s0;
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>
/* 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
#include <ctype.h>
@ -20,64 +20,63 @@
#define SIZE_VOIDP SIZEOF_INT_P
#if SIZEOF_LONG_INT==4
#if SIZEOF_LONG_INT == 4
#define INT64_FORMAT "%lld"
#else
#define INT64_FORMAT "%ld"
#endif
#define INTBITSIZE (sizeof(int)*8)
#define INTBITSIZE (sizeof(int) * 8)
typedef module_t Module;
typedef Term (*Func)(term_t); /* foreign functions */
typedef module_t Module;
typedef Term (*Func)(term_t); /* foreign functions */
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 void Yap_setCurrentSourceLocation( void *rd );
extern void *Yap_GetStreamHandle(Atom at);
extern void Yap_WriteAtom(IOSTREAM *s, Atom atom);
extern void Yap_setCurrentSourceLocation(void *rd);
extern void *Yap_GetStreamHandle(Atom at);
extern void Yap_WriteAtom(IOSTREAM *s, Atom atom);
extern atom_t codeToAtom(int chrcode);
#define valTermRef(t) ((Word)Yap_AddressFromSlot(t))
#define valTermRef(t) ((Word)Yap_AddressFromSlot(t))
#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
COMMON(int) mbscoll(const char *s1, const char *s2);
#endif
#ifndef HAVE_MBSCASECOLL
COMMON(int) mbscasecoll(const char *s1, const char *s2);
#endif
COMMON(atom_t) TemporaryFile(const char *id, int *fdp);
COMMON(char *) Getenv(const char *, char *buf, size_t buflen);
COMMON(atom_t) TemporaryFile(const char *id, int *fdp);
COMMON(char *) Getenv(const char *, char *buf, size_t buflen);
/*** memory allocation stuff: SWI wraps around malloc */
#define stopItimer()
COMMON(word) pl_print(term_t term);
COMMON(word) pl_write(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_writeq(term_t term);
COMMON(word) pl_print(term_t term);
COMMON(word) pl_write(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_writeq(term_t term);
static inline int
get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
static inline int get_procedure(term_t descr, predicate_t *proc, term_t he,
int f) {
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))
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t),CurrentModule));
*proc = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), CurrentModule));
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
@ -88,41 +87,38 @@ get_procedure(term_t descr, predicate_t *proc, term_t he, int f) {
return TRUE;
}
/* TBD */
extern word globalString(size_t size, char *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)
Int YAP_PLArityOfSWIFunctor(functor_t f);
struct PL_blob_t* YAP_find_blob_type(Atom at);
Int YAP_PLArityOfSWIFunctor(functor_t f);
struct PL_blob_t *YAP_find_blob_type(Atom at);
void PL_license(const char *license, const char *module);
#define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE)
#define isInteger(A) (!IsVarTerm(A) && ( IsIntegerTerm((A)) || YAP_IsBigNumTerm((A)) ))
#define isString(A) (!IsVarTerm(A) && IsStringTerm(A) )
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)) )
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)) )
#define stringAtom(w) (YAP_AtomFromSWIAtom(w)->StrOfAE)
#define isInteger(A) \
(!IsVarTerm(A) && (IsIntegerTerm((A)) || YAP_IsBigNumTerm((A))))
#define isString(A) (!IsVarTerm(A) && IsStringTerm(A))
#define isAtom(A) (!IsVarTerm(A) && IsAtomTerm((A)))
#define isList(A) (!IsVarTerm(A) && IsPairTerm((A)))
#define isNil(A) ((A) == TermNil)
#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)) )
#define isReal(A) (!IsVarTerm(A) && IsFloatTerm((A)))
#define isFloat(A) (!IsVarTerm(A) && IsFloatTerm((A)))
#define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) AtomOfTerm(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static char *
atomName(Atom atom)
{
inline static char *atomName(Atom atom) {
if (IsWideAtom(atom))
return (char *)(atom->WStrOfAE);
return atom->StrOfAE;
@ -131,16 +127,19 @@ atomName(Atom atom)
#define nameOfAtom(atom) nameOfAtom(atom)
#define atomBlobType(at) YAP_find_blob_type(at)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); }
#define canBind(t) FALSE // VSC: to implement
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
#define argTermP(w, i) ((Word)((YAP_ArgsOfTerm(w) + (i))))
#define deRef(t) \
while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { \
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 lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
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 isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A)
@ -156,34 +155,32 @@ extern term_t Yap_CvtTerm(term_t ts);
wchar_t *nameOfWideAtom(atom_t atom);
int isWideAtom(atom_t atom);
inline static int
charCode(Term w)
{ if ( IsAtomTerm(w) )
{
Atom a = atomValue(w);
inline static int charCode(Term w) {
if (IsAtomTerm(w)) {
Atom a = atomValue(w);
if (IsWideAtom(a)) {
if (wcslen(a->WStrOfAE) == 1)
return a->WStrOfAE[0];
return -1;
}
if (strlen(a->StrOfAE) == 1)
return ((unsigned char *)(a->StrOfAE))[0];
if (IsWideAtom(a)) {
if (wcslen(a->WStrOfAE) == 1)
return a->WStrOfAE[0];
return -1;
}
if (strlen(a->StrOfAE) == 1)
return ((unsigned char *)(a->StrOfAE))[0];
return -1;
}
return -1;
}
#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_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_variable(t) PL_is_variable__LD(t PASS_LD)
#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_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_integer(t, i) PL_unify_integer__LD(t, i 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_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_variable(t) PL_is_variable__LD(t PASS_LD)
#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_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_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);
@ -192,13 +189,12 @@ charCode(Term w)
unsigned int getUnknownModule(module_t m);
#if IN_PL_OS_C
static int
stripostfix(const char *s, const char *e)
{ size_t ls = strlen(s);
static int stripostfix(const char *s, const char *e) {
size_t ls = strlen(s);
size_t le = strlen(e);
if ( ls >= le )
return strcasecmp(&s[ls-le], e) == 0;
if (ls >= le)
return strcasecmp(&s[ls - le], e) == 0;
return FALSE;
}
@ -209,9 +205,8 @@ stripostfix(const char *s, const char *e)
#include <signal.h>
#endif
static inline void
unblockSignal(int sig)
{ sigset_t set;
static inline void unblockSignal(int sig) {
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
@ -220,10 +215,7 @@ unblockSignal(int sig)
// DEBUG(1, Sdprintf("Unblocked signal %d\n", sig));
}
#else
static inline void
unblockSignal(int sig)
{
}
static inline void unblockSignal(int sig) {}
#endif
#define suspendTrace(x)
@ -234,6 +226,8 @@ atom_t ATOM_;
intptr_t system_thread_id(void);
#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 */

1
library/maplist.yap
View File

@ -1,3 +1,4 @@
/**
* @file maplist.yap
* @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()
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.
#
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,
Atom open_mode);
#
#define Yap_CheckStream(arg, kind, msg) \
Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
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 */
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 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, ...) \
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 Term Yap_MkStream(int n);
extern Term Yap_MkStream(int n);
extern bool Yap_PrintWarning(Term twarning);
extern void Yap_plwrite(Term, struct stream_desc *, int, int, int);
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);
@ -275,7 +275,8 @@ extern bool Yap_Exists(const char *f);
static inline void freeBuffer(const void *ptr) {
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;
free((void *)ptr);
}

235
os/readterm.c
View File

@ -8,6 +8,7 @@
* *
**************************************************************************
* *
read_term
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
@ -184,6 +185,7 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
#define READ_DEFS() \
PAR("comments", list_filler, READ_COMMENTS) \
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
PAR("output", filler, READ_OUTPUT), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \
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()};
#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
*
@ -299,7 +319,7 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
typedef struct FEnv {
Term qq, tp, sp, np, vp, ce;
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 *toklast; /// the last token
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();
if (args[READ_MODULE].used) {
fe->cmod = args[READ_MODULE].tvalue;
if (args[READ_OUTPUT].used) {
fe->t0 = args[READ_OUTPUT].tvalue;
} else {
fe->cmod = CurrentModule;
fe->t0 = 0;
}
if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE;
if (args[READ_BACKQUOTED_STRING].used) {
if (args[READ_MODULE].used) {
fe->cmod = args[READ_MODULE].tvalue;
} 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)) {
return false;
}
@ -562,6 +586,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v1, v2, v3, vc, tp;
if (fe->t0 && !(Yap_unify(fe->t, fe->t0)))
return false;
if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart);
else
@ -598,6 +625,8 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
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)
v_vp = get_variables(fe, tokstart);
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,
int nargs);
bool clause);
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,
int nargs) {
CACHE_REGS
bool clause) {
LOCAL_ErrorMessage = NULL;
fe->old_TR = TR;
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;
fe->tpos = StreamPosition(inp_stream);
fe->old_H = HR;
fe->reading_clause = nargs < 0;
if (fe->reading_clause) {
fe->nargs = -nargs;
fe->reading_clause = clause;
if (clause) {
fe->args = setClauseReadEnv(opts, fe, re, inp_stream);
} else {
fe->nargs = nargs;
fe->args = setReadEnv(opts, fe, re, inp_stream);
}
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;
REnv re;
#if EMACS
@ -860,7 +886,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
while (true) {
switch (state) {
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) {
pop_text_stack(lvl);
return 0;
@ -907,12 +933,8 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc;
yhandle_t h = Yap_PushHandle(ARG1);
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);
return Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, ARG2), false) !=
0;
}
static Int read_term(
@ -922,15 +944,13 @@ static Int read_term(
/* needs to change LOCAL_output_stream for write */
yhandle_t h = Yap_PushHandle(ARG2);
inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
if (inp_stream == -1) {
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);
Term tf = Yap_PopHandle(h);
return out != 0L && Yap_unify(tf, out);
return out != 0L;
}
#define READ_CLAUSE_DEFS() \
@ -940,6 +960,7 @@ static Int read_term(
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR("output", isatom, READ_CLAUSE_OUTPUT), \
PAR(NULL, ok, READ_CLAUSE_END)
#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;
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) {
fe->cmod = args[READ_CLAUSE_MODULE].tvalue;
} else {
@ -977,6 +1003,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
fe->enc = GLOBAL_Stream[inp_stream].encoding;
fe->sp = 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) {
fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue;
} 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) {
Term rc;
yhandle_t h = Yap_InitSlot(ARG1);
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);
Term ctl = add_output(ARG1, ARG2);
return Yap_read_term(LOCAL_c_input_stream, ctl, true);
}
/**
* @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
*specific
* 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
* + 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
* position of the term.
* + 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) */
int inp_stream;
Term out;
Term t3 = Deref(ARG3);
yhandle_t h = Yap_InitSlot(ARG2);
/* needs to change LOCAL_output_stream for write */
inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
if (inp_stream < 0)
return false;
out = Yap_read_term(inp_stream, t3, -3);
#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
out = Yap_read_term(inp_stream, add_output(ARG2, ARG3), true);
UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
Term tf = Yap_GetFromSlot(h);
Yap_RecoverSlots(1, h);
return out && Yap_unify(tf, out);
return out != 0;
}
/**
@ -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
* stream.
@ -1163,12 +1179,12 @@ static Int read2(
if (inp_stream == -1) {
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);
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
_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(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
Term out = Yap_read_term(LOCAL_c_input_stream, TermNil, 1);
return out && Yap_unify(ARG1, out);
Term out = Yap_read_term(LOCAL_c_input_stream, add_output(ARG1, TermNil), 1);
return out;
}
/** @pred fileerrors
@ -1252,38 +1268,35 @@ static Int style_checker(USES_REGS1) {
return TRUE;
}
X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
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 Yap_BufferToTerm(const unsigned char *s, size_t len, Term opts) {
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);
Yap_CloseStream(stream);
UNLOCK(GLOBAL_Stream[stream].streamlock);
if (rval && bindingsp) {
*bindingsp = ArgOfTerm(1, ctl);
}
pop_text_stack(lvl);
rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno);
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_
*
@ -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 _Options_ read_term/3 options.
*
* @notes Originally from SWI-Prolog, in YAP only works with internalised atoms
* Check read_term_from_atomic/3 for the general version. Also, the built-in is
* @notes Originally from SWI-Prolog, in YAP only works with internalised
*atoms
* Check read_term_from_atomic/3 for the general version. Also, the built-in
*is
*supposed to
* use YAP's internal encoding, so please avoid the encoding/1 option.
*/
static Int read_term_from_atom(USES_REGS1) {
Term t1 = Deref(ARG1), rc;
Term t1 = Deref(ARG1);
Atom at;
const unsigned char *s;
size_t len;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "style_check/1");
return false;
@ -1307,31 +1325,21 @@ static Int read_term_from_atom(USES_REGS1) {
return false;
} else {
at = AtomOfTerm(t1);
s = at->UStrOfAE;
len = strlen_utf8(s);
}
if ((rc = Yap_AtomToTerm(at, Deref(ARG3))) == 0L)
return false;
return Yap_unify(rc, ARG2);
}
Term ctl = add_output(ARG2, ARG3);
Term Yap_AtomToTerm(Atom a, Term opts) {
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;
return Yap_BufferToTerm(s, len, ctl);
}
/**
* @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_
*
* @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.
* @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options.
@ -1341,7 +1349,7 @@ Term Yap_AtomToTerm(Atom a, Term opts) {
* Encoding is fixed in atoms and strings.
*/
static Int read_term_from_atomic(USES_REGS1) {
Term t1 = Deref(ARG1), rc;
Term t1 = Deref(ARG1);
const unsigned char *s;
size_t len;
if (IsVarTerm(t1)) {
@ -1353,20 +1361,15 @@ static Int read_term_from_atomic(USES_REGS1) {
} else {
Term t = Yap_AtomicToString(t1 PASS_REGS);
s = UStringOfTerm(t);
len = strlen_utf8((unsigned char *)s);
len = strlen_utf8(s);
}
char *ss = (char *)s;
encoding_t enc = ENC_ISO_UTF8;
int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER);
rc = Yap_read_term(sno, Deref(ARG3), 3);
Yap_CloseStream(sno);
if (!rc)
return false;
return Yap_unify(rc, ARG2);
Term ctl = add_output(ARG2, ARG3);
return Yap_BufferToTerm(s, len, ctl);
}
/**
* @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_
*

4
os/writeterm.c
View File

@ -716,7 +716,9 @@ static Int term_to_atom(USES_REGS1) {
at = AtomOfTerm(t2);
}
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) {

7
os/yapio.h
View File

@ -105,8 +105,6 @@ typedef enum mem_buf_source {
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,
bool error_on);
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,
size_t nchars);
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_GetOutputStream(Term t, const char *m);
extern char *Yap_guessFileName(FILE *f, int sno, char *nameb, size_t max);