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;
case Var_tok:
case String_tok:
case WString_tok:
case StringTerm_tok:
if (IsOldTrail(tks->TokInfo))
tks->TokInfo = TrailAdjust(tks->TokInfo);
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);
}
break;
case StringTerm_tok:
{
Term t0 = MkStringTerm((const char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok:
{
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 "Yatom.h"
#include "YapHeap.h"
@ -157,69 +156,65 @@ dot with single quotes.
#define Volatile
#endif
/* weak backtraking mechanism based on long_jump */
typedef struct jmp_buff_struct {
sigjmp_buf JmpBuff;
} JMPBUFF;
typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken( CACHE_TYPE1 );
static void checkfor(wchar_t, JMPBUFF * CACHE_TYPE);
static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE);
static Term ParseArgs(read_data *, Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList(read_data *, JMPBUFF * CACHE_TYPE);
static Term ParseTerm(read_data *, int, JMPBUFF * CACHE_TYPE);
static Term ParseList(read_data *, JMPBUFF *CACHE_TYPE);
static Term ParseTerm(read_data *, int, JMPBUFF *CACHE_TYPE);
#define TRY(S,P) \
{ Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=LOCAL_tokptr; \
Volatile CELL *saveH=HR; \
Volatile int savecurprio=curprio; \
saveenv=FailBuff; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \
#define TRY(S, P) \
{ \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \
Volatile int savecurprio = curprio; \
saveenv = FailBuff; \
if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
FailBuff = saveenv; \
P; \
} \
else { FailBuff=saveenv; \
HR=saveH; \
} else { \
FailBuff = saveenv; \
HR = saveH; \
curprio = savecurprio; \
LOCAL_tokptr=saveT; \
LOCAL_tokptr = saveT; \
} \
}
#define TRY3(S,P,F) \
{ Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT=LOCAL_tokptr; \
Volatile CELL *saveH=HR; \
saveenv=FailBuff; \
if(!sigsetjmp(newenv.JmpBuff, 0)) { \
#define TRY3(S, P, F) \
{ \
Volatile JMPBUFF *saveenv, newenv; \
Volatile TokEntry *saveT = LOCAL_tokptr; \
Volatile CELL *saveH = HR; \
saveenv = FailBuff; \
if (!sigsetjmp(newenv.JmpBuff, 0)) { \
FailBuff = &newenv; \
S; \
FailBuff=saveenv; \
FailBuff = saveenv; \
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
VarEntry *p;
#if DEBUG
if (GLOBAL_Option[4])
fprintf(stderr,"[LookupVar %s]", var);
fprintf(stderr, "[LookupVar %s]", var);
#endif
if (var[0] != '_' || var[1] != '\0') {
VarEntry **op = &LOCAL_VarTable;
@ -234,7 +229,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
Int scmp;
if ((scmp = strcmp(var, p->VarRep)) == 0) {
p->refs++;
return(p);
return (p);
} else if (scmp < 0) {
op = &(p->VarLeft);
p = p->VarLeft;
@ -250,7 +245,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
p = p->VarRight;
}
}
p = (VarEntry *) Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
*op = p;
p->VarLeft = p->VarRight = NULL;
p->hv = hv;
@ -258,7 +253,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
strcpy(p->VarRep, var);
} else {
/* anon var */
p = (VarEntry *) Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p;
p->VarRight = NULL;
@ -271,9 +266,7 @@ Yap_LookupVar(char *var) /* lookup variable in variables table */
return (p);
}
static Term
VarNames(VarEntry *p,Term l USES_REGS)
{
static Term VarNames(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) {
Term t[2];
@ -283,30 +276,26 @@ VarNames(VarEntry *p,Term l USES_REGS)
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, VarNames(p->VarRight,
VarNames(p->VarLeft,l PASS_REGS) PASS_REGS));
if (HR > ASP-4096) {
VarNames(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch,1);
siglongjmp(LOCAL_IOBotch, 1);
}
return(o);
return (o);
} 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 {
return (l);
}
}
Term
Yap_VarNames(VarEntry *p,Term l)
{
Term Yap_VarNames(VarEntry *p, Term l) {
CACHE_REGS
return VarNames(p,l PASS_REGS);
return VarNames(p, l PASS_REGS);
}
static Term
Singletons(VarEntry *p,Term l USES_REGS)
{
static Term Singletons(VarEntry *p, Term l USES_REGS) {
if (p != NULL) {
if (p->VarRep && p->VarRep[0] != '_' && p->refs == 1) {
Term t[2];
@ -315,62 +304,56 @@ Singletons(VarEntry *p,Term l USES_REGS)
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep));
t[1] = p->VarAdr;
o = Yap_MkApplTerm(FunctorEq, 2, t);
o = MkPairTerm(o, Singletons(p->VarRight,
Singletons(p->VarLeft,l PASS_REGS) PASS_REGS));
if (HR > ASP-4096) {
o = MkPairTerm(o,
Singletons(p->VarRight,
Singletons(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch,1);
siglongjmp(LOCAL_IOBotch, 1);
}
return(o);
return (o);
} 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 {
return (l);
}
}
Term
Yap_Singletons(VarEntry *p,Term l)
{
Term Yap_Singletons(VarEntry *p, Term l) {
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) {
Term o;
o = MkPairTerm(p->VarAdr, Variables(p->VarRight,Variables(p->VarLeft,l PASS_REGS) PASS_REGS));
if (HR > ASP-4096) {
o = MkPairTerm(
p->VarAdr,
Variables(p->VarRight, Variables(p->VarLeft, l PASS_REGS) PASS_REGS));
if (HR > ASP - 4096) {
save_machine_regs();
siglongjmp(LOCAL_IOBotch,1);
siglongjmp(LOCAL_IOBotch, 1);
}
return(o);
return (o);
} else {
return (l);
}
}
Term
Yap_Variables(VarEntry *p,Term l)
{
Term Yap_Variables(VarEntry *p, Term l) {
CACHE_REGS
return Variables(p,l PASS_REGS);
return Variables(p, l PASS_REGS);
}
static int
IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
{
static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule) {
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
@ -378,7 +361,7 @@ IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = p & MaskPrio;
if (p & DcrrpFlag)
--* rpptr;
--*rpptr;
return TRUE;
} else {
READ_UNLOCK(opp->OpRWLock);
@ -386,23 +369,18 @@ IsPrefixOp(Atom op,int *pptr, int *rpptr USES_REGS)
}
}
int
Yap_IsPrefixOp(Atom op,int *pptr, int *rpptr)
{
int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
CACHE_REGS
return IsPrefixOp(op,pptr,rpptr PASS_REGS);
return IsPrefixOp(op, pptr, rpptr PASS_REGS);
}
static int
IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
{
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule) {
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
@ -410,9 +388,9 @@ IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock);
*pptr = *rpptr = *lpptr = p & MaskPrio;
if (p & DcrrpFlag)
--* rpptr;
--*rpptr;
if (p & DcrlpFlag)
--* lpptr;
--*lpptr;
return TRUE;
} else {
READ_UNLOCK(opp->OpRWLock);
@ -420,23 +398,18 @@ IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS)
}
}
int
Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr)
{
int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) {
CACHE_REGS
return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS);
}
static int
IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
{
static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) {
int p;
OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS);
if (!opp)
return FALSE;
if (opp->OpModule &&
opp->OpModule != CurrentModule) {
if (opp->OpModule && opp->OpModule != CurrentModule) {
READ_UNLOCK(opp->OpRWLock);
return FALSE;
}
@ -444,7 +417,7 @@ IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
READ_UNLOCK(opp->OpRWLock);
*pptr = *lpptr = p & MaskPrio;
if (p & DcrlpFlag)
--* lpptr;
--*lpptr;
return (TRUE);
} else {
READ_UNLOCK(opp->OpRWLock);
@ -452,16 +425,12 @@ IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS)
}
}
int
Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr)
{
int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
CACHE_REGS
return IsPosfixOp(op, pptr, lpptr PASS_REGS);
}
inline static void
GNextToken( USES_REGS1 )
{
inline static void GNextToken(USES_REGS1) {
if (LOCAL_tokptr->Tok == Ord(eot_tok))
return;
if (LOCAL_tokptr == LOCAL_toktide)
@ -470,52 +439,47 @@ GNextToken( USES_REGS1 )
LOCAL_tokptr = LOCAL_tokptr->TokNext;
}
inline static void
checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS)
{
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)
|| LOCAL_tokptr->TokInfo != (Term)c)
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c)
FAIL;
NextToken;
}
#ifdef O_QUASIQUOTATIONS
static int
is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat)
{ CACHE_REGS
static int is_quasi_quotation_syntax(Term goal, ReadData _PL_rd, Atom *pat) {
CACHE_REGS
Term m = CurrentModule, t;
Atom at;
UInt arity;
Functor f;
t = Yap_StripModule(goal, &m);
f = FunctorOfTerm( t );
*pat = at = NameOfFunctor( f );
arity = ArityOfFunctor( f );
if ( arity > 0 )
f = FunctorOfTerm(t);
*pat = at = NameOfFunctor(f);
arity = ArityOfFunctor(f);
if (arity > 0)
return TRUE;
return FALSE;
}
static int
get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein,
ReadData _PL_rd)
{ unsigned char *in, *start = *here;
static int get_quasi_quotation(term_t t, unsigned char **here,
unsigned char *ein, ReadData _PL_rd) {
unsigned char *in, *start = *here;
for(in=start; in <= ein; in++)
{ if ( in[0] == '}' &&
in[-1] == '|' )
{ *here = in+1; /* after } */
for (in = start; in <= ein; in++) {
if (in[0] == '}' && in[-1] == '|') {
*here = in + 1; /* after } */
in--; /* Before | */
if ( _PL_rd->quasi_quotations ) /* option; must return strings */
{ PL_chars_t txt;
if (_PL_rd->quasi_quotations) /* option; must return strings */
{
PL_chars_t txt;
int rc;
txt.text.t = (char*)start;
txt.length = in-start;
txt.text.t = (char *)start;
txt.length = in - start;
txt.storage = PL_CHARS_HEAP;
txt.encoding = ENC_UTF8;
txt.canonical = FALSE;
@ -524,38 +488,35 @@ get_quasi_quotation(term_t t, unsigned char **here, unsigned char *ein,
PL_free_text(&txt);
return rc;
} else
{ return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
PL_POINTER, _PL_rd,
PL_INTPTR, (intptr_t)(start),
PL_INTPTR, (intptr_t)(in-start));
} else {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_dquasi_quotation3,
PL_POINTER, _PL_rd, PL_INTPTR, (intptr_t)(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*/
static Term
ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
{
static Term ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1 USES_REGS) {
int nargs = 0;
Term *p, t;
Functor func;
#ifdef SFUNC
SFEntry *pe = (SFEntry *) Yap_GetAProp(a, SFProperty);
SFEntry *pe = (SFEntry *)Yap_GetAProp(a, SFProperty);
#endif
NextToken;
p = (Term *) ParserAuxSp;
p = (Term *)ParserAuxSp;
if (arg1) {
*p = arg1;
nargs++;
ParserAuxSp = (char *)(p+1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
&& LOCAL_tokptr->TokInfo == close) {
ParserAuxSp = (char *)(p + 1);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
LOCAL_tokptr->TokInfo == close) {
func = Yap_MkFunctor(a, 1);
if (func == NULL) {
@ -563,7 +524,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
FAIL;
}
t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
return TermNil;
}
@ -573,7 +534,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
}
while (1) {
Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp+1 > LOCAL_TrailTop) {
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
LOCAL_ErrorMessage = "Trail Overflow";
FAIL;
}
@ -582,7 +543,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
break;
if (((int) LOCAL_tokptr->TokInfo) != ',')
if (((int)LOCAL_tokptr->TokInfo) != ',')
break;
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
* order
*/
if (HR > ASP-(nargs+1)) {
if (HR > ASP - (nargs + 1)) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
@ -611,7 +572,7 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
else
t = Yap_MkApplTerm(func, nargs, p);
#endif
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
return TermNil;
}
@ -620,39 +581,36 @@ ParseArgs(read_data *rd, Atom a, wchar_t close, JMPBUFF *FailBuff, Term arg1 USE
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;
Term tf[2], tl= TermNil;
Term tf[2], tl = TermNil;
tf[1] = ArgOfTerm(1, t);
for (i = arity; i > 1; i--) {
tl = MkPairTerm(ArgOfTerm(i, t), tl);
}
tf[0] = tl;
return Yap_MkApplTerm( f, 2, tf );
return Yap_MkApplTerm(f, 2, tf);
}
static Term
ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
{
static Term ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS) {
Term o;
CELL *to_store;
o = AbsPair(HR);
loop:
loop:
to_store = HR;
HR+=2;
HR += 2;
to_store[0] = ParseTerm(rd, 999, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int) LOCAL_tokptr->TokInfo) == ',') {
if (((int)LOCAL_tokptr->TokInfo) == ',') {
NextToken;
if (LOCAL_tokptr->Tok == Ord(Name_tok)
&& strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
strcmp(RepAtom((Atom)(LOCAL_tokptr->TokInfo))->StrOfAE, "..") == 0) {
NextToken;
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else {
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
to_store[1] = TermNil;
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
@ -661,7 +619,7 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
goto loop;
}
}
} else if (((int) LOCAL_tokptr->TokInfo) == '|') {
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
NextToken;
to_store[1] = ParseTerm(rd, 999, FailBuff PASS_REGS);
} else {
@ -672,9 +630,7 @@ ParseList(read_data *rd, JMPBUFF *FailBuff USES_REGS)
return (o);
}
static Term
ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
{
static Term ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS) {
/* parse term with priority prio */
Volatile Term t;
Volatile Functor func;
@ -705,10 +661,9 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break;
}
}
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok)
|| Unsigned(LOCAL_tokptr->TokInfo) != 'l')
&& IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)
) {
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo;
#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(
/* build appl on the heap */
func = Yap_MkFunctor((Atom) t, 1);
func = Yap_MkFunctor((Atom)t, 1);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
} t = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
curprio = opprio;
,
break;
)
} curprio = opprio;
, break;)
}
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
&& Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs(rd, (Atom) t, ')', FailBuff, 0L PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs(rd, (Atom)t, ')', FailBuff, 0L PASS_REGS);
else
t = MkAtomTerm((Atom)t);
break;
@ -771,28 +722,36 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
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);
if (!t) {
FAIL;
}
NextToken;
}
break;
} break;
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);
if (!t) {
FAIL;
}
NextToken;
}
break;
} break;
case Var_tok:
varinfo = (VarEntry *) (LOCAL_tokptr->TokInfo);
case StringTerm_tok: /* build list on the heap */
{
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) {
t = varinfo->VarAdr = MkVarTerm();
}
@ -803,7 +762,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
FAIL;
case Ponctuation_tok:
switch ((int) LOCAL_tokptr->TokInfo) {
switch ((int)LOCAL_tokptr->TokInfo) {
case '(':
case 'l': /* non solo ( */
NextToken;
@ -813,7 +772,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case '[':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int) LOCAL_tokptr->TokInfo == ']') {
(int)LOCAL_tokptr->TokInfo == ']') {
t = TermNil;
NextToken;
break;
@ -824,7 +783,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
case '{':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int) LOCAL_tokptr->TokInfo == '}') {
(int)LOCAL_tokptr->TokInfo == '}') {
t = MkAtomTerm(AtomBraces);
NextToken;
break;
@ -832,7 +791,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
t = ParseTerm(rd, 1200, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
@ -843,8 +802,7 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
}
break;
case QuasiQuotes_tok:
{
case QuasiQuotes_tok: {
qq_t *qq = (qq_t *)(LOCAL_tokptr->TokInfo);
term_t pv, positions = rd->subtpos, to;
Atom at;
@ -853,31 +811,29 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
// from SWI, enter the list
/* prepare (if we are the first in term) */
if ( !rd->varnames )
if (!rd->varnames)
rd->varnames = PL_new_term_ref();
if ( !rd->qq )
{ if ( rd->quasi_quotations )
{ rd->qq = rd->quasi_quotations;
} else
{ if ( !(rd->qq = PL_new_term_ref()) )
if (!rd->qq) {
if (rd->quasi_quotations) {
rd->qq = rd->quasi_quotations;
} else {
if (!(rd->qq = PL_new_term_ref()))
return FALSE;
}
// create positions term
if ( positions )
{ if ( !(pv = PL_new_term_refs(3)) ||
!PL_unify_term(positions,
PL_FUNCTOR, FUNCTOR_quasi_quotation_position5,
PL_INTPTR, qq->start.charno,
PL_VARIABLE,
PL_TERM, pv+0, // leave three open slots
PL_TERM, pv+1,
PL_TERM, pv+2) )
if (positions) {
if (!(pv = PL_new_term_refs(3)) ||
!PL_unify_term(positions, PL_FUNCTOR,
FUNCTOR_quasi_quotation_position5, PL_INTPTR,
qq->start.charno, PL_VARIABLE, PL_TERM,
pv + 0, // leave three open slots
PL_TERM, pv + 1, PL_TERM, pv + 2))
return FALSE;
} else
pv = 0;
/* push type */
if ( !(rd->qq_tail = PL_copy_term_ref(rd->qq)) )
if (!(rd->qq_tail = PL_copy_term_ref(rd->qq)))
return FALSE;
}
@ -886,32 +842,35 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
FAIL;
}
if ( !( is_quasi_quotation_syntax(t, rd, &at)) )
if (!(is_quasi_quotation_syntax(t, rd, &at)))
FAIL;
/* Arg 2: the content */
tn = Yap_MkNewApplTerm( SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4 );
tnp = RepAppl(tn)+1;
tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn) + 1;
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;
if ( positions )
{ intptr_t qqend = qq->end.charno;
if (positions) {
intptr_t qqend = qq->end.charno;
// set_range_position(positions, -1, qqend PASS_LD);
if ( !PL_unify_term( Yap_InitSlot( ArgOfTerm(2, t) PASS_REGS),
PL_FUNCTOR, FUNCTOR_minus2,
PL_INTPTR, qq->mid.charno+2, /* end of | token */
PL_INTPTR, qqend-2) ) /* end minus "|}" */
if (!PL_unify_term(Yap_InitSlot(ArgOfTerm(2, t) PASS_REGS), PL_FUNCTOR,
FUNCTOR_minus2, PL_INTPTR,
qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend - 2)) /* end minus "|}" */
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 */
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(to, Yap_InitSlot(tn PASS_REGS)) )
!PL_unify(to, Yap_InitSlot(tn PASS_REGS)))
FAIL;
}
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 */
while (TRUE) {
if (LOCAL_tokptr->Tok == Ord(Name_tok)
&& Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;
TRY3(
func = Yap_MkFunctor((Atom) LOCAL_tokptr->TokInfo, 2);
TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
NextToken;
} NextToken;
{
Term args[2];
args[0] = t;
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
},
curprio = opprio;
opinfo = save_opinfo;
continue;
,
opinfo = save_opinfo;
curprio = oldprio;
)
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
curprio = oldprio;)
}
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio &&
oplprio >= curprio) {
/* 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) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
@ -977,51 +930,53 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
break;
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' &&
prio >= 1000 && curprio <= 999) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
curprio <= 999) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(rd, 1000, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
curprio = 1000;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
Volatile Term args[2];
NextToken;
args[0] = t;
args[1] = ParseTerm(rd, oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */
if (HR > ASP-4096) {
if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;
}
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyBrackets, ')', FailBuff, t PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS)
&& opprio <= prio && oplprio >= curprio) {
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
t = ParseArgs(rd, AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
curprio = opprio;
@ -1034,19 +989,16 @@ ParseTerm(read_data *rd, int prio, JMPBUFF *FailBuff USES_REGS)
}
#if DEBUG
if (GLOBAL_Option['p' - 'a' + 1]) {
Yap_DebugPutc(LOCAL_c_error_stream,'[');
Yap_DebugPutc(LOCAL_c_error_stream, '[');
Yap_DebugPlWrite(t);
Yap_DebugPutc(LOCAL_c_error_stream,']');
Yap_DebugPutc(LOCAL_c_error_stream,'\n');
Yap_DebugPutc(LOCAL_c_error_stream, ']');
Yap_DebugPutc(LOCAL_c_error_stream, '\n');
}
#endif
return t;
}
Term
Yap_Parse(read_data *rd)
{
Term Yap_Parse(read_data *rd) {
CACHE_REGS
Volatile Term t;
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;
} udirect;
typedef struct rewind_term {
struct rewind_term *parent;
union {
@ -70,7 +69,7 @@ typedef struct rewind_term {
} rwts;
typedef struct write_globs {
IOSTREAM*stream;
IOSTREAM *stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
@ -83,23 +82,22 @@ typedef struct write_globs {
#define lastw wglb->lw
#define last_minus wglb->last_atom_minus
static bool
callPortray(Term t, struct DB_TERM **old_EXp USES_REGS)
{
static bool callPortray(Term t, struct DB_TERM **old_EXp USES_REGS) {
PredEntry *pe;
Int b0 = LCL0-(CELL*)B;
Int b0 = LCL0 - (CELL *)B;
EX = NULL;
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t PASS_REGS) ) {
choiceptr B0 = (choiceptr)(LCL0-b0);
if (EX && !*old_EXp) *old_EXp = EX;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0);
if (EX && !*old_EXp)
*old_EXp = EX;
Yap_fail_all(B0 PASS_REGS);
return true;
}
if (EX && !*old_EXp) *old_EXp = EX;
if (EX && !*old_EXp)
*old_EXp = EX;
return false;
}
@ -111,17 +109,16 @@ static int legalAtom(unsigned char *);
static int RightOpToProtect(Atom, int);*/
static wtype AtomIsSymbols(unsigned char *);
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.
avoid stuff like not (2,3) -> not(2,3) or
*/
static void
wropen_bracket(struct write_globs *wglb, int protect)
{
static void wropen_bracket(struct write_globs *wglb, int protect) {
wrf stream = wglb->stream;
if (lastw != separator && protect)
@ -130,33 +127,27 @@ wropen_bracket(struct write_globs *wglb, int protect)
lastw = separator;
}
static void
wrclose_bracket(struct write_globs *wglb, int protect)
{
static void wrclose_bracket(struct write_globs *wglb, int protect) {
wrf stream = wglb->stream;
wrputc(')', stream);
lastw = separator;
}
static int
protect_open_number(struct write_globs *wglb, int lm, int minus_required)
{
static int protect_open_number(struct write_globs *wglb, int lm,
int minus_required) {
wrf stream = wglb->stream;
if (lastw == symbol && lm && !minus_required) {
wropen_bracket(wglb, TRUE);
return TRUE;
} else if (lastw == alphanum ||
(lastw == symbol && minus_required)) {
} else if (lastw == alphanum || (lastw == symbol && minus_required)) {
wrputc(' ', stream);
}
return FALSE;
}
static void
protect_close_number(struct write_globs *wglb, int used_bracket)
{
static void protect_close_number(struct write_globs *wglb, int used_bracket) {
if (used_bracket) {
wrclose_bracket(wglb, TRUE);
} else {
@ -165,12 +156,12 @@ protect_close_number(struct write_globs *wglb, int used_bracket)
last_minus = FALSE;
}
static void
wrputn(Int n, struct write_globs *wglb) /* writes an integer */
static void wrputn(Int n,
struct write_globs *wglb) /* writes an integer */
{
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 ob;
@ -187,9 +178,7 @@ wrputn(Int n, struct write_globs *wglb) /* writes an integer */
#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)
wrputc(*s++, stream);
@ -197,28 +186,27 @@ wrputws(wchar_t *s, wrf stream) /* writes a string */
#ifdef USE_GMP
static char *
ensure_space(size_t sz) {
static char *ensure_space(size_t sz) {
CACHE_REGS
char *s;
s = (char *) Yap_PreAllocCodeSpace();
while (s+sz >= (char *)AuxSp) {
s = (char *)Yap_PreAllocCodeSpace();
while (s + sz >= (char *)AuxSp) {
#if USE_SYSTEM_MALLOC
/* may require stack expansion */
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
s = NULL;
break;
}
s = (char *) Yap_PreAllocCodeSpace();
s = (char *)Yap_PreAllocCodeSpace();
#else
s = NULL;
#endif
}
if (!s) {
s = (char *)TR;
while (s+sz >= LOCAL_TrailTop) {
if (!Yap_growtrail(sz/sizeof(CELL), FALSE)) {
while (s + sz >= LOCAL_TrailTop) {
if (!Yap_growtrail(sz / sizeof(CELL), FALSE)) {
s = NULL;
break;
}
@ -227,41 +215,40 @@ ensure_space(size_t sz) {
}
if (!s) {
s = (char *)HR;
if (s+sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz);
if (s + sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil,
"not enough space to write bignum: it requires %d bytes", sz);
s = NULL;
}
}
return s;
}
static void
write_mpint(MP_INT *big, struct write_globs *wglb) {
static void write_mpint(MP_INT *big, struct write_globs *wglb) {
char *s;
int has_minus = mpz_sgn(big);
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);
if (!s) {
s = mpz_get_str(NULL, 10, big);
if (!s)
return;
wrputs(s,wglb->stream);
wrputs(s, wglb->stream);
free(s);
} else {
mpz_get_str(s, 10, big);
wrputs(s,wglb->stream);
wrputs(s, wglb->stream);
}
protect_close_number(wglb, ob);
}
#endif
/* writes a bignum */
static void
writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt)
{
CELL *pt = RepAppl(t)+1;
/* writes a bignum */
static void writebig(Term t, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt) {
CELL *pt = RepAppl(t) + 1;
CELL big_tag = pt[0];
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;
return;
#ifdef USE_GMP
} else if (big_tag == BIG_INT)
{
} else if (big_tag == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb);
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;
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);
return;
}
}
wrputs("0",wglb->stream);
wrputs("0", wglb->stream);
}
static void
wrputf(Float f, struct write_globs *wglb) /* writes a float */
static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
{
char s[256];
@ -304,7 +289,6 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int sgn;
int ob;
#if HAVE_ISNAN || defined(__WIN32)
if (isnan(f)) {
wrputs("(nan)", stream);
@ -330,11 +314,11 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
int found_dot = FALSE;
char *pt = s;
int ch;
/* always use C locale for writing numbers */
/* always use C locale for writing numbers */
#if O_LOCALE
const unsigned char *decimalpoint = (unsigned char*)
localeconv()->decimal_point;
size_t l1 = strlen((const char *)decimalpoint+1);
const unsigned char *decimalpoint =
(unsigned char *)localeconv()->decimal_point;
size_t l1 = strlen((const char *)decimalpoint + 1);
#else
const unsigned char decimalpoint[2] = ".";
size_t l1 = 0;
@ -354,7 +338,8 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
}
while ((ch = *pt) != '\0') {
// 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;
pt += l1;
ch = '.';
@ -362,7 +347,7 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
if (ch == 'e' || ch == 'E') {
if (!found_dot) {
found_dot = TRUE;
wrputs(".0" , stream);
wrputs(".0", stream);
}
found_dot = TRUE;
}
@ -381,15 +366,14 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
}
/* use SWI's format_float */
buf = format_float(f, s);
if (!buf) return;
if (!buf)
return;
wrputs(buf, stream);
#endif
protect_close_number(wglb, ob);
}
int
Yap_FormatFloat( Float f, const char *s, size_t sz )
{
int Yap_FormatFloat(Float f, const char *s, size_t sz) {
struct write_globs wglb;
char *ws = (char *)s;
IOSTREAM *smem = Sopenmem(&ws, &sz, "w");
@ -401,28 +385,25 @@ Yap_FormatFloat( Float f, const char *s, size_t sz )
return TRUE;
}
/* writes a data base reference */
static void
wrputref(CODEADDR ref, int Quote_illegal, struct write_globs *wglb)
{
static void wrputref(CODEADDR ref, int Quote_illegal,
struct write_globs *wglb) {
char s[256];
wrf stream = wglb->stream;
putAtom(AtomDBref, Quote_illegal, wglb);
#if defined(__linux__) || defined(__APPLE__)
sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount);
sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#else
sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount);
sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#endif
wrputs(s, stream);
lastw = alphanum;
}
/* writes a blob (default) */
static int
wrputblob(AtomEntry * ref, int Quote_illegal, struct write_globs *wglb)
{
static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) {
char s[256];
wrf stream = wglb->stream;
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;
}
static int
legalAtom(unsigned char *s) /* Is this a legal atom ? */
static int legalAtom(unsigned char *s) /* Is this a legal atom ? */
{
wchar_t ch = *s;
@ -461,7 +441,8 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
return FALSE;
} else {
if (ch == '/') {
if (s[1] == '*') return FALSE;
if (s[1] == '*')
return FALSE;
}
while (ch) {
if (Yap_chtype[ch] != SY) {
@ -483,7 +464,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
{
int ch;
if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0')
return(separator);
return (separator);
while ((ch = *s++) != '\0') {
if (Yap_chtype[ch] != SY)
return alphanum;
@ -491,9 +472,7 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
return symbol;
}
static void
write_quoted(wchar_t ch, wchar_t quote, wrf stream)
{
static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
@ -501,7 +480,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\'', stream); /* be careful about quotes */
return;
}
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\') {
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' && ch != '`') {
wrputc(ch, stream);
} else {
switch (ch) {
@ -519,6 +498,11 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('\\', stream);
wrputc(ch, stream);
break;
case '`':
if (ch == quote)
wrputc('`', stream);
wrputc(ch, stream);
break;
case 7:
wrputc('\\', stream);
wrputc('a', stream);
@ -552,7 +536,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
wrputc('f', stream);
break;
default:
if ( ch <= 0xff ) {
if (ch <= 0xff) {
char esc[8];
/* last backslash in ISO mode */
@ -563,42 +547,38 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
}
}
static void
write_string(const char *s, struct write_globs *wglb) /* writes an integer */
static void write_string(const char *s,
struct write_globs *wglb) /* writes an integer */
{
IOSTREAM *stream = wglb->stream;
int chr;
int chr, qt;
char *ptr = (char *)s;
if (wglb->Write_strings)
wrputc('`', stream);
qt = '`';
else
wrputc('"', stream);
qt = '"';
wrputc(qt, stream);
do {
ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break;
write_quoted(chr, '"', stream);
if (chr == '\0')
break;
write_quoted(chr, qt, stream);
} while (TRUE);
if (wglb->Write_strings)
wrputc('`', stream);
else
wrputc('"', stream);
wrputc(qt, stream);
}
/* writes an atom */
static void
putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
{
static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s;
wtype atom_or_symbol;
wrf stream = wglb->stream;
if (IsBlob(atom)) {
wrputblob(RepAtom(atom),Quote_illegal,wglb);
wrputblob(RepAtom(atom), Quote_illegal, wglb);
return;
}
if (IsWideAtom(atom) ) {
if (IsWideAtom(atom)) {
wchar_t *ws = RepAtom(atom)->WStrOfAE;
if (Quote_illegal) {
@ -614,11 +594,12 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
return;
}
s = (unsigned char *)RepAtom(atom)->StrOfAE;
/* #define CRYPT_FOR_STEVE 1*/
/* #define CRYPT_FOR_STEVE 1*/
#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];
sprintf(s,"x%x", (CELL)s);
sprintf(s, "x%x", (CELL)s);
wrputs(s, stream);
return;
}
@ -641,17 +622,14 @@ putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb)
}
}
void
Yap_WriteAtom(IOSTREAM *s, Atom atom)
{
void Yap_WriteAtom(IOSTREAM *s, Atom atom) {
struct write_globs wglb;
wglb.stream = s;
wglb.Quote_illegal = FALSE;
putAtom(atom, 0, &wglb);
}
static int
IsCodesTerm(Term string) /* checks whether this is a string */
static int IsCodesTerm(Term string) /* checks whether this is a string */
{
if (IsVarTerm(string))
return FALSE;
@ -659,22 +637,25 @@ IsCodesTerm(Term string) /* checks whether this is a string */
Term hd;
int ch;
if (!IsPairTerm(string)) return(FALSE);
if (!IsPairTerm(string))
return (FALSE);
hd = HeadOfTerm(string);
if (IsVarTerm(hd)) return(FALSE);
if (!IsIntTerm(hd)) return(FALSE);
if (IsVarTerm(hd))
return (FALSE);
if (!IsIntTerm(hd))
return (FALSE);
ch = IntOfTerm(HeadOfTerm(string));
if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t')
return(FALSE);
return (FALSE);
string = TailOfTerm(string);
if (IsVarTerm(string)) return(FALSE);
if (IsVarTerm(string))
return (FALSE);
} while (string != TermNil);
return(TRUE);
return (TRUE);
}
/* writes a string */
static void
putString(Term string, struct write_globs *wglb)
static void putString(Term string, struct write_globs *wglb)
{
wrf stream = wglb->stream;
@ -689,8 +670,7 @@ putString(Term string, struct write_globs *wglb)
}
/* writes a string */
static void
putUnquotedString(Term string, struct write_globs *wglb)
static void putUnquotedString(Term string, struct write_globs *wglb)
{
wrf stream = wglb->stream;
@ -702,10 +682,8 @@ putUnquotedString(Term string, struct write_globs *wglb)
lastw = alphanum;
}
static Term
from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
{
static Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
Term t;
CELL *ptr = ptr0;
@ -729,7 +707,7 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
} else {
rwt->u_sd.d.old = t;
rwt->u_sd.d.ptr = ptr0;
if ( !IsVarTerm(t) && !IsAtomicTerm(t)) {
if (!IsVarTerm(t) && !IsAtomicTerm(t)) {
struct rewind_term *x = rwt->parent;
while (x) {
@ -742,14 +720,13 @@ from_pointer(CELL *ptr0, struct rewind_term *rwt, struct write_globs *wglb)
return t;
}
static CELL *
restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
{
static CELL *restore_from_write(struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
CELL *ptr;
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))
return NULL;
} else {
@ -760,9 +737,8 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
}
/* writes an unbound variable */
static void
write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
{
static void write_var(CELL *t, struct write_globs *wglb,
struct rewind_term *rwt) {
CACHE_REGS
if (lastw == alphanum) {
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 */
lastw = separator;
if (IsAttVar(t)) {
Int vcount = (t-H0);
Int vcount = (t - H0);
if (wglb->Portray_delays) {
exts ext = ExtFromCell(t);
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);
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
wrputs("$AT(",wglb->stream);
wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt);
wrputc(',', wglb->stream);
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
l = restore_from_write(&nrwt, wglb);
wrputc(',', wglb->stream);
l ++;
l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE);
@ -798,15 +774,14 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
return;
}
wrputc('D', wglb->stream);
wrputn(vcount,wglb);
wrputn(vcount, wglb);
} else {
wrputn(((Int) (t- H0)),wglb);
wrputn(((Int)(t - H0)), wglb);
}
}
static Term
check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
{
static Term check_infinite_loop(Term t, struct rewind_term *x,
struct write_globs *wglb) {
CACHE_REGS
if (wglb->Keep_terms) {
while (x) {
@ -824,9 +799,8 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
return t;
}
static void
write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt)
{
static void write_list(Term t, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) {
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
@ -836,7 +810,8 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
int ndirection;
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));
ti = TailOfTerm(t);
if (IsVarTerm(ti))
@ -844,7 +819,7 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
if (!IsPairTerm(ti) ||
!IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb))))
break;
ndirection = RepPair(ti)-RepPair(t);
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
if (ndirection > 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;
}
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 */
if (IsAtomTerm(nt)) {
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)) {
wrputc('|', wglb->stream);
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);
}
}
}
static void
writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, struct rewind_term *rwt)
static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt)
/* term to write */
/* 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);
} else if (IsIntTerm(t)) {
wrputn((Int) IntOfTerm(t),wglb);
wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) {
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) {
if (wglb->Ignore_ops) {
wrputs("'.'(",wglb->stream);
wrputs("'.'(", wglb->stream);
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));
wrputs(",",wglb->stream);
writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
wrputs(",", wglb->stream);
writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE);
return;
}
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)) {
putString(t, wglb);
} else {
@ -947,21 +925,21 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
int op, lp, rp;
if (IsExtensionFunctor(functor)) {
switch((CELL)functor) {
case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t),wglb);
switch ((CELL)functor) {
case (CELL) FunctorDouble:
wrputf(FloatOfTerm(t), wglb);
return;
case (CELL)FunctorString:
write_string(StringOfTerm(t),wglb);
case (CELL) FunctorString:
write_string(StringOfTerm(t), wglb);
return;
case (CELL)FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt);
case (CELL) FunctorAttVar:
write_var(RepAppl(t) + 1, wglb, &nrwt);
return;
case (CELL)FunctorDBRef:
case (CELL) FunctorDBRef:
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb);
return;
case (CELL)FunctorLongInt:
wrputn(LongIntOfTerm(t),wglb);
case (CELL) FunctorLongInt:
wrputn(LongIntOfTerm(t), wglb);
return;
/* case (CELL)FunctorBigInt: */
default:
@ -988,8 +966,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
*p++;
lastw = separator;
/* cannot use the term directly with the SBA */
writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
p = restore_from_write(&nrwt, wglb)+1;
writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb,
&nrwt);
p = restore_from_write(&nrwt, wglb) + 1;
if (*p)
wrputc(',', wglb->stream);
argno++;
@ -999,15 +978,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
}
#endif
if (wglb->Use_portray) {
if (callPortray(t, &EX PASS_REGS) ) return;
if (callPortray(t, &EX PASS_REGS))
return;
}
if (!wglb->Ignore_ops &&
Arity == 1 &&
Yap_IsPrefixOp(atom, &op, &rp)
) {
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
int bracket_right =
!IsVarTerm(tright) && IsAtomTerm(tright) &&
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
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) {
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);
if (bracket_right) {
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);
}
} 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)) {
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;
}
bracket_left =
!IsVarTerm(tleft) &&
IsAtomTerm(tleft) &&
Yap_IsOp(AtomOfTerm(tleft));
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
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) {
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);
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
if (Arity > 1 ) {
if (Arity > 1) {
if (atom == AtomEmptyBrackets) {
wrputc('(', wglb->stream);
} 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) {
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops &&
Arity == 2 && Yap_IsInfixOp(atom, &op, &lp,
&rp) ) {
} else if (!wglb->Ignore_ops && Arity == 2 &&
Yap_IsInfixOp(atom, &op, &lp, &rp)) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
Yap_IsOp(AtomOfTerm(tleft));
int bracket_right =
!IsVarTerm(tright) && IsAtomTerm(tright) &&
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
@ -1101,16 +1077,17 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), lp, depth + 1, rinfixarg, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb)-1);
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), lp, depth + 1,
rinfixarg, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - 1);
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
/* avoid quoting commas and bars */
if (!strcmp(RepAtom(atom)->StrOfAE,",")) {
if (!strcmp(RepAtom(atom)->StrOfAE, ",")) {
wrputc(',', wglb->stream);
lastw = separator;
} else if (!strcmp(RepAtom(atom)->StrOfAE,"|")) {
} else if (!strcmp(RepAtom(atom)->StrOfAE, "|")) {
wrputc('|', wglb->stream);
lastw = separator;
} else
@ -1118,7 +1095,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (bracket_right) {
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);
if (bracket_right) {
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) {
wrputc(' ', wglb->stream);
}
if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (!IsVarTerm(ti) &&
(IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti))) {
if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti);
if (k == -1) {
@ -1143,7 +1122,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
if (k >= 26) {
/* make sure we don't get confused about our context */
lastw = separator;
wrputn( k / 26 ,wglb);
wrputn(k / 26, wglb);
} else
lastw = alphanum;
}
@ -1153,16 +1132,18 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
putUnquotedString(ti, wglb);
}
} else {
wrputs("'$VAR'(",wglb->stream);
wrputs("'$VAR'(", wglb->stream);
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);
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream);
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);
wrputc('}', wglb->stream);
lastw = separator;
@ -1174,8 +1155,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputs("...", wglb->stream);
break;
}
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb)-op);
writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
FALSE, wglb, &nrwt);
t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
if (op != Arity) {
wrputc(',', wglb->stream);
lastw = separator;
@ -1194,7 +1176,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputc('.', wglb->stream);
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);
if (op != Arity) {
wrputc(',', wglb->stream);
@ -1206,11 +1189,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
}
}
void
Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
/* term to be written */
/* consumer */
/* write options */
void Yap_plwrite(Term t, void *mywrite, int max_depth, int flags, int priority)
/* term to be written */
/* consumer */
/* write options */
{
struct write_globs wglb;
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;
/* notice: we must have ASP well set when using portray, otherwise
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 */
rwt.parent = NULL;
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);
restore_from_write(&rwt, &wglb);
}

11
CMakeLists.txt
View File

@ -509,13 +509,18 @@ ADD_SUBDIRECTORY(swi/library)
# ADD_SUBDIRECTORY(os)
# 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)
INCLUDE_DIRECTORIES(JIT JIT/HPP)
macro_optional_add_subdirectory(JIT ON)
endif()
macro_optional_add_subdirectory(JIT)
endif()
macro_optional_add_subdirectory(library/mpi)
macro_optional_add_subdirectory(library/lammpi)
macro_optional_add_subdirectory (packages/gecode)

2
H/ScannerTypes.h
View File

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

2
H/amijit.h
View File

@ -336,7 +336,7 @@ typedef struct environment {
#if YAP_JIT
/* Enumeration for types of basic blocks -- used on trace construction */
typedef enum {
typedef enum block_try {
NONE, // untyped
SIMPLE_ENTRY, // first 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;
/* 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_
@ -351,5 +321,3 @@ WideHashFunction(wchar_t *CHP)
#define QUIET_ON_PARSER_ERROR 1
#define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3

5
JIT/CMakeLists.txt
View File

@ -16,11 +16,6 @@ set(LIBJIT_SOURCES
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:
# LLVM_FOUND - true if LLVM was found
# 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("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
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
setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES);
#endif
@ -1329,4 +1329,3 @@ BeginPredDefs(prologflag)
EndPredDefs
//! @}

18
os/pl-utf8.c
View File

@ -252,3 +252,21 @@ utf8_strprefix(const char *s1, const char *s2)
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
#define UTF8_H_INCLUDED
#include <wchar.h>
#define PL_MB_LEN_MAX 16
#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 int utf8_strncmp(const char *s1, const char *s2, size_t n);
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 {
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 &&
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);
@ -796,5 +796,3 @@ pl_writeln(term_t term)
BeginPredDefs(write)
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 <SWI-Stream.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_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;
/**** 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.os.Bundle;
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.SQLiteOpenHelper;
import org.sqlite.database.SQLException;
import org.sqlite.database.DatabaseErrorHandler;
class DoNotDeleteErrorHandler implements DatabaseErrorHandler {
private static final String TAG = "DoNotDeleteErrorHandler";
@ -49,7 +75,7 @@ public class JavaYap extends Activity
// text.setText("");
if (vs0.nil()) {
if (BuildConfig.DEBUG) {
Log.i(TAG, "q=");
Log.i(TAG, "q0=\n");
}
if (q.next()) {
outputText.append( "yes\n" );
@ -59,12 +85,12 @@ public class JavaYap extends Activity
} else {
int i=1;
if (BuildConfig.DEBUG) {
Log.i(TAG, "q=");
Log.i(TAG, "q1= "+vs0.text()+"\n");
}
while (rc = q.next()) {
if (BuildConfig.DEBUG) {
Log.i(TAG, "q=");
Log.i(TAG, "q= "+vs0.text()+"\n");
}
YAPListTerm vs = vs0;