Merge ssh://192.168.66.221/~vitor/Yap/yap-6.3
This commit is contained in:
commit
02e0e50915
|
@ -902,7 +902,8 @@ static void undef_goal(USES_REGS1) {
|
||||||
PP = pe;
|
PP = pe;
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag)) {
|
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ||
|
||||||
|
pe == UndefCode) {
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
UNLOCKPE(19, PP);
|
UNLOCKPE(19, PP);
|
||||||
PP = NULL;
|
PP = NULL;
|
||||||
|
|
176
C/adtdefs.c
176
C/adtdefs.c
|
@ -51,17 +51,6 @@ uint64_t HashFunction(const unsigned char *CHP) {
|
||||||
*/
|
*/
|
||||||
}
|
}
|
||||||
|
|
||||||
uint64_t WideHashFunction(wchar_t *CHP) {
|
|
||||||
UInt hash = 5381;
|
|
||||||
|
|
||||||
UInt c;
|
|
||||||
|
|
||||||
while ((c = *CHP++) != '\0') {
|
|
||||||
hash = hash * 33 ^ c;
|
|
||||||
}
|
|
||||||
return hash;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* this routine must be run at least having a read lock on ae */
|
/* this routine must be run at least having a read lock on ae */
|
||||||
static Prop
|
static Prop
|
||||||
GetFunctorProp(AtomEntry *ae,
|
GetFunctorProp(AtomEntry *ae,
|
||||||
|
@ -69,9 +58,8 @@ GetFunctorProp(AtomEntry *ae,
|
||||||
FunctorEntry *pp;
|
FunctorEntry *pp;
|
||||||
|
|
||||||
pp = RepFunctorProp(ae->PropsOfAE);
|
pp = RepFunctorProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) &&
|
while (!EndOfPAEntr(pp) && (pp = RepFunctorProp(pp->NextOfPE)))
|
||||||
(!IsFunctorProperty(pp->KindOfPE) || pp->ArityOfFE != arity))
|
;
|
||||||
pp = RepFunctorProp(pp->NextOfPE);
|
|
||||||
return (AbsFunctorProp(pp));
|
return (AbsFunctorProp(pp));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -153,19 +141,6 @@ static inline Atom SearchAtom(const unsigned char *p, Atom a) {
|
||||||
return (NIL);
|
return (NIL);
|
||||||
}
|
}
|
||||||
|
|
||||||
static inline Atom SearchWideAtom(const wchar_t *p, Atom a) {
|
|
||||||
AtomEntry *ae;
|
|
||||||
|
|
||||||
/* search atom in chain */
|
|
||||||
while (a != NIL) {
|
|
||||||
ae = RepAtom(a);
|
|
||||||
if (wcscmp((wchar_t *)ae->StrOfAE, p) == 0) {
|
|
||||||
return a;
|
|
||||||
}
|
|
||||||
a = ae->NextOfAE;
|
|
||||||
}
|
|
||||||
return (NIL);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Atom
|
static Atom
|
||||||
LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
|
LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
|
||||||
|
@ -227,142 +202,6 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
|
||||||
return na;
|
return na;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Atom
|
|
||||||
LookupWideAtom(const wchar_t *atom) { /* lookup atom in atom table */
|
|
||||||
CELL hash;
|
|
||||||
wchar_t *p;
|
|
||||||
Atom a, na;
|
|
||||||
AtomEntry *ae;
|
|
||||||
UInt sz;
|
|
||||||
WideAtomEntry *wae;
|
|
||||||
|
|
||||||
/* compute hash */
|
|
||||||
p = (wchar_t *)atom;
|
|
||||||
hash = WideHashFunction(p) % WideAtomHashTableSize;
|
|
||||||
/* we'll start by holding a read lock in order to avoid contention */
|
|
||||||
READ_LOCK(WideHashChain[hash].AERWLock);
|
|
||||||
a = WideHashChain[hash].Entry;
|
|
||||||
/* search atom in chain */
|
|
||||||
na = SearchWideAtom(atom, a);
|
|
||||||
if (na != NIL) {
|
|
||||||
READ_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
return (na);
|
|
||||||
}
|
|
||||||
READ_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
/* we need a write lock */
|
|
||||||
WRITE_LOCK(WideHashChain[hash].AERWLock);
|
|
||||||
/* concurrent version of Yap, need to take care */
|
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
|
||||||
if (a != WideHashChain[hash].Entry) {
|
|
||||||
a = WideHashChain[hash].Entry;
|
|
||||||
na = SearchWideAtom(atom, a);
|
|
||||||
if (na != NIL) {
|
|
||||||
WRITE_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
return na;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
/* add new atom to start of chain */
|
|
||||||
sz = wcslen(atom);
|
|
||||||
ae = (AtomEntry *)Yap_AllocAtomSpace((size_t)(((AtomEntry *)NULL) + 1) +
|
|
||||||
sizeof(wchar_t) * (sz + 1));
|
|
||||||
if (ae == NULL) {
|
|
||||||
WRITE_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
return NIL;
|
|
||||||
}
|
|
||||||
wae = (WideAtomEntry *)Yap_AllocAtomSpace(sizeof(WideAtomEntry));
|
|
||||||
if (wae == NULL) {
|
|
||||||
WRITE_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
return NIL;
|
|
||||||
}
|
|
||||||
na = AbsAtom(ae);
|
|
||||||
ae->PropsOfAE = AbsWideAtomProp(wae);
|
|
||||||
wae->NextOfPE = NIL;
|
|
||||||
wae->KindOfPE = WideAtomProperty;
|
|
||||||
wae->SizeOfAtom = sz;
|
|
||||||
if (ae->WStrOfAE != atom)
|
|
||||||
wcscpy(ae->WStrOfAE, atom);
|
|
||||||
NOfAtoms++;
|
|
||||||
ae->NextOfAE = a;
|
|
||||||
WideHashChain[hash].Entry = na;
|
|
||||||
INIT_RWLOCK(ae->ARWLock);
|
|
||||||
WRITE_UNLOCK(WideHashChain[hash].AERWLock);
|
|
||||||
|
|
||||||
if (NOfWideAtoms > 2 * WideAtomHashTableSize) {
|
|
||||||
Yap_signal(YAP_CDOVF_SIGNAL);
|
|
||||||
}
|
|
||||||
return na;
|
|
||||||
}
|
|
||||||
|
|
||||||
Atom Yap_LookupMaybeWideAtom(
|
|
||||||
const wchar_t *atom) { /* lookup atom in atom table */
|
|
||||||
wchar_t *p = (wchar_t *)atom, c;
|
|
||||||
size_t len = 0;
|
|
||||||
unsigned char *ptr, *ptr0;
|
|
||||||
Atom at;
|
|
||||||
|
|
||||||
while ((c = *p++)) {
|
|
||||||
if (c > 255)
|
|
||||||
return LookupWideAtom(atom);
|
|
||||||
len++;
|
|
||||||
}
|
|
||||||
/* not really a wide atom */
|
|
||||||
p = (wchar_t *)atom;
|
|
||||||
ptr0 = ptr = Yap_AllocCodeSpace(len + 1);
|
|
||||||
if (!ptr)
|
|
||||||
return NIL;
|
|
||||||
while ((*ptr++ = *p++))
|
|
||||||
;
|
|
||||||
at = LookupAtom(ptr0);
|
|
||||||
Yap_FreeCodeSpace(ptr0);
|
|
||||||
return at;
|
|
||||||
}
|
|
||||||
|
|
||||||
Atom Yap_LookupMaybeWideAtomWithLength(
|
|
||||||
const wchar_t *atom, size_t len0) { /* lookup atom in atom table */
|
|
||||||
Atom at;
|
|
||||||
int wide = FALSE;
|
|
||||||
size_t i = 0;
|
|
||||||
|
|
||||||
while (i < len0) {
|
|
||||||
// primary support for atoms with null chars
|
|
||||||
wchar_t c = atom[i];
|
|
||||||
if (c >= 255) {
|
|
||||||
wide = true;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (c == '\0') {
|
|
||||||
wide = true;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
i++;
|
|
||||||
}
|
|
||||||
if (wide) {
|
|
||||||
wchar_t *ptr0;
|
|
||||||
|
|
||||||
ptr0 = (wchar_t *)Yap_AllocCodeSpace(sizeof(wchar_t) * (len0 + 2));
|
|
||||||
if (!ptr0)
|
|
||||||
return NIL;
|
|
||||||
memcpy(ptr0, atom, (len0 + 1) * sizeof(wchar_t));
|
|
||||||
ptr0[len0] = '\0';
|
|
||||||
at = LookupWideAtom(ptr0);
|
|
||||||
Yap_FreeCodeSpace((char *)ptr0);
|
|
||||||
return at;
|
|
||||||
} else {
|
|
||||||
unsigned char *ptr0;
|
|
||||||
|
|
||||||
ptr0 = Yap_AllocCodeSpace((len0 + 2));
|
|
||||||
if (!ptr0)
|
|
||||||
return NIL;
|
|
||||||
for (i = 0; i < len0; i++)
|
|
||||||
ptr0[i] = atom[i];
|
|
||||||
ptr0[len0] = '\0';
|
|
||||||
at = LookupAtom(ptr0);
|
|
||||||
Yap_FreeCodeSpace(ptr0);
|
|
||||||
return at;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
Atom Yap_LookupAtomWithLength(const char *atom,
|
Atom Yap_LookupAtomWithLength(const char *atom,
|
||||||
size_t len0) { /* lookup atom in atom table */
|
size_t len0) { /* lookup atom in atom table */
|
||||||
Atom at;
|
Atom at;
|
||||||
|
@ -388,9 +227,6 @@ Atom Yap_ULookupAtom(
|
||||||
return LookupAtom(atom);
|
return LookupAtom(atom);
|
||||||
}
|
}
|
||||||
|
|
||||||
Atom Yap_LookupWideAtom(const wchar_t *atom) { /* lookup atom in atom table */
|
|
||||||
return LookupWideAtom(atom);
|
|
||||||
}
|
|
||||||
|
|
||||||
Atom Yap_FullLookupAtom(const char *atom) { /* lookup atom in atom table */
|
Atom Yap_FullLookupAtom(const char *atom) { /* lookup atom in atom table */
|
||||||
Atom t;
|
Atom t;
|
||||||
|
@ -809,8 +645,8 @@ Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) {
|
||||||
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
|
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
|
||||||
p->TimeStampOfPred = 0L;
|
p->TimeStampOfPred = 0L;
|
||||||
p->LastCallOfPred = LUCALL_ASSERT;
|
p->LastCallOfPred = LUCALL_ASSERT;
|
||||||
p->MetaEntryOfPred = NULL;
|
p->MetaEntryOfPred = NULL;
|
||||||
if (cur_mod == TermProlog)
|
if (cur_mod == TermProlog)
|
||||||
p->ModuleOfPred = 0L;
|
p->ModuleOfPred = 0L;
|
||||||
else
|
else
|
||||||
p->ModuleOfPred = cur_mod;
|
p->ModuleOfPred = cur_mod;
|
||||||
|
@ -947,8 +783,8 @@ Prop Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod) {
|
||||||
p->OpcodeOfPred = UNDEF_OPCODE;
|
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||||
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
|
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
|
||||||
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||||
p->MetaEntryOfPred = NULL;
|
p->MetaEntryOfPred = NULL;
|
||||||
if (cur_mod == TermProlog)
|
if (cur_mod == TermProlog)
|
||||||
p->ModuleOfPred = 0;
|
p->ModuleOfPred = 0;
|
||||||
else
|
else
|
||||||
p->ModuleOfPred = cur_mod;
|
p->ModuleOfPred = cur_mod;
|
||||||
|
|
12
C/agc.c
12
C/agc.c
|
@ -427,12 +427,7 @@ clean_atom_list(AtomHashEntry *HashPtr)
|
||||||
Yap_FreeCodeSpace((char *)b);
|
Yap_FreeCodeSpace((char *)b);
|
||||||
GLOBAL_agc_collected += sizeof(YAP_BlobPropEntry);
|
GLOBAL_agc_collected += sizeof(YAP_BlobPropEntry);
|
||||||
GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length;
|
GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length;
|
||||||
} else if (IsWideAtom(atm)) {
|
} else {
|
||||||
#ifdef DEBUG_RESTORE3
|
|
||||||
fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE);
|
|
||||||
#endif
|
|
||||||
GLOBAL_agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE);
|
|
||||||
} else {
|
|
||||||
#ifdef DEBUG_RESTORE3
|
#ifdef DEBUG_RESTORE3
|
||||||
fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE);
|
fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE);
|
||||||
#endif
|
#endif
|
||||||
|
@ -459,11 +454,6 @@ clean_atoms(void)
|
||||||
clean_atom_list(HashPtr);
|
clean_atom_list(HashPtr);
|
||||||
HashPtr++;
|
HashPtr++;
|
||||||
}
|
}
|
||||||
HashPtr = WideHashChain;
|
|
||||||
for (i = 0; i < WideAtomHashTableSize; ++i) {
|
|
||||||
clean_atom_list(HashPtr);
|
|
||||||
HashPtr++;
|
|
||||||
}
|
|
||||||
clean_atom_list(&INVISIBLECHAIN);
|
clean_atom_list(&INVISIBLECHAIN);
|
||||||
{
|
{
|
||||||
AtomHashEntry list;
|
AtomHashEntry list;
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/*************************************************************************
|
/*************************************************************************
|
||||||
* *
|
* *
|
||||||
* YAP Prolog *
|
* YAP Prolog *
|
||||||
* *
|
* *
|
||||||
|
@ -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)
|
if (Yap_do_low_level_trace||1)
|
||||||
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,7 +89,7 @@ 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)
|
if (Yap_do_low_level_trace||1)
|
||||||
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)
|
||||||
|
@ -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)
|
if (Yap_do_low_level_trace||1)
|
||||||
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,
|
||||||
|
|
634
C/atomic.c
634
C/atomic.c
|
@ -230,15 +230,15 @@ static Int char_code(USES_REGS1) {
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
if (code > MAX_ISO_LATIN1) {
|
if (code > MAX_ISO_LATIN1) {
|
||||||
wchar_t wcodes[2];
|
unsigned char codes[10];
|
||||||
|
|
||||||
if (code > CHARCODE_MAX) {
|
if (code > CHARCODE_MAX) {
|
||||||
Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2");
|
Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2");
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
wcodes[0] = code;
|
size_t n = put_utf8( codes, code);
|
||||||
wcodes[1] = '\0';
|
codes[0] = code;
|
||||||
tout = MkAtomTerm(Yap_LookupWideAtom(wcodes));
|
tout = MkAtomTerm(Yap_ULookupAtom(codes));
|
||||||
} else {
|
} else {
|
||||||
char codes[2];
|
char codes[2];
|
||||||
|
|
||||||
|
@ -254,25 +254,15 @@ static Int char_code(USES_REGS1) {
|
||||||
} else {
|
} else {
|
||||||
Atom at = AtomOfTerm(t0);
|
Atom at = AtomOfTerm(t0);
|
||||||
Term tf;
|
Term tf;
|
||||||
|
unsigned char *c = RepAtom(at)->UStrOfAE;
|
||||||
if (IsWideAtom(at)) {
|
int32_t v;
|
||||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
c += get_utf8(c, 1, &v);
|
||||||
|
if (c[0] != '\0') {
|
||||||
if (c[1] != '\0') {
|
Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2");
|
||||||
Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2");
|
return FALSE;
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
tf = MkIntegerTerm(c[0]);
|
|
||||||
} else {
|
|
||||||
unsigned char *c = RepAtom(at)->UStrOfAE;
|
|
||||||
|
|
||||||
if (c[1] != '\0') {
|
|
||||||
Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2");
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
tf = MkIntTerm((unsigned char)(c[0]));
|
|
||||||
}
|
}
|
||||||
return Yap_unify(ARG2, tf);
|
tf = MkIntTerm(v);
|
||||||
|
return Yap_unify(ARG2, tf);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1616,22 +1606,11 @@ static Int upcase_text_to_chars(USES_REGS1) {
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int is_wide(wchar_t *s) {
|
|
||||||
wchar_t ch;
|
|
||||||
|
|
||||||
while ((ch = *s++)) {
|
|
||||||
if (ch > MAX_ISO_LATIN1)
|
|
||||||
return TRUE;
|
|
||||||
}
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* split an atom into two sub-atoms */
|
/* split an atom into two sub-atoms */
|
||||||
static Int atom_split(USES_REGS1) {
|
static Int atom_split(USES_REGS1) {
|
||||||
Term t1 = Deref(ARG1);
|
Term t1 = Deref(ARG1);
|
||||||
Term t2 = Deref(ARG2);
|
Term t2 = Deref(ARG2);
|
||||||
size_t len;
|
size_t len;
|
||||||
int i;
|
|
||||||
Term to1, to2;
|
Term to1, to2;
|
||||||
Atom at;
|
Atom at;
|
||||||
|
|
||||||
|
@ -1656,66 +1635,22 @@ static Int atom_split(USES_REGS1) {
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
at = AtomOfTerm(t1);
|
at = AtomOfTerm(t1);
|
||||||
if (IsWideAtom(at)) {
|
unsigned char *s, *s1, *s10;
|
||||||
wchar_t *ws, *ws1 = (wchar_t *)HR;
|
|
||||||
unsigned char *s1 = (unsigned char *)HR;
|
|
||||||
size_t wlen;
|
|
||||||
|
|
||||||
ws = (wchar_t *)RepAtom(at)->StrOfAE;
|
|
||||||
wlen = wcslen(ws);
|
|
||||||
if (len > wlen)
|
|
||||||
return FALSE;
|
|
||||||
if (s1 + len > (unsigned char *)LCL0 - 1024)
|
|
||||||
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
|
|
||||||
for (i = 0; i < len; i++) {
|
|
||||||
if (ws[i] > MAX_ISO_LATIN1) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
s1[i] = ws[i];
|
|
||||||
}
|
|
||||||
if (ws1[i] > MAX_ISO_LATIN1) {
|
|
||||||
/* first sequence is wide */
|
|
||||||
if (ws1 + len > (wchar_t *)ASP - 1024)
|
|
||||||
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
|
|
||||||
ws = (wchar_t *)RepAtom(at)->StrOfAE;
|
|
||||||
for (i = 0; i < len; i++) {
|
|
||||||
ws1[i] = ws[i];
|
|
||||||
}
|
|
||||||
ws1[len] = '\0';
|
|
||||||
to1 = MkAtomTerm(Yap_LookupWideAtom(ws1));
|
|
||||||
/* we don't know if the rest of the string is wide or not */
|
|
||||||
if (is_wide(ws + len)) {
|
|
||||||
to2 = MkAtomTerm(Yap_LookupWideAtom(ws + len));
|
|
||||||
} else {
|
|
||||||
char *s2 = (char *)HR;
|
|
||||||
if (s2 + (wlen - len) > (char *)ASP - 1024)
|
|
||||||
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
|
|
||||||
ws += len;
|
|
||||||
while ((*s2++ = *ws++))
|
|
||||||
;
|
|
||||||
to2 = MkAtomTerm(Yap_LookupAtom((char *)HR));
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
s1[len] = '\0';
|
|
||||||
to1 = MkAtomTerm(Yap_ULookupAtom(s1));
|
|
||||||
/* second atom must be wide, if first wasn't */
|
|
||||||
to2 = MkAtomTerm(Yap_LookupWideAtom(ws + len));
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
unsigned char *s, *s1 = (unsigned char *)HR;
|
|
||||||
|
|
||||||
s = RepAtom(at)->UStrOfAE;
|
s = RepAtom(at)->UStrOfAE;
|
||||||
if (len > (Int)strlen((char *)s))
|
if (len > (Int)strlen_utf8(s))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
|
s1 = s10 = Malloc(len);
|
||||||
if (s1 + len > (unsigned char *)ASP - 1024)
|
if (s1 + len > (unsigned char *)ASP - 1024)
|
||||||
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
|
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
|
||||||
for (i = 0; i < len; i++) {
|
size_t j;
|
||||||
s1[i] = s[i];
|
for (j = 0; j < len; j++) {
|
||||||
|
int32_t val;
|
||||||
|
s += get_utf8(s,1,&val);
|
||||||
|
s1 += put_utf8(s,val);
|
||||||
}
|
}
|
||||||
s1[len] = '\0';
|
s1[0] = '\0';
|
||||||
to1 = MkAtomTerm(Yap_ULookupAtom(s1));
|
to1 = MkAtomTerm(Yap_ULookupAtom(s10));
|
||||||
to2 = MkAtomTerm(Yap_ULookupAtom(s + len));
|
to2 = MkAtomTerm(Yap_ULookupAtom(s));
|
||||||
}
|
|
||||||
return (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2));
|
return (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1769,50 +1704,17 @@ restart_aux:
|
||||||
#define SUB_ATOM_HAS_SIZE 2
|
#define SUB_ATOM_HAS_SIZE 2
|
||||||
#define SUB_ATOM_HAS_AFTER 4
|
#define SUB_ATOM_HAS_AFTER 4
|
||||||
#define SUB_ATOM_HAS_VAL 8
|
#define SUB_ATOM_HAS_VAL 8
|
||||||
#define SUB_ATOM_HAS_WIDE 16
|
#define SUB_ATOM_HAS_ATOM 16
|
||||||
#define SUB_ATOM_HAS_UTF8 32
|
#define SUB_ATOM_HAS_UTF8 32
|
||||||
|
|
||||||
static void *alloc_tmp_stack(size_t sz USES_REGS) {
|
|
||||||
void *pt = (void *)HR;
|
|
||||||
while (HR > ASP - (1044 + sz / sizeof(CELL))) {
|
|
||||||
if (!Yap_gc(5, ENV, gc_P(P, CP))) {
|
|
||||||
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "sub_atom/5");
|
|
||||||
return (NULL);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return pt;
|
|
||||||
}
|
|
||||||
|
|
||||||
static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
|
static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
|
||||||
size_t min, size_t len USES_REGS) {
|
size_t minv, size_t len USES_REGS) {
|
||||||
Atom nat;
|
{
|
||||||
if (mask & SUB_ATOM_HAS_WIDE) {
|
|
||||||
wchar_t *src = wp + min;
|
|
||||||
wchar_t *d = alloc_tmp_stack((len + 1) * sizeof(wchar_t) PASS_REGS);
|
|
||||||
if (!d)
|
|
||||||
return NIL;
|
|
||||||
|
|
||||||
wcsncpy(d, src, len);
|
|
||||||
d[len] = '\0';
|
|
||||||
nat = Yap_LookupMaybeWideAtom(d);
|
|
||||||
if (nat)
|
|
||||||
return MkAtomTerm(nat);
|
|
||||||
} else if (!(mask & SUB_ATOM_HAS_UTF8)) {
|
|
||||||
const unsigned char *src = p + min;
|
|
||||||
unsigned char *d = alloc_tmp_stack((len + 1) * sizeof(char) PASS_REGS);
|
|
||||||
if (!d)
|
|
||||||
return NIL;
|
|
||||||
|
|
||||||
strncpy((char *)d, (char *)src, len);
|
|
||||||
d[len] = '\0';
|
|
||||||
nat = Yap_ULookupAtom(d);
|
|
||||||
if (nat)
|
|
||||||
return MkAtomTerm(nat);
|
|
||||||
} else {
|
|
||||||
const unsigned char *src = p;
|
const unsigned char *src = p;
|
||||||
unsigned char *buf;
|
unsigned char *buf;
|
||||||
Term t = init_tstring(PASS_REGS1);
|
Term t = init_tstring(PASS_REGS1);
|
||||||
src = skip_utf8((unsigned char *)src, min);
|
src = skip_utf8((unsigned char *)src, minv);
|
||||||
const unsigned char *cp = src;
|
const unsigned char *cp = src;
|
||||||
|
|
||||||
buf = buf_from_tstring(HR);
|
buf = buf_from_tstring(HR);
|
||||||
|
@ -1823,6 +1725,8 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
|
||||||
len--;
|
len--;
|
||||||
}
|
}
|
||||||
*buf++ = '\0';
|
*buf++ = '\0';
|
||||||
|
if (mask & SUB_ATOM_HAS_ATOM)
|
||||||
|
return MkAtomTerm( Yap_ULookupAtom(buf ) );
|
||||||
|
|
||||||
close_tstring(buf PASS_REGS);
|
close_tstring(buf PASS_REGS);
|
||||||
return t;
|
return t;
|
||||||
|
@ -1830,257 +1734,132 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
|
||||||
return 0L;
|
return 0L;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int wcsstrcmp(wchar_t *p, char *p2, size_t len) {
|
|
||||||
while (len--) {
|
static int check_sub_atom_at(int minv, Atom at, Atom nat, size_t len) {
|
||||||
Int d = *p++ - *p2++;
|
const unsigned char *p1;
|
||||||
if (d)
|
const unsigned char *p2 = RepAtom(nat)->UStrOfAE;
|
||||||
return d;
|
p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv);
|
||||||
}
|
return cmpn_utf8(p1, p2, len) == 0;
|
||||||
return 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int check_sub_atom_at(int min, Atom at, Atom nat) {
|
static int check_sub_string_at(int minv, const unsigned char *p1,
|
||||||
if (IsWideAtom(nat)) {
|
|
||||||
wchar_t *p1, *p2;
|
|
||||||
wchar_t c1;
|
|
||||||
if (!IsWideAtom(at))
|
|
||||||
return FALSE;
|
|
||||||
p1 = RepAtom(at)->WStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->WStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
} else {
|
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
wchar_t *p1;
|
|
||||||
unsigned char *p2;
|
|
||||||
wchar_t c1;
|
|
||||||
p1 = RepAtom(at)->WStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->UStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
} else {
|
|
||||||
unsigned char *p1, *p2;
|
|
||||||
char c1;
|
|
||||||
p1 = RepAtom(at)->UStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->UStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static int check_sub_string_at(int min, const unsigned char *p1,
|
|
||||||
const unsigned char *p2, size_t len) {
|
const unsigned char *p2, size_t len) {
|
||||||
p1 = skip_utf8((unsigned char *)p1, min);
|
p1 = skip_utf8((unsigned char *)p1, minv);
|
||||||
|
if (p1 == NULL || p2 == NULL)
|
||||||
|
return p1 == p2;
|
||||||
return cmpn_utf8(p1, p2, len) == 0;
|
return cmpn_utf8(p1, p2, len) == 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int check_sub_atom_bef(int max, Atom at, Atom nat) {
|
|
||||||
if (IsWideAtom(nat)) {
|
|
||||||
wchar_t *p1, *p2;
|
|
||||||
wchar_t c1;
|
|
||||||
|
|
||||||
size_t len = wcslen(RepAtom(nat)->WStrOfAE);
|
|
||||||
int min = max - len;
|
|
||||||
if (min < 0)
|
|
||||||
return FALSE;
|
|
||||||
if (!IsWideAtom(at))
|
|
||||||
return FALSE;
|
|
||||||
p1 = RepAtom(at)->WStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->WStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
} else {
|
|
||||||
size_t len = strlen((char *)RepAtom(nat)->StrOfAE);
|
|
||||||
int min = max - len;
|
|
||||||
if ((Int)(min - len) < 0)
|
|
||||||
return FALSE;
|
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
wchar_t *p1;
|
|
||||||
unsigned char *p2;
|
|
||||||
wchar_t c1;
|
|
||||||
p1 = RepAtom(at)->WStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->UStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
} else {
|
|
||||||
unsigned char *p1, *p2;
|
|
||||||
char c1;
|
|
||||||
p1 = RepAtom(at)->UStrOfAE + min;
|
|
||||||
p2 = RepAtom(nat)->UStrOfAE;
|
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
|
||||||
;
|
|
||||||
return c1 == 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static int check_sub_string_bef(int max, Term at, Term nat) {
|
static int check_sub_string_bef(int max, Term at, Term nat) {
|
||||||
size_t len = strlen_utf8(UStringOfTerm(nat));
|
size_t len = strlen_utf8(UStringOfTerm(nat));
|
||||||
int min = max - len;
|
int minv = max - len;
|
||||||
const unsigned char *p1, *p2;
|
const unsigned char *p1, *p2;
|
||||||
int c1;
|
int c1;
|
||||||
|
|
||||||
if ((Int)(min - len) < 0)
|
if ((Int)(minv - len) < 0)
|
||||||
return FALSE;
|
return FALSE;
|
||||||
|
|
||||||
p1 = skip_utf8((unsigned char *)UStringOfTerm(at), min);
|
p1 = skip_utf8((unsigned char *)UStringOfTerm(at), minv);
|
||||||
p2 = UStringOfTerm(nat);
|
p2 = UStringOfTerm(nat);
|
||||||
while ((c1 = *p1++) == *p2++ && c1)
|
while ((c1 = *p1++) == *p2++ && c1)
|
||||||
;
|
;
|
||||||
return c1 == 0;
|
return c1 == 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static int check_sub_atom_bef(int max, Atom at, Atom nat) {
|
||||||
|
const unsigned char *p1, *p2 = RepAtom(nat)->UStrOfAE;
|
||||||
|
size_t len = strlen_utf8(p2);
|
||||||
|
int minv = max - len;
|
||||||
|
int c1;
|
||||||
|
|
||||||
|
if ((Int)(minv - len) < 0)
|
||||||
|
return false;
|
||||||
|
p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv);
|
||||||
|
while ((c1 = *p1++) == *p2++ && c1)
|
||||||
|
;
|
||||||
|
return c1 == 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int cont_sub_atomic(USES_REGS1) {
|
static Int cont_sub_atomic(USES_REGS1) {
|
||||||
Term tat1 = Deref(ARG1);
|
Term tat1 = Deref(ARG1);
|
||||||
Atom at = NULL;
|
Term tat5 = Deref(ARG5);
|
||||||
int mask;
|
int mask;
|
||||||
size_t min, len, after, sz;
|
size_t minv, len, after, sz;
|
||||||
wchar_t *wp = NULL;
|
wchar_t *wp = NULL;
|
||||||
const unsigned char *p = NULL;
|
const unsigned char *p = NULL, *p5 = NULL;
|
||||||
Term nat;
|
Term nat;
|
||||||
int sub_atom = TRUE;
|
int sub_atom = TRUE;
|
||||||
|
|
||||||
mask = IntegerOfTerm(EXTRA_CBACK_ARG(5, 1));
|
mask = IntegerOfTerm(EXTRA_CBACK_ARG(5, 1));
|
||||||
min = IntegerOfTerm(EXTRA_CBACK_ARG(5, 2));
|
minv = IntegerOfTerm(EXTRA_CBACK_ARG(5, 2));
|
||||||
len = IntegerOfTerm(EXTRA_CBACK_ARG(5, 3));
|
len = IntegerOfTerm(EXTRA_CBACK_ARG(5, 3));
|
||||||
after = IntegerOfTerm(EXTRA_CBACK_ARG(5, 4));
|
after = IntegerOfTerm(EXTRA_CBACK_ARG(5, 4));
|
||||||
sz = IntegerOfTerm(EXTRA_CBACK_ARG(5, 5));
|
sz = IntegerOfTerm(EXTRA_CBACK_ARG(5, 5));
|
||||||
|
|
||||||
if (mask & SUB_ATOM_HAS_UTF8) {
|
if (!IsVarTerm(tat1)) {
|
||||||
sub_atom = FALSE;
|
if (IsAtomTerm(tat1)) {
|
||||||
p = UStringOfTerm(tat1);
|
p = AtomOfTerm(tat1)->UStrOfAE;
|
||||||
} else if (mask & SUB_ATOM_HAS_WIDE) {
|
} else {
|
||||||
at = AtomOfTerm(tat1);
|
p = UStringOfTerm(tat1);
|
||||||
wp = RepAtom(at)->WStrOfAE;
|
}
|
||||||
} else {
|
}
|
||||||
at = AtomOfTerm(tat1);
|
if (!IsVarTerm(tat5)) {
|
||||||
p = RepAtom(at)->UStrOfAE;
|
if (IsAtomTerm(tat5)) {
|
||||||
}
|
p5 = AtomOfTerm(tat5)->UStrOfAE;
|
||||||
/* we can have one of two cases: A5 bound or unbound */
|
} else {
|
||||||
|
p5 = UStringOfTerm(tat5);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* we can have one of two cases: A5 bound or unbound */
|
||||||
if (mask & SUB_ATOM_HAS_VAL) {
|
if (mask & SUB_ATOM_HAS_VAL) {
|
||||||
int found = FALSE;
|
int found = FALSE;
|
||||||
nat = Deref(ARG5);
|
nat = Deref(ARG5);
|
||||||
if (mask & SUB_ATOM_HAS_WIDE) {
|
{
|
||||||
wp = RepAtom(at)->WStrOfAE;
|
const unsigned char *p1 = p;
|
||||||
if (IsWideAtom(AtomOfTerm(nat))) {
|
|
||||||
while (!found) {
|
|
||||||
if (wcsncmp(wp + min, AtomOfTerm(nat)->WStrOfAE, len) == 0) {
|
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
|
||||||
found = TRUE;
|
|
||||||
/* found one, check if there is any left */
|
|
||||||
while (min <= sz - len) {
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
if (wcsncmp(wp + min, AtomOfTerm(nat)->WStrOfAE, len) == 0)
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if (min == sz - len)
|
|
||||||
break;
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
while (!found) {
|
|
||||||
if (wcsstrcmp(wp + min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) {
|
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
|
||||||
found = TRUE;
|
|
||||||
/* found one, check if there is any left */
|
|
||||||
while (min <= sz - len) {
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
if (wcsstrcmp(wp + min, (char *)AtomOfTerm(nat)->StrOfAE, len) ==
|
|
||||||
0)
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if (min == sz - len)
|
|
||||||
break;
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else if (sub_atom) {
|
|
||||||
p = RepAtom(at)->UStrOfAE;
|
|
||||||
while (!found) {
|
|
||||||
if (strncmp((char *)p + min, (char *)AtomOfTerm(nat)->StrOfAE, len) ==
|
|
||||||
0) {
|
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
|
||||||
found = TRUE;
|
|
||||||
/* found one, check if there is any left */
|
|
||||||
while (min <= sz - len) {
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
if (strncmp((char *)p + min, (char *)AtomOfTerm(nat)->StrOfAE,
|
|
||||||
len) == 0)
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if (min == sz - len)
|
|
||||||
break;
|
|
||||||
after--;
|
|
||||||
min++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
const unsigned char *p = UStringOfTerm(Deref(ARG1)), *p1 = p;
|
|
||||||
const unsigned char *p5 = UStringOfTerm(Deref(ARG5));
|
|
||||||
|
|
||||||
while (!found) {
|
while (!found) {
|
||||||
p = skip_utf8((unsigned char *)p1, min);
|
p = skip_utf8(p1, minv);
|
||||||
if (cmpn_utf8(p, p5, len) == 0) {
|
if (cmpn_utf8(p, p5, len) == 0) {
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
Yap_unify(ARG2, MkIntegerTerm(minv));
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
Yap_unify(ARG3, MkIntegerTerm(len));
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
Yap_unify(ARG4, MkIntegerTerm(after));
|
||||||
found = TRUE;
|
found = TRUE;
|
||||||
/* found one, check if there is any left */
|
/* found one, check if there is any left */
|
||||||
while (min <= sz - len) {
|
while (minv <= sz - len) {
|
||||||
int chr;
|
int chr;
|
||||||
p += get_utf8((unsigned char *)p, -1, &chr);
|
p += get_utf8((unsigned char *)p, -1, &chr);
|
||||||
after--;
|
after--;
|
||||||
min++;
|
minv++;
|
||||||
if (cmpn_utf8(p, UStringOfTerm(nat), len) == 0)
|
if (cmpn_utf8(p, UStringOfTerm(nat), len) == 0)
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (min == sz - len)
|
if (minv == sz - len)
|
||||||
break;
|
break;
|
||||||
after--;
|
after--;
|
||||||
min++;
|
minv++;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (found) {
|
if (found) {
|
||||||
if (min > sz - len)
|
if (minv > sz - len)
|
||||||
cut_succeed();
|
cut_succeed();
|
||||||
} else {
|
} else {
|
||||||
cut_fail();
|
cut_fail();
|
||||||
}
|
}
|
||||||
} else if (mask & SUB_ATOM_HAS_SIZE) {
|
} else if (mask & SUB_ATOM_HAS_SIZE) {
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
Yap_unify(ARG2, MkIntegerTerm(minv));
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
Yap_unify(ARG4, MkIntegerTerm(after));
|
||||||
Yap_unify(ARG5, nat);
|
Yap_unify(ARG5, nat);
|
||||||
min++;
|
minv++;
|
||||||
if (after-- == 0)
|
if (after-- == 0)
|
||||||
cut_succeed();
|
cut_succeed();
|
||||||
} else if (mask & SUB_ATOM_HAS_MIN) {
|
} else if (mask & SUB_ATOM_HAS_MIN) {
|
||||||
after = sz - (min + len);
|
after = sz - (minv + len);
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
Yap_unify(ARG3, MkIntegerTerm(len));
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
Yap_unify(ARG4, MkIntegerTerm(after));
|
||||||
Yap_unify(ARG5, nat);
|
Yap_unify(ARG5, nat);
|
||||||
|
@ -2088,53 +1867,66 @@ static Int cont_sub_atomic(USES_REGS1) {
|
||||||
if (after-- == 0)
|
if (after-- == 0)
|
||||||
cut_succeed();
|
cut_succeed();
|
||||||
} else if (mask & SUB_ATOM_HAS_AFTER) {
|
} else if (mask & SUB_ATOM_HAS_AFTER) {
|
||||||
len = sz - (min + after);
|
len = sz - (minv + after);
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
Yap_unify(ARG2, MkIntegerTerm(minv));
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
Yap_unify(ARG3, MkIntegerTerm(len));
|
||||||
Yap_unify(ARG5, nat);
|
Yap_unify(ARG5, nat);
|
||||||
min++;
|
minv++;
|
||||||
if (len-- == 0)
|
if (len-- == 0)
|
||||||
cut_succeed();
|
cut_succeed();
|
||||||
} else {
|
} else {
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
Yap_unify(ARG2, MkIntegerTerm(min));
|
Yap_unify(ARG2, MkIntegerTerm(minv));
|
||||||
Yap_unify(ARG3, MkIntegerTerm(len));
|
Yap_unify(ARG3, MkIntegerTerm(len));
|
||||||
Yap_unify(ARG4, MkIntegerTerm(after));
|
Yap_unify(ARG4, MkIntegerTerm(after));
|
||||||
Yap_unify(ARG5, nat);
|
Yap_unify(ARG5, nat);
|
||||||
len++;
|
len++;
|
||||||
if (after-- == 0) {
|
if (after-- == 0) {
|
||||||
if (min == sz)
|
if (minv == sz)
|
||||||
cut_succeed();
|
cut_succeed();
|
||||||
min++;
|
minv++;
|
||||||
len = 0;
|
len = 0;
|
||||||
after = sz - min;
|
after = sz - minv;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask);
|
EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask);
|
||||||
EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(min);
|
EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv);
|
||||||
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len);
|
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len);
|
||||||
EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after);
|
EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after);
|
||||||
EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz);
|
EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz);
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int sub_atomic(int sub_atom USES_REGS) {
|
static Int sub_atomic(bool sub_atom USES_REGS) {
|
||||||
Term tat1, tbef, tsize, tafter, tout;
|
Term tat1, tbef, tsize, tafter, tout;
|
||||||
int mask = 0;
|
int mask = SUB_ATOM_HAS_UTF8;
|
||||||
size_t min, len, after, sz;
|
size_t minv, len, after, sz;
|
||||||
wchar_t *wp = NULL;
|
wchar_t *wp = NULL;
|
||||||
unsigned char *p = NULL;
|
const unsigned char *p = NULL;
|
||||||
int bnds = 0;
|
int bnds = 0;
|
||||||
Term nat = 0L;
|
Term nat = 0L;
|
||||||
Atom at = NULL;
|
Atom at = NULL;
|
||||||
|
|
||||||
tat1 = Deref(ARG1);
|
if (sub_atom)
|
||||||
|
mask |= SUB_ATOM_HAS_ATOM;
|
||||||
|
|
||||||
|
|
||||||
|
tat1 = Deref(ARG1);
|
||||||
|
|
||||||
|
if (!IsVarTerm(tat1)) {
|
||||||
|
if (IsAtomTerm(tat1)) {
|
||||||
|
p = AtomOfTerm(tat1)->UStrOfAE;
|
||||||
|
} else {
|
||||||
|
p = UStringOfTerm(tat1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0);
|
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0);
|
||||||
if (IsVarTerm(tat1)) {
|
if (IsVarTerm(tat1)) {
|
||||||
Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first argument");
|
Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else if (sub_atom && !IsAtomTerm(tat1)) {
|
} else if (IsAtomTerm(tat1)) {
|
||||||
Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5");
|
Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else if (!sub_atom && !IsStringTerm(tat1)) {
|
} else if (!sub_atom && !IsStringTerm(tat1)) {
|
||||||
|
@ -2143,13 +1935,13 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
}
|
}
|
||||||
tbef = Deref(ARG2);
|
tbef = Deref(ARG2);
|
||||||
if (IsVarTerm(tbef)) {
|
if (IsVarTerm(tbef)) {
|
||||||
min = 0;
|
minv = 0;
|
||||||
} else if (!IsIntegerTerm(tbef)) {
|
} else if (!IsIntegerTerm(tbef)) {
|
||||||
Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5");
|
Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else {
|
} else {
|
||||||
min = IntegerOfTerm(tbef);
|
minv = IntegerOfTerm(tbef);
|
||||||
if ((Int)min < 0) {
|
if ((Int)minv < 0) {
|
||||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5");
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
};
|
};
|
||||||
|
@ -2193,10 +1985,7 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
Atom oat;
|
Atom oat;
|
||||||
mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE;
|
mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE;
|
||||||
oat = AtomOfTerm(tout);
|
oat = AtomOfTerm(tout);
|
||||||
if (IsWideAtom(oat))
|
len = strlen_utf8(RepAtom(oat)->UStrOfAE);
|
||||||
len = wcslen(RepAtom(oat)->WStrOfAE);
|
|
||||||
else
|
|
||||||
len = strlen((const char *)RepAtom(oat)->StrOfAE);
|
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (!IsStringTerm(tout)) {
|
if (!IsStringTerm(tout)) {
|
||||||
|
@ -2211,41 +2000,30 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
cut_fail();
|
cut_fail();
|
||||||
bnds += 2;
|
bnds += 2;
|
||||||
}
|
}
|
||||||
if (sub_atom) {
|
if (!IsVarTerm(tat1)) {
|
||||||
at = AtomOfTerm(tat1);
|
mask |= SUB_ATOM_HAS_UTF8;
|
||||||
if (IsWideAtom(at)) {
|
sz = strlen_utf8(p);
|
||||||
mask |= SUB_ATOM_HAS_WIDE;
|
|
||||||
wp = RepAtom(at)->WStrOfAE;
|
|
||||||
sz = wcslen(wp);
|
|
||||||
} else {
|
|
||||||
p = RepAtom(at)->UStrOfAE;
|
|
||||||
sz = strlen((const char *)p);
|
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
mask |= SUB_ATOM_HAS_UTF8;
|
|
||||||
p = (unsigned char *)StringOfTerm(tat1);
|
|
||||||
sz = strlen_utf8(p);
|
|
||||||
}
|
|
||||||
/* the problem is deterministic if we have two cases */
|
/* the problem is deterministic if we have two cases */
|
||||||
if (bnds > 1) {
|
if (bnds > 1) {
|
||||||
int out = FALSE;
|
int out = FALSE;
|
||||||
|
|
||||||
if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) ==
|
if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) ==
|
||||||
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) {
|
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) {
|
||||||
if (min + len > sz)
|
if (minv + len > sz)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
if ((Int)(after = (sz - (min + len))) < 0)
|
if ((Int)(after = (sz - (minv + len))) < 0)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
if (!nat)
|
if (!nat)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat);
|
out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat);
|
||||||
} else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) ==
|
} else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) ==
|
||||||
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) {
|
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) {
|
||||||
if (sz < min + after)
|
if (sz < minv + after)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
len = sz - (min + after);
|
len = sz - (minv + after);
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
if (!nat)
|
if (!nat)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat);
|
out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat);
|
||||||
|
@ -2253,17 +2031,17 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
(SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) {
|
(SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) {
|
||||||
if (len + after > sz)
|
if (len + after > sz)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
min = sz - (len + after);
|
minv = sz - (len + after);
|
||||||
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
|
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
|
||||||
if (!nat)
|
if (!nat)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
out = Yap_unify(ARG2, MkIntegerTerm(min)) && Yap_unify(ARG5, nat);
|
out = Yap_unify(ARG2, MkIntegerTerm(minv)) && Yap_unify(ARG5, nat);
|
||||||
} else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) ==
|
} else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) ==
|
||||||
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) {
|
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) {
|
||||||
if (sub_atom)
|
if (sub_atom)
|
||||||
out = check_sub_atom_at(min, at, AtomOfTerm(nat));
|
out = check_sub_atom_at(minv, at, AtomOfTerm(nat), len);
|
||||||
else
|
else
|
||||||
out = check_sub_string_at(min, p, UStringOfTerm(nat), len);
|
out = check_sub_string_at(minv, p, UStringOfTerm(nat), len);
|
||||||
} else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) ==
|
} else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) ==
|
||||||
(SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) {
|
(SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) {
|
||||||
if (sub_atom)
|
if (sub_atom)
|
||||||
|
@ -2276,14 +2054,9 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
out = (strlen_utf8(UStringOfTerm(tout)) == len);
|
out = (strlen_utf8(UStringOfTerm(tout)) == len);
|
||||||
if (!out)
|
if (!out)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
} else if (IsWideAtom(AtomOfTerm(tout))) {
|
|
||||||
if (!(mask & SUB_ATOM_HAS_VAL)) {
|
|
||||||
cut_fail();
|
|
||||||
}
|
|
||||||
/* just check length, they may still be several occurrences :( */
|
|
||||||
out = (wcslen(RepAtom(AtomOfTerm(tout))->WStrOfAE) == len);
|
|
||||||
} else {
|
} else {
|
||||||
out = (strlen((const char *)RepAtom(AtomOfTerm(tout))->StrOfAE) == len);
|
out = (strlen_utf8(RepAtom(AtomOfTerm(tout))->UStrOfAE)
|
||||||
|
== len);
|
||||||
if (!out)
|
if (!out)
|
||||||
cut_fail();
|
cut_fail();
|
||||||
}
|
}
|
||||||
|
@ -2295,7 +2068,7 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
cut_fail();
|
cut_fail();
|
||||||
} else {
|
} else {
|
||||||
mask |= SUB_ATOM_HAS_SIZE;
|
mask |= SUB_ATOM_HAS_SIZE;
|
||||||
min = 0;
|
minv = 0;
|
||||||
after = sz - len;
|
after = sz - len;
|
||||||
goto backtrackable;
|
goto backtrackable;
|
||||||
}
|
}
|
||||||
|
@ -2305,15 +2078,15 @@ static Int sub_atomic(int sub_atom USES_REGS) {
|
||||||
cut_fail();
|
cut_fail();
|
||||||
} else {
|
} else {
|
||||||
if (!(mask & SUB_ATOM_HAS_MIN))
|
if (!(mask & SUB_ATOM_HAS_MIN))
|
||||||
min = 0;
|
minv = 0;
|
||||||
if (!(mask & SUB_ATOM_HAS_SIZE))
|
if (!(mask & SUB_ATOM_HAS_SIZE))
|
||||||
len = 0;
|
len = 0;
|
||||||
if (!(mask & SUB_ATOM_HAS_AFTER))
|
if (!(mask & SUB_ATOM_HAS_AFTER))
|
||||||
after = sz - (len + min);
|
after = sz - (len + minv);
|
||||||
}
|
}
|
||||||
backtrackable:
|
backtrackable:
|
||||||
EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask);
|
EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask);
|
||||||
EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(min);
|
EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv);
|
||||||
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len);
|
EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len);
|
||||||
EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after);
|
EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after);
|
||||||
EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz);
|
EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz);
|
||||||
|
@ -2334,7 +2107,7 @@ are unbound, the built-in will backtrack through all possible
|
||||||
sub-strings of _A_.
|
sub-strings of _A_.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
static Int sub_atom(USES_REGS1) { return sub_atomic(TRUE PASS_REGS); }
|
static Int sub_atom(USES_REGS1) { return sub_atomic(true PASS_REGS); }
|
||||||
|
|
||||||
/** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is iso
|
/** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is iso
|
||||||
|
|
||||||
|
@ -2350,7 +2123,7 @@ are unbound, the built-in will generate all possible
|
||||||
sub-strings of _S_.
|
sub-strings of _S_.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
static Int sub_string(USES_REGS1) { return sub_atomic(FALSE PASS_REGS); }
|
static Int sub_string(USES_REGS1) { return sub_atomic(false PASS_REGS); }
|
||||||
|
|
||||||
static Int cont_current_atom(USES_REGS1) {
|
static Int cont_current_atom(USES_REGS1) {
|
||||||
Atom catom;
|
Atom catom;
|
||||||
|
@ -2428,89 +2201,10 @@ static Int current_atom(USES_REGS1) { /* current_atom(?Atom) */
|
||||||
return (cont_current_atom(PASS_REGS1));
|
return (cont_current_atom(PASS_REGS1));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int cont_current_wide_atom(USES_REGS1) {
|
|
||||||
Atom catom;
|
|
||||||
Int i = IntOfTerm(EXTRA_CBACK_ARG(1, 2));
|
|
||||||
AtomEntry *ap; /* nasty hack for gcc on hpux */
|
|
||||||
|
|
||||||
/* protect current hash table line */
|
|
||||||
if (IsAtomTerm(EXTRA_CBACK_ARG(1, 1)))
|
|
||||||
catom = AtomOfTerm(EXTRA_CBACK_ARG(1, 1));
|
|
||||||
else
|
|
||||||
catom = NIL;
|
|
||||||
if (catom == NIL) {
|
|
||||||
i++;
|
|
||||||
/* move away from current hash table line */
|
|
||||||
while (i < WideAtomHashTableSize) {
|
|
||||||
READ_LOCK(WideHashChain[i].AERWLock);
|
|
||||||
catom = WideHashChain[i].Entry;
|
|
||||||
READ_UNLOCK(WideHashChain[i].AERWLock);
|
|
||||||
if (catom != NIL) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
i++;
|
|
||||||
}
|
|
||||||
if (i == WideAtomHashTableSize) {
|
|
||||||
cut_fail();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
ap = RepAtom(catom);
|
|
||||||
if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) {
|
|
||||||
READ_LOCK(ap->ARWLock);
|
|
||||||
if (ap->NextOfAE == NIL) {
|
|
||||||
READ_UNLOCK(ap->ARWLock);
|
|
||||||
i++;
|
|
||||||
while (i < WideAtomHashTableSize) {
|
|
||||||
READ_LOCK(WideHashChain[i].AERWLock);
|
|
||||||
catom = WideHashChain[i].Entry;
|
|
||||||
READ_UNLOCK(WideHashChain[i].AERWLock);
|
|
||||||
if (catom != NIL) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
i++;
|
|
||||||
}
|
|
||||||
if (i == WideAtomHashTableSize) {
|
|
||||||
cut_fail();
|
|
||||||
} else {
|
|
||||||
EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(catom);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(ap->NextOfAE);
|
|
||||||
READ_UNLOCK(ap->ARWLock);
|
|
||||||
}
|
|
||||||
EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i);
|
|
||||||
return TRUE;
|
|
||||||
} else {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int current_wide_atom(USES_REGS1) { /* current_atom(?Atom)
|
|
||||||
*/
|
|
||||||
Term t1 = Deref(ARG1);
|
|
||||||
if (!IsVarTerm(t1)) {
|
|
||||||
if (IsAtomTerm(t1))
|
|
||||||
cut_succeed();
|
|
||||||
else
|
|
||||||
cut_fail();
|
|
||||||
}
|
|
||||||
READ_LOCK(WideHashChain[0].AERWLock);
|
|
||||||
if (WideHashChain[0].Entry != NIL) {
|
|
||||||
EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(WideHashChain[0].Entry);
|
|
||||||
} else {
|
|
||||||
EXTRA_CBACK_ARG(1, 1) = MkIntTerm(0);
|
|
||||||
}
|
|
||||||
READ_UNLOCK(WideHashChain[0].AERWLock);
|
|
||||||
EXTRA_CBACK_ARG(1, 2) = MkIntTerm(0);
|
|
||||||
return (cont_current_wide_atom(PASS_REGS1));
|
|
||||||
}
|
|
||||||
|
|
||||||
void Yap_InitBackAtoms(void) {
|
void Yap_InitBackAtoms(void) {
|
||||||
Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom,
|
Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom,
|
||||||
SafePredFlag | SyncPredFlag);
|
SafePredFlag | SyncPredFlag);
|
||||||
Yap_InitCPredBack("$current_wide_atom", 1, 2, current_wide_atom,
|
Yap_InitCPredBack("atom_concat", 3, 2, atom_concat3, cont_atom_concat3, 0);
|
||||||
cont_current_wide_atom, SafePredFlag | SyncPredFlag);
|
|
||||||
Yap_InitCPredBack("atom_concat", 3, 2, atom_concat3, cont_atom_concat3, 0);
|
|
||||||
Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, cont_atomic_concat3,
|
Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, cont_atomic_concat3,
|
||||||
0);
|
0);
|
||||||
Yap_InitCPredBack("string_concat", 3, 2, string_concat3, cont_string_concat3,
|
Yap_InitCPredBack("string_concat", 3, 2, string_concat3, cont_string_concat3,
|
||||||
|
|
|
@ -212,16 +212,9 @@ bool YAP_get_blob(Term t, void **blob, size_t *len, blob_type_t **type) {
|
||||||
void *YAP_blob_data(Atom x, size_t *len, blob_type_t **type) {
|
void *YAP_blob_data(Atom x, size_t *len, blob_type_t **type) {
|
||||||
|
|
||||||
if (!IsBlob(x)) {
|
if (!IsBlob(x)) {
|
||||||
if (IsWideAtom(x)) {
|
|
||||||
if (len)
|
|
||||||
*len = wcslen(x->WStrOfAE);
|
|
||||||
if (type)
|
|
||||||
|
|
||||||
*type = &unregistered_blob_atom;
|
|
||||||
return x->WStrOfAE;
|
|
||||||
}
|
|
||||||
if (len)
|
if (len)
|
||||||
*len = strlen((char *)x->StrOfAE);
|
*len = strlen_utf8(x->UStrOfAE);
|
||||||
if (type)
|
if (type)
|
||||||
*type = &unregistered_blob_atom;
|
*type = &unregistered_blob_atom;
|
||||||
return x->StrOfAE;
|
return x->StrOfAE;
|
||||||
|
|
|
@ -398,7 +398,16 @@ X_API Term YAP_MkAtomTerm(Atom n) {
|
||||||
|
|
||||||
X_API Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); }
|
X_API Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); }
|
||||||
|
|
||||||
X_API bool YAP_IsWideAtom(Atom a) { return IsWideAtom(a); }
|
X_API bool YAP_IsWideAtom(Atom a) {
|
||||||
|
const unsigned char *s = RepAtom(a)->UStrOfAE;
|
||||||
|
int32_t v;
|
||||||
|
while (*s) {
|
||||||
|
size_t n = get_utf8(s,1,&v);
|
||||||
|
if (n>1)
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
|
||||||
X_API const char *YAP_AtomName(Atom a) {
|
X_API const char *YAP_AtomName(Atom a) {
|
||||||
const char *o;
|
const char *o;
|
||||||
|
@ -407,7 +416,20 @@ X_API const char *YAP_AtomName(Atom a) {
|
||||||
return (o);
|
return (o);
|
||||||
}
|
}
|
||||||
|
|
||||||
X_API const wchar_t *YAP_WideAtomName(Atom a) { return RepAtom(a)->WStrOfAE; }
|
X_API const wchar_t *YAP_WideAtomName(Atom a) {
|
||||||
|
int32_t v;
|
||||||
|
const unsigned char *s = RepAtom(a)->UStrOfAE;
|
||||||
|
size_t n = strlen_utf8( s );
|
||||||
|
wchar_t *dest = Malloc( (n+1)* sizeof(wchar_t)), *o = dest;
|
||||||
|
while (*s) {
|
||||||
|
size_t n = get_utf8(s,1,&v);
|
||||||
|
if (n==0)
|
||||||
|
return NULL;
|
||||||
|
*o++ = v;
|
||||||
|
}
|
||||||
|
o[0] = '\0';
|
||||||
|
return dest;
|
||||||
|
}
|
||||||
|
|
||||||
X_API Atom YAP_LookupAtom(const char *c) {
|
X_API Atom YAP_LookupAtom(const char *c) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
|
@ -430,9 +452,10 @@ X_API Atom YAP_LookupAtom(const char *c) {
|
||||||
X_API Atom YAP_LookupWideAtom(const wchar_t *c) {
|
X_API Atom YAP_LookupWideAtom(const wchar_t *c) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Atom a;
|
Atom a;
|
||||||
|
|
||||||
|
|
||||||
while (TRUE) {
|
while (TRUE) {
|
||||||
a = Yap_LookupWideAtom((wchar_t *)c);
|
a = Yap_NWCharsToAtom(c, -1 USES_REGS);
|
||||||
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
||||||
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
||||||
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
||||||
|
@ -467,15 +490,10 @@ X_API size_t YAP_AtomNameLength(Atom at) {
|
||||||
if (IsBlob(at)) {
|
if (IsBlob(at)) {
|
||||||
return RepAtom(at)->rep.blob->length;
|
return RepAtom(at)->rep.blob->length;
|
||||||
}
|
}
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
|
||||||
|
|
||||||
return wcslen(c);
|
|
||||||
} else {
|
|
||||||
unsigned char *c = RepAtom(at)->UStrOfAE;
|
unsigned char *c = RepAtom(at)->UStrOfAE;
|
||||||
|
|
||||||
return strlen((char *)c);
|
return strlen_utf8(c);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
X_API Term YAP_MkVarTerm(void) {
|
X_API Term YAP_MkVarTerm(void) {
|
||||||
|
@ -2260,6 +2278,9 @@ static void start_modules(void) {
|
||||||
CurrentModule = cm;
|
CurrentModule = cm;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// whether Yap is under control of some other system
|
||||||
|
bool Yap_embedded;
|
||||||
|
|
||||||
/* this routine is supposed to be called from an external program
|
/* this routine is supposed to be called from an external program
|
||||||
that wants to control Yap */
|
that wants to control Yap */
|
||||||
|
|
||||||
|
@ -2268,7 +2289,6 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
|
||||||
bool do_bootstrap = (restore_result & YAP_CONSULT_MODE);
|
bool do_bootstrap = (restore_result & YAP_CONSULT_MODE);
|
||||||
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
|
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
|
||||||
char boot_file[YAP_FILENAME_MAX + 1];
|
char boot_file[YAP_FILENAME_MAX + 1];
|
||||||
|
|
||||||
Int rc;
|
Int rc;
|
||||||
const char *yroot;
|
const char *yroot;
|
||||||
|
|
||||||
|
@ -2277,6 +2297,7 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
|
||||||
return YAP_FOUND_BOOT_ERROR;
|
return YAP_FOUND_BOOT_ERROR;
|
||||||
initialized = true;
|
initialized = true;
|
||||||
|
|
||||||
|
Yap_embedded = yap_init->Embedded;
|
||||||
Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by
|
Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by
|
||||||
later functions */
|
later functions */
|
||||||
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
|
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
|
||||||
|
@ -2285,7 +2306,7 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
|
||||||
GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts;
|
GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts;
|
||||||
Yap_InitSysbits(0); /* init signal handling and time, required by later
|
Yap_InitSysbits(0); /* init signal handling and time, required by later
|
||||||
functions */
|
functions */
|
||||||
GLOBAL_argv = yap_init->Argv;
|
GLOBAL_argv = yap_init->Argv;
|
||||||
GLOBAL_argc = yap_init->Argc;
|
GLOBAL_argc = yap_init->Argc;
|
||||||
if (0 && ((YAP_QLY && yap_init->SavedState) ||
|
if (0 && ((YAP_QLY && yap_init->SavedState) ||
|
||||||
(YAP_BOOT_PL && (yap_init->YapPrologBootFile)))) {
|
(YAP_BOOT_PL && (yap_init->YapPrologBootFile)))) {
|
||||||
|
@ -2346,9 +2367,10 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
|
||||||
//
|
//
|
||||||
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
if (yap_init->QuietMode) {
|
if (Yap_embedded)
|
||||||
setVerbosity(TermSilent);
|
if (yap_init->QuietMode) {
|
||||||
}
|
setVerbosity(TermSilent);
|
||||||
|
}
|
||||||
{
|
{
|
||||||
if (yap_init->YapPrologRCFile != NULL) {
|
if (yap_init->YapPrologRCFile != NULL) {
|
||||||
/*
|
/*
|
||||||
|
@ -3186,10 +3208,10 @@ size_t YAP_UTF8_TextLength(Term t) {
|
||||||
Term hd = HeadOfTerm(t);
|
Term hd = HeadOfTerm(t);
|
||||||
if (IsAtomTerm(hd)) {
|
if (IsAtomTerm(hd)) {
|
||||||
Atom at = AtomOfTerm(hd);
|
Atom at = AtomOfTerm(hd);
|
||||||
if (IsWideAtom(at))
|
unsigned char *s = RepAtom(at)->UStrOfAE;
|
||||||
c = RepAtom(at)->WStrOfAE[0];
|
int32_t ch;
|
||||||
else
|
get_utf8(s, 1, &ch);
|
||||||
c = RepAtom(at)->StrOfAE[0];
|
c = ch;
|
||||||
} else if (IsIntegerTerm(hd)) {
|
} else if (IsIntegerTerm(hd)) {
|
||||||
c = IntegerOfTerm(hd);
|
c = IntegerOfTerm(hd);
|
||||||
} else {
|
} else {
|
||||||
|
@ -3200,21 +3222,8 @@ size_t YAP_UTF8_TextLength(Term t) {
|
||||||
}
|
}
|
||||||
} else if (IsAtomTerm(t)) {
|
} else if (IsAtomTerm(t)) {
|
||||||
Atom at = AtomOfTerm(t);
|
Atom at = AtomOfTerm(t);
|
||||||
if (IsWideAtom(at)) {
|
sz = strlen(RepAtom(at)->StrOfAE);
|
||||||
const wchar_t *s = RepAtom(at)->WStrOfAE;
|
} else if (IsStringTerm(t)) {
|
||||||
int c;
|
|
||||||
while ((c = *s++)) {
|
|
||||||
sz += utf8proc_encode_char(c, dst);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE;
|
|
||||||
int c;
|
|
||||||
|
|
||||||
while ((c = *s++)) {
|
|
||||||
sz += utf8proc_encode_char(c, dst);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else if (IsStringTerm(t)) {
|
|
||||||
sz = strlen(StringOfTerm(t));
|
sz = strlen(StringOfTerm(t));
|
||||||
}
|
}
|
||||||
return sz;
|
return sz;
|
||||||
|
|
33
C/cmppreds.c
33
C/cmppreds.c
|
@ -81,38 +81,7 @@ static Int a_gen_ge(Term, Term);
|
||||||
#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
|
#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
|
||||||
|
|
||||||
static int cmp_atoms(Atom a1, Atom a2) {
|
static int cmp_atoms(Atom a1, Atom a2) {
|
||||||
if (IsWideAtom(a1)) {
|
return strcmp(RepAtom(a1)->StrOfAE, RepAtom(a2)->StrOfAE);
|
||||||
if (IsWideAtom(a2)) {
|
|
||||||
return wcscmp((wchar_t *)RepAtom(a1)->StrOfAE,
|
|
||||||
(wchar_t *)RepAtom(a2)->StrOfAE);
|
|
||||||
} else {
|
|
||||||
/* The standard does not seem to have nothing on this */
|
|
||||||
unsigned char *s1 = (unsigned char *)RepAtom(a1)->StrOfAE;
|
|
||||||
wchar_t *s2 = (wchar_t *)RepAtom(a2)->StrOfAE;
|
|
||||||
|
|
||||||
while (*s1 == *s2) {
|
|
||||||
if (!*s1)
|
|
||||||
return 0;
|
|
||||||
s1++;
|
|
||||||
s2++;
|
|
||||||
}
|
|
||||||
return *s1 - *s2;
|
|
||||||
}
|
|
||||||
} else if (IsWideAtom(a2)) {
|
|
||||||
/* The standard does not seem to have nothing on this */
|
|
||||||
wchar_t *s1 = (wchar_t *)RepAtom(a1)->StrOfAE;
|
|
||||||
unsigned char *s2 = (unsigned char *)RepAtom(a2)->StrOfAE;
|
|
||||||
|
|
||||||
while (*s1 == *s2) {
|
|
||||||
if (!*s1)
|
|
||||||
return 0;
|
|
||||||
s1++;
|
|
||||||
s2++;
|
|
||||||
}
|
|
||||||
return *s1 - *s2;
|
|
||||||
} else {
|
|
||||||
return strcmp((char *)RepAtom(a1)->StrOfAE, (char *)RepAtom(a2)->StrOfAE);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
|
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
|
||||||
|
|
20
C/compiler.c
20
C/compiler.c
|
@ -1485,25 +1485,7 @@ static void c_goal(Term Goal, Term mod, compiler_struct *cglobs) {
|
||||||
PredEntry *p;
|
PredEntry *p;
|
||||||
Prop p0;
|
Prop p0;
|
||||||
|
|
||||||
if (IsVarTerm(Goal)) {
|
Goal = Yap_YapStripModule( Goal, &mod);
|
||||||
Goal = Yap_MkApplTerm(FunctorCall, 1, &Goal);
|
|
||||||
}
|
|
||||||
if (IsApplTerm(Goal) && FunctorOfTerm(Goal) == FunctorModule) {
|
|
||||||
Term M = ArgOfTerm(1, Goal);
|
|
||||||
|
|
||||||
if (IsVarTerm(M) || !IsAtomTerm(M)) {
|
|
||||||
CACHE_REGS
|
|
||||||
if (IsVarTerm(M)) {
|
|
||||||
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
|
|
||||||
} else {
|
|
||||||
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
|
|
||||||
}
|
|
||||||
save_machine_regs();
|
|
||||||
siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
|
|
||||||
}
|
|
||||||
Goal = ArgOfTerm(2, Goal);
|
|
||||||
mod = M;
|
|
||||||
}
|
|
||||||
if (IsVarTerm(Goal)) {
|
if (IsVarTerm(Goal)) {
|
||||||
Goal = Yap_MkApplTerm(FunctorCall, 1, &Goal);
|
Goal = Yap_MkApplTerm(FunctorCall, 1, &Goal);
|
||||||
} else if (IsNumTerm(Goal)) {
|
} else if (IsNumTerm(Goal)) {
|
||||||
|
|
2
C/init.c
2
C/init.c
|
@ -98,6 +98,8 @@ int Yap_Portray_delays = FALSE;
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
void *YAP_save;
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
||||||
@defgroup Operators Summary of YAP Predefined Operators
|
@defgroup Operators Summary of YAP Predefined Operators
|
||||||
|
|
|
@ -0,0 +1,43 @@
|
||||||
|
#!/usr/local/bin/python3.4
|
||||||
|
import os, sys
|
||||||
|
if 'LD_LIBRARY_PATH' not in os.environ:
|
||||||
|
os.environ['LD_LIBRARY_PATH'] = '/usr/local/lib'
|
||||||
|
try:
|
||||||
|
os.execv(sys.argv[0], sys.argv)
|
||||||
|
except Exception as exc:
|
||||||
|
print( 'Failed re-exec:', exc )
|
||||||
|
sys.exit(1)
|
||||||
|
#
|
||||||
|
# import yourmodule
|
||||||
|
print( 'Success:', os.environ['LD_LIBRARY_PATH']
|
||||||
|
# your program goes here
|
||||||
|
|
||||||
|
import matplotlib
|
||||||
|
matplotlib.use('Agg')
|
||||||
|
|
||||||
|
|
||||||
|
#import sys, os
|
||||||
|
sys.path = sys.path + [os.getcwd()]
|
||||||
|
|
||||||
|
sys.druwid_root = os.path.abspath(os.path.dirname(__file__))
|
||||||
|
|
||||||
|
|
||||||
|
import dru.druwid
|
||||||
|
import dru.druplot
|
||||||
|
from dru.shell import AlephShell
|
||||||
|
|
||||||
|
cq = dru.druwid.ClauseQueue()
|
||||||
|
|
||||||
|
learner = dru.druwid.Aleph( cq )
|
||||||
|
|
||||||
|
#
|
||||||
|
# initialize engine
|
||||||
|
#
|
||||||
|
def main():
|
||||||
|
if not learner:
|
||||||
|
print("Nothing to do, bye!")
|
||||||
|
exit(2)
|
||||||
|
AlephShell(learner).cmdloop()
|
||||||
|
|
||||||
|
if __name__ == "__main__":
|
||||||
|
main()
|
202
C/parser.c
202
C/parser.c
|
@ -8,9 +8,9 @@
|
||||||
* *
|
* *
|
||||||
**************************************************************************
|
**************************************************************************
|
||||||
* *
|
* *
|
||||||
* File: parser.c *
|
* File: parser.c *
|
||||||
* Last rev: *
|
* Last rev: *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Prolog's parser *
|
* comments: Prolog's parser *
|
||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
@ -138,11 +138,11 @@ dot with single quotes.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include "Yap.h"
|
#include "Yap.h"
|
||||||
#include "Yatom.h"
|
|
||||||
#include "YapHeap.h"
|
#include "YapHeap.h"
|
||||||
#include "YapText.h"
|
#include "YapText.h"
|
||||||
#include "yapio.h"
|
#include "Yatom.h"
|
||||||
#include "eval.h"
|
#include "eval.h"
|
||||||
|
#include "yapio.h"
|
||||||
/* stuff we want to use in standard YAP code */
|
/* stuff we want to use in standard YAP code */
|
||||||
#include "iopreds.h"
|
#include "iopreds.h"
|
||||||
#if HAVE_STRING_H
|
#if HAVE_STRING_H
|
||||||
|
@ -163,21 +163,21 @@ dot with single quotes.
|
||||||
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 GNextToken(CACHE_TYPE1);
|
||||||
static void checkfor(wchar_t, JMPBUFF *, encoding_t CACHE_TYPE);
|
static void checkfor(Term, JMPBUFF *, encoding_t CACHE_TYPE);
|
||||||
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
|
static Term ParseArgs(Atom, Term, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
|
||||||
static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE);
|
static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE);
|
||||||
static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE);
|
static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE);
|
||||||
|
|
||||||
const char *Yap_tokRep(TokEntry *tokptr, encoding_t enc);
|
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_toktide == LOCAL_tokptr) {
|
if (LOCAL_toktide == LOCAL_tokptr) {
|
||||||
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1);
|
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
|
||||||
va_start(ap, msg);
|
va_start(ap, msg);
|
||||||
vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX , msg, ap);
|
vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX, msg, ap);
|
||||||
LOCAL_Error_TYPE = SYNTAX_ERROR;
|
LOCAL_Error_TYPE = SYNTAX_ERROR;
|
||||||
va_end(ap);
|
va_end(ap);
|
||||||
}
|
}
|
||||||
|
@ -225,16 +225,21 @@ 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;
|
||||||
|
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;
|
||||||
|
|
||||||
|
@ -262,7 +267,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table */
|
||||||
p = p->VarRight;
|
p = p->VarRight;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
|
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + 1+ sizeof(VarEntry));
|
||||||
*op = p;
|
*op = p;
|
||||||
p->VarLeft = p->VarRight = NULL;
|
p->VarLeft = p->VarRight = NULL;
|
||||||
p->hv = hv;
|
p->hv = hv;
|
||||||
|
@ -270,7 +275,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table */
|
||||||
strcpy(p->VarRep, var);
|
strcpy(p->VarRep, var);
|
||||||
} else {
|
} else {
|
||||||
/* anon var */
|
/* anon var */
|
||||||
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
|
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 3);
|
||||||
p->VarLeft = LOCAL_AnonVarTable;
|
p->VarLeft = LOCAL_AnonVarTable;
|
||||||
LOCAL_AnonVarTable = p;
|
LOCAL_AnonVarTable = p;
|
||||||
p->VarRight = NULL;
|
p->VarRight = NULL;
|
||||||
|
@ -378,7 +383,7 @@ static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term cmod USES_REGS) {
|
||||||
}
|
}
|
||||||
if ((p = opp->Prefix) != 0) {
|
if ((p = opp->Prefix) != 0) {
|
||||||
READ_UNLOCK(opp->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *rpptr = p &MaskPrio;
|
*pptr = *rpptr = p & MaskPrio;
|
||||||
if (p & DcrrpFlag)
|
if (p & DcrrpFlag)
|
||||||
--*rpptr;
|
--*rpptr;
|
||||||
return TRUE;
|
return TRUE;
|
||||||
|
@ -393,7 +398,8 @@ int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
|
||||||
return IsPrefixOp(op, pptr, rpptr, CurrentModule PASS_REGS);
|
return IsPrefixOp(op, pptr, rpptr, CurrentModule PASS_REGS);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term cmod USES_REGS) {
|
static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr,
|
||||||
|
Term cmod USES_REGS) {
|
||||||
int p;
|
int p;
|
||||||
|
|
||||||
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
|
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
|
||||||
|
@ -405,7 +411,7 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term cmod USES_
|
||||||
}
|
}
|
||||||
if ((p = opp->Infix) != 0) {
|
if ((p = opp->Infix) != 0) {
|
||||||
READ_UNLOCK(opp->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *rpptr = *lpptr = p &MaskPrio;
|
*pptr = *rpptr = *lpptr = p & MaskPrio;
|
||||||
if (p & DcrrpFlag)
|
if (p & DcrrpFlag)
|
||||||
--*rpptr;
|
--*rpptr;
|
||||||
if (p & DcrlpFlag)
|
if (p & DcrlpFlag)
|
||||||
|
@ -434,7 +440,7 @@ static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term cmod USES_REGS) {
|
||||||
}
|
}
|
||||||
if ((p = opp->Posfix) != 0) {
|
if ((p = opp->Posfix) != 0) {
|
||||||
READ_UNLOCK(opp->OpRWLock);
|
READ_UNLOCK(opp->OpRWLock);
|
||||||
*pptr = *lpptr = p &MaskPrio;
|
*pptr = *lpptr = p & MaskPrio;
|
||||||
if (p & DcrlpFlag)
|
if (p & DcrlpFlag)
|
||||||
--*lpptr;
|
--*lpptr;
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
|
@ -458,12 +464,14 @@ inline static void GNextToken(USES_REGS1) {
|
||||||
LOCAL_tokptr = LOCAL_tokptr->TokNext;
|
LOCAL_tokptr = LOCAL_tokptr->TokNext;
|
||||||
}
|
}
|
||||||
|
|
||||||
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_REGS) {
|
inline static void checkfor(Term c, JMPBUFF *FailBuff,
|
||||||
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
|
encoding_t enc USES_REGS) {
|
||||||
LOCAL_tokptr->TokInfo != (Term)c) {
|
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != c) {
|
||||||
char s[1024];
|
char s[1024];
|
||||||
strncpy(s, Yap_tokRep(LOCAL_tokptr, enc), 1023);
|
strncpy(s, Yap_tokRep(LOCAL_tokptr, enc), 1023);
|
||||||
syntax_msg("line %d: expected to find \'%c\', found %s", LOCAL_tokptr->TokPos, c, s);
|
syntax_msg("line %d: expected to find "
|
||||||
|
"\'%c....................................\', found %s",
|
||||||
|
LOCAL_tokptr->TokPos, c, s);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
NextToken;
|
NextToken;
|
||||||
|
@ -471,7 +479,8 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_RE
|
||||||
|
|
||||||
#ifdef O_QUASIQUOTATIONS
|
#ifdef O_QUASIQUOTATIONS
|
||||||
|
|
||||||
static int is_quasi_quotation_syntax(Term goal, Atom *pat, encoding_t enc, Term cmod) {
|
static int is_quasi_quotation_syntax(Term goal, Atom *pat, encoding_t enc,
|
||||||
|
Term cmod) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Term m = cmod, t;
|
Term m = cmod, t;
|
||||||
Atom at;
|
Atom at;
|
||||||
|
@ -519,12 +528,12 @@ static int get_quasi_quotation(term_t t, unsigned char **here,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return FALSE; // errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd);
|
return false; // errorWarning("end_of_file_in_quasi_quotation", 0, _PL_rd);
|
||||||
}
|
}
|
||||||
#endif /*O_QUASIQUOTATIONS*/
|
#endif /*O_QUASIQUOTATIONS*/
|
||||||
|
|
||||||
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
|
||||||
Term arg1, encoding_t enc, Term cmod USES_REGS) {
|
encoding_t enc, Term cmod USES_REGS) {
|
||||||
int nargs = 0;
|
int nargs = 0;
|
||||||
Term *p, t;
|
Term *p, t;
|
||||||
Functor func;
|
Functor func;
|
||||||
|
@ -543,12 +552,12 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
||||||
|
|
||||||
func = Yap_MkFunctor(a, 1);
|
func = Yap_MkFunctor(a, 1);
|
||||||
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;
|
||||||
}
|
}
|
||||||
t = Yap_MkApplTerm(func, nargs, p);
|
t = Yap_MkApplTerm(func, nargs, p);
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos );
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
return TermNil;
|
return TermNil;
|
||||||
}
|
}
|
||||||
NextToken;
|
NextToken;
|
||||||
|
@ -558,15 +567,15 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
||||||
while (1) {
|
while (1) {
|
||||||
Term *tp = (Term *)ParserAuxSp;
|
Term *tp = (Term *)ParserAuxSp;
|
||||||
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
|
if (ParserAuxSp + 1 > LOCAL_TrailTop) {
|
||||||
syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Trail Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
*tp++ = Unsigned(ParseTerm(999, FailBuff, enc,cmod PASS_REGS));
|
*tp++ = Unsigned(ParseTerm(999, FailBuff, enc, cmod PASS_REGS));
|
||||||
ParserAuxSp = (char *)tp;
|
ParserAuxSp = (char *)tp;
|
||||||
++nargs;
|
++nargs;
|
||||||
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
|
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
|
||||||
break;
|
break;
|
||||||
if (((int)LOCAL_tokptr->TokInfo) != ',')
|
if (LOCAL_tokptr->TokInfo != TermComma)
|
||||||
break;
|
break;
|
||||||
NextToken;
|
NextToken;
|
||||||
}
|
}
|
||||||
|
@ -576,12 +585,12 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
||||||
* order
|
* order
|
||||||
*/
|
*/
|
||||||
if (HR > ASP - (nargs + 1)) {
|
if (HR > ASP - (nargs + 1)) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
func = Yap_MkFunctor(a, nargs);
|
func = Yap_MkFunctor(a, nargs);
|
||||||
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;
|
||||||
}
|
}
|
||||||
#ifdef SFUNC
|
#ifdef SFUNC
|
||||||
|
@ -596,7 +605,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
|
||||||
t = Yap_MkApplTerm(func, nargs, p);
|
t = Yap_MkApplTerm(func, nargs, p);
|
||||||
#endif
|
#endif
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
return TermNil;
|
return TermNil;
|
||||||
}
|
}
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
|
@ -625,34 +634,35 @@ loop:
|
||||||
HR += 2;
|
HR += 2;
|
||||||
to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
|
to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
|
||||||
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
|
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
|
||||||
if (((int)LOCAL_tokptr->TokInfo) == ',') {
|
if (LOCAL_tokptr->TokInfo == TermComma) {
|
||||||
NextToken;
|
NextToken;
|
||||||
{
|
{
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
to_store[1] = TermNil;
|
to_store[1] = TermNil;
|
||||||
syntax_msg("line %d: Stack Overflow" ,LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
} else {
|
} else {
|
||||||
to_store[1] = AbsPair(HR);
|
to_store[1] = AbsPair(HR);
|
||||||
goto loop;
|
goto loop;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
|
} else if (LOCAL_tokptr->TokInfo == TermVBar) {
|
||||||
NextToken;
|
NextToken;
|
||||||
to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
|
to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
|
||||||
} else {
|
} else {
|
||||||
to_store[1] = MkAtomTerm(AtomNil);
|
to_store[1] = MkAtomTerm(AtomNil);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",LOCAL_tokptr->TokPos,
|
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",
|
||||||
Yap_tokRep(LOCAL_tokptr, enc));
|
LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
return (o);
|
return (o);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USES_REGS) {
|
static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc,
|
||||||
|
Term cmod USES_REGS) {
|
||||||
/* parse term with priority prio */
|
/* parse term with priority prio */
|
||||||
Volatile Term t;
|
Volatile Term t;
|
||||||
Volatile Functor func;
|
Volatile Functor func;
|
||||||
|
@ -684,10 +694,10 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
|
if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
|
||||||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
|
LOCAL_tokptr->TokInfo != Terml) &&
|
||||||
IsPrefixOp((Atom)t, &opprio, &oprprio, cmod PASS_REGS)) {
|
IsPrefixOp(AtomOfTerm(t), &opprio, &oprprio, cmod PASS_REGS)) {
|
||||||
if (LOCAL_tokptr->Tok == Name_tok) {
|
if (LOCAL_tokptr->Tok == Name_tok) {
|
||||||
Atom at = (Atom)LOCAL_tokptr->TokInfo;
|
Atom at = AtomOfTerm(LOCAL_tokptr->TokInfo);
|
||||||
#ifndef _MSC_VER
|
#ifndef _MSC_VER
|
||||||
if ((Atom)t == AtomPlus) {
|
if ((Atom)t == AtomPlus) {
|
||||||
if (at == AtomInf) {
|
if (at == AtomInf) {
|
||||||
|
@ -716,25 +726,23 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
/* try to parse as a prefix operator */
|
/* try to parse as a prefix operator */
|
||||||
TRY(
|
TRY(
|
||||||
/* build appl on the heap */
|
/* build appl on the heap */
|
||||||
func = Yap_MkFunctor((Atom)t, 1); if (func == NULL) {
|
func = Yap_MkFunctor(AtomOfTerm(t), 1); if (func == NULL) {
|
||||||
syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
} t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
|
||||||
t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
|
|
||||||
t = Yap_MkApplTerm(func, 1, &t);
|
t = Yap_MkApplTerm(func, 1, &t);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
} curprio = opprio;
|
} curprio = opprio;
|
||||||
, break;)
|
, break;)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
|
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
|
||||||
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
|
LOCAL_tokptr->TokInfo == Terml)
|
||||||
t = ParseArgs((Atom)t, ')', FailBuff, 0L, enc, cmod PASS_REGS);
|
t = ParseArgs(AtomOfTerm(t), TermEndBracket, FailBuff, 0L, enc,
|
||||||
else
|
cmod PASS_REGS);
|
||||||
t = MkAtomTerm((Atom)t);
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case Number_tok:
|
case Number_tok:
|
||||||
|
@ -743,9 +751,9 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case String_tok: /* build list on the heap */
|
case String_tok: /* build list on the heap */
|
||||||
t = LOCAL_tokptr->TokInfo;
|
t = LOCAL_tokptr->TokInfo;
|
||||||
NextToken;
|
NextToken;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case Var_tok:
|
case Var_tok:
|
||||||
varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
|
varinfo = (VarEntry *)(LOCAL_tokptr->TokInfo);
|
||||||
|
@ -756,33 +764,34 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case Error_tok:
|
case Error_tok:
|
||||||
syntax_msg("line %d: found ill-formed \"%s\"",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
syntax_msg("line %d: found ill-formed \"%s\"", LOCAL_tokptr->TokPos,
|
||||||
|
Yap_tokRep(LOCAL_tokptr, enc));
|
||||||
FAIL;
|
FAIL;
|
||||||
|
|
||||||
case Ponctuation_tok:
|
case Ponctuation_tok:
|
||||||
|
|
||||||
switch ((int)LOCAL_tokptr->TokInfo) {
|
switch (RepAtom(AtomOfTerm(LOCAL_tokptr->TokInfo))->StrOfAE[0]) {
|
||||||
case '(':
|
case '(':
|
||||||
case 'l': /* non solo ( */
|
case 'l': /* non solo ( */
|
||||||
NextToken;
|
NextToken;
|
||||||
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
|
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
|
||||||
checkfor(')', FailBuff, enc PASS_REGS);
|
checkfor(TermEndBracket, FailBuff, enc PASS_REGS);
|
||||||
break;
|
break;
|
||||||
case '[':
|
case '[':
|
||||||
NextToken;
|
NextToken;
|
||||||
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
|
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
|
||||||
(int)LOCAL_tokptr->TokInfo == ']') {
|
LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
|
||||||
t = TermNil;
|
t = TermNil;
|
||||||
NextToken;
|
NextToken;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
t = ParseList(FailBuff, enc, cmod PASS_REGS);
|
t = ParseList(FailBuff, enc, cmod PASS_REGS);
|
||||||
checkfor(']', FailBuff, enc PASS_REGS);
|
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
|
||||||
break;
|
break;
|
||||||
case '{':
|
case '{':
|
||||||
NextToken;
|
NextToken;
|
||||||
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
|
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
|
||||||
(int)LOCAL_tokptr->TokInfo == '}') {
|
(int)LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
|
||||||
t = MkAtomTerm(AtomBraces);
|
t = MkAtomTerm(AtomBraces);
|
||||||
NextToken;
|
NextToken;
|
||||||
break;
|
break;
|
||||||
|
@ -791,13 +800,14 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
|
t = Yap_MkApplTerm(FunctorBraces, 1, &t);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
checkfor('}', FailBuff, enc PASS_REGS);
|
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
syntax_msg("line %d: unexpected ponctuation signal %s",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
syntax_msg("line %d: unexpected ponctuation signal %s",
|
||||||
|
LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
@ -888,33 +898,34 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
NextToken;
|
NextToken;
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos,
|
||||||
|
Yap_tokRep(LOCAL_tokptr, enc));
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* main loop to parse infix and posfix operators starts here */
|
/* main loop to parse infix and posfix operators starts here */
|
||||||
while (true) {
|
while (true) {
|
||||||
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
|
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
|
||||||
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
|
Yap_HasOp(AtomOfTerm(LOCAL_tokptr->TokInfo))) {
|
||||||
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
|
Atom save_opinfo = opinfo = AtomOfTerm(LOCAL_tokptr->TokInfo);
|
||||||
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((Atom)LOCAL_tokptr->TokInfo, 2);
|
func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 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;
|
||||||
} NextToken;
|
} NextToken;
|
||||||
{
|
{
|
||||||
Term args[2];
|
Term args[2];
|
||||||
args[0] = t;
|
args[0] = t;
|
||||||
args[1] = ParseTerm(oprprio, FailBuff,enc, cmod PASS_REGS);
|
args[1] = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
|
||||||
t = Yap_MkApplTerm(func, 2, args);
|
t = Yap_MkApplTerm(func, 2, args);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
@ -922,18 +933,18 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
|
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
|
||||||
curprio = oldprio;)
|
curprio = oldprio;)
|
||||||
}
|
}
|
||||||
if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) && opprio <= prio &&
|
if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) &&
|
||||||
oplprio >= curprio) {
|
opprio <= prio && oplprio >= curprio) {
|
||||||
/* parse as posfix operator */
|
/* parse as posfix operator */
|
||||||
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
|
Functor func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 1);
|
||||||
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;
|
||||||
}
|
}
|
||||||
t = Yap_MkApplTerm(func, 1, &t);
|
t = Yap_MkApplTerm(func, 1, &t);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
curprio = opprio;
|
curprio = opprio;
|
||||||
|
@ -943,8 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
|
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
|
||||||
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
|
if (LOCAL_tokptr->TokInfo == TermDot && prio >= 1000 && curprio <= 999) {
|
||||||
curprio <= 999) {
|
|
||||||
Volatile Term args[2];
|
Volatile Term args[2];
|
||||||
NextToken;
|
NextToken;
|
||||||
args[0] = t;
|
args[0] = t;
|
||||||
|
@ -952,13 +962,14 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
t = Yap_MkApplTerm(FunctorComma, 2, args);
|
t = Yap_MkApplTerm(FunctorComma, 2, args);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
curprio = 1000;
|
curprio = 1000;
|
||||||
continue;
|
continue;
|
||||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
|
} else if (LOCAL_tokptr->TokInfo == TermVBar &&
|
||||||
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
|
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio,
|
||||||
|
cmod PASS_REGS) &&
|
||||||
opprio <= prio && oplprio >= curprio) {
|
opprio <= prio && oplprio >= curprio) {
|
||||||
Volatile Term args[2];
|
Volatile Term args[2];
|
||||||
NextToken;
|
NextToken;
|
||||||
|
@ -967,37 +978,42 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
|
||||||
t = Yap_MkApplTerm(FunctorVBar, 2, args);
|
t = Yap_MkApplTerm(FunctorVBar, 2, args);
|
||||||
/* check for possible overflow against local stack */
|
/* check for possible overflow against local stack */
|
||||||
if (HR > ASP - 4096) {
|
if (HR > ASP - 4096) {
|
||||||
syntax_msg("line %d: Stack Overflow",LOCAL_tokptr->TokPos);
|
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
curprio = opprio;
|
curprio = opprio;
|
||||||
continue;
|
continue;
|
||||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
|
} else if (LOCAL_tokptr->TokInfo == TermBeginBracket &&
|
||||||
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, cmod PASS_REGS) &&
|
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio,
|
||||||
|
cmod PASS_REGS) &&
|
||||||
opprio <= prio && oplprio >= curprio) {
|
opprio <= prio && oplprio >= curprio) {
|
||||||
t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, enc, cmod PASS_REGS);
|
t = ParseArgs(AtomEmptyBrackets, TermEndBracket, FailBuff, t, enc,
|
||||||
|
cmod PASS_REGS);
|
||||||
curprio = opprio;
|
curprio = opprio;
|
||||||
continue;
|
continue;
|
||||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
|
} else if (LOCAL_tokptr->TokInfo == TermBeginSquareBracket &&
|
||||||
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
|
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio,
|
||||||
&oplprio, cmod PASS_REGS) &&
|
cmod PASS_REGS) &&
|
||||||
opprio <= prio && oplprio >= curprio) {
|
opprio <= prio && oplprio >= curprio) {
|
||||||
t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, enc, cmod PASS_REGS);
|
t = ParseArgs(AtomEmptySquareBrackets, TermEndSquareBracket, FailBuff,
|
||||||
|
t, enc, cmod PASS_REGS);
|
||||||
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
|
t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS);
|
||||||
curprio = opprio;
|
curprio = opprio;
|
||||||
continue;
|
continue;
|
||||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
|
} else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
|
||||||
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
|
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio,
|
||||||
&oplprio, cmod PASS_REGS) &&
|
cmod PASS_REGS) &&
|
||||||
opprio <= prio && oplprio >= curprio) {
|
opprio <= prio && oplprio >= curprio) {
|
||||||
t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, enc, cmod PASS_REGS);
|
t = ParseArgs(AtomEmptyCurlyBrackets, TermEndCurlyBracket, FailBuff, t,
|
||||||
|
enc, cmod PASS_REGS);
|
||||||
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
|
t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS);
|
||||||
curprio = opprio;
|
curprio = opprio;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) {
|
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) {
|
||||||
syntax_msg("line %d: expected operator, got \'%s\'",LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
|
syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos,
|
||||||
|
Yap_tokRep(LOCAL_tokptr, enc));
|
||||||
FAIL;
|
FAIL;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
|
17
C/qlyr.c
17
C/qlyr.c
|
@ -688,22 +688,7 @@ static void ReadHash(FILE *stream) {
|
||||||
Atom at;
|
Atom at;
|
||||||
qlf_tag_t tg = read_tag(stream);
|
qlf_tag_t tg = read_tag(stream);
|
||||||
|
|
||||||
if (tg == QLY_ATOM_WIDE) {
|
if (tg == QLY_ATOM) {
|
||||||
wchar_t *rep = (wchar_t *)AllocTempSpace();
|
|
||||||
UInt len;
|
|
||||||
|
|
||||||
len = read_UInt(stream);
|
|
||||||
if (!EnoughTempSpace(len))
|
|
||||||
QLYR_ERROR(OUT_OF_TEMP_SPACE);
|
|
||||||
read_bytes(stream, rep, (len + 1) * sizeof(wchar_t));
|
|
||||||
while (!(at = Yap_LookupWideAtom(rep))) {
|
|
||||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
|
||||||
exit(1);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (at == NIL)
|
|
||||||
QLYR_ERROR(OUT_OF_ATOM_SPACE);
|
|
||||||
} else if (tg == QLY_ATOM) {
|
|
||||||
char *rep = (char *)AllocTempSpace();
|
char *rep = (char *)AllocTempSpace();
|
||||||
UInt len;
|
UInt len;
|
||||||
|
|
||||||
|
|
7
C/qlyw.c
7
C/qlyw.c
|
@ -505,7 +505,6 @@ DBRefAdjust__ (DBRef dbt USES_REGS)
|
||||||
|
|
||||||
#define rehash(oldcode, NOfE, KindOfEntries)
|
#define rehash(oldcode, NOfE, KindOfEntries)
|
||||||
|
|
||||||
#define RestoreSWIHash()
|
|
||||||
|
|
||||||
static void RestoreFlags( UInt NFlags )
|
static void RestoreFlags( UInt NFlags )
|
||||||
{
|
{
|
||||||
|
@ -584,15 +583,9 @@ SaveHash(FILE *stream)
|
||||||
if (a->val) {
|
if (a->val) {
|
||||||
Atom at = a->val;
|
Atom at = a->val;
|
||||||
CHECK(save_UInt(stream, (UInt)at));
|
CHECK(save_UInt(stream, (UInt)at));
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
CHECK(save_tag(stream, QLY_ATOM_WIDE));
|
|
||||||
CHECK(save_UInt(stream, wcslen(RepAtom(at)->WStrOfAE)));
|
|
||||||
CHECK(save_bytes(stream, at->WStrOfAE, (wcslen(at->WStrOfAE)+1)*sizeof(wchar_t)));
|
|
||||||
} else {
|
|
||||||
CHECK(save_tag(stream, QLY_ATOM));
|
CHECK(save_tag(stream, QLY_ATOM));
|
||||||
CHECK(save_UInt(stream, strlen((char *)RepAtom(at)->StrOfAE)));
|
CHECK(save_UInt(stream, strlen((char *)RepAtom(at)->StrOfAE)));
|
||||||
CHECK(save_bytes(stream, (char *)at->StrOfAE, (strlen((char *)at->StrOfAE)+1)*sizeof(char)));
|
CHECK(save_bytes(stream, (char *)at->StrOfAE, (strlen((char *)at->StrOfAE)+1)*sizeof(char)));
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
save_tag(stream, QLY_START_FUNCTORS);
|
save_tag(stream, QLY_START_FUNCTORS);
|
||||||
|
|
462
C/scanner.c
462
C/scanner.c
|
@ -435,7 +435,7 @@ writing, writing a BOM can be requested using the option
|
||||||
#define my_islower(C) (C >= 'a' && C <= 'z')
|
#define my_islower(C) (C >= 'a' && C <= 'z')
|
||||||
|
|
||||||
static Term float_send(char *, int);
|
static Term float_send(char *, int);
|
||||||
static Term get_num(int *, int *, struct stream_desc *, char *, UInt, int);
|
static Term get_num(int *, int *, struct stream_desc *, int);
|
||||||
|
|
||||||
static void Yap_setCurrentSourceLocation(struct stream_desc *s) {
|
static void Yap_setCurrentSourceLocation(struct stream_desc *s) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
|
@ -584,7 +584,7 @@ static TokEntry *AuxSpaceError__(TokEntry *p, TokEntry *l,
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void * InitScannerMemory(void) {
|
static void *InitScannerMemory(void) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
LOCAL_ErrorMessage = NULL;
|
LOCAL_ErrorMessage = NULL;
|
||||||
LOCAL_Error_Size = 0;
|
LOCAL_Error_Size = 0;
|
||||||
|
@ -880,15 +880,34 @@ static int num_send_error_message(char s[]) {
|
||||||
return TermNil;
|
return TermNil;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#define number_overflow() \
|
||||||
|
{ \
|
||||||
|
size_t nsz = min(max_size * 2, max_size); \
|
||||||
|
char *nbuf; \
|
||||||
|
\
|
||||||
|
if (buf == buf0) { \
|
||||||
|
nbuf = malloc(nsz); \
|
||||||
|
} else { \
|
||||||
|
nbuf = realloc(buf, nsz); \
|
||||||
|
} \
|
||||||
|
if (!nbuf) { \
|
||||||
|
return num_send_error_message("Number Too Long"); \
|
||||||
|
} else { \
|
||||||
|
left = nsz - max_size; \
|
||||||
|
max_size = nsz; \
|
||||||
|
buf = nbuf; \
|
||||||
|
} \
|
||||||
|
}
|
||||||
|
|
||||||
/* reads a number, either integer or float */
|
/* reads a number, either integer or float */
|
||||||
|
|
||||||
static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, int sign) {
|
||||||
UInt max_size, int sign) {
|
|
||||||
char *sp = s;
|
|
||||||
int ch = *chp;
|
int ch = *chp;
|
||||||
Int val = 0L, base = ch - '0';
|
Int val = 0L, base = ch - '0';
|
||||||
int might_be_float = TRUE, has_overflow = FALSE;
|
int might_be_float = TRUE, has_overflow = FALSE;
|
||||||
const unsigned char *decimalpoint;
|
const unsigned char *decimalpoint;
|
||||||
|
char buf0[256], *sp = buf0, *buf = buf0;
|
||||||
|
int max_size = 254, left = 254;
|
||||||
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
|
@ -898,9 +917,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
*/
|
*/
|
||||||
if (chtype(ch) == NU) {
|
if (chtype(ch) == NU) {
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
base = 10 * base + ch - '0';
|
base = 10 * base + ch - '0';
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
}
|
}
|
||||||
|
@ -909,9 +927,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
return num_send_error_message("Admissible bases are 0..36");
|
return num_send_error_message("Admissible bases are 0..36");
|
||||||
}
|
}
|
||||||
might_be_float = FALSE;
|
might_be_float = FALSE;
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
if (base == 0) {
|
if (base == 0) {
|
||||||
|
@ -939,9 +956,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
int chval =
|
int chval =
|
||||||
(chtype(ch) == NU ? ch - '0'
|
(chtype(ch) == NU ? ch - '0'
|
||||||
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
|
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
val = oval * base + chval;
|
val = oval * base + chval;
|
||||||
if (oval != (val - chval) / base) /* overflow */
|
if (oval != (val - chval) / base) /* overflow */
|
||||||
|
@ -951,9 +967,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
}
|
}
|
||||||
} else if (ch == 'x' && base == 0) {
|
} else if (ch == 'x' && base == 0) {
|
||||||
might_be_float = FALSE;
|
might_be_float = FALSE;
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
while (my_isxdigit(ch, 'F', 'f')) {
|
while (my_isxdigit(ch, 'F', 'f')) {
|
||||||
|
@ -961,9 +976,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
int chval =
|
int chval =
|
||||||
(chtype(ch) == NU ? ch - '0'
|
(chtype(ch) == NU ? ch - '0'
|
||||||
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
|
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
val = val * 16 + chval;
|
val = val * 16 + chval;
|
||||||
if (oval != (val - chval) / 16) /* overflow */
|
if (oval != (val - chval) / 16) /* overflow */
|
||||||
|
@ -986,9 +1000,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
while (chtype(ch) == NU) {
|
while (chtype(ch) == NU) {
|
||||||
Int oval = val;
|
Int oval = val;
|
||||||
if (!(val == 0 && ch == '0') || has_overflow) {
|
if (!(val == 0 && ch == '0') || has_overflow) {
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
}
|
}
|
||||||
if (ch - '0' >= base) {
|
if (ch - '0' >= base) {
|
||||||
|
@ -1019,7 +1032,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
*chbuffp = '.';
|
*chbuffp = '.';
|
||||||
*chp = ch;
|
*chp = ch;
|
||||||
if (has_overflow)
|
if (has_overflow)
|
||||||
return read_int_overflow(s, base, val, sign);
|
return read_int_overflow(buf, base, val, sign);
|
||||||
if (sign == -1)
|
if (sign == -1)
|
||||||
return MkIntegerTerm(-val);
|
return MkIntegerTerm(-val);
|
||||||
return MkIntegerTerm(val);
|
return MkIntegerTerm(val);
|
||||||
|
@ -1034,30 +1047,26 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
/* translate . to current locale */
|
/* translate . to current locale */
|
||||||
while ((dc = *dp++) != '\0') {
|
while ((dc = *dp++) != '\0') {
|
||||||
*sp++ = dc;
|
*sp++ = dc;
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
}
|
}
|
||||||
/* numbers after . */
|
/* numbers after . */
|
||||||
if (chtype(ch) == NU) {
|
if (chtype(ch) == NU) {
|
||||||
do {
|
do {
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
} while (chtype(ch = getchr(inp_stream)) == NU);
|
} while (chtype(ch = getchr(inp_stream)) == NU);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (ch == 'e' || ch == 'E') {
|
if (ch == 'e' || ch == 'E') {
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
if (ch == '-') {
|
if (ch == '-') {
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = '-';
|
*sp++ = '-';
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
} else if (ch == '+') {
|
} else if (ch == '+') {
|
||||||
|
@ -1066,34 +1075,33 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
|
||||||
if (chtype(ch) != NU) {
|
if (chtype(ch) != NU) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
if (has_dot)
|
if (has_dot)
|
||||||
return float_send(s, sign);
|
return float_send(buf, sign);
|
||||||
return MkIntegerTerm(sign * val);
|
return MkIntegerTerm(sign * val);
|
||||||
}
|
}
|
||||||
do {
|
do {
|
||||||
if (--max_size == 0) {
|
if (--left == 0)
|
||||||
return num_send_error_message("Number Too Long");
|
number_overflow();
|
||||||
}
|
|
||||||
*sp++ = ch;
|
*sp++ = ch;
|
||||||
} while (chtype(ch = getchr(inp_stream)) == NU);
|
} while (chtype(ch = getchr(inp_stream)) == NU);
|
||||||
}
|
}
|
||||||
*sp = '\0';
|
*sp = '\0';
|
||||||
*chp = ch;
|
*chp = ch;
|
||||||
return float_send(s, sign);
|
return float_send(buf, sign);
|
||||||
} else if (has_overflow) {
|
} else if (has_overflow) {
|
||||||
*sp = '\0';
|
*sp = '\0';
|
||||||
/* skip base */
|
/* skip base */
|
||||||
*chp = ch;
|
*chp = ch;
|
||||||
if (s[0] == '0' && s[1] == 'x')
|
if (buf[0] == '0' && buf[1] == 'x')
|
||||||
return read_int_overflow(s + 2, 16, val, sign);
|
return read_int_overflow(buf + 2, 16, val, sign);
|
||||||
else if (s[0] == '0' && s[1] == 'o')
|
else if (buf[0] == '0' && buf[1] == 'o')
|
||||||
return read_int_overflow(s + 2, 8, val, sign);
|
return read_int_overflow(buf + 2, 8, val, sign);
|
||||||
else if (s[0] == '0' && s[1] == 'b')
|
else if (buf[0] == '0' && buf[1] == 'b')
|
||||||
return read_int_overflow(s + 2, 2, val, sign);
|
return read_int_overflow(buf + 2, 2, val, sign);
|
||||||
if (s[1] == '\'')
|
if (buf[1] == '\'')
|
||||||
return read_int_overflow(s + 2, base, val, sign);
|
return read_int_overflow(buf + 2, base, val, sign);
|
||||||
if (s[2] == '\'')
|
if (buf[2] == '\'')
|
||||||
return read_int_overflow(s + 3, base, val, sign);
|
return read_int_overflow(buf + 3, base, val, sign);
|
||||||
return read_int_overflow(s, base, val, sign);
|
return read_int_overflow(buf, base, val, sign);
|
||||||
} else {
|
} else {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
*chp = ch;
|
*chp = ch;
|
||||||
|
@ -1120,9 +1128,11 @@ Term Yap_scan_num(StreamDesc *inp) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
#if HAVE_ISWBLANK
|
#if HAVE_ISWBLANK
|
||||||
while (iswblank( ch = getchr(inp) ));
|
while (iswblank(ch = getchr(inp)))
|
||||||
|
;
|
||||||
#else
|
#else
|
||||||
while (isspace( ch = getchr(inp) ));
|
while (isspace(ch = getchr(inp)))
|
||||||
|
;
|
||||||
#endif
|
#endif
|
||||||
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
tokptr->TokPos = GetCurInpPos(inp);
|
tokptr->TokPos = GetCurInpPos(inp);
|
||||||
|
@ -1136,11 +1146,11 @@ Term Yap_scan_num(StreamDesc *inp) {
|
||||||
cherr = '\0';
|
cherr = '\0';
|
||||||
if (ASP - HR < 1024) {
|
if (ASP - HR < 1024) {
|
||||||
Yap_clean_tokenizer(old_tr, NULL, NULL);
|
Yap_clean_tokenizer(old_tr, NULL, NULL);
|
||||||
LOCAL_ErrorMessage = "Stack Overflow";
|
LOCAL_ErrorMessage = "Stack Overflow";
|
||||||
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
|
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
|
out = get_num(&ch, &cherr, inp, sign); /* */
|
||||||
}
|
}
|
||||||
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) {
|
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
|
@ -1174,7 +1184,7 @@ Term Yap_scan_num(StreamDesc *inp) {
|
||||||
size_t len = strlen(ptr);
|
size_t len = strlen(ptr);
|
||||||
mp = AllocScannerMemory(len + 1);
|
mp = AllocScannerMemory(len + 1);
|
||||||
tokptr->Tok = Ord(kind = String_tok);
|
tokptr->Tok = Ord(kind = String_tok);
|
||||||
tokptr->TokInfo = Unsigned(mp);
|
tokptr->TokInfo = MkStringTerm(mp);
|
||||||
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
ef = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
ef = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
tokptr->TokNext = e;
|
tokptr->TokNext = e;
|
||||||
|
@ -1214,60 +1224,35 @@ Term Yap_scan_num(StreamDesc *inp) {
|
||||||
return l; \
|
return l; \
|
||||||
}
|
}
|
||||||
|
|
||||||
const char *Yap_tokRep(TokEntry *tokptr, encoding_t encoding) {
|
const char *Yap_tokRep(void *tokptre, encoding_t encoding) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
|
TokEntry *tokptr = tokptre;
|
||||||
Term info = tokptr->TokInfo;
|
Term info = tokptr->TokInfo;
|
||||||
char *buf = LOCAL_FileNameBuf2;
|
|
||||||
size_t length;
|
size_t length;
|
||||||
UInt flags = 0;
|
UInt flags = 0;
|
||||||
|
|
||||||
switch (tokptr->Tok) {
|
switch (tokptr->Tok) {
|
||||||
case Name_tok:
|
case Name_tok:
|
||||||
if (IsWideAtom((Atom)info)) {
|
|
||||||
wchar_t *wc = RepAtom((Atom)info)->WStrOfAE;
|
|
||||||
Term s = Yap_WCharsToString(wc PASS_REGS);
|
|
||||||
return StringOfTerm(s);
|
|
||||||
}
|
|
||||||
return RepAtom((Atom)info)->StrOfAE;
|
|
||||||
case Number_tok:
|
case Number_tok:
|
||||||
|
case Ponctuation_tok:
|
||||||
|
case String_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 varinfo->VarRep;
|
||||||
}
|
}
|
||||||
case String_tok:
|
|
||||||
case BQString_tok:
|
|
||||||
return (char *)info;
|
|
||||||
case WString_tok:
|
|
||||||
case WBQString_tok: {
|
|
||||||
wchar_t *op = (wchar_t *)info;
|
|
||||||
wchar_t c;
|
|
||||||
unsigned char *bp = (unsigned char *)buf;
|
|
||||||
while ((c = *op++)) {
|
|
||||||
bp += put_utf8(bp, c);
|
|
||||||
}
|
|
||||||
bp[0] = '\0';
|
|
||||||
return buf;
|
|
||||||
}
|
|
||||||
case Error_tok:
|
case Error_tok:
|
||||||
return "<ERR>";
|
return "<ERR>";
|
||||||
case eot_tok:
|
case eot_tok:
|
||||||
return "<EOT>";
|
return "<EOT>";
|
||||||
case Ponctuation_tok: {
|
|
||||||
buf[1] = '\0';
|
|
||||||
if ((info) == 'l') {
|
|
||||||
buf[0] = '(';
|
|
||||||
} else {
|
|
||||||
buf[0] = (char)info;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return buf;
|
|
||||||
case QuasiQuotes_tok:
|
case QuasiQuotes_tok:
|
||||||
case WQuasiQuotes_tok:
|
case WQuasiQuotes_tok:
|
||||||
return "<QQ>";
|
return "<QQ>";
|
||||||
default:
|
|
||||||
return "??";
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1319,52 +1304,8 @@ static void mark_eof(struct stream_desc *inp_stream) {
|
||||||
inp_stream->status |= Push_Eof_Stream_f;
|
inp_stream->status |= Push_Eof_Stream_f;
|
||||||
}
|
}
|
||||||
|
|
||||||
static wchar_t *ch_to_wide(char *base, char *charp) {
|
|
||||||
CACHE_REGS
|
|
||||||
int n = charp - base, i;
|
|
||||||
wchar_t *nb = (wchar_t *)base;
|
|
||||||
|
|
||||||
if ((nb + n) + 1024 > (wchar_t *)AuxSp) {
|
|
||||||
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
|
|
||||||
LOCAL_ErrorMessage =
|
|
||||||
"Heap Overflow While Scanning: please increase code space (-h)";
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
for (i = n; i > 0; i--) {
|
|
||||||
nb[i - 1] = (unsigned char)base[i - 1];
|
|
||||||
}
|
|
||||||
return nb + n;
|
|
||||||
}
|
|
||||||
|
|
||||||
#define add_ch_to_buff(ch) \
|
#define add_ch_to_buff(ch) \
|
||||||
if (wcharp) { \
|
{ charp += put_utf8(charp, ch); }
|
||||||
*wcharp++ = (ch); \
|
|
||||||
if (wcharp >= (wchar_t *)AuxSp - 1024) \
|
|
||||||
goto huge_var_error; \
|
|
||||||
charp = (char *)wcharp; \
|
|
||||||
} else { \
|
|
||||||
if (ch > MAX_ISO_LATIN1 && !wcharp) { \
|
|
||||||
/* does not fit in ISO-LATIN */ \
|
|
||||||
wcharp = ch_to_wide(TokImage, charp); \
|
|
||||||
if (!wcharp) \
|
|
||||||
goto huge_var_error; \
|
|
||||||
*wcharp++ = (ch); \
|
|
||||||
charp = (char *)wcharp; \
|
|
||||||
} else { \
|
|
||||||
if (charp >= (char *)AuxSp - 1024) \
|
|
||||||
goto huge_var_error; \
|
|
||||||
*charp++ = ch; \
|
|
||||||
} \
|
|
||||||
}
|
|
||||||
|
|
||||||
#define add_ch_to_utf8_buff(ch) \
|
|
||||||
{ \
|
|
||||||
if ((ch & 0xff) == ch) { \
|
|
||||||
*charp++ = ch; \
|
|
||||||
} else { \
|
|
||||||
charp = _PL__put_utf8(charp, chr); \
|
|
||||||
} \
|
|
||||||
}
|
|
||||||
|
|
||||||
TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
Term *tposp) {
|
Term *tposp) {
|
||||||
|
@ -1373,8 +1314,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
TokEntry *t, *l, *p;
|
TokEntry *t, *l, *p;
|
||||||
enum TokenKinds kind;
|
enum TokenKinds kind;
|
||||||
int solo_flag = TRUE;
|
int solo_flag = TRUE;
|
||||||
int ch;
|
int32_t ch, och;
|
||||||
wchar_t *wcharp;
|
|
||||||
struct qq_struct_t *cur_qq = NULL;
|
struct qq_struct_t *cur_qq = NULL;
|
||||||
|
|
||||||
InitScannerMemory();
|
InitScannerMemory();
|
||||||
|
@ -1391,11 +1331,10 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
LOCAL_StartLineCount = inp_stream->linecount;
|
LOCAL_StartLineCount = inp_stream->linecount;
|
||||||
LOCAL_StartLinePos = inp_stream->linepos;
|
LOCAL_StartLinePos = inp_stream->linepos;
|
||||||
do {
|
do {
|
||||||
wchar_t och, pch;
|
|
||||||
int quote, isvar;
|
int quote, isvar;
|
||||||
char *charp, *mp;
|
unsigned char *charp, *mp;
|
||||||
unsigned int len;
|
unsigned int len;
|
||||||
char *TokImage = NULL;
|
unsigned char *TokImage = NULL;
|
||||||
|
|
||||||
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
t->TokNext = NULL;
|
t->TokNext = NULL;
|
||||||
|
@ -1417,14 +1356,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
|
|
||||||
case CC:
|
case CC:
|
||||||
if (store_comments) {
|
if (store_comments) {
|
||||||
CHECK_SPACE();
|
|
||||||
open_comment(ch, inp_stream PASS_REGS);
|
open_comment(ch, inp_stream PASS_REGS);
|
||||||
continue_comment:
|
continue_comment:
|
||||||
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) {
|
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) {
|
||||||
CHECK_SPACE();
|
|
||||||
extend_comment(ch PASS_REGS);
|
extend_comment(ch PASS_REGS);
|
||||||
}
|
}
|
||||||
CHECK_SPACE();
|
|
||||||
extend_comment(ch PASS_REGS);
|
extend_comment(ch PASS_REGS);
|
||||||
if (chtype(ch) != EF) {
|
if (chtype(ch) != EF) {
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
|
@ -1445,7 +1381,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
while (chtype(ch) == BS) {
|
while (chtype(ch) == BS) {
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
}
|
}
|
||||||
CHECK_SPACE();
|
|
||||||
*tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
|
*tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
|
||||||
Yap_setCurrentSourceLocation(inp_stream);
|
Yap_setCurrentSourceLocation(inp_stream);
|
||||||
}
|
}
|
||||||
|
@ -1459,27 +1394,31 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
|
|
||||||
case UC:
|
case UC:
|
||||||
case UL:
|
case UL:
|
||||||
case LC:
|
case LC: {
|
||||||
och = ch;
|
int32_t och = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
|
size_t sz = 512;
|
||||||
scan_name:
|
scan_name:
|
||||||
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
|
TokImage = Malloc(sz PASS_REGS);
|
||||||
charp = TokImage;
|
charp = (unsigned char *)TokImage;
|
||||||
wcharp = NULL;
|
|
||||||
isvar = (chtype(och) != LC);
|
isvar = (chtype(och) != LC);
|
||||||
add_ch_to_buff(och);
|
add_ch_to_buff(och);
|
||||||
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
|
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
|
||||||
if (charp == (char *)AuxSp - 1024) {
|
if (charp == TokImage + (sz - 1)) {
|
||||||
huge_var_error:
|
unsigned char *p0 = TokImage;
|
||||||
return AuxSpaceError(p, l, "Code Space Overflow due to huge atom");
|
sz = min(sz * 2, sz + MBYTE);
|
||||||
/* huge atom or variable, we are in trouble */
|
TokImage = Realloc(p0, sz);
|
||||||
|
if (TokImage == NULL) {
|
||||||
|
return CodeSpaceError(t, p, l);
|
||||||
|
}
|
||||||
|
charp = TokImage - (charp - p0);
|
||||||
}
|
}
|
||||||
add_ch_to_buff(ch);
|
add_ch_to_buff(ch);
|
||||||
}
|
}
|
||||||
while (ch == '\'' && isvar &&
|
while (ch == '\'' && isvar &&
|
||||||
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
|
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
|
||||||
if (charp == (char *)AuxSp - 1024) {
|
if (charp == (unsigned char *)AuxSp - 1024) {
|
||||||
goto huge_var_error;
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
add_ch_to_buff(ch);
|
add_ch_to_buff(ch);
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
|
@ -1488,42 +1427,34 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
if (!isvar) {
|
if (!isvar) {
|
||||||
Atom ae;
|
Atom ae;
|
||||||
/* don't do this in iso */
|
/* don't do this in iso */
|
||||||
if (wcharp) {
|
ae = Yap_ULookupAtom(TokImage);
|
||||||
ae = Yap_LookupWideAtom((wchar_t *)TokImage);
|
Free(TokImage);
|
||||||
} else {
|
|
||||||
ae = Yap_LookupAtom(TokImage);
|
|
||||||
}
|
|
||||||
if (ae == NIL) {
|
if (ae == NIL) {
|
||||||
return CodeSpaceError(t, p, l);
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
t->TokInfo = Unsigned(ae);
|
t->TokInfo = MkAtomTerm(ae);
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
if (ch == '(')
|
if (ch == '(')
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
} else {
|
} else {
|
||||||
VarEntry *ve = Yap_LookupVar(TokImage);
|
VarEntry *ve = Yap_LookupVar((const char *)TokImage);
|
||||||
|
Free(TokImage);
|
||||||
t->TokInfo = Unsigned(ve);
|
t->TokInfo = Unsigned(ve);
|
||||||
if (cur_qq) {
|
if (cur_qq) {
|
||||||
ve->refs++;
|
ve->refs++;
|
||||||
}
|
}
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
t->Tok = Ord(kind = Var_tok);
|
t->Tok = Ord(kind = Var_tok);
|
||||||
}
|
}
|
||||||
break;
|
|
||||||
|
} break;
|
||||||
|
|
||||||
case NU: {
|
case NU: {
|
||||||
int cherr;
|
int cherr;
|
||||||
int cha = ch;
|
int cha = ch;
|
||||||
char *ptr;
|
|
||||||
|
|
||||||
cherr = 0;
|
cherr = 0;
|
||||||
if (!(ptr = AllocScannerMemory(4096))) {
|
|
||||||
return TrailSpaceError(t, l);
|
|
||||||
}
|
|
||||||
CHECK_SPACE();
|
CHECK_SPACE();
|
||||||
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, ptr, 4096, 1)) ==
|
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, 1)) == 0L) {
|
||||||
0L) {
|
|
||||||
if (p) {
|
if (p) {
|
||||||
p->Tok = eot_tok;
|
p->Tok = eot_tok;
|
||||||
t->TokInfo = TermError;
|
t->TokInfo = TermError;
|
||||||
|
@ -1531,7 +1462,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
/* serious error now */
|
/* serious error now */
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
PopScannerMemory(ptr, 4096);
|
|
||||||
ch = cha;
|
ch = cha;
|
||||||
if (cherr) {
|
if (cherr) {
|
||||||
TokEntry *e;
|
TokEntry *e;
|
||||||
|
@ -1560,7 +1490,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
TokEntry *e2;
|
TokEntry *e2;
|
||||||
|
|
||||||
t->Tok = Ord(Var_tok);
|
t->Tok = Ord(Var_tok);
|
||||||
t->TokInfo = Unsigned(Yap_LookupVar("E"));
|
t->TokInfo = (Term)Yap_LookupVar("E");
|
||||||
t->TokPos = GetCurInpPos(inp_stream);
|
t->TokPos = GetCurInpPos(inp_stream);
|
||||||
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
if (e2 == NULL) {
|
if (e2 == NULL) {
|
||||||
|
@ -1586,7 +1516,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
t->Tok = Name_tok;
|
t->Tok = Name_tok;
|
||||||
if (ch == '(')
|
if (ch == '(')
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
t->TokInfo = Unsigned(AtomE);
|
t->TokInfo = MkAtomTerm(AtomE);
|
||||||
t->TokPos = GetCurInpPos(inp_stream);
|
t->TokPos = GetCurInpPos(inp_stream);
|
||||||
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
|
||||||
if (e2 == NULL) {
|
if (e2 == NULL) {
|
||||||
|
@ -1610,18 +1540,19 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
case QT:
|
case QT:
|
||||||
case DC:
|
case DC:
|
||||||
quoted_string:
|
quoted_string:
|
||||||
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
|
TokImage = Malloc(1048);
|
||||||
charp = TokImage;
|
charp = TokImage;
|
||||||
quote = ch;
|
quote = ch;
|
||||||
len = 0;
|
len = 0;
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
wcharp = NULL;
|
size_t sz = 1024;
|
||||||
|
|
||||||
while (TRUE) {
|
while (TRUE) {
|
||||||
if (charp + 1024 > (char *)AuxSp) {
|
if (charp > TokImage + (sz - 1)) {
|
||||||
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
|
TokImage = Realloc(TokImage, min(sz * 2, sz + MBYTE));
|
||||||
LOCAL_ErrorMessage =
|
if (TokImage == NULL) {
|
||||||
"Heap Overflow While Scanning: please increase code space (-h)";
|
return CodeSpaceError(t, p, l);
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {
|
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {
|
||||||
|
@ -1645,75 +1576,46 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
if (scan_next) {
|
if (scan_next) {
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
}
|
}
|
||||||
} else if (chtype(ch) == EF && ch <= MAX_ISO_LATIN1) {
|
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
mark_eof(inp_stream);
|
|
||||||
t->Tok = Ord(kind = eot_tok);
|
|
||||||
t->TokInfo = TermEof;
|
|
||||||
break;
|
|
||||||
} else {
|
} else {
|
||||||
add_ch_to_buff(ch);
|
add_ch_to_buff(ch);
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
}
|
}
|
||||||
++len;
|
++len;
|
||||||
if (charp > (char *)AuxSp - 1024) {
|
}
|
||||||
/* Not enough space to read in the string. */
|
*charp = '\0';
|
||||||
return AuxSpaceError(
|
if (quote == '"') {
|
||||||
t, l, "not enough space to read in string or quoted atom");
|
t->TokInfo = Yap_CharsToTDQ((char *)TokImage, CurrentModule,
|
||||||
|
LOCAL_encoding PASS_REGS);
|
||||||
|
if (!(t->TokInfo)) {
|
||||||
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
}
|
Free(TokImage);
|
||||||
if (wcharp) {
|
t->Tok = Ord(kind = String_tok);
|
||||||
*wcharp = '\0';
|
} else if (quote == '`') {
|
||||||
|
t->TokInfo = Yap_CharsToTBQ((char *)TokImage, CurrentModule,
|
||||||
|
LOCAL_encoding PASS_REGS);
|
||||||
|
if (!(t->TokInfo)) {
|
||||||
|
return CodeSpaceError(t, p, l);
|
||||||
|
}
|
||||||
|
Free(TokImage);
|
||||||
|
t->Tok = Ord(kind = String_tok);
|
||||||
} else {
|
} else {
|
||||||
*charp = '\0';
|
t->TokInfo = MkAtomTerm(Yap_ULookupAtom(TokImage));
|
||||||
|
if (!(t->TokInfo)) {
|
||||||
|
return CodeSpaceError(t, p, l);
|
||||||
|
}
|
||||||
|
Free(TokImage);
|
||||||
|
t->Tok = Ord(kind = Name_tok);
|
||||||
|
if (ch == '(')
|
||||||
|
solo_flag = false;
|
||||||
}
|
}
|
||||||
if (quote == '"' ) {
|
break;
|
||||||
if (wcharp) {
|
|
||||||
t->TokInfo = Yap_WCharsToTDQ((wchar_t *)TokImage,
|
|
||||||
CurrentModule
|
|
||||||
PASS_REGS);
|
|
||||||
} else {
|
|
||||||
t->TokInfo = Yap_CharsToTDQ(TokImage, CurrentModule, LOCAL_encoding
|
|
||||||
PASS_REGS);
|
|
||||||
}
|
|
||||||
if (!(t->TokInfo)) {
|
|
||||||
return CodeSpaceError(t, p, l);
|
|
||||||
}
|
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
t->Tok = Ord(kind = String_tok);
|
|
||||||
} else if (quote == '`') {
|
|
||||||
if (wcharp) {
|
|
||||||
t->TokInfo = Yap_WCharsToTBQ((wchar_t *)TokImage,
|
|
||||||
CurrentModule PASS_REGS);
|
|
||||||
} else {
|
|
||||||
t->TokInfo = Yap_CharsToTBQ(TokImage, CurrentModule,
|
|
||||||
LOCAL_encoding
|
|
||||||
PASS_REGS);
|
|
||||||
}
|
|
||||||
if (!(t->TokInfo)) {
|
|
||||||
return CodeSpaceError(t, p, l);
|
|
||||||
}
|
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
t->Tok = Ord(kind = String_tok);
|
|
||||||
} else {
|
|
||||||
if (wcharp) {
|
|
||||||
t->TokInfo = Unsigned(Yap_LookupWideAtom((wchar_t *)TokImage));
|
|
||||||
} else {
|
|
||||||
t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
|
|
||||||
}
|
|
||||||
if (!(t->TokInfo)) {
|
|
||||||
return CodeSpaceError(t, p, l);
|
|
||||||
}
|
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
t->Tok = Ord(kind = Name_tok);
|
|
||||||
if (ch == '(')
|
|
||||||
solo_flag = false;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
|
|
||||||
case BS:
|
case BS:
|
||||||
if (ch == '\0') {
|
if (ch == '\0') {
|
||||||
|
int pch;
|
||||||
t->Tok = Ord(kind = eot_tok);
|
t->Tok = Ord(kind = eot_tok);
|
||||||
|
pch = Yap_peek(inp_stream - GLOBAL_Stream);
|
||||||
if (chtype(pch) == EF) {
|
if (chtype(pch) == EF) {
|
||||||
mark_eof(inp_stream);
|
mark_eof(inp_stream);
|
||||||
t->TokInfo = TermEof;
|
t->TokInfo = TermEof;
|
||||||
|
@ -1725,15 +1627,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
} else
|
} else
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
break;
|
break;
|
||||||
case SY:
|
case SY: {
|
||||||
|
int pch;
|
||||||
if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) &&
|
if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) &&
|
||||||
(chtype(pch) == BS || chtype(pch) == EF || pch == '%')) {
|
(chtype(pch) == BS || chtype(pch) == EF || pch == '%')) {
|
||||||
t->Tok = Ord(kind = eot_tok);
|
t->Tok = Ord(kind = eot_tok);
|
||||||
// consume...
|
// consume...
|
||||||
if (pch == '%') {
|
if (pch == '%') {
|
||||||
t->TokInfo = TermNewLine;
|
t->TokInfo = TermNewLine;
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
if (chtype(ch) == EF) {
|
if (chtype(ch) == EF) {
|
||||||
mark_eof(inp_stream);
|
mark_eof(inp_stream);
|
||||||
|
@ -1753,11 +1656,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
if (ch == '%') {
|
if (ch == '%') {
|
||||||
t->TokInfo = TermNewLine;
|
t->TokInfo = TermNewLine;
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
if (chtype(ch) == EF) {
|
if (chtype(ch) == EF) {
|
||||||
mark_eof(inp_stream);
|
mark_eof(inp_stream);
|
||||||
t->TokInfo = TermEof;
|
t->TokInfo = TermEof;
|
||||||
} else {
|
} else {
|
||||||
t->TokInfo = TermNewLine;
|
t->TokInfo = TermNewLine;
|
||||||
}
|
}
|
||||||
return l;
|
return l;
|
||||||
|
@ -1803,14 +1706,15 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
}
|
}
|
||||||
goto restart;
|
goto restart;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
enter_symbol:
|
enter_symbol:
|
||||||
if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
|
if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
|
||||||
t->Tok = Ord(kind = eot_tok);
|
t->Tok = Ord(kind = eot_tok);
|
||||||
if (ch == '%') {
|
if (ch == '%') {
|
||||||
t->TokInfo = TermNewLine;
|
t->TokInfo = TermNewLine;
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
if (chtype(ch) == EF) {
|
if (chtype(ch) == EF) {
|
||||||
mark_eof(inp_stream);
|
mark_eof(inp_stream);
|
||||||
t->TokInfo = TermEof;
|
t->TokInfo = TermEof;
|
||||||
} else {
|
} else {
|
||||||
|
@ -1819,31 +1723,29 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
return l;
|
return l;
|
||||||
} else {
|
} else {
|
||||||
Atom ae;
|
Atom ae;
|
||||||
|
size_t sz = 1024;
|
||||||
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
|
TokImage = Malloc(sz);
|
||||||
charp = TokImage;
|
charp = TokImage;
|
||||||
wcharp = NULL;
|
|
||||||
add_ch_to_buff(och);
|
add_ch_to_buff(och);
|
||||||
for (; chtype(ch) == SY; ch = getchr(inp_stream)) {
|
for (; chtype(ch) == SY; ch = getchr(inp_stream)) {
|
||||||
if (charp == (char *)AuxSp - 1024) {
|
if (charp >= TokImage + (sz - 10)) {
|
||||||
goto huge_var_error;
|
sz = min(sz * 2, sz + MBYTE);
|
||||||
|
TokImage = Realloc(TokImage, sz);
|
||||||
|
if (!TokImage)
|
||||||
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
add_ch_to_buff(ch);
|
add_ch_to_buff(ch);
|
||||||
}
|
}
|
||||||
add_ch_to_buff('\0');
|
add_ch_to_buff('\0');
|
||||||
if (wcharp) {
|
ae = Yap_ULookupAtom(TokImage);
|
||||||
ae = Yap_LookupWideAtom((wchar_t *)TokImage);
|
|
||||||
} else {
|
|
||||||
ae = Yap_LookupAtom(TokImage);
|
|
||||||
}
|
|
||||||
if (ae == NIL) {
|
if (ae == NIL) {
|
||||||
return CodeSpaceError(t, p, l);
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
t->TokInfo = Unsigned(ae);
|
t->TokInfo = MkAtomTerm(ae);
|
||||||
if (t->TokInfo == (CELL)NIL) {
|
if (t->TokInfo == (CELL)NIL) {
|
||||||
return CodeSpaceError(t, p, l);
|
return CodeSpaceError(t, p, l);
|
||||||
}
|
}
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
Free(TokImage);
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
if (ch == '(')
|
if (ch == '(')
|
||||||
solo_flag = false;
|
solo_flag = false;
|
||||||
|
@ -1853,11 +1755,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case SL: {
|
case SL: {
|
||||||
char chs[2];
|
unsigned char chs[2];
|
||||||
chs[0] = ch;
|
chs[0] = ch;
|
||||||
chs[1] = '\0';
|
chs[1] = '\0';
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
t->TokInfo = Unsigned(Yap_LookupAtom(chs));
|
t->TokInfo = MkAtomTerm(Yap_ULookupAtom(chs));
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
if (ch == '(')
|
if (ch == '(')
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
|
@ -1866,19 +1768,25 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
case BK:
|
case BK:
|
||||||
och = ch;
|
och = ch;
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
t->TokInfo = och;
|
{
|
||||||
|
unsigned char chs[10];
|
||||||
|
TokImage = charp = chs;
|
||||||
|
add_ch_to_buff(och);
|
||||||
|
charp[0] = '\0';
|
||||||
|
t->TokInfo = MkAtomTerm(Yap_ULookupAtom(chs));
|
||||||
|
}
|
||||||
if (och == '(') {
|
if (och == '(') {
|
||||||
while (chtype(ch) == BS) {
|
while (chtype(ch) == BS) {
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
};
|
}
|
||||||
if (ch == ')') {
|
if (ch == ')') {
|
||||||
t->TokInfo = Unsigned(AtomEmptyBrackets);
|
t->TokInfo = TermEmptyBrackets;
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
break;
|
break;
|
||||||
} else if (!solo_flag) {
|
} else if (!solo_flag) {
|
||||||
t->TokInfo = 'l';
|
t->TokInfo = Terml;
|
||||||
solo_flag = TRUE;
|
solo_flag = TRUE;
|
||||||
}
|
}
|
||||||
} else if (och == '[') {
|
} else if (och == '[') {
|
||||||
|
@ -1886,7 +1794,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
};
|
};
|
||||||
if (ch == ']') {
|
if (ch == ']') {
|
||||||
t->TokInfo = Unsigned(AtomNil);
|
t->TokInfo = TermNil;
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
|
@ -1930,7 +1838,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
};
|
};
|
||||||
if (ch == '}') {
|
if (ch == '}') {
|
||||||
t->TokInfo = Unsigned(AtomBraces);
|
t->TokInfo = TermBraces;
|
||||||
t->Tok = Ord(kind = Name_tok);
|
t->Tok = Ord(kind = Name_tok);
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
solo_flag = FALSE;
|
solo_flag = FALSE;
|
||||||
|
@ -1959,12 +1867,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
qq->mid.charno = inp_stream->charcount - 1;
|
qq->mid.charno = inp_stream->charcount - 1;
|
||||||
t->Tok = Ord(kind = QuasiQuotes_tok);
|
t->Tok = Ord(kind = QuasiQuotes_tok);
|
||||||
ch = getchr(inp_stream);
|
ch = getchr(inp_stream);
|
||||||
|
sz = 1024;
|
||||||
TokImage = Yap_PreAllocCodeSpace();
|
TokImage = Malloc(sz);
|
||||||
if (!TokImage) {
|
if (!TokImage) {
|
||||||
LOCAL_ErrorMessage =
|
LOCAL_ErrorMessage =
|
||||||
"not enough heap space to read in a quasi quoted atom";
|
"not enough heap space to read in a quasi quoted atom";
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
|
||||||
t->Tok = Ord(kind = eot_tok);
|
t->Tok = Ord(kind = eot_tok);
|
||||||
t->TokInfo = TermError;
|
t->TokInfo = TermError;
|
||||||
return l;
|
return l;
|
||||||
|
@ -1973,35 +1880,34 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
quote = ch;
|
quote = ch;
|
||||||
len = 0;
|
len = 0;
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
wcharp = NULL;
|
|
||||||
|
|
||||||
while (TRUE) {
|
while (TRUE) {
|
||||||
if (ch == '|') {
|
if (ch == '|') {
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
if (ch != '}') {
|
if (ch != '}') {
|
||||||
} else {
|
} else {
|
||||||
charp = (char *)put_utf8((unsigned char *)charp, och);
|
charp += put_utf8((unsigned char *)charp, och);
|
||||||
charp = (char *)put_utf8((unsigned char *)charp, ch);
|
charp += put_utf8((unsigned char *)charp, ch);
|
||||||
/* we're done */
|
/* we're done */
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
} else if (chtype(ch) == EF) {
|
} else if (chtype(ch) == EF) {
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
Free(TokImage);
|
||||||
mark_eof(inp_stream);
|
mark_eof(inp_stream);
|
||||||
t->Tok = Ord(kind = eot_tok);
|
t->Tok = Ord(kind = eot_tok);
|
||||||
t->TokInfo = TermOutOfHeapError;
|
t->TokInfo = TermOutOfHeapError;
|
||||||
break;
|
break;
|
||||||
} else {
|
} else {
|
||||||
charp = (char *)put_utf8((unsigned char *)charp, ch);
|
charp += put_utf8(charp, ch);
|
||||||
ch = getchrq(inp_stream);
|
ch = getchrq(inp_stream);
|
||||||
}
|
}
|
||||||
if (charp > (char *)AuxSp - 1024) {
|
if (charp > (unsigned char *)AuxSp - 1024) {
|
||||||
/* Not enough space to read in the string. */
|
/* Not enough space to read in the string. */
|
||||||
return AuxSpaceError(
|
return AuxSpaceError(
|
||||||
t, l, "not enough space to read in string or quoted atom");
|
t, l, "not enough space to read in string or quoted atom");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
len = charp - TokImage;
|
len = charp - (unsigned char *)TokImage;
|
||||||
mp = malloc(len + 1);
|
mp = malloc(len + 1);
|
||||||
if (mp == NULL) {
|
if (mp == NULL) {
|
||||||
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
|
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
|
||||||
|
@ -2010,7 +1916,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
t->TokInfo = TermOutOfHeapError;
|
t->TokInfo = TermOutOfHeapError;
|
||||||
return l;
|
return l;
|
||||||
}
|
}
|
||||||
strncpy(mp, TokImage, len + 1);
|
strncpy((char *)mp, (const char *)TokImage, len + 1);
|
||||||
qq->text = (unsigned char *)mp;
|
qq->text = (unsigned char *)mp;
|
||||||
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
|
||||||
if (inp_stream->status & Seekable_Stream_f) {
|
if (inp_stream->status & Seekable_Stream_f) {
|
||||||
|
@ -2049,7 +1955,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
|
||||||
if (GLOBAL_Option[2]) {
|
if (GLOBAL_Option[2]) {
|
||||||
static int n;
|
static int n;
|
||||||
fprintf(stderr, "[Token %d %s %d]", Ord(kind),
|
fprintf(stderr, "[Token %d %s %d]", Ord(kind),
|
||||||
Yap_tokRep(t, inp_stream->encoding),n++);
|
Yap_tokRep(t, inp_stream->encoding), n++);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
if (LOCAL_ErrorMessage) {
|
if (LOCAL_ErrorMessage) {
|
||||||
|
@ -2076,7 +1982,7 @@ int vsc_count;
|
||||||
void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
|
void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
|
||||||
VarEntry *anonvartable) {
|
VarEntry *anonvartable) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
|
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;
|
||||||
while (ptr) {
|
while (ptr) {
|
||||||
struct scanner_extra_alloc *next = ptr->next;
|
struct scanner_extra_alloc *next = ptr->next;
|
||||||
free(ptr);
|
free(ptr);
|
||||||
|
|
33
C/stdpreds.c
33
C/stdpreds.c
|
@ -1099,24 +1099,25 @@ void Yap_show_statistics(void) {
|
||||||
#endif
|
#endif
|
||||||
frag = (100.0 * (heap_space_taken - HeapUsed)) / heap_space_taken;
|
frag = (100.0 * (heap_space_taken - HeapUsed)) / heap_space_taken;
|
||||||
|
|
||||||
fprintf(stderr, "Code Space: %ld (%ld bytes needed, %ld bytes used, "
|
fprintf(stderr, "Code Space: " UInt_FORMAT " (" UInt_FORMAT
|
||||||
|
" bytes needed, " UInt_FORMAT " bytes used, "
|
||||||
"fragmentation %.3f%%).\n",
|
"fragmentation %.3f%%).\n",
|
||||||
(unsigned long int)(Unsigned(H0) - Unsigned(Yap_HeapBase)),
|
Unsigned(H0) - Unsigned(Yap_HeapBase),
|
||||||
(unsigned long int)(Unsigned(HeapTop) - Unsigned(Yap_HeapBase)),
|
Unsigned(HeapTop) - Unsigned(Yap_HeapBase), Unsigned(HeapUsed), frag);
|
||||||
(unsigned long int)(HeapUsed), frag);
|
fprintf(stderr, "Stack Space: " UInt_FORMAT " (" UInt_FORMAT
|
||||||
fprintf(stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n",
|
" for Global, " UInt_FORMAT " for local).\n",
|
||||||
(unsigned long int)(sizeof(CELL) * (LCL0 - H0)),
|
Unsigned(sizeof(CELL) * (LCL0 - H0)),
|
||||||
(unsigned long int)(sizeof(CELL) * (HR - H0)),
|
Unsigned(sizeof(CELL) * (HR - H0)),
|
||||||
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)));
|
Unsigned(sizeof(CELL) * (LCL0 - ASP)));
|
||||||
fprintf(stderr, "Trail Space: %ld (%ld used).\n",
|
fprintf(
|
||||||
(unsigned long int)(sizeof(tr_fr_ptr) * (Unsigned(LOCAL_TrailTop) -
|
stderr, "Trail Space: " UInt_FORMAT " (" UInt_FORMAT " used).\n",
|
||||||
Unsigned(LOCAL_TrailBase))),
|
Unsigned(sizeof(tr_fr_ptr) *
|
||||||
(unsigned long int)(sizeof(tr_fr_ptr) *
|
(Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase))),
|
||||||
(Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
|
Unsigned(sizeof(tr_fr_ptr) * (Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
|
||||||
fprintf(stderr, "Runtime: %lds.\n", (unsigned long int)(runtime(PASS_REGS1)));
|
fprintf(stderr, "Runtime: " UInt_FORMAT "\n", runtime(PASS_REGS1));
|
||||||
fprintf(stderr, "Cputime: %lds.\n", (unsigned long int)(Yap_cputime()));
|
fprintf(stderr, "Cputime: " UInt_FORMAT "\n", Yap_cputime());
|
||||||
|
|
||||||
fprintf(stderr, "Walltime: " UInt_F ".\n", (UInt)(Yap_walltime() / 1000));
|
fprintf(stderr, "Walltime: %" PRIu64 ".\n", Yap_walltime() / (UInt)1000);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int p_statistics_heap_max(USES_REGS1) {
|
static Int p_statistics_heap_max(USES_REGS1) {
|
||||||
|
|
251
C/text.c
251
C/text.c
|
@ -35,17 +35,119 @@ inline static size_t min_size(size_t i, size_t j) { return (i < j ? i : j); }
|
||||||
#define NAN (0.0 / 0.0)
|
#define NAN (0.0 / 0.0)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifndef MAX_PATHHNAME
|
#define MAX_PATHNAME 2048
|
||||||
#define MAX_PATHHNAME 1024
|
|
||||||
#endif
|
|
||||||
|
|
||||||
void
|
struct mblock {
|
||||||
Yap_InitTextAllocator( void )
|
struct mblock *prev, *next;
|
||||||
{
|
int lvl;
|
||||||
struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+MAX_PATHHNAME*2 );
|
size_t sz;
|
||||||
new->prev = NULL;
|
};
|
||||||
new->ptr = new->buf = (struct TextBuffer_manager *)new+1;
|
|
||||||
LOCAL_TextBuffer = new;
|
typedef struct TextBuffer_manager {
|
||||||
|
void *buf, *ptr;
|
||||||
|
size_t sz;
|
||||||
|
struct mblock *first[16];
|
||||||
|
struct mblock *last[16];
|
||||||
|
int lvl;
|
||||||
|
} text_buffer_t;
|
||||||
|
|
||||||
|
int push_text_stack(USES_REGS1) {
|
||||||
|
printf("push %d\n", LOCAL_TextBuffer->lvl);
|
||||||
|
return LOCAL_TextBuffer->lvl++;
|
||||||
|
}
|
||||||
|
|
||||||
|
int pop_text_stack(int i) {
|
||||||
|
printf("pop %d\n", i);
|
||||||
|
int lvl = LOCAL_TextBuffer->lvl;
|
||||||
|
while (lvl > i) {
|
||||||
|
struct mblock *p = LOCAL_TextBuffer->first[lvl];
|
||||||
|
while (p) {
|
||||||
|
struct mblock *np = p->next;
|
||||||
|
free(p);
|
||||||
|
printf("----------> %p free\n", p);
|
||||||
|
p = np;
|
||||||
|
}
|
||||||
|
LOCAL_TextBuffer->first[lvl] = NULL;
|
||||||
|
LOCAL_TextBuffer->last[lvl] = NULL;
|
||||||
|
lvl--;
|
||||||
|
}
|
||||||
|
LOCAL_TextBuffer->lvl = lvl;
|
||||||
|
return lvl;
|
||||||
|
}
|
||||||
|
|
||||||
|
// void pop_text_stack(int i) { LOCAL_TextBuffer->lvl = i; }
|
||||||
|
|
||||||
|
void *Malloc(size_t sz USES_REGS) {
|
||||||
|
int lvl = LOCAL_TextBuffer->lvl;
|
||||||
|
if (sz == 0)
|
||||||
|
sz = 1024;
|
||||||
|
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
|
||||||
|
struct mblock *o = malloc(sz);
|
||||||
|
o->prev = LOCAL_TextBuffer->last[lvl];
|
||||||
|
if (o->prev) {
|
||||||
|
o->prev->next = o;
|
||||||
|
}
|
||||||
|
if (LOCAL_TextBuffer->first[lvl]) {
|
||||||
|
LOCAL_TextBuffer->last[lvl] = o;
|
||||||
|
} else {
|
||||||
|
LOCAL_TextBuffer->first[lvl] = LOCAL_TextBuffer->last[lvl] = o;
|
||||||
|
}
|
||||||
|
o->next = NULL;
|
||||||
|
o->sz = sz;
|
||||||
|
o->lvl = lvl;
|
||||||
|
printf("%p malloc %d\n", o, sz);
|
||||||
|
return o + 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void *Realloc(void *pt, size_t sz USES_REGS) {
|
||||||
|
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
|
||||||
|
struct mblock *old = pt, *o;
|
||||||
|
old--;
|
||||||
|
int lvl = old->lvl;
|
||||||
|
o = realloc(old, sz);
|
||||||
|
if (o->prev)
|
||||||
|
o->prev->next = o;
|
||||||
|
if (o->next)
|
||||||
|
o->next->prev = o;
|
||||||
|
if (LOCAL_TextBuffer->first[lvl] == old) {
|
||||||
|
LOCAL_TextBuffer->first[lvl] = o;
|
||||||
|
}
|
||||||
|
if (LOCAL_TextBuffer->last[lvl] == old) {
|
||||||
|
LOCAL_TextBuffer->last[lvl] = o;
|
||||||
|
}
|
||||||
|
printf("%p realloc %ld\n", o, sz);
|
||||||
|
return o + 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void Free(void *pt USES_REGS) {
|
||||||
|
struct mblock *o = pt;
|
||||||
|
o--;
|
||||||
|
if (o->prev)
|
||||||
|
o->prev->next = o->next;
|
||||||
|
if (o->next)
|
||||||
|
o->next->prev = o->prev;
|
||||||
|
int lvl = o->lvl;
|
||||||
|
if (LOCAL_TextBuffer->first[lvl] == o) {
|
||||||
|
if (LOCAL_TextBuffer->last[lvl] == o) {
|
||||||
|
LOCAL_TextBuffer->first[lvl] = LOCAL_TextBuffer->last[lvl] = NULL;
|
||||||
|
}
|
||||||
|
LOCAL_TextBuffer->first[lvl] = o->next;
|
||||||
|
} else if (LOCAL_TextBuffer->last[lvl] == o) {
|
||||||
|
LOCAL_TextBuffer->last[lvl] = o->prev;
|
||||||
|
}
|
||||||
|
free(o);
|
||||||
|
printf("%p free\n", o);
|
||||||
|
}
|
||||||
|
|
||||||
|
void *Yap_InitTextAllocator(void) {
|
||||||
|
struct TextBuffer_manager *new = calloc(sizeof(struct TextBuffer_manager), 1);
|
||||||
|
return new;
|
||||||
|
}
|
||||||
|
|
||||||
|
static size_t MaxTmp(USES_REGS1) {
|
||||||
|
|
||||||
|
return ((char *)LOCAL_TextBuffer->buf + LOCAL_TextBuffer->sz) -
|
||||||
|
(char *)LOCAL_TextBuffer->ptr;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Term Globalize(Term v USES_REGS) {
|
static Term Globalize(Term v USES_REGS) {
|
||||||
|
@ -111,14 +213,6 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp,
|
||||||
if (*atoms < length) {
|
if (*atoms < length) {
|
||||||
*tailp = l;
|
*tailp = l;
|
||||||
return -TYPE_ERROR_NUMBER;
|
return -TYPE_ERROR_NUMBER;
|
||||||
}
|
|
||||||
if (IsWideAtom(AtomOfTerm(hd))) {
|
|
||||||
int ch;
|
|
||||||
if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') {
|
|
||||||
length = -REPRESENTATION_ERROR_CHARACTER;
|
|
||||||
}
|
|
||||||
ch = RepAtom(AtomOfTerm(hd))->WStrOfAE[0];
|
|
||||||
*wide = true;
|
|
||||||
} else {
|
} else {
|
||||||
AtomEntry *ae = RepAtom(AtomOfTerm(hd));
|
AtomEntry *ae = RepAtom(AtomOfTerm(hd));
|
||||||
if ((ae->StrOfAE)[1] != '\0') {
|
if ((ae->StrOfAE)[1] != '\0') {
|
||||||
|
@ -215,6 +309,7 @@ static unsigned char *to_buffer(unsigned char *buf, Term t, seq_tv_t *inp,
|
||||||
unsigned char *bufc = buf;
|
unsigned char *bufc = buf;
|
||||||
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
|
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
|
||||||
if (n < 0) {
|
if (n < 0) {
|
||||||
|
LOCAL_Error_TYPE = -n;
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
*lenp = n;
|
*lenp = n;
|
||||||
|
@ -297,13 +392,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);
|
||||||
if (IsWideAtom(at)) {
|
inp->val.uc = at->UStrOfAE;
|
||||||
inp->val.w = at->WStrOfAE;
|
|
||||||
return wchar2utf8(inp, lengp);
|
|
||||||
} else {
|
|
||||||
inp->val.c = at->StrOfAE;
|
|
||||||
return latin2utf8(inp, lengp);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
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
|
||||||
|
@ -338,9 +427,9 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
|
||||||
s = (char *)s0;
|
s = (char *)s0;
|
||||||
else
|
else
|
||||||
s = Malloc(0);
|
s = Malloc(0);
|
||||||
if (snprintf(s, MAX_PATHNAME - 1, Int_FORMAT,
|
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
|
||||||
IntegerOfTerm(inp->val.t)) < 0) {
|
IntegerOfTerm(inp->val.t)) < 0) {
|
||||||
AUX_ERROR(inp->val.t, 2 * (MAX_PATHNAME), s, char);
|
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
|
||||||
}
|
}
|
||||||
*lengp = strlen(s);
|
*lengp = strlen(s);
|
||||||
Malloc(*lengp);
|
Malloc(*lengp);
|
||||||
|
@ -463,19 +552,20 @@ static Term write_atoms(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
|
||||||
|
|
||||||
unsigned char *s = s0, *lim = s + strnlen((char *)s, max);
|
unsigned char *s = s0, *lim = s + strnlen((char *)s, max);
|
||||||
unsigned char *cp = s;
|
unsigned char *cp = s;
|
||||||
wchar_t w[2];
|
unsigned char w[10], *wp = w;
|
||||||
w[1] = '\0';
|
|
||||||
LOCAL_TERM_ERROR(t, 2 * (lim - s));
|
LOCAL_TERM_ERROR(t, 2 * (lim - s));
|
||||||
while (cp < lim && *cp) {
|
while (cp < lim && *cp) {
|
||||||
utf8proc_int32_t chr;
|
utf8proc_int32_t chr;
|
||||||
CELL *cl;
|
CELL *cl;
|
||||||
cp += get_utf8(cp, -1, &chr);
|
s += get_utf8(s, 1, &chr);
|
||||||
if (chr == '\0')
|
if (chr == '\0') {
|
||||||
|
wp[0] = '\0';
|
||||||
break;
|
break;
|
||||||
w[0] = chr;
|
}
|
||||||
|
wp += put_utf8(w, chr);
|
||||||
cl = HR;
|
cl = HR;
|
||||||
HR += 2;
|
HR += 2;
|
||||||
cl[0] = MkAtomTerm(Yap_LookupMaybeWideAtom(w));
|
cl[0] = MkAtomTerm(Yap_ULookupAtom(w));
|
||||||
cl[1] = AbsPair(HR);
|
cl[1] = AbsPair(HR);
|
||||||
sz++;
|
sz++;
|
||||||
if (sz == max)
|
if (sz == max)
|
||||||
|
@ -544,34 +634,15 @@ 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;
|
||||||
utf8proc_int32_t chr;
|
if (strlen_utf8(s0) <= leng) {
|
||||||
while (*s && get_utf8(s, -1, &chr) == 1)
|
return Yap_LookupAtom(s0);
|
||||||
s++;
|
} else {
|
||||||
if (*s == '\0')
|
size_t n = get_utf8(s, 1, &ch);
|
||||||
return out->val.a = Yap_LookupAtom((char *)s0);
|
unsigned char *buf = Malloc(n + 1);
|
||||||
s = s0;
|
memcpy(buf, s0, n + 1);
|
||||||
size_t l = strlen(s0);
|
return Yap_ULookupAtom(buf);
|
||||||
wchar_t *wbuf = Malloc(sizeof(wchar_t) * ((l + 1))), *wptr = wbuf;
|
|
||||||
Atom at;
|
|
||||||
if (!wbuf)
|
|
||||||
return NULL;
|
|
||||||
while (*s) {
|
|
||||||
utf8proc_int32_t chr;
|
|
||||||
int off = get_utf8(s, -1, &chr);
|
|
||||||
if (off < 0) {
|
|
||||||
s++;
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
s++;
|
|
||||||
*wptr++ = chr;
|
|
||||||
}
|
|
||||||
*wptr++ = '\0';
|
|
||||||
|
|
||||||
at = Yap_LookupMaybeWideAtom(wbuf);
|
|
||||||
out->val.a = at;
|
|
||||||
return at;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -650,18 +721,18 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out,
|
||||||
|
|
||||||
static Term write_number(unsigned char *s, seq_tv_t *out, int size USES_REGS) {
|
static Term write_number(unsigned char *s, seq_tv_t *out, int size USES_REGS) {
|
||||||
Term t;
|
Term t;
|
||||||
mark_stack();
|
int i = push_text_stack();
|
||||||
t = Yap_StringToNumberTerm((char *)s, &out->enc);
|
t = Yap_StringToNumberTerm((char *)s, &out->enc);
|
||||||
restore_stack();
|
pop_text_stack(i);
|
||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
|
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
|
||||||
Term o;
|
Term o;
|
||||||
mark_stack();
|
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);
|
||||||
restore_stack();
|
pop_text_stack(i);
|
||||||
return o;
|
return o;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -762,9 +833,9 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
|
||||||
bool rc;
|
bool rc;
|
||||||
|
|
||||||
size_t leng;
|
size_t leng;
|
||||||
init_alloc(__LINE__);
|
int l = push_text_stack(PASS_REGS1);
|
||||||
/*
|
/*
|
||||||
f//printf(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
|
||||||
|YAP_STRING_STRING))
|
|YAP_STRING_STRING))
|
||||||
//Yap_DebugPlWriteln(inp->val.t);
|
//Yap_DebugPlWriteln(inp->val.t);
|
||||||
|
@ -787,26 +858,26 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!buf) {
|
if (!buf) {
|
||||||
unprotect_stack(NULL);
|
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)) {
|
||||||
unprotect_stack(NULL);
|
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)) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
rc = write_Text(buf, out, leng PASS_REGS);
|
rc = write_Text(buf, out, leng PASS_REGS);
|
||||||
unprotect_stack(out);
|
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 &
|
||||||
|
@ -876,10 +947,10 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
|
||||||
unsigned char *buf;
|
unsigned char *buf;
|
||||||
size_t leng;
|
size_t leng;
|
||||||
int i;
|
int i;
|
||||||
init_alloc(__LINE__);
|
int l = push_text_stack(PASS_REGS1);
|
||||||
bufv = Malloc(tot * sizeof(unsigned char *));
|
bufv = Malloc(tot * sizeof(unsigned char *));
|
||||||
if (!bufv) {
|
if (!bufv) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
for (i = 0; i < tot; i++) {
|
for (i = 0; i < tot; i++) {
|
||||||
|
@ -887,14 +958,14 @@ 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) {
|
||||||
unprotect_stack(NULL);
|
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, leng PASS_REGS);
|
||||||
unprotect_stack(out);
|
pop_text_stack(l);
|
||||||
return rc;
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -902,12 +973,13 @@ 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;
|
||||||
init_alloc(__LINE__);
|
|
||||||
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) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
|
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
@ -919,11 +991,11 @@ 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) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
if (cmp_Text(buf, buf0, l0) != 0) {
|
if (cmp_Text(buf, buf0, l0) != 0) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
l1 = l - l0;
|
l1 = l - l0;
|
||||||
|
@ -931,26 +1003,26 @@ 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) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
unprotect_stack((outv + 1));
|
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) {
|
||||||
unprotect_stack(NULL);
|
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) {
|
||||||
unprotect_stack(NULL);
|
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);
|
||||||
unprotect_stack((rc ? NULL : outv + 0));
|
pop_text_stack((rc ? 0 : lvl));
|
||||||
return rc;
|
return rc;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -963,11 +1035,11 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
|
||||||
next = cuts[i - 1];
|
next = cuts[i - 1];
|
||||||
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)) {
|
||||||
unprotect_stack(NULL);
|
pop_text_stack( l);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
unprotect_stack(outv);
|
pop_text_stack(l);
|
||||||
|
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
@ -993,10 +1065,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) {
|
||||||
inp.val.t = t;
|
inp.val.t = t;
|
||||||
if (IsAtomTerm(t) && t != TermNil) {
|
if (IsAtomTerm(t) && t != TermNil) {
|
||||||
inp.type = YAP_STRING_ATOM;
|
inp.type = YAP_STRING_ATOM;
|
||||||
if (IsWideAtom(AtomOfTerm(t)))
|
inp.enc = ENC_ISO_UTF8;
|
||||||
inp.enc = ENC_WCHAR;
|
|
||||||
else
|
|
||||||
inp.enc = ENC_ISO_LATIN1;
|
|
||||||
} else if (IsStringTerm(t)) {
|
} else if (IsStringTerm(t)) {
|
||||||
inp.type = YAP_STRING_STRING;
|
inp.type = YAP_STRING_STRING;
|
||||||
inp.enc = ENC_ISO_UTF8;
|
inp.enc = ENC_ISO_UTF8;
|
||||||
|
|
|
@ -799,22 +799,12 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
||||||
ptr = (char *)AdjustSize((CELL*)ptr, buf);
|
ptr = (char *)AdjustSize((CELL*)ptr, buf);
|
||||||
|
|
||||||
p0 = ptr;
|
p0 = ptr;
|
||||||
if (IsWideAtom(at)) {
|
*ptr++ = 0;
|
||||||
wchar_t *wptr = (wchar_t *)ptr;
|
|
||||||
*wptr++ = -1;
|
|
||||||
sz = wcslen(RepAtom(at)->WStrOfAE);
|
|
||||||
if (sizeof(wchar_t)*(sz+1) >= len)
|
|
||||||
return (Atom)NULL;
|
|
||||||
wcsncpy(wptr, RepAtom(at)->WStrOfAE, len);
|
|
||||||
*hpp = (char *)(wptr+(sz+1));
|
|
||||||
} else {
|
|
||||||
*ptr++ = 0;
|
|
||||||
sz = strlen(RepAtom(at)->StrOfAE);
|
sz = strlen(RepAtom(at)->StrOfAE);
|
||||||
if (sz + 1 + sizeof(wchar_t) >= len)
|
if (sz + 1 >= len)
|
||||||
return (Atom)NULL;
|
return (Atom)NULL;
|
||||||
strcpy(ptr, RepAtom(at)->StrOfAE);
|
strcpy(ptr, RepAtom(at)->StrOfAE);
|
||||||
*hpp = ptr+(sz+1);
|
*hpp = ptr+(sz+1);
|
||||||
}
|
|
||||||
return (Atom)(p0-buf);
|
return (Atom)(p0-buf);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1179,10 +1169,8 @@ addAtom(Atom t, char *buf)
|
||||||
|
|
||||||
if (!*s) {
|
if (!*s) {
|
||||||
return Yap_LookupAtom(s+1);
|
return Yap_LookupAtom(s+1);
|
||||||
} else {
|
|
||||||
wchar_t *w = (wchar_t *)s;
|
|
||||||
return Yap_LookupWideAtom(w+1);
|
|
||||||
}
|
}
|
||||||
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
static UInt
|
static UInt
|
||||||
|
@ -3386,19 +3374,6 @@ addAtomToHash(CELL *st, Atom at)
|
||||||
{
|
{
|
||||||
unsigned int len;
|
unsigned int len;
|
||||||
|
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
|
||||||
int ulen = wcslen(c);
|
|
||||||
len = ulen*sizeof(wchar_t);
|
|
||||||
if (len % CellSize == 0) {
|
|
||||||
len /= CellSize;
|
|
||||||
} else {
|
|
||||||
len /= CellSize;
|
|
||||||
len++;
|
|
||||||
}
|
|
||||||
st[len-1] = 0L;
|
|
||||||
wcsncpy((wchar_t *)st, c, ulen);
|
|
||||||
} else {
|
|
||||||
char *c = RepAtom(at)->StrOfAE;
|
char *c = RepAtom(at)->StrOfAE;
|
||||||
int ulen = strlen(c);
|
int ulen = strlen(c);
|
||||||
/* fix hashing over empty atom */
|
/* fix hashing over empty atom */
|
||||||
|
@ -3413,7 +3388,6 @@ addAtomToHash(CELL *st, Atom at)
|
||||||
}
|
}
|
||||||
st[len-1] = 0L;
|
st[len-1] = 0L;
|
||||||
strncpy((char *)st, c, ulen);
|
strncpy((char *)st, c, ulen);
|
||||||
}
|
|
||||||
return st+len;
|
return st+len;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
26
C/write.c
26
C/write.c
|
@ -187,12 +187,6 @@ inline static void wrputs(char *s, StreamDesc *stream) {
|
||||||
wrputc(c, stream);
|
wrputc(c, stream);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void wrputws(wchar_t *s, wrf stream) /* writes a string */
|
|
||||||
{
|
|
||||||
while (*s)
|
|
||||||
wrputc(*s++, stream);
|
|
||||||
}
|
|
||||||
|
|
||||||
#ifdef USE_GMP
|
#ifdef USE_GMP
|
||||||
|
|
||||||
static char *ensure_space(size_t sz) {
|
static char *ensure_space(size_t sz) {
|
||||||
|
@ -589,22 +583,7 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
|
||||||
wrputblob(RepAtom(atom), Quote_illegal, wglb);
|
wrputblob(RepAtom(atom), Quote_illegal, wglb);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if (IsWideAtom(atom)) {
|
s = RepAtom(atom)->UStrOfAE;
|
||||||
wchar_t *ws = RepAtom(atom)->WStrOfAE;
|
|
||||||
|
|
||||||
if (Quote_illegal) {
|
|
||||||
wrputc('\'', stream);
|
|
||||||
while (*ws) {
|
|
||||||
wchar_t ch = *ws++;
|
|
||||||
write_quoted(ch, '\'', stream);
|
|
||||||
}
|
|
||||||
wrputc('\'', stream);
|
|
||||||
} else {
|
|
||||||
wrputws(ws, stream);
|
|
||||||
}
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
s = (unsigned char *)RepAtom(atom)->StrOfAE;
|
|
||||||
/* #define CRYPT_FOR_STEVE 1*/
|
/* #define CRYPT_FOR_STEVE 1*/
|
||||||
#ifdef CRYPT_FOR_STEVE
|
#ifdef CRYPT_FOR_STEVE
|
||||||
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
|
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
|
||||||
|
@ -624,7 +603,8 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
|
||||||
if (Quote_illegal && !legalAtom(s)) {
|
if (Quote_illegal && !legalAtom(s)) {
|
||||||
wrputc('\'', stream);
|
wrputc('\'', stream);
|
||||||
while (*s) {
|
while (*s) {
|
||||||
wchar_t ch = *s++;
|
int32_t ch;
|
||||||
|
s += get_utf8(s, 1, &ch);
|
||||||
write_quoted(ch, '\'', stream);
|
write_quoted(ch, '\'', stream);
|
||||||
}
|
}
|
||||||
wrputc('\'', stream);
|
wrputc('\'', stream);
|
||||||
|
|
|
@ -9,6 +9,7 @@
|
||||||
project( YAP )
|
project( YAP )
|
||||||
|
|
||||||
cmake_minimum_required(VERSION 2.8)
|
cmake_minimum_required(VERSION 2.8)
|
||||||
|
include(CMakeToolsHelpers OPTIONAL)
|
||||||
|
|
||||||
# cmake_policy(VERSION 3.4)
|
# cmake_policy(VERSION 3.4)
|
||||||
|
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,142 @@
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
|
||||||
|
# Cython imports
|
||||||
|
from cython.operator cimport dereference as deref
|
||||||
|
from cython.operator cimport preincrement as inc
|
||||||
|
from libc cimport stdio
|
||||||
|
from cpython.version cimport PY_MAJOR_VERSION
|
||||||
|
from cpython.ref cimport PyTypeObject, Py_INCREF, Py_XDECREF
|
||||||
|
from cpython.type cimport PyType_Ready
|
||||||
|
from cpython.object cimport PyObject
|
||||||
|
from cpython.object cimport Py_LT, Py_LE, Py_EQ, Py_NE, Py_GT, Py_GE
|
||||||
|
|
||||||
|
# Python imports
|
||||||
|
cimport numpy as np
|
||||||
|
|
||||||
|
# Local imports
|
||||||
|
cimport xdress_extra_types
|
||||||
|
|
||||||
|
# Cython imports for types
|
||||||
|
|
||||||
|
|
||||||
|
cdef extern from "Python.h":
|
||||||
|
ctypedef Py_ssize_t Py_ssize_t
|
||||||
|
|
||||||
|
cdef long Py_TPFLAGS_DEFAULT
|
||||||
|
cdef long Py_TPFLAGS_BASETYPE
|
||||||
|
cdef long Py_TPFLAGS_CHECKTYPES
|
||||||
|
cdef long Py_TPFLAGS_HEAPTYPE
|
||||||
|
|
||||||
|
ctypedef struct PyGetSetDef:
|
||||||
|
char * name
|
||||||
|
|
||||||
|
ctypedef struct PyTypeObject:
|
||||||
|
char * tp_name
|
||||||
|
int tp_basicsize
|
||||||
|
int tp_itemsize
|
||||||
|
object tp_alloc(PyTypeObject *, Py_ssize_t)
|
||||||
|
void tp_dealloc(object)
|
||||||
|
object tp_richcompare(object, object, int)
|
||||||
|
object tp_new(PyTypeObject *, object, object)
|
||||||
|
object tp_str(object)
|
||||||
|
object tp_repr(object)
|
||||||
|
long tp_hash(object)
|
||||||
|
long tp_flags
|
||||||
|
char * tp_doc
|
||||||
|
PyMemberDef * tp_members
|
||||||
|
PyGetSetDef * tp_getset
|
||||||
|
PyTypeObject * tp_base
|
||||||
|
void tp_free(void *)
|
||||||
|
# This is a dirty hack by declaring to Cython both the Python 2 & 3 APIs
|
||||||
|
int (*tp_compare)(object, object) # Python 2
|
||||||
|
void * (*tp_reserved)(object, object) # Python 3
|
||||||
|
|
||||||
|
# structmember.h isn't included in Python.h for some reason
|
||||||
|
cdef extern from "structmember.h":
|
||||||
|
ctypedef struct PyMemberDef:
|
||||||
|
char * name
|
||||||
|
int type
|
||||||
|
Py_ssize_t offset
|
||||||
|
int flags
|
||||||
|
char * doc
|
||||||
|
|
||||||
|
cdef extern from "numpy/arrayobject.h":
|
||||||
|
|
||||||
|
ctypedef object (*PyArray_GetItemFunc)(void *, void *)
|
||||||
|
ctypedef int (*PyArray_SetItemFunc)(object, void *, void *)
|
||||||
|
ctypedef void (*PyArray_CopySwapNFunc)(void *, np.npy_intp, void *, np.npy_intp, np.npy_intp, int, void *)
|
||||||
|
ctypedef void (*PyArray_CopySwapFunc)(void *, void *, int, void *)
|
||||||
|
ctypedef int (*PyArray_CompareFunc)(const void* d1, const void *, void *)
|
||||||
|
ctypedef int (*PyArray_ArgFunc)(void *, np.npy_intp, np.npy_intp *, void *)
|
||||||
|
ctypedef void (*PyArray_DotFunc)(void *, np.npy_intp, void *, np.npy_intp, void *, np.npy_intp, void *)
|
||||||
|
ctypedef int (*PyArray_ScanFunc)(stdio.FILE *, void *, void *, void *)
|
||||||
|
ctypedef int (*PyArray_FromStrFunc)(char *, void *, char **, void *)
|
||||||
|
ctypedef np.npy_bool (*PyArray_NonzeroFunc)(void *, void *)
|
||||||
|
ctypedef void (*PyArray_FillFunc)(void *, np.npy_intp, void *)
|
||||||
|
ctypedef void (*PyArray_FillWithScalarFunc)(void *, np.npy_intp, void *, void *)
|
||||||
|
ctypedef int (*PyArray_SortFunc)(void *, np.npy_intp, void *)
|
||||||
|
ctypedef int (*PyArray_ArgSortFunc)(void *, np.npy_intp *, np.npy_intp, void *)
|
||||||
|
ctypedef np.NPY_SCALARKIND (*PyArray_ScalarKindFunc)(np.PyArrayObject *)
|
||||||
|
|
||||||
|
ctypedef struct PyArray_ArrFuncs:
|
||||||
|
np.PyArray_VectorUnaryFunc ** cast
|
||||||
|
PyArray_GetItemFunc *getitem
|
||||||
|
PyArray_SetItemFunc *setitem
|
||||||
|
PyArray_CopySwapNFunc *copyswapn
|
||||||
|
PyArray_CopySwapFunc *copyswap
|
||||||
|
PyArray_CompareFunc *compare
|
||||||
|
PyArray_ArgFunc *argmax
|
||||||
|
PyArray_DotFunc *dotfunc
|
||||||
|
PyArray_ScanFunc *scanfunc
|
||||||
|
PyArray_FromStrFunc *fromstr
|
||||||
|
PyArray_NonzeroFunc *nonzero
|
||||||
|
PyArray_FillFunc *fill
|
||||||
|
PyArray_FillWithScalarFunc *fillwithscalar
|
||||||
|
PyArray_SortFunc *sort
|
||||||
|
PyArray_ArgSortFunc *argsort
|
||||||
|
PyObject *castdict
|
||||||
|
PyArray_ScalarKindFunc *scalarkind
|
||||||
|
int **cancastscalarkindto
|
||||||
|
int *cancastto
|
||||||
|
int listpickle
|
||||||
|
|
||||||
|
cdef void PyArray_InitArrFuncs(PyArray_ArrFuncs *)
|
||||||
|
|
||||||
|
ctypedef struct PyArray_ArrayDescr:
|
||||||
|
PyArray_Descr * base
|
||||||
|
PyObject *shape
|
||||||
|
|
||||||
|
cdef void ** PyArray_API
|
||||||
|
|
||||||
|
cdef PyTypeObject * PyArrayDescr_Type
|
||||||
|
|
||||||
|
ctypedef struct PyArray_Descr:
|
||||||
|
Py_ssize_t ob_refcnt
|
||||||
|
PyTypeObject * ob_type
|
||||||
|
PyTypeObject * typeobj
|
||||||
|
char kind
|
||||||
|
char type
|
||||||
|
char byteorder
|
||||||
|
int flags
|
||||||
|
int type_num
|
||||||
|
int elsize
|
||||||
|
int alignment
|
||||||
|
PyArray_ArrayDescr * subarray
|
||||||
|
PyObject * fields
|
||||||
|
PyObject * names
|
||||||
|
PyArray_ArrFuncs * f
|
||||||
|
|
||||||
|
cdef int PyArray_RegisterDataType(PyArray_Descr *)
|
||||||
|
|
||||||
|
cdef object PyArray_Scalar(void *, PyArray_Descr *, object)
|
||||||
|
|
||||||
|
cdef extern from "xdress_extra_types.h" namespace "xdress_extra_types":
|
||||||
|
cdef cppclass MemoryKnight[T]:
|
||||||
|
MemoryKnight() nogil except +
|
||||||
|
T * defnew() nogil except +
|
||||||
|
T * renew(void *) nogil except +
|
||||||
|
void deall(T *) nogil except +
|
||||||
|
|
|
@ -0,0 +1,43 @@
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
|
||||||
|
# Cython imports
|
||||||
|
from cython.operator cimport dereference as deref
|
||||||
|
from cython.operator cimport preincrement as inc
|
||||||
|
from libc.stdlib cimport malloc, free
|
||||||
|
from libc.string cimport memcpy
|
||||||
|
from cpython.version cimport PY_MAJOR_VERSION
|
||||||
|
from cpython.ref cimport PyTypeObject
|
||||||
|
from cpython.type cimport PyType_Ready
|
||||||
|
from cpython.object cimport Py_LT, Py_LE, Py_EQ, Py_NE, Py_GT, Py_GE
|
||||||
|
|
||||||
|
# Python Imports
|
||||||
|
import collections
|
||||||
|
|
||||||
|
cimport numpy as np
|
||||||
|
import numpy as np
|
||||||
|
np.import_array()
|
||||||
|
|
||||||
|
cimport xdress_extra_types
|
||||||
|
|
||||||
|
# Cython imports for types
|
||||||
|
|
||||||
|
|
||||||
|
# imports for types
|
||||||
|
|
||||||
|
|
||||||
|
dtypes = {}
|
||||||
|
|
||||||
|
if PY_MAJOR_VERSION >= 3:
|
||||||
|
basestring = str
|
||||||
|
|
||||||
|
# Dirty ifdef, else, else preprocessor hack
|
||||||
|
# see http://comments.gmane.org/gmane.comp.python.cython.user/4080
|
||||||
|
cdef extern from *:
|
||||||
|
cdef void emit_ifpy2k "#if PY_MAJOR_VERSION == 2 //" ()
|
||||||
|
cdef void emit_ifpy3k "#if PY_MAJOR_VERSION == 3 //" ()
|
||||||
|
cdef void emit_else "#else //" ()
|
||||||
|
cdef void emit_endif "#endif //" ()
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,30 @@
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
|
||||||
|
# Cython imports
|
||||||
|
from cython.operator cimport dereference as deref
|
||||||
|
from cython.operator cimport preincrement as inc
|
||||||
|
from libcpp.string cimport string as std_string
|
||||||
|
from libcpp.utility cimport pair
|
||||||
|
from libcpp.map cimport map as cpp_map
|
||||||
|
from libcpp.set cimport set as cpp_set
|
||||||
|
from libcpp.vector cimport vector as cpp_vector
|
||||||
|
from libcpp cimport bool as cpp_bool
|
||||||
|
from libc cimport stdio
|
||||||
|
from cpython.version cimport PY_MAJOR_VERSION
|
||||||
|
from cpython.ref cimport PyTypeObject, Py_INCREF, Py_XDECREF
|
||||||
|
|
||||||
|
# Python Imports
|
||||||
|
cimport numpy as np
|
||||||
|
|
||||||
|
# Local imports
|
||||||
|
cimport xdress_extra_types
|
||||||
|
|
||||||
|
cimport numpy as np
|
||||||
|
|
||||||
|
|
||||||
|
# Cython Imports For Types
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,45 @@
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
|
||||||
|
# Cython imports
|
||||||
|
from cython.operator cimport dereference as deref
|
||||||
|
from cython.operator cimport preincrement as inc
|
||||||
|
from libc.stdlib cimport malloc, free
|
||||||
|
from libc.string cimport memcpy
|
||||||
|
from libcpp.string cimport string as std_string
|
||||||
|
from libcpp.utility cimport pair
|
||||||
|
from libcpp.map cimport map as cpp_map
|
||||||
|
from libcpp.set cimport set as cpp_set
|
||||||
|
from libcpp cimport bool as cpp_bool
|
||||||
|
from libcpp.vector cimport vector as cpp_vector
|
||||||
|
from cpython.version cimport PY_MAJOR_VERSION
|
||||||
|
|
||||||
|
# Python Imports
|
||||||
|
import collections
|
||||||
|
|
||||||
|
cimport numpy as np
|
||||||
|
import numpy as np
|
||||||
|
|
||||||
|
np.import_array()
|
||||||
|
|
||||||
|
cimport xdress_extra_types
|
||||||
|
|
||||||
|
# Cython Imports For Types
|
||||||
|
|
||||||
|
|
||||||
|
# Imports For Types
|
||||||
|
|
||||||
|
|
||||||
|
if PY_MAJOR_VERSION >= 3:
|
||||||
|
basestring = str
|
||||||
|
|
||||||
|
# Dirty ifdef, else, else preprocessor hack
|
||||||
|
# see http://comments.gmane.org/gmane.comp.python.cython.user/4080
|
||||||
|
cdef extern from *:
|
||||||
|
cdef void emit_ifpy2k "#if PY_MAJOR_VERSION == 2 //" ()
|
||||||
|
cdef void emit_ifpy3k "#if PY_MAJOR_VERSION == 3 //" ()
|
||||||
|
cdef void emit_else "#else //" ()
|
||||||
|
cdef void emit_endif "#endif //" ()
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,21 @@
|
||||||
|
"""Tests the part of dtypes that is accessible from Python."""
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
from __future__ import print_function
|
||||||
|
|
||||||
|
import nose
|
||||||
|
from nose.tools import assert_equal, assert_not_equal, assert_raises, raises, \
|
||||||
|
assert_almost_equal, assert_true, assert_false, assert_in
|
||||||
|
|
||||||
|
from numpy.testing import assert_array_equal, assert_array_almost_equal
|
||||||
|
|
||||||
|
import os
|
||||||
|
import numpy as np
|
||||||
|
|
||||||
|
from _yap import dtypes
|
||||||
|
|
||||||
|
|
||||||
|
if __name__ == '__main__':
|
||||||
|
nose.run()
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,23 @@
|
||||||
|
"""Tests the part of stlconverters that is accessible from Python."""
|
||||||
|
###################
|
||||||
|
### WARNING!!! ###
|
||||||
|
###################
|
||||||
|
# This file has been autogenerated
|
||||||
|
from __future__ import print_function
|
||||||
|
from unittest import TestCase
|
||||||
|
import nose
|
||||||
|
|
||||||
|
from nose.tools import assert_equal, assert_not_equal, assert_raises, raises, \
|
||||||
|
assert_almost_equal, assert_true, assert_false, assert_in
|
||||||
|
|
||||||
|
from numpy.testing import assert_array_equal, assert_array_almost_equal
|
||||||
|
|
||||||
|
import os
|
||||||
|
import numpy as np
|
||||||
|
from collections import Container, Mapping
|
||||||
|
|
||||||
|
from _yap import stlcontainers
|
||||||
|
|
||||||
|
|
||||||
|
if __name__ == '__main__':
|
||||||
|
nose.run()
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,62 @@
|
||||||
|
/// \file extra_types.h
|
||||||
|
/// \author Anthony Scopatz (scopatz\@gmail.com)
|
||||||
|
///
|
||||||
|
/// Provides some extra types that may be generally useful
|
||||||
|
|
||||||
|
#if !defined(_XDRESS_EXTRA_TYPES_)
|
||||||
|
#define _XDRESS_EXTRA_TYPES_
|
||||||
|
|
||||||
|
#if defined(__cplusplus)
|
||||||
|
namespace xdress_extra_types
|
||||||
|
{
|
||||||
|
/// complex type struct, matching PyTables definition
|
||||||
|
// typedef struct {
|
||||||
|
// double re; ///< real part
|
||||||
|
// double im; ///< imaginary part
|
||||||
|
// } complex_t;
|
||||||
|
|
||||||
|
/// Chivalrously handles C++ memory issues that Cython does
|
||||||
|
/// not yet have a syntax for. This is a template class,
|
||||||
|
/// rather than three template functions, because Cython does
|
||||||
|
/// not yet support template function wrapping.
|
||||||
|
template <class T>
|
||||||
|
class MemoryKnight
|
||||||
|
{
|
||||||
|
public:
|
||||||
|
MemoryKnight(){}; ///< Default constructor
|
||||||
|
~MemoryKnight(){}; ///< Default Destructor
|
||||||
|
|
||||||
|
/// Creates a new instance of type T on the heap using
|
||||||
|
/// its default constructor.
|
||||||
|
/// \return T *
|
||||||
|
T * defnew(){return new T();};
|
||||||
|
|
||||||
|
/// Creates a new instance of type T, using T's default
|
||||||
|
/// constructor, at a given location.
|
||||||
|
/// \param void * ptr, location to create T instance
|
||||||
|
/// \return value of ptr recast as T *
|
||||||
|
T * renew(void * ptr){return new (ptr) T();};
|
||||||
|
|
||||||
|
/// Deallocates a location in memory using delete.
|
||||||
|
/// \param T * ptr, location to remove
|
||||||
|
void deall(T * ptr){delete ptr;};
|
||||||
|
};
|
||||||
|
|
||||||
|
// End namespace xdress_extra_types
|
||||||
|
};
|
||||||
|
|
||||||
|
#elif defined(__STDC__)
|
||||||
|
|
||||||
|
// de nada
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
/// complex type struct, matching PyTables definition
|
||||||
|
typedef struct {
|
||||||
|
double re; ///< real part
|
||||||
|
double im; ///< imaginary part
|
||||||
|
} xd_complex_t;
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
|
@ -0,0 +1,45 @@
|
||||||
|
"""C++ wrapper for extra types header."""
|
||||||
|
from libc.stdio cimport FILE
|
||||||
|
|
||||||
|
# Dirty ifdef, else, else preprocessor hack
|
||||||
|
# see http://comments.gmane.org/gmane.comp.python.cython.user/4080
|
||||||
|
cdef extern from *:
|
||||||
|
cdef void emit_ifc "#if defined(__STDC__) //" ()
|
||||||
|
cdef void emit_ifcpp "#if defined(__cplusplus) //" ()
|
||||||
|
cdef void emit_elifc "#elif defined(__STDC__) //" ()
|
||||||
|
cdef void emit_elifcpp "#elif defined(__cplusplus) //" ()
|
||||||
|
cdef void emit_else "#else //" ()
|
||||||
|
cdef void emit_endif "#endif //" ()
|
||||||
|
|
||||||
|
ctypedef unsigned char uchar
|
||||||
|
ctypedef long long int64
|
||||||
|
ctypedef unsigned short uint16
|
||||||
|
ctypedef unsigned int uint32
|
||||||
|
ctypedef unsigned long long uint64
|
||||||
|
ctypedef long double float128
|
||||||
|
|
||||||
|
cdef extern from "xdress_extra_types.h":
|
||||||
|
|
||||||
|
ctypedef struct complex_t "xd_complex_t":
|
||||||
|
double re
|
||||||
|
double im
|
||||||
|
|
||||||
|
cdef complex_t py2c_complex(object pyv)
|
||||||
|
|
||||||
|
cdef extern from "Python.h":
|
||||||
|
|
||||||
|
object PyFile_FromFile(FILE *fp, char *name, char *mode, int (*close)(FILE*))
|
||||||
|
FILE* PyFile_AsFile(object p)
|
||||||
|
|
||||||
|
|
||||||
|
#emit_ifcpp()
|
||||||
|
#cdef extern from "<exception>" namespace "std":
|
||||||
|
|
||||||
|
# cdef cppclass exception:
|
||||||
|
# exception()
|
||||||
|
# exception(const exception&)
|
||||||
|
# exception& operator= (const exception&)
|
||||||
|
# ~exception()
|
||||||
|
# const char * what()
|
||||||
|
|
||||||
|
#emit_endif()
|
|
@ -0,0 +1,12 @@
|
||||||
|
#
|
||||||
|
# This file has been autogenerated by xdress
|
||||||
|
#
|
||||||
|
|
||||||
|
cdef complex_t py2c_complex(object pyv):
|
||||||
|
cdef complex_t cv = complex_t(0, 0)
|
||||||
|
pyv = complex(pyv)
|
||||||
|
cv.re = pyv.real
|
||||||
|
cv.im = pyv.imag
|
||||||
|
return cv
|
||||||
|
|
||||||
|
|
|
@ -875,6 +875,7 @@ YAPEngine::YAPEngine(char *savedState, char *bootFile, size_t stackSize,
|
||||||
size_t trailSize, size_t maxStackSize, size_t maxTrailSize,
|
size_t trailSize, size_t maxStackSize, size_t maxTrailSize,
|
||||||
char *libDir, char *goal, char *topLevel, bool script,
|
char *libDir, char *goal, char *topLevel, bool script,
|
||||||
bool fastBoot,
|
bool fastBoot,
|
||||||
|
bool embedded,
|
||||||
YAPCallback *cb)
|
YAPCallback *cb)
|
||||||
: _callback(0) { // a single engine can be active
|
: _callback(0) { // a single engine can be active
|
||||||
|
|
||||||
|
@ -907,6 +908,7 @@ YAPEngine::YAPEngine(char *savedState, char *bootFile, size_t stackSize,
|
||||||
init_args.YapPrologTopLevelGoal = topLevel;
|
init_args.YapPrologTopLevelGoal = topLevel;
|
||||||
init_args.HaltAfterConsult = script;
|
init_args.HaltAfterConsult = script;
|
||||||
init_args.FastBoot = fastBoot;
|
init_args.FastBoot = fastBoot;
|
||||||
|
init_args.Embedded = embedded;
|
||||||
doInit(BootMode);
|
doInit(BootMode);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
11
CXX/yapq.hh
11
CXX/yapq.hh
|
@ -145,6 +145,7 @@ public:
|
||||||
size_t maxTrailSize = 0, char *libDir = (char *)NULL,
|
size_t maxTrailSize = 0, char *libDir = (char *)NULL,
|
||||||
char *goal = (char *)NULL, char *topLevel = (char *)NULL,
|
char *goal = (char *)NULL, char *topLevel = (char *)NULL,
|
||||||
bool script = FALSE, bool fastBoot = FALSE,
|
bool script = FALSE, bool fastBoot = FALSE,
|
||||||
|
bool embedded = true,
|
||||||
YAPCallback *callback = (YAPCallback *)
|
YAPCallback *callback = (YAPCallback *)
|
||||||
NULL); /// construct a new engine, including aaccess to callbacks
|
NULL); /// construct a new engine, including aaccess to callbacks
|
||||||
/// construct a new engine using argc/argv list of arguments
|
/// construct a new engine using argc/argv list of arguments
|
||||||
|
@ -183,16 +184,6 @@ public:
|
||||||
bool goalt(YAPTerm t);
|
bool goalt(YAPTerm t);
|
||||||
/// current directory for the engine
|
/// current directory for the engine
|
||||||
bool goal(Term t);
|
bool goal(Term t);
|
||||||
bool unlockedGoal(Term t) {bool rc;
|
|
||||||
#ifdef SWIGPYTHON
|
|
||||||
Py_BEGIN_ALLOW_THREADS;
|
|
||||||
#endif
|
|
||||||
rc = goal(t);
|
|
||||||
#ifdef SWIGPYTHON
|
|
||||||
Py_END_ALLOW_THREADS;
|
|
||||||
#endif
|
|
||||||
return rc;
|
|
||||||
}
|
|
||||||
/// reset Prolog state
|
/// reset Prolog state
|
||||||
void reSet();
|
void reSet();
|
||||||
/// release: assune that there are no stack pointers, just release memory
|
/// release: assune that there are no stack pointers, just release memory
|
||||||
|
|
10
H/ATOMS
10
H/ATOMS
|
@ -29,7 +29,13 @@ A Arrow N "->"
|
||||||
A AttributedModule N "attributes_module"
|
A AttributedModule N "attributes_module"
|
||||||
A DoubleArrow N "-->"
|
A DoubleArrow N "-->"
|
||||||
A Assert N ":-"
|
A Assert N ":-"
|
||||||
A EmptyBrackets N "()"
|
A BeginBracket N "("
|
||||||
|
A EndBracket N ")"
|
||||||
|
A BeginSquareBracket N "["
|
||||||
|
A EndSquareBracket N "]"
|
||||||
|
A BeginCurlyBracket N "{"
|
||||||
|
A EndCurlyBracket N "}"
|
||||||
|
A EmptyBrackets N "()"
|
||||||
A EmptySquareBrackets N "[]"
|
A EmptySquareBrackets N "[]"
|
||||||
A EmptyCurlyBrackets N "{}"
|
A EmptyCurlyBrackets N "{}"
|
||||||
A Asserta N "asserta"
|
A Asserta N "asserta"
|
||||||
|
@ -68,6 +74,7 @@ A Chars N "chars"
|
||||||
A Charset N "charset"
|
A Charset N "charset"
|
||||||
A ChType F "$char_type"
|
A ChType F "$char_type"
|
||||||
A CleanCall F "$clean_call"
|
A CleanCall F "$clean_call"
|
||||||
|
A Close N "close"
|
||||||
A Colon N ":"
|
A Colon N ":"
|
||||||
A CodeSpace N "code_space"
|
A CodeSpace N "code_space"
|
||||||
A Codes N "codes"
|
A Codes N "codes"
|
||||||
|
@ -201,6 +208,7 @@ A Integer N "integer"
|
||||||
A InternalCompilerError N "internal_compiler_error"
|
A InternalCompilerError N "internal_compiler_error"
|
||||||
A Is N "is"
|
A Is N "is"
|
||||||
A J N "j"
|
A J N "j"
|
||||||
|
A l N "l"
|
||||||
A Key N "key"
|
A Key N "key"
|
||||||
A LDLibraryPath N "LD_LIBRARY_PATH"
|
A LDLibraryPath N "LD_LIBRARY_PATH"
|
||||||
A LONGINT N "LongInt"
|
A LONGINT N "LongInt"
|
||||||
|
|
|
@ -59,7 +59,6 @@ typedef struct AtomEntryStruct {
|
||||||
union {
|
union {
|
||||||
unsigned char uUStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
|
unsigned char uUStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
|
||||||
char uStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
|
char uStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
|
||||||
wchar_t uWStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
|
|
||||||
struct atom_blob blob[MIN_ARRAY];
|
struct atom_blob blob[MIN_ARRAY];
|
||||||
} rep;
|
} rep;
|
||||||
} AtomEntry;
|
} AtomEntry;
|
||||||
|
@ -75,14 +74,12 @@ typedef struct ExtraAtomEntryStruct {
|
||||||
union {
|
union {
|
||||||
unsigned char uUStrOfAE[4]; /* representation of atom as a string */
|
unsigned char uUStrOfAE[4]; /* representation of atom as a string */
|
||||||
char uStrOfAE[4]; /* representation of atom as a string */
|
char uStrOfAE[4]; /* representation of atom as a string */
|
||||||
wchar_t uWStrOfAE[2]; /* representation of atom as a string */
|
|
||||||
struct atom_blob blob[2];
|
struct atom_blob blob[2];
|
||||||
} rep;
|
} rep;
|
||||||
} ExtraAtomEntry;
|
} ExtraAtomEntry;
|
||||||
|
|
||||||
#define UStrOfAE rep.uUStrOfAE
|
#define UStrOfAE rep.uUStrOfAE
|
||||||
#define StrOfAE rep.uStrOfAE
|
#define StrOfAE rep.uStrOfAE
|
||||||
#define WStrOfAE rep.uWStrOfAE
|
|
||||||
|
|
||||||
/* Props and Atoms are stored in chains, ending with a NIL */
|
/* Props and Atoms are stored in chains, ending with a NIL */
|
||||||
#ifdef USE_OFFSETS
|
#ifdef USE_OFFSETS
|
||||||
|
|
5
H/Yap.h
5
H/Yap.h
|
@ -462,6 +462,7 @@ extern ADDR Yap_HeapBase;
|
||||||
/* This is ok for Linux, should be ok for everyone */
|
/* This is ok for Linux, should be ok for everyone */
|
||||||
#define YAP_FILENAME_MAX 1024
|
#define YAP_FILENAME_MAX 1024
|
||||||
|
|
||||||
|
|
||||||
/*************************************************************************************************
|
/*************************************************************************************************
|
||||||
Debugging Support
|
Debugging Support
|
||||||
*************************************************************************************************/
|
*************************************************************************************************/
|
||||||
|
@ -850,4 +851,8 @@ inline static void LOG0(const char *f, int l, const char *fmt, ...) {
|
||||||
|
|
||||||
#include "GitSHA1.h"
|
#include "GitSHA1.h"
|
||||||
|
|
||||||
|
extern bool Yap_embedded, Yap_Server;
|
||||||
|
|
||||||
#endif /* YAP_H */
|
#endif /* YAP_H */
|
||||||
|
|
||||||
|
#include "YapText.h"
|
||||||
|
|
53
H/YapText.h
53
H/YapText.h
|
@ -31,47 +31,18 @@
|
||||||
#include "../utf8proc/utf8proc.h"
|
#include "../utf8proc/utf8proc.h"
|
||||||
#include "Yap.h"
|
#include "Yap.h"
|
||||||
|
|
||||||
|
/// allocate a temporary text block
|
||||||
|
///
|
||||||
|
extern void *Malloc(size_t sz USES_REGS);
|
||||||
|
extern void *Realloc(void *buf, size_t sz USES_REGS);
|
||||||
|
extern void Free(void *buf USES_REGS);
|
||||||
|
|
||||||
typedef struct TextBuffer_manager {
|
extern int push_text_stack( USES_REGS1 );
|
||||||
void *buf, *ptr;
|
extern int pop_text_stack( int lvl USES_REGS );
|
||||||
size_t sz;
|
|
||||||
struct TextBuffer_manager *prev;
|
|
||||||
} text_buffer_t;
|
|
||||||
|
|
||||||
/**
|
#define min(x,y) (x<y ? x : y)
|
||||||
* TextBuffer is allocated as a chain of blocks, They area
|
|
||||||
* recovered at the end if the translation.
|
|
||||||
*/
|
|
||||||
inline void init_alloc(int line) {
|
|
||||||
while (LOCAL_TextBuffer->prev ) {
|
|
||||||
struct TextBuffer_manager *old = LOCAL_TextBuffer;
|
|
||||||
LOCAL_TextBuffer = LOCAL_TextBuffer->prev;
|
|
||||||
free(old);
|
|
||||||
}
|
|
||||||
LOCAL_TextBuffer->sz = (YAP_FILENAME_MAX + 1);
|
|
||||||
LOCAL_TextBuffer->buf = LOCAL_TextBuffer->ptr = realloc(LOCAL_TextBuffer->ptr, YAP_FILENAME_MAX + 1 );
|
|
||||||
}
|
|
||||||
|
|
||||||
extern inline void mark_stack(void) {}
|
|
||||||
|
|
||||||
extern inline void restore_stack(void ) {} \
|
#define MBYTE (1024*1024)
|
||||||
|
|
||||||
extern inline void unprotect_stack(void *ptr) {} \
|
|
||||||
|
|
||||||
extern inline void *Malloc(size_t sz USES_REGS) {
|
|
||||||
sz = ALIGN_BY_TYPE(sz, CELL);
|
|
||||||
void *o = LOCAL_TextBuffer->ptr;
|
|
||||||
if ((char*)LOCAL_TextBuffer->ptr+sz>(char*)LOCAL_TextBuffer->buf + LOCAL_TextBuffer->sz) {
|
|
||||||
struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+YAP_FILENAME_MAX + 1);
|
|
||||||
new->prev = LOCAL_TextBuffer;
|
|
||||||
new->buf = (struct TextBuffer_manager *)new+1;
|
|
||||||
new->ptr = new->buf + sz;
|
|
||||||
LOCAL_TextBuffer= new;
|
|
||||||
return new->buf;
|
|
||||||
}
|
|
||||||
LOCAL_TextBuffer->ptr += sz;
|
|
||||||
return o;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Character types for tokenizer and write.c */
|
/* Character types for tokenizer and write.c */
|
||||||
|
|
||||||
|
@ -189,12 +160,12 @@ inline static utf8proc_ssize_t get_utf8(const utf8proc_uint8_t *ptr, size_t n,
|
||||||
}
|
}
|
||||||
|
|
||||||
inline static utf8proc_ssize_t put_utf8(utf8proc_uint8_t *ptr,
|
inline static utf8proc_ssize_t put_utf8(utf8proc_uint8_t *ptr,
|
||||||
utf8proc_int32_t val) {
|
utf8proc_int32_t val) {
|
||||||
return utf8proc_encode_char(val, ptr);
|
return utf8proc_encode_char(val, ptr);
|
||||||
}
|
}
|
||||||
|
|
||||||
inline static const utf8proc_uint8_t *skip_utf8(const utf8proc_uint8_t *pt,
|
inline static const utf8proc_uint8_t *skip_utf8(const utf8proc_uint8_t *pt,
|
||||||
utf8proc_ssize_t n) {
|
utf8proc_ssize_t n) {
|
||||||
utf8proc_ssize_t i;
|
utf8proc_ssize_t i;
|
||||||
utf8proc_int32_t b;
|
utf8proc_int32_t b;
|
||||||
for (i = 0; i < n; i++) {
|
for (i = 0; i < n; i++) {
|
||||||
|
@ -315,7 +286,7 @@ inline static int cmpn_utf8(const utf8proc_uint8_t *pt1,
|
||||||
#define SURROGATE_OFFSET \
|
#define SURROGATE_OFFSET \
|
||||||
((uint32_t)0x10000 - (uint32_t)(0xD800 << 10) - (uint32_t)0xDC00)
|
((uint32_t)0x10000 - (uint32_t)(0xD800 << 10) - (uint32_t)0xDC00)
|
||||||
|
|
||||||
const char *Yap_tokRep(TokEntry *tokptr, encoding_t enc);
|
const char *Yap_tokRep(void*tokptr, encoding_t enc);
|
||||||
|
|
||||||
// standard strings
|
// standard strings
|
||||||
|
|
||||||
|
|
|
@ -35,9 +35,6 @@ extern struct operator_entry *
|
||||||
extern Atom Yap_LookupAtom(const char *);
|
extern Atom Yap_LookupAtom(const char *);
|
||||||
extern Atom Yap_ULookupAtom(const unsigned char *);
|
extern Atom Yap_ULookupAtom(const unsigned char *);
|
||||||
extern Atom Yap_LookupAtomWithLength(const char *, size_t);
|
extern Atom Yap_LookupAtomWithLength(const char *, size_t);
|
||||||
extern Atom Yap_LookupUTF8Atom(const unsigned char *);
|
|
||||||
extern Atom Yap_LookupMaybeWideAtom(const wchar_t *);
|
|
||||||
extern Atom Yap_LookupMaybeWideAtomWithLength(const wchar_t *, size_t);
|
|
||||||
extern Atom Yap_FullLookupAtom(const char *);
|
extern Atom Yap_FullLookupAtom(const char *);
|
||||||
extern void Yap_LookupAtomWithAddress(const char *, struct AtomEntryStruct *);
|
extern void Yap_LookupAtomWithAddress(const char *, struct AtomEntryStruct *);
|
||||||
extern Prop Yap_NewPredPropByFunctor(struct FunctorEntryStruct *, Term);
|
extern Prop Yap_NewPredPropByFunctor(struct FunctorEntryStruct *, Term);
|
||||||
|
@ -447,6 +444,8 @@ extern intptr_t system_thread_id(void);
|
||||||
extern void Yap_InitLowLevelTrace(void);
|
extern void Yap_InitLowLevelTrace(void);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
extern void *Yap_InitTextAllocator( void );
|
||||||
|
|
||||||
/* udi.c */
|
/* udi.c */
|
||||||
extern void Yap_udi_init(void);
|
extern void Yap_udi_init(void);
|
||||||
extern void Yap_udi_abolish(struct pred_entry *);
|
extern void Yap_udi_abolish(struct pred_entry *);
|
||||||
|
|
59
H/Yatom.h
59
H/Yatom.h
|
@ -198,58 +198,6 @@ INLINE_ONLY inline EXTERN PropFlags IsGlobalProperty(int flags) {
|
||||||
return (PropFlags)((flags == GlobalProperty));
|
return (PropFlags)((flags == GlobalProperty));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Wide Atom property */
|
|
||||||
typedef struct {
|
|
||||||
Prop NextOfPE; /* used to chain properties */
|
|
||||||
PropFlags KindOfPE; /* kind of property */
|
|
||||||
UInt SizeOfAtom; /* index in module table */
|
|
||||||
} WideAtomEntry;
|
|
||||||
|
|
||||||
#if USE_OFFSETS_IN_PROPS
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p) {
|
|
||||||
return (WideAtomEntry *)(AtomBase + Unsigned(p));
|
|
||||||
}
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p) {
|
|
||||||
return (Prop)(Addr(p) - AtomBase);
|
|
||||||
}
|
|
||||||
|
|
||||||
#else
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN WideAtomEntry *RepWideAtomProp(Prop p) {
|
|
||||||
return (WideAtomEntry *)(p);
|
|
||||||
}
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN Prop AbsWideAtomProp(WideAtomEntry *p) {
|
|
||||||
return (Prop)(p);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#define WideAtomProperty ((PropFlags)0xfff8)
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN bool IsWideAtomProperty(PropFlags);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN bool IsWideAtomProperty(PropFlags flags) {
|
|
||||||
return (flags == WideAtomProperty);
|
|
||||||
}
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN bool IsWideAtom(Atom);
|
|
||||||
|
|
||||||
INLINE_ONLY inline EXTERN bool IsWideAtom(Atom at) {
|
|
||||||
return RepAtom(at)->PropsOfAE != NIL &&
|
|
||||||
IsWideAtomProperty(RepWideAtomProp(RepAtom(at)->PropsOfAE)->KindOfPE);
|
|
||||||
}
|
|
||||||
|
|
||||||
/** Module property: low-level data used to manage modes.
|
/** Module property: low-level data used to manage modes.
|
||||||
|
|
||||||
Includes lists of pedicates, operators and other well-defIned
|
Includes lists of pedicates, operators and other well-defIned
|
||||||
|
@ -1609,15 +1557,8 @@ INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *, PropEntry *p);
|
||||||
INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) {
|
INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) {
|
||||||
/* old properties should be always last, and wide atom properties
|
/* old properties should be always last, and wide atom properties
|
||||||
should always be first */
|
should always be first */
|
||||||
if (ae->PropsOfAE != NIL &&
|
|
||||||
RepProp(ae->PropsOfAE)->KindOfPE == WideAtomProperty) {
|
|
||||||
PropEntry *pp = RepProp(ae->PropsOfAE);
|
|
||||||
p->NextOfPE = pp->NextOfPE;
|
|
||||||
pp->NextOfPE = AbsProp(p);
|
|
||||||
} else {
|
|
||||||
p->NextOfPE = ae->PropsOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropsOfAE = AbsProp(p);
|
ae->PropsOfAE = AbsProp(p);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// auxiliary functions
|
// auxiliary functions
|
||||||
|
|
|
@ -24,6 +24,12 @@
|
||||||
AtomAttributedModule = Yap_LookupAtom("attributes_module"); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
|
AtomAttributedModule = Yap_LookupAtom("attributes_module"); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
|
||||||
AtomDoubleArrow = Yap_LookupAtom("-->"); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
|
AtomDoubleArrow = Yap_LookupAtom("-->"); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
|
||||||
AtomAssert = Yap_LookupAtom(":-"); TermAssert = MkAtomTerm(AtomAssert);
|
AtomAssert = Yap_LookupAtom(":-"); TermAssert = MkAtomTerm(AtomAssert);
|
||||||
|
AtomBeginBracket = Yap_LookupAtom("("); TermBeginBracket = MkAtomTerm(AtomBeginBracket);
|
||||||
|
AtomEndBracket = Yap_LookupAtom(")"); TermEndBracket = MkAtomTerm(AtomEndBracket);
|
||||||
|
AtomBeginSquareBracket = Yap_LookupAtom("["); TermBeginSquareBracket = MkAtomTerm(AtomBeginSquareBracket);
|
||||||
|
AtomEndSquareBracket = Yap_LookupAtom("]"); TermEndSquareBracket = MkAtomTerm(AtomEndSquareBracket);
|
||||||
|
AtomBeginCurlyBracket = Yap_LookupAtom("{"); TermBeginCurlyBracket = MkAtomTerm(AtomBeginCurlyBracket);
|
||||||
|
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);
|
AtomEmptyCurlyBrackets = Yap_LookupAtom("{}"); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
|
||||||
|
@ -63,6 +69,7 @@
|
||||||
AtomCharset = Yap_LookupAtom("charset"); TermCharset = MkAtomTerm(AtomCharset);
|
AtomCharset = Yap_LookupAtom("charset"); TermCharset = MkAtomTerm(AtomCharset);
|
||||||
AtomChType = Yap_FullLookupAtom("$char_type"); TermChType = MkAtomTerm(AtomChType);
|
AtomChType = Yap_FullLookupAtom("$char_type"); TermChType = MkAtomTerm(AtomChType);
|
||||||
AtomCleanCall = Yap_FullLookupAtom("$clean_call"); TermCleanCall = MkAtomTerm(AtomCleanCall);
|
AtomCleanCall = Yap_FullLookupAtom("$clean_call"); TermCleanCall = MkAtomTerm(AtomCleanCall);
|
||||||
|
AtomClose = Yap_LookupAtom("close"); TermClose = MkAtomTerm(AtomClose);
|
||||||
AtomColon = Yap_LookupAtom(":"); TermColon = MkAtomTerm(AtomColon);
|
AtomColon = Yap_LookupAtom(":"); TermColon = MkAtomTerm(AtomColon);
|
||||||
AtomCodeSpace = Yap_LookupAtom("code_space"); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
|
AtomCodeSpace = Yap_LookupAtom("code_space"); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
|
||||||
AtomCodes = Yap_LookupAtom("codes"); TermCodes = MkAtomTerm(AtomCodes);
|
AtomCodes = Yap_LookupAtom("codes"); TermCodes = MkAtomTerm(AtomCodes);
|
||||||
|
@ -196,6 +203,7 @@
|
||||||
AtomInternalCompilerError = Yap_LookupAtom("internal_compiler_error"); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
|
AtomInternalCompilerError = Yap_LookupAtom("internal_compiler_error"); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
|
||||||
AtomIs = Yap_LookupAtom("is"); TermIs = MkAtomTerm(AtomIs);
|
AtomIs = Yap_LookupAtom("is"); TermIs = MkAtomTerm(AtomIs);
|
||||||
AtomJ = Yap_LookupAtom("j"); TermJ = MkAtomTerm(AtomJ);
|
AtomJ = Yap_LookupAtom("j"); TermJ = MkAtomTerm(AtomJ);
|
||||||
|
Atoml = Yap_LookupAtom("l"); Terml = MkAtomTerm(Atoml);
|
||||||
AtomKey = Yap_LookupAtom("key"); TermKey = MkAtomTerm(AtomKey);
|
AtomKey = Yap_LookupAtom("key"); TermKey = MkAtomTerm(AtomKey);
|
||||||
AtomLDLibraryPath = Yap_LookupAtom("LD_LIBRARY_PATH"); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
|
AtomLDLibraryPath = Yap_LookupAtom("LD_LIBRARY_PATH"); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
|
||||||
AtomLONGINT = Yap_LookupAtom("LongInt"); TermLONGINT = MkAtomTerm(AtomLONGINT);
|
AtomLONGINT = Yap_LookupAtom("LongInt"); TermLONGINT = MkAtomTerm(AtomLONGINT);
|
||||||
|
|
|
@ -24,6 +24,12 @@
|
||||||
AtomAttributedModule = AtomAdjust(AtomAttributedModule); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
|
AtomAttributedModule = AtomAdjust(AtomAttributedModule); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
|
||||||
AtomDoubleArrow = AtomAdjust(AtomDoubleArrow); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
|
AtomDoubleArrow = AtomAdjust(AtomDoubleArrow); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
|
||||||
AtomAssert = AtomAdjust(AtomAssert); TermAssert = MkAtomTerm(AtomAssert);
|
AtomAssert = AtomAdjust(AtomAssert); TermAssert = MkAtomTerm(AtomAssert);
|
||||||
|
AtomBeginBracket = AtomAdjust(AtomBeginBracket); TermBeginBracket = MkAtomTerm(AtomBeginBracket);
|
||||||
|
AtomEndBracket = AtomAdjust(AtomEndBracket); TermEndBracket = MkAtomTerm(AtomEndBracket);
|
||||||
|
AtomBeginSquareBracket = AtomAdjust(AtomBeginSquareBracket); TermBeginSquareBracket = MkAtomTerm(AtomBeginSquareBracket);
|
||||||
|
AtomEndSquareBracket = AtomAdjust(AtomEndSquareBracket); TermEndSquareBracket = MkAtomTerm(AtomEndSquareBracket);
|
||||||
|
AtomBeginCurlyBracket = AtomAdjust(AtomBeginCurlyBracket); TermBeginCurlyBracket = MkAtomTerm(AtomBeginCurlyBracket);
|
||||||
|
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);
|
AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
|
||||||
|
@ -63,6 +69,7 @@
|
||||||
AtomCharset = AtomAdjust(AtomCharset); TermCharset = MkAtomTerm(AtomCharset);
|
AtomCharset = AtomAdjust(AtomCharset); TermCharset = MkAtomTerm(AtomCharset);
|
||||||
AtomChType = AtomAdjust(AtomChType); TermChType = MkAtomTerm(AtomChType);
|
AtomChType = AtomAdjust(AtomChType); TermChType = MkAtomTerm(AtomChType);
|
||||||
AtomCleanCall = AtomAdjust(AtomCleanCall); TermCleanCall = MkAtomTerm(AtomCleanCall);
|
AtomCleanCall = AtomAdjust(AtomCleanCall); TermCleanCall = MkAtomTerm(AtomCleanCall);
|
||||||
|
AtomClose = AtomAdjust(AtomClose); TermClose = MkAtomTerm(AtomClose);
|
||||||
AtomColon = AtomAdjust(AtomColon); TermColon = MkAtomTerm(AtomColon);
|
AtomColon = AtomAdjust(AtomColon); TermColon = MkAtomTerm(AtomColon);
|
||||||
AtomCodeSpace = AtomAdjust(AtomCodeSpace); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
|
AtomCodeSpace = AtomAdjust(AtomCodeSpace); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
|
||||||
AtomCodes = AtomAdjust(AtomCodes); TermCodes = MkAtomTerm(AtomCodes);
|
AtomCodes = AtomAdjust(AtomCodes); TermCodes = MkAtomTerm(AtomCodes);
|
||||||
|
@ -196,6 +203,7 @@
|
||||||
AtomInternalCompilerError = AtomAdjust(AtomInternalCompilerError); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
|
AtomInternalCompilerError = AtomAdjust(AtomInternalCompilerError); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
|
||||||
AtomIs = AtomAdjust(AtomIs); TermIs = MkAtomTerm(AtomIs);
|
AtomIs = AtomAdjust(AtomIs); TermIs = MkAtomTerm(AtomIs);
|
||||||
AtomJ = AtomAdjust(AtomJ); TermJ = MkAtomTerm(AtomJ);
|
AtomJ = AtomAdjust(AtomJ); TermJ = MkAtomTerm(AtomJ);
|
||||||
|
Atoml = AtomAdjust(Atoml); Terml = MkAtomTerm(Atoml);
|
||||||
AtomKey = AtomAdjust(AtomKey); TermKey = MkAtomTerm(AtomKey);
|
AtomKey = AtomAdjust(AtomKey); TermKey = MkAtomTerm(AtomKey);
|
||||||
AtomLDLibraryPath = AtomAdjust(AtomLDLibraryPath); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
|
AtomLDLibraryPath = AtomAdjust(AtomLDLibraryPath); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
|
||||||
AtomLONGINT = AtomAdjust(AtomLONGINT); TermLONGINT = MkAtomTerm(AtomLONGINT);
|
AtomLONGINT = AtomAdjust(AtomLONGINT); TermLONGINT = MkAtomTerm(AtomLONGINT);
|
||||||
|
|
|
@ -24,6 +24,12 @@ EXTERNAL Atom AtomArrow; EXTERNAL Term TermArrow;
|
||||||
EXTERNAL Atom AtomAttributedModule; EXTERNAL Term TermAttributedModule;
|
EXTERNAL Atom AtomAttributedModule; EXTERNAL Term TermAttributedModule;
|
||||||
EXTERNAL Atom AtomDoubleArrow; EXTERNAL Term TermDoubleArrow;
|
EXTERNAL Atom AtomDoubleArrow; EXTERNAL Term TermDoubleArrow;
|
||||||
EXTERNAL Atom AtomAssert; EXTERNAL Term TermAssert;
|
EXTERNAL Atom AtomAssert; EXTERNAL Term TermAssert;
|
||||||
|
EXTERNAL Atom AtomBeginBracket; EXTERNAL Term TermBeginBracket;
|
||||||
|
EXTERNAL Atom AtomEndBracket; EXTERNAL Term TermEndBracket;
|
||||||
|
EXTERNAL Atom AtomBeginSquareBracket; EXTERNAL Term TermBeginSquareBracket;
|
||||||
|
EXTERNAL Atom AtomEndSquareBracket; EXTERNAL Term TermEndSquareBracket;
|
||||||
|
EXTERNAL Atom AtomBeginCurlyBracket; EXTERNAL Term TermBeginCurlyBracket;
|
||||||
|
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 AtomEmptyCurlyBrackets; EXTERNAL Term TermEmptyCurlyBrackets;
|
||||||
|
@ -63,6 +69,7 @@ EXTERNAL Atom AtomChars; EXTERNAL Term TermChars;
|
||||||
EXTERNAL Atom AtomCharset; EXTERNAL Term TermCharset;
|
EXTERNAL Atom AtomCharset; EXTERNAL Term TermCharset;
|
||||||
EXTERNAL Atom AtomChType; EXTERNAL Term TermChType;
|
EXTERNAL Atom AtomChType; EXTERNAL Term TermChType;
|
||||||
EXTERNAL Atom AtomCleanCall; EXTERNAL Term TermCleanCall;
|
EXTERNAL Atom AtomCleanCall; EXTERNAL Term TermCleanCall;
|
||||||
|
EXTERNAL Atom AtomClose; EXTERNAL Term TermClose;
|
||||||
EXTERNAL Atom AtomColon; EXTERNAL Term TermColon;
|
EXTERNAL Atom AtomColon; EXTERNAL Term TermColon;
|
||||||
EXTERNAL Atom AtomCodeSpace; EXTERNAL Term TermCodeSpace;
|
EXTERNAL Atom AtomCodeSpace; EXTERNAL Term TermCodeSpace;
|
||||||
EXTERNAL Atom AtomCodes; EXTERNAL Term TermCodes;
|
EXTERNAL Atom AtomCodes; EXTERNAL Term TermCodes;
|
||||||
|
@ -196,6 +203,7 @@ EXTERNAL Atom AtomInteger; EXTERNAL Term TermInteger;
|
||||||
EXTERNAL Atom AtomInternalCompilerError; EXTERNAL Term TermInternalCompilerError;
|
EXTERNAL Atom AtomInternalCompilerError; EXTERNAL Term TermInternalCompilerError;
|
||||||
EXTERNAL Atom AtomIs; EXTERNAL Term TermIs;
|
EXTERNAL Atom AtomIs; EXTERNAL Term TermIs;
|
||||||
EXTERNAL Atom AtomJ; EXTERNAL Term TermJ;
|
EXTERNAL Atom AtomJ; EXTERNAL Term TermJ;
|
||||||
|
EXTERNAL Atom Atoml; EXTERNAL Term Terml;
|
||||||
EXTERNAL Atom AtomKey; EXTERNAL Term TermKey;
|
EXTERNAL Atom AtomKey; EXTERNAL Term TermKey;
|
||||||
EXTERNAL Atom AtomLDLibraryPath; EXTERNAL Term TermLDLibraryPath;
|
EXTERNAL Atom AtomLDLibraryPath; EXTERNAL Term TermLDLibraryPath;
|
||||||
EXTERNAL Atom AtomLONGINT; EXTERNAL Term TermLONGINT;
|
EXTERNAL Atom AtomLONGINT; EXTERNAL Term TermLONGINT;
|
||||||
|
|
3
H/qly.h
3
H/qly.h
|
@ -96,10 +96,9 @@ typedef enum {
|
||||||
QLY_END_OPS = 11,
|
QLY_END_OPS = 11,
|
||||||
QLY_START_PREDICATE = 12,
|
QLY_START_PREDICATE = 12,
|
||||||
QLY_END_PREDICATES = 13,
|
QLY_END_PREDICATES = 13,
|
||||||
QLY_ATOM_WIDE = 14,
|
|
||||||
QLY_FAILCODE = 15,
|
QLY_FAILCODE = 15,
|
||||||
QLY_ATOM = 16,
|
QLY_ATOM = 16,
|
||||||
QLY_ATOM_BLOB = 17
|
QLY_ATOM_BLOB = 14
|
||||||
} qlf_tag_t;
|
} qlf_tag_t;
|
||||||
|
|
||||||
#define STATIC_PRED_FLAGS \
|
#define STATIC_PRED_FLAGS \
|
||||||
|
|
|
@ -1460,9 +1460,6 @@ static void RestoreEntries(PropEntry *pp, int int_key USES_REGS) {
|
||||||
case ExpProperty:
|
case ExpProperty:
|
||||||
pp->NextOfPE = PropAdjust(pp->NextOfPE);
|
pp->NextOfPE = PropAdjust(pp->NextOfPE);
|
||||||
break;
|
break;
|
||||||
case WideAtomProperty:
|
|
||||||
pp->NextOfPE = PropAdjust(pp->NextOfPE);
|
|
||||||
break;
|
|
||||||
case BlobProperty:
|
case BlobProperty:
|
||||||
pp->NextOfPE = PropAdjust(pp->NextOfPE);
|
pp->NextOfPE = PropAdjust(pp->NextOfPE);
|
||||||
{
|
{
|
||||||
|
|
|
@ -0,0 +1,152 @@
|
||||||
|
/*************************************************************************
|
||||||
|
* *
|
||||||
|
* YAP Prolog *
|
||||||
|
* *
|
||||||
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||||
|
* *
|
||||||
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||||
|
* *
|
||||||
|
**************************************************************************
|
||||||
|
* *
|
||||||
|
* File: callcount.yap *
|
||||||
|
* Last rev: 8/2/02 *
|
||||||
|
* mods: *
|
||||||
|
* comments: Some profiling predicates available in yap *
|
||||||
|
* *
|
||||||
|
*************************************************************************/
|
||||||
|
|
||||||
|
%% @{
|
||||||
|
|
||||||
|
/** @defgroup Profiling Profiling Prolog Programs
|
||||||
|
@ingroup extensions
|
||||||
|
|
||||||
|
YAP includes two profilers. The count profiler keeps information on the
|
||||||
|
number of times a predicate was called. This information can be used to
|
||||||
|
detect what are the most commonly called predicates in the program. The
|
||||||
|
count profiler can be compiled by setting YAP's flag profiling
|
||||||
|
to `on`. The time-profiler is a `gprof` profiler, and counts
|
||||||
|
how many ticks are being spent on specific predicates, or on other
|
||||||
|
system functions such as internal data-base accesses or garbage collects.
|
||||||
|
|
||||||
|
The YAP profiling sub-system is currently under
|
||||||
|
development. Functionality for this sub-system will increase with newer
|
||||||
|
implementation.
|
||||||
|
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
%% @{
|
||||||
|
|
||||||
|
/** @defgroup Call_Counting Counting Calls
|
||||||
|
@ingroup Profiling
|
||||||
|
|
||||||
|
Predicates compiled with YAP's flag call_counting set to
|
||||||
|
`on` update counters on the numbers of calls and of
|
||||||
|
retries. Counters are actually decreasing counters, so that they can be
|
||||||
|
used as timers. Three counters are available:
|
||||||
|
|
||||||
|
+ `calls`: number of predicate calls since execution started or since
|
||||||
|
system was reset;
|
||||||
|
+ `retries`: number of retries for predicates called since
|
||||||
|
execution started or since counters were reset;
|
||||||
|
+ `calls_and_retries`: count both on predicate calls and
|
||||||
|
retries.
|
||||||
|
|
||||||
|
These counters can be used to find out how many calls a certain
|
||||||
|
goal takes to execute. They can also be used as timers.
|
||||||
|
|
||||||
|
The code for the call counters piggybacks on the profiling
|
||||||
|
code. Therefore, activating the call counters also activates the profiling
|
||||||
|
counters.
|
||||||
|
|
||||||
|
These are the predicates that access and manipulate the call counters.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- system_module( '$_callcount', [call_count/3,
|
||||||
|
call_count_data/3,
|
||||||
|
call_count_reset/0], []).
|
||||||
|
|
||||||
|
:- use_system_module( '$_errors', ['$do_error'/2]).
|
||||||
|
|
||||||
|
|
||||||
|
/** @pred call_count_data(- _Calls_, - _Retries_, - _CallsAndRetries_)
|
||||||
|
|
||||||
|
|
||||||
|
Give current call count data. The first argument gives the current value
|
||||||
|
for the _Calls_ counter, next the _Retries_ counter, and last
|
||||||
|
the _CallsAndRetries_ counter.
|
||||||
|
|
||||||
|
*/
|
||||||
|
call_count_data(Calls, Retries, Both) :-
|
||||||
|
'$call_count_info'(Calls, Retries, Both).
|
||||||
|
|
||||||
|
/** @pred call_count_reset
|
||||||
|
|
||||||
|
|
||||||
|
Reset call count counters. All timers are also reset.
|
||||||
|
|
||||||
|
*/
|
||||||
|
call_count_reset :-
|
||||||
|
'$call_count_reset'.
|
||||||
|
|
||||||
|
/** @pred call_count(? _CallsMax_, ? _RetriesMax_, ? _CallsAndRetriesMax_)
|
||||||
|
|
||||||
|
|
||||||
|
Set call counters as timers. YAP will generate an exception
|
||||||
|
if one of the instantiated call counters decreases to 0:
|
||||||
|
|
||||||
|
+ _CallsMax_
|
||||||
|
|
||||||
|
throw the exception `call_counter` when the
|
||||||
|
counter `calls` reaches 0;
|
||||||
|
|
||||||
|
+ _RetriesMax_
|
||||||
|
|
||||||
|
throw the exception `retry_counter` when the
|
||||||
|
counter `retries` reaches 0;
|
||||||
|
|
||||||
|
+ _CallsAndRetriesMax_
|
||||||
|
|
||||||
|
throw the exception
|
||||||
|
`call_and_retry_counter` when the counter `calls_and_retries`
|
||||||
|
reaches 0.
|
||||||
|
|
||||||
|
YAP will ignore counters that are called with unbound arguments.
|
||||||
|
|
||||||
|
Next, we show a simple example of how to use call counters:
|
||||||
|
|
||||||
|
~~~~~{.prolog}
|
||||||
|
?- yap_flag(call_counting,on), [-user]. l :- l. end_of_file. yap_flag(call_counting,off).
|
||||||
|
|
||||||
|
yes
|
||||||
|
|
||||||
|
yes
|
||||||
|
?- catch((call_count(10000,_,_),l),call_counter,format("limit_exceeded.~n",[])).
|
||||||
|
|
||||||
|
limit_exceeded.
|
||||||
|
|
||||||
|
yes
|
||||||
|
~~~~~
|
||||||
|
Notice that we first compile the looping predicate `l/0` with
|
||||||
|
call_counting `on`. Next, we catch/3 to handle an
|
||||||
|
exception when `l/0` performs more than 10000 reductions.
|
||||||
|
|
||||||
|
|
||||||
|
*/
|
||||||
|
call_count(Calls, Retries, Both) :-
|
||||||
|
'$check_if_call_count_on'(Calls, CallsOn),
|
||||||
|
'$check_if_call_count_on'(Retries, RetriesOn),
|
||||||
|
'$check_if_call_count_on'(Both, BothOn),
|
||||||
|
'$call_count_set'(Calls, CallsOn, Retries, RetriesOn, Both, BothOn).
|
||||||
|
|
||||||
|
'$check_if_call_count_on'(Calls, 1) :- integer(Calls), !.
|
||||||
|
'$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
|
||||||
|
'$check_if_call_count_on'(Calls, A) :-
|
||||||
|
'$do_error'(type_error(integer,Calls),call_count(A)).
|
||||||
|
|
||||||
|
%% @}
|
||||||
|
|
||||||
|
/**
|
||||||
|
@}
|
||||||
|
*/
|
||||||
|
|
|
@ -284,6 +284,8 @@ typedef struct yap_boot_params {
|
||||||
int Argc;
|
int Argc;
|
||||||
/* array of arguments as seen by Prolog */
|
/* array of arguments as seen by Prolog */
|
||||||
char **Argv;
|
char **Argv;
|
||||||
|
/* embedded in some other system: no signals, readline, etc */
|
||||||
|
bool Embedded;
|
||||||
/* QuietMode */
|
/* QuietMode */
|
||||||
int QuietMode;
|
int QuietMode;
|
||||||
|
|
||||||
|
|
|
@ -23,13 +23,15 @@
|
||||||
*
|
*
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <stdio.h>
|
#include <Yap.h>
|
||||||
#include <Yap.h>
|
#include <Yatom.h>
|
||||||
#include <Yatom.h>
|
#include <iopreds.h>
|
||||||
#include <iopreds.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
|
#include "YapText.h"
|
||||||
|
|
||||||
/* for freeBSD9.1 */
|
/* for freeBSD9.1 */
|
||||||
#define _WITH_DPRINTF
|
#define _WITH_DPRINTF
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
@ -37,18 +39,12 @@
|
||||||
//#include <SWI-Stream.h>
|
//#include <SWI-Stream.h>
|
||||||
//#include <pl-shared.h>
|
//#include <pl-shared.h>
|
||||||
|
|
||||||
|
|
||||||
#include "swi.h"
|
#include "swi.h"
|
||||||
|
|
||||||
static PL_blob_t unregistered_blob_atom =
|
static PL_blob_t unregistered_blob_atom = {
|
||||||
{ PL_BLOB_MAGIC,
|
PL_BLOB_MAGIC, PL_BLOB_NOCOPY | PL_BLOB_TEXT, "unregistered"};
|
||||||
PL_BLOB_NOCOPY|PL_BLOB_TEXT,
|
|
||||||
"unregistered"
|
|
||||||
};
|
|
||||||
|
|
||||||
int
|
int PL_is_blob(term_t t, PL_blob_t **type) {
|
||||||
PL_is_blob(term_t t, PL_blob_t **type)
|
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Term yt = Yap_GetFromSlot(t);
|
Term yt = Yap_GetFromSlot(t);
|
||||||
Atom a;
|
Atom a;
|
||||||
|
@ -69,8 +65,7 @@ PL_is_blob(term_t t, PL_blob_t **type)
|
||||||
/* void check_chain(void); */
|
/* void check_chain(void); */
|
||||||
|
|
||||||
PL_EXPORT(int)
|
PL_EXPORT(int)
|
||||||
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
|
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type) {
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
AtomEntry *ae;
|
AtomEntry *ae;
|
||||||
|
|
||||||
|
@ -87,15 +82,14 @@ PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(int)
|
PL_EXPORT(int)
|
||||||
PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
|
PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type) {
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
AtomEntry *ae;
|
AtomEntry *ae;
|
||||||
int ret;
|
int ret;
|
||||||
|
|
||||||
if (!blob)
|
if (!blob)
|
||||||
return FALSE;
|
return FALSE;
|
||||||
ae = Yap_lookupBlob(blob, len, type, & ret);
|
ae = Yap_lookupBlob(blob, len, type, &ret);
|
||||||
if (!ae) {
|
if (!ae) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
|
@ -107,8 +101,7 @@ PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(int)
|
PL_EXPORT(int)
|
||||||
PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
|
PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type) {
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Atom a;
|
Atom a;
|
||||||
Term tt;
|
Term tt;
|
||||||
|
@ -129,59 +122,47 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
|
||||||
*len = ae->rep.blob[0].length;
|
*len = ae->rep.blob[0].length;
|
||||||
if (blob)
|
if (blob)
|
||||||
*blob = ae->rep.blob[0].data;
|
*blob = ae->rep.blob[0].data;
|
||||||
return TRUE;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(void*)
|
PL_EXPORT(void *)
|
||||||
PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
|
PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type) {
|
||||||
{
|
|
||||||
Atom x = SWIAtomToAtom(a);
|
Atom x = SWIAtomToAtom(a);
|
||||||
|
|
||||||
if (!IsBlob(x)) {
|
if (!IsBlob(x)) {
|
||||||
if (IsWideAtom(x)) {
|
if (len)
|
||||||
if ( len )
|
*len = strlen_utf8(x->UStrOfAE);
|
||||||
*len = wcslen(x->WStrOfAE);
|
if (type)
|
||||||
if ( type )
|
*type = &unregistered_blob_atom;
|
||||||
*type = &unregistered_blob_atom;
|
return x->StrOfAE;
|
||||||
return x->WStrOfAE;
|
|
||||||
}
|
|
||||||
if ( len )
|
|
||||||
*len = strlen(x->StrOfAE);
|
|
||||||
if ( type )
|
|
||||||
*type = &unregistered_blob_atom;
|
|
||||||
return x->StrOfAE;
|
|
||||||
}
|
}
|
||||||
if ( len )
|
if (len)
|
||||||
*len = x->rep.blob[0].length;
|
*len = x->rep.blob[0].length;
|
||||||
if ( type )
|
if (type)
|
||||||
*type = (struct PL_blob_t *)RepBlobProp(x->PropsOfAE)->blob_type;
|
*type = (struct PL_blob_t *)RepBlobProp(x->PropsOfAE)->blob_type;
|
||||||
|
|
||||||
return x->rep.blob[0].data;
|
return x->rep.blob[0].data;
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(void)
|
PL_EXPORT(void)
|
||||||
PL_register_blob_type(PL_blob_t *type)
|
PL_register_blob_type(PL_blob_t *type) {
|
||||||
{
|
|
||||||
type->next = (PL_blob_t *)BlobTypes;
|
type->next = (PL_blob_t *)BlobTypes;
|
||||||
BlobTypes = (struct YAP_blob_t *)type;
|
BlobTypes = (struct YAP_blob_t *)type;
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(PL_blob_t*)
|
PL_EXPORT(PL_blob_t *)
|
||||||
PL_find_blob_type(const char* name)
|
PL_find_blob_type(const char *name) {
|
||||||
{
|
|
||||||
Atom at = Yap_LookupAtom((char *)name);
|
Atom at = Yap_LookupAtom((char *)name);
|
||||||
|
|
||||||
return YAP_find_blob_type((YAP_Atom)at);
|
return YAP_find_blob_type((YAP_Atom)at);
|
||||||
}
|
}
|
||||||
|
|
||||||
PL_EXPORT(int)
|
PL_EXPORT(int)
|
||||||
PL_unregister_blob_type(PL_blob_t *type)
|
PL_unregister_blob_type(PL_blob_t *type) {
|
||||||
{
|
fprintf(stderr, "PL_unregister_blob_type not implemented yet\n");
|
||||||
fprintf(stderr,"PL_unregister_blob_type not implemented yet\n");
|
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @}
|
* @}
|
||||||
*/
|
*/
|
||||||
|
|
|
@ -213,9 +213,9 @@ X_API int PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) {
|
||||||
out.enc = ENC_ISO_LATIN1;
|
out.enc = ENC_ISO_LATIN1;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (flags & BUF_MALLOC) {
|
if (flags & BUF_MALLOC) {
|
||||||
out.type |= YAP_STRING_MALLOC;
|
out.type |= YAP_STRING_MALLOC;
|
||||||
}
|
}
|
||||||
if (lengthp) {
|
if (lengthp) {
|
||||||
out.type |= YAP_STRING_NCHARS;
|
out.type |= YAP_STRING_NCHARS;
|
||||||
out.max = *lengthp;
|
out.max = *lengthp;
|
||||||
|
@ -238,7 +238,7 @@ int PL_get_wchars(term_t l, size_t *lengthp, wchar_t **s, unsigned flags) {
|
||||||
inp.type = cvtFlags(flags);
|
inp.type = cvtFlags(flags);
|
||||||
out.type = YAP_STRING_WCHARS;
|
out.type = YAP_STRING_WCHARS;
|
||||||
if (flags & BUF_MALLOC) {
|
if (flags & BUF_MALLOC) {
|
||||||
out.type |= YAP_STRING_MALLOC;
|
out.type |= YAP_STRING_MALLOC;
|
||||||
}
|
}
|
||||||
if (lengthp) {
|
if (lengthp) {
|
||||||
out.type |= YAP_STRING_NCHARS;
|
out.type |= YAP_STRING_NCHARS;
|
||||||
|
@ -286,8 +286,6 @@ X_API int PL_unify_chars(term_t l, int flags, size_t length, const char *s) {
|
||||||
X_API char *PL_atom_chars(atom_t a) /* SAM check type */
|
X_API char *PL_atom_chars(atom_t a) /* SAM check type */
|
||||||
{
|
{
|
||||||
Atom at = SWIAtomToAtom(a);
|
Atom at = SWIAtomToAtom(a);
|
||||||
if (IsWideAtom(at))
|
|
||||||
return NULL;
|
|
||||||
return RepAtom(at)->StrOfAE;
|
return RepAtom(at)->StrOfAE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -625,7 +623,7 @@ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */
|
||||||
{
|
{
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Term t = Yap_GetFromSlot(ts);
|
Term t = Yap_GetFromSlot(ts);
|
||||||
if (!IsAtomTerm(t) || IsWideAtom(AtomOfTerm(t)))
|
if (!IsAtomTerm(t))
|
||||||
return 0;
|
return 0;
|
||||||
*a = RepAtom(AtomOfTerm(t))->StrOfAE;
|
*a = RepAtom(AtomOfTerm(t))->StrOfAE;
|
||||||
return 1;
|
return 1;
|
||||||
|
@ -892,9 +890,9 @@ X_API atom_t PL_new_atom(const char *c) {
|
||||||
Atom at;
|
Atom at;
|
||||||
atom_t sat;
|
atom_t sat;
|
||||||
|
|
||||||
while ((at = Yap_CharsToAtom(c, ENC_ISO_LATIN1 PASS_REGS)) == 0L) {
|
while ((at = Yap_LookupAtom(c)) == 0L) {
|
||||||
if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_new_atom"))
|
if (LOCAL_Error_TYPE && !Yap_SWIHandleError("PL_new_atom"))
|
||||||
return FALSE;
|
return false;
|
||||||
}
|
}
|
||||||
Yap_AtomIncreaseHold(at);
|
Yap_AtomIncreaseHold(at);
|
||||||
sat = AtomToSWIAtom(at);
|
sat = AtomToSWIAtom(at);
|
||||||
|
@ -931,10 +929,16 @@ X_API atom_t PL_new_atom_wchars(size_t len, const wchar_t *c) {
|
||||||
|
|
||||||
X_API wchar_t *PL_atom_wchars(atom_t name, size_t *sp) {
|
X_API wchar_t *PL_atom_wchars(atom_t name, size_t *sp) {
|
||||||
Atom at = SWIAtomToAtom(name);
|
Atom at = SWIAtomToAtom(name);
|
||||||
if (!IsWideAtom(at))
|
const unsigned char *s = at->UStrOfAE;
|
||||||
return NULL;
|
size_t sz = *sp = strlen_utf8(s);
|
||||||
*sp = wcslen(RepAtom(at)->WStrOfAE);
|
wchar_t *out = Malloc((sz + 1) * sizeof(wchar_t));
|
||||||
return RepAtom(at)->WStrOfAE;
|
size_t i = 0;
|
||||||
|
for (; i < sz; i++) {
|
||||||
|
int32_t v;
|
||||||
|
s += get_utf8(s, 1, &v);
|
||||||
|
out[i] = v;
|
||||||
|
}
|
||||||
|
return out;
|
||||||
}
|
}
|
||||||
|
|
||||||
X_API functor_t PL_new_functor(atom_t name, int arity) {
|
X_API functor_t PL_new_functor(atom_t name, int arity) {
|
||||||
|
|
|
@ -0,0 +1,43 @@
|
||||||
|
The environment variable LOGTALKHOME should be defined first, pointing
|
||||||
|
to your Logtalk installation directory!
|
||||||
|
Trying the default locations for the Logtalk installation...
|
||||||
|
... using Logtalk installation found at /Users/vsc/share/logtalk
|
||||||
|
|
||||||
|
The environment variable LOGTALKUSER should be defined first, pointing
|
||||||
|
to your Logtalk user directory!
|
||||||
|
Trying the default location for the Logtalk user directory...
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Logtalk 3.6.3-rc9
|
||||||
|
Copyright (c) 1998-2016 Paulo Moura
|
||||||
|
|
||||||
|
% Default lint compilation flags:
|
||||||
|
% unknown_predicates: warning, undefined_predicates: warning
|
||||||
|
% portability: silent, unknown_entities: warning
|
||||||
|
% missing_directives: warning, redefined_built_ins: silent
|
||||||
|
% singleton_variables: warning, underscore_variables: singletons
|
||||||
|
% Default optional features compiler flags:
|
||||||
|
% complements: deny, dynamic_declarations: deny
|
||||||
|
% context_switching_calls: allow, events: deny
|
||||||
|
% Other default compilation flags:
|
||||||
|
% report: on, scratch_directory: ./.lgt_tmp/
|
||||||
|
% source_data: on, code_prefix: $, hook: (none)
|
||||||
|
% optimize: off, debug: off, clean: on, reload: changed
|
||||||
|
% Backend Prolog compiler flags:
|
||||||
|
% prolog_compiler: []
|
||||||
|
% prolog_loader: [silent(true),compilation_mode(compact)]
|
||||||
|
% Read-only compilation flags (backend Prolog compiler features):
|
||||||
|
% prolog_dialect: yap, modules: supported, threads: unsupported
|
||||||
|
% tabling: unsupported, coinduction: supported
|
||||||
|
% unicode: full, encoding_directive: full
|
||||||
|
%
|
||||||
|
% No settings file found in the startup or Logtalk user directories.
|
||||||
|
% Using default flag values set in the backend Prolog compiler adapter file.
|
||||||
|
%
|
||||||
|
% For Logtalk help, use ?- {help(loader)}. or ?- logtalk_load(help(loader)).
|
||||||
|
%
|
||||||
|
***** Logtalk version: 3.6.3-rc9
|
||||||
|
***** Prolog version: 6.3.4
|
||||||
|
% [ /Users/vsc/logtalk/library/tester_versions.lgt loaded ]
|
||||||
|
% (0 warnings)
|
File diff suppressed because it is too large
Load Diff
31
os/charsio.c
31
os/charsio.c
|
@ -87,11 +87,10 @@ static Int flush_all_streams(USES_REGS1);
|
||||||
* @return the char .
|
* @return the char .
|
||||||
*/
|
*/
|
||||||
INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
|
INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
|
||||||
if (IsWideAtom(at)) {
|
int32_t val;
|
||||||
return at->WStrOfAE[0];
|
|
||||||
} else {
|
get_utf8(at->UStrOfAE, 1, &val);
|
||||||
return at->StrOfAE[0];
|
return val;
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
Int Yap_peek(int sno) {
|
Int Yap_peek(int sno) {
|
||||||
|
@ -113,9 +112,9 @@ Int Yap_peek(int sno) {
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
#if !HAVE_FMEMOPEN
|
#if !HAVE_FMEMOPEN
|
||||||
if (s->status & InMemory_Stream_f ) {
|
if (s->status & InMemory_Stream_f) {
|
||||||
return Yap_MemPeekc( sno );
|
return Yap_MemPeekc(sno);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
/* buffer the character */
|
/* buffer the character */
|
||||||
if (s->encoding == Yap_SystemEncoding() && 0) {
|
if (s->encoding == Yap_SystemEncoding() && 0) {
|
||||||
|
@ -1100,7 +1099,7 @@ atom with _C_, while leaving the stream position unaltered.
|
||||||
static Int peek_char(USES_REGS1) {
|
static Int peek_char(USES_REGS1) {
|
||||||
/* the next character is a EOF */
|
/* the next character is a EOF */
|
||||||
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
|
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
|
||||||
wchar_t wsinp[2];
|
unsigned char sinp[10];
|
||||||
Int ch;
|
Int ch;
|
||||||
|
|
||||||
if (sno < 0)
|
if (sno < 0)
|
||||||
|
@ -1115,9 +1114,9 @@ static Int peek_char(USES_REGS1) {
|
||||||
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
|
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
|
||||||
}
|
}
|
||||||
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
||||||
wsinp[1] = '\0';
|
int off = put_utf8(sinp, ch);
|
||||||
wsinp[0] = ch;
|
sinp[off] = '\0';
|
||||||
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
|
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp)));
|
||||||
}
|
}
|
||||||
|
|
||||||
/** @pred peek_char( - _C_) is iso
|
/** @pred peek_char( - _C_) is iso
|
||||||
|
@ -1130,7 +1129,7 @@ atom with _C_, while leaving the stream position unaltered.
|
||||||
static Int peek_char_1(USES_REGS1) {
|
static Int peek_char_1(USES_REGS1) {
|
||||||
/* the next character is a EOF */
|
/* the next character is a EOF */
|
||||||
int sno = LOCAL_c_input_stream;
|
int sno = LOCAL_c_input_stream;
|
||||||
wchar_t wsinp[2];
|
unsigned char sinp[10];
|
||||||
Int ch;
|
Int ch;
|
||||||
|
|
||||||
LOCK(GLOBAL_Stream[sno].streamlock);
|
LOCK(GLOBAL_Stream[sno].streamlock);
|
||||||
|
@ -1140,9 +1139,9 @@ static Int peek_char_1(USES_REGS1) {
|
||||||
// return false;
|
// return false;
|
||||||
}
|
}
|
||||||
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
||||||
wsinp[1] = '\0';
|
int off = put_utf8(sinp, ch);
|
||||||
wsinp[0] = ch;
|
sinp[off] = '\0';
|
||||||
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
|
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp)));
|
||||||
}
|
}
|
||||||
|
|
||||||
/** @pred peek(+ _S_, - _C_) is deprecated
|
/** @pred peek(+ _S_, - _C_) is deprecated
|
||||||
|
|
|
@ -79,7 +79,7 @@ static char SccsId[] = "%W% %G%";
|
||||||
|
|
||||||
static Int p_change_type_of_char(USES_REGS1);
|
static Int p_change_type_of_char(USES_REGS1);
|
||||||
|
|
||||||
Term Yap_StringToNumberTerm(const char *s, encoding_t *encp) {
|
Term Yap_StringToNumberTerm(const char *s, encoding_t *encp) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
int sno;
|
int sno;
|
||||||
Term t;
|
Term t;
|
||||||
|
@ -214,22 +214,15 @@ static int get_char(Term t) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
Atom at = AtomOfTerm(t);
|
Atom at = AtomOfTerm(t);
|
||||||
if (IsWideAtom(at)) {
|
unsigned char *s = RepAtom(at)->UStrOfAE;
|
||||||
wchar_t *s0 = RepAtom(AtomOfTerm(t))->WStrOfAE;
|
utf8proc_int32_t c;
|
||||||
if (s0[1] != '\0') {
|
s += get_utf8(s, 1, &c);
|
||||||
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
return c;
|
||||||
return 0;
|
if (s[0] != '\0') {
|
||||||
}
|
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
||||||
return s0[0];
|
return 0;
|
||||||
} else {
|
|
||||||
char *s0 = RepAtom(AtomOfTerm(t))->StrOfAE;
|
|
||||||
if (s0[1] != '\0') {
|
|
||||||
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
return s0[0];
|
|
||||||
}
|
}
|
||||||
return 0;
|
return c;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int get_code(Term t) {
|
static int get_code(Term t) {
|
||||||
|
@ -263,25 +256,15 @@ static int get_char_or_code(Term t, bool *is_char) {
|
||||||
*is_char = false;
|
*is_char = false;
|
||||||
return ch;
|
return ch;
|
||||||
}
|
}
|
||||||
Atom at = AtomOfTerm(t);
|
unsigned char *s0 = RepAtom(AtomOfTerm(t))->UStrOfAE;
|
||||||
if (IsWideAtom(at)) {
|
int val;
|
||||||
wchar_t *s0 = RepAtom(AtomOfTerm(t))->WStrOfAE;
|
s0 += get_utf8(s0, 1, &val);
|
||||||
if (s0[1] != '\0') {
|
if (s0[0] != '\0') {
|
||||||
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
|
||||||
*is_char = true;
|
|
||||||
return s0[0];
|
|
||||||
} else {
|
|
||||||
char *s0 = RepAtom(AtomOfTerm(t))->StrOfAE;
|
|
||||||
if (s0[1] != '\0') {
|
|
||||||
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
*is_char = true;
|
|
||||||
return s0[0];
|
|
||||||
}
|
}
|
||||||
return 0;
|
*is_char = true;
|
||||||
|
return val;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int toupper2(USES_REGS1) {
|
static Int toupper2(USES_REGS1) {
|
||||||
|
|
89
os/files.c
89
os/files.c
|
@ -456,7 +456,7 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
|
||||||
Atom at;
|
Atom at;
|
||||||
bool rc;
|
bool rc;
|
||||||
|
|
||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)) {
|
||||||
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
|
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
@ -465,19 +465,11 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
|
||||||
rc = Yap_IsAbsolutePath(buf);
|
rc = Yap_IsAbsolutePath(buf);
|
||||||
} else {
|
} else {
|
||||||
at = AtomOfTerm(t);
|
at = AtomOfTerm(t);
|
||||||
if (IsWideAtom(at)) {
|
|
||||||
#if _WIN32
|
#if _WIN32
|
||||||
rc = PathIsRelativeW(RepAtom(at)->WStrOfAE);
|
rc = PathIsRelative(RepAtom(at)->StrOfAE);
|
||||||
#else
|
#else
|
||||||
rc = RepAtom(at)->WStrOfAE[0] == '/';
|
rc = RepAtom(at)->StrOfAE[0] == '/';
|
||||||
#endif
|
#endif
|
||||||
} else {
|
|
||||||
#if _WIN32
|
|
||||||
rc = PathIsRelative(RepAtom(at)->StrOfAE);
|
|
||||||
#else
|
|
||||||
rc = RepAtom(at)->StrOfAE[0] == '/';
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
freeBuffer(buf);
|
freeBuffer(buf);
|
||||||
}
|
}
|
||||||
return rc;
|
return rc;
|
||||||
|
@ -491,31 +483,23 @@ static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
at = AtomOfTerm(t);
|
at = AtomOfTerm(t);
|
||||||
if (IsWideAtom(at)) {
|
const char *c = RepAtom(at)->StrOfAE;
|
||||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
const char *s;
|
||||||
Int i = wcslen(c);
|
|
||||||
while (i && !Yap_dir_separator((int)c[--i]))
|
|
||||||
;
|
|
||||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(c + i)));
|
|
||||||
} else {
|
|
||||||
const char *c = RepAtom(at)->StrOfAE;
|
|
||||||
const char *s;
|
|
||||||
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
|
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
|
||||||
// file_base_name in SWI and GNU
|
// file_base_name in SWI and GNU
|
||||||
char c1[YAP_FILENAME_MAX + 1];
|
char c1[YAP_FILENAME_MAX + 1];
|
||||||
strncpy(c1, c, YAP_FILENAME_MAX);
|
strncpy(c1, c, YAP_FILENAME_MAX);
|
||||||
s = basename(c1);
|
s = basename(c1);
|
||||||
#else
|
#else
|
||||||
Int i = strlen(c);
|
Int i = strlen(c);
|
||||||
while (i && !Yap_dir_separator((int)c[--i]))
|
while (i && !Yap_dir_separator((int)c[--i]))
|
||||||
;
|
;
|
||||||
if (Yap_dir_separator((int)c[i])) {
|
if (Yap_dir_separator((int)c[i])) {
|
||||||
i++;
|
i++;
|
||||||
}
|
|
||||||
s = c + i;
|
|
||||||
#endif
|
|
||||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
|
||||||
}
|
}
|
||||||
|
s = c + i;
|
||||||
|
#endif
|
||||||
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
|
static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
|
||||||
|
@ -526,37 +510,24 @@ static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
at = AtomOfTerm(t);
|
at = AtomOfTerm(t);
|
||||||
if (IsWideAtom(at)) {
|
const char *c = RepAtom(at)->StrOfAE;
|
||||||
wchar_t s[YAP_FILENAME_MAX + 1];
|
|
||||||
wchar_t *c = RepAtom(at)->WStrOfAE;
|
|
||||||
Int i = wcslen(c);
|
|
||||||
while (i && !Yap_dir_separator((int)c[--i]))
|
|
||||||
;
|
|
||||||
if (Yap_dir_separator((int)c[i])) {
|
|
||||||
i++;
|
|
||||||
}
|
|
||||||
wcsncpy(s, c, i);
|
|
||||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(s)));
|
|
||||||
} else {
|
|
||||||
const char *c = RepAtom(at)->StrOfAE;
|
|
||||||
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
|
#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
|
||||||
// file_base_name in SWI and GNU
|
// file_base_name in SWI and GNU
|
||||||
const char *s;
|
const char *s;
|
||||||
char c1[YAP_FILENAME_MAX + 1];
|
char c1[YAP_FILENAME_MAX + 1];
|
||||||
strncpy(c1, c, YAP_FILENAME_MAX);
|
strncpy(c1, c, YAP_FILENAME_MAX);
|
||||||
s = dirname(c1);
|
s = dirname(c1);
|
||||||
#else
|
#else
|
||||||
char s[YAP_FILENAME_MAX + 1];
|
char s[YAP_FILENAME_MAX + 1];
|
||||||
Int i = strlen(c);
|
Int i = strlen(c);
|
||||||
strncpy(s, c, YAP_FILENAME_MAX);
|
strncpy(s, c, YAP_FILENAME_MAX);
|
||||||
while (--i) {
|
while (--i) {
|
||||||
if (Yap_dir_separator((int)c[i]))
|
if (Yap_dir_separator((int)c[i]))
|
||||||
break;
|
break;
|
||||||
}
|
|
||||||
s[i] = '\0';
|
|
||||||
#endif
|
|
||||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
|
||||||
}
|
}
|
||||||
|
s[i] = '\0';
|
||||||
|
#endif
|
||||||
|
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int same_file(USES_REGS1) {
|
static Int same_file(USES_REGS1) {
|
||||||
|
|
|
@ -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();
|
||||||
|
|
|
@ -450,7 +450,10 @@ int Yap_ReadlineForSIGINT(void) {
|
||||||
|
|
||||||
static Int has_readline(USES_REGS1) {
|
static Int has_readline(USES_REGS1) {
|
||||||
#if USE_READLINE
|
#if USE_READLINE
|
||||||
|
if (!Yap_embedded) {
|
||||||
return true;
|
return true;
|
||||||
|
}
|
||||||
|
return false;
|
||||||
#else
|
#else
|
||||||
return false;
|
return false;
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -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 char *syntax_error(TokEntry *errtok, int sno, Term cmod) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Term info;
|
Term info;
|
||||||
Term startline, errline, endline;
|
Term startline, errline, endline;
|
||||||
|
@ -364,7 +364,7 @@ static char * syntax_error(TokEntry *errtok, int sno, Term cmod) {
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
char * Yap_syntax_error(TokEntry *errtok, int sno) {
|
char *Yap_syntax_error(TokEntry *errtok, int sno) {
|
||||||
return syntax_error(errtok, sno, CurrentModule);
|
return syntax_error(errtok, sno, CurrentModule);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -870,14 +870,14 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||||
return YAP_PARSING_FINISHED;
|
return YAP_PARSING_FINISHED;
|
||||||
} else {
|
} else {
|
||||||
const char*s = syntax_error(fe->toklast, inp_stream, fe->cmod);
|
char *s = syntax_error(fe->toklast, inp_stream, fe->cmod);
|
||||||
if (ParserErrorStyle == TermError) {
|
if (ParserErrorStyle == TermError) {
|
||||||
LOCAL_ErrorMessage = s;
|
LOCAL_ErrorMessage = s;
|
||||||
LOCAL_Error_TYPE = SYNTAX_ERROR;
|
LOCAL_Error_TYPE = SYNTAX_ERROR;
|
||||||
return YAP_PARSING_FINISHED;
|
return YAP_PARSING_FINISHED;
|
||||||
// dec-10
|
// dec-10
|
||||||
} else if (Yap_PrintWarning(MkStringTerm(s))) {
|
} else if (Yap_PrintWarning(MkStringTerm(s))) {
|
||||||
free(s);
|
free(s);
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||||
return YAP_SCANNING;
|
return YAP_SCANNING;
|
||||||
}
|
}
|
||||||
|
@ -923,13 +923,16 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
|
||||||
int emacs_cares = FALSE;
|
int emacs_cares = FALSE;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
int lvl = push_text_stack();
|
||||||
parser_state_t state = YAP_START_PARSING;
|
parser_state_t state = YAP_START_PARSING;
|
||||||
while (true) {
|
while (true) {
|
||||||
switch (state) {
|
switch (state) {
|
||||||
case YAP_START_PARSING:
|
case YAP_START_PARSING:
|
||||||
state = initParser(opts, &fe, &re, inp_stream, nargs);
|
state = initParser(opts, &fe, &re, inp_stream, nargs);
|
||||||
if (state == YAP_PARSING_FINISHED)
|
if (state == YAP_PARSING_FINISHED) {
|
||||||
|
pop_text_stack(lvl);
|
||||||
return 0;
|
return 0;
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
case YAP_SCANNING:
|
case YAP_SCANNING:
|
||||||
state = scan(&re, &fe, inp_stream);
|
state = scan(&re, &fe, inp_stream);
|
||||||
|
@ -961,10 +964,12 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
|
||||||
#if EMACS
|
#if EMACS
|
||||||
first_char = tokstart->TokPos;
|
first_char = tokstart->TokPos;
|
||||||
#endif /* EMACS */
|
#endif /* EMACS */
|
||||||
|
pop_text_stack(lvl);
|
||||||
return fe.t;
|
return fe.t;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
pop_text_stack(lvl);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1339,17 +1344,10 @@ static Int read_term_from_atom(USES_REGS1) {
|
||||||
Term Yap_AtomToTerm(Atom a, Term opts) {
|
Term Yap_AtomToTerm(Atom a, Term opts) {
|
||||||
Term rval;
|
Term rval;
|
||||||
int sno;
|
int sno;
|
||||||
if (IsWideAtom(a)) {
|
char *s = a->StrOfAE;
|
||||||
wchar_t *ws = a->WStrOfAE;
|
size_t len = strlen(s);
|
||||||
size_t len = wcslen(ws);
|
encoding_t enc = ENC_ISO_UTF8;
|
||||||
encoding_t enc = ENC_ISO_ANSI;
|
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
|
||||||
sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER);
|
|
||||||
} else {
|
|
||||||
char *s = a->StrOfAE;
|
|
||||||
size_t len = strlen(s);
|
|
||||||
encoding_t enc = ENC_ISO_LATIN1;
|
|
||||||
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
|
|
||||||
}
|
|
||||||
|
|
||||||
rval = Yap_read_term(sno, opts, 3);
|
rval = Yap_read_term(sno, opts, 3);
|
||||||
Yap_CloseStream(sno);
|
Yap_CloseStream(sno);
|
||||||
|
|
3
os/sig.c
3
os/sig.c
|
@ -816,6 +816,9 @@ yap_error_number Yap_MathException__(USES_REGS1) {
|
||||||
|
|
||||||
/* SIGINT can cause problems, if caught before full initialization */
|
/* SIGINT can cause problems, if caught before full initialization */
|
||||||
void Yap_InitOSSignals(int wid) {
|
void Yap_InitOSSignals(int wid) {
|
||||||
|
if (Yap_embedded) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
if (GLOBAL_PrologShouldHandleInterrupts) {
|
if (GLOBAL_PrologShouldHandleInterrupts) {
|
||||||
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
|
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
|
||||||
my_signal(SIGQUIT, ReceiveSignal);
|
my_signal(SIGQUIT, ReceiveSignal);
|
||||||
|
|
|
@ -1790,15 +1790,13 @@ static Int p_log_event(USES_REGS1) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
at = AtomOfTerm(in);
|
at = AtomOfTerm(in);
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
if (IsWideAtom(at))
|
if (IsBlob(at))
|
||||||
fprintf(stderr, "LOG %S\n", RepAtom(at)->WStrOfAE);
|
|
||||||
else if (IsBlob(at))
|
|
||||||
return FALSE;
|
return FALSE;
|
||||||
else
|
else
|
||||||
fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE);
|
fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE);
|
||||||
#endif
|
#endif
|
||||||
if (IsWideAtom(at) || IsBlob(at))
|
if (IsBlob(at))
|
||||||
return FALSE;
|
return false;
|
||||||
LOG(" %s ", RepAtom(at)->StrOfAE);
|
LOG(" %s ", RepAtom(at)->StrOfAE);
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
|
@ -137,12 +137,12 @@ INLINE_ONLY inline EXTERN Term MkCharTerm(Int c);
|
||||||
* @return the term.
|
* @return the term.
|
||||||
*/
|
*/
|
||||||
INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
|
INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
|
||||||
wchar_t cs[2];
|
unsigned char cs[10];
|
||||||
if (c < 0)
|
if (c < 0)
|
||||||
return TermEof;
|
return TermEof;
|
||||||
cs[0] = c;
|
size_t n = put_utf8( cs, c );
|
||||||
cs[1] = '\0';
|
cs[n] = '\0';
|
||||||
return MkAtomTerm(Yap_LookupMaybeWideAtom(cs));
|
return MkAtomTerm(Yap_ULookupAtom(cs));
|
||||||
}
|
}
|
||||||
|
|
||||||
/// UT when yap started
|
/// UT when yap started
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Fold; CLL; AUCROC; AUCPR
|
|
Binary file not shown.
|
@ -0,0 +1,21 @@
|
||||||
|
|
||||||
|
:- use_module( library(python) ).
|
||||||
|
|
||||||
|
:- := import( collections ).
|
||||||
|
:- := import( yap ).
|
||||||
|
:- e := yap.'YAPEngine'().
|
||||||
|
|
||||||
|
main :-
|
||||||
|
system_predicate(N/A),
|
||||||
|
args(0,A,L),
|
||||||
|
N := namedtuple( N, L),
|
||||||
|
fail.
|
||||||
|
main :-
|
||||||
|
:= e.call( writeln( 1 ) ).
|
||||||
|
|
||||||
|
args(N, N, []) :- !.
|
||||||
|
args(I0,IF,[AI|Ais]) :-
|
||||||
|
I is I0+1,
|
||||||
|
number_string(I, IS),
|
||||||
|
string_concat("A", IS, AI),
|
||||||
|
args(I, IF, Ais).
|
|
@ -0,0 +1,48 @@
|
||||||
|
import base64
|
||||||
|
import imghdr
|
||||||
|
import os
|
||||||
|
|
||||||
|
#from IPython.
|
||||||
|
|
||||||
|
_TEXT_SAVED_IMAGE = "yap_kernel: saved image data to:"
|
||||||
|
|
||||||
|
image_setup_cmd = """
|
||||||
|
display () {
|
||||||
|
TMPFILE=$(mktemp ${TMPDIR-/tmp}/yap_kernel.XXXXXXXXXX)
|
||||||
|
cat > $TMPFILE
|
||||||
|
echo "%s $TMPFILE" >&2
|
||||||
|
}
|
||||||
|
""" % _TEXT_SAVED_IMAGE
|
||||||
|
|
||||||
|
def display_data_for_image(filename):
|
||||||
|
with open(filename, 'rb') as f:
|
||||||
|
image = f.read()
|
||||||
|
os.unlink(filename)
|
||||||
|
|
||||||
|
image_type = imghdr.what(None, image)
|
||||||
|
if image_type is None:
|
||||||
|
raise ValueError("Not a valid image: %s" % image)
|
||||||
|
|
||||||
|
image_data = base64.b64encode(image).decode('ascii')
|
||||||
|
content = {
|
||||||
|
'data': {
|
||||||
|
'image/' + image_type: image_data
|
||||||
|
},
|
||||||
|
'metadata': {}
|
||||||
|
}
|
||||||
|
return content
|
||||||
|
|
||||||
|
|
||||||
|
def extract_image_filenames(output):
|
||||||
|
output_lines = []
|
||||||
|
image_filenames = []
|
||||||
|
|
||||||
|
for line in output.split("\n"):
|
||||||
|
if line.startswith(_TEXT_SAVED_IMAGE):
|
||||||
|
filename = line.rstrip().split(": ")[-1]
|
||||||
|
image_filenames.append(filename)
|
||||||
|
else:
|
||||||
|
output_lines.append(line)
|
||||||
|
|
||||||
|
output = "\n".join(output_lines)
|
||||||
|
return image_filenames, output
|
|
@ -0,0 +1,92 @@
|
||||||
|
from __future__ import print_function
|
||||||
|
|
||||||
|
from metakernel import MetaKernel
|
||||||
|
|
||||||
|
from metakernel import register_ipython_magics
|
||||||
|
register_ipython_magics()
|
||||||
|
|
||||||
|
class MetaKernelyap(MetaKernel):
|
||||||
|
implementation = 'MetaKernel YAP'
|
||||||
|
implementation_version = '1.0'
|
||||||
|
language = 'text'
|
||||||
|
language_version = '0.1'
|
||||||
|
banner = "MetaKernel YAP"
|
||||||
|
language_info = {
|
||||||
|
'mimetype': 'text/plain',
|
||||||
|
'name': 'text',
|
||||||
|
# ------ If different from 'language':
|
||||||
|
'codemirror_mode': {
|
||||||
|
"version": 2,
|
||||||
|
"name": "prolog"
|
||||||
|
}
|
||||||
|
'pygments_lexer': 'language',
|
||||||
|
'version' : "0.0.1",
|
||||||
|
'file_extension': '.yap',
|
||||||
|
'help_links': MetaKernel.help_links,
|
||||||
|
}
|
||||||
|
|
||||||
|
def __init__(self, **kwargs):
|
||||||
|
|
||||||
|
MetaKernel.__init__(self, **kwargs)
|
||||||
|
self._start_yap()
|
||||||
|
self.qq = None sq
|
||||||
|
|
||||||
|
def _start_yap(self):
|
||||||
|
# Signal handlers are inherited by forked processes, and we can't easily
|
||||||
|
# reset it from the subprocess. Since kernelapp ignores SIGINT except in
|
||||||
|
# message handlers, we need to temporarily reset the SIGINT handler here
|
||||||
|
# so that yap and its children are interruptible.
|
||||||
|
sig = signal.signal(signal.SIGINT, signal.SIG_DFL)
|
||||||
|
try:
|
||||||
|
engine = yap.YAPEngine()
|
||||||
|
engine.query("load_files(library(python), [])").command()
|
||||||
|
banner = "YAP {0} Kernel".format(self.engine.version())
|
||||||
|
|
||||||
|
finally:
|
||||||
|
signal.signal(signal.SIGINT, sig)
|
||||||
|
|
||||||
|
# Register Yap function to write image data to temporary file
|
||||||
|
#self.yapwrapper.run_command(image_setup_cmd)
|
||||||
|
|
||||||
|
def get_usage(self):
|
||||||
|
return "This is the YAP kernel."
|
||||||
|
|
||||||
|
def do_execute_direct(self, code):
|
||||||
|
if not code.strip():
|
||||||
|
return {'status': 'ok', 'execution_count': self.execution_count,
|
||||||
|
'payload': [], 'user_expressions': {}}
|
||||||
|
|
||||||
|
interrupted = False
|
||||||
|
try:
|
||||||
|
print self.q
|
||||||
|
if self.q is None:
|
||||||
|
self.q = self.engine.query(code.rstrip())
|
||||||
|
if self.q.next():
|
||||||
|
vs = self.q.namedVars()
|
||||||
|
if vs.length() > 0:
|
||||||
|
l = []
|
||||||
|
while vs.length() > 0:
|
||||||
|
eq = vs.car()
|
||||||
|
l.append(' '.join([getArg(1).text(), '=', eq.getArg(2).text())
|
||||||
|
vs = vs.cdr()
|
||||||
|
l.append(';')
|
||||||
|
o = '\n'.join(l)
|
||||||
|
else:
|
||||||
|
return 'yes'
|
||||||
|
self.q = None
|
||||||
|
|
||||||
|
else:
|
||||||
|
return 'no'
|
||||||
|
self.q = None
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
def repr(self, data):
|
||||||
|
return repr(data)
|
||||||
|
|
||||||
|
if __name__ == '__main__':
|
||||||
|
try:
|
||||||
|
from ipykernel.kernelapp import IPKernelApp
|
||||||
|
except ImportError:
|
||||||
|
from IPython.kernel.zmq.kernelapp import IPKernelApp
|
||||||
|
IPKernelApp.launch_instance(kernel_class=MetaKernelyap)
|
|
@ -0,0 +1,61 @@
|
||||||
|
%matplotlib inline
|
||||||
|
import numpy as np
|
||||||
|
import seaborn as sns
|
||||||
|
import matplotlib.pyplot as plt
|
||||||
|
sns.set(style="white", context="talk")
|
||||||
|
rs = np.random.RandomState(7)
|
||||||
|
|
||||||
|
pos={0:(0,0),
|
||||||
|
1:(1,0),
|
||||||
|
2:(0,1),
|
||||||
|
3:(1,1),
|
||||||
|
4:(0.1,0.9),
|
||||||
|
5:(0.3,1.1),
|
||||||
|
6:(0.9,0.9)
|
||||||
|
}
|
||||||
|
|
||||||
|
names={4:'MMM',
|
||||||
|
5:'XXX',
|
||||||
|
6:'ZZZ'}
|
||||||
|
|
||||||
|
def plot1(y10,y20):
|
||||||
|
def gen(f,f0):
|
||||||
|
return [f[0],f[1],-f[2]]/max(f,f0)
|
||||||
|
ax1 = plt.subplot2grid((1,2), (0,0), colspan=2)
|
||||||
|
ax2 = plt.subplot2grid((1,2), (0,1), colspan=2)
|
||||||
|
ax3 = plt.subplot2grid((2,2), (2,0), colspan=2, rowspan=2)
|
||||||
|
|
||||||
|
xs = ["+-","++","--"]
|
||||||
|
y1 = gen(y10, y20)
|
||||||
|
sns.barplot(xs, y1, palette="RdBu_r", ax=ax1)
|
||||||
|
y2 = gen(y20,y10)
|
||||||
|
sns.barplot(xs, y2, palette="Set3", ax=ax2)
|
||||||
|
# Finalize the plot
|
||||||
|
# sns.despine(bottom=True)
|
||||||
|
|
||||||
|
|
||||||
|
G=nx.Graph()
|
||||||
|
i=0
|
||||||
|
G.pos={} # location
|
||||||
|
G.pop={} # size
|
||||||
|
lpos={0:(0,0),1:(0,0),2:(0,0),3:(0,0)}
|
||||||
|
last=len(pos)-1
|
||||||
|
for i in range(4,len(pos)):
|
||||||
|
G.pos[i]=pos[i]
|
||||||
|
G.pop[i]=2000
|
||||||
|
(x,y) = pos[i]
|
||||||
|
lpos[i] = (x,y-0.05)
|
||||||
|
if i > 4:
|
||||||
|
G.add_edge(i-1,i)
|
||||||
|
else:
|
||||||
|
G.add_edge(2,i)
|
||||||
|
G.add_edge(3,last)
|
||||||
|
nx.draw_networkx_nodes(G,pos,nodelist=range(4,len(pos)),ax=ax3)
|
||||||
|
nx.draw_networkx_nodes(G,pos,nodelist=[0,1,2,3],node_color='b',ax=ax3)
|
||||||
|
nx.draw_networkx_edges(G,pos,alpha=0.5,ax=ax3)
|
||||||
|
nx.draw_networkx_labels(G,lpos,names,alpha=0.5,ax=ax3)
|
||||||
|
plt.axis('off')
|
||||||
|
plt.tight_layout(h_pad=3)
|
||||||
|
plt.savefig("house_with_colors.png") # save as png
|
||||||
|
|
||||||
|
plot1([20,30,10],[30,30,5])
|
File diff suppressed because it is too large
Load Diff
|
@ -185,9 +185,9 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
|
||||||
Py_ssize_t i, sz = PyTuple_Size(pVal);
|
Py_ssize_t i, sz = PyTuple_Size(pVal);
|
||||||
functor_t f;
|
functor_t f;
|
||||||
const char *s;
|
const char *s;
|
||||||
if ((s = (Py_TYPE(pVal)->tp_name)))
|
if ((s = (Py_TYPE(pVal)->tp_name))) {
|
||||||
f = PL_new_functor(PL_new_atom(s), sz);
|
f = PL_new_functor(PL_new_atom(s), sz);
|
||||||
else
|
} else
|
||||||
f = PL_new_functor(ATOM_t, sz);
|
f = PL_new_functor(ATOM_t, sz);
|
||||||
if (!PL_unify_functor(t, f))
|
if (!PL_unify_functor(t, f))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
|
|
|
@ -28,7 +28,7 @@ static foreign_t python_f(term_t tmod, term_t fname, term_t tf) {
|
||||||
char *s;
|
char *s;
|
||||||
size_t len;
|
size_t len;
|
||||||
PyObject *pF, *pModule;
|
PyObject *pF, *pModule;
|
||||||
|
|
||||||
/* if an atom, fetch again */
|
/* if an atom, fetch again */
|
||||||
if (PL_is_atom(tmod)) {
|
if (PL_is_atom(tmod)) {
|
||||||
PyObject *pName;
|
PyObject *pName;
|
||||||
|
@ -42,40 +42,59 @@ static foreign_t python_f(term_t tmod, term_t fname, term_t tf) {
|
||||||
pName = PyUnicode_FromString(s);
|
pName = PyUnicode_FromString(s);
|
||||||
#endif
|
#endif
|
||||||
if (pName == NULL) {
|
if (pName == NULL) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pModule = PyImport_Import(pName);
|
pModule = PyImport_Import(pName);
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
} else if (!(pModule = term_to_python(tmod, true))) {
|
} else if (!(pModule = term_to_python(tmod, true))) {
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pF = PyObject_GetAttrString(pModule, s);
|
pF = PyObject_GetAttrString(pModule, s);
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
Py_DECREF(pModule);
|
Py_DECREF(pModule);
|
||||||
if (pF == NULL || !PyCallable_Check(pF)) {
|
if (pF == NULL || !PyCallable_Check(pF)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
foreign_t rc = python_to_ptr(pF, tf);
|
||||||
|
return rc;
|
||||||
}
|
}
|
||||||
return python_to_ptr(pF, tf);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_o(term_t tmod, term_t fname, term_t tf) {
|
static foreign_t python_o(term_t tmod, term_t fname, term_t tf) {
|
||||||
char *s;
|
char *s;
|
||||||
size_t len;
|
size_t len;
|
||||||
PyObject *pO, *pModule;
|
PyObject *pO, *pModule;
|
||||||
|
|
||||||
pModule = term_to_python(tmod, true);
|
pModule = term_to_python(tmod, true);
|
||||||
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pO = PyObject_GetAttrString(pModule, s);
|
pO = PyObject_GetAttrString(pModule, s);
|
||||||
if (pO == NULL) {
|
if (pO == NULL) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
foreign_t rc = python_to_ptr(pO, tf);
|
||||||
|
;
|
||||||
|
return rc;
|
||||||
}
|
}
|
||||||
return python_to_ptr(pO, tf);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_len(term_t tobj, term_t tf) {
|
static foreign_t python_len(term_t tobj, term_t tf) {
|
||||||
|
@ -83,8 +102,9 @@ static foreign_t python_len(term_t tobj, term_t tf) {
|
||||||
PyObject *o;
|
PyObject *o;
|
||||||
|
|
||||||
o = term_to_python(tobj, true);
|
o = term_to_python(tobj, true);
|
||||||
if (o == NULL)
|
if (o == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
len = PyObject_Length(o);
|
len = PyObject_Length(o);
|
||||||
return PL_unify_int64(tf, len);
|
return PL_unify_int64(tf, len);
|
||||||
}
|
}
|
||||||
|
@ -94,40 +114,54 @@ static foreign_t python_dir(term_t tobj, term_t tf) {
|
||||||
PyObject *o;
|
PyObject *o;
|
||||||
|
|
||||||
o = term_to_python(tobj, true);
|
o = term_to_python(tobj, true);
|
||||||
if (o == NULL)
|
if (o == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
dir = PyObject_Dir(o);
|
dir = PyObject_Dir(o);
|
||||||
return python_to_ptr(dir, tf);
|
{
|
||||||
|
foreign_t rc = python_to_ptr(dir, tf);
|
||||||
|
;
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_index(term_t tobj, term_t tindex, term_t val) {
|
static foreign_t python_index(term_t tobj, term_t tindex, term_t val) {
|
||||||
PyObject *i;
|
PyObject *i;
|
||||||
PyObject *o;
|
PyObject *o;
|
||||||
PyObject *f;
|
PyObject *f;
|
||||||
|
|
||||||
o = term_to_python(tobj, true);
|
o = term_to_python(tobj, true);
|
||||||
if (o == NULL)
|
if (o == NULL) {
|
||||||
return false;
|
|
||||||
if (!PySequence_Check(o))
|
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
|
if (!PySequence_Check(o)) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
i = term_to_python(tindex, true);
|
i = term_to_python(tindex, true);
|
||||||
if (i == NULL)
|
if (i == NULL) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
#if PY_MAJOR_VERSION < 3
|
#if PY_MAJOR_VERSION < 3
|
||||||
f = PyObject_CallMethodObjArgs(o, PyString_FromString("getitem"), i);
|
f = PyObject_CallMethodObjArgs(o, PyString_FromString("getitem"), i);
|
||||||
#else
|
#else
|
||||||
f = PyObject_CallMethodObjArgs(o, PyUnicode_FromString("getitem"), i);
|
f = PyObject_CallMethodObjArgs(o, PyUnicode_FromString("getitem"), i);
|
||||||
#endif
|
#endif
|
||||||
return python_to_ptr(f, val);
|
{
|
||||||
|
foreign_t rc = python_to_ptr(f, val);
|
||||||
|
;
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_is(term_t tobj, term_t tf) {
|
static foreign_t python_is(term_t tobj, term_t tf) {
|
||||||
PyObject *o;
|
PyObject *o;
|
||||||
|
|
||||||
o = term_to_python(tobj, true);
|
o = term_to_python(tobj, true);
|
||||||
if (!o)
|
if (!o) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
return python_to_ptr(o, tf);
|
foreign_t rc = python_to_ptr(o, tf);
|
||||||
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_assign_item(term_t parent, term_t indx, term_t tobj) {
|
static foreign_t python_assign_item(term_t parent, term_t indx, term_t tobj) {
|
||||||
|
@ -145,23 +179,31 @@ static foreign_t python_assign_item(term_t parent, term_t indx, term_t tobj) {
|
||||||
pF = term_to_python(parent, true);
|
pF = term_to_python(parent, true);
|
||||||
// Exp
|
// Exp
|
||||||
if (!pI || !p) {
|
if (!pI || !p) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
} else if (PyObject_SetItem(p, pI, pF)) {
|
} else if (PyObject_SetItem(p, pI, pF)) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
Py_DecRef(pI);
|
Py_DecRef(pI);
|
||||||
Py_DecRef(p);
|
Py_DecRef(p);
|
||||||
|
|
||||||
return true;
|
{
|
||||||
|
return true;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/** assign a tuple to something:
|
/** assign a tuple to something:
|
||||||
*/
|
*/
|
||||||
static foreign_t python_assign_tuple(term_t t_lhs, term_t t_rhs) {
|
static foreign_t python_assign_tuple(term_t t_lhs, term_t t_rhs) {
|
||||||
PyObject *e = term_to_python(t_rhs, true);
|
PyObject *e;
|
||||||
Py_ssize_t sz;
|
Py_ssize_t sz;
|
||||||
functor_t f;
|
functor_t f;
|
||||||
|
|
||||||
|
e = term_to_python(t_rhs, true);
|
||||||
if (!e || !PyTuple_Check(e)) {
|
if (!e || !PyTuple_Check(e)) {
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
@ -224,12 +266,18 @@ static foreign_t python_item(term_t parent, term_t indx, term_t tobj) {
|
||||||
return false;
|
return false;
|
||||||
} else if ((pF = PyObject_GetItem(p, pI)) == NULL) {
|
} else if ((pF = PyObject_GetItem(p, pI)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
Py_DecRef(pI);
|
Py_DecRef(pI);
|
||||||
Py_DecRef(p);
|
Py_DecRef(p);
|
||||||
|
|
||||||
return address_to_term(pF, tobj);
|
{
|
||||||
|
foreign_t rc;
|
||||||
|
rc = address_to_term(pF, tobj);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
|
static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
|
||||||
|
@ -244,15 +292,23 @@ static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
|
||||||
p = term_to_python(parent, true);
|
p = term_to_python(parent, true);
|
||||||
// Exp
|
// Exp
|
||||||
if (!pI || !p) {
|
if (!pI || !p) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
} else if ((pF = PySequence_GetSlice(p, 0, 0)) == NULL) {
|
} else if ((pF = PySequence_GetSlice(p, 0, 0)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
Py_DecRef(pI);
|
Py_DecRef(pI);
|
||||||
Py_DecRef(p);
|
Py_DecRef(p);
|
||||||
|
|
||||||
return address_to_term(pF, tobj);
|
{
|
||||||
|
foreign_t rc;
|
||||||
|
rc = address_to_term(pF, tobj);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
||||||
|
@ -268,14 +324,18 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
||||||
pF = term_to_python(tin, true);
|
pF = term_to_python(tin, true);
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
if (pF == NULL) {
|
if (pF == NULL) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (PL_is_atom(targs)) {
|
if (PL_is_atom(targs)) {
|
||||||
pArgs = NULL;
|
pArgs = NULL;
|
||||||
} else {
|
} else {
|
||||||
|
|
||||||
if (!PL_get_name_arity(targs, &aname, &arity)) {
|
if (!PL_get_name_arity(targs, &aname, &arity)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (arity == 1 && PL_get_arg(1, targs, targ) && PL_is_variable(targ)) {
|
if (arity == 1 && PL_get_arg(1, targs, targ) && PL_is_variable(targ)) {
|
||||||
/* ignore (_) */
|
/* ignore (_) */
|
||||||
|
@ -283,15 +343,18 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
||||||
} else {
|
} else {
|
||||||
|
|
||||||
pArgs = PyTuple_New(arity);
|
pArgs = PyTuple_New(arity);
|
||||||
if (!pArgs)
|
if (!pArgs) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
for (i = 0; i < arity; i++) {
|
for (i = 0; i < arity; i++) {
|
||||||
PyObject *pArg;
|
PyObject *pArg;
|
||||||
if (!PL_get_arg(i + 1, targs, targ))
|
if (!PL_get_arg(i + 1, targs, targ)) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
pArg = term_to_python(targ, true);
|
pArg = term_to_python(targ, true);
|
||||||
if (pArg == NULL)
|
if (pArg == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
/* pArg reference stolen here: */
|
/* pArg reference stolen here: */
|
||||||
PyTuple_SetItem(pArgs, i, pArg);
|
PyTuple_SetItem(pArgs, i, pArg);
|
||||||
}
|
}
|
||||||
|
@ -319,13 +382,16 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (pArgs)
|
if (pArgs)
|
||||||
Py_DECREF(pArgs);
|
Py_DECREF(pArgs);
|
||||||
Py_DECREF(pF);
|
Py_DECREF(pF);
|
||||||
if (pValue == NULL)
|
if (pValue == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
out = python_to_ptr(pValue, tf);
|
out = python_to_ptr(pValue, tf);
|
||||||
return out;
|
return out;
|
||||||
}
|
}
|
||||||
|
@ -333,21 +399,23 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
|
||||||
static foreign_t python_assign(term_t name, term_t exp) {
|
static foreign_t python_assign(term_t name, term_t exp) {
|
||||||
PyObject *e = term_to_python(exp, true);
|
PyObject *e = term_to_python(exp, true);
|
||||||
|
|
||||||
if (e == NULL)
|
if (e == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
return assign_python(py_Main, name, e) >= 0;
|
return assign_python(py_Main, name, e) >= 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_assign_field(term_t source, term_t name, term_t exp) {
|
static foreign_t python_assign_field(term_t source, term_t name, term_t exp) {
|
||||||
PyObject *e = term_to_python(exp, true), *root = term_to_python(source, true);
|
PyObject *e = term_to_python(exp, true), *root = term_to_python(source, true);
|
||||||
|
|
||||||
if (e == NULL)
|
if (e == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
return assign_python(root, name, e) >= 0;
|
return assign_python(root, name, e) >= 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
|
static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
|
||||||
PyObject *pI, *pArgs, *pOut;
|
PyObject *pI, *pArgs, *pOut;
|
||||||
PyObject *env;
|
PyObject *env;
|
||||||
atom_t name;
|
atom_t name;
|
||||||
char *s;
|
char *s;
|
||||||
|
@ -356,36 +424,47 @@ static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
|
||||||
|
|
||||||
if ((env = py_Builtin) == NULL) {
|
if ((env = py_Builtin) == NULL) {
|
||||||
// no point in even trying
|
// no point in even trying
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (PL_get_name_arity(caller, &name, &arity)) {
|
if (PL_get_name_arity(caller, &name, &arity)) {
|
||||||
if (!(s = PL_atom_chars(name)))
|
if (!(s = PL_atom_chars(name))) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
if ((pI = PyObject_GetAttrString(env, s)) == NULL) {
|
if ((pI = PyObject_GetAttrString(env, s)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
// Prolog should make sure this never happens.
|
// Prolog should make sure this never happens.
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pArgs = PyTuple_New(arity);
|
pArgs = PyTuple_New(arity);
|
||||||
for (i = 0; i < arity; i++) {
|
for (i = 0; i < arity; i++) {
|
||||||
PyObject *pArg;
|
PyObject *pArg;
|
||||||
if (!PL_get_arg(i + 1, caller, targ))
|
if (!PL_get_arg(i + 1, caller, targ)) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
/* ignore (_) */
|
/* ignore (_) */
|
||||||
if (i == 0 && PL_is_variable(targ)) {
|
if (i == 0 && PL_is_variable(targ)) {
|
||||||
pArg = Py_None;
|
pArg = Py_None;
|
||||||
} else {
|
} else {
|
||||||
pArg = term_to_python(targ, true);
|
pArg = term_to_python(targ, true);
|
||||||
if (pArg == NULL)
|
if (pArg == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
/* pArg reference stolen here: */
|
/* pArg reference stolen here: */
|
||||||
if (PyTuple_SetItem(pArgs, i, pArg)) {
|
if (PyTuple_SetItem(pArgs, i, pArg)) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
pOut = PyObject_CallObject(pI, pArgs);
|
pOut = PyObject_CallObject(pI, pArgs);
|
||||||
|
@ -393,9 +472,15 @@ static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
|
||||||
Py_DECREF(pI);
|
Py_DECREF(pI);
|
||||||
if (pOut == NULL) {
|
if (pOut == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
foreign_t rc = python_to_ptr(pOut, out);
|
||||||
|
;
|
||||||
|
return rc;
|
||||||
}
|
}
|
||||||
return python_to_ptr(pOut, out);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_access(term_t obj, term_t f, term_t out) {
|
static foreign_t python_access(term_t obj, term_t f, term_t out) {
|
||||||
|
@ -405,57 +490,76 @@ static foreign_t python_access(term_t obj, term_t f, term_t out) {
|
||||||
int i, arity;
|
int i, arity;
|
||||||
term_t targ = PL_new_term_ref();
|
term_t targ = PL_new_term_ref();
|
||||||
|
|
||||||
if (o == NULL)
|
if (o == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
if (PL_is_atom(f)) {
|
if (PL_is_atom(f)) {
|
||||||
if (!PL_get_atom_chars(f, &s))
|
if (!PL_get_atom_chars(f, &s)) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
if ((pValue = PyObject_GetAttrString(o, s)) == NULL) {
|
if ((pValue = PyObject_GetAttrString(o, s)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
return python_to_term(pValue, out);
|
||||||
}
|
}
|
||||||
return python_to_term(pValue, out);
|
|
||||||
}
|
}
|
||||||
if (!PL_get_name_arity(f, &name, &arity)) {
|
if (!PL_get_name_arity(f, &name, &arity)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
/* follow chains of the form a.b.c.d.e() */
|
/* follow chains of the form a.b.c.d.e() */
|
||||||
while (name == ATOM_dot && arity == 2) {
|
while (name == ATOM_dot && arity == 2) {
|
||||||
term_t tleft = PL_new_term_ref();
|
term_t tleft = PL_new_term_ref();
|
||||||
PyObject *lhs;
|
PyObject *lhs;
|
||||||
|
|
||||||
if (!PL_get_arg(1, f, tleft))
|
if (!PL_get_arg(1, f, tleft)) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
lhs = term_to_python(tleft, true);
|
lhs = term_to_python(tleft, true);
|
||||||
if ((o = PyObject_GetAttr(o, lhs)) == NULL) {
|
if ((o = PyObject_GetAttr(o, lhs)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!PL_get_arg(2, f, f)) {
|
||||||
|
return false;
|
||||||
}
|
}
|
||||||
if (!PL_get_arg(2, f, f))
|
|
||||||
return FALSE;
|
|
||||||
if (!PL_get_name_arity(f, &name, &arity)) {
|
if (!PL_get_name_arity(f, &name, &arity)) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
s = PL_atom_chars(name);
|
s = PL_atom_chars(name);
|
||||||
if (!s)
|
if (!s) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
if ((pF = PyObject_GetAttrString(o, s)) == NULL) {
|
if ((pF = PyObject_GetAttrString(o, s)) == NULL) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pArgs = PyTuple_New(arity);
|
pArgs = PyTuple_New(arity);
|
||||||
for (i = 0; i < arity; i++) {
|
for (i = 0; i < arity; i++) {
|
||||||
PyObject *pArg;
|
PyObject *pArg;
|
||||||
if (!PL_get_arg(i + 1, f, targ))
|
if (!PL_get_arg(i + 1, f, targ)) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
/* ignore (_) */
|
/* ignore (_) */
|
||||||
if (i == 0 && PL_is_variable(targ)) {
|
if (i == 0 && PL_is_variable(targ)) {
|
||||||
pArgs = Py_None;
|
pArgs = Py_None;
|
||||||
}
|
}
|
||||||
pArg = term_to_python(targ, true);
|
pArg = term_to_python(targ, true);
|
||||||
if (pArg == NULL)
|
if (pArg == NULL) {
|
||||||
return FALSE;
|
return false;
|
||||||
|
}
|
||||||
/* pArg reference stolen here: */
|
/* pArg reference stolen here: */
|
||||||
PyTuple_SetItem(pArgs, i, pArg);
|
PyTuple_SetItem(pArgs, i, pArg);
|
||||||
}
|
}
|
||||||
|
@ -463,9 +567,13 @@ static foreign_t python_access(term_t obj, term_t f, term_t out) {
|
||||||
Py_DECREF(pArgs);
|
Py_DECREF(pArgs);
|
||||||
Py_DECREF(pF);
|
Py_DECREF(pF);
|
||||||
if (pValue == NULL) {
|
if (pValue == NULL) {
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
return python_to_term(pValue, out);
|
||||||
}
|
}
|
||||||
return python_to_term(pValue, out);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
|
static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
|
||||||
|
@ -475,7 +583,9 @@ static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
|
||||||
int arity;
|
int arity;
|
||||||
|
|
||||||
if (!PL_get_name_arity(att, &name, &arity)) {
|
if (!PL_get_name_arity(att, &name, &arity)) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
PyObject *p;
|
PyObject *p;
|
||||||
|
|
||||||
|
@ -484,39 +594,61 @@ static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
|
||||||
p = term_to_python(parent, true);
|
p = term_to_python(parent, true);
|
||||||
// Exp
|
// Exp
|
||||||
if (!PL_get_name_arity(att, &name, &arity)) {
|
if (!PL_get_name_arity(att, &name, &arity)) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
s = PL_atom_chars(name);
|
s = PL_atom_chars(name);
|
||||||
if (arity == 1 && !strcmp(s, "()")) {
|
if (arity == 1 && !strcmp(s, "()")) {
|
||||||
if (!PL_get_arg(1, att, att))
|
if (!PL_get_arg(1, att, att)) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
if (!PL_get_name_arity(att, &name, &arity)) {
|
if (!PL_get_name_arity(att, &name, &arity)) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
s = PL_atom_chars(name);
|
s = PL_atom_chars(name);
|
||||||
}
|
}
|
||||||
if (!s || !p) {
|
if (!s || !p) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
} else if ((pF = PyObject_GetAttrString(p, s)) == NULL) {
|
} else if ((pF = PyObject_GetAttrString(p, s)) == NULL) {
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return address_to_term(pF, tobj);
|
{
|
||||||
|
foreign_t rc;
|
||||||
|
rc = address_to_term(pF, tobj);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_main_module(term_t mod) {
|
static foreign_t python_main_module(term_t mod) {
|
||||||
return address_to_term(py_Main, mod);
|
{
|
||||||
|
foreign_t rc;
|
||||||
|
rc = address_to_term(py_Main, mod);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_function(term_t tobj) {
|
static foreign_t python_function(term_t tobj) {
|
||||||
PyObject *obj = term_to_python(tobj, true);
|
PyObject *obj = term_to_python(tobj, true);
|
||||||
|
foreign_t rc = PyFunction_Check(obj);
|
||||||
|
|
||||||
return PyFunction_Check(obj);
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
foreign_t python_builtin(term_t out) {
|
foreign_t python_builtin(term_t out) {
|
||||||
return address_to_term(py_Builtin, out);
|
{
|
||||||
|
foreign_t rc;
|
||||||
|
rc = address_to_term(py_Builtin, out);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_run_file(term_t file) {
|
static foreign_t python_run_file(term_t file) {
|
||||||
|
@ -530,24 +662,37 @@ static foreign_t python_run_file(term_t file) {
|
||||||
PyRun_SimpleFileEx(PyFile_AsFile(PyFileObject), "test.py", 1);
|
PyRun_SimpleFileEx(PyFile_AsFile(PyFileObject), "test.py", 1);
|
||||||
#else
|
#else
|
||||||
FILE *f = fopen(s, "r");
|
FILE *f = fopen(s, "r");
|
||||||
if (f == NULL)
|
if (f == NULL) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
PyRun_SimpleFileEx(f, s, 1);
|
PyRun_SimpleFileEx(f, s, 1);
|
||||||
#endif
|
#endif
|
||||||
return TRUE;
|
{
|
||||||
|
{
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
return false;
|
||||||
}
|
}
|
||||||
return false;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
extern PyThreadState *YAP_save;
|
||||||
|
|
||||||
|
|
||||||
static foreign_t python_run_command(term_t cmd) {
|
static foreign_t python_run_command(term_t cmd) {
|
||||||
char *s;
|
char *s;
|
||||||
|
bool rc = false;
|
||||||
size_t len;
|
size_t len;
|
||||||
char si[256];
|
char si[256];
|
||||||
|
|
||||||
s = si;
|
s = si;
|
||||||
if (PL_get_nchars(cmd, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
if (PL_get_nchars(cmd, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
|
||||||
PyRun_SimpleString(s);
|
PyRun_SimpleString(s);
|
||||||
|
rc = true;
|
||||||
}
|
}
|
||||||
return TRUE;
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_run_script(term_t cmd, term_t fun) {
|
static foreign_t python_run_script(term_t cmd, term_t fun) {
|
||||||
|
@ -587,7 +732,9 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
|
||||||
Py_DECREF(pModule);
|
Py_DECREF(pModule);
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
fprintf(stderr, "Call failed\n");
|
fprintf(stderr, "Call failed\n");
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (PyErr_Occurred())
|
if (PyErr_Occurred())
|
||||||
|
@ -598,11 +745,17 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
|
||||||
Py_DECREF(pModule);
|
Py_DECREF(pModule);
|
||||||
} else {
|
} else {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
return true;
|
||||||
}
|
}
|
||||||
return true;
|
|
||||||
}
|
}
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t python_export(term_t t, term_t pl) {
|
static foreign_t python_export(term_t t, term_t pl) {
|
||||||
|
@ -611,10 +764,12 @@ static foreign_t python_export(term_t t, term_t pl) {
|
||||||
void *ptr;
|
void *ptr;
|
||||||
term_t targ = PL_new_term_ref();
|
term_t targ = PL_new_term_ref();
|
||||||
|
|
||||||
if (!PL_get_arg(1, t, targ))
|
if (!PL_get_arg(1, t, targ)) {
|
||||||
return false;
|
return false;
|
||||||
if (!PL_get_pointer(targ, &ptr))
|
}
|
||||||
|
if (!PL_get_pointer(targ, &ptr)) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
Py_INCREF((PyObject *)ptr);
|
Py_INCREF((PyObject *)ptr);
|
||||||
/* return __main__,s */
|
/* return __main__,s */
|
||||||
rc = python_to_term((PyObject *)ptr, pl);
|
rc = python_to_term((PyObject *)ptr, pl);
|
||||||
|
@ -622,9 +777,7 @@ static foreign_t python_export(term_t t, term_t pl) {
|
||||||
return rc;
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
static foreign_t p_python_within_python(void) {
|
static foreign_t p_python_within_python(void) { return python_in_python; }
|
||||||
return python_in_python;
|
|
||||||
}
|
|
||||||
|
|
||||||
static int python_import(term_t mname, term_t mod) {
|
static int python_import(term_t mname, term_t mod) {
|
||||||
PyObject *pName, *pModule;
|
PyObject *pName, *pModule;
|
||||||
|
@ -638,14 +791,17 @@ static int python_import(term_t mname, term_t mod) {
|
||||||
if (PL_is_pair(mname)) {
|
if (PL_is_pair(mname)) {
|
||||||
char *sa;
|
char *sa;
|
||||||
if (!PL_get_arg(1, mname, arg) || !PL_get_atom_chars(arg, &sa) ||
|
if (!PL_get_arg(1, mname, arg) || !PL_get_atom_chars(arg, &sa) ||
|
||||||
!PL_get_arg(2, mname, mname))
|
!PL_get_arg(2, mname, mname)) {
|
||||||
return false;
|
return false;
|
||||||
|
}
|
||||||
s = stpcpy(s, sa);
|
s = stpcpy(s, sa);
|
||||||
*s++ = '.';
|
*s++ = '.';
|
||||||
s[0] = '\0';
|
s[0] = '\0';
|
||||||
} else if (!PL_get_nchars(mname, &len, &s,
|
} else if (!PL_get_nchars(mname, &len, &s,
|
||||||
CVT_ALL | CVT_EXCEPTION | REP_UTF8)) {
|
CVT_ALL | CVT_EXCEPTION | REP_UTF8)) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
@ -656,7 +812,9 @@ static int python_import(term_t mname, term_t mod) {
|
||||||
pName = PyUnicode_FromString(s0);
|
pName = PyUnicode_FromString(s0);
|
||||||
#endif
|
#endif
|
||||||
if (pName == NULL) {
|
if (pName == NULL) {
|
||||||
return false;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
pModule = PyImport_Import(pName);
|
pModule = PyImport_Import(pName);
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
|
@ -667,12 +825,32 @@ static int python_import(term_t mname, term_t mod) {
|
||||||
PyErr_Print();
|
PyErr_Print();
|
||||||
PyErr_Clear();
|
PyErr_Clear();
|
||||||
#endif
|
#endif
|
||||||
return FALSE;
|
{
|
||||||
|
return false;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
ActiveModules[active_modules++] = pModule;
|
ActiveModules[active_modules++] = pModule;
|
||||||
return python_to_ptr(pModule, mod);
|
{ foreign_t rc = python_to_ptr(pModule, mod);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static PyThreadState *_saveP;
|
||||||
|
|
||||||
|
static YAP_Int
|
||||||
|
p_python_get_GIL(void)
|
||||||
|
{
|
||||||
|
PyEval_AcquireThread(_saveP);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
static YAP_Int
|
||||||
|
p_python_release_GIL(void)
|
||||||
|
{
|
||||||
|
_saveP = PyEval_SaveThread();
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
install_t install_pypreds(void) {
|
install_t install_pypreds(void) {
|
||||||
PL_register_foreign("python_builtin_eval", 3, python_builtin_eval, 0);
|
PL_register_foreign("python_builtin_eval", 3, python_builtin_eval, 0);
|
||||||
PL_register_foreign("python_builtin", 1, python_builtin, 0);
|
PL_register_foreign("python_builtin", 1, python_builtin, 0);
|
||||||
|
@ -699,5 +877,6 @@ install_t install_pypreds(void) {
|
||||||
PL_register_foreign("python_main_module", 1, python_main_module, 0);
|
PL_register_foreign("python_main_module", 1, python_main_module, 0);
|
||||||
PL_register_foreign("python_import", 2, python_import, 0);
|
PL_register_foreign("python_import", 2, python_import, 0);
|
||||||
PL_register_foreign("python_access", 3, python_access, 0);
|
PL_register_foreign("python_access", 3, python_access, 0);
|
||||||
PL_register_foreign("python_within_python", 0, p_python_within_python, 0);
|
PL_register_foreign("release_GIL", 0, p_python_release_GIL, 0);
|
||||||
|
PL_register_foreign("acquire_GIL", 0, p_python_get_GIL, 0);
|
||||||
}
|
}
|
||||||
|
|
|
@ -93,6 +93,7 @@ X_API bool init_python(void) {
|
||||||
// wait for YAP_Init
|
// wait for YAP_Init
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
PyGILState_STATE gstate = PyGILState_Ensure();
|
||||||
term_t t = PL_new_term_ref();
|
term_t t = PL_new_term_ref();
|
||||||
if (!Py_IsInitialized()) {
|
if (!Py_IsInitialized()) {
|
||||||
python_in_python = true;
|
python_in_python = true;
|
||||||
|
@ -111,5 +112,6 @@ X_API bool init_python(void) {
|
||||||
PL_reset_term_refs(t);
|
PL_reset_term_refs(t);
|
||||||
install_pypreds();
|
install_pypreds();
|
||||||
install_pl2pl();
|
install_pl2pl();
|
||||||
|
PyGILState_Release(gstate);
|
||||||
return !python_in_python;
|
return !python_in_python;
|
||||||
}
|
}
|
||||||
|
|
|
@ -27,6 +27,8 @@
|
||||||
array_to_python_tuple/4,
|
array_to_python_tuple/4,
|
||||||
array_to_python_view/5,
|
array_to_python_view/5,
|
||||||
python/2,
|
python/2,
|
||||||
|
acquire_GIL/0,
|
||||||
|
release_GIL/0,
|
||||||
(:=)/2,
|
(:=)/2,
|
||||||
(:=)/1,
|
(:=)/1,
|
||||||
% (<-)/2,
|
% (<-)/2,
|
||||||
|
|
|
@ -0,0 +1,44 @@
|
||||||
|
import json
|
||||||
|
import os
|
||||||
|
import sys
|
||||||
|
|
||||||
|
try:
|
||||||
|
from jupyter_client.kernelspec import install_kernel_spec
|
||||||
|
except ImportError:
|
||||||
|
from IPython.kernel.kernelspec import install_kernel_spec
|
||||||
|
from IPython.utils.tempdir import TemporaryDirectory
|
||||||
|
|
||||||
|
|
||||||
|
kernel_json = {
|
||||||
|
"argv": [sys.executable,
|
||||||
|
"-m", "yap_kernel",
|
||||||
|
"-f", "{connection_file}"],
|
||||||
|
"display_name": "yap",
|
||||||
|
"mimetype": "text/x-prolog",
|
||||||
|
"language": "prolog",
|
||||||
|
"name": "yap",
|
||||||
|
}
|
||||||
|
|
||||||
|
def install_my_kernel_spec(user=False):
|
||||||
|
with TemporaryDirectory() as td:
|
||||||
|
os.chmod(td, 0o755) # Starts off as 700, not user readable
|
||||||
|
with open(os.path.join(td, 'kernel.json'), 'w') as f:
|
||||||
|
json.dump(kernel_json, f, sort_keys=True)
|
||||||
|
# TODO: Copy resources once they're specified
|
||||||
|
|
||||||
|
print('Installing IPython kernel spec')
|
||||||
|
install_kernel_spec(td, 'yap', user=False, replace=True)
|
||||||
|
|
||||||
|
def _is_root():
|
||||||
|
return True
|
||||||
|
try:
|
||||||
|
return os.geteuid() == 0
|
||||||
|
except AttributeError:
|
||||||
|
return False # assume not an admin on non-Unix platforms
|
||||||
|
|
||||||
|
def main(argv=[]):
|
||||||
|
user = '--user' in argv or not _is_root()
|
||||||
|
install_my_kernel_spec(user=user)
|
||||||
|
|
||||||
|
if __name__ == '__main__':
|
||||||
|
main(argv=sys.argv)
|
|
@ -0,0 +1,30 @@
|
||||||
|
"""
|
||||||
|
Paired Density and Scatterplot Matrix
|
||||||
|
=====================================
|
||||||
|
|
||||||
|
_thumb: .5, .5
|
||||||
|
"""
|
||||||
|
import seaborn as sns
|
||||||
|
import matplotlib.pyplot as plt
|
||||||
|
sns.set(style="white")
|
||||||
|
|
||||||
|
df = sns.load_dataset("iris")
|
||||||
|
|
||||||
|
g = sns.PairGrid(df, diag_sharey=False)
|
||||||
|
g.map_lower(sns.kdeplot, cmap="Blues_d")
|
||||||
|
g.map_upper(plt.scatter)
|
||||||
|
g.map_diag(sns.kdeplot, lw=3)
|
||||||
|
|
||||||
|
"""
|
||||||
|
Grouped barplots
|
||||||
|
================
|
||||||
|
|
||||||
|
_thumb: .45, .5
|
||||||
|
"""
|
||||||
|
sns.set(style="whitegrid")
|
||||||
|
|
||||||
|
# Draw a nested barplot to show survival for class and sex
|
||||||
|
g = sns.factorplot(x="class", y="survived", hue="sex", data=[15,30,5],
|
||||||
|
size=3, kind="bar", palette="muted")
|
||||||
|
g.despine(left=True)
|
||||||
|
g.set_ylabels("survival probability")
|
|
@ -1648,3 +1648,6 @@ log_event( String, Args ) :-
|
||||||
/**
|
/**
|
||||||
@}
|
@}
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
|
Binary file not shown.
After Width: | Height: | Size: 128 KiB |
|
@ -0,0 +1,4 @@
|
||||||
|
a(X) :- X.
|
||||||
|
b(X) :- X, writeln(X).
|
||||||
|
c(X) :- X, X.
|
||||||
|
|
|
@ -0,0 +1,652 @@
|
||||||
|
#! /usr/bin/env python3
|
||||||
|
#
|
||||||
|
# druwid is machine learning tool for adverse drug discovery
|
||||||
|
#
|
||||||
|
# It relies on the Aleph ILP learner, written and maintained by Ashwin Srinivasan\
|
||||||
|
#
|
||||||
|
# Authos: Vitor Santos Costa, David Page
|
||||||
|
# Bugs are from Vitor Santos Costa
|
||||||
|
#
|
||||||
|
|
||||||
|
import matplotlib
|
||||||
|
import matplotlib.image as mpimg
|
||||||
|
#matplotlib.use('Agg')
|
||||||
|
|
||||||
|
import argparse
|
||||||
|
import csv
|
||||||
|
import heapq
|
||||||
|
import logging
|
||||||
|
import networkx as nx
|
||||||
|
import os
|
||||||
|
import numpy as np
|
||||||
|
import pandas as pd
|
||||||
|
import sys
|
||||||
|
import threading
|
||||||
|
import time
|
||||||
|
import yap
|
||||||
|
|
||||||
|
graphics_ability = False
|
||||||
|
|
||||||
|
if graphics_ability:
|
||||||
|
import PIL
|
||||||
|
def display_pdf(id):
|
||||||
|
im = Image.open(self.shown_clause[id])
|
||||||
|
im.show()
|
||||||
|
|
||||||
|
|
||||||
|
logging.basicConfig(level=logging.DEBUG,
|
||||||
|
format='[%(levelname)s] (%(threadName)-10s) %(message)s',
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
from collections import namedtuple
|
||||||
|
from enum import IntEnum
|
||||||
|
from queue import Queue
|
||||||
|
from dru.druplot import plotClause
|
||||||
|
from dru.shell import alephShell
|
||||||
|
|
||||||
|
# class Console(InteractiveConsole):
|
||||||
|
|
||||||
|
# def __init__(*args): InteractiveConsole.__init__(*args)
|
||||||
|
|
||||||
|
compile = namedtuple('consult', 'FileName')
|
||||||
|
ensure_loaded = namedtuple('ensure_loaded', 'FileName')
|
||||||
|
loadFile = namedtuple('load_file', 'FileName Opts')
|
||||||
|
add_example = namedtuple('add_example', 'polarity case id b e')
|
||||||
|
set = namedtuple('set', 'key val')
|
||||||
|
setting = namedtuple('setting', ' key')
|
||||||
|
clsrc = namedtuple('clsrc', ' key ids')
|
||||||
|
clgraph = namedtuple('clgraph', ' key')
|
||||||
|
clhist = namedtuple('clhist', ' key first pos')
|
||||||
|
clause_info = namedtuple('clause_info', ' key Text Symbs H1Pos H2Pos CH1Pos CH2Pos ')
|
||||||
|
learn = namedtuple('learn', 'example')
|
||||||
|
learn_in_thread = namedtuple('learn_in_thread', 'example')
|
||||||
|
#learner = namedtuple('learn', 'class')
|
||||||
|
# assert = namedtuple('assert', 'fact')
|
||||||
|
load_ptable = namedtuple('load_ptable', 'File')
|
||||||
|
load_files = namedtuple('load_files', 'File Opts')
|
||||||
|
|
||||||
|
|
||||||
|
# prolog engine
|
||||||
|
class y:
|
||||||
|
E = None
|
||||||
|
|
||||||
|
def run(g):
|
||||||
|
y.E.goal(g)
|
||||||
|
|
||||||
|
def f(g):
|
||||||
|
y.E.fun(g)
|
||||||
|
|
||||||
|
|
||||||
|
# Schema information on Marshfiel mode table ( 2016 data )
|
||||||
|
#
|
||||||
|
# TBD: make it match/ genrate a mode declaration
|
||||||
|
#
|
||||||
|
|
||||||
|
# column headers, StudyId refers to the study participant
|
||||||
|
#
|
||||||
|
class DiagFields:
|
||||||
|
StudyID = 0
|
||||||
|
DX_CODE= 1
|
||||||
|
AGE= 2
|
||||||
|
FACILITY_NUM= 3
|
||||||
|
PROV_ID= 4
|
||||||
|
DX_DESC= 5
|
||||||
|
DX_TYPE_ID= 6
|
||||||
|
DX_TYPE_DESC= 7
|
||||||
|
DX_SUB_TYPE_ID= 8
|
||||||
|
DX_SUB_TYPE_DESC= 9
|
||||||
|
DX_CODE_CATEGORY= 10
|
||||||
|
DX_CODE_CATEGORY_DESC= 11
|
||||||
|
DX_CODE_SUBCATEGORY= 12
|
||||||
|
DX_CODE_SUBCATEGORY_DESC= 13
|
||||||
|
DATA_SOURCE= 14
|
||||||
|
|
||||||
|
#
|
||||||
|
# operations to fetch data from meds
|
||||||
|
#
|
||||||
|
class DiagOps(DiagFields):
|
||||||
|
''' Selects age, id, and one descriptor: we chose to use DX_DESC so that people
|
||||||
|
can understand the rules easily. '''
|
||||||
|
|
||||||
|
def import_row( self ):
|
||||||
|
return ( DiagFields.StudyID, DiagFields.AGE, DiagFields.DX_DESC )
|
||||||
|
|
||||||
|
def pred(self):
|
||||||
|
return yap.YAPPrologPredicate( self.name, 3 )
|
||||||
|
|
||||||
|
def __init__(self, name, ids):
|
||||||
|
self.name = name
|
||||||
|
self.ids = ids
|
||||||
|
|
||||||
|
# column headers, StudyId refers to the study participant
|
||||||
|
#
|
||||||
|
class MedFields( IntEnum ):
|
||||||
|
StudyID = 0
|
||||||
|
AGE = 1
|
||||||
|
GCN_SEQ_NUM= 2
|
||||||
|
DRUG_NAME= 3
|
||||||
|
GENERIC_NAME= 4
|
||||||
|
DOSAGE= 5
|
||||||
|
FREQUENCY= 6
|
||||||
|
ACTION_ATTRIBUTE_DESC= 7
|
||||||
|
ACTION_VALUE_DESC = 8
|
||||||
|
ACTION_IN_PLAN_CODE= 9
|
||||||
|
THERAPEUTIC_GENERIC_ID= 10
|
||||||
|
THERAPEUTIC_GENERIC_DESC= 11
|
||||||
|
THERAPEUTIC_SPECIFIC_ID= 12
|
||||||
|
THERAPEUTIC_SPECIFIC_DESC= 13
|
||||||
|
DRUG_SOURCE= 14
|
||||||
|
DATA_SOURCE = 15
|
||||||
|
|
||||||
|
#
|
||||||
|
# operations to fetch data from meds
|
||||||
|
#
|
||||||
|
class MedOps:
|
||||||
|
''' Operations as designed for the Marshfield meds table'''
|
||||||
|
|
||||||
|
arity = 3
|
||||||
|
|
||||||
|
def import_row( self ):
|
||||||
|
return ( MedFields.StudyID, MedFields.AGE, MedFields.DRUG_NAME )
|
||||||
|
|
||||||
|
def pred( self ):
|
||||||
|
return yap.YAPPredicate( self.name, 3 )
|
||||||
|
|
||||||
|
def __init__(self, name, ids):
|
||||||
|
self.name = name
|
||||||
|
self.ids = ids
|
||||||
|
|
||||||
|
class PrologTable:
|
||||||
|
'''Access tables in Prolog format'''
|
||||||
|
|
||||||
|
def query( self ):
|
||||||
|
args = [ 0 for x in range(self.arity) ]
|
||||||
|
return self.pname._make( args )
|
||||||
|
|
||||||
|
def __init__(self, p, name):
|
||||||
|
self.p = p
|
||||||
|
self.name = name
|
||||||
|
self.arity = p.arity()
|
||||||
|
ArgNames = [ "A" + str(x+1) for x in range(self.arity) ]
|
||||||
|
self.pname = namedtuple(self.name, ArgNames)
|
||||||
|
|
||||||
|
def __iter__(self):
|
||||||
|
goal = self.pname._make( )
|
||||||
|
return PrologTableIter(self, e, goal)
|
||||||
|
|
||||||
|
class PrologTableIter:
|
||||||
|
|
||||||
|
def __init__(self, e, goal):
|
||||||
|
try:
|
||||||
|
self.e = e
|
||||||
|
self.q = e.YAPQuery(goal)
|
||||||
|
except:
|
||||||
|
print('Error')
|
||||||
|
|
||||||
|
def __iter__(self):
|
||||||
|
# Iterators are iterables too.
|
||||||
|
# Adding this functions to make them so.
|
||||||
|
return self
|
||||||
|
|
||||||
|
def next(self):
|
||||||
|
if self.q.next():
|
||||||
|
return goal
|
||||||
|
else:
|
||||||
|
self.q.close()
|
||||||
|
self.q = None
|
||||||
|
raise StopIteration()
|
||||||
|
|
||||||
|
class DBStore:
|
||||||
|
'''store operations: csv to pl, and so on'''
|
||||||
|
|
||||||
|
def filter ( self, row ):
|
||||||
|
id = int(row[self.StudyID])
|
||||||
|
|
||||||
|
if id in self.ids:
|
||||||
|
ex1 = self.ids[ id ]
|
||||||
|
ex2 = self.ids[ -id ]
|
||||||
|
|
||||||
|
age = int(float(row[self.AGE])*1000)
|
||||||
|
if ex2[1] <= age and age <= ex2[2]:
|
||||||
|
id = -id
|
||||||
|
elif ex1[1] > age or age > ex1[2]:
|
||||||
|
return None
|
||||||
|
desc = row[self.DESC]
|
||||||
|
return id, age, desc
|
||||||
|
|
||||||
|
def __init__(self, File, dbi, ids ):
|
||||||
|
self.ids = ids
|
||||||
|
OFile = "data/" + dbi.name + '.yap'
|
||||||
|
if os.path.isfile(OFile) :
|
||||||
|
print("loading db from "+OFile)
|
||||||
|
y.run( load_files( OFile , []) )
|
||||||
|
return
|
||||||
|
with open(File) as csvfile:
|
||||||
|
print("Converting db from "+File+ " to "+OFile)
|
||||||
|
with open( OFile, "w") as out:
|
||||||
|
csvfile.seek(0)
|
||||||
|
reader = csv.reader(csvfile, delimiter = '|', quoting = csv.QUOTE_MINIMAL )
|
||||||
|
( self.StudyID, self.AGE, self.DESC ) = dbi.import_row()
|
||||||
|
P = dbi.pred()
|
||||||
|
reader.__next__()
|
||||||
|
for row in reader:
|
||||||
|
tuple = self.filter( row )
|
||||||
|
if tuple:
|
||||||
|
out.write( dbi.name + "( " + str(tuple[0]) +" , " + str(tuple[1])+ ", \'" + str(tuple[2]) + "\').\n" )
|
||||||
|
print("loading db from "+OFile)
|
||||||
|
y.E.reSet()
|
||||||
|
y.run( load_ptable( OFile ) )
|
||||||
|
|
||||||
|
def save_table(self, File, name):
|
||||||
|
p = self.YAPPredicate(name, 3)
|
||||||
|
with open(File, 'w', newline='') as csvfile:
|
||||||
|
fieldnames = ['Id', 'Age', 'Attribute' ]
|
||||||
|
writer = csv.writer(csvfile, delimiter='|', fieldnames=fieldnames)
|
||||||
|
writer.writerows(PrologTable(p, name))
|
||||||
|
|
||||||
|
class Examples:
|
||||||
|
''' Support for the manipulation and processing of examples.
|
||||||
|
|
||||||
|
So far, only loadng examples'''
|
||||||
|
|
||||||
|
ids = {}
|
||||||
|
|
||||||
|
def __init__(self, File):
|
||||||
|
if File.lower().endswith(('.yap','.pl','.pro','.prolog')):
|
||||||
|
E.run( add_prolog( File ) )
|
||||||
|
return
|
||||||
|
print("loading examples from "+File)
|
||||||
|
with open(File) as csvfile:
|
||||||
|
dialect = csv.Sniffer().sniff(csvfile.read(1024))
|
||||||
|
dialect.delimiter = '|'
|
||||||
|
dialect.quoting = csv.QUOTE_MINIMAL
|
||||||
|
csvfile.seek(0)
|
||||||
|
reader = csv.reader(csvfile, dialect)
|
||||||
|
reader.__next__()
|
||||||
|
for row in reader:
|
||||||
|
( cdb, pdb, id, b, e ) = row
|
||||||
|
case = cdb == "1" or cdb == 't' or cdb == '+'
|
||||||
|
Type = pdb == "1" or pdb == 't' or pdb == '+'
|
||||||
|
if Type:
|
||||||
|
id = int(id)
|
||||||
|
ti = 1
|
||||||
|
else:
|
||||||
|
id = -int(id)
|
||||||
|
ti = 0
|
||||||
|
if case:
|
||||||
|
ci = 1
|
||||||
|
else:
|
||||||
|
ci = 0
|
||||||
|
b = int(float(b)*1000)
|
||||||
|
e = int(float(e)*1000)
|
||||||
|
y.run( add_example(ti, ci, id, b, e) )
|
||||||
|
self.ids[id] = ( case, b, e )
|
||||||
|
|
||||||
|
cols = ['Id', 'Ref', 'Parent', 'TPP', 'TPN', 'TNN', ' CPP', 'CPN', 'CNN']
|
||||||
|
indx= ['Id']
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
class ClauseQueue:
|
||||||
|
'''Auxiliary class that represents the list of visited clauses.'''
|
||||||
|
|
||||||
|
''' queue size '''
|
||||||
|
size = 1024*256
|
||||||
|
best = 8
|
||||||
|
q = []
|
||||||
|
count = 0
|
||||||
|
|
||||||
|
def parentText(self, parent):
|
||||||
|
[row] = self.DF.loc[self.DF.Id==parent].values.tolist( )
|
||||||
|
return "Parent "+str(parent)+", cases " +repr(row[3:6])+", controls " +repr(row[6:9])
|
||||||
|
|
||||||
|
def showQueue(self, n):
|
||||||
|
L = heapq.nlargest(n, self.q)
|
||||||
|
S = "[ *********************************************************************\nbest rules at " + repr(self.count) +" nodes:\n"
|
||||||
|
S += "Node".rjust(6) + "Score".rjust(10) + "Parent".rjust(6) +" | " +"Matches on Cases".center(24) +" | " +"Matches on Controls".center(24) + '|\n'
|
||||||
|
S += "".rjust(6) + "".rjust(10) + "".rjust(6) + " | " +"Generic".center(8) + "Both".center(8) + "Brand".center(8) + " | " +"Generic".center(8) + "Both".center(8) + "Brand".center(8) + '|\n'
|
||||||
|
S += "".rjust(6) + "".rjust(10) + "".rjust(6) + " | " + "Only".center(8) + "".center(8) + "Only".center(8) + " | " +"Only".center(8) + "".center(8) + "Only".center(8) + '|\n'
|
||||||
|
for cl in L:
|
||||||
|
S += self.clauseToStringRow( cl )
|
||||||
|
S += "\n[ ********************************************************************* ]\n\n"
|
||||||
|
for cl in L:
|
||||||
|
S += self.PrintClbyId( cl )
|
||||||
|
return S
|
||||||
|
|
||||||
|
|
||||||
|
def loadHists(self):
|
||||||
|
hists = {}
|
||||||
|
if self.ipcs[0]:
|
||||||
|
hists["case_after_first"] = self.histpcs[0][0:self.ipcs[0]]
|
||||||
|
if self.ipcs[1]:
|
||||||
|
hists["case_after_last"] = self.histpcs[1][0:self.ipcs[1]]
|
||||||
|
if self.ipcs[2]:
|
||||||
|
hists["case_bef_first"] = self.histpcs[2][0:self.ipcs[2]]
|
||||||
|
if self.ipcs[3]:
|
||||||
|
hists["case_bef_last"] = self.histpcs[3][0:self.ipcs[3]]
|
||||||
|
if self.ipcs[4]:
|
||||||
|
hists["control_after_first"] = self.histpcs[4][0:self.ipcs[4]]
|
||||||
|
if self.ipcs[5]:
|
||||||
|
hists["control_after_last"] = self.histpcs[5][0:self.ipcs[5]]
|
||||||
|
if self.ipcs[6]:
|
||||||
|
hists["control_bef_first"] = self.histpcs[6][0:self.ipcs[6]]
|
||||||
|
if self.ipcs[7]:
|
||||||
|
hists["control_bef_last"] = self.histpcs[7][0:self.ipcs[7]]
|
||||||
|
return hists
|
||||||
|
|
||||||
|
def attendRequests(self):
|
||||||
|
while not self.command_q.empty():
|
||||||
|
msg = self.command_q.get()
|
||||||
|
if msg[0] == "show_clause":
|
||||||
|
row = msg[1]
|
||||||
|
y.run( clsrc( row[1], self ) )
|
||||||
|
parent = row[2]
|
||||||
|
parentDesc = self.parentText(parent)
|
||||||
|
self.hists = self.loadHists()
|
||||||
|
print( hists)
|
||||||
|
self.reply_q.put( ("show_clause", parentDesc ) )
|
||||||
|
|
||||||
|
|
||||||
|
# this method implements PrintCl if YAP is running
|
||||||
|
def printClWithThreads(self, row):
|
||||||
|
try:
|
||||||
|
id = row[0]
|
||||||
|
# if id in self.shown_clause:
|
||||||
|
# im = Image.open(self.shown_clause[id])
|
||||||
|
# im.show()
|
||||||
|
# return
|
||||||
|
#Prolog does the firat half
|
||||||
|
self.queue.prolog_q.put( ( "show_clause" , row ) )
|
||||||
|
( x, parentDesc )= self.queue.reply_q.get()
|
||||||
|
self.shown_clause[id] = plotClause(row[0],parentDesc, row[3:6], row[3:9], Text, (self.GraphV,self.d), self.hists)
|
||||||
|
except Exception as e:
|
||||||
|
print( 'trieref = ' + trieref )
|
||||||
|
raise
|
||||||
|
|
||||||
|
# this method implements PrintCl if YAP is not running
|
||||||
|
def printClNoThreads(self, row):
|
||||||
|
try:
|
||||||
|
id = row[0]
|
||||||
|
if graphics_ability and id in self.shown_clause:
|
||||||
|
display_pdf( id )
|
||||||
|
im = Image.open(self.shown_clause[id])
|
||||||
|
im.show()
|
||||||
|
return
|
||||||
|
#Prolog does the real work
|
||||||
|
y.run( clsrc( row[1], self ) )
|
||||||
|
parent = row[2]
|
||||||
|
self.hists = self.loadHists()
|
||||||
|
parentDesc = self.parentText(parent)
|
||||||
|
# and then sealib
|
||||||
|
self.shown_clause[id] = plotClause(row[0],parentDesc, row[3:6], row[6:9], self.Text )
|
||||||
|
except Exception as e:
|
||||||
|
print( 'trieref = ' + trieref )
|
||||||
|
raise
|
||||||
|
|
||||||
|
def clauseToStringRow(self, id):
|
||||||
|
try:
|
||||||
|
[row] = self.DF.loc[self.DF.Id==id].values.tolist( )
|
||||||
|
S = "" + repr(id).rjust(6) + "{:10.3f}".format(cl[0]) + repr(row[2]).rjust(6) +" | " + repr(row[3]).rjust(6) + repr(row[4]).rjust(6) + repr(row[5]).rjust(6) + ' | '+ repr(row[6]).rjust(6) + repr(row[7]).rjust(6) + repr(row[8]).rjust(6) + '|\n'
|
||||||
|
return S
|
||||||
|
except Exception as e:
|
||||||
|
print( str(e) )
|
||||||
|
raise
|
||||||
|
|
||||||
|
def printClauseAsRow(self, id):
|
||||||
|
print( self.clauseToStringRow( id ) )
|
||||||
|
|
||||||
|
|
||||||
|
def printClbyId(self, id):
|
||||||
|
try:
|
||||||
|
[row] = self.DF.loc[self.DF.Id==id].values.tolist( )
|
||||||
|
self.printClause( row )
|
||||||
|
except Exception as e:
|
||||||
|
print( str(e) )
|
||||||
|
raise
|
||||||
|
|
||||||
|
def printClbyTrieRef(self, trieref):
|
||||||
|
try:
|
||||||
|
[row] = self.DF.loc[self.DF.Ref==trieref].values.tolist()
|
||||||
|
self.printClause( row )
|
||||||
|
except Exception as e:
|
||||||
|
print( str(e) )
|
||||||
|
raise
|
||||||
|
|
||||||
|
def idFromTrieRef( self, trieref ):
|
||||||
|
try:
|
||||||
|
row = self.DF.loc[self.DF.Ref==trieref]
|
||||||
|
return int(row.at['Id','Id' ])
|
||||||
|
except Exception as e:
|
||||||
|
print("node = "+str(trieref))
|
||||||
|
print(self.DF)
|
||||||
|
raise
|
||||||
|
|
||||||
|
def add(self, parent, score, trieref, c):
|
||||||
|
try:
|
||||||
|
#import pdb
|
||||||
|
#pdb.set_trace()
|
||||||
|
self.count += 1
|
||||||
|
k = [self.count,trieref,parent,c[0],c[1],c[2],c[3],c[4],c[5]]
|
||||||
|
heapq.heappush(self.q, (score, self.count))
|
||||||
|
self.DF = self.DF.append(pd.DataFrame([k],columns=cols,index=indx))
|
||||||
|
if not self.command_q.empty():
|
||||||
|
self.attendRequests()
|
||||||
|
except Exception as e:
|
||||||
|
print("new node = "+str(self.count))
|
||||||
|
print("parent = "+str(parent))
|
||||||
|
print(self.DF)
|
||||||
|
raise
|
||||||
|
|
||||||
|
def link(self, parent, trieref):
|
||||||
|
try:
|
||||||
|
row = self.DF.loc[self.DF.Ref==trieref]
|
||||||
|
if not self.command_q.empty():
|
||||||
|
self.attendRequests()
|
||||||
|
except Exception as e:
|
||||||
|
print("new node = "+str(trieref))
|
||||||
|
print("parent = "+str(parent))
|
||||||
|
print(self.DF)
|
||||||
|
raise
|
||||||
|
|
||||||
|
def pushHistogram( self, i, val):
|
||||||
|
try:
|
||||||
|
x = self.ipcs[i]
|
||||||
|
self.histpcs[i][x] = val
|
||||||
|
self.ipcs[i] = x+1
|
||||||
|
except Exception as e:
|
||||||
|
print("i = "+str(i))
|
||||||
|
print("x = "+str(x))
|
||||||
|
print(self.DF)
|
||||||
|
raise
|
||||||
|
|
||||||
|
|
||||||
|
def initHistograms( self ):
|
||||||
|
self.histpcs = ( [None]*2400, [None]*2400, [None]*2400, [None]*2400,
|
||||||
|
[None]*2400, [None]*2400, [None]*2400, [None]*2400)
|
||||||
|
self.resetHistograms()
|
||||||
|
|
||||||
|
def resetHistograms( self ):
|
||||||
|
self.ipcs = [ 0, 0, 0, 0, 0, 0, 0, 0 ]
|
||||||
|
|
||||||
|
def setClauseText( self, txt ):
|
||||||
|
self.Text = txt
|
||||||
|
|
||||||
|
def setClauseGraph( self, labels,edges ):
|
||||||
|
G=nx.DiGraph()
|
||||||
|
dict = {}
|
||||||
|
for (i,l) in labels:
|
||||||
|
G.add_node(i,label=i)
|
||||||
|
dict[i] = l.strip()[0].lower()
|
||||||
|
for (i,j) in edges:
|
||||||
|
G.add_edge(i,j)
|
||||||
|
self.GraphV = G
|
||||||
|
self.d = dict
|
||||||
|
return G
|
||||||
|
|
||||||
|
def __repr__(self):
|
||||||
|
l = heapq.nlargest(self.q, 10)
|
||||||
|
for i in l:
|
||||||
|
print( l )
|
||||||
|
|
||||||
|
def __init__(self):
|
||||||
|
self.command_q = Queue()
|
||||||
|
self.reply_q = Queue()
|
||||||
|
self.GraphV=nx.Graph()
|
||||||
|
self.count = 0
|
||||||
|
self.DF = pd.DataFrame([[0,88998993,0,4,3,2,1,160,400]],columns=cols, index=indx)
|
||||||
|
self.shown_clause = {}
|
||||||
|
|
||||||
|
class LineSettings:
|
||||||
|
'''Isolate interface with argparse '''
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
opts = None
|
||||||
|
|
||||||
|
def __init__(self):
|
||||||
|
parser = argparse.ArgumentParser(description='''Search for ADRs using EHR data.
|
||||||
|
The arguments are CSV files for the databases, with at least 3 fields:
|
||||||
|
- an integer giving the patient id, called key
|
||||||
|
- a float point giving the patient\'s age in years, called age
|
||||||
|
- a string describing the diagnosis, called data
|
||||||
|
dppb
|
||||||
|
The case and control files are alos in CSV form, withe the following fields:
|
||||||
|
Key,AgeBefStart,AgeStartEnd,AgeAfterStart,AGeAfterEnd
|
||||||
|
|
||||||
|
p ''')
|
||||||
|
parser.add_argument('--save-db', dest='save', default=None, help="save the processed DB in Prolog, CSV, pickle")
|
||||||
|
parser.add_argument('--meds', dest='meds', default="data/meds.csv", help="CSV or Tab like with the medications database")
|
||||||
|
parser.add_argument('--diags', dest='diags', default="data/diags.csv", help="CSV or Tab like with the medications database")
|
||||||
|
parser.add_argument('--examples', dest='examples', default="data/exs.csv" , help="CSV or Tab like with the cases and controls")
|
||||||
|
parser.add_argument('--labs', type=argparse.FileType('r'), default=None, help="unsupported for now")
|
||||||
|
parser.add_argument('--min_examples', type=int, default=20, help="minimal number of examples to cover")
|
||||||
|
parser.add_argument('--seed', type=int, default=0, help="examples to start search, 0 if tries to cinsider all")
|
||||||
|
parser.add_argument('-f', default=" " , help="jupyter notebook")
|
||||||
|
parser.add_argument('--interactive', type = bool, default=True, help="run as line mode, or run as closed script ()")
|
||||||
|
self.opts = parser.parse_args()
|
||||||
|
|
||||||
|
def map(self):
|
||||||
|
return vars(self.opts)
|
||||||
|
|
||||||
|
|
||||||
|
class Aleph:
|
||||||
|
|
||||||
|
e = None
|
||||||
|
|
||||||
|
def add_db(self, p, t):
|
||||||
|
queue.addClause(t)
|
||||||
|
|
||||||
|
def set_options( self, xargs):
|
||||||
|
|
||||||
|
if 'min-examples' in xargs:
|
||||||
|
self.set('minpos', xargs[ 'min_examples' ] )
|
||||||
|
if 'verbosity' in xargs:
|
||||||
|
self.set('verbosity', xargs[ 'verbosity' ] )
|
||||||
|
if 'search' in xargs:
|
||||||
|
self.set('search', xargs[ 'search' ] )
|
||||||
|
if 'nodes' in xargs:
|
||||||
|
self.set('nodes', xargs[ 'nodes' ] )
|
||||||
|
|
||||||
|
def set( self, parameter, value):
|
||||||
|
'''Set an integer parameter, eg nodes, seeds or noise'''
|
||||||
|
y.run(set(parameter, value))
|
||||||
|
|
||||||
|
def setting( self, parameter):
|
||||||
|
'''Return the Aleph setting for parameter p, or show all
|
||||||
|
the current settings'''
|
||||||
|
if parameter:
|
||||||
|
value = yap.YAPVarTerm()
|
||||||
|
y.run(setting(parameter, value))
|
||||||
|
# return value
|
||||||
|
y.run( settings )
|
||||||
|
|
||||||
|
def induce( self, index = 0):
|
||||||
|
'''Learn clauses'''
|
||||||
|
y.run( learn( index ) )
|
||||||
|
|
||||||
|
def induceInThread( self, index = 0):
|
||||||
|
'''Learn clauses as a separe thread'''
|
||||||
|
if self.learning:
|
||||||
|
print("Already learning" )
|
||||||
|
return
|
||||||
|
self.learning = True
|
||||||
|
y.run( learn_in_thread( index ) )
|
||||||
|
|
||||||
|
def query_prolog( self, y, Query):
|
||||||
|
y.run( Query )
|
||||||
|
|
||||||
|
def rule( self, id ):
|
||||||
|
self.queue.printClause( id )
|
||||||
|
|
||||||
|
def histogram( self, Dict ):
|
||||||
|
pass
|
||||||
|
|
||||||
|
def induceInThread( self, index = 0 ):
|
||||||
|
kw = {}
|
||||||
|
kw["index"] = index
|
||||||
|
t = threading.Thread(target=self.induceInThread, kwargs=kw)
|
||||||
|
t.setDaemon = True
|
||||||
|
self.queue.printClause = self.queue.printClWithThreads
|
||||||
|
t.start()
|
||||||
|
self.queue.printClause = self.queue.printClNoThreads
|
||||||
|
|
||||||
|
def rules( self, count = 100 ):
|
||||||
|
self.queue.showQueue()
|
||||||
|
|
||||||
|
def golearn( self ):
|
||||||
|
|
||||||
|
try:
|
||||||
|
# import pdb
|
||||||
|
# pdb.set_trace()
|
||||||
|
self.learning = False
|
||||||
|
alephShell( self ).cmdloop()
|
||||||
|
q.close()
|
||||||
|
|
||||||
|
except SyntaxError as err:
|
||||||
|
print("Syntax Error error: {0}".format(err))
|
||||||
|
print( sys.exc_info()[0] )
|
||||||
|
except EOFError:
|
||||||
|
return
|
||||||
|
except RuntimeError as err:
|
||||||
|
print("YAP Execution Error: {0}".format(err))
|
||||||
|
print( sys.exc_info()[0] )
|
||||||
|
except ValueError as err:
|
||||||
|
print("Could not convert data to an integer: {0}.", format(rr))
|
||||||
|
print( sys.exc_info()[0] )
|
||||||
|
except NameError as err:
|
||||||
|
print("Bad Name: {0}.", format(err))
|
||||||
|
print( sys.exc_info()[0] )
|
||||||
|
except Exception as err:
|
||||||
|
print("Unexpected error:" + sys.exc_info() )
|
||||||
|
print( sys.exc_info()[0] )
|
||||||
|
|
||||||
|
|
||||||
|
def learn( self ):
|
||||||
|
|
||||||
|
while True:
|
||||||
|
self.golearn()
|
||||||
|
|
||||||
|
def __init__(self, queue):
|
||||||
|
''' Initialize Aleph by loading the data-bases and the example'''
|
||||||
|
|
||||||
|
if y.E == None:
|
||||||
|
y.E = yap.YAPEngine()
|
||||||
|
y.run( ensure_loaded( sys.druwid_root +'/druwid.yap' ) )
|
||||||
|
y.E.reSet()
|
||||||
|
x_args = LineSettings().map()
|
||||||
|
exf = x_args['examples']
|
||||||
|
exs = Examples(exf)
|
||||||
|
di = x_args['diags']
|
||||||
|
exmap = exs.ids
|
||||||
|
diags = DBStore( di, DiagOps( "diags", exmap ), exmap )
|
||||||
|
md = x_args['meds']
|
||||||
|
meds = DBStore(md, MedOps( "meds", exmap ) , exmap )
|
||||||
|
y.E.reSet()
|
||||||
|
save_db = x_args['save']
|
||||||
|
self.set_options( x_args )
|
||||||
|
self.interactive = x_args['interactive']
|
||||||
|
self.queue = queue
|
||||||
|
self.learning = False
|
||||||
|
self.queue.initHistograms( )
|
||||||
|
self.queue.printClause = self.queue.printClNoThreads
|
Reference in New Issue