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

Merge ssh://192.168.66.221/~vitor/Yap/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-11-02 00:16:36 -05:00
commit 02e0e50915
89 changed files with 25149 additions and 1730 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/absmi.c
View File

@ -902,7 +902,8 @@ static void undef_goal(USES_REGS1) {
PP = pe;
}
#endif
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag)) {
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ||
pe == UndefCode) {
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;

168
C/adtdefs.c
View File

@ -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 */
static Prop
GetFunctorProp(AtomEntry *ae,
@ -69,9 +58,8 @@ GetFunctorProp(AtomEntry *ae,
FunctorEntry *pp;
pp = RepFunctorProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) &&
(!IsFunctorProperty(pp->KindOfPE) || pp->ArityOfFE != arity))
pp = RepFunctorProp(pp->NextOfPE);
while (!EndOfPAEntr(pp) && (pp = RepFunctorProp(pp->NextOfPE)))
;
return (AbsFunctorProp(pp));
}
@ -153,19 +141,6 @@ static inline Atom SearchAtom(const unsigned char *p, Atom a) {
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
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;
}
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,
size_t len0) { /* lookup atom in atom table */
Atom at;
@ -388,9 +227,6 @@ Atom Yap_ULookupAtom(
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 t;

10
C/agc.c
View File

@ -427,11 +427,6 @@ clean_atom_list(AtomHashEntry *HashPtr)
Yap_FreeCodeSpace((char *)b);
GLOBAL_agc_collected += sizeof(YAP_BlobPropEntry);
GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length;
} else if (IsWideAtom(atm)) {
#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
fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE);
@ -459,11 +454,6 @@ clean_atoms(void)
clean_atom_list(HashPtr);
HashPtr++;
}
HashPtr = WideHashChain;
for (i = 0; i < WideAtomHashTableSize; ++i) {
clean_atom_list(HashPtr);
HashPtr++;
}
clean_atom_list(&INVISIBLECHAIN);
{
AtomHashEntry list;

6
C/alloc.c
View File

@ -77,7 +77,7 @@ void *my_malloc(size_t sz) {
p = malloc(sz);
// 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);
if (sz > 500 && write_malloc++ > 0)
__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;
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);
// Yap_DebugPuts(stderr,"gof\n");
if (sz > 500 && write_malloc++ > 0)
@ -100,7 +100,7 @@ void *my_realloc(void *ptr, size_t sz) {
void my_free(void *p) {
// printf("f %p\n",p);
if (Yap_do_low_level_trace)
if (Yap_do_low_level_trace||1)
fprintf(stderr, "+ %p\n", p);
if (write_malloc && write_malloc++ > 0)
__android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc,

580
C/atomic.c
View File

@ -230,15 +230,15 @@ static Int char_code(USES_REGS1) {
return (FALSE);
}
if (code > MAX_ISO_LATIN1) {
wchar_t wcodes[2];
unsigned char codes[10];
if (code > CHARCODE_MAX) {
Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2");
return (FALSE);
}
wcodes[0] = code;
wcodes[1] = '\0';
tout = MkAtomTerm(Yap_LookupWideAtom(wcodes));
size_t n = put_utf8( codes, code);
codes[0] = code;
tout = MkAtomTerm(Yap_ULookupAtom(codes));
} else {
char codes[2];
@ -254,24 +254,14 @@ static Int char_code(USES_REGS1) {
} else {
Atom at = AtomOfTerm(t0);
Term tf;
if (IsWideAtom(at)) {
wchar_t *c = RepAtom(at)->WStrOfAE;
if (c[1] != '\0') {
Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2");
return FALSE;
}
tf = MkIntegerTerm(c[0]);
} else {
unsigned char *c = RepAtom(at)->UStrOfAE;
if (c[1] != '\0') {
int32_t v;
c += get_utf8(c, 1, &v);
if (c[0] != '\0') {
Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2");
return FALSE;
}
tf = MkIntTerm((unsigned char)(c[0]));
}
tf = MkIntTerm(v);
return Yap_unify(ARG2, tf);
}
}
@ -1616,22 +1606,11 @@ static Int upcase_text_to_chars(USES_REGS1) {
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 */
static Int atom_split(USES_REGS1) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
size_t len;
int i;
Term to1, to2;
Atom at;
@ -1656,66 +1635,22 @@ static Int atom_split(USES_REGS1) {
return (FALSE);
}
at = AtomOfTerm(t1);
if (IsWideAtom(at)) {
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;
unsigned char *s, *s1, *s10;
s = RepAtom(at)->UStrOfAE;
if (len > (Int)strlen((char *)s))
if (len > (Int)strlen_utf8(s))
return (FALSE);
s1 = s10 = Malloc(len);
if (s1 + len > (unsigned char *)ASP - 1024)
Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4");
for (i = 0; i < len; i++) {
s1[i] = s[i];
}
s1[len] = '\0';
to1 = MkAtomTerm(Yap_ULookupAtom(s1));
to2 = MkAtomTerm(Yap_ULookupAtom(s + len));
size_t j;
for (j = 0; j < len; j++) {
int32_t val;
s += get_utf8(s,1,&val);
s1 += put_utf8(s,val);
}
s1[0] = '\0';
to1 = MkAtomTerm(Yap_ULookupAtom(s10));
to2 = MkAtomTerm(Yap_ULookupAtom(s));
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_AFTER 4
#define SUB_ATOM_HAS_VAL 8
#define SUB_ATOM_HAS_WIDE 16
#define SUB_ATOM_HAS_ATOM 16
#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,
size_t min, 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 {
size_t minv, size_t len USES_REGS) {
{
const unsigned char *src = p;
unsigned char *buf;
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;
buf = buf_from_tstring(HR);
@ -1823,6 +1725,8 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
len--;
}
*buf++ = '\0';
if (mask & SUB_ATOM_HAS_ATOM)
return MkAtomTerm( Yap_ULookupAtom(buf ) );
close_tstring(buf PASS_REGS);
return t;
@ -1830,257 +1734,132 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
return 0L;
}
static Int wcsstrcmp(wchar_t *p, char *p2, size_t len) {
while (len--) {
Int d = *p++ - *p2++;
if (d)
return d;
}
return 0;
}
static int check_sub_atom_at(int min, Atom at, Atom nat) {
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) {
p1 = skip_utf8((unsigned char *)p1, min);
static int check_sub_atom_at(int minv, Atom at, Atom nat, size_t len) {
const unsigned char *p1;
const unsigned char *p2 = RepAtom(nat)->UStrOfAE;
p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv);
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;
static int check_sub_string_at(int minv, const unsigned char *p1,
const unsigned char *p2, size_t len) {
p1 = skip_utf8((unsigned char *)p1, minv);
if (p1 == NULL || p2 == NULL)
return p1 == p2;
return cmpn_utf8(p1, p2, len) == 0;
}
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) {
size_t len = strlen_utf8(UStringOfTerm(nat));
int min = max - len;
int minv = max - len;
const unsigned char *p1, *p2;
int c1;
if ((Int)(min - len) < 0)
if ((Int)(minv - len) < 0)
return FALSE;
p1 = skip_utf8((unsigned char *)UStringOfTerm(at), min);
p1 = skip_utf8((unsigned char *)UStringOfTerm(at), minv);
p2 = UStringOfTerm(nat);
while ((c1 = *p1++) == *p2++ && c1)
;
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) {
Term tat1 = Deref(ARG1);
Atom at = NULL;
Term tat5 = Deref(ARG5);
int mask;
size_t min, len, after, sz;
size_t minv, len, after, sz;
wchar_t *wp = NULL;
const unsigned char *p = NULL;
const unsigned char *p = NULL, *p5 = NULL;
Term nat;
int sub_atom = TRUE;
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));
after = IntegerOfTerm(EXTRA_CBACK_ARG(5, 4));
sz = IntegerOfTerm(EXTRA_CBACK_ARG(5, 5));
if (mask & SUB_ATOM_HAS_UTF8) {
sub_atom = FALSE;
p = UStringOfTerm(tat1);
} else if (mask & SUB_ATOM_HAS_WIDE) {
at = AtomOfTerm(tat1);
wp = RepAtom(at)->WStrOfAE;
if (!IsVarTerm(tat1)) {
if (IsAtomTerm(tat1)) {
p = AtomOfTerm(tat1)->UStrOfAE;
} else {
at = AtomOfTerm(tat1);
p = RepAtom(at)->UStrOfAE;
p = UStringOfTerm(tat1);
}
}
if (!IsVarTerm(tat5)) {
if (IsAtomTerm(tat5)) {
p5 = AtomOfTerm(tat5)->UStrOfAE;
} else {
p5 = UStringOfTerm(tat5);
}
}
/* we can have one of two cases: A5 bound or unbound */
if (mask & SUB_ATOM_HAS_VAL) {
int found = FALSE;
nat = Deref(ARG5);
if (mask & SUB_ATOM_HAS_WIDE) {
wp = RepAtom(at)->WStrOfAE;
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));
{
const unsigned char *p1 = p;
while (!found) {
p = skip_utf8((unsigned char *)p1, min);
p = skip_utf8(p1, minv);
if (cmpn_utf8(p, p5, len) == 0) {
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG2, MkIntegerTerm(minv));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
found = TRUE;
/* found one, check if there is any left */
while (min <= sz - len) {
while (minv <= sz - len) {
int chr;
p += get_utf8((unsigned char *)p, -1, &chr);
after--;
min++;
minv++;
if (cmpn_utf8(p, UStringOfTerm(nat), len) == 0)
break;
}
} else {
if (min == sz - len)
if (minv == sz - len)
break;
after--;
min++;
minv++;
}
}
}
if (found) {
if (min > sz - len)
if (minv > sz - len)
cut_succeed();
} else {
cut_fail();
}
} else if (mask & SUB_ATOM_HAS_SIZE) {
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(min));
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(minv));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, nat);
min++;
minv++;
if (after-- == 0)
cut_succeed();
} else if (mask & SUB_ATOM_HAS_MIN) {
after = sz - (min + len);
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
after = sz - (minv + len);
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, nat);
@ -2088,53 +1867,66 @@ static Int cont_sub_atomic(USES_REGS1) {
if (after-- == 0)
cut_succeed();
} else if (mask & SUB_ATOM_HAS_AFTER) {
len = sz - (min + after);
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(min));
len = sz - (minv + after);
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(minv));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG5, nat);
min++;
minv++;
if (len-- == 0)
cut_succeed();
} else {
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(min));
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
Yap_unify(ARG2, MkIntegerTerm(minv));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, nat);
len++;
if (after-- == 0) {
if (min == sz)
if (minv == sz)
cut_succeed();
min++;
minv++;
len = 0;
after = sz - min;
after = sz - minv;
}
}
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, 4) = MkIntegerTerm(after);
EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz);
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;
int mask = 0;
size_t min, len, after, sz;
int mask = SUB_ATOM_HAS_UTF8;
size_t minv, len, after, sz;
wchar_t *wp = NULL;
unsigned char *p = NULL;
const unsigned char *p = NULL;
int bnds = 0;
Term nat = 0L;
Atom at = NULL;
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);
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;
} else if (sub_atom && !IsAtomTerm(tat1)) {
} else if (IsAtomTerm(tat1)) {
Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5");
return FALSE;
} else if (!sub_atom && !IsStringTerm(tat1)) {
@ -2143,13 +1935,13 @@ static Int sub_atomic(int sub_atom USES_REGS) {
}
tbef = Deref(ARG2);
if (IsVarTerm(tbef)) {
min = 0;
minv = 0;
} else if (!IsIntegerTerm(tbef)) {
Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5");
return FALSE;
} else {
min = IntegerOfTerm(tbef);
if ((Int)min < 0) {
minv = IntegerOfTerm(tbef);
if ((Int)minv < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5");
return FALSE;
};
@ -2193,10 +1985,7 @@ static Int sub_atomic(int sub_atom USES_REGS) {
Atom oat;
mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE;
oat = AtomOfTerm(tout);
if (IsWideAtom(oat))
len = wcslen(RepAtom(oat)->WStrOfAE);
else
len = strlen((const char *)RepAtom(oat)->StrOfAE);
len = strlen_utf8(RepAtom(oat)->UStrOfAE);
}
} else {
if (!IsStringTerm(tout)) {
@ -2211,19 +2000,8 @@ static Int sub_atomic(int sub_atom USES_REGS) {
cut_fail();
bnds += 2;
}
if (sub_atom) {
at = AtomOfTerm(tat1);
if (IsWideAtom(at)) {
mask |= SUB_ATOM_HAS_WIDE;
wp = RepAtom(at)->WStrOfAE;
sz = wcslen(wp);
} else {
p = RepAtom(at)->UStrOfAE;
sz = strlen((const char *)p);
}
} else {
if (!IsVarTerm(tat1)) {
mask |= SUB_ATOM_HAS_UTF8;
p = (unsigned char *)StringOfTerm(tat1);
sz = strlen_utf8(p);
}
/* the problem is deterministic if we have two cases */
@ -2232,20 +2010,20 @@ static Int sub_atomic(int sub_atom USES_REGS) {
if ((mask & (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();
if ((Int)(after = (sz - (min + len))) < 0)
if ((Int)(after = (sz - (minv + len))) < 0)
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)
cut_fail();
out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat);
} else if ((mask & (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();
len = sz - (min + after);
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
len = sz - (minv + after);
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
if (!nat)
cut_fail();
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)) {
if (len + after > sz)
cut_fail();
min = sz - (len + after);
nat = build_new_atomic(mask, wp, p, min, len PASS_REGS);
minv = sz - (len + after);
nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS);
if (!nat)
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)) ==
(SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) {
if (sub_atom)
out = check_sub_atom_at(min, at, AtomOfTerm(nat));
out = check_sub_atom_at(minv, at, AtomOfTerm(nat), len);
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)) ==
(SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) {
if (sub_atom)
@ -2276,14 +2054,9 @@ static Int sub_atomic(int sub_atom USES_REGS) {
out = (strlen_utf8(UStringOfTerm(tout)) == len);
if (!out)
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 {
out = (strlen((const char *)RepAtom(AtomOfTerm(tout))->StrOfAE) == len);
out = (strlen_utf8(RepAtom(AtomOfTerm(tout))->UStrOfAE)
== len);
if (!out)
cut_fail();
}
@ -2295,7 +2068,7 @@ static Int sub_atomic(int sub_atom USES_REGS) {
cut_fail();
} else {
mask |= SUB_ATOM_HAS_SIZE;
min = 0;
minv = 0;
after = sz - len;
goto backtrackable;
}
@ -2305,15 +2078,15 @@ static Int sub_atomic(int sub_atom USES_REGS) {
cut_fail();
} else {
if (!(mask & SUB_ATOM_HAS_MIN))
min = 0;
minv = 0;
if (!(mask & SUB_ATOM_HAS_SIZE))
len = 0;
if (!(mask & SUB_ATOM_HAS_AFTER))
after = sz - (len + min);
after = sz - (len + minv);
}
backtrackable:
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, 4) = MkIntegerTerm(after);
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_.
*/
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
@ -2350,7 +2123,7 @@ are unbound, the built-in will generate all possible
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) {
Atom catom;
@ -2428,88 +2201,9 @@ static Int current_atom(USES_REGS1) { /* current_atom(?Atom) */
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) {
Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom,
SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$current_wide_atom", 1, 2, current_wide_atom,
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,
0);

9
C/blobs.c
View File

@ -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) {
if (!IsBlob(x)) {
if (IsWideAtom(x)) {
if (len)
*len = wcslen(x->WStrOfAE);
if (type)
*type = &unregistered_blob_atom;
return x->WStrOfAE;
}
if (len)
*len = strlen((char *)x->StrOfAE);
*len = strlen_utf8(x->UStrOfAE);
if (type)
*type = &unregistered_blob_atom;
return x->StrOfAE;

67
C/c_interface.c
View File

@ -398,7 +398,16 @@ X_API Term YAP_MkAtomTerm(Atom n) {
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) {
const char *o;
@ -407,7 +416,20 @@ X_API const char *YAP_AtomName(Atom a) {
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) {
CACHE_REGS
@ -431,8 +453,9 @@ X_API Atom YAP_LookupWideAtom(const wchar_t *c) {
CACHE_REGS
Atom a;
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 (!Yap_locked_growheap(FALSE, 0, NULL)) {
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)) {
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;
return strlen((char *)c);
}
return strlen_utf8(c);
}
X_API Term YAP_MkVarTerm(void) {
@ -2260,6 +2278,9 @@ static void start_modules(void) {
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
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);
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
char boot_file[YAP_FILENAME_MAX + 1];
Int rc;
const char *yroot;
@ -2277,6 +2297,7 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
return YAP_FOUND_BOOT_ERROR;
initialized = true;
Yap_embedded = yap_init->Embedded;
Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by
later functions */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
@ -2346,6 +2367,7 @@ YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
//
CACHE_REGS
if (Yap_embedded)
if (yap_init->QuietMode) {
setVerbosity(TermSilent);
}
@ -3186,10 +3208,10 @@ size_t YAP_UTF8_TextLength(Term t) {
Term hd = HeadOfTerm(t);
if (IsAtomTerm(hd)) {
Atom at = AtomOfTerm(hd);
if (IsWideAtom(at))
c = RepAtom(at)->WStrOfAE[0];
else
c = RepAtom(at)->StrOfAE[0];
unsigned char *s = RepAtom(at)->UStrOfAE;
int32_t ch;
get_utf8(s, 1, &ch);
c = ch;
} else if (IsIntegerTerm(hd)) {
c = IntegerOfTerm(hd);
} else {
@ -3200,20 +3222,7 @@ size_t YAP_UTF8_TextLength(Term t) {
}
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) {
const wchar_t *s = RepAtom(at)->WStrOfAE;
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);
}
}
sz = strlen(RepAtom(at)->StrOfAE);
} else if (IsStringTerm(t)) {
sz = strlen(StringOfTerm(t));
}

33
C/cmppreds.c
View File

@ -81,38 +81,7 @@ static Int a_gen_ge(Term, Term);
#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
static int cmp_atoms(Atom a1, Atom a2) {
if (IsWideAtom(a1)) {
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);
}
return strcmp(RepAtom(a1)->StrOfAE, RepAtom(a2)->StrOfAE);
}
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,

20
C/compiler.c
View File

@ -1485,25 +1485,7 @@ static void c_goal(Term Goal, Term mod, compiler_struct *cglobs) {
PredEntry *p;
Prop p0;
if (IsVarTerm(Goal)) {
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;
}
Goal = Yap_YapStripModule( Goal, &mod);
if (IsVarTerm(Goal)) {
Goal = Yap_MkApplTerm(FunctorCall, 1, &Goal);
} else if (IsNumTerm(Goal)) {

2
C/init.c
View File

@ -98,6 +98,8 @@ int Yap_Portray_delays = FALSE;
#endif
#endif
void *YAP_save;
/**
@defgroup Operators Summary of YAP Predefined Operators

43
C/learn2 Normal file
View File

@ -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()

146
C/parser.c
View File

@ -138,11 +138,11 @@ dot with single quotes.
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "YapText.h"
#include "yapio.h"
#include "Yatom.h"
#include "eval.h"
#include "yapio.h"
/* stuff we want to use in standard YAP code */
#include "iopreds.h"
#if HAVE_STRING_H
@ -163,12 +163,12 @@ dot with single quotes.
typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF;
static void GNextToken(CACHE_TYPE1);
static void checkfor(wchar_t, JMPBUFF *, encoding_t CACHE_TYPE);
static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE);
static void checkfor(Term, JMPBUFF *, encoding_t 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 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, ...) {
CACHE_REGS
@ -225,16 +225,21 @@ static void syntax_msg(const char *msg, ...) {
#define FAIL siglongjmp(FailBuff->JmpBuff, 1)
VarEntry *
Yap_LookupVar(const char *var) /* lookup variable in variables table */
Yap_LookupVar(const char *var) /* lookup variable in variables table
* */
{
CACHE_REGS
VarEntry *p;
int32_t ch;
const unsigned char *v1 = var;
#if DEBUG
if (GLOBAL_Option[4])
fprintf(stderr, "[LookupVar %s]", var);
#endif
if (var[0] != '_' || var[1] != '\0') {
v1 = v1 + get_utf8(v1, 1, &ch);
if (ch != '_' || v1[0] != '\0') {
VarEntry **op = &LOCAL_VarTable;
UInt hv;
@ -262,7 +267,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table */
p = p->VarRight;
}
}
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + 1+ sizeof(VarEntry));
*op = p;
p->VarLeft = p->VarRight = NULL;
p->hv = hv;
@ -270,7 +275,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table */
strcpy(p->VarRep, var);
} else {
/* anon var */
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 2);
p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 3);
p->VarLeft = LOCAL_AnonVarTable;
LOCAL_AnonVarTable = p;
p->VarRight = NULL;
@ -393,7 +398,8 @@ int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) {
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;
OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS);
@ -458,12 +464,14 @@ inline static void GNextToken(USES_REGS1) {
LOCAL_tokptr = LOCAL_tokptr->TokNext;
}
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c) {
inline static void checkfor(Term c, JMPBUFF *FailBuff,
encoding_t enc USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != c) {
char s[1024];
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;
}
NextToken;
@ -471,7 +479,8 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff, encoding_t enc USES_RE
#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
Term m = cmod, t;
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*/
static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
Term arg1, encoding_t enc, Term cmod USES_REGS) {
static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1,
encoding_t enc, Term cmod USES_REGS) {
int nargs = 0;
Term *p, t;
Functor func;
@ -566,7 +575,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff,
++nargs;
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok))
break;
if (((int)LOCAL_tokptr->TokInfo) != ',')
if (LOCAL_tokptr->TokInfo != TermComma)
break;
NextToken;
}
@ -625,7 +634,7 @@ loop:
HR += 2;
to_store[0] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int)LOCAL_tokptr->TokInfo) == ',') {
if (LOCAL_tokptr->TokInfo == TermComma) {
NextToken;
{
/* check for possible overflow against local stack */
@ -638,21 +647,22 @@ loop:
goto loop;
}
}
} else if (((int)LOCAL_tokptr->TokInfo) == '|') {
} else if (LOCAL_tokptr->TokInfo == TermVBar) {
NextToken;
to_store[1] = ParseTerm(999, FailBuff, enc, cmod PASS_REGS);
} else {
to_store[1] = MkAtomTerm(AtomNil);
}
} else {
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",LOCAL_tokptr->TokPos,
Yap_tokRep(LOCAL_tokptr, enc));
syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'",
LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc));
FAIL;
}
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 */
Volatile Term t;
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) ||
Unsigned(LOCAL_tokptr->TokInfo) != 'l') &&
IsPrefixOp((Atom)t, &opprio, &oprprio, cmod PASS_REGS)) {
LOCAL_tokptr->TokInfo != Terml) &&
IsPrefixOp(AtomOfTerm(t), &opprio, &oprprio, cmod PASS_REGS)) {
if (LOCAL_tokptr->Tok == Name_tok) {
Atom at = (Atom)LOCAL_tokptr->TokInfo;
Atom at = AtomOfTerm(LOCAL_tokptr->TokInfo);
#ifndef _MSC_VER
if ((Atom)t == AtomPlus) {
if (at == AtomInf) {
@ -716,11 +726,10 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
/* try to parse as a prefix operator */
TRY(
/* 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);
FAIL;
}
t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
} t = ParseTerm(oprprio, FailBuff, enc, cmod PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */
if (HR > ASP - 4096) {
@ -731,10 +740,9 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
}
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(LOCAL_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom)t, ')', FailBuff, 0L, enc, cmod PASS_REGS);
else
t = MkAtomTerm((Atom)t);
LOCAL_tokptr->TokInfo == Terml)
t = ParseArgs(AtomOfTerm(t), TermEndBracket, FailBuff, 0L, enc,
cmod PASS_REGS);
break;
case Number_tok:
@ -756,33 +764,34 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
break;
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;
case Ponctuation_tok:
switch ((int)LOCAL_tokptr->TokInfo) {
switch (RepAtom(AtomOfTerm(LOCAL_tokptr->TokInfo))->StrOfAE[0]) {
case '(':
case 'l': /* non solo ( */
NextToken;
t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS);
checkfor(')', FailBuff, enc PASS_REGS);
checkfor(TermEndBracket, FailBuff, enc PASS_REGS);
break;
case '[':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == ']') {
LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
t = TermNil;
NextToken;
break;
}
t = ParseList(FailBuff, enc, cmod PASS_REGS);
checkfor(']', FailBuff, enc PASS_REGS);
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
break;
case '{':
NextToken;
if (LOCAL_tokptr->Tok == Ponctuation_tok &&
(int)LOCAL_tokptr->TokInfo == '}') {
(int)LOCAL_tokptr->TokInfo == TermEndSquareBracket) {
t = MkAtomTerm(AtomBraces);
NextToken;
break;
@ -794,10 +803,11 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos);
FAIL;
}
checkfor('}', FailBuff, enc PASS_REGS);
checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS);
break;
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;
}
break;
@ -888,21 +898,22 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
NextToken;
break;
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;
}
/* main loop to parse infix and posfix operators starts here */
while (true) {
if (LOCAL_tokptr->Tok == Ord(Name_tok) &&
Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo);
Yap_HasOp(AtomOfTerm(LOCAL_tokptr->TokInfo))) {
Atom save_opinfo = opinfo = AtomOfTerm(LOCAL_tokptr->TokInfo);
if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */
Volatile int oldprio = curprio;
TRY3(
func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 2);
if (func == NULL) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
FAIL;
@ -922,10 +933,10 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
opinfo = save_opinfo; continue;, opinfo = save_opinfo;
curprio = oldprio;)
}
if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) && opprio <= prio &&
oplprio >= curprio) {
if (IsPosfixOp(opinfo, &opprio, &oplprio, cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
/* 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) {
syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos);
FAIL;
@ -943,8 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
break;
}
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(LOCAL_tokptr->TokInfo) == ',' && prio >= 1000 &&
curprio <= 999) {
if (LOCAL_tokptr->TokInfo == TermDot && prio >= 1000 && curprio <= 999) {
Volatile Term args[2];
NextToken;
args[0] = t;
@ -957,8 +967,9 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
}
curprio = 1000;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, cmod PASS_REGS) &&
} else if (LOCAL_tokptr->TokInfo == TermVBar &&
IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio,
cmod PASS_REGS) &&
opprio <= prio && oplprio >= curprio) {
Volatile Term args[2];
NextToken;
@ -972,32 +983,37 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, Term cmod USE
}
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, cmod PASS_REGS) &&
} else if (LOCAL_tokptr->TokInfo == TermBeginBracket &&
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio,
cmod PASS_REGS) &&
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;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio,
&oplprio, cmod PASS_REGS) &&
} else if (LOCAL_tokptr->TokInfo == TermBeginSquareBracket &&
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio,
cmod PASS_REGS) &&
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);
curprio = opprio;
continue;
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio,
&oplprio, cmod PASS_REGS) &&
} else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket &&
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio,
cmod PASS_REGS) &&
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);
curprio = opprio;
continue;
}
}
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;
}
break;

1047
C/pold.c Executable file
View File

File diff suppressed because it is too large Load Diff

17
C/qlyr.c
View File

@ -688,22 +688,7 @@ static void ReadHash(FILE *stream) {
Atom at;
qlf_tag_t tg = read_tag(stream);
if (tg == QLY_ATOM_WIDE) {
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) {
if (tg == QLY_ATOM) {
char *rep = (char *)AllocTempSpace();
UInt len;

7
C/qlyw.c
View File

@ -505,7 +505,6 @@ DBRefAdjust__ (DBRef dbt USES_REGS)
#define rehash(oldcode, NOfE, KindOfEntries)
#define RestoreSWIHash()
static void RestoreFlags( UInt NFlags )
{
@ -584,17 +583,11 @@ SaveHash(FILE *stream)
if (a->val) {
Atom at = a->val;
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_UInt(stream, strlen((char *)RepAtom(at)->StrOfAE)));
CHECK(save_bytes(stream, (char *)at->StrOfAE, (strlen((char *)at->StrOfAE)+1)*sizeof(char)));
}
}
}
save_tag(stream, QLY_START_FUNCTORS);
save_UInt(stream, LOCAL_ExportFunctorHashTableNum);
for (i = 0; i < LOCAL_ExportFunctorHashTableSize; i++) {

404
C/scanner.c
View File

@ -435,7 +435,7 @@ writing, writing a BOM can be requested using the option
#define my_islower(C) (C >= 'a' && C <= 'z')
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) {
CACHE_REGS
@ -880,15 +880,34 @@ static int num_send_error_message(char s[]) {
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 */
static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
UInt max_size, int sign) {
char *sp = s;
static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, int sign) {
int ch = *chp;
Int val = 0L, base = ch - '0';
int might_be_float = TRUE, has_overflow = FALSE;
const unsigned char *decimalpoint;
char buf0[256], *sp = buf0, *buf = buf0;
int max_size = 254, left = 254;
*sp++ = ch;
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) {
*sp++ = ch;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
base = 10 * base + ch - '0';
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");
}
might_be_float = FALSE;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
ch = getchr(inp_stream);
if (base == 0) {
@ -939,9 +956,8 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
int chval =
(chtype(ch) == NU ? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
val = oval * base + chval;
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) {
might_be_float = FALSE;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
ch = getchr(inp_stream);
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 =
(chtype(ch) == NU ? ch - '0'
: (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
val = val * 16 + chval;
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) {
Int oval = val;
if (!(val == 0 && ch == '0') || has_overflow) {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
}
if (ch - '0' >= base) {
@ -1019,7 +1032,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
*chbuffp = '.';
*chp = ch;
if (has_overflow)
return read_int_overflow(s, base, val, sign);
return read_int_overflow(buf, base, val, sign);
if (sign == -1)
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 */
while ((dc = *dp++) != '\0') {
*sp++ = dc;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
}
/* numbers after . */
if (chtype(ch) == NU) {
do {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
} while (chtype(ch = getchr(inp_stream)) == NU);
}
}
if (ch == 'e' || ch == 'E') {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
ch = getchr(inp_stream);
if (ch == '-') {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = '-';
ch = getchr(inp_stream);
} else if (ch == '+') {
@ -1066,34 +1075,33 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
if (chtype(ch) != NU) {
CACHE_REGS
if (has_dot)
return float_send(s, sign);
return float_send(buf, sign);
return MkIntegerTerm(sign * val);
}
do {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
if (--left == 0)
number_overflow();
*sp++ = ch;
} while (chtype(ch = getchr(inp_stream)) == NU);
}
*sp = '\0';
*chp = ch;
return float_send(s, sign);
return float_send(buf, sign);
} else if (has_overflow) {
*sp = '\0';
/* skip base */
*chp = ch;
if (s[0] == '0' && s[1] == 'x')
return read_int_overflow(s + 2, 16, val, sign);
else if (s[0] == '0' && s[1] == 'o')
return read_int_overflow(s + 2, 8, val, sign);
else if (s[0] == '0' && s[1] == 'b')
return read_int_overflow(s + 2, 2, val, sign);
if (s[1] == '\'')
return read_int_overflow(s + 2, base, val, sign);
if (s[2] == '\'')
return read_int_overflow(s + 3, base, val, sign);
return read_int_overflow(s, base, val, sign);
if (buf[0] == '0' && buf[1] == 'x')
return read_int_overflow(buf + 2, 16, val, sign);
else if (buf[0] == '0' && buf[1] == 'o')
return read_int_overflow(buf + 2, 8, val, sign);
else if (buf[0] == '0' && buf[1] == 'b')
return read_int_overflow(buf + 2, 2, val, sign);
if (buf[1] == '\'')
return read_int_overflow(buf + 2, base, val, sign);
if (buf[2] == '\'')
return read_int_overflow(buf + 3, base, val, sign);
return read_int_overflow(buf, base, val, sign);
} else {
CACHE_REGS
*chp = ch;
@ -1120,9 +1128,11 @@ Term Yap_scan_num(StreamDesc *inp) {
return 0;
}
#if HAVE_ISWBLANK
while (iswblank( ch = getchr(inp) ));
while (iswblank(ch = getchr(inp)))
;
#else
while (isspace( ch = getchr(inp) ));
while (isspace(ch = getchr(inp)))
;
#endif
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokPos = GetCurInpPos(inp);
@ -1140,7 +1150,7 @@ Term Yap_scan_num(StreamDesc *inp) {
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
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) {
CACHE_REGS
@ -1174,7 +1184,7 @@ Term Yap_scan_num(StreamDesc *inp) {
size_t len = strlen(ptr);
mp = AllocScannerMemory(len + 1);
tokptr->Tok = Ord(kind = String_tok);
tokptr->TokInfo = Unsigned(mp);
tokptr->TokInfo = MkStringTerm(mp);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
ef = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokNext = e;
@ -1214,60 +1224,35 @@ Term Yap_scan_num(StreamDesc *inp) {
return l; \
}
const char *Yap_tokRep(TokEntry *tokptr, encoding_t encoding) {
const char *Yap_tokRep(void *tokptre, encoding_t encoding) {
CACHE_REGS
TokEntry *tokptr = tokptre;
Term info = tokptr->TokInfo;
char *buf = LOCAL_FileNameBuf2;
size_t length;
UInt flags = 0;
switch (tokptr->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 Ponctuation_tok:
case String_tok:
case BQString_tok:
case WString_tok:
case WBQString_tok: {
return Yap_TermToString(info, &length, encoding, flags);
}
case Var_tok: {
VarEntry *varinfo = (VarEntry *)info;
varinfo->VarAdr = TermNil;
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:
return "<ERR>";
case eot_tok:
return "<EOT>";
case Ponctuation_tok: {
buf[1] = '\0';
if ((info) == 'l') {
buf[0] = '(';
} else {
buf[0] = (char)info;
}
}
return buf;
case QuasiQuotes_tok:
case WQuasiQuotes_tok:
return "<QQ>";
default:
return "??";
}
}
@ -1319,52 +1304,8 @@ static void mark_eof(struct stream_desc *inp_stream) {
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) \
if (wcharp) { \
*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); \
} \
}
{ charp += put_utf8(charp, ch); }
TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
Term *tposp) {
@ -1373,8 +1314,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int ch;
wchar_t *wcharp;
int32_t ch, och;
struct qq_struct_t *cur_qq = NULL;
InitScannerMemory();
@ -1391,11 +1331,10 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
LOCAL_StartLineCount = inp_stream->linecount;
LOCAL_StartLinePos = inp_stream->linepos;
do {
wchar_t och, pch;
int quote, isvar;
char *charp, *mp;
unsigned char *charp, *mp;
unsigned int len;
char *TokImage = NULL;
unsigned char *TokImage = NULL;
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
t->TokNext = NULL;
@ -1417,14 +1356,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case CC:
if (store_comments) {
CHECK_SPACE();
open_comment(ch, inp_stream PASS_REGS);
continue_comment:
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) {
CHECK_SPACE();
extend_comment(ch PASS_REGS);
}
CHECK_SPACE();
extend_comment(ch PASS_REGS);
if (chtype(ch) != EF) {
ch = getchr(inp_stream);
@ -1445,7 +1381,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
while (chtype(ch) == BS) {
ch = getchr(inp_stream);
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream);
}
@ -1459,27 +1394,31 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case UC:
case UL:
case LC:
och = ch;
case LC: {
int32_t och = ch;
ch = getchr(inp_stream);
size_t sz = 512;
scan_name:
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage;
wcharp = NULL;
TokImage = Malloc(sz PASS_REGS);
charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC);
add_ch_to_buff(och);
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
if (charp == (char *)AuxSp - 1024) {
huge_var_error:
return AuxSpaceError(p, l, "Code Space Overflow due to huge atom");
/* huge atom or variable, we are in trouble */
if (charp == TokImage + (sz - 1)) {
unsigned char *p0 = TokImage;
sz = min(sz * 2, sz + MBYTE);
TokImage = Realloc(p0, sz);
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
}
charp = TokImage - (charp - p0);
}
add_ch_to_buff(ch);
}
while (ch == '\'' && isvar &&
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
if (charp == (char *)AuxSp - 1024) {
goto huge_var_error;
if (charp == (unsigned char *)AuxSp - 1024) {
return CodeSpaceError(t, p, l);
}
add_ch_to_buff(ch);
ch = getchr(inp_stream);
@ -1488,42 +1427,34 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
if (!isvar) {
Atom ae;
/* don't do this in iso */
if (wcharp) {
ae = Yap_LookupWideAtom((wchar_t *)TokImage);
} else {
ae = Yap_LookupAtom(TokImage);
}
ae = Yap_ULookupAtom(TokImage);
Free(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
}
t->TokInfo = Unsigned(ae);
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->TokInfo = MkAtomTerm(ae);
if (ch == '(')
solo_flag = FALSE;
t->Tok = Ord(kind = Name_tok);
} else {
VarEntry *ve = Yap_LookupVar(TokImage);
VarEntry *ve = Yap_LookupVar((const char *)TokImage);
Free(TokImage);
t->TokInfo = Unsigned(ve);
if (cur_qq) {
ve->refs++;
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = Var_tok);
}
break;
} break;
case NU: {
int cherr;
int cha = ch;
char *ptr;
cherr = 0;
if (!(ptr = AllocScannerMemory(4096))) {
return TrailSpaceError(t, l);
}
CHECK_SPACE();
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, ptr, 4096, 1)) ==
0L) {
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, 1)) == 0L) {
if (p) {
p->Tok = eot_tok;
t->TokInfo = TermError;
@ -1531,7 +1462,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
/* serious error now */
return l;
}
PopScannerMemory(ptr, 4096);
ch = cha;
if (cherr) {
TokEntry *e;
@ -1560,7 +1490,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
TokEntry *e2;
t->Tok = Ord(Var_tok);
t->TokInfo = Unsigned(Yap_LookupVar("E"));
t->TokInfo = (Term)Yap_LookupVar("E");
t->TokPos = GetCurInpPos(inp_stream);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
@ -1586,7 +1516,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->Tok = Name_tok;
if (ch == '(')
solo_flag = FALSE;
t->TokInfo = Unsigned(AtomE);
t->TokInfo = MkAtomTerm(AtomE);
t->TokPos = GetCurInpPos(inp_stream);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
@ -1610,18 +1540,19 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case QT:
case DC:
quoted_string:
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
TokImage = Malloc(1048);
charp = TokImage;
quote = ch;
len = 0;
ch = getchrq(inp_stream);
wcharp = NULL;
size_t sz = 1024;
while (TRUE) {
if (charp + 1024 > (char *)AuxSp) {
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
LOCAL_ErrorMessage =
"Heap Overflow While Scanning: please increase code space (-h)";
if (charp > TokImage + (sz - 1)) {
TokImage = Realloc(TokImage, min(sz * 2, sz + MBYTE));
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
}
break;
}
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {
@ -1645,66 +1576,35 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
if (scan_next) {
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 {
add_ch_to_buff(ch);
ch = getchrq(inp_stream);
}
++len;
if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */
return AuxSpaceError(
t, l, "not enough space to read in string or quoted atom");
}
}
if (wcharp) {
*wcharp = '\0';
} else {
*charp = '\0';
}
if (quote == '"') {
if (wcharp) {
t->TokInfo = Yap_WCharsToTDQ((wchar_t *)TokImage,
CurrentModule
PASS_REGS);
} else {
t->TokInfo = Yap_CharsToTDQ(TokImage, CurrentModule, LOCAL_encoding
PASS_REGS);
}
t->TokInfo = Yap_CharsToTDQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
Free(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);
}
t->TokInfo = Yap_CharsToTBQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
Free(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));
}
t->TokInfo = MkAtomTerm(Yap_ULookupAtom(TokImage));
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
Free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1713,7 +1613,9 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case BS:
if (ch == '\0') {
int pch;
t->Tok = Ord(kind = eot_tok);
pch = Yap_peek(inp_stream - GLOBAL_Stream);
if (chtype(pch) == EF) {
mark_eof(inp_stream);
t->TokInfo = TermEof;
@ -1725,7 +1627,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
} else
ch = getchr(inp_stream);
break;
case SY:
case SY: {
int pch;
if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) &&
(chtype(pch) == BS || chtype(pch) == EF || pch == '%')) {
t->Tok = Ord(kind = eot_tok);
@ -1803,6 +1706,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
}
goto restart;
}
}
enter_symbol:
if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
t->Tok = Ord(kind = eot_tok);
@ -1819,31 +1723,29 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
return l;
} else {
Atom ae;
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
size_t sz = 1024;
TokImage = Malloc(sz);
charp = TokImage;
wcharp = NULL;
add_ch_to_buff(och);
for (; chtype(ch) == SY; ch = getchr(inp_stream)) {
if (charp == (char *)AuxSp - 1024) {
goto huge_var_error;
if (charp >= TokImage + (sz - 10)) {
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('\0');
if (wcharp) {
ae = Yap_LookupWideAtom((wchar_t *)TokImage);
} else {
ae = Yap_LookupAtom(TokImage);
}
ae = Yap_ULookupAtom(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
}
t->TokInfo = Unsigned(ae);
t->TokInfo = MkAtomTerm(ae);
if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
Free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1853,11 +1755,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
break;
case SL: {
char chs[2];
unsigned char chs[2];
chs[0] = ch;
chs[1] = '\0';
ch = getchr(inp_stream);
t->TokInfo = Unsigned(Yap_LookupAtom(chs));
t->TokInfo = MkAtomTerm(Yap_ULookupAtom(chs));
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = FALSE;
@ -1866,19 +1768,25 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case BK:
och = ch;
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 == '(') {
while (chtype(ch) == BS) {
ch = getchr(inp_stream);
};
}
if (ch == ')') {
t->TokInfo = Unsigned(AtomEmptyBrackets);
t->TokInfo = TermEmptyBrackets;
t->Tok = Ord(kind = Name_tok);
ch = getchr(inp_stream);
solo_flag = FALSE;
break;
} else if (!solo_flag) {
t->TokInfo = 'l';
t->TokInfo = Terml;
solo_flag = TRUE;
}
} else if (och == '[') {
@ -1886,7 +1794,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
ch = getchr(inp_stream);
};
if (ch == ']') {
t->TokInfo = Unsigned(AtomNil);
t->TokInfo = TermNil;
t->Tok = Ord(kind = Name_tok);
ch = getchr(inp_stream);
solo_flag = FALSE;
@ -1930,7 +1838,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
ch = getchr(inp_stream);
};
if (ch == '}') {
t->TokInfo = Unsigned(AtomBraces);
t->TokInfo = TermBraces;
t->Tok = Ord(kind = Name_tok);
ch = getchr(inp_stream);
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;
t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(inp_stream);
TokImage = Yap_PreAllocCodeSpace();
sz = 1024;
TokImage = Malloc(sz);
if (!TokImage) {
LOCAL_ErrorMessage =
"not enough heap space to read in a quasi quoted atom";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
return l;
@ -1973,35 +1880,34 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
quote = ch;
len = 0;
ch = getchrq(inp_stream);
wcharp = NULL;
while (TRUE) {
if (ch == '|') {
ch = getchrq(inp_stream);
if (ch != '}') {
} else {
charp = (char *)put_utf8((unsigned char *)charp, och);
charp = (char *)put_utf8((unsigned char *)charp, ch);
charp += put_utf8((unsigned char *)charp, och);
charp += put_utf8((unsigned char *)charp, ch);
/* we're done */
break;
}
} else if (chtype(ch) == EF) {
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
Free(TokImage);
mark_eof(inp_stream);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
break;
} else {
charp = (char *)put_utf8((unsigned char *)charp, ch);
charp += put_utf8(charp, ch);
ch = getchrq(inp_stream);
}
if (charp > (char *)AuxSp - 1024) {
if (charp > (unsigned char *)AuxSp - 1024) {
/* Not enough space to read in the string. */
return AuxSpaceError(
t, l, "not enough space to read in string or quoted atom");
}
}
len = charp - TokImage;
len = charp - (unsigned char *)TokImage;
mp = malloc(len + 1);
if (mp == NULL) {
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;
return l;
}
strncpy(mp, TokImage, len + 1);
strncpy((char *)mp, (const char *)TokImage, len + 1);
qq->text = (unsigned char *)mp;
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (inp_stream->status & Seekable_Stream_f) {

33
C/stdpreds.c
View File

@ -1099,24 +1099,25 @@ void Yap_show_statistics(void) {
#endif
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",
(unsigned long int)(Unsigned(H0) - Unsigned(Yap_HeapBase)),
(unsigned long int)(Unsigned(HeapTop) - Unsigned(Yap_HeapBase)),
(unsigned long int)(HeapUsed), frag);
fprintf(stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - H0)),
(unsigned long int)(sizeof(CELL) * (HR - H0)),
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)));
fprintf(stderr, "Trail Space: %ld (%ld used).\n",
(unsigned long int)(sizeof(tr_fr_ptr) * (Unsigned(LOCAL_TrailTop) -
Unsigned(LOCAL_TrailBase))),
(unsigned long int)(sizeof(tr_fr_ptr) *
(Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
fprintf(stderr, "Runtime: %lds.\n", (unsigned long int)(runtime(PASS_REGS1)));
fprintf(stderr, "Cputime: %lds.\n", (unsigned long int)(Yap_cputime()));
Unsigned(H0) - Unsigned(Yap_HeapBase),
Unsigned(HeapTop) - Unsigned(Yap_HeapBase), Unsigned(HeapUsed), frag);
fprintf(stderr, "Stack Space: " UInt_FORMAT " (" UInt_FORMAT
" for Global, " UInt_FORMAT " for local).\n",
Unsigned(sizeof(CELL) * (LCL0 - H0)),
Unsigned(sizeof(CELL) * (HR - H0)),
Unsigned(sizeof(CELL) * (LCL0 - ASP)));
fprintf(
stderr, "Trail Space: " UInt_FORMAT " (" UInt_FORMAT " used).\n",
Unsigned(sizeof(tr_fr_ptr) *
(Unsigned(LOCAL_TrailTop) - Unsigned(LOCAL_TrailBase))),
Unsigned(sizeof(tr_fr_ptr) * (Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
fprintf(stderr, "Runtime: " UInt_FORMAT "\n", runtime(PASS_REGS1));
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) {

247
C/text.c
View File

@ -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)
#endif
#ifndef MAX_PATHHNAME
#define MAX_PATHHNAME 1024
#endif
#define MAX_PATHNAME 2048
void
Yap_InitTextAllocator( void )
{
struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+MAX_PATHHNAME*2 );
new->prev = NULL;
new->ptr = new->buf = (struct TextBuffer_manager *)new+1;
LOCAL_TextBuffer = new;
struct mblock {
struct mblock *prev, *next;
int lvl;
size_t sz;
};
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) {
@ -111,14 +213,6 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp,
if (*atoms < length) {
*tailp = l;
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 {
AtomEntry *ae = RepAtom(AtomOfTerm(hd));
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;
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
if (n < 0) {
LOCAL_Error_TYPE = -n;
return NULL;
}
*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
// Yap_DebugPlWriteln(inp->val.t);
Atom at = AtomOfTerm(inp->val.t);
if (IsWideAtom(at)) {
inp->val.w = at->WStrOfAE;
return wchar2utf8(inp, lengp);
} else {
inp->val.c = at->StrOfAE;
return latin2utf8(inp, lengp);
}
inp->val.uc = at->UStrOfAE;
}
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// 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;
else
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) {
AUX_ERROR(inp->val.t, 2 * (MAX_PATHNAME), s, char);
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
}
*lengp = strlen(s);
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 *cp = s;
wchar_t w[2];
w[1] = '\0';
unsigned char w[10], *wp = w;
LOCAL_TERM_ERROR(t, 2 * (lim - s));
while (cp < lim && *cp) {
utf8proc_int32_t chr;
CELL *cl;
cp += get_utf8(cp, -1, &chr);
if (chr == '\0')
s += get_utf8(s, 1, &chr);
if (chr == '\0') {
wp[0] = '\0';
break;
w[0] = chr;
}
wp += put_utf8(w, chr);
cl = HR;
HR += 2;
cl[0] = MkAtomTerm(Yap_LookupMaybeWideAtom(w));
cl[0] = MkAtomTerm(Yap_ULookupAtom(w));
cl[1] = AbsPair(HR);
sz++;
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) {
{
unsigned char *s = s0;
utf8proc_int32_t chr;
while (*s && get_utf8(s, -1, &chr) == 1)
s++;
if (*s == '\0')
return out->val.a = Yap_LookupAtom((char *)s0);
s = s0;
size_t l = strlen(s0);
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;
int32_t ch;
if (strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0);
} else {
size_t n = get_utf8(s, 1, &ch);
unsigned char *buf = Malloc(n + 1);
memcpy(buf, s0, n + 1);
return Yap_ULookupAtom(buf);
}
}
@ -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) {
Term t;
mark_stack();
int i = push_text_stack();
t = Yap_StringToNumberTerm((char *)s, &out->enc);
restore_stack();
pop_text_stack(i);
return t;
}
static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
Term o;
mark_stack();
int i = push_text_stack();
o = out->val.t =
Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, NULL);
restore_stack();
pop_text_stack(i);
return o;
}
@ -762,9 +833,9 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
bool rc;
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
|YAP_STRING_STRING))
//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) {
unprotect_stack(NULL);
pop_text_stack( l);
return 0L;
}
if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
if (out->type & YAP_STRING_UPCASE) {
if (!upcase(buf, out)) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
}
if (out->type & YAP_STRING_DOWNCASE) {
if (!downcase(buf, out)) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
}
}
rc = write_Text(buf, out, leng PASS_REGS);
unprotect_stack(out);
pop_text_stack(l);
/* fprintf(stderr, " -> ");
if (!rc) fprintf(stderr, "NULL");
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;
size_t leng;
int i;
init_alloc(__LINE__);
int l = push_text_stack(PASS_REGS1);
bufv = Malloc(tot * sizeof(unsigned char *));
if (!bufv) {
unprotect_stack(NULL);
pop_text_stack( l);
return NULL;
}
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);
if (!nbuf) {
unprotect_stack(NULL);
pop_text_stack( l);
return NULL;
}
bufv[i] = nbuf;
}
buf = concat(tot, bufv PASS_REGS);
bool rc = write_Text(buf, out, leng PASS_REGS);
unprotect_stack(out);
pop_text_stack(l);
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,
seq_tv_t outv[] USES_REGS) {
unsigned char *buf;
int lvl = push_text_stack(PASS_REGS1);
size_t l;
init_alloc(__LINE__);
inp->type |= YAP_STRING_IN_TMP;
buf = Yap_readText(inp, &l PASS_REGS);
if (!buf) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
@ -919,11 +991,11 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
if (outv[0].val.t) {
buf0 = Yap_readText(outv, &l0 PASS_REGS);
if (!buf0) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
if (cmp_Text(buf, buf0, l0) != 0) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
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);
bool rc = write_Text(buf1, outv + 1, l1 PASS_REGS);
if (!rc) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
unprotect_stack((outv + 1));
pop_text_stack(lvl);
return rc;
} else /* if (outv[1].val.t) */ {
buf1 = Yap_readText(outv + 1, &l1 PASS_REGS);
if (!buf1) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
l0 = l - l1;
if (cmp_Text(skip_utf8((const unsigned char *)buf, l0), buf1, l1) !=
0) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
buf0 = slice(0, l0, buf 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;
}
}
@ -963,11 +1035,11 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
next = cuts[i - 1];
void *bufi = slice(next, cuts[i], buf PASS_REGS);
if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) {
unprotect_stack(NULL);
pop_text_stack( l);
return false;
}
}
unprotect_stack(outv);
pop_text_stack(l);
return true;
}
@ -993,10 +1065,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) {
inp.val.t = t;
if (IsAtomTerm(t) && t != TermNil) {
inp.type = YAP_STRING_ATOM;
if (IsWideAtom(AtomOfTerm(t)))
inp.enc = ENC_WCHAR;
else
inp.enc = ENC_ISO_LATIN1;
inp.enc = ENC_ISO_UTF8;
} else if (IsStringTerm(t)) {
inp.type = YAP_STRING_STRING;
inp.enc = ENC_ISO_UTF8;

30
C/utilpreds.c
View File

@ -799,22 +799,12 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
ptr = (char *)AdjustSize((CELL*)ptr, buf);
p0 = ptr;
if (IsWideAtom(at)) {
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);
if (sz + 1 + sizeof(wchar_t) >= len)
if (sz + 1 >= len)
return (Atom)NULL;
strcpy(ptr, RepAtom(at)->StrOfAE);
*hpp = ptr+(sz+1);
}
return (Atom)(p0-buf);
}
@ -1179,10 +1169,8 @@ addAtom(Atom t, char *buf)
if (!*s) {
return Yap_LookupAtom(s+1);
} else {
wchar_t *w = (wchar_t *)s;
return Yap_LookupWideAtom(w+1);
}
return NULL;
}
static UInt
@ -3386,19 +3374,6 @@ addAtomToHash(CELL *st, Atom at)
{
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;
int ulen = strlen(c);
/* fix hashing over empty atom */
@ -3413,7 +3388,6 @@ addAtomToHash(CELL *st, Atom at)
}
st[len-1] = 0L;
strncpy((char *)st, c, ulen);
}
return st+len;
}

26
C/write.c
View File

@ -187,12 +187,6 @@ inline static void wrputs(char *s, StreamDesc *stream) {
wrputc(c, stream);
}
static void wrputws(wchar_t *s, wrf stream) /* writes a string */
{
while (*s)
wrputc(*s++, stream);
}
#ifdef USE_GMP
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);
return;
}
if (IsWideAtom(atom)) {
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;
s = RepAtom(atom)->UStrOfAE;
/* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE
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)) {
wrputc('\'', stream);
while (*s) {
wchar_t ch = *s++;
int32_t ch;
s += get_utf8(s, 1, &ch);
write_quoted(ch, '\'', stream);
}
wrputc('\'', stream);

1
CMakeLists.txt
View File

@ -9,6 +9,7 @@
project( YAP )
cmake_minimum_required(VERSION 2.8)
include(CMakeToolsHelpers OPTIONAL)
# cmake_policy(VERSION 3.4)

1684
CXX/_yap/__init__.c Normal file
View File

File diff suppressed because it is too large Load Diff

0
CXX/_yap/__init__.pxd Normal file
View File

0
CXX/_yap/__init__.py Normal file
View File

5233
CXX/_yap/dtypes.c Normal file
View File

File diff suppressed because it is too large Load Diff

142
CXX/_yap/dtypes.pxd Normal file
View File

@ -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 +

43
CXX/_yap/dtypes.pyx Normal file
View File

@ -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 //" ()

5234
CXX/_yap/stlcontainers.c Normal file
View File

File diff suppressed because it is too large Load Diff

30
CXX/_yap/stlcontainers.pxd Normal file
View File

@ -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

45
CXX/_yap/stlcontainers.pyx Normal file
View File

@ -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 //" ()

2276
CXX/_yap/tests/test_dtypes.c Normal file
View File

File diff suppressed because it is too large Load Diff

21
CXX/_yap/tests/test_dtypes.py Normal file
View File

@ -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()

2340
CXX/_yap/tests/test_stlcontainers.c Normal file
View File

File diff suppressed because it is too large Load Diff

23
CXX/_yap/tests/test_stlcontainers.py Normal file
View File

@ -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()

1962
CXX/_yap/xdress_extra_types.c Normal file
View File

File diff suppressed because it is too large Load Diff

62
CXX/_yap/xdress_extra_types.h Normal file
View File

@ -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

45
CXX/_yap/xdress_extra_types.pxd Normal file
View File

@ -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()

12
CXX/_yap/xdress_extra_types.pyx Normal file
View File

@ -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

2
CXX/yapi.cpp
View File

@ -875,6 +875,7 @@ YAPEngine::YAPEngine(char *savedState, char *bootFile, size_t stackSize,
size_t trailSize, size_t maxStackSize, size_t maxTrailSize,
char *libDir, char *goal, char *topLevel, bool script,
bool fastBoot,
bool embedded,
YAPCallback *cb)
: _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.HaltAfterConsult = script;
init_args.FastBoot = fastBoot;
init_args.Embedded = embedded;
doInit(BootMode);
}

11
CXX/yapq.hh
View File

@ -145,6 +145,7 @@ public:
size_t maxTrailSize = 0, char *libDir = (char *)NULL,
char *goal = (char *)NULL, char *topLevel = (char *)NULL,
bool script = FALSE, bool fastBoot = FALSE,
bool embedded = true,
YAPCallback *callback = (YAPCallback *)
NULL); /// construct a new engine, including aaccess to callbacks
/// construct a new engine using argc/argv list of arguments
@ -183,16 +184,6 @@ public:
bool goalt(YAPTerm t);
/// current directory for the engine
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
void reSet();
/// release: assune that there are no stack pointers, just release memory

8
H/ATOMS
View File

@ -29,6 +29,12 @@ A Arrow N "->"
A AttributedModule N "attributes_module"
A DoubleArrow N "-->"
A Assert 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 EmptyCurlyBrackets N "{}"
@ -68,6 +74,7 @@ A Chars N "chars"
A Charset N "charset"
A ChType F "$char_type"
A CleanCall F "$clean_call"
A Close N "close"
A Colon N ":"
A CodeSpace N "code_space"
A Codes N "codes"
@ -201,6 +208,7 @@ A Integer N "integer"
A InternalCompilerError N "internal_compiler_error"
A Is N "is"
A J N "j"
A l N "l"
A Key N "key"
A LDLibraryPath N "LD_LIBRARY_PATH"
A LONGINT N "LongInt"

3
H/Atoms.h
View File

@ -59,7 +59,6 @@ typedef struct AtomEntryStruct {
union {
unsigned char uUStrOfAE[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];
} rep;
} AtomEntry;
@ -75,14 +74,12 @@ typedef struct ExtraAtomEntryStruct {
union {
unsigned char uUStrOfAE[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];
} rep;
} ExtraAtomEntry;
#define UStrOfAE rep.uUStrOfAE
#define StrOfAE rep.uStrOfAE
#define WStrOfAE rep.uWStrOfAE
/* Props and Atoms are stored in chains, ending with a NIL */
#ifdef USE_OFFSETS

5
H/Yap.h
View File

@ -462,6 +462,7 @@ extern ADDR Yap_HeapBase;
/* This is ok for Linux, should be ok for everyone */
#define YAP_FILENAME_MAX 1024
/*************************************************************************************************
Debugging Support
*************************************************************************************************/
@ -850,4 +851,8 @@ inline static void LOG0(const char *f, int l, const char *fmt, ...) {
#include "GitSHA1.h"
extern bool Yap_embedded, Yap_Server;
#endif /* YAP_H */
#include "YapText.h"

49
H/YapText.h
View File

@ -31,47 +31,18 @@
#include "../utf8proc/utf8proc.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 {
void *buf, *ptr;
size_t sz;
struct TextBuffer_manager *prev;
} text_buffer_t;
extern int push_text_stack( USES_REGS1 );
extern int pop_text_stack( int lvl USES_REGS );
/**
* 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 );
}
#define min(x,y) (x<y ? x : y)
extern inline void mark_stack(void) {}
extern inline void restore_stack(void ) {} \
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;
}
#define MBYTE (1024*1024)
/* Character types for tokenizer and write.c */
@ -315,7 +286,7 @@ inline static int cmpn_utf8(const utf8proc_uint8_t *pt1,
#define SURROGATE_OFFSET \
((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

5
H/Yapproto.h
View File

@ -35,9 +35,6 @@ extern struct operator_entry *
extern Atom Yap_LookupAtom(const char *);
extern Atom Yap_ULookupAtom(const unsigned char *);
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 void Yap_LookupAtomWithAddress(const char *, struct AtomEntryStruct *);
extern Prop Yap_NewPredPropByFunctor(struct FunctorEntryStruct *, Term);
@ -447,6 +444,8 @@ extern intptr_t system_thread_id(void);
extern void Yap_InitLowLevelTrace(void);
#endif
extern void *Yap_InitTextAllocator( void );
/* udi.c */
extern void Yap_udi_init(void);
extern void Yap_udi_abolish(struct pred_entry *);

59
H/Yatom.h
View File

@ -198,58 +198,6 @@ INLINE_ONLY inline EXTERN PropFlags IsGlobalProperty(int flags) {
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.
Includes lists of pedicates, operators and other well-defIned
@ -1609,16 +1557,9 @@ INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *, PropEntry *p);
INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) {
/* old properties should be always last, and wide atom properties
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;
ae->PropsOfAE = AbsProp(p);
}
}
// auxiliary functions

8
H/generated/iatoms.h
View File

@ -24,6 +24,12 @@
AtomAttributedModule = Yap_LookupAtom("attributes_module"); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
AtomDoubleArrow = Yap_LookupAtom("-->"); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
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);
AtomEmptySquareBrackets = Yap_LookupAtom("[]"); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets);
AtomEmptyCurlyBrackets = Yap_LookupAtom("{}"); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
@ -63,6 +69,7 @@
AtomCharset = Yap_LookupAtom("charset"); TermCharset = MkAtomTerm(AtomCharset);
AtomChType = Yap_FullLookupAtom("$char_type"); TermChType = MkAtomTerm(AtomChType);
AtomCleanCall = Yap_FullLookupAtom("$clean_call"); TermCleanCall = MkAtomTerm(AtomCleanCall);
AtomClose = Yap_LookupAtom("close"); TermClose = MkAtomTerm(AtomClose);
AtomColon = Yap_LookupAtom(":"); TermColon = MkAtomTerm(AtomColon);
AtomCodeSpace = Yap_LookupAtom("code_space"); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
AtomCodes = Yap_LookupAtom("codes"); TermCodes = MkAtomTerm(AtomCodes);
@ -196,6 +203,7 @@
AtomInternalCompilerError = Yap_LookupAtom("internal_compiler_error"); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
AtomIs = Yap_LookupAtom("is"); TermIs = MkAtomTerm(AtomIs);
AtomJ = Yap_LookupAtom("j"); TermJ = MkAtomTerm(AtomJ);
Atoml = Yap_LookupAtom("l"); Terml = MkAtomTerm(Atoml);
AtomKey = Yap_LookupAtom("key"); TermKey = MkAtomTerm(AtomKey);
AtomLDLibraryPath = Yap_LookupAtom("LD_LIBRARY_PATH"); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
AtomLONGINT = Yap_LookupAtom("LongInt"); TermLONGINT = MkAtomTerm(AtomLONGINT);

8
H/generated/ratoms.h
View File

@ -24,6 +24,12 @@
AtomAttributedModule = AtomAdjust(AtomAttributedModule); TermAttributedModule = MkAtomTerm(AtomAttributedModule);
AtomDoubleArrow = AtomAdjust(AtomDoubleArrow); TermDoubleArrow = MkAtomTerm(AtomDoubleArrow);
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);
AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets);
AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets);
@ -63,6 +69,7 @@
AtomCharset = AtomAdjust(AtomCharset); TermCharset = MkAtomTerm(AtomCharset);
AtomChType = AtomAdjust(AtomChType); TermChType = MkAtomTerm(AtomChType);
AtomCleanCall = AtomAdjust(AtomCleanCall); TermCleanCall = MkAtomTerm(AtomCleanCall);
AtomClose = AtomAdjust(AtomClose); TermClose = MkAtomTerm(AtomClose);
AtomColon = AtomAdjust(AtomColon); TermColon = MkAtomTerm(AtomColon);
AtomCodeSpace = AtomAdjust(AtomCodeSpace); TermCodeSpace = MkAtomTerm(AtomCodeSpace);
AtomCodes = AtomAdjust(AtomCodes); TermCodes = MkAtomTerm(AtomCodes);
@ -196,6 +203,7 @@
AtomInternalCompilerError = AtomAdjust(AtomInternalCompilerError); TermInternalCompilerError = MkAtomTerm(AtomInternalCompilerError);
AtomIs = AtomAdjust(AtomIs); TermIs = MkAtomTerm(AtomIs);
AtomJ = AtomAdjust(AtomJ); TermJ = MkAtomTerm(AtomJ);
Atoml = AtomAdjust(Atoml); Terml = MkAtomTerm(Atoml);
AtomKey = AtomAdjust(AtomKey); TermKey = MkAtomTerm(AtomKey);
AtomLDLibraryPath = AtomAdjust(AtomLDLibraryPath); TermLDLibraryPath = MkAtomTerm(AtomLDLibraryPath);
AtomLONGINT = AtomAdjust(AtomLONGINT); TermLONGINT = MkAtomTerm(AtomLONGINT);

8
H/generated/tatoms.h
View File

@ -24,6 +24,12 @@ EXTERNAL Atom AtomArrow; EXTERNAL Term TermArrow;
EXTERNAL Atom AtomAttributedModule; EXTERNAL Term TermAttributedModule;
EXTERNAL Atom AtomDoubleArrow; EXTERNAL Term TermDoubleArrow;
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 AtomEmptySquareBrackets; EXTERNAL Term TermEmptySquareBrackets;
EXTERNAL Atom AtomEmptyCurlyBrackets; EXTERNAL Term TermEmptyCurlyBrackets;
@ -63,6 +69,7 @@ EXTERNAL Atom AtomChars; EXTERNAL Term TermChars;
EXTERNAL Atom AtomCharset; EXTERNAL Term TermCharset;
EXTERNAL Atom AtomChType; EXTERNAL Term TermChType;
EXTERNAL Atom AtomCleanCall; EXTERNAL Term TermCleanCall;
EXTERNAL Atom AtomClose; EXTERNAL Term TermClose;
EXTERNAL Atom AtomColon; EXTERNAL Term TermColon;
EXTERNAL Atom AtomCodeSpace; EXTERNAL Term TermCodeSpace;
EXTERNAL Atom AtomCodes; EXTERNAL Term TermCodes;
@ -196,6 +203,7 @@ EXTERNAL Atom AtomInteger; EXTERNAL Term TermInteger;
EXTERNAL Atom AtomInternalCompilerError; EXTERNAL Term TermInternalCompilerError;
EXTERNAL Atom AtomIs; EXTERNAL Term TermIs;
EXTERNAL Atom AtomJ; EXTERNAL Term TermJ;
EXTERNAL Atom Atoml; EXTERNAL Term Terml;
EXTERNAL Atom AtomKey; EXTERNAL Term TermKey;
EXTERNAL Atom AtomLDLibraryPath; EXTERNAL Term TermLDLibraryPath;
EXTERNAL Atom AtomLONGINT; EXTERNAL Term TermLONGINT;

3
H/qly.h
View File

@ -96,10 +96,9 @@ typedef enum {
QLY_END_OPS = 11,
QLY_START_PREDICATE = 12,
QLY_END_PREDICATES = 13,
QLY_ATOM_WIDE = 14,
QLY_FAILCODE = 15,
QLY_ATOM = 16,
QLY_ATOM_BLOB = 17
QLY_ATOM_BLOB = 14
} qlf_tag_t;
#define STATIC_PRED_FLAGS \

3
H/rheap.h
View File

@ -1460,9 +1460,6 @@ static void RestoreEntries(PropEntry *pp, int int_key USES_REGS) {
case ExpProperty:
pp->NextOfPE = PropAdjust(pp->NextOfPE);
break;
case WideAtomProperty:
pp->NextOfPE = PropAdjust(pp->NextOfPE);
break;
case BlobProperty:
pp->NextOfPE = PropAdjust(pp->NextOfPE);
{

152
callcount.yap Normal file
View File

@ -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)).
%% @}
/**
@}
*/

2
include/YapDefs.h
View File

@ -284,6 +284,8 @@ typedef struct yap_boot_params {
int Argc;
/* array of arguments as seen by Prolog */
char **Argv;
/* embedded in some other system: no signals, readline, etc */
bool Embedded;
/* QuietMode */
int QuietMode;

0
interactive.py Normal file
View File

49
library/dialect/swi/fli/blobs.c
View File

@ -23,13 +23,15 @@
*
*/
#include <stdio.h>
#include <Yap.h>
#include <Yatom.h>
#include <iopreds.h>
#include <stdio.h>
#include <string.h>
#include "YapText.h"
/* for freeBSD9.1 */
#define _WITH_DPRINTF
#include <stdio.h>
@ -37,18 +39,12 @@
//#include <SWI-Stream.h>
//#include <pl-shared.h>
#include "swi.h"
static PL_blob_t unregistered_blob_atom =
{ PL_BLOB_MAGIC,
PL_BLOB_NOCOPY|PL_BLOB_TEXT,
"unregistered"
};
static PL_blob_t unregistered_blob_atom = {
PL_BLOB_MAGIC, PL_BLOB_NOCOPY | PL_BLOB_TEXT, "unregistered"};
int
PL_is_blob(term_t t, PL_blob_t **type)
{
int PL_is_blob(term_t t, PL_blob_t **type) {
CACHE_REGS
Term yt = Yap_GetFromSlot(t);
Atom a;
@ -69,8 +65,7 @@ PL_is_blob(term_t t, PL_blob_t **type)
/* void check_chain(void); */
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
AtomEntry *ae;
@ -87,8 +82,7 @@ PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
}
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
AtomEntry *ae;
int ret;
@ -107,8 +101,7 @@ PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
}
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
Atom a;
Term tt;
@ -129,24 +122,16 @@ PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
*len = ae->rep.blob[0].length;
if (blob)
*blob = ae->rep.blob[0].data;
return TRUE;
return true;
}
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);
if (!IsBlob(x)) {
if (IsWideAtom(x)) {
if (len)
*len = wcslen(x->WStrOfAE);
if ( type )
*type = &unregistered_blob_atom;
return x->WStrOfAE;
}
if ( len )
*len = strlen(x->StrOfAE);
*len = strlen_utf8(x->UStrOfAE);
if (type)
*type = &unregistered_blob_atom;
return x->StrOfAE;
@ -160,28 +145,24 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
}
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;
BlobTypes = (struct YAP_blob_t *)type;
}
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);
return YAP_find_blob_type((YAP_Atom)at);
}
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");
return FALSE;
}
/**
* @}
*/

22
library/dialect/swi/fli/swi.c
View File

@ -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 */
{
Atom at = SWIAtomToAtom(a);
if (IsWideAtom(at))
return NULL;
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
Term t = Yap_GetFromSlot(ts);
if (!IsAtomTerm(t) || IsWideAtom(AtomOfTerm(t)))
if (!IsAtomTerm(t))
return 0;
*a = RepAtom(AtomOfTerm(t))->StrOfAE;
return 1;
@ -892,9 +890,9 @@ X_API atom_t PL_new_atom(const char *c) {
Atom at;
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"))
return FALSE;
return false;
}
Yap_AtomIncreaseHold(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) {
Atom at = SWIAtomToAtom(name);
if (!IsWideAtom(at))
return NULL;
*sp = wcslen(RepAtom(at)->WStrOfAE);
return RepAtom(at)->WStrOfAE;
const unsigned char *s = at->UStrOfAE;
size_t sz = *sp = strlen_utf8(s);
wchar_t *out = Malloc((sz + 1) * sizeof(wchar_t));
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) {

0
logtalk_tester_logs/errors.all Normal file
View File

43
logtalk_tester_logs/tester_versions.txt Normal file
View File

@ -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)

1283
misc/editors/prolog.js Normal file
View File

File diff suppressed because it is too large Load Diff

25
os/charsio.c
View File

@ -87,11 +87,10 @@ static Int flush_all_streams(USES_REGS1);
* @return the char .
*/
INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
if (IsWideAtom(at)) {
return at->WStrOfAE[0];
} else {
return at->StrOfAE[0];
}
int32_t val;
get_utf8(at->UStrOfAE, 1, &val);
return val;
}
Int Yap_peek(int sno) {
@ -1100,7 +1099,7 @@ atom with _C_, while leaving the stream position unaltered.
static Int peek_char(USES_REGS1) {
/* the next character is a EOF */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
wchar_t wsinp[2];
unsigned char sinp[10];
Int ch;
if (sno < 0)
@ -1115,9 +1114,9 @@ static Int peek_char(USES_REGS1) {
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0';
wsinp[0] = ch;
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
int off = put_utf8(sinp, ch);
sinp[off] = '\0';
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp)));
}
/** @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) {
/* the next character is a EOF */
int sno = LOCAL_c_input_stream;
wchar_t wsinp[2];
unsigned char sinp[10];
Int ch;
LOCK(GLOBAL_Stream[sno].streamlock);
@ -1140,9 +1139,9 @@ static Int peek_char_1(USES_REGS1) {
// return false;
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0';
wsinp[0] = ch;
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
int off = put_utf8(sinp, ch);
sinp[off] = '\0';
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp)));
}
/** @pred peek(+ _S_, - _C_) is deprecated

39
os/chartypes.c
View File

@ -214,22 +214,15 @@ static int get_char(Term t) {
return 0;
}
Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) {
wchar_t *s0 = RepAtom(AtomOfTerm(t))->WStrOfAE;
if (s0[1] != '\0') {
unsigned char *s = RepAtom(at)->UStrOfAE;
utf8proc_int32_t c;
s += get_utf8(s, 1, &c);
return c;
if (s[0] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
return 0;
}
return s0[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) {
@ -263,25 +256,15 @@ static int get_char_or_code(Term t, bool *is_char) {
*is_char = false;
return ch;
}
Atom at = AtomOfTerm(t);
if (IsWideAtom(at)) {
wchar_t *s0 = RepAtom(AtomOfTerm(t))->WStrOfAE;
if (s0[1] != '\0') {
unsigned char *s0 = RepAtom(AtomOfTerm(t))->UStrOfAE;
int val;
s0 += get_utf8(s0, 1, &val);
if (s0[0] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t, NULL);
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;
return val;
}
static Int toupper2(USES_REGS1) {

29
os/files.c
View File

@ -465,19 +465,11 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
rc = Yap_IsAbsolutePath(buf);
} else {
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
#if _WIN32
rc = PathIsRelativeW(RepAtom(at)->WStrOfAE);
#else
rc = RepAtom(at)->WStrOfAE[0] == '/';
#endif
} else {
#if _WIN32
rc = PathIsRelative(RepAtom(at)->StrOfAE);
#else
rc = RepAtom(at)->StrOfAE[0] == '/';
#endif
}
freeBuffer(buf);
}
return rc;
@ -491,13 +483,6 @@ static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
return FALSE;
}
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
wchar_t *c = RepAtom(at)->WStrOfAE;
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
@ -516,7 +501,6 @@ static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
Term t = Deref(ARG1);
@ -526,18 +510,6 @@ static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
return false;
}
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
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
// file_base_name in SWI and GNU
@ -557,7 +529,6 @@ static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
static Int same_file(USES_REGS1) {
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;

3
os/readline.c
View File

@ -450,7 +450,10 @@ int Yap_ReadlineForSIGINT(void) {
static Int has_readline(USES_REGS1) {
#if USE_READLINE
if (!Yap_embedded) {
return true;
}
return false;
#else
return false;
#endif

18
os/readterm.c
View File

@ -870,7 +870,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
} 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) {
LOCAL_ErrorMessage = s;
LOCAL_Error_TYPE = SYNTAX_ERROR;
@ -923,13 +923,16 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
int emacs_cares = FALSE;
#endif
int lvl = push_text_stack();
parser_state_t state = YAP_START_PARSING;
while (true) {
switch (state) {
case YAP_START_PARSING:
state = initParser(opts, &fe, &re, inp_stream, nargs);
if (state == YAP_PARSING_FINISHED)
if (state == YAP_PARSING_FINISHED) {
pop_text_stack(lvl);
return 0;
}
break;
case YAP_SCANNING:
state = scan(&re, &fe, inp_stream);
@ -961,10 +964,12 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
pop_text_stack(lvl);
return fe.t;
}
}
}
pop_text_stack(lvl);
return 0;
}
@ -1339,17 +1344,10 @@ static Int read_term_from_atom(USES_REGS1) {
Term Yap_AtomToTerm(Atom a, Term opts) {
Term rval;
int sno;
if (IsWideAtom(a)) {
wchar_t *ws = a->WStrOfAE;
size_t len = wcslen(ws);
encoding_t enc = ENC_ISO_ANSI;
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;
encoding_t enc = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
}
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);

3
os/sig.c
View File

@ -816,6 +816,9 @@ yap_error_number Yap_MathException__(USES_REGS1) {
/* SIGINT can cause problems, if caught before full initialization */
void Yap_InitOSSignals(int wid) {
if (Yap_embedded) {
return;
}
if (GLOBAL_PrologShouldHandleInterrupts) {
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
my_signal(SIGQUIT, ReceiveSignal);

8
os/sysbits.c
View File

@ -1790,15 +1790,13 @@ static Int p_log_event(USES_REGS1) {
return FALSE;
at = AtomOfTerm(in);
#if DEBUG
if (IsWideAtom(at))
fprintf(stderr, "LOG %S\n", RepAtom(at)->WStrOfAE);
else if (IsBlob(at))
if (IsBlob(at))
return FALSE;
else
fprintf(stderr, "LOG %s\n", RepAtom(at)->StrOfAE);
#endif
if (IsWideAtom(at) || IsBlob(at))
return FALSE;
if (IsBlob(at))
return false;
LOG(" %s ", RepAtom(at)->StrOfAE);
return TRUE;
}

8
os/yapio.h
View File

@ -137,12 +137,12 @@ INLINE_ONLY inline EXTERN Term MkCharTerm(Int c);
* @return the term.
*/
INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
wchar_t cs[2];
unsigned char cs[10];
if (c < 0)
return TermEof;
cs[0] = c;
cs[1] = '\0';
return MkAtomTerm(Yap_LookupMaybeWideAtom(cs));
size_t n = put_utf8( cs, c );
cs[n] = '\0';
return MkAtomTerm(Yap_ULookupAtom(cs));
}
/// UT when yap started

1
packages/cplint/slipcover/areas.csv Normal file
View File

@ -0,0 +1 @@
Fold; CLL; AUCROC; AUCPR
1 Fold; CLL; AUCROC; AUCPR

BIN
packages/cplint/slipcover/extra.tgz Normal file
View File

Binary file not shown.

21
packages/python/examples/namedtuples.yap Normal file
View File

@ -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
packages/python/examples/untitled Normal file
View File

48
packages/python/images.py Normal file
View File

@ -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

92
packages/python/kernel Normal file
View File

@ -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)

61
packages/python/plot.py Normal file
View File

@ -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])

1283
packages/python/prolog.js Normal file
View File

File diff suppressed because it is too large Load Diff

4
packages/python/py2pl.c
View File

@ -185,9 +185,9 @@ foreign_t python_to_term(PyObject *pVal, term_t t) {
Py_ssize_t i, sz = PyTuple_Size(pVal);
functor_t f;
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);
else
} else
f = PL_new_functor(ATOM_t, sz);
if (!PL_unify_functor(t, f))
return FALSE;

347
packages/python/pypreds.c
View File

@ -42,24 +42,35 @@ static foreign_t python_f(term_t tmod, term_t fname, term_t tf) {
pName = PyUnicode_FromString(s);
#endif
if (pName == NULL) {
return FALSE;
{
return false;
}
}
pModule = PyImport_Import(pName);
PyErr_Clear();
} else if (!(pModule = term_to_python(tmod, true))) {
PyErr_Clear();
return FALSE;
{
return false;
}
}
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
return FALSE;
{
return false;
}
}
pF = PyObject_GetAttrString(pModule, s);
PyErr_Print();
Py_DECREF(pModule);
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) {
@ -69,13 +80,21 @@ static foreign_t python_o(term_t tmod, term_t fname, term_t tf) {
pModule = term_to_python(tmod, true);
if (!PL_get_nchars(fname, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
return FALSE;
{
return false;
}
}
pO = PyObject_GetAttrString(pModule, s);
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) {
@ -83,8 +102,9 @@ static foreign_t python_len(term_t tobj, term_t tf) {
PyObject *o;
o = term_to_python(tobj, true);
if (o == NULL)
return FALSE;
if (o == NULL) {
return false;
}
len = PyObject_Length(o);
return PL_unify_int64(tf, len);
}
@ -94,40 +114,54 @@ static foreign_t python_dir(term_t tobj, term_t tf) {
PyObject *o;
o = term_to_python(tobj, true);
if (o == NULL)
return FALSE;
if (o == NULL) {
return false;
}
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) {
PyObject *i;
PyObject *o;
PyObject *f;
o = term_to_python(tobj, true);
if (o == NULL)
if (o == NULL) {
return false;
if (!PySequence_Check(o))
}
if (!PySequence_Check(o)) {
return false;
}
i = term_to_python(tindex, true);
if (i == NULL)
if (i == NULL) {
return false;
}
#if PY_MAJOR_VERSION < 3
f = PyObject_CallMethodObjArgs(o, PyString_FromString("getitem"), i);
#else
f = PyObject_CallMethodObjArgs(o, PyUnicode_FromString("getitem"), i);
#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) {
PyObject *o;
o = term_to_python(tobj, true);
if (!o)
return FALSE;
return python_to_ptr(o, tf);
if (!o) {
return false;
}
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) {
@ -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);
// Exp
if (!pI || !p) {
{
return false;
}
} else if (PyObject_SetItem(p, pI, pF)) {
PyErr_Print();
return FALSE;
{
return false;
}
}
Py_DecRef(pI);
Py_DecRef(p);
{
return true;
}
}
/** assign a tuple to something:
*/
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;
functor_t f;
e = term_to_python(t_rhs, true);
if (!e || !PyTuple_Check(e)) {
return -1;
}
@ -224,12 +266,18 @@ static foreign_t python_item(term_t parent, term_t indx, term_t tobj) {
return false;
} else if ((pF = PyObject_GetItem(p, pI)) == NULL) {
PyErr_Print();
return FALSE;
{
return false;
}
}
Py_DecRef(pI);
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) {
@ -244,15 +292,23 @@ static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
p = term_to_python(parent, true);
// Exp
if (!pI || !p) {
{
return false;
}
} else if ((pF = PySequence_GetSlice(p, 0, 0)) == NULL) {
PyErr_Print();
return FALSE;
{
return false;
}
}
Py_DecRef(pI);
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,
@ -268,14 +324,18 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
pF = term_to_python(tin, true);
PyErr_Clear();
if (pF == NULL) {
{
return false;
}
}
if (PL_is_atom(targs)) {
pArgs = NULL;
} else {
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)) {
/* ignore (_) */
@ -283,15 +343,18 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
} else {
pArgs = PyTuple_New(arity);
if (!pArgs)
return FALSE;
if (!pArgs) {
return false;
}
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, targs, targ))
return FALSE;
if (!PL_get_arg(i + 1, targs, targ)) {
return false;
}
pArg = term_to_python(targ, true);
if (pArg == NULL)
return FALSE;
if (pArg == NULL) {
return false;
}
/* pArg reference stolen here: */
PyTuple_SetItem(pArgs, i, pArg);
}
@ -319,13 +382,16 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
}
} else {
PyErr_Print();
return FALSE;
{
return false;
}
}
if (pArgs)
Py_DECREF(pArgs);
Py_DECREF(pF);
if (pValue == NULL)
return FALSE;
if (pValue == NULL) {
return false;
}
out = python_to_ptr(pValue, tf);
return out;
}
@ -333,16 +399,18 @@ 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) {
PyObject *e = term_to_python(exp, true);
if (e == NULL)
return FALSE;
if (e == NULL) {
return false;
}
return assign_python(py_Main, name, e) >= 0;
}
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);
if (e == NULL)
return FALSE;
if (e == NULL) {
return false;
}
return assign_python(root, name, e) >= 0;
}
@ -356,46 +424,63 @@ static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
if ((env = py_Builtin) == NULL) {
// no point in even trying
{
return false;
}
}
if (PL_get_name_arity(caller, &name, &arity)) {
if (!(s = PL_atom_chars(name)))
if (!(s = PL_atom_chars(name))) {
return false;
}
if ((pI = PyObject_GetAttrString(env, s)) == NULL) {
PyErr_Print();
{
return false;
}
}
} else {
// Prolog should make sure this never happens.
{
return false;
}
}
pArgs = PyTuple_New(arity);
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, caller, targ))
return FALSE;
if (!PL_get_arg(i + 1, caller, targ)) {
return false;
}
/* ignore (_) */
if (i == 0 && PL_is_variable(targ)) {
pArg = Py_None;
} else {
pArg = term_to_python(targ, true);
if (pArg == NULL)
return FALSE;
if (pArg == NULL) {
return false;
}
}
/* pArg reference stolen here: */
if (PyTuple_SetItem(pArgs, i, pArg)) {
PyErr_Print();
{
return false;
}
}
}
pOut = PyObject_CallObject(pI, pArgs);
Py_DECREF(pArgs);
Py_DECREF(pI);
if (pOut == NULL) {
PyErr_Print();
{
return false;
}
return python_to_ptr(pOut, out);
}
{
foreign_t rc = python_to_ptr(pOut, out);
;
return rc;
}
}
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;
term_t targ = PL_new_term_ref();
if (o == NULL)
return FALSE;
if (o == NULL) {
return false;
}
if (PL_is_atom(f)) {
if (!PL_get_atom_chars(f, &s))
return FALSE;
if (!PL_get_atom_chars(f, &s)) {
return false;
}
if ((pValue = PyObject_GetAttrString(o, s)) == NULL) {
PyErr_Print();
return FALSE;
{
return false;
}
}
{
return python_to_term(pValue, out);
}
}
if (!PL_get_name_arity(f, &name, &arity)) {
return FALSE;
{
return false;
}
}
/* follow chains of the form a.b.c.d.e() */
while (name == ATOM_dot && arity == 2) {
term_t tleft = PL_new_term_ref();
PyObject *lhs;
if (!PL_get_arg(1, f, tleft))
return FALSE;
if (!PL_get_arg(1, f, tleft)) {
return false;
}
lhs = term_to_python(tleft, true);
if ((o = PyObject_GetAttr(o, lhs)) == NULL) {
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)) {
return FALSE;
{
return false;
}
}
}
s = PL_atom_chars(name);
if (!s)
if (!s) {
return false;
}
if ((pF = PyObject_GetAttrString(o, s)) == NULL) {
PyErr_Print();
return FALSE;
{
return false;
}
}
pArgs = PyTuple_New(arity);
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, f, targ))
return FALSE;
if (!PL_get_arg(i + 1, f, targ)) {
return false;
}
/* ignore (_) */
if (i == 0 && PL_is_variable(targ)) {
pArgs = Py_None;
}
pArg = term_to_python(targ, true);
if (pArg == NULL)
return FALSE;
if (pArg == NULL) {
return false;
}
/* pArg reference stolen here: */
PyTuple_SetItem(pArgs, i, pArg);
}
@ -463,10 +567,14 @@ static foreign_t python_access(term_t obj, term_t f, term_t out) {
Py_DECREF(pArgs);
Py_DECREF(pF);
if (pValue == NULL) {
return FALSE;
{
return false;
}
}
{
return python_to_term(pValue, out);
}
}
static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
PyObject *pF;
@ -475,7 +583,9 @@ static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
int arity;
if (!PL_get_name_arity(att, &name, &arity)) {
{
return false;
}
} else {
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);
// Exp
if (!PL_get_name_arity(att, &name, &arity)) {
{
return false;
}
}
s = PL_atom_chars(name);
if (arity == 1 && !strcmp(s, "()")) {
if (!PL_get_arg(1, att, att))
if (!PL_get_arg(1, att, att)) {
return false;
}
if (!PL_get_name_arity(att, &name, &arity)) {
{
return false;
}
}
s = PL_atom_chars(name);
}
if (!s || !p) {
{
return false;
}
} else if ((pF = PyObject_GetAttrString(p, s)) == NULL) {
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) {
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) {
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) {
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) {
@ -530,24 +662,37 @@ static foreign_t python_run_file(term_t file) {
PyRun_SimpleFileEx(PyFile_AsFile(PyFileObject), "test.py", 1);
#else
FILE *f = fopen(s, "r");
if (f == NULL)
if (f == NULL) {
return false;
}
PyRun_SimpleFileEx(f, s, 1);
#endif
return TRUE;
{
{
return true;
}
}
}
{
return false;
}
}
extern PyThreadState *YAP_save;
static foreign_t python_run_command(term_t cmd) {
char *s;
bool rc = false;
size_t len;
char si[256];
s = si;
if (PL_get_nchars(cmd, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
PyRun_SimpleString(s);
rc = true;
}
return TRUE;
return rc;
}
static foreign_t python_run_script(term_t cmd, term_t fun) {
@ -587,8 +732,10 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
Py_DECREF(pModule);
PyErr_Print();
fprintf(stderr, "Call failed\n");
{
return false;
}
}
} else {
if (PyErr_Occurred())
PyErr_Print();
@ -598,12 +745,18 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
Py_DECREF(pModule);
} else {
PyErr_Print();
{
return false;
}
}
{
return true;
}
}
{
return false;
}
}
static foreign_t python_export(term_t t, term_t pl) {
foreign_t rc = false;
@ -611,10 +764,12 @@ static foreign_t python_export(term_t t, term_t pl) {
void *ptr;
term_t targ = PL_new_term_ref();
if (!PL_get_arg(1, t, targ))
if (!PL_get_arg(1, t, targ)) {
return false;
if (!PL_get_pointer(targ, &ptr))
}
if (!PL_get_pointer(targ, &ptr)) {
return false;
}
Py_INCREF((PyObject *)ptr);
/* return __main__,s */
rc = python_to_term((PyObject *)ptr, pl);
@ -622,9 +777,7 @@ static foreign_t python_export(term_t t, term_t pl) {
return rc;
}
static foreign_t p_python_within_python(void) {
return python_in_python;
}
static foreign_t p_python_within_python(void) { return python_in_python; }
static int python_import(term_t mname, term_t mod) {
PyObject *pName, *pModule;
@ -638,14 +791,17 @@ static int python_import(term_t mname, term_t mod) {
if (PL_is_pair(mname)) {
char *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;
}
s = stpcpy(s, sa);
*s++ = '.';
s[0] = '\0';
} else if (!PL_get_nchars(mname, &len, &s,
CVT_ALL | CVT_EXCEPTION | REP_UTF8)) {
{
return false;
}
} else {
break;
}
@ -656,8 +812,10 @@ static int python_import(term_t mname, term_t mod) {
pName = PyUnicode_FromString(s0);
#endif
if (pName == NULL) {
{
return false;
}
}
pModule = PyImport_Import(pName);
PyErr_Clear();
Py_DECREF(pName);
@ -667,10 +825,30 @@ static int python_import(term_t mname, term_t mod) {
PyErr_Print();
PyErr_Clear();
#endif
return FALSE;
{
return false;
}
}
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) {
@ -699,5 +877,6 @@ install_t install_pypreds(void) {
PL_register_foreign("python_main_module", 1, python_main_module, 0);
PL_register_foreign("python_import", 2, python_import, 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);
}

2
packages/python/python.c
View File

@ -93,6 +93,7 @@ X_API bool init_python(void) {
// wait for YAP_Init
return false;
}
PyGILState_STATE gstate = PyGILState_Ensure();
term_t t = PL_new_term_ref();
if (!Py_IsInitialized()) {
python_in_python = true;
@ -111,5 +112,6 @@ X_API bool init_python(void) {
PL_reset_term_refs(t);
install_pypreds();
install_pl2pl();
PyGILState_Release(gstate);
return !python_in_python;
}

2
packages/python/python.pl
View File

@ -27,6 +27,8 @@
array_to_python_tuple/4,
array_to_python_view/5,
python/2,
acquire_GIL/0,
release_GIL/0,
(:=)/2,
(:=)/1,
% (<-)/2,

44
packages/python/yap_kernel/#install.py# Normal file
View File

@ -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)

30
packages/python/yap_kernel/clause.py Normal file
View File

@ -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")

3
pl/boot.yap
View File

@ -1648,3 +1648,6 @@ log_event( String, Args ) :-
/**
@}
*/

BIN
pl/figure_3.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 128 KiB

4
regression/metaconj.yap Normal file
View File

@ -0,0 +1,4 @@
a(X) :- X.
b(X) :- X, writeln(X).
c(X) :- X, X.

0
untitled 2.txt Normal file
View File

0
untitled.txt Normal file
View File

652
x.py Normal file
View File

@ -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

BIN
x.tgz Normal file
View File

Binary file not shown.