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

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-02-10 09:20:12 +00:00
commit 9743c81f05
20 changed files with 6953 additions and 2086 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/grow.c
View File

@ -737,6 +737,8 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep USES_REGS)
break; break;
case Var_tok: case Var_tok:
case String_tok: case String_tok:
case WString_tok:
case StringTerm_tok:
if (IsOldTrail(tks->TokInfo)) if (IsOldTrail(tks->TokInfo))
tks->TokInfo = TrailAdjust(tks->TokInfo); tks->TokInfo = TrailAdjust(tks->TokInfo);
break; break;

6
C/iopreds.c
View File

@ -356,6 +356,12 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
} }
break; break;
case StringTerm_tok:
{
Term t0 = MkStringTerm((const char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok: case WString_tok:
{ {
Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS); Term t0 = Yap_WCharsToListOfCodes((const wchar_t *)info PASS_REGS);

493
C/parser.c
View File

@ -136,7 +136,6 @@ dot with single quotes.
* *
*/ */
#include "Yap.h" #include "Yap.h"
#include "Yatom.h" #include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
@ -157,69 +156,65 @@ dot with single quotes.
#define Volatile #define Volatile
#endif #endif
/* weak backtraking mechanism based on long_jump */ /* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct { typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
sigjmp_buf JmpBuff;
} JMPBUFF;
static void GNextToken( CACHE_TYPE1 ); static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF * CACHE_TYPE); static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(read_data *, Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE); static Term ParseArgs(read_data *, Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(read_data *, JMPBUFF * CACHE_TYPE); static Term ParseList(read_data *, JMPBUFF *CACHE_TYPE);
static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE); static Term ParseTerm(read_data *, int, JMPBUFF *CACHE_TYPE);
#define TRY(S, P) \
#define TRY(S,P) \ { \
{ Volatile JMPBUFF *saveenv, newenv; \ Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH=HR; \ Volatile CELL *saveH = HR; \
Volatile int savecurprio=curprio; \ Volatile int savecurprio = curprio; \
saveenv=FailBuff; \ saveenv = FailBuff; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \ if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \ FailBuff = &newenv; \
S; \ S; \
FailBuff=saveenv; \ FailBuff = saveenv; \
P; \ P; \
} \ } else { \
else { FailBuff=saveenv; \ FailBuff = saveenv; \
HR=saveH; \ HR = saveH; \
curprio = savecurprio; \ curprio = savecurprio; \
LOCAL_tokptr=saveT; \ LOCAL_tokptr = saveT; \
} \ } \
} }
#define TRY3(S,P,F) \ #define TRY3(S, P, F) \
{ Volatile JMPBUFF *saveenv, newenv; \ { \
Volatile TokEntry *saveT=LOCAL_tokptr; \ Volatile JMPBUFF *saveenv, newenv; \
Volatile CELL *saveH=HR; \ Volatile TokEntry *saveT = LOCAL_tokptr; \
saveenv=FailBuff; \ Volatile CELL *saveH = HR; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \ saveenv = FailBuff; \
if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \ FailBuff = &newenv; \
S; \ S; \
FailBuff=saveenv; \ FailBuff = saveenv; \
P; \ P; \
} else { \
FailBuff = saveenv; \
HR = saveH; \
LOCAL_tokptr = saveT; \
F \
} \ } \
else { \
FailBuff=saveenv; \
HR=saveH; \
LOCAL_tokptr=saveT; \
F } \
} }
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
#define FAIL siglongjmp(FailBuff->JmpBuff,1) VarEntry *Yap_LookupVar(char *var) /* lookup variable in variables table */
VarEntry *
Yap_LookupVar(char *var) /* lookup variable in variables table */
{ {
CACHE_REGS CACHE_REGS
VarEntry *p; VarEntry *p;
#if DEBUG #if DEBUG
if (GLOBAL_Option[4]) if (GLOBAL_Option[4])
fprintf(stderr,"[LookupVar %s]", var); fprintf(stderr, "[LookupVar %s]", var);
#endif #endif
if (var[0] != '_' || var[1] != '\0') { if (var[0] != '_' || var[1] != '\0') {
VarEntry **op = &LOCAL_VarTable; VarEntry **op = &LOCAL_VarTable;
@ -234,7 +229,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
Int scmp; Int scmp;
if ((scmp = strcmp(var, p->VarRep)) == 0) { if ((scmp = strcmp(var, p->VarRep)) == 0) {
p->refs++; p->refs++;
return(p); return (p);
} else if (scmp < 0) { } else if (scmp < 0) {
op = &(p->VarLeft); op = &(p->VarLeft);
p = p->VarLeft; p = p->VarLeft;
@ -250,7 +245,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
p = p->VarRight; p = p->VarRight;
} }
} }
p = (VarEntry *) Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry)); p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
*op = p; *op = p;
p->VarLeft = p->VarRight = NULL; p->VarLeft = p->VarRight = NULL;
p->hv = hv; p->hv = hv;
@ -258,7 +253,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
strcpy(p->VarRep, var); strcpy(p->VarRep, var);
} else { } else {
/* anon var */ /* anon var */
p = (VarEntry *) Yap_AllocScannerMemory(sizeof(VarEntry) + 2); p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
p->VarLeft = LOCAL_AnonVarTable; p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p; LOCAL_AnonVarTable = p;
p->VarRight = NULL; p->VarRight = NULL;
@ -271,9 +266,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
return (p); return (p);
} }
static Term static Term VarNames(VarEntry *p, Term l USES_REGS) {
VarNames(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) { if (strcmp(p->VarRep, "_") != 0) {
Term t[2]; Term t[2];
@ -283,30 +276,26 @@ VarNames(VarEntry *p,Term l USES_REGS)
t[1] = p->VarAdr; t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t); o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight, o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft,l PASS_REGS) PASS_REGS)); VarNames(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP-4096) { if (HR > ASP - 4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch, 1);
} }
return(o); return (o);
} else { } else {
return VarNames(p->VarRight,VarNames(p->VarLeft,l PASS_REGS) PASS_REGS); return VarNames(p->VarRight, VarNames(p->VarLeft, l PASS_REGS) PASS_REGS);
} }
} else { } else {
return (l); return (l);
} }
} }
Term Term Yap_VarNames(VarEntry *p, Term l) {
Yap_VarNames(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return VarNames(p,l PASS_REGS); return VarNames(p, l PASS_REGS);
} }
static Term static Term Singletons(VarEntry *p, Term l USES_REGS) {
Singletons(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
if (p->VarRep && p->VarRep[0] != '_' && p->refs == 1) { if (p->VarRep && p->VarRep[0] != '_' && p->refs == 1) {
Term t[2]; Term t[2];
@ -315,62 +304,56 @@ Singletons(VarEntry *p,Term l USES_REGS)
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
t[1] = p->VarAdr; t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t); o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, Singletons(p->VarRight, o = MkPairTerm(o,
Singletons(p->VarLeft,l PASS_REGS) PASS_REGS)); Singletons(p->VarRight,
if (HR > ASP-4096) { Singletons(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch, 1);
} }
return(o); return (o);
} else { } else {
return Singletons(p->VarRight,Singletons(p->VarLeft,l PASS_REGS) PASS_REGS); return Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS);
} }
} else { } else {
return (l); return (l);
} }
} }
Term Term Yap_Singletons(VarEntry *p, Term l) {
Yap_Singletons(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return Singletons(p,l PASS_REGS); return Singletons(p, l PASS_REGS);
} }
static Term Variables(VarEntry *p, Term l USES_REGS) {
static Term
Variables(VarEntry *p,Term l USES_REGS)
{
if (p != NULL) { if (p != NULL) {
Term o; Term o;
o = MkPairTerm(p->VarAdr, Variables(p->VarRight,Variables(p->VarLeft,l PASS_REGS) PASS_REGS)); o = MkPairTerm(
if (HR > ASP-4096) { p->VarAdr,
Variables(p->VarRight, Variables(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs(); save_machine_regs();
siglongjmp(LOCAL_IOBotch,1); siglongjmp(LOCAL_IOBotch, 1);
} }
return(o); return (o);
} else { } else {
return (l); return (l);
} }
} }
Term Term Yap_Variables(VarEntry *p, Term l) {
Yap_Variables(VarEntry *p,Term l)
{
CACHE_REGS CACHE_REGS
return Variables(p,l PASS_REGS); return Variables(p, l PASS_REGS);
} }
static int static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -378,7 +361,7 @@ IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p & MaskPrio; *pptr = *rpptr = p & MaskPrio;
if (p & DcrrpFlag) if (p & DcrrpFlag)
--* rpptr; --*rpptr;
return TRUE; return TRUE;
} else { } else {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
@ -386,23 +369,18 @@ IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
} }
} }
int int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
Yap_IsPrefixOp(Atom op,int *pptr, int *rpptr)
{
CACHE_REGS CACHE_REGS
return IsPrefixOp(op,pptr,rpptr PASS_REGS); return IsPrefixOp(op, pptr, rpptr PASS_REGS);
} }
static int static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -410,9 +388,9 @@ IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p & MaskPrio; *pptr = *rpptr = *lpptr = p & MaskPrio;
if (p & DcrrpFlag) if (p & DcrrpFlag)
--* rpptr; --*rpptr;
if (p & DcrlpFlag) if (p & DcrlpFlag)
--* lpptr; --*lpptr;
return TRUE; return TRUE;
} else { } else {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
@ -420,23 +398,18 @@ IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
} }
} }
int int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr)
{
CACHE_REGS CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS); return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS);
} }
static int static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
{
int p; int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
if (!opp) if (!opp)
return FALSE; return FALSE;
if (opp->OpModule && if (opp->OpModule && opp->OpModule != CurrentModule) {
opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return FALSE;
} }
@ -444,7 +417,7 @@ IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p & MaskPrio; *pptr = *lpptr = p & MaskPrio;
if (p & DcrlpFlag) if (p & DcrlpFlag)
--* lpptr; --*lpptr;
return (TRUE); return (TRUE);
} else { } else {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
@ -452,16 +425,12 @@ IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
} }
} }
int int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr)
{
CACHE_REGS CACHE_REGS
return IsPosfixOp(op, pptr, lpptr PASS_REGS); return IsPosfixOp(op, pptr, lpptr PASS_REGS);
} }
inline static void inline static void GNextToken(USES_REGS1) {
GNextToken( USES_REGS1 )
{
if (LOCAL_tokptr->Tok == Ord(eot_tok)) if (LOCAL_tokptr->Tok == Ord(eot_tok))
return; return;
if (LOCAL_tokptr == LOCAL_toktide) if (LOCAL_tokptr == LOCAL_toktide)
@ -470,52 +439,47 @@ GNextToken( USES_REGS1 )
LOCAL_tokptr = LOCAL_tokptr->TokNext; LOCAL_tokptr = LOCAL_tokptr->TokNext;
} }
inline static void inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
{ LOCAL_tokptr->TokInfo != (Term)c)
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)
|| LOCAL_tokptr->TokInfo != (Term)c)
FAIL; FAIL;
NextToken; NextToken;
} }
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
static int is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat) {
static int CACHE_REGS
is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
{ CACHE_REGS
Term m = CurrentModule, t; Term m = CurrentModule, t;
Atom at; Atom at;
UInt arity; UInt arity;
Functor f; Functor f;
t = Yap_StripModule(goal, &m); t = Yap_StripModule(goal, &m);
f = FunctorOfTerm( t ); f = FunctorOfTerm(t);
*pat = at = NameOfFunctor( f ); *pat = at = NameOfFunctor(f);
arity = ArityOfFunctor( f ); arity = ArityOfFunctor(f);
if ( arity > 0 ) if (arity > 0)
return TRUE; return TRUE;
return FALSE; return FALSE;
} }
static int static int get_quasi_quotation(term_t t, unsigned char **here,
get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein, unsigned char *ein, ReadData _PL_rd) {
ReadData _PL_rd) unsigned char *in, *start = *here;
{ unsigned char *in, *start = *here;
for(in=start; in <= ein; in++) for (in = start; in <= ein; in++) {
{ if ( in[0] == '}' && if (in[0] == '}' && in[-1] == '|') {
in[-1] == '|' ) *here = in + 1; /* after } */
{ *here = in+1; /* after } */
in--; /* Before | */ in--; /* Before | */
if ( _PL_rd->quasi_quotations ) /* option; must return strings */ if (_PL_rd->quasi_quotations) /* option; must return strings */
{ PL_chars_t txt; {
PL_chars_t txt;
int rc; int rc;
txt.text.t = (char*)start; txt.text.t = (char *)start;
txt.length = in-start; txt.length = in - start;
txt.storage = PL_CHARS_HEAP; txt.storage = PL_CHARS_HEAP;
txt.encoding = ENC_UTF8; txt.encoding = ENC_UTF8;
txt.canonical = FALSE; txt.canonical = FALSE;
@ -524,38 +488,35 @@ get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein,
PL_free_text(&txt); PL_free_text(&txt);
return rc; return rc;
} else } else {
{ return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3, return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
PL_POINTER, _PL_rd, PL_POINTER, _PL_rd, PL_INTPTR, (intptr_t)(start),
PL_INTPTR, (intptr_t)(start), PL_INTPTR, (intptr_t)(in - start));
PL_INTPTR, (intptr_t)(in-start));
} }
} }
} }
return FALSE; //errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd); return FALSE; // errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd);
} }
#endif /*O_QUASIQUOTATIONS*/ #endif /*O_QUASIQUOTATIONS*/
static Term ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff,
static Term Term arg1 USES_REGS) {
ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
{
int nargs = 0; int nargs = 0;
Term *p, t; Term *p, t;
Functor func; Functor func;
#ifdef SFUNC #ifdef SFUNC
SFEntry *pe = (SFEntry *) Yap_GetAProp(a, SFProperty); SFEntry *pe = (SFEntry *)Yap_GetAProp(a, SFProperty);
#endif #endif
NextToken; NextToken;
p = (Term *) ParserAuxSp; p = (Term *)ParserAuxSp;
if (arg1) { if (arg1) {
*p = arg1; *p = arg1;
nargs++; nargs++;
ParserAuxSp = (char *)(p+1); ParserAuxSp = (char *)(p + 1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
&& LOCAL_tokptr->TokInfo == close) { LOCAL_tokptr->TokInfo == close) {
func = Yap_MkFunctor(a, 1); func = Yap_MkFunctor(a, 1);
if (func == NULL) { if (func == NULL) {
@ -563,7 +524,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
FAIL; FAIL;
} }
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
return TermNil; return TermNil;
} }
@ -573,7 +534,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
} }
while (1) { while (1) {
Term *tp = (Term *)ParserAuxSp; Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp+1 > LOCAL_TrailTop) { if (ParserAuxSp + 1 > LOCAL_TrailTop) {
LOCAL_ErrorMessage = "Trail Overflow"; LOCAL_ErrorMessage = "Trail Overflow";
FAIL; FAIL;
} }
@ -582,7 +543,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
++nargs; ++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)) if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
break; break;
if (((int) LOCAL_tokptr->TokInfo) != ',') if (((int)LOCAL_tokptr->TokInfo) != ',')
break; break;
NextToken; NextToken;
} }
@ -591,7 +552,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
* Needed because the arguments for the functor are placed in reverse * Needed because the arguments for the functor are placed in reverse
* order * order
*/ */
if (HR > ASP-(nargs+1)) { if (HR > ASP - (nargs + 1)) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -611,7 +572,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
else else
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
#endif #endif
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
return TermNil; return TermNil;
} }
@ -620,39 +581,36 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
return t; return t;
} }
static Term MakeAccessor( Term t, Functor f USES_REGS ) static Term MakeAccessor(Term t, Functor f USES_REGS) {
{
UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i; UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i;
Term tf[2], tl= TermNil; Term tf[2], tl = TermNil;
tf[1] = ArgOfTerm(1, t); tf[1] = ArgOfTerm(1, t);
for (i = arity; i > 1; i--) { for (i = arity; i > 1; i--) {
tl = MkPairTerm(ArgOfTerm(i, t), tl); tl = MkPairTerm(ArgOfTerm(i, t), tl);
} }
tf[0] = tl; tf[0] = tl;
return Yap_MkApplTerm( f, 2, tf ); return Yap_MkApplTerm(f, 2, tf);
} }
static Term static Term ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS) {
ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
{
Term o; Term o;
CELL *to_store; CELL *to_store;
o = AbsPair(HR); o = AbsPair(HR);
loop: loop:
to_store = HR; to_store = HR;
HR+=2; HR += 2;
to_store[0] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[0] = ParseTerm(rd, 999, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int) LOCAL_tokptr->TokInfo) == ',') { if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken; NextToken;
if (LOCAL_tokptr->Tok == Ord(Name_tok) if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
&& strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) { strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) {
NextToken; NextToken;
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else { } else {
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
to_store[1] = TermNil; to_store[1] = TermNil;
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
@ -661,7 +619,7 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
goto loop; goto loop;
} }
} }
} else if (((int) LOCAL_tokptr->TokInfo) == '|') { } else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken; NextToken;
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS); to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else { } else {
@ -672,9 +630,7 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
return (o); return (o);
} }
static Term static Term ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS) {
ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
{
/* parse term with priority prio */ /* parse term with priority prio */
Volatile Term t; Volatile Term t;
Volatile Functor func; Volatile Functor func;
@ -705,10 +661,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break; break;
} }
} }
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
|| Unsigned(LOCAL_tokptr->TokInfo) != 'l') Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
&& IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS) IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) {
) {
if (LOCAL_tokptr->Tok == Name_tok) { if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo; Atom at = (Atom)LOCAL_tokptr->TokInfo;
#ifndef _MSC_VER #ifndef _MSC_VER
@ -739,27 +694,23 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
/* try to parse as a prefix operator */ /* try to parse as a prefix operator */
TRY( TRY(
/* build appl on the heap */ /* build appl on the heap */
func = Yap_MkFunctor((Atom) t, 1); func = Yap_MkFunctor((Atom)t, 1);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; LOCAL_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} } t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} } curprio = opprio;
curprio = opprio; , break;)
,
break;
)
} }
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
&& Unsigned(LOCAL_tokptr->TokInfo) == 'l') Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs(rd, (Atom) t, ')', FailBuff, 0L PASS_REGS); t = ParseArgs(rd, (Atom)t, ')', FailBuff, 0L PASS_REGS);
else else
t = MkAtomTerm((Atom)t); t = MkAtomTerm((Atom)t);
break; break;
@ -771,28 +722,36 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case String_tok: /* build list on the heap */ case String_tok: /* build list on the heap */
{ {
Volatile char *p = (char *) LOCAL_tokptr->TokInfo; Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS); t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
FAIL; FAIL;
} }
NextToken; NextToken;
} } break;
break;
case WString_tok: /* build list on the heap */ case WString_tok: /* build list on the heap */
{ {
Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo; Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS); t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
FAIL; FAIL;
} }
NextToken; NextToken;
} } break;
break;
case Var_tok: case StringTerm_tok: /* build list on the heap */
varinfo = (VarEntry *) (LOCAL_tokptr->TokInfo); {
Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToString(p PASS_REGS);
if (!t) {
FAIL;
}
NextToken;
} break;
case Var_tok:
varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
if ((t = varinfo->VarAdr) == TermNil) { if ((t = varinfo->VarAdr) == TermNil) {
t = varinfo->VarAdr = MkVarTerm(); t = varinfo->VarAdr = MkVarTerm();
} }
@ -803,7 +762,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
FAIL; FAIL;
case Ponctuation_tok: case Ponctuation_tok:
switch ((int) LOCAL_tokptr->TokInfo) { switch ((int)LOCAL_tokptr->TokInfo) {
case '(': case '(':
case 'l': /* non solo ( */ case 'l': /* non solo ( */
NextToken; NextToken;
@ -813,7 +772,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case '[': case '[':
NextToken; NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok && if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int) LOCAL_tokptr->TokInfo == ']') { (int)LOCAL_tokptr->TokInfo == ']') {
t = TermNil; t = TermNil;
NextToken; NextToken;
break; break;
@ -824,7 +783,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case '{': case '{':
NextToken; NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok && if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int) LOCAL_tokptr->TokInfo == '}') { (int)LOCAL_tokptr->TokInfo == '}') {
t = MkAtomTerm(AtomBraces); t = MkAtomTerm(AtomBraces);
NextToken; NextToken;
break; break;
@ -832,7 +791,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
t = ParseTerm(rd, 1200, FailBuff PASS_REGS); t = ParseTerm(rd, 1200, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t); t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -843,8 +802,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
} }
break; break;
case QuasiQuotes_tok: case QuasiQuotes_tok: {
{
qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo); qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo);
term_t pv, positions = rd->subtpos, to; term_t pv, positions = rd->subtpos, to;
Atom at; Atom at;
@ -853,31 +811,29 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
// from SWI, enter the list // from SWI, enter the list
/* prepare (if we are the first in term) */ /* prepare (if we are the first in term) */
if ( !rd->varnames ) if (!rd->varnames)
rd->varnames = PL_new_term_ref(); rd->varnames = PL_new_term_ref();
if ( !rd->qq ) if (!rd->qq) {
{ if ( rd->quasi_quotations ) if (rd->quasi_quotations) {
{ rd->qq = rd->quasi_quotations; rd->qq = rd->quasi_quotations;
} else } else {
{ if ( !(rd->qq = PL_new_term_ref()) ) if (!(rd->qq = PL_new_term_ref()))
return FALSE; return FALSE;
} }
// create positions term // create positions term
if ( positions ) if (positions) {
{ if ( !(pv = PL_new_term_refs(3)) || if (!(pv = PL_new_term_refs(3)) ||
!PL_unify_term(positions, !PL_unify_term(positions, PL_FUNCTOR,
PL_FUNCTOR, FUNCTOR_quasi_quotation_position5, FUNCTOR_quasi_quotation_position5, PL_INTPTR,
PL_INTPTR, qq->start.charno, qq->start.charno, PL_VARIABLE, PL_TERM,
PL_VARIABLE, pv + 0, // leave three open slots
PL_TERM, pv+0, // leave three open slots PL_TERM, pv + 1, PL_TERM, pv + 2))
PL_TERM, pv+1,
PL_TERM, pv+2) )
return FALSE; return FALSE;
} else } else
pv = 0; pv = 0;
/* push type */ /* push type */
if ( !(rd->qq_tail = PL_copy_term_ref(rd->qq)) ) if (!(rd->qq_tail = PL_copy_term_ref(rd->qq)))
return FALSE; return FALSE;
} }
@ -886,32 +842,35 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
FAIL; FAIL;
} }
if ( !( is_quasi_quotation_syntax(t, rd, &at)) ) if (!(is_quasi_quotation_syntax(t, rd, &at)))
FAIL; FAIL;
/* Arg 2: the content */ /* Arg 2: the content */
tn = Yap_MkNewApplTerm( SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4 ); tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn)+1; tnp = RepAppl(tn) + 1;
tnp[0] = MkAtomTerm(at); tnp[0] = MkAtomTerm(at);
if ( !get_quasi_quotation(Yap_InitSlot( ArgOfTerm(2, tn) PASS_REGS), &qq->text, qq->text+strlen((const char *)qq->text), rd) ) if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn) PASS_REGS),
&qq->text,
qq->text + strlen((const char *)qq->text), rd))
FAIL; FAIL;
if ( positions ) if (positions) {
{ intptr_t qqend = qq->end.charno; intptr_t qqend = qq->end.charno;
// set_range_position(positions, -1, qqend PASS_LD); // set_range_position(positions, -1, qqend PASS_LD);
if ( !PL_unify_term( Yap_InitSlot( ArgOfTerm(2, t) PASS_REGS), if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t) PASS_REGS), PL_FUNCTOR,
PL_FUNCTOR, FUNCTOR_minus2, FUNCTOR_minus2, PL_INTPTR,
PL_INTPTR, qq->mid.charno+2, /* end of | token */ qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend-2) ) /* end minus "|}" */ PL_INTPTR, qqend - 2)) /* end minus "|}" */
FAIL; FAIL;
} }
tnp[2] = Yap_GetFromSlot(rd->varnames PASS_REGS); /* Arg 3: the var dictionary */ tnp[2] =
Yap_GetFromSlot(rd->varnames PASS_REGS); /* Arg 3: the var dictionary */
/* Arg 4: the result */ /* Arg 4: the result */
t = ArgOfTerm(4, tn); t = ArgOfTerm(4, tn);
if ( !(to = PL_new_term_ref()) || if (!(to = PL_new_term_ref()) ||
!PL_unify_list(rd->qq_tail, to, rd->qq_tail) || !PL_unify_list(rd->qq_tail, to, rd->qq_tail) ||
!PL_unify(to, Yap_InitSlot(tn PASS_REGS)) ) !PL_unify(to, Yap_InitSlot(tn PASS_REGS)))
FAIL; FAIL;
} }
NextToken; NextToken;
@ -923,50 +882,44 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
/* main loop to parse infix and posfix operators starts here */ /* main loop to parse infix and posfix operators starts here */
while (TRUE) { while (TRUE) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
&& Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */ /* try parsing as infix operator */
Volatile int oldprio = curprio; Volatile int oldprio = curprio;
TRY3( TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 2);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; LOCAL_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} } NextToken;
NextToken;
{ {
Term args[2]; Term args[2];
args[0] = t; args[0] = t;
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS); args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 2, args); t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
}, },
curprio = opprio; curprio = opprio;
opinfo = save_opinfo; opinfo = save_opinfo; continue;, opinfo = save_opinfo;
continue; curprio = oldprio;)
,
opinfo = save_opinfo;
curprio = oldprio;
)
} }
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
&& opprio <= prio && oplprio >= curprio) { oplprio >= curprio) {
/* parse as posfix operator */ /* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 1); Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; LOCAL_ErrorMessage = "Heap Overflow";
FAIL; FAIL;
} }
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
@ -977,51 +930,53 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break; break;
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
prio >= 1000 && curprio <= 999) { curprio <= 999) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(rd, 1000, FailBuff PASS_REGS); args[1] = ParseTerm(rd, 1000, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args); t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = 1000; curprio = 1000;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS); args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args); t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP-4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; LOCAL_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
&& opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyBrackets, ')', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&& opprio <= prio && oplprio >= curprio) { &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' && } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS) IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&& opprio <= prio && oplprio >= curprio) { &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS); t = ParseArgs(rd, AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio; curprio = opprio;
@ -1034,19 +989,16 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
} }
#if DEBUG #if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) { if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(LOCAL_c_error_stream,'['); Yap_DebugPutc(LOCAL_c_error_stream, '[');
Yap_DebugPlWrite(t); Yap_DebugPlWrite(t);
Yap_DebugPutc(LOCAL_c_error_stream,']'); Yap_DebugPutc(LOCAL_c_error_stream, ']');
Yap_DebugPutc(LOCAL_c_error_stream,'\n'); Yap_DebugPutc(LOCAL_c_error_stream, '\n');
} }
#endif #endif
return t; return t;
} }
Term Yap_Parse(read_data *rd) {
Term
Yap_Parse(read_data *rd)
{
CACHE_REGS CACHE_REGS
Volatile Term t; Volatile Term t;
JMPBUFF FailBuff; JMPBUFF FailBuff;
@ -1061,4 +1013,3 @@ Yap_Parse(read_data *rd)
} }
//! @} //! @}

585
C/scanner.c
View File

File diff suppressed because it is too large Load Diff

409
C/write.c
View File

@ -60,7 +60,6 @@ typedef struct union_direct {
CELL *ptr; CELL *ptr;
} udirect; } udirect;
typedef struct rewind_term { typedef struct rewind_term {
struct rewind_term *parent; struct rewind_term *parent;
union { union {
@ -70,7 +69,7 @@ typedef struct rewind_term {
} rwts; } rwts;
typedef struct write_globs { typedef struct write_globs {
IOSTREAM*stream; IOSTREAM *stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms; int Keep_terms;
int Write_Loops; int Write_Loops;
@ -83,23 +82,22 @@ typedef struct write_globs {
#define lastw wglb->lw #define lastw wglb->lw
#define last_minus wglb->last_atom_minus #define last_minus wglb->last_atom_minus
static bool static bool callPortray(Term t, struct DB_TERM **old_EXp USES_REGS) {
callPortray(Term t, struct DB_TERM **old_EXp USES_REGS)
{
PredEntry *pe; PredEntry *pe;
Int b0 = LCL0-(CELL*)B; Int b0 = LCL0 - (CELL *)B;
EX = NULL; EX = NULL;
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE) ) ) && if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, &t PASS_REGS)) {
Yap_execute_pred(pe, &t PASS_REGS) ) { choiceptr B0 = (choiceptr)(LCL0 - b0);
choiceptr B0 = (choiceptr)(LCL0-b0); if (EX && !*old_EXp)
if (EX && !*old_EXp) *old_EXp = EX; *old_EXp = EX;
Yap_fail_all(B0 PASS_REGS); Yap_fail_all(B0 PASS_REGS);
return true; return true;
} }
if (EX && !*old_EXp) *old_EXp = EX; if (EX && !*old_EXp)
*old_EXp = EX;
return false; return false;
} }
@ -111,17 +109,16 @@ static int legalAtom(unsigned char *);
static int RightOpToProtect(Atom, int);*/ static int RightOpToProtect(Atom, int);*/
static wtype AtomIsSymbols(unsigned char *); static wtype AtomIsSymbols(unsigned char *);
static void putAtom(Atom, int, struct write_globs *); static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *);
#define wrputc(X,WF) Sputcode(X,WF) /* writes a character */ #define wrputc(X, WF) Sputcode(X, WF) /* writes a character */
/* /*
protect bracket from merging with previoous character. protect bracket from merging with previoous character.
avoid stuff like not (2,3) -> not(2,3) or avoid stuff like not (2,3) -> not(2,3) or
*/ */
static void static void wropen_bracket(struct write_globs *wglb, int protect) {
wropen_bracket(struct write_globs *wglb, int protect)
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (lastw != separator && protect) if (lastw != separator && protect)
@ -130,33 +127,27 @@ wropen_bracket(struct write_globs *wglb, int protect)
lastw = separator; lastw = separator;
} }
static void static void wrclose_bracket(struct write_globs *wglb, int protect) {
wrclose_bracket(struct write_globs *wglb, int protect)
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
wrputc(')', stream); wrputc(')', stream);
lastw = separator; lastw = separator;
} }
static int static int protect_open_number(struct write_globs *wglb, int lm,
protect_open_number(struct write_globs *wglb, int lm, int minus_required) int minus_required) {
{
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (lastw == symbol && lm && !minus_required) { if (lastw == symbol && lm && !minus_required) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
return TRUE; return TRUE;
} else if (lastw == alphanum || } else if (lastw == alphanum || (lastw == symbol && minus_required)) {
(lastw == symbol && minus_required)) {
wrputc(' ', stream); wrputc(' ', stream);
} }
return FALSE; return FALSE;
} }
static void static void protect_close_number(struct write_globs *wglb, int used_bracket) {
protect_close_number(struct write_globs *wglb, int used_bracket)
{
if (used_bracket) { if (used_bracket) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} else { } else {
@ -165,12 +156,12 @@ protect_close_number(struct write_globs *wglb, int used_bracket)
last_minus = FALSE; last_minus = FALSE;
} }
static void static void wrputn(Int n,
wrputn(Int n, struct write_globs *wglb) /* writes an integer */ struct write_globs *wglb) /* writes an integer */
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
char s[256], *s1=s; /* that should be enough for most integers */ char s[256], *s1 = s; /* that should be enough for most integers */
int has_minus = (n < 0); int has_minus = (n < 0);
int ob; int ob;
@ -187,9 +178,7 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#define wrputs(s, stream) Sfputs(s, stream) #define wrputs(s, stream) Sfputs(s, stream)
static void wrputws(wchar_t *s, wrf stream) /* writes a string */
static void
wrputws(wchar_t *s, wrf stream) /* writes a string */
{ {
while (*s) while (*s)
wrputc(*s++, stream); wrputc(*s++, stream);
@ -197,28 +186,27 @@ wrputws(wchar_t *s, wrf stream) /* writes a string */
#ifdef USE_GMP #ifdef USE_GMP
static char * static char *ensure_space(size_t sz) {
ensure_space(size_t sz) {
CACHE_REGS CACHE_REGS
char *s; char *s;
s = (char *) Yap_PreAllocCodeSpace(); s = (char *)Yap_PreAllocCodeSpace();
while (s+sz >= (char *)AuxSp) { while (s + sz >= (char *)AuxSp) {
#if USE_SYSTEM_MALLOC #if USE_SYSTEM_MALLOC
/* may require stack expansion */ /* may require stack expansion */
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) { if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
s = NULL; s = NULL;
break; break;
} }
s = (char *) Yap_PreAllocCodeSpace(); s = (char *)Yap_PreAllocCodeSpace();
#else #else
s = NULL; s = NULL;
#endif #endif
} }
if (!s) { if (!s) {
s = (char *)TR; s = (char *)TR;
while (s+sz >= LOCAL_TrailTop) { while (s + sz >= LOCAL_TrailTop) {
if (!Yap_growtrail(sz/sizeof(CELL), FALSE)) { if (!Yap_growtrail(sz / sizeof(CELL), FALSE)) {
s = NULL; s = NULL;
break; break;
} }
@ -227,41 +215,40 @@ ensure_space(size_t sz) {
} }
if (!s) { if (!s) {
s = (char *)HR; s = (char *)HR;
if (s+sz >= (char *)ASP) { if (s + sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz); Yap_Error(OUT_OF_STACK_ERROR, TermNil,
"not enough space to write bignum: it requires %d bytes", sz);
s = NULL; s = NULL;
} }
} }
return s; return s;
} }
static void static void write_mpint(MP_INT *big, struct write_globs *wglb) {
write_mpint(MP_INT *big, struct write_globs *wglb) {
char *s; char *s;
int has_minus = mpz_sgn(big); int has_minus = mpz_sgn(big);
int ob; int ob;
s = ensure_space(3+mpz_sizeinbase(big, 10)); s = ensure_space(3 + mpz_sizeinbase(big, 10));
ob = protect_open_number(wglb, last_minus, has_minus); ob = protect_open_number(wglb, last_minus, has_minus);
if (!s) { if (!s) {
s = mpz_get_str(NULL, 10, big); s = mpz_get_str(NULL, 10, big);
if (!s) if (!s)
return; return;
wrputs(s,wglb->stream); wrputs(s, wglb->stream);
free(s); free(s);
} else { } else {
mpz_get_str(s, 10, big); mpz_get_str(s, 10, big);
wrputs(s,wglb->stream); wrputs(s, wglb->stream);
} }
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
#endif #endif
/* writes a bignum */ /* writes a bignum */
static void static void writebig(Term t, int p, int depth, int rinfixarg,
writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt) {
{ CELL *pt = RepAppl(t) + 1;
CELL *pt = RepAppl(t)+1;
CELL big_tag = pt[0]; CELL big_tag = pt[0];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) { if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
@ -271,8 +258,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
lastw = separator; lastw = separator;
return; return;
#ifdef USE_GMP #ifdef USE_GMP
} else if (big_tag == BIG_INT) } else if (big_tag == BIG_INT) {
{
MP_INT *big = Yap_BigIntOfTerm(t); MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb); write_mpint(big, wglb);
return; return;
@ -287,16 +273,15 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
blob_info = big_tag - USER_BLOB_START; blob_info = big_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers && if (GLOBAL_OpaqueHandlers &&
(f= GLOBAL_OpaqueHandlers[blob_info].write_handler)) { (f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0); (f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0);
return; return;
} }
} }
wrputs("0",wglb->stream); wrputs("0", wglb->stream);
} }
static void static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
wrputf(Float f, struct write_globs *wglb) /* writes a float */
{ {
char s[256]; char s[256];
@ -304,7 +289,6 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int sgn; int sgn;
int ob; int ob;
#if HAVE_ISNAN || defined(__WIN32) #if HAVE_ISNAN || defined(__WIN32)
if (isnan(f)) { if (isnan(f)) {
wrputs("(nan)", stream); wrputs("(nan)", stream);
@ -330,11 +314,11 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int found_dot = FALSE; int found_dot = FALSE;
char *pt = s; char *pt = s;
int ch; int ch;
/* always use C locale for writing numbers */ /* always use C locale for writing numbers */
#if O_LOCALE #if O_LOCALE
const unsigned char *decimalpoint = (unsigned char*) const unsigned char *decimalpoint =
localeconv()->decimal_point; (unsigned char *)localeconv()->decimal_point;
size_t l1 = strlen((const char *)decimalpoint+1); size_t l1 = strlen((const char *)decimalpoint + 1);
#else #else
const unsigned char decimalpoint[2] = "."; const unsigned char decimalpoint[2] = ".";
size_t l1 = 0; size_t l1 = 0;
@ -354,7 +338,8 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
} }
while ((ch = *pt) != '\0') { while ((ch = *pt) != '\0') {
// skip locale // skip locale
if (ch == decimalpoint[0] && !strncmp(pt+1, (char *)decimalpoint+1, l1)) { if (ch == decimalpoint[0] &&
!strncmp(pt + 1, (char *)decimalpoint + 1, l1)) {
found_dot = TRUE; found_dot = TRUE;
pt += l1; pt += l1;
ch = '.'; ch = '.';
@ -362,7 +347,7 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
if (ch == 'e' || ch == 'E') { if (ch == 'e' || ch == 'E') {
if (!found_dot) { if (!found_dot) {
found_dot = TRUE; found_dot = TRUE;
wrputs(".0" , stream); wrputs(".0", stream);
} }
found_dot = TRUE; found_dot = TRUE;
} }
@ -381,15 +366,14 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
} }
/* use SWI's format_float */ /* use SWI's format_float */
buf = format_float(f, s); buf = format_float(f, s);
if (!buf) return; if (!buf)
return;
wrputs(buf, stream); wrputs(buf, stream);
#endif #endif
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
int int Yap_FormatFloat(Float f, const char *s, size_t sz) {
Yap_FormatFloat( Float f, const char *s, size_t sz )
{
struct write_globs wglb; struct write_globs wglb;
char *ws = (char *)s; char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w"); IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
@ -401,28 +385,25 @@ Yap_FormatFloat( Float f, const char *s, size_t sz )
return TRUE; return TRUE;
} }
/* writes a data base reference */ /* writes a data base reference */
static void static void wrputref(CODEADDR ref, int Quote_illegal,
wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb) struct write_globs *wglb) {
{
char s[256]; char s[256];
wrf stream = wglb->stream; wrf stream = wglb->stream;
putAtom(AtomDBref, Quote_illegal, wglb); putAtom(AtomDBref, Quote_illegal, wglb);
#if defined(__linux__) || defined(__APPLE__) #if defined(__linux__) || defined(__APPLE__)
sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount); sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#else #else
sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount); sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#endif #endif
wrputs(s, stream); wrputs(s, stream);
lastw = alphanum; lastw = alphanum;
} }
/* writes a blob (default) */ /* writes a blob (default) */
static int static int wrputblob(AtomEntry *ref, int Quote_illegal,
wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb) struct write_globs *wglb) {
{
char s[256]; char s[256];
wrf stream = wglb->stream; wrf stream = wglb->stream;
PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t; PL_blob_t *type = RepBlobProp(ref->PropsOfAE)->blob_t;
@ -443,8 +424,7 @@ wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
return 1; return 1;
} }
static int static int legalAtom(unsigned char *s) /* Is this a legal atom ? */
legalAtom(unsigned char *s) /* Is this a legal atom ? */
{ {
wchar_t ch = *s; wchar_t ch = *s;
@ -461,7 +441,8 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
return FALSE; return FALSE;
} else { } else {
if (ch == '/') { if (ch == '/') {
if (s[1] == '*') return FALSE; if (s[1] == '*')
return FALSE;
} }
while (ch) { while (ch) {
if (Yap_chtype[ch] != SY) { if (Yap_chtype[ch] != SY) {
@ -483,7 +464,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
{ {
int ch; int ch;
if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0') if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0')
return(separator); return (separator);
while ((ch = *s++) != '\0') { while ((ch = *s++) != '\0') {
if (Yap_chtype[ch] != SY) if (Yap_chtype[ch] != SY)
return alphanum; return alphanum;
@ -491,9 +472,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
return symbol; return symbol;
} }
static void static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
write_quoted(wchar_t ch, wchar_t quote, wrf stream)
{
CACHE_REGS CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) { if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream); wrputc(ch, stream);
@ -501,7 +480,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\'', stream); /* be careful about quotes */ wrputc('\'', stream); /* be careful about quotes */
return; return;
} }
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\') { if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' && ch != '`') {
wrputc(ch, stream); wrputc(ch, stream);
} else { } else {
switch (ch) { switch (ch) {
@ -519,6 +498,11 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\\', stream); wrputc('\\', stream);
wrputc(ch, stream); wrputc(ch, stream);
break; break;
case '`':
if (ch == quote)
wrputc('`', stream);
wrputc(ch, stream);
break;
case 7: case 7:
wrputc('\\', stream); wrputc('\\', stream);
wrputc('a', stream); wrputc('a', stream);
@ -552,7 +536,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('f', stream); wrputc('f', stream);
break; break;
default: default:
if ( ch <= 0xff ) { if (ch <= 0xff) {
char esc[8]; char esc[8];
/* last backslash in ISO mode */ /* last backslash in ISO mode */
@ -563,42 +547,38 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
} }
} }
static void static void write_string(const char *s,
write_string(const char *s, struct write_globs *wglb) /* writes an integer */ struct write_globs *wglb) /* writes an integer */
{ {
IOSTREAM *stream = wglb->stream; IOSTREAM *stream = wglb->stream;
int chr; int chr, qt;
char *ptr = (char *)s; char *ptr = (char *)s;
if (wglb->Write_strings) if (wglb->Write_strings)
wrputc('`', stream); qt = '`';
else else
wrputc('"', stream); qt = '"';
wrputc(qt, stream);
do { do {
ptr = utf8_get_char(ptr, &chr); ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break; if (chr == '\0')
write_quoted(chr, '"', stream); break;
write_quoted(chr, qt, stream);
} while (TRUE); } while (TRUE);
if (wglb->Write_strings) wrputc(qt, stream);
wrputc('`', stream);
else
wrputc('"', stream);
} }
/* writes an atom */ /* writes an atom */
static void static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
{
unsigned char *s; unsigned char *s;
wtype atom_or_symbol; wtype atom_or_symbol;
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (IsBlob(atom)) { if (IsBlob(atom)) {
wrputblob(RepAtom(atom),Quote_illegal,wglb); wrputblob(RepAtom(atom), Quote_illegal, wglb);
return; return;
} }
if (IsWideAtom(atom) ) { if (IsWideAtom(atom)) {
wchar_t *ws = RepAtom(atom)->WStrOfAE; wchar_t *ws = RepAtom(atom)->WStrOfAE;
if (Quote_illegal) { if (Quote_illegal) {
@ -614,11 +594,12 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
return; return;
} }
s = (unsigned char *)RepAtom(atom)->StrOfAE; s = (unsigned char *)RepAtom(atom)->StrOfAE;
/* #define CRYPT_FOR_STEVE 1*/ /* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE #ifdef CRYPT_FOR_STEVE
if (Yap_GetValue(AtomCryptAtoms) != TermNil && Yap_GetAProp(atom, OpProperty) == NIL) { if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
Yap_GetAProp(atom, OpProperty) == NIL) {
char s[16]; char s[16];
sprintf(s,"x%x", (CELL)s); sprintf(s, "x%x", (CELL)s);
wrputs(s, stream); wrputs(s, stream);
return; return;
} }
@ -641,17 +622,14 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
} }
} }
void void Yap_WriteAtom(IOSTREAM *s, Atom atom) {
Yap_WriteAtom(IOSTREAM *s, Atom atom)
{
struct write_globs wglb; struct write_globs wglb;
wglb.stream = s; wglb.stream = s;
wglb.Quote_illegal = FALSE; wglb.Quote_illegal = FALSE;
putAtom(atom, 0, &wglb); putAtom(atom, 0, &wglb);
} }
static int static int IsCodesTerm(Term string) /* checks whether this is a string */
IsCodesTerm(Term string) /* checks whether this is a string */
{ {
if (IsVarTerm(string)) if (IsVarTerm(string))
return FALSE; return FALSE;
@ -659,22 +637,25 @@ IsCodesTerm(Term string) /* checks whether this is a string */
Term hd; Term hd;
int ch; int ch;
if (!IsPairTerm(string)) return(FALSE); if (!IsPairTerm(string))
return (FALSE);
hd = HeadOfTerm(string); hd = HeadOfTerm(string);
if (IsVarTerm(hd)) return(FALSE); if (IsVarTerm(hd))
if (!IsIntTerm(hd)) return(FALSE); return (FALSE);
if (!IsIntTerm(hd))
return (FALSE);
ch = IntOfTerm(HeadOfTerm(string)); ch = IntOfTerm(HeadOfTerm(string));
if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t') if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t')
return(FALSE); return (FALSE);
string = TailOfTerm(string); string = TailOfTerm(string);
if (IsVarTerm(string)) return(FALSE); if (IsVarTerm(string))
return (FALSE);
} while (string != TermNil); } while (string != TermNil);
return(TRUE); return (TRUE);
} }
/* writes a string */ /* writes a string */
static void static void putString(Term string, struct write_globs *wglb)
putString(Term string, struct write_globs *wglb)
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -689,8 +670,7 @@ putString(Term string, struct write_globs *wglb)
} }
/* writes a string */ /* writes a string */
static void static void putUnquotedString(Term string, struct write_globs *wglb)
putUnquotedString(Term string, struct write_globs *wglb)
{ {
wrf stream = wglb->stream; wrf stream = wglb->stream;
@ -702,10 +682,8 @@ putUnquotedString(Term string, struct write_globs *wglb)
lastw = alphanum; lastw = alphanum;
} }
static Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
static Term struct write_globs *wglb) {
from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
{
CACHE_REGS CACHE_REGS
Term t; Term t;
CELL *ptr = ptr0; CELL *ptr = ptr0;
@ -729,7 +707,7 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
} else { } else {
rwt->u_sd.d.old = t; rwt->u_sd.d.old = t;
rwt->u_sd.d.ptr = ptr0; rwt->u_sd.d.ptr = ptr0;
if ( !IsVarTerm(t) && !IsAtomicTerm(t)) { if (!IsVarTerm(t) && !IsAtomicTerm(t)) {
struct rewind_term *x = rwt->parent; struct rewind_term *x = rwt->parent;
while (x) { while (x) {
@ -742,14 +720,13 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
return t; return t;
} }
static CELL * static CELL *restore_from_write(struct rewind_term *rwt,
restore_from_write(struct rewind_term *rwt, struct write_globs *wglb) struct write_globs *wglb) {
{
CACHE_REGS CACHE_REGS
CELL *ptr; CELL *ptr;
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
ptr = (CELL*)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS); ptr = (CELL *)Yap_GetPtrFromSlot(rwt->u_sd.s.ptr PASS_REGS);
if (!Yap_RecoverSlots(2, rwt->u_sd.s.ptr PASS_REGS)) if (!Yap_RecoverSlots(2, rwt->u_sd.s.ptr PASS_REGS))
return NULL; return NULL;
} else { } else {
@ -760,9 +737,8 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
} }
/* writes an unbound variable */ /* writes an unbound variable */
static void static void write_var(CELL *t, struct write_globs *wglb,
write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) struct rewind_term *rwt) {
{
CACHE_REGS CACHE_REGS
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
@ -771,7 +747,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
/* make sure we don't get no creepy spaces where they shouldn't be */ /* make sure we don't get no creepy spaces where they shouldn't be */
lastw = separator; lastw = separator;
if (IsAttVar(t)) { if (IsAttVar(t)) {
Int vcount = (t-H0); Int vcount = (t - H0);
if (wglb->Portray_delays) { if (wglb->Portray_delays) {
exts ext = ExtFromCell(t); exts ext = ExtFromCell(t);
struct rewind_term nrwt; struct rewind_term nrwt;
@ -783,13 +759,13 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
attvar_record *attv = RepAttVar(t); attvar_record *attv = RepAttVar(t);
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */ CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
wrputs("$AT(",wglb->stream); wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt); write_var(t, wglb, rwt);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
l = restore_from_write(&nrwt, wglb); l = restore_from_write(&nrwt, wglb);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
l ++; l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -798,15 +774,14 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
return; return;
} }
wrputc('D', wglb->stream); wrputc('D', wglb->stream);
wrputn(vcount,wglb); wrputn(vcount, wglb);
} else { } else {
wrputn(((Int) (t- H0)),wglb); wrputn(((Int)(t - H0)), wglb);
} }
} }
static Term static Term check_infinite_loop(Term t, struct rewind_term *x,
check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb) struct write_globs *wglb) {
{
CACHE_REGS CACHE_REGS
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
while (x) { while (x) {
@ -824,9 +799,8 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
return t; return t;
} }
static void static void write_list(Term t, int direction, int depth,
write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt) {
{
Term ti; Term ti;
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
@ -836,7 +810,8 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
int ndirection; int ndirection;
int do_jump; int do_jump;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth+1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb)); t = AbsPair(restore_from_write(&nrwt, wglb));
ti = TailOfTerm(t); ti = TailOfTerm(t);
if (IsVarTerm(ti)) if (IsVarTerm(ti))
@ -844,7 +819,7 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
if (!IsPairTerm(ti) || if (!IsPairTerm(ti) ||
!IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb)))) !IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb))))
break; break;
ndirection = RepPair(ti)-RepPair(t); ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */ /* make sure we're not trapped in loops */
if (ndirection > 0) { if (ndirection > 0) {
do_jump = (direction <= 0); do_jump = (direction <= 0);
@ -870,7 +845,7 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
t = ti; t = ti;
} }
if (IsPairTerm(ti)) { if (IsPairTerm(ti)) {
Term nt = from_pointer(RepPair(t)+1, &nrwt, wglb); Term nt = from_pointer(RepPair(t) + 1, &nrwt, wglb);
/* we found an infinite loop */ /* we found an infinite loop */
if (IsAtomTerm(nt)) { if (IsAtomTerm(nt)) {
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
@ -884,14 +859,14 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
} else if (ti != MkAtomTerm(AtomNil)) { } else if (ti != MkAtomTerm(AtomNil)) {
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
} }
} }
static void writeTerm(Term t, int p, int depth, int rinfixarg,
static void struct write_globs *wglb, struct rewind_term *rwt)
writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt)
/* term to write */ /* term to write */
/* context priority */ /* context priority */
@ -912,24 +887,27 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
write_var((CELL *)t, wglb, &nrwt); write_var((CELL *)t, wglb, &nrwt);
} else if (IsIntTerm(t)) { } else if (IsIntTerm(t)) {
wrputn((Int) IntOfTerm(t),wglb); wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb); putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
if (wglb->Ignore_ops) { if (wglb->Ignore_ops) {
wrputs("'.'(",wglb->stream); wrputs("'.'(", wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
wglb, &nrwt);
t = AbsPair(restore_from_write(&nrwt, wglb)); t = AbsPair(restore_from_write(&nrwt, wglb));
wrputs(",",wglb->stream); wrputs(",", wglb->stream);
writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
return; return;
} }
if (wglb->Use_portray) if (wglb->Use_portray)
if (callPortray(t, &EX PASS_REGS) ) return; if (callPortray(t, &EX PASS_REGS))
return;
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) { if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsCodesTerm(t)) {
putString(t, wglb); putString(t, wglb);
} else { } else {
@ -947,21 +925,21 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
int op, lp, rp; int op, lp, rp;
if (IsExtensionFunctor(functor)) { if (IsExtensionFunctor(functor)) {
switch((CELL)functor) { switch ((CELL)functor) {
case (CELL)FunctorDouble: case (CELL) FunctorDouble:
wrputf(FloatOfTerm(t),wglb); wrputf(FloatOfTerm(t), wglb);
return; return;
case (CELL)FunctorString: case (CELL) FunctorString:
write_string(StringOfTerm(t),wglb); write_string(StringOfTerm(t), wglb);
return; return;
case (CELL)FunctorAttVar: case (CELL) FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt); write_var(RepAppl(t) + 1, wglb, &nrwt);
return; return;
case (CELL)FunctorDBRef: case (CELL) FunctorDBRef:
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb); wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb);
return; return;
case (CELL)FunctorLongInt: case (CELL) FunctorLongInt:
wrputn(LongIntOfTerm(t),wglb); wrputn(LongIntOfTerm(t), wglb);
return; return;
/* case (CELL)FunctorBigInt: */ /* case (CELL)FunctorBigInt: */
default: default:
@ -988,8 +966,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
*p++; *p++;
lastw = separator; lastw = separator;
/* cannot use the term directly with the SBA */ /* cannot use the term directly with the SBA */
writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb,
p = restore_from_write(&nrwt, wglb)+1; &nrwt);
p = restore_from_write(&nrwt, wglb) + 1;
if (*p) if (*p)
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
argno++; argno++;
@ -999,15 +978,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} }
#endif #endif
if (wglb->Use_portray) { if (wglb->Use_portray) {
if (callPortray(t, &EX PASS_REGS) ) return; if (callPortray(t, &EX PASS_REGS))
return;
} }
if (!wglb->Ignore_ops && if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Arity == 1 &&
Yap_IsPrefixOp(atom, &op, &rp)
) {
Term tright = ArgOfTerm(1, t); Term tright = ArgOfTerm(1, t);
int bracket_right = int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
!IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
if (op > p) { if (op > p) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
@ -1019,7 +995,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} else if (atom == AtomMinus) { } else if (atom == AtomMinus) {
last_minus = TRUE; last_minus = TRUE;
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), rp, depth + 1, TRUE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1028,7 +1005,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && } else if (!wglb->Ignore_ops &&
( Arity == 1 || ((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) && Yap_IsListTerm(ArgOfTerm(1, t)))) && (Arity == 1 ||
((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets ||
atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp)) { Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
@ -1042,9 +1022,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
offset = 1; offset = 1;
} }
bracket_left = bracket_left =
!IsVarTerm(tleft) && !IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
IsAtomTerm(tleft) &&
Yap_IsOp(AtomOfTerm(tleft));
if (op > p) { if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */ /* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
@ -1052,12 +1030,13 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) { if (bracket_left) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+offset, &nrwt, wglb), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + offset, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_left) { if (bracket_left) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
if (Arity > 1 ) { if (Arity > 1) {
if (atom == AtomEmptyBrackets) { if (atom == AtomEmptyBrackets) {
wrputc('(', wglb->stream); wrputc('(', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) { } else if (atom == AtomEmptySquareBrackets) {
@ -1081,16 +1060,13 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (op > p) { if (op > p) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && } else if (!wglb->Ignore_ops && Arity == 2 &&
Arity == 2 && Yap_IsInfixOp(atom, &op, &lp, Yap_IsInfixOp(atom, &op, &lp, &rp)) {
&rp) ) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t); Term tright = ArgOfTerm(2, t);
int bracket_left = int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && !IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
Yap_IsOp(AtomOfTerm(tleft)); int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
int bracket_right =
!IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
if (op > p) { if (op > p) {
@ -1101,16 +1077,17 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) { if (bracket_left) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), lp, depth + 1,
t = AbsAppl(restore_from_write(&nrwt, wglb)-1); rinfixarg, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - 1);
if (bracket_left) { if (bracket_left) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
/* avoid quoting commas and bars */ /* avoid quoting commas and bars */
if (!strcmp(RepAtom(atom)->StrOfAE,",")) { if (!strcmp(RepAtom(atom)->StrOfAE, ",")) {
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
lastw = separator; lastw = separator;
} else if (!strcmp(RepAtom(atom)->StrOfAE,"|")) { } else if (!strcmp(RepAtom(atom)->StrOfAE, "|")) {
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
lastw = separator; lastw = separator;
} else } else
@ -1118,7 +1095,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_right) { if (bracket_right) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(from_pointer(RepAppl(t)+2, &nrwt, wglb), rp, depth + 1, TRUE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 2, &nrwt, wglb), rp, depth + 1, TRUE,
wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -1131,7 +1109,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) { if (!IsVarTerm(ti) &&
(IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) { if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti); Int k = IntOfTerm(ti);
if (k == -1) { if (k == -1) {
@ -1143,7 +1122,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (k >= 26) { if (k >= 26) {
/* make sure we don't get confused about our context */ /* make sure we don't get confused about our context */
lastw = separator; lastw = separator;
wrputn( k / 26 ,wglb); wrputn(k / 26, wglb);
} else } else
lastw = alphanum; lastw = alphanum;
} }
@ -1153,16 +1132,18 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
putUnquotedString(ti, wglb); putUnquotedString(ti, wglb);
} }
} else { } else {
wrputs("'$VAR'(",wglb->stream); wrputs("'$VAR'(", wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && functor == FunctorBraces) { } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), 1200, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 1200, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
@ -1174,8 +1155,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputs("...", wglb->stream); wrputs("...", wglb->stream);
break; break;
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
t = AbsAppl(restore_from_write(&nrwt, wglb)-op); FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
if (op != Arity) { if (op != Arity) {
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
lastw = separator; lastw = separator;
@ -1194,7 +1176,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputc('.', wglb->stream); wrputc('.', wglb->stream);
break; break;
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
if (op != Arity) { if (op != Arity) {
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
@ -1206,11 +1189,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} }
} }
void void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority) /* term to be written */
/* term to be written */ /* consumer */
/* consumer */ /* write options */
/* write options */
{ {
struct write_globs wglb; struct write_globs wglb;
struct rewind_term rwt; struct rewind_term rwt;
@ -1230,7 +1212,7 @@ Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
wglb.MaxArgs = max_depth; wglb.MaxArgs = max_depth;
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
wglb.Keep_terms = (flags & (Use_portray_f|To_heap_f)); wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f));
/* initialise wglb */ /* initialise wglb */
rwt.parent = NULL; rwt.parent = NULL;
wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Ignore_ops = flags & Ignore_ops_f;
@ -1239,4 +1221,3 @@ Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt); writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
restore_from_write(&rwt, &wglb); restore_from_write(&rwt, &wglb);
} }

11
CMakeLists.txt
View File

@ -509,13 +509,18 @@ ADD_SUBDIRECTORY(swi/library)
# ADD_SUBDIRECTORY(os) # ADD_SUBDIRECTORY(os)
# ADD_SUBDIRECTORY(packages) # ADD_SUBDIRECTORY(packages)
if (BUILD_JIT) macro_optional_find_package (LLVM ON)
macro_log_feature (LLVM_FOUND "LLVM JIT generator"
"The LLVM Compiler Infrastructure" "http://www.llvm.org")
if (LLVM_FOUND)
add_definitions (-DYAP_JIT=1) add_definitions (-DYAP_JIT=1)
INCLUDE_DIRECTORIES(JIT JIT/HPP) INCLUDE_DIRECTORIES(JIT JIT/HPP)
macro_optional_add_subdirectory(JIT ON) macro_optional_add_subdirectory(JIT)
endif() endif()
macro_optional_add_subdirectory(library/mpi) macro_optional_add_subdirectory(library/mpi)
macro_optional_add_subdirectory(library/lammpi) macro_optional_add_subdirectory(library/lammpi)
macro_optional_add_subdirectory (packages/gecode) macro_optional_add_subdirectory (packages/gecode)

2
H/ScannerTypes.h
View File

@ -4,6 +4,7 @@ typedef enum TokenKinds {
Var_tok, Var_tok,
String_tok, String_tok,
WString_tok, WString_tok,
StringTerm_tok,
Ponctuation_tok, Ponctuation_tok,
Error_tok, Error_tok,
QuasiQuotes_tok, QuasiQuotes_tok,
@ -29,4 +30,3 @@ typedef struct VARSTRUCT {
struct VARSTRUCT *VarLeft, *VarRight; struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1]; char VarRep[1];
} VarEntry; } VarEntry;

2
H/amijit.h
View File

@ -336,7 +336,7 @@ typedef struct environment {
#if YAP_JIT #if YAP_JIT
/* Enumeration for types of basic blocks -- used on trace construction */ /* Enumeration for types of basic blocks -- used on trace construction */
typedef enum { typedef enum block_try {
NONE, // untyped NONE, // untyped
SIMPLE_ENTRY, // first basic block of any yaam opcode SIMPLE_ENTRY, // first basic block of any yaam opcode
SIMPLE, // any other basic block of any yaam opcode SIMPLE, // any other basic block of any yaam opcode

32
H/yapio.h
View File

@ -149,36 +149,6 @@ extern YP_FILE yp_iob[YP_MAX_FILES];
typedef YP_FILE *YP_File; typedef YP_FILE *YP_File;
/* ricardo
typedef enum TokenKinds {
Name_tok,
Number_tok,
Var_tok,
String_tok,
WString_tok,
Ponctuation_tok,
Error_tok,
eot_tok
} tkinds;
typedef struct TOKEN {
enum TokenKinds Tok;
Term TokInfo;
int TokPos;
struct TOKEN *TokNext;
} TokEntry;
#define Ord(X) ((enum TokenKinds) (X))
#define NextToken GNextToken( PASS_REGS1 )
typedef struct VARSTRUCT {
Term VarAdr;
CELL hv;
struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1];
} VarEntry;
*/
#ifndef _PL_WRITE_ #ifndef _PL_WRITE_
@ -351,5 +321,3 @@ WideHashFunction(wchar_t *CHP)
#define QUIET_ON_PARSER_ERROR 1 #define QUIET_ON_PARSER_ERROR 1
#define CONTINUE_ON_PARSER_ERROR 2 #define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3 #define EXCEPTION_ON_PARSER_ERROR 3

5
JIT/CMakeLists.txt
View File

@ -16,11 +16,6 @@ set(LIBJIT_SOURCES
JIT_Init.cpp JIT_Init.cpp
) )
macro_optional_find_package (LLVM ON)
macro_log_feature (LLVM_FOUND "LLVM JIT generator"
"The LLVM Compiler Infrastructure" "http://www.llvm.org")
# The following variables are defined: # The following variables are defined:
# LLVM_FOUND - true if LLVM was found # LLVM_FOUND - true if LLVM was found
# LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers. # LLVM_CXXFLAGS - C++ compiler flags for files that include LLVM headers.

3
os/pl-prologflag.c
View File

@ -1194,7 +1194,7 @@ initPrologFlags(void)
setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0); setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0);
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE); setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION); setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING); setPrologFlag("backquoted_string", FT_BOOL, TRUE, PLFLAG_BACKQUOTED_STRING);
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES); setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES);
#endif #endif
@ -1329,4 +1329,3 @@ BeginPredDefs(prologflag)
EndPredDefs EndPredDefs
//! @} //! @}

18
os/pl-utf8.c
View File

@ -252,3 +252,21 @@ utf8_strprefix(const char *s1, const char *s2)
return 0; return 0;
} }
char *
utf8_wcscpy(char *sf, const wchar_t *s0)
{
char *sf0 = sf;
while(1)
{ int chr1;
chr1 = * s0++;
if (chr1 == '\0') {
*sf++ = '\0';
return sf0;
}
sf = utf8_put_char(sf, chr1);
}
return NULL;
}

4
os/pl-utf8.h
View File

@ -26,6 +26,8 @@
#ifndef UTF8_H_INCLUDED #ifndef UTF8_H_INCLUDED
#define UTF8_H_INCLUDED #define UTF8_H_INCLUDED
#include <wchar.h>
#define PL_MB_LEN_MAX 16 #define PL_MB_LEN_MAX 16
#define UTF8_MALFORMED_REPLACEMENT 0xfffd #define UTF8_MALFORMED_REPLACEMENT 0xfffd
@ -66,6 +68,8 @@ extern size_t utf8_strlen1(const char *s);
extern const char * utf8_skip(const char *s, int n); extern const char * utf8_skip(const char *s, int n);
extern int utf8_strncmp(const char *s1, const char *s2, size_t n); extern int utf8_strncmp(const char *s1, const char *s2, size_t n);
extern int utf8_strprefix(const char *s1, const char *s2); extern int utf8_strprefix(const char *s1, const char *s2);
/// copy a wide string to an UTF-8 version.
extern char *utf8_wcscpy(char *sf, const wchar_t *s0);
typedef enum { typedef enum {
S_ASCII, S_ASCII,

4
os/pl-write.c
View File

@ -711,7 +711,7 @@ pl_write_canonical2(term_t stream, term_t term)
rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 && rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
do_write2(stream, term, do_write2(stream, term,
PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS) PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS|PLFLAG_BACKQUOTED_STRING)
); );
END_NUMBERVARS(TRUE); END_NUMBERVARS(TRUE);
@ -796,5 +796,3 @@ pl_writeln(term_t term)
BeginPredDefs(write) BeginPredDefs(write)
EndPredDefs EndPredDefs

2
packages/clib

@ -1 +1 @@
Subproject commit 849232fea0f549f6704b16afa1c986e0d50ec177 Subproject commit 8257467ff9a7bb901d1688e6a75ad072e0246aba

4859
packages/gecode/gecode.yap
View File

File diff suppressed because it is too large Load Diff

2
packages/odbc

@ -1 +1 @@
Subproject commit d0d1ee4d58373cc611676103e0a50a3ae451a023 Subproject commit 9972458293415b2d72276bd67875767bfeed00df

4
packages/python/python.c
View File

@ -1,4 +1,7 @@
#ifdef _XOPEN_SOURCE
#undef _XOPEN_SOURCE // python does its own thing
#endif
#include <Python.h> #include <Python.h>
#include <SWI-Stream.h> #include <SWI-Stream.h>
#include <SWI-Prolog.h> #include <SWI-Prolog.h>
@ -1677,4 +1680,3 @@ install_python(void)
PL_register_foreign("python_run_command", 1, python_run_command, 0); PL_register_foreign("python_run_command", 1, python_run_command, 0);
PL_register_foreign("python_main_module", 1, python_main_module, 0); PL_register_foreign("python_main_module", 1, python_main_module, 0);
} }

2
packages/raptor

@ -1 +1 @@
Subproject commit 34d9f645721645aac9f4f40c815fe4fe2c6511e6 Subproject commit 36f99e3c3c978fef25f899dc4fab1ffee334d73c

32
packages/swig/android/JavaYap.java
View File

@ -1,5 +1,30 @@
package pt.up.fc.dcc.yap; package pt.up.fc.dcc.yap;
/**** using sqlite
For example,the following:
import android.database.sqlite.SQLiteDatabase;
should be replaced with:
import org.sqlite.database.sqlite.SQLiteDatabase;
As well as replacing all uses of the classes in the android.database.sqlite.* namespace, the application must also be sure to use the following two:
org.sqlite.database.SQLException
org.sqlite.database.DatabaseErrorHandler
instead of:
android.database.SQLException
android.database.DatabaseErrorHandler
Aside from namespace changes, there are other differences from the stock Android interface that applications need to be aware of:
The SQLiteStatement.simpleQueryForBlobFileDescriptor() API is not available. The collation sequence "UNICODE" is not available. The collation sequence "LOCALIZED", which normally changes with the system's current locale, is always equivalent to SQLite's built in collation BINARY.
****/
import android.app.Activity; import android.app.Activity;
import android.os.Bundle; import android.os.Bundle;
import android.view.View; import android.view.View;
@ -18,6 +43,7 @@ import org.sqlite.database.sqlite.SQLiteStatement;
import org.sqlite.database.sqlite.SQLiteDatabaseCorruptException; import org.sqlite.database.sqlite.SQLiteDatabaseCorruptException;
import org.sqlite.database.sqlite.SQLiteOpenHelper; import org.sqlite.database.sqlite.SQLiteOpenHelper;
import org.sqlite.database.SQLException;
import org.sqlite.database.DatabaseErrorHandler; import org.sqlite.database.DatabaseErrorHandler;
class DoNotDeleteErrorHandler implements DatabaseErrorHandler { class DoNotDeleteErrorHandler implements DatabaseErrorHandler {
private static final String TAG = "DoNotDeleteErrorHandler"; private static final String TAG = "DoNotDeleteErrorHandler";
@ -49,7 +75,7 @@ public class JavaYap extends Activity
// text.setText(""); // text.setText("");
if (vs0.nil()) { if (vs0.nil()) {
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q0=\n");
} }
if (q.next()) { if (q.next()) {
outputText.append( "yes\n" ); outputText.append( "yes\n" );
@ -59,12 +85,12 @@ public class JavaYap extends Activity
} else { } else {
int i=1; int i=1;
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q1= "+vs0.text()+"\n");
} }
while (rc = q.next()) { while (rc = q.next()) {
if (BuildConfig.DEBUG) { if (BuildConfig.DEBUG) {
Log.i(TAG, "q="); Log.i(TAG, "q= "+vs0.text()+"\n");
} }
YAPListTerm vs = vs0; YAPListTerm vs = vs0;