589 lines
14 KiB
C
Executable File
589 lines
14 KiB
C
Executable File
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: exo.c *
|
|
* comments: Exo compilation *
|
|
* *
|
|
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ * *
|
|
* $Log: not supported by cvs2svn $ *
|
|
* *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
#include "Yap.h"
|
|
#include "clause.h"
|
|
#include "yapio.h"
|
|
#include "eval.h"
|
|
#include "tracer.h"
|
|
#include "attvar.h"
|
|
#ifdef YAPOR
|
|
#include "or.macros.h"
|
|
#endif /* YAPOR */
|
|
#ifdef TABLING
|
|
#include "tab.macros.h"
|
|
#endif /* TABLING */
|
|
#if HAVE_STRING_H
|
|
#include <string.h>
|
|
#endif
|
|
#include <udi.h>
|
|
|
|
|
|
static int
|
|
compar(const void *ip0, const void *jp0) {
|
|
CACHE_REGS
|
|
BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
|
|
Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
|
|
Term j = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *jp)[LOCAL_exo_arg];
|
|
//fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), IntOfTerm(j));
|
|
return IntOfTerm(i)-IntOfTerm(j);
|
|
}
|
|
|
|
static Int
|
|
cmp_extra_args(CELL *si, CELL *sj, struct index_t *it)
|
|
{
|
|
UInt m = it->udi_free_args;
|
|
UInt m0 = 1, x;
|
|
|
|
for (x=0; x< it->arity; x++) {
|
|
if (m0 & m) {
|
|
if (si[x] != sj[x]) {
|
|
if (IsIntTerm(si[x]))
|
|
return IntOfTerm(si[x])-IntOfTerm(sj[x]);
|
|
return AtomOfTerm(si[x])-AtomOfTerm(sj[x]);
|
|
}
|
|
m -= m0;
|
|
if (m == 0)
|
|
return 0;
|
|
}
|
|
m0 <<= 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
static int
|
|
compar2(const void *ip0, const void *jp0) {
|
|
CACHE_REGS
|
|
BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
|
|
struct index_t *it = LOCAL_exo_it;
|
|
Term* si = EXO_OFFSET_TO_ADDRESS(it, *ip);
|
|
Term* sj = EXO_OFFSET_TO_ADDRESS(it, *jp);
|
|
int cmp = cmp_extra_args(si, sj, it);
|
|
if (cmp)
|
|
return cmp;
|
|
return IntOfTerm(si[LOCAL_exo_arg])-IntOfTerm(sj[LOCAL_exo_arg]);
|
|
}
|
|
|
|
static int
|
|
compare(const BITS32 *ip, Int j USES_REGS) {
|
|
Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
|
|
//fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j);
|
|
return IntOfTerm(i)-j;
|
|
}
|
|
|
|
static UInt free_args(UInt b[], UInt arity, UInt i) {
|
|
UInt j;
|
|
UInt rc = 0;
|
|
|
|
for (j=0; j<arity; j++) {
|
|
if (i !=j && b[j] == 0)
|
|
rc |= 1<<j;
|
|
}
|
|
return rc;
|
|
}
|
|
|
|
static BITS32*
|
|
NEXT_DIFFERENT(BITS32 *pt0, BITS32 *pte, struct index_t *it)
|
|
{
|
|
Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
|
|
Term* sj;
|
|
|
|
do {
|
|
pt0++;
|
|
if (pt0 == pte)
|
|
return NULL;
|
|
sj = EXO_OFFSET_TO_ADDRESS(it, *pt0);
|
|
} while (!cmp_extra_args(si, sj, it));
|
|
return pt0;
|
|
}
|
|
|
|
static BITS32*
|
|
PREV_DIFFERENT(BITS32 *pt0, BITS32 *pte, struct index_t *it)
|
|
{
|
|
Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
|
|
Term* sj;
|
|
|
|
do {
|
|
pt0--;
|
|
if (pt0 == pte)
|
|
return NULL;
|
|
sj = EXO_OFFSET_TO_ADDRESS(it, *pt0);
|
|
} while (!cmp_extra_args(si, sj, it));
|
|
return pt0;
|
|
}
|
|
|
|
static BITS32*
|
|
NEXT_MIN(BITS32 *pt0, BITS32 *pte, Term tmin, Term tmax, struct index_t *it)
|
|
{
|
|
Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
|
|
int do_min, do_max;
|
|
Int min = 0, max = 0;
|
|
|
|
if (IsVarTerm(tmin)) {
|
|
do_min = FALSE;
|
|
} else {
|
|
do_min = TRUE;
|
|
min = IntOfTerm(tmin);
|
|
}
|
|
if (IsVarTerm(tmax)) {
|
|
do_max = FALSE;
|
|
} else {
|
|
do_max = TRUE;
|
|
max = IntOfTerm(tmax);
|
|
}
|
|
|
|
while ((do_min && IntOfTerm(si[it->udi_arg]) < min) ||
|
|
(do_max && IntOfTerm(si[it->udi_arg]) > max)) {
|
|
pt0++;
|
|
if (pt0 == pte)
|
|
return NULL;
|
|
si = EXO_OFFSET_TO_ADDRESS(it, *pt0);
|
|
}
|
|
return pt0;
|
|
}
|
|
|
|
static BITS32*
|
|
NEXT_MAX(BITS32 *pt0, BITS32 *pte, Term tmin, Term tmax, struct index_t *it)
|
|
{
|
|
Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
|
|
int do_min, do_max;
|
|
Int min = 0, max = 0;
|
|
|
|
if (IsVarTerm(tmin)) {
|
|
do_min = FALSE;
|
|
} else {
|
|
do_min = TRUE;
|
|
min = IntOfTerm(tmin);
|
|
}
|
|
if (IsVarTerm(tmax)) {
|
|
do_max = FALSE;
|
|
} else {
|
|
do_max = TRUE;
|
|
max = IntOfTerm(tmax);
|
|
}
|
|
|
|
while ((do_min && IntOfTerm(si[it->udi_arg]) < min) ||
|
|
(do_max && IntOfTerm(si[it->udi_arg]) > max)) {
|
|
pt0--;
|
|
if (pt0 == pte)
|
|
return NULL;
|
|
si = EXO_OFFSET_TO_ADDRESS(it, *pt0);
|
|
}
|
|
return pt0;
|
|
}
|
|
|
|
static void
|
|
IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
|
|
{
|
|
size_t sz;
|
|
struct index_t *it = *ip;
|
|
yamop *code;
|
|
|
|
/* hard-wired implementation for the Interval case */
|
|
Int i = it->udi_arg;
|
|
/* it is bound, use hash */
|
|
if (it->bmap & b[i]) return;
|
|
/* no constraints, nothing to gain */
|
|
//if (!IsAttVar(VarOfTerm(Deref(XREGS[i+1])))) return;
|
|
LOCAL_exo_it = it;
|
|
LOCAL_exo_base = it->bcls;
|
|
LOCAL_exo_arity = it->arity;
|
|
LOCAL_exo_arg = i;
|
|
it->udi_free_args = free_args(b, it->arity, i);
|
|
if (!it->key) {
|
|
UInt ncls = it->ap->cs.p_code.NOfClauses, i;
|
|
BITS32 *sorted;
|
|
/* handle ll variables */
|
|
sz = sizeof(BITS32)*(ncls);
|
|
/* allocate space */
|
|
if (!(it->udi_data = (BITS32*)Yap_AllocCodeSpace(sz)))
|
|
return;
|
|
sorted = (BITS32*)it->udi_data;
|
|
for (i=0; i< ncls; i++)
|
|
sorted[i] = i;
|
|
qsort(sorted, (size_t)ncls, sizeof(BITS32), compar);
|
|
it->links = NULL;
|
|
} else {
|
|
BITS32 *sorted0, *sorted;
|
|
|
|
/* be conservative */
|
|
if (it->udi_free_args)
|
|
sz = sizeof(BITS32)*(2*it->ntrys+3*it->nentries);
|
|
else
|
|
sz = sizeof(BITS32)*(it->ntrys+2*it->nentries);
|
|
/* allocate space */
|
|
if (!(it->udi_data = (BITS32*)malloc(sz)))
|
|
return;
|
|
sorted0 = sorted = (BITS32 *)it->udi_data;
|
|
sorted++; /* leave an initial hole */
|
|
for (i=0; i < it->hsize; i++) {
|
|
if (it->key[i]) {
|
|
BITS32 *s0 = sorted;
|
|
BITS32 offset = it->key[i], offset0 = offset;
|
|
|
|
*sorted++ = 0;
|
|
do {
|
|
*sorted++ = offset;
|
|
offset = it->links[offset];
|
|
} while (offset);
|
|
// S = EXO_OFFSET_TO_ADDRESS(it, offset0); Yap_DebugPlWrite(S[0]);
|
|
// fprintf(stderr, " key[i]=%d offset=%d %d\n", it->key[i], offset0, (sorted-s0)-1);
|
|
if (sorted-s0 == 2) {
|
|
it->links[offset0] = 0;
|
|
sorted = s0;
|
|
} else {
|
|
/* number of elements comes first */
|
|
*s0 = sorted - (s0+1);
|
|
qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar);
|
|
it->links[offset0] = s0-sorted0;
|
|
if (it->udi_free_args) {
|
|
memcpy(sorted, s0+1, sizeof(BITS32)*(*s0));
|
|
qsort(sorted, (size_t)*s0, sizeof(BITS32), compar2);
|
|
sorted += *s0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
sz = sizeof(BITS32)*(sorted-sorted0);
|
|
it->udi_data = (BITS32 *)realloc((char *)it->udi_data, sz);
|
|
}
|
|
it->is_udi = i+1;
|
|
code = it->code;
|
|
code->opc = Yap_opcode(_try_exo_udi);
|
|
code = NEXTOP(code, lp);
|
|
code->opc = Yap_opcode(_retry_exo_udi);
|
|
}
|
|
|
|
static BITS32 *
|
|
binary_search(BITS32 *start, BITS32 *end, Int x USES_REGS)
|
|
{
|
|
BITS32 *mid;
|
|
while (start < end) {
|
|
int cmp;
|
|
mid = start + (end-start)/2;
|
|
cmp = compare(mid, x PASS_REGS);
|
|
if (!cmp)
|
|
return mid;
|
|
if (cmp > 0) {
|
|
end = mid-1;
|
|
} else
|
|
start = mid+1;
|
|
}
|
|
return start;
|
|
}
|
|
|
|
static yamop *
|
|
Interval(struct index_t *it, Term min, Term max, Term op, BITS32 off USES_REGS)
|
|
{
|
|
BITS32 *c;
|
|
BITS32 n;
|
|
BITS32 *pt;
|
|
BITS32 *end;
|
|
Atom at;
|
|
|
|
LOCAL_exo_it = it;
|
|
LOCAL_exo_base = it->bcls;
|
|
LOCAL_exo_arity = it->arity;
|
|
LOCAL_exo_arg = it->udi_arg;
|
|
if (!it->links) {
|
|
c = (BITS32 *)it->udi_data;
|
|
n = it->nels;
|
|
pt = c;
|
|
end = c+(n-1);
|
|
} else if (it->links[off]) {
|
|
c = (BITS32 *)it->udi_data;
|
|
n = c[it->links[off]];
|
|
pt = c;
|
|
end = c+(it->links[off]+n);
|
|
// fprintf(stderr," %d links %d=%d \n", off, it->links[off], n);
|
|
} else {
|
|
if (!IsVarTerm(min)) {
|
|
Int x;
|
|
if (!IsIntegerTerm(min)) {
|
|
min = Yap_Eval(min);
|
|
if (!IsIntegerTerm(min)) {
|
|
Yap_Error(TYPE_ERROR_INTEGER, min, "data-base constraint");
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
x = IntegerOfTerm(min);
|
|
if (x >= IntegerOfTerm(S[LOCAL_exo_arg])) {
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
if (!IsVarTerm(max)) {
|
|
Int x;
|
|
if (!IsIntegerTerm(max)) {
|
|
max = Yap_Eval(max);
|
|
if (!IsIntegerTerm(max)) {
|
|
Yap_Error(TYPE_ERROR_INTEGER, max, "data-base constraint");
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
x = IntegerOfTerm(max);
|
|
if (x <= IntegerOfTerm(S[LOCAL_exo_arg])) {
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
|
}
|
|
|
|
if (!IsVarTerm(min)) {
|
|
Int x;
|
|
if (!IsIntegerTerm(min)) {
|
|
min = Yap_Eval(min);
|
|
if (!IsIntegerTerm(min)) {
|
|
Yap_Error(TYPE_ERROR_INTEGER, min, "data-base constraint");
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
x = IntegerOfTerm(min);
|
|
if (n > 8) {
|
|
int cmp;
|
|
pt = binary_search(pt, end, x PASS_REGS);
|
|
while ( pt < end+1 && (cmp = compare(pt, x PASS_REGS)) <= 0 ) {
|
|
if (cmp > 0) break;
|
|
pt++;
|
|
}
|
|
} else {
|
|
while ( pt < end+1 && compare(pt, x PASS_REGS) <= 0 ) {
|
|
pt++;
|
|
}
|
|
}
|
|
if (pt > end)
|
|
return FAILCODE;
|
|
}
|
|
if (!IsVarTerm(max)) {
|
|
Int x;
|
|
BITS32 *pt1;
|
|
Int n = end-pt;
|
|
|
|
if (!IsIntegerTerm(max)) {
|
|
max = Yap_Eval(max);
|
|
if (!IsIntegerTerm(max)) {
|
|
Yap_Error(TYPE_ERROR_INTEGER, max, "data-base constraint");
|
|
return FAILCODE;
|
|
}
|
|
}
|
|
x = IntegerOfTerm(max);
|
|
if (n > 8) {
|
|
int cmp;
|
|
pt1 = binary_search(pt, end, x PASS_REGS);
|
|
while ( pt1 >= pt && (cmp = compare(pt1, x PASS_REGS)) >= 0 ) {
|
|
if (cmp < 0) break;
|
|
pt1--;
|
|
}
|
|
} else {
|
|
pt1 = end;
|
|
while ( pt1 >= pt && compare(pt1, x PASS_REGS) >= 0 ) {
|
|
pt1--;
|
|
}
|
|
}
|
|
if (pt1 < pt)
|
|
return FAILCODE;
|
|
end = pt1;
|
|
}
|
|
if (IsVarTerm(op)) {
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
if (pt < end ) {
|
|
YENV[-1] = (CELL)( end );
|
|
YENV[-2] = (CELL)( pt+1 );
|
|
YENV -= 2;
|
|
return it->code;
|
|
}
|
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
|
}
|
|
at = AtomOfTerm(op);
|
|
if (at == AtomAny || at == AtomMinimum) {
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
} else if (at == AtomMaximum) {
|
|
S = EXO_OFFSET_TO_ADDRESS(it, end[0]);
|
|
} else if (at == AtomUnique) {
|
|
if (end-2 > pt)
|
|
return FAILCODE;
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
} else if (at == AtomMin) {
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
if (it->udi_free_args) {
|
|
BITS32 *ptn;
|
|
pt = c+(it->links[off]+n+1);
|
|
end = pt+n;
|
|
pt = NEXT_MIN(pt, end, min, max, it);
|
|
if (!pt)
|
|
return FAILCODE;
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
ptn = NEXT_DIFFERENT(pt, end, it);
|
|
if (ptn)
|
|
ptn = NEXT_MIN(ptn, end, min, max, it);
|
|
if ( ptn ) {
|
|
YENV[-1] = min; // what we are doing
|
|
YENV[-2] = max; // what we are doing
|
|
YENV[-3] = (CELL) end; // what we are doing
|
|
YENV[-4] = MkAtomTerm(AtomMin); // what we are doing
|
|
YENV[-5] = (CELL)( ptn ); // where we are in pt0 array
|
|
YENV -= 5;
|
|
return it->code;
|
|
}
|
|
}
|
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
|
} else if (at == AtomMax) {
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
if (it->udi_free_args) {
|
|
BITS32 *ptn;
|
|
end = c+(it->links[off]+n);
|
|
pt = end+n;
|
|
pt = NEXT_MAX(pt, end, min, max, it);
|
|
if (!pt)
|
|
return FAILCODE;
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
|
|
ptn = PREV_DIFFERENT(pt, end, it);
|
|
if (ptn)
|
|
ptn = NEXT_MAX(ptn, end, min, max, it);
|
|
if ( ptn ) {
|
|
YENV[-1] = min; // what we are doing
|
|
YENV[-2] = max; // what we are doing
|
|
YENV[-3] = (CELL) end; // what we are doing
|
|
YENV[-4] = MkAtomTerm(AtomMax); // what we are doing
|
|
YENV[-5] = (CELL)( ptn ); // where we are in pt0 array
|
|
YENV -= 5;
|
|
return it->code;
|
|
}
|
|
}
|
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
|
}
|
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
|
}
|
|
|
|
static yamop *
|
|
IntervalEnterUDIIndex(struct index_t *it USES_REGS)
|
|
{
|
|
Int i = it->udi_arg;
|
|
Term t = XREGS[i+1], a1;
|
|
BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S);
|
|
// printf("off=%d it=%p %p---%p\n", off, it, it->cls, S);
|
|
attvar_record *attv;
|
|
|
|
t = Deref(t);
|
|
if (!IsVarTerm(t))
|
|
return FALSE;
|
|
if(!IsAttVar(VarOfTerm(t)))
|
|
return Interval(it, MkVarTerm(), MkVarTerm(), MkVarTerm(), off PASS_REGS);
|
|
attv = RepAttVar(VarOfTerm(t));
|
|
t = attv->Atts;
|
|
a1 = ArgOfTerm(2,t);
|
|
if (IsVarTerm(a1)) {
|
|
Yap_Error(INSTANTIATION_ERROR, t, "executing exo_interval constraints");
|
|
return FAILCODE;
|
|
} else if (!IsApplTerm(a1)) {
|
|
Yap_Error(TYPE_ERROR_COMPOUND, a1, "executing exo_interval constraints");
|
|
return FAILCODE;
|
|
} else {
|
|
return Interval(it, ArgOfTerm(1,a1), ArgOfTerm(2,a1), ArgOfTerm(3,a1), off PASS_REGS);
|
|
}
|
|
}
|
|
|
|
static int
|
|
IntervalRetryUDIIndex(struct index_t *it USES_REGS)
|
|
{
|
|
CELL *w = (CELL*)(B+1)+it->arity;
|
|
if (IsVarTerm(w[2])) {
|
|
BITS32 *end = (BITS32 *) w[2],
|
|
*pt = (BITS32 *) w[1];
|
|
BITS32 f = *pt;
|
|
|
|
S = EXO_OFFSET_TO_ADDRESS(it, f);
|
|
if (pt++ == end) return FALSE;
|
|
w[1] = (CELL)pt;
|
|
} else {
|
|
BITS32 *pt0 = (BITS32 *)w[1];
|
|
BITS32 *pte = (BITS32 *)w[3];
|
|
Atom what = AtomOfTerm(w[2]);
|
|
Term min = w[5];
|
|
Term max = w[4];
|
|
|
|
S = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
|
|
if ( what == AtomMin ) {
|
|
pt0 = NEXT_DIFFERENT(pt0, pte, it);
|
|
if (pt0)
|
|
pt0 = NEXT_MIN(pt0, pte, min, max, it);
|
|
} else {
|
|
pt0 = PREV_DIFFERENT(pt0, pte, it);
|
|
if (pt0)
|
|
pt0 = NEXT_MAX(pt0, pte, min, max, it);
|
|
}
|
|
if (!pt0) {
|
|
return FALSE;
|
|
}
|
|
w[1] = (CELL)pt0;
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
static struct udi_control_block IntervalCB;
|
|
|
|
typedef struct exo_udi_access_t {
|
|
CRefitExoIndex refit;
|
|
} exo_udi_encaps_t;
|
|
|
|
static struct exo_udi_access_t ExoCB;
|
|
|
|
static void *
|
|
IntervalUdiInit (Term spec, int arg, int arity) {
|
|
ExoCB.refit = IntervalUDIRefitIndex;
|
|
return (void *)&ExoCB;
|
|
}
|
|
|
|
static void *
|
|
IntervalUdiInsert (void *control,
|
|
Term term, int arg, void *data)
|
|
{
|
|
CACHE_REGS
|
|
|
|
struct index_t **ip = (struct index_t **)term;
|
|
(*ip)->udi_arg = arg-1;
|
|
(ExoCB.refit)(ip, LOCAL_ibnds PASS_REGS);
|
|
(*ip)->udi_first = (void *)IntervalEnterUDIIndex;
|
|
(*ip)->udi_next = (void *)IntervalRetryUDIIndex;
|
|
return control;
|
|
}
|
|
|
|
static int IntervalUdiDestroy(void *control)
|
|
{
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
|
|
void Yap_udi_Interval_init(void) {
|
|
UdiControlBlock cb = &IntervalCB;
|
|
Atom name = Yap_LookupAtom("exo_interval");
|
|
memset((void *) cb,0, sizeof(*cb));
|
|
|
|
/*TODO: ask vitor why this gives a warning*/
|
|
cb->decl= (YAP_Atom)name;
|
|
Yap_MkEmptyWakeUp(name);
|
|
cb->init= IntervalUdiInit;
|
|
cb->insert=IntervalUdiInsert;
|
|
cb->search=NULL;
|
|
cb->destroy=IntervalUdiDestroy;
|
|
|
|
Yap_UdiRegister(cb);
|
|
}
|