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

Memory management and UTF-8 for all fixes

This commit is contained in:
Vitor Santos Costa 2016-11-04 11:36:48 -05:00
parent 02e0e50915
commit 46a9d52d2d
26 changed files with 526 additions and 483 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
C/adtdefs.c
View File

@ -57,10 +57,15 @@ GetFunctorProp(AtomEntry *ae,
arity_t arity) { /* look property list of atom a for kind */ arity_t arity) { /* look property list of atom a for kind */
FunctorEntry *pp; FunctorEntry *pp;
pp = RepFunctorProp(ae->PropsOfAE); PropEntry *p = RepFunctorProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && (pp = RepFunctorProp(pp->NextOfPE))) while (p != NIL) {
; if (p->KindOfPE == FunctorProperty &&
return (AbsFunctorProp(pp)); RepFunctorProp(p)->ArityOfFE == arity) {
return p;
}
p = p->NextOfPE;
}
return NIL;
} }
/* vsc: We must guarantee that IsVarTerm(functor) returns true! */ /* vsc: We must guarantee that IsVarTerm(functor) returns true! */
@ -155,7 +160,6 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
hash = HashFunction(p); hash = HashFunction(p);
hash = hash % sz; hash = hash % sz;
/* we'll start by holding a read lock in order to avoid contention */ /* we'll start by holding a read lock in order to avoid contention */
READ_LOCK(HashChain[hash].AERWLock); READ_LOCK(HashChain[hash].AERWLock);
a = HashChain[hash].Entry; a = HashChain[hash].Entry;
@ -199,6 +203,7 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
if (NOfAtoms > 2 * AtomHashTableSize) { if (NOfAtoms > 2 * AtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL); Yap_signal(YAP_CDOVF_SIGNAL);
} }
return na; return na;
} }

10
C/alloc.c
View File

@ -77,7 +77,7 @@ void *my_malloc(size_t sz) {
p = malloc(sz); p = malloc(sz);
// Yap_DebugPuts(stderr,"gof\n"); // Yap_DebugPuts(stderr,"gof\n");
if (Yap_do_low_level_trace||1) if (Yap_do_low_level_trace)
fprintf(stderr, "+ %p : %lu\n", p, sz); fprintf(stderr, "+ %p : %lu\n", p, sz);
if (sz > 500 && write_malloc++ > 0) if (sz > 500 && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "+ %d %p", write_malloc, __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "+ %d %p", write_malloc,
@ -89,8 +89,8 @@ void *my_realloc(void *ptr, size_t sz) {
void *p; void *p;
p = realloc(ptr, sz); p = realloc(ptr, sz);
if (Yap_do_low_level_trace||1) if (Yap_do_low_level_trace)
fprintf(stderr, "+ %p -> %p : %lu\n", ptr, p, sz); // fprintf(stderr, "+ %p -> %p : %lu\n", ptr, p, sz);
// Yap_DebugPuts(stderr,"gof\n"); // Yap_DebugPuts(stderr,"gof\n");
if (sz > 500 && write_malloc++ > 0) if (sz > 500 && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "* %d %p", write_malloc, __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "* %d %p", write_malloc,
@ -100,7 +100,7 @@ void *my_realloc(void *ptr, size_t sz) {
void my_free(void *p) { void my_free(void *p) {
// printf("f %p\n",p); // printf("f %p\n",p);
if (Yap_do_low_level_trace||1) if (Yap_do_low_level_trace)
fprintf(stderr, "+ %p\n", p); fprintf(stderr, "+ %p\n", p);
if (write_malloc && write_malloc++ > 0) if (write_malloc && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc, __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc,
@ -671,7 +671,7 @@ static char *AllocHeap(size_t size) {
LOCK(FreeBlocksLock); LOCK(FreeBlocksLock);
if ((b = GetBlock(size))) { if ((b = GetBlock(size))) {
if (b->b_size >= size + 24 + 1) { if (b->b_size >= size + 24 + 1) {
n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1); n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1)v;
n->b_size = b->b_size - size - 1; n->b_size = b->b_size - size - 1;
b->b_size = size; b->b_size = size;
AddToFreeList(n); AddToFreeList(n);

611
C/atomic.c
View File

File diff suppressed because it is too large Load Diff

33
C/cmppreds.c
View File

@ -63,6 +63,8 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include <wchar.h> #include <wchar.h>
#include "YapError.h"
static Int compare(Term, Term); static Int compare(Term, Term);
static Int p_compare(USES_REGS1); static Int p_compare(USES_REGS1);
static Int p_acomp(USES_REGS1); static Int p_acomp(USES_REGS1);
@ -378,9 +380,11 @@ inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
return 1; return 1;
else { else {
int out; int out;
if (!(out = 2 - ArityOfFunctor(f))) if (f != FunctorDot)
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE); return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
return (out); else {
return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2) );
}
} }
} }
if (IsPairTerm(t2)) { if (IsPairTerm(t2)) {
@ -590,14 +594,12 @@ inline static Int flt_cmp(Float dif) {
return dif = 0.0; return dif = 0.0;
} }
static inline Int a_cmp(Term t1, Term t2 USES_REGS) { static Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2"); Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" );
return FALSE;
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2"); Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" );
return FALSE;
} }
if (IsFloatTerm(t1) && IsFloatTerm(t2)) { if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2)); return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
@ -620,8 +622,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" );
LOCAL_ErrorMessage = "trying to evaluate nan";
} }
#endif #endif
return flt_cmp(i1 - f2); return flt_cmp(i1 - f2);
@ -636,8 +637,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f1 = FloatOfTerm(t1); Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f1)) { if (isnan(f1)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, "trying to evaluate nan" );
LOCAL_ErrorMessage = "trying to evaluate nan";
} }
#endif #endif
t2 = Yap_Eval(t2); t2 = Yap_Eval(t2);
@ -653,9 +653,8 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" );
LOCAL_ErrorMessage = "trying to evaluate nan"; }
}
#endif #endif
return flt_cmp(f1 - f2); return flt_cmp(f1 - f2);
#ifdef USE_GMP #ifdef USE_GMP
@ -676,8 +675,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" );
LOCAL_ErrorMessage = "trying to evaluate nan";
} }
#endif #endif
return Yap_gmp_cmp_big_float(t1, f2); return Yap_gmp_cmp_big_float(t1, f2);
@ -744,7 +742,6 @@ static Int a_eq(Term t1, Term t2) {
} }
} }
out = a_cmp(t1, t2 PASS_REGS); out = a_cmp(t1, t2 PASS_REGS);
Yap_Error(LOCAL_Error_TYPE, t1, LOCAL_ErrorMessage);
return out == 0; return out == 0;
} }

16
C/compiler.c
View File

@ -1080,10 +1080,8 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal,
} else { } else {
char s[32]; char s[32];
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
Yap_bip_name(Op, s); Yap_bip_name(Op, s);
sprintf(LOCAL_ErrorMessage, "compiling %s/2 with output bound", s); Yap_ThrowError( TYPE_ERROR_NUMBER, t2, "compiling %s/2 with output bound", s);
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch, 1); siglongjmp(cglobs->cint.CompilerBotch, 1);
} }
@ -1094,9 +1092,8 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal,
if (IsNewVar(t2)) { if (IsNewVar(t2)) {
char s[32]; char s[32];
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
Yap_bip_name(Op, s); Yap_bip_name(Op, s);
sprintf(LOCAL_ErrorMessage, "compiling %s/3", s); Yap_ThrowError(INSTANTIATION_ERROR , t2, "compiling %s/3", s);
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch, 1); siglongjmp(cglobs->cint.CompilerBotch, 1);
} }
@ -1107,10 +1104,7 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal,
if (!IsIntegerTerm(t2)) { if (!IsIntegerTerm(t2)) {
char s[32]; char s[32];
Yap_ThrowError( TYPE_ERROR_INTEGER, t2, "compiling functor/3");
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
Yap_bip_name(Op, s);
sprintf(LOCAL_ErrorMessage, "compiling functor/3");
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch, 1); siglongjmp(cglobs->cint.CompilerBotch, 1);
} }
@ -1118,9 +1112,7 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal,
if (i2 < 0) { if (i2 < 0) {
char s[32]; char s[32];
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO , t2, "compiling functor/3");
Yap_bip_name(Op, s);
sprintf(LOCAL_ErrorMessage, "compiling functor/3");
save_machine_regs(); save_machine_regs();
siglongjmp(cglobs->cint.CompilerBotch, 1); siglongjmp(cglobs->cint.CompilerBotch, 1);
} }

21
C/errors.c
View File

@ -310,6 +310,27 @@ yap_error_descriptor_t *Yap_popErrorContext(void) {
return new_error; return new_error;
} }
void Yap_ThrowError__(const char *file, const char *function, int lineno,
yap_error_number type, Term where, ...) {
va_list ap;
char tmpbuf[MAXPATHLEN];
va_start(ap, where);
char *format = va_arg(ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap);
#else
(void)vsprintf(tnpbuf, format, ap);
#endif
// fprintf(stderr, "warning: ");
Yap_Error__(file, function, lineno, type, where, tmpbuf);
} else {
Yap_Error__(file, function, lineno, type, where);
}
siglongjmp(LOCAL_RestartEnv, 2);
}
/** /**
* @brief Yap_Error * @brief Yap_Error
* This function handles errors in the C code. Check errors.yap for the * This function handles errors in the C code. Check errors.yap for the

1
C/exec.c
View File

@ -2229,6 +2229,7 @@ bool Yap_ResetException(int wid) {
Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm); Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm);
} }
REMOTE_ActiveError(wid)->errorTerm = NULL; REMOTE_ActiveError(wid)->errorTerm = NULL;
REMOTE_ActiveError(wid)->errorTerm = NULL;
return true; return true;
} }

2
C/grow.c
View File

@ -749,9 +749,7 @@ 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 BQString_tok: case BQString_tok:
case WBQString_tok:
if (IsOldTrail(tks->TokInfo)) if (IsOldTrail(tks->TokInfo))
tks->TokInfo = TrailAdjust(tks->TokInfo); tks->TokInfo = TrailAdjust(tks->TokInfo);
break; break;

100
C/parser.c
View File

@ -173,12 +173,15 @@ const char *Yap_tokRep(void *tokptr, encoding_t enc);
static void syntax_msg(const char *msg, ...) { static void syntax_msg(const char *msg, ...) {
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
if (!LOCAL_ErrorMessage ||
if (LOCAL_toktide == LOCAL_tokptr) { (LOCAL_Error_TYPE == SYNTAX_ERROR &&
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1); LOCAL_ActiveError->prologParserLine < LOCAL_tokptr->TokPos)) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(1024 + 1);
}
LOCAL_ActiveError->prologParserLine = LOCAL_tokptr->TokPos;
va_start(ap, msg); va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX, msg, ap); vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap); va_end(ap);
} }
} }
@ -224,22 +227,18 @@ static void syntax_msg(const char *msg, ...) {
#define FAIL siglongjmp(FailBuff->JmpBuff, 1) #define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry * VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table
Yap_LookupVar(const char *var) /* lookup variable in variables table * */
* */
{ {
CACHE_REGS CACHE_REGS
VarEntry *p; VarEntry *p;
int32_t ch; Atom vat = Yap_LookupAtom(var);
const unsigned char *v1 = var;
#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') {
v1 = v1 + get_utf8(v1, 1, &ch);
if (ch != '_' || v1[0] != '\0') {
VarEntry **op = &LOCAL_VarTable; VarEntry **op = &LOCAL_VarTable;
UInt hv; UInt hv;
@ -249,7 +248,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table
CELL hpv = p->hv; CELL hpv = p->hv;
if (hv == hpv) { if (hv == hpv) {
Int scmp; Int scmp;
if ((scmp = strcmp(var, p->VarRep)) == 0) { if ((scmp = strcmp(var, RepAtom(p->VarRep)->StrOfAE)) == 0) {
p->refs++; p->refs++;
return (p); return (p);
} else if (scmp < 0) { } else if (scmp < 0) {
@ -267,22 +266,21 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table
p = p->VarRight; p = p->VarRight;
} }
} }
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + 1+ sizeof(VarEntry)); p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry));
*op = p; *op = p;
p->VarLeft = p->VarRight = NULL; p->VarLeft = p->VarRight = NULL;
p->hv = hv; p->hv = hv;
p->refs = 1L; p->refs = 1L;
strcpy(p->VarRep, var); p->VarRep = vat;
} else { } else {
/* anon var */ /* anon var */
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 3); p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry));
p->VarLeft = LOCAL_AnonVarTable; p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p; LOCAL_AnonVarTable = p;
p->VarRight = NULL; p->VarRight = NULL;
p->refs = 0L; p->refs = 0L;
p->hv = 1L; p->hv = 1L;
p->VarRep[0] = '_'; p->VarRep = vat;
p->VarRep[1] = '\0';
} }
p->VarAdr = TermNil; p->VarAdr = TermNil;
return (p); return (p);
@ -290,11 +288,11 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table
static Term VarNames(VarEntry *p, Term l USES_REGS) { static Term VarNames(VarEntry *p, Term l USES_REGS) {
if (p != NULL) { if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) { if (strcmp(RepAtom(p->VarRep)->StrOfAE, "_") != 0) {
Term t[2]; Term t[2];
Term o; Term o;
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); t[0] = MkAtomTerm(p->VarRep);
if (!IsVarTerm(p->VarAdr)) if (!IsVarTerm(p->VarAdr))
p->VarAdr = MkVarTerm(); p->VarAdr = MkVarTerm();
t[1] = p->VarAdr; t[1] = p->VarAdr;
@ -321,11 +319,11 @@ Term Yap_VarNames(VarEntry *p, Term l) {
static Term Singletons(VarEntry *p, Term l USES_REGS) { static Term Singletons(VarEntry *p, Term l USES_REGS) {
if (p != NULL) { if (p != NULL) {
if (p->VarRep[0] != '_' && p->refs == 1) { if (RepAtom(p->VarRep)->StrOfAE[0] != '_' && p->refs == 1) {
Term t[2]; Term t[2];
Term o; Term o;
t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); t[0] = MkAtomTerm(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, o = MkPairTerm(o,
@ -404,10 +402,10 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr,
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS); OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
if (!opp) if (!opp)
return FALSE; return false;
if (opp->OpModule && opp->OpModule != cmod) { if (opp->OpModule && opp->OpModule != cmod) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
return FALSE; return false;
} }
if ((p = opp->Infix) != 0) { if ((p = opp->Infix) != 0) {
READ_UNLOCK(opp->OpRWLock); READ_UNLOCK(opp->OpRWLock);
@ -614,7 +612,8 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
} }
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));
int i;
Term tf[2], tl = TermNil; Term tf[2], tl = TermNil;
tf[1] = ArgOfTerm(1, t); tf[1] = ArgOfTerm(1, t);
@ -791,7 +790,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
case '{': case '{':
NextToken; NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok && if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == TermEndSquareBracket) { (int)LOCAL_tokptr->TokInfo == TermEndCurlyBracket) {
t = MkAtomTerm(AtomBraces); t = MkAtomTerm(AtomBraces);
NextToken; NextToken;
break; break;
@ -803,7 +802,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos); syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
FAIL; FAIL;
} }
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS); checkfor(TermEndCurlyBracket, FailBuff, enc PASS_REGS);
break; break;
default: default:
syntax_msg("line %d: unexpected ponctuation signal %s", syntax_msg("line %d: unexpected ponctuation signal %s",
@ -905,15 +904,16 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
/* main loop to parse infix and posfix operators starts here */ /* main loop to parse infix and posfix operators starts here */
while (true) { while (true) {
Atom name;
if (LOCAL_tokptr->Tok == Ord(Name_tok) && if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp(AtomOfTerm(LOCAL_tokptr->TokInfo))) { Yap_HasOp((name = AtomOfTerm(LOCAL_tokptr->TokInfo)))) {
Atom save_opinfo = opinfo = AtomOfTerm(LOCAL_tokptr->TokInfo); Atom save_opinfo = opinfo = name;
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) && if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod 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(AtomOfTerm(LOCAL_tokptr->TokInfo), 2); func = Yap_MkFunctor(save_opinfo, 2);
if (func == NULL) { if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos); syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
FAIL; FAIL;
@ -954,7 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
break; break;
} }
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (LOCAL_tokptr->TokInfo == TermDot && prio >= 1000 && curprio <= 999) { if (LOCAL_tokptr->TokInfo == TermComma && prio >= 1000 && curprio <= 999) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
@ -1001,17 +1001,17 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
curprio = opprio; curprio = opprio;
continue; continue;
} else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket && } else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio, IsPosfixOp(AtomBraces, &opprio, &oplprio,
cmod PASS_REGS) && cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) { opprio <= prio && oplprio >= curprio) {
t = ParseArgs(AtomEmptyCurlyBrackets, TermEndCurlyBracket, FailBuff, t, t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t,
enc, cmod PASS_REGS); enc, cmod PASS_REGS);
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); t = MakeAccessor(t, FunctorBraces PASS_REGS);
curprio = opprio; curprio = opprio;
continue; continue;
} }
} }
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) { if (LOCAL_tokptr->Tok <= Ord(String_tok)) {
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos, syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos,
Yap_tokRep(LOCAL_tokptr, enc)); Yap_tokRep(LOCAL_tokptr, enc));
FAIL; FAIL;
@ -1026,6 +1026,7 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
Volatile Term t; Volatile Term t;
JMPBUFF FailBuff; JMPBUFF FailBuff;
yhandle_t sls = Yap_StartSlots(); yhandle_t sls = Yap_StartSlots();
LOCAL_toktide = LOCAL_tokptr;
if (!sigsetjmp(FailBuff.JmpBuff, 0)) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
@ -1042,22 +1043,19 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
} }
#endif #endif
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_ErrorMessage = "term does not end on . ";
t = 0;
}
if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_ErrorMessage = NULL;
}
// if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L);
return t;
} }
Yap_CloseSlots(sls); if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
return (0); LOCAL_ErrorMessage = "term does not end on . ";
t = 0;
}
if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_ErrorMessage = NULL;
}
// if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L);
return t;
} }
//! @} //! @}

17
C/scanner.c
View File

@ -1202,7 +1202,8 @@ Term Yap_scan_num(StreamDesc *inp) {
ef->TokNext = NULL; ef->TokNext = NULL;
LOCAL_tokptr = tokptr; LOCAL_tokptr = tokptr;
LOCAL_toktide = e; LOCAL_toktide = e;
LOCAL_ErrorMessage = Yap_syntax_error(e, inp - GLOBAL_Stream); Yap_JumpToEnv(
Yap_syntax_error(e, inp - GLOBAL_Stream) );
LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_TYPE = SYNTAX_ERROR;
} }
} }
@ -1237,21 +1238,18 @@ const char *Yap_tokRep(void *tokptre, encoding_t encoding) {
case Ponctuation_tok: case Ponctuation_tok:
case String_tok: case String_tok:
case BQString_tok: case BQString_tok:
case WString_tok:
case WBQString_tok: {
return Yap_TermToString(info, &length, encoding, flags); return Yap_TermToString(info, &length, encoding, flags);
} case Var_tok:
case Var_tok: { {
VarEntry *varinfo = (VarEntry *)info; VarEntry *varinfo = (VarEntry *)info;
varinfo->VarAdr = TermNil; varinfo->VarAdr = TermNil;
return varinfo->VarRep; return RepAtom(varinfo->VarRep)->StrOfAE;
} }
case Error_tok: case Error_tok:
return "<ERR>"; return "<ERR>";
case eot_tok: case eot_tok:
return "<EOT>"; return "<EOT>";
case QuasiQuotes_tok: case QuasiQuotes_tok:
case WQuasiQuotes_tok:
return "<QQ>"; return "<QQ>";
} }
} }
@ -1445,7 +1443,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
} }
t->Tok = Ord(kind = Var_tok); t->Tok = Ord(kind = Var_tok);
} }
} break; } break;
case NU: { case NU: {
@ -1923,7 +1921,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
qq->end.byteno = fseek(inp_stream->file, 0, 0); qq->end.byteno = fseek(inp_stream->file, 0, 0);
} else { } else {
qq->end.byteno = inp_stream->charcount - 1; qq->end.byteno = inp_stream->charcount - 1;
} }
qq->end.lineno = inp_stream->linecount; qq->end.lineno = inp_stream->linecount;
qq->end.linepos = inp_stream->linepos - 1; qq->end.linepos = inp_stream->linepos - 1;
qq->end.charno = inp_stream->charcount - 1; qq->end.charno = inp_stream->charcount - 1;
@ -1977,7 +1975,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
return (l); return (l);
} }
int vsc_count;
void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
VarEntry *anonvartable) { VarEntry *anonvartable) {

54
C/text.c
View File

@ -52,19 +52,16 @@ typedef struct TextBuffer_manager {
} text_buffer_t; } text_buffer_t;
int push_text_stack(USES_REGS1) { int push_text_stack(USES_REGS1) {
printf("push %d\n", LOCAL_TextBuffer->lvl);
return LOCAL_TextBuffer->lvl++; return LOCAL_TextBuffer->lvl++;
} }
int pop_text_stack(int i) { int pop_text_stack(int i) {
printf("pop %d\n", i);
int lvl = LOCAL_TextBuffer->lvl; int lvl = LOCAL_TextBuffer->lvl;
while (lvl > i) { while (lvl > i) {
struct mblock *p = LOCAL_TextBuffer->first[lvl]; struct mblock *p = LOCAL_TextBuffer->first[lvl];
while (p) { while (p) {
struct mblock *np = p->next; struct mblock *np = p->next;
free(p); free(p);
printf("----------> %p free\n", p);
p = np; p = np;
} }
LOCAL_TextBuffer->first[lvl] = NULL; LOCAL_TextBuffer->first[lvl] = NULL;
@ -95,7 +92,6 @@ void *Malloc(size_t sz USES_REGS) {
o->next = NULL; o->next = NULL;
o->sz = sz; o->sz = sz;
o->lvl = lvl; o->lvl = lvl;
printf("%p malloc %d\n", o, sz);
return o + 1; return o + 1;
} }
@ -115,7 +111,6 @@ void *Realloc(void *pt, size_t sz USES_REGS) {
if (LOCAL_TextBuffer->last[lvl] == old) { if (LOCAL_TextBuffer->last[lvl] == old) {
LOCAL_TextBuffer->last[lvl] = o; LOCAL_TextBuffer->last[lvl] = o;
} }
printf("%p realloc %ld\n", o, sz);
return o + 1; return o + 1;
} }
@ -136,7 +131,6 @@ void Free(void *pt USES_REGS) {
LOCAL_TextBuffer->last[lvl] = o->prev; LOCAL_TextBuffer->last[lvl] = o->prev;
} }
free(o); free(o);
printf("%p free\n", o);
} }
void *Yap_InitTextAllocator(void) { void *Yap_InitTextAllocator(void) {
@ -392,7 +386,7 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t); Atom at = AtomOfTerm(inp->val.t);
inp->val.uc = at->UStrOfAE; return at->UStrOfAE;
} }
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
@ -636,7 +630,7 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) { static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
unsigned char *s = s0; unsigned char *s = s0;
int32_t ch; int32_t ch;
if (strlen_utf8(s0) <= leng) { if (!leng || strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0); return Yap_LookupAtom(s0);
} else { } else {
size_t n = get_utf8(s, 1, &ch); size_t n = get_utf8(s, 1, &ch);
@ -729,15 +723,17 @@ static Term write_number(unsigned char *s, seq_tv_t *out, int size USES_REGS) {
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) { static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
Term o; Term o;
int i = push_text_stack();
o = out->val.t = o = out->val.t =
Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, NULL); Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, NULL);
pop_text_stack(i);
return o; return o;
} }
bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
/* we know what the term is */ /* we know what the term is */
if (out->type == 0) {
return true;
}
if (out->type & YAP_STRING_TERM) { if (out->type & YAP_STRING_TERM) {
if ((out->val.t = string_to_term(inp, out, leng PASS_REGS)) != 0L) if ((out->val.t = string_to_term(inp, out, leng PASS_REGS)) != 0L)
return out->val.t != 0; return out->val.t != 0;
@ -753,7 +749,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
return false; return false;
} }
if (out->type & (YAP_STRING_ATOM)) { if (out->type & (YAP_STRING_ATOM)) {
if (write_atom(inp, out, leng PASS_REGS) != NIL) { if ((out->val.a = write_atom(inp, out, leng PASS_REGS)) != NIL) {
Atom at = out->val.a; Atom at = out->val.a;
if (at && (out->type & YAP_STRING_OUTPUT_TERM)) if (at && (out->type & YAP_STRING_OUTPUT_TERM))
out->val.t = MkAtomTerm(at); out->val.t = MkAtomTerm(at);
@ -797,7 +793,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
out->val.t = write_number(inp, out, leng PASS_REGS); out->val.t = write_number(inp, out, leng PASS_REGS);
// Yap_DebugPlWriteln(out->val.t); // Yap_DebugPlWriteln(out->val.t);
return out->val.t != 0; return out->val.t != 0;
default: {} default: { return true ; }
} }
return false; return false;
} }
@ -833,7 +829,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
bool rc; bool rc;
size_t leng; size_t leng;
int l = push_text_stack(PASS_REGS1);
/* /*
f//printfmark(stderr, "[ %d ", n++) ; f//printfmark(stderr, "[ %d ", n++) ;
if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES
@ -858,26 +853,22 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
} }
if (!buf) { if (!buf) {
pop_text_stack( l);
return 0L; return 0L;
} }
if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) { if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
if (out->type & YAP_STRING_UPCASE) { if (out->type & YAP_STRING_UPCASE) {
if (!upcase(buf, out)) { if (!upcase(buf, out)) {
pop_text_stack( l);
return false; return false;
} }
} }
if (out->type & YAP_STRING_DOWNCASE) { if (out->type & YAP_STRING_DOWNCASE) {
if (!downcase(buf, out)) { if (!downcase(buf, out)) {
pop_text_stack( l);
return false; return false;
} }
} }
} }
rc = write_Text(buf, out, leng PASS_REGS); rc = write_Text(buf, out, leng PASS_REGS);
pop_text_stack(l);
/* fprintf(stderr, " -> "); /* fprintf(stderr, " -> ");
if (!rc) fprintf(stderr, "NULL"); if (!rc) fprintf(stderr, "NULL");
else if (out->type & else if (out->type &
@ -919,9 +910,7 @@ static unsigned char *concat(int n, unsigned char *sv[] USES_REGS) {
buf = Malloc(room + 1); buf = Malloc(room + 1);
buf0 = (unsigned char *)buf; buf0 = (unsigned char *)buf;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
char *s = (char *)sv[i]; buf = stpcpy(buf, sv[i]);
buf = strcpy(buf, s);
buf += strlen(s);
} }
return buf0; return buf0;
} }
@ -945,12 +934,11 @@ static void *slice(size_t min, size_t max, unsigned char *buf USES_REGS) {
bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
unsigned char **bufv; unsigned char **bufv;
unsigned char *buf; unsigned char *buf;
size_t leng;
int i; int i;
int l = push_text_stack(PASS_REGS1); size_t leng;
bufv = Malloc(tot * sizeof(unsigned char *)); bufv = Malloc(tot * sizeof(unsigned char *));
if (!bufv) { if (!bufv) {
pop_text_stack( l);
return NULL; return NULL;
} }
for (i = 0; i < tot; i++) { for (i = 0; i < tot; i++) {
@ -958,14 +946,12 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
unsigned char *nbuf = Yap_readText(inp + i, &leng PASS_REGS); unsigned char *nbuf = Yap_readText(inp + i, &leng PASS_REGS);
if (!nbuf) { if (!nbuf) {
pop_text_stack( l);
return NULL; return NULL;
} }
bufv[i] = nbuf; bufv[i] = nbuf;
} }
buf = concat(tot, bufv PASS_REGS); buf = concat(tot, bufv PASS_REGS);
bool rc = write_Text(buf, out, leng PASS_REGS); bool rc = write_Text(buf, out, 0 PASS_REGS);
pop_text_stack(l);
return rc; return rc;
} }
@ -973,14 +959,11 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
seq_tv_t outv[] USES_REGS) { seq_tv_t outv[] USES_REGS) {
unsigned char *buf; unsigned char *buf;
int lvl = push_text_stack(PASS_REGS1);
size_t l; size_t l;
inp->type |= YAP_STRING_IN_TMP; inp->type |= YAP_STRING_IN_TMP;
buf = Yap_readText(inp, &l PASS_REGS); buf = Yap_readText(inp, &l PASS_REGS);
if (!buf) { if (!buf) {
pop_text_stack( l);
return false; return false;
} }
if (!cuts) { if (!cuts) {
@ -991,11 +974,9 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
if (outv[0].val.t) { if (outv[0].val.t) {
buf0 = Yap_readText(outv, &l0 PASS_REGS); buf0 = Yap_readText(outv, &l0 PASS_REGS);
if (!buf0) { if (!buf0) {
pop_text_stack( l);
return false; return false;
} }
if (cmp_Text(buf, buf0, l0) != 0) { if (cmp_Text(buf, buf0, l0) != 0) {
pop_text_stack( l);
return false; return false;
} }
l1 = l - l0; l1 = l - l0;
@ -1003,26 +984,21 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
buf1 = slice(l0, l, buf PASS_REGS); buf1 = slice(l0, l, buf PASS_REGS);
bool rc = write_Text(buf1, outv + 1, l1 PASS_REGS); bool rc = write_Text(buf1, outv + 1, l1 PASS_REGS);
if (!rc) { if (!rc) {
pop_text_stack( l);
return false; return false;
} }
pop_text_stack(lvl);
return rc; return rc;
} else /* if (outv[1].val.t) */ { } else /* if (outv[1].val.t) */ {
buf1 = Yap_readText(outv + 1, &l1 PASS_REGS); buf1 = Yap_readText(outv + 1, &l1 PASS_REGS);
if (!buf1) { if (!buf1) {
pop_text_stack( l);
return false; return false;
} }
l0 = l - l1; l0 = l - l1;
if (cmp_Text(skip_utf8((const unsigned char *)buf, l0), buf1, l1) != if (cmp_Text(skip_utf8((const unsigned char *)buf, l0), buf1, l1) !=
0) { 0) {
pop_text_stack( l);
return false; return false;
} }
buf0 = slice(0, l0, buf PASS_REGS); buf0 = slice(0, l0, buf PASS_REGS);
bool rc = write_Text(buf0, outv, l0 PASS_REGS); bool rc = write_Text(buf0, outv, l0 PASS_REGS);
pop_text_stack((rc ? 0 : lvl));
return rc; return rc;
} }
} }
@ -1033,14 +1009,14 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
next = 0; next = 0;
else else
next = cuts[i - 1]; next = cuts[i - 1];
if (cuts[i] == 0)
break;
void *bufi = slice(next, cuts[i], buf PASS_REGS); void *bufi = slice(next, cuts[i], buf PASS_REGS);
if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) { if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) {
pop_text_stack( l);
return false; return false;
} }
} }
pop_text_stack(l);
return true; return true;
} }

6
C/write.c
View File

@ -1012,7 +1012,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} }
} else if (!wglb->Ignore_ops && } else if (!wglb->Ignore_ops &&
(Arity == 1 || (Arity == 1 ||
((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || ((atom == AtomEmptyBrackets || atom == AtomCurly ||
atom == AtomEmptySquareBrackets) && atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) && Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp)) { Yap_IsPosfixOp(atom, &op, &lp)) {
@ -1047,7 +1047,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc('(', wglb->stream); wrputc('(', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) { } else if (atom == AtomEmptySquareBrackets) {
wrputc('[', wglb->stream); wrputc('[', wglb->stream);
} else if (atom == AtomEmptyCurlyBrackets) { } else if (atom == AtomCurly) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
} }
lastw = separator; lastw = separator;
@ -1056,7 +1056,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc(')', wglb->stream); wrputc(')', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) { } else if (atom == AtomEmptySquareBrackets) {
wrputc(']', wglb->stream); wrputc(']', wglb->stream);
} else if (atom == AtomEmptyCurlyBrackets) { } else if (atom == AtomCurly) {
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
} }
lastw = separator; lastw = separator;

8
CXX/yapa.hh
View File

@ -23,8 +23,6 @@ enum PropTag {
MUTEX_TAG = MutexProperty, // 0xFFF6, MUTEX_TAG = MutexProperty, // 0xFFF6,
/// A typed array, may be in-db or in-stack deped /// A typed array, may be in-db or in-stack deped
ARRAY_TAG = ArrayProperty, // 0xFFF7, ARRAY_TAG = ArrayProperty, // 0xFFF7,
/// atom does not fit ISO-LATIN-1
WIDE_TAG = WideAtomProperty, // 0xFFF8,
/// module /// module
MODULE_TAG = ModProperty, // 0xFFFA, MODULE_TAG = ModProperty, // 0xFFFA,
/// the original SICStus blackboard /// the original SICStus blackboard
@ -59,14 +57,12 @@ class YAPAtom {
/// construct new YAPAtom from Atom /// construct new YAPAtom from Atom
YAPAtom( Atom at ) { a = at; } YAPAtom( Atom at ) { a = at; }
public: public:
/// construct new YAPAtom from string /// construct new YAPAtom from UTF-8 string
YAPAtom( const char * s) { a = Yap_LookupAtom( s ); } YAPAtom( const char * s) { a = Yap_LookupAtom( s ); }
/// construct new YAPAtom from wide string /// construct new YAPAtom from wide string
YAPAtom( const wchar_t * s) { a = Yap_LookupMaybeWideAtom( s ); } //YAPAtom( const wchar_t * s) { a = Yap_LookupMaybeWideAtom( s ); }
/// construct new YAPAtom from max-length string /// construct new YAPAtom from max-length string
YAPAtom( const char * s, size_t len) { a = Yap_LookupAtomWithLength( s, len ); } YAPAtom( const char * s, size_t len) { a = Yap_LookupAtomWithLength( s, len ); }
/// construct new YAPAtom from max-length wide string
YAPAtom( const wchar_t * s, size_t len) { a = Yap_LookupMaybeWideAtomWithLength( s, len ); }
/// get name of atom /// get name of atom
const char *getName(void); const char *getName(void);
/// get name of (other way) /// get name of (other way)

2
H/ATOMS
View File

@ -37,7 +37,6 @@ A BeginCurlyBracket N "{"
A EndCurlyBracket N "}" A EndCurlyBracket N "}"
A EmptyBrackets N "()" A EmptyBrackets N "()"
A EmptySquareBrackets N "[]" A EmptySquareBrackets N "[]"
A EmptyCurlyBrackets N "{}"
A Asserta N "asserta" A Asserta N "asserta"
A AssertaStatic N "asserta_static" A AssertaStatic N "asserta_static"
A Assertz N "assertz" A Assertz N "assertz"
@ -498,7 +497,6 @@ F Dot8 Dot 8
F Dot9 Dot 9 F Dot9 Dot 9
F DoubleSlash DoubleSlash 2 F DoubleSlash DoubleSlash 2
F EmptySquareBrackets EmptySquareBrackets 2 F EmptySquareBrackets EmptySquareBrackets 2
F EmptyCurlyBrackets EmptyCurlyBrackets 2
F Eq Eq 2 F Eq Eq 2
F Error Error 2 F Error Error 2
F EvaluationError EvaluationError 1 F EvaluationError EvaluationError 1

5
H/ScannerTypes.h
View File

@ -3,13 +3,10 @@ typedef enum TokenKinds {
Number_tok, Number_tok,
Var_tok, Var_tok,
String_tok, String_tok,
WString_tok,
BQString_tok, BQString_tok,
WBQString_tok,
Ponctuation_tok, Ponctuation_tok,
Error_tok, Error_tok,
QuasiQuotes_tok, QuasiQuotes_tok,
WQuasiQuotes_tok,
eot_tok eot_tok
} tkinds; } tkinds;
@ -29,5 +26,5 @@ typedef struct VARSTRUCT {
CELL hv; CELL hv;
UInt refs; UInt refs;
struct VARSTRUCT *VarLeft, *VarRight; struct VARSTRUCT *VarLeft, *VarRight;
char VarRep[1]; Atom VarRep;
} VarEntry; } VarEntry;

2
H/YapGFlagInfo.h
View File

@ -524,7 +524,7 @@ and _Patch_ is the patch number.
*/ */
YAP_FLAG(VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION, YAP_FLAG(VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION,
NULL), /**< NULL), /**<
`version ` Read-only flag that returns an a compound term with the `version ` Read-only flag that returns a compound term with the
current version of YAP. The term will have the name `yap` and arity 4, the first current version of YAP. The term will have the name `yap` and arity 4, the first
argument will be the argument will be the
major version, the second the minor version, the third the patch number, and the major version, the second the minor version, the third the patch number, and the

2
H/YapText.h
View File

@ -190,7 +190,7 @@ inline static utf8proc_ssize_t strlen_utf8(const utf8proc_uint8_t *pt) {
return rc; return rc;
else if (b > 0) { else if (b > 0) {
pt += l; pt += l;
rc += l; rc ++;
} else { } else {
pt++; pt++;
} }

2
H/generated/iatoms.h
View File

@ -32,7 +32,6 @@
AtomEndCurlyBracket = Yap_LookupAtom("}"); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket); AtomEndCurlyBracket = Yap_LookupAtom("}"); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket);
AtomEmptyBrackets = Yap_LookupAtom("()"); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets); AtomEmptyBrackets = Yap_LookupAtom("()"); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets);
AtomEmptySquareBrackets = Yap_LookupAtom("[]"); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets); AtomEmptySquareBrackets = Yap_LookupAtom("[]"); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets);
AtomEmptyCurlyBrackets = Yap_LookupAtom("{}"); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
AtomAsserta = Yap_LookupAtom("asserta"); TermAsserta = MkAtomTerm(AtomAsserta); AtomAsserta = Yap_LookupAtom("asserta"); TermAsserta = MkAtomTerm(AtomAsserta);
AtomAssertaStatic = Yap_LookupAtom("asserta_static"); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic); AtomAssertaStatic = Yap_LookupAtom("asserta_static"); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic);
AtomAssertz = Yap_LookupAtom("assertz"); TermAssertz = MkAtomTerm(AtomAssertz); AtomAssertz = Yap_LookupAtom("assertz"); TermAssertz = MkAtomTerm(AtomAssertz);
@ -493,7 +492,6 @@
FunctorDot9 = Yap_MkFunctor(AtomDot,9); FunctorDot9 = Yap_MkFunctor(AtomDot,9);
FunctorDoubleSlash = Yap_MkFunctor(AtomDoubleSlash,2); FunctorDoubleSlash = Yap_MkFunctor(AtomDoubleSlash,2);
FunctorEmptySquareBrackets = Yap_MkFunctor(AtomEmptySquareBrackets,2); FunctorEmptySquareBrackets = Yap_MkFunctor(AtomEmptySquareBrackets,2);
FunctorEmptyCurlyBrackets = Yap_MkFunctor(AtomEmptyCurlyBrackets,2);
FunctorEq = Yap_MkFunctor(AtomEq,2); FunctorEq = Yap_MkFunctor(AtomEq,2);
FunctorError = Yap_MkFunctor(AtomError,2); FunctorError = Yap_MkFunctor(AtomError,2);
FunctorEvaluationError = Yap_MkFunctor(AtomEvaluationError,1); FunctorEvaluationError = Yap_MkFunctor(AtomEvaluationError,1);

2
H/generated/ratoms.h
View File

@ -32,7 +32,6 @@
AtomEndCurlyBracket = AtomAdjust(AtomEndCurlyBracket); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket); AtomEndCurlyBracket = AtomAdjust(AtomEndCurlyBracket); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket);
AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets); AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets);
AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets); AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets);
AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
AtomAsserta = AtomAdjust(AtomAsserta); TermAsserta = MkAtomTerm(AtomAsserta); AtomAsserta = AtomAdjust(AtomAsserta); TermAsserta = MkAtomTerm(AtomAsserta);
AtomAssertaStatic = AtomAdjust(AtomAssertaStatic); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic); AtomAssertaStatic = AtomAdjust(AtomAssertaStatic); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic);
AtomAssertz = AtomAdjust(AtomAssertz); TermAssertz = MkAtomTerm(AtomAssertz); AtomAssertz = AtomAdjust(AtomAssertz); TermAssertz = MkAtomTerm(AtomAssertz);
@ -493,7 +492,6 @@
FunctorDot9 = FuncAdjust(FunctorDot9); FunctorDot9 = FuncAdjust(FunctorDot9);
FunctorDoubleSlash = FuncAdjust(FunctorDoubleSlash); FunctorDoubleSlash = FuncAdjust(FunctorDoubleSlash);
FunctorEmptySquareBrackets = FuncAdjust(FunctorEmptySquareBrackets); FunctorEmptySquareBrackets = FuncAdjust(FunctorEmptySquareBrackets);
FunctorEmptyCurlyBrackets = FuncAdjust(FunctorEmptyCurlyBrackets);
FunctorEq = FuncAdjust(FunctorEq); FunctorEq = FuncAdjust(FunctorEq);
FunctorError = FuncAdjust(FunctorError); FunctorError = FuncAdjust(FunctorError);
FunctorEvaluationError = FuncAdjust(FunctorEvaluationError); FunctorEvaluationError = FuncAdjust(FunctorEvaluationError);

3
H/generated/tatoms.h
View File

@ -32,7 +32,6 @@ EXTERNAL Atom AtomBeginCurlyBracket; EXTERNAL Term TermBeginCurlyBracket;
EXTERNAL Atom AtomEndCurlyBracket; EXTERNAL Term TermEndCurlyBracket; EXTERNAL Atom AtomEndCurlyBracket; EXTERNAL Term TermEndCurlyBracket;
EXTERNAL Atom AtomEmptyBrackets; EXTERNAL Term TermEmptyBrackets; EXTERNAL Atom AtomEmptyBrackets; EXTERNAL Term TermEmptyBrackets;
EXTERNAL Atom AtomEmptySquareBrackets; EXTERNAL Term TermEmptySquareBrackets; EXTERNAL Atom AtomEmptySquareBrackets; EXTERNAL Term TermEmptySquareBrackets;
EXTERNAL Atom AtomEmptyCurlyBrackets; EXTERNAL Term TermEmptyCurlyBrackets;
EXTERNAL Atom AtomAsserta; EXTERNAL Term TermAsserta; EXTERNAL Atom AtomAsserta; EXTERNAL Term TermAsserta;
EXTERNAL Atom AtomAssertaStatic; EXTERNAL Term TermAssertaStatic; EXTERNAL Atom AtomAssertaStatic; EXTERNAL Term TermAssertaStatic;
EXTERNAL Atom AtomAssertz; EXTERNAL Term TermAssertz; EXTERNAL Atom AtomAssertz; EXTERNAL Term TermAssertz;
@ -549,8 +548,6 @@ EXTERNAL Functor FunctorDoubleSlash;
EXTERNAL Functor FunctorEmptySquareBrackets; EXTERNAL Functor FunctorEmptySquareBrackets;
EXTERNAL Functor FunctorEmptyCurlyBrackets;
EXTERNAL Functor FunctorEq; EXTERNAL Functor FunctorEq;
EXTERNAL Functor FunctorError; EXTERNAL Functor FunctorError;

9
include/YapError.h
View File

@ -41,11 +41,18 @@
struct yami *Yap_Error__(const char *file, const char *function, int lineno, struct yami *Yap_Error__(const char *file, const char *function, int lineno,
yap_error_number err, YAP_Term wheret, ...); yap_error_number err, YAP_Term wheret, ...);
void Yap_ThrowError__(const char *file, const char *function, int lineno,
yap_error_number err, YAP_Term wheret, ...);
#define Yap_NilError(id, ...) \ #define Yap_NilError(id, ...) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
#define Yap_Error(id, inp, ...) \ #define Yap_Error(id, inp, ...) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__)
#define Yap_ThrowError(id, inp, ...) \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__)
#ifdef YAP_TERM_H #ifdef YAP_TERM_H
/** /**

2
os/iopreds.c
View File

@ -1869,7 +1869,7 @@ void Yap_InitIOPreds(void) {
Yap_InitReadTPreds(); Yap_InitReadTPreds();
Yap_InitFormat(); Yap_InitFormat();
Yap_InitRandomPreds(); Yap_InitRandomPreds();
#if USE_READLINE #if USE_READLINE
Yap_InitReadlinePreds(); Yap_InitReadlinePreds();
#endif #endif
Yap_InitSockets(); Yap_InitSockets();

2
os/iopreds.h
View File

@ -151,7 +151,7 @@ bool Yap_DoPrompt(StreamDesc *s);
Int Yap_peek(int sno); Int Yap_peek(int sno);
int Yap_MemPeekc(int sno); int Yap_MemPeekc(int sno);
char *Yap_syntax_error(TokEntry *tokptr, int sno); Term Yap_syntax_error(TokEntry *tokptr, int sno);
int console_post_process_read_char(int, StreamDesc *); int console_post_process_read_char(int, StreamDesc *);
int console_post_process_eof(StreamDesc *); int console_post_process_eof(StreamDesc *);

75
os/readterm.c
View File

@ -95,7 +95,7 @@ static char SccsId[] = "%W% %G%";
#define SYSTEM_STAT stat #define SYSTEM_STAT stat
#endif #endif
static char *syntax_error(TokEntry *errtok, int sno, Term cmod); static Term syntax_error(TokEntry *errtok, int sno, Term cmod);
static void clean_vars(VarEntry *p) { static void clean_vars(VarEntry *p) {
if (p == NULL) if (p == NULL)
@ -215,7 +215,7 @@ static const param_t read_defs[] = {READ_DEFS()};
* Implicit arguments: * Implicit arguments:
* + * +
*/ */
static char *syntax_error(TokEntry *errtok, int sno, Term cmod) { static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS CACHE_REGS
Term info; Term info;
Term startline, errline, endline; Term startline, errline, endline;
@ -270,42 +270,21 @@ static char *syntax_error(TokEntry *errtok, int sno, Term cmod) {
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>")); t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break; } break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case Number_tok: case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo)); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &info);
break; break;
case Var_tok: { case Var_tok: {
Term t[2]; Term t[2];
VarEntry *varinfo = (VarEntry *)info; VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break; } break;
case String_tok: { case String_tok: {
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; } break;
case BQString_tok: { case BQString_tok: {
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; } break;
case Error_tok: { case Error_tok: {
ts[0] = MkAtomTerm(AtomError); ts[0] = MkAtomTerm(AtomError);
@ -361,10 +340,10 @@ static char *syntax_error(TokEntry *errtok, int sno, Term cmod) {
Yap_DebugPlWriteln(terr); Yap_DebugPlWriteln(terr);
} }
#endif #endif
return NULL; return terr;
} }
char *Yap_syntax_error(TokEntry *errtok, int sno) { Term Yap_syntax_error(TokEntry *errtok, int sno) {
return syntax_error(errtok, sno, CurrentModule); return syntax_error(errtok, sno, CurrentModule);
} }
@ -798,21 +777,28 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
LOCAL_tokptr = LOCAL_toktide = LOCAL_tokptr = LOCAL_toktide =
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos); Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
if (LOCAL_ErrorMessage) #if DEBUG
return YAP_SCANNING_ERROR; if (GLOBAL_Option[2]) {
if (LOCAL_tokptr->Tok != Ord(eot_tok)) { TokEntry *t = LOCAL_tokptr;
// next step int n = 0;
return YAP_PARSING; while (t) {
fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok),
Yap_tokRep(t, ENC_ISO_UTF8), n++);
t = t->TokNext;
}
} }
if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { #endif
size_t len = strlen("Empty clause"); if (LOCAL_ErrorMessage)
char *out = malloc(len + 1); return YAP_SCANNING_ERROR;
strncpy(out, "Empty clause", len); if (LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_ErrorMessage = out; // next step
LOCAL_Error_TYPE = SYNTAX_ERROR; return YAP_PARSING;
return YAP_PARSING_ERROR; }
} if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) {
return scanEOF(fe, inp_stream); LOCAL_Error_TYPE = SYNTAX_ERROR;
return YAP_PARSING_ERROR;
}
return scanEOF(fe, inp_stream);
} }
static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
@ -1282,13 +1268,15 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
CACHE_REGS CACHE_REGS
Term bvar = MkVarTerm(), ctl; Term bvar = MkVarTerm(), ctl;
yhandle_t sl; yhandle_t sl;
int lvl = push_text_stack();
if (len == 0) { if (len == 0) {
Term rval = TermEof; Term rval = TermEof;
if (rval && bindings) { if (rval && bindings) {
*bindings = TermNil; *bindings = TermNil;
} }
return rval; pop_text_stack(lvl);
return rval;
} }
if (bindings) { if (bindings) {
ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar); ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar);
@ -1307,6 +1295,7 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
if (rval && bindings) { if (rval && bindings) {
*bindings = Yap_PopHandle(sl); *bindings = Yap_PopHandle(sl);
} }
pop_text_stack(lvl);
return rval; return rval;
} }

8
pl/boot.yap
View File

@ -174,7 +174,7 @@ list, since backtracking could not "pass through" the cut.
system_module(_Mod, _SysExps, _Decls). system_module(_Mod, _SysExps, _Decls).
% new_system_module(Mod). % new_system_module(Mod).
use_system_module(_init, _SysExps). use_system_module(Module, _SysExps).
private(_). private(_).
@ -251,6 +251,7 @@ private(_).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1, :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]). '$iso_check_goal'/2]).
'$early_print_message'(Level, Msg) :- '$early_print_message'(Level, Msg) :-
'$pred_exists'(print_message(_,_), prolog), !, '$pred_exists'(print_message(_,_), prolog), !,
print_message( Level, Msg). print_message( Level, Msg).
@ -658,7 +659,7 @@ number of steps.
'$execute_command'(G, VL, Pos, Option, Source) :- '$execute_command'(G, VL, Pos, Option, Source) :-
'$continue_with_command'(Option, VL, Pos, G, Source). '$continue_with_command'(Option, VL, Pos, G, Source).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!, !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
@ -1648,6 +1649,3 @@ log_event( String, Args ) :-
/** /**
@} @}
*/ */

1
pl/grammar.yap
View File

@ -109,7 +109,6 @@ prolog:'$translate_rule'(Rule, (NH :- B) ) :-
), ),
t_tidy(B1, B). t_tidy(B1, B).
t_head(V, _, _, _, _, G0) :- var(V), !, t_head(V, _, _, _, _, G0) :- var(V), !,
'$do_error'(instantiation_error,G0). '$do_error'(instantiation_error,G0).
t_head((H,List), NH, NGs, S, S1, G0) :- !, t_head((H,List), NH, NGs, S, S1, G0) :- !,