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

generalise interval handling

This commit is contained in:
Vitor Santos Costa 2013-04-29 11:58:05 -05:00
parent edbc21dcb0
commit 72cc5bc317
7 changed files with 334 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
C/exo.c
View File

@ -384,8 +384,11 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
if (i->is_udi) if (i->is_udi)
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS); return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
else return code; else return code;
} else } else if(i->is_udi) {
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
} else {
return i->code; return i->code;
}
} }
CELL CELL

428
C/exo_udi.c
View File

@ -51,216 +51,203 @@ static int
compare(const BITS32 *ip, Int j USES_REGS) { compare(const BITS32 *ip, Int j USES_REGS) {
BITS32 *bs = LOCAL_exo_base; BITS32 *bs = LOCAL_exo_base;
Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg]; Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg];
/* fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j); */ //fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j);
return IntOfTerm(i)-j; return IntOfTerm(i)-j;
} }
static void static void
IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS) IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
{ {
size_t sz; size_t sz;
struct index_t *it = *ip; struct index_t *it = *ip;
BITS32 *sorted0, *sorted; UInt arity = it->arity;
UInt arity = it->arity; yamop *code;
yamop *code;
/* hard-wired implementation for the Interval case */ /* hard-wired implementation for the Interval case */
Int i = it->udi_arg; Int i = it->udi_arg;
/* it is bound, use hash */ /* it is bound, use hash */
if (it->bmap & b[i]) return; if (it->bmap & b[i]) return;
/* no constraints, nothing to gain */ /* no constraints, nothing to gain */
if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return; if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return;
/* be conservative */ LOCAL_exo_base = it->cls;
sz = sizeof(BITS32)*(it->ntrys+it->nentries); LOCAL_exo_arity = it->arity;
/* allocate space */ LOCAL_exo_arg = i;
if (!(it->udi_data = malloc(sz))) if (!it->key) {
return; UInt ncls = it->ap->cs.p_code.NOfClauses, i;
sorted0 = sorted = (BITS32 *)it->udi_data; BITS32 *sorted;
sorted++; /* leave an initial hole */ /* handle ll variables */
LOCAL_exo_base = it->cls; sz = sizeof(BITS32)*(ncls);
LOCAL_exo_arity = it->arity; /* allocate space */
LOCAL_exo_arg = i; if (!(it->udi_data = malloc(sz)))
for (i=0; i < it->hsize; i++) { return;
if (it->key[i]) { sorted = (BITS32*)it->udi_data;
BITS32 *s0 = sorted; for (i=0; i< ncls; i++)
BITS32 offset = it->key[i]/arity, offset0 = offset; sorted[i] = i;
qsort(sorted, (size_t)ncls, sizeof(BITS32), compar);
it->links = NULL;
} else {
BITS32 *sorted0, *sorted;
*sorted++ = 0; /* be conservative */
do { sz = sizeof(BITS32)*(it->ntrys+it->nentries);
*sorted++ = offset; /* allocate space */
offset = it->links[offset]; if (!(it->udi_data = malloc(sz)))
} while (offset); return;
// S = it->cls+it->arity*offset0; Yap_DebugPlWrite(S[1]); sorted0 = sorted = (BITS32 *)it->udi_data;
// fprintf(stderr, " key[i]=%d offset=%d %d\n", it->key[i], offset0, (sorted-s0)-1); sorted++; /* leave an initial hole */
if (sorted-s0 == 2) { for (i=0; i < it->hsize; i++) {
it->links[offset0] = 0; if (it->key[i]) {
sorted = s0; BITS32 *s0 = sorted;
} else { BITS32 offset = it->key[i]/arity, offset0 = offset;
/* number of elements comes first */
*s0 = sorted - (s0+1);
qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar);
it->links[offset0] = s0-sorted0;
}
}
}
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 yamop * *sorted++ = 0;
Min(struct index_t *it, BITS32 off USES_REGS) do {
{ *sorted++ = offset;
if (it->links[off]) { offset = it->links[offset];
BITS32 *c = (BITS32 *)it->udi_data; } while (offset);
BITS32 f = c[it->links[off]+1]; // S = it->cls+it->arity*offset0; Yap_DebugPlWrite(S[1]);
S = it->cls+it->arity*f; // fprintf(stderr, " key[i]=%d offset=%d %d\n", it->key[i], offset0, (sorted-s0)-1);
} if (sorted-s0 == 2) {
return NEXTOP(NEXTOP(it->code,lp),lp); 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;
}
}
}
}
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 yamop * static BITS32 *
Max(struct index_t *it, BITS32 off USES_REGS) binary_search(BITS32 *start, BITS32 *end, Int x USES_REGS)
{ {
if (it->links[off]) { BITS32 *mid;
BITS32 *c = (BITS32 *)it->udi_data; while (start < end) {
BITS32 n = c[it->links[off]]; int cmp;
BITS32 f = c[it->links[off]+n]; mid = start + (end-start)/2;
S = it->cls+it->arity*f; cmp = compare(mid, x PASS_REGS);
} if (!cmp)
return NEXTOP(NEXTOP(it->code,lp),lp); return mid;
} if (cmp > 0) {
end = mid-1;
} else
start = mid+1;
}
return start;
}
static yamop * static yamop *
Gt(struct index_t *it, Int x, BITS32 off USES_REGS) Interval(struct index_t *it, Term min, Term max, Term op, BITS32 off USES_REGS)
{ {
if (it->links[off]) { BITS32 *c;
BITS32 *c = (BITS32 *)it->udi_data; BITS32 n;
BITS32 n = c[it->links[off]]; BITS32 *pt;
BITS32 *end;
Atom at;
LOCAL_exo_base = it->cls; LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity; LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = it->udi_arg; LOCAL_exo_arg = it->udi_arg;
BITS32 *pt = c+(it->links[off]+1); if (!it->links) {
BITS32 *end = c+(it->links[off]+(n+2)); c = (BITS32 *)it->udi_data;
if (n > 8 && FALSE) { n = it->nels;
// start = binary_search(start,end, x, it); pt = c;
} else { end = c+(n-1);
while ( pt < end && compare(pt, x PASS_REGS) <= 0 ) { } else if (it->links[off]) {
pt++; c = (BITS32 *)it->udi_data;
} n = c[it->links[off]];
} pt = c+(it->links[off]+1);
if (pt == end) end = c+(it->links[off]+n);
return FAILCODE; } else {
S = it->cls+it->arity*pt[0]; return NEXTOP(NEXTOP(it->code,lp),lp);
end --; }
if (pt < end ) {
YENV[-2] = (CELL)( pt+1 );
YENV[-1] = (CELL)( end );
YENV -= 2;
return it->code;
}
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
static yamop * if (!IsVarTerm(min)) {
Lt(struct index_t *it, Int x, BITS32 off USES_REGS) Int x;
{ if (!IsIntegerTerm(min)) {
if (it->links[off]) { min = Yap_Eval(min);
BITS32 *c = (BITS32 *)it->udi_data; if (!IsIntegerTerm(min)) {
BITS32 n = c[it->links[off]]; Yap_Error(TYPE_ERROR_INTEGER, min, "data-base constraint");
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = it->udi_arg;
BITS32 *start = c+(it->links[off]+1), *pt = start+1;
BITS32 *end = c+(it->links[off]+(n+2));
if (n > 8 && FALSE) {
// start = binary_search(start,end, x, it);
} else {
if (compare(start, x PASS_REGS) >= 0)
return FAILCODE; return FAILCODE;
while ( pt < end && compare(pt, x PASS_REGS) < 0 ) {
pt++;
} }
} }
S = it->cls+it->arity*start[0]; x = IntegerOfTerm(min);
pt --; if (n > 8) {
if ( pt > start ) { int cmp;
YENV[-2] = (CELL)( start+1 ); pt = binary_search(pt, end, x PASS_REGS);
YENV[-1] = (CELL)( pt ); while ( pt < end+1 && (cmp = compare(pt, x PASS_REGS)) <= 0 ) {
YENV -= 2; if (cmp > 0) break;
return it->code; pt++;
} }
} } else {
return NEXTOP(NEXTOP(it->code,lp),lp); 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;
static yamop * if (!IsIntegerTerm(max)) {
Eq(struct index_t *it, Int x, BITS32 off USES_REGS) max = Yap_Eval(max);
{ if (!IsIntegerTerm(max)) {
if (it->links[off]) { Yap_Error(TYPE_ERROR_INTEGER, max, "data-base constraint");
BITS32 *c = (BITS32 *)it->udi_data;
BITS32 n = c[it->links[off]];
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = it->udi_arg;
BITS32 *end = c+(it->links[off]+(n+2));
BITS32 *start, *pt = c+(it->links[off]+1);
if (n > 8 && FALSE) {
// start = binary_search(start,end, x, it);
} else {
Int c = 0;
while ( pt < end && (c = compare(pt, x PASS_REGS)) < 0 ) {
pt++;
}
if (pt == end || c)
return FAILCODE; return FAILCODE;
start = pt;
pt ++;
while ( pt < end && (c = compare(pt, x PASS_REGS)) == 0 ) {
pt++;
} }
} }
S = it->cls+it->arity*start[0]; x = IntegerOfTerm(max);
pt --; if (n > 8) {
if ( pt > start ) { int cmp;
YENV[-2] = (CELL)( start+1 ); pt1 = binary_search(pt, end, x PASS_REGS);
YENV[-1] = (CELL)( pt ); while ( pt1 >= pt && (cmp = compare(pt1, x PASS_REGS)) >= 0 ) {
YENV -= 2; if (cmp < 0) break;
return it->code; pt1--;
} }
} } else {
return NEXTOP(NEXTOP(it->code,lp),lp); pt1 = end;
} while ( pt1 >= pt && compare(pt1, x PASS_REGS) >= 0 ) {
pt1--;
static yamop * }
All(struct index_t *it, BITS32 off USES_REGS) }
{ if (pt1 < pt)
if (it->links[off]) { return FAILCODE;
BITS32 *c = (BITS32 *)it->udi_data; end = pt1;
BITS32 n = c[it->links[off]]; }
if (IsVarTerm(op)) {
LOCAL_exo_base = it->cls; S = it->cls+it->arity*pt[0];
LOCAL_exo_arity = it->arity; if (pt < end ) {
LOCAL_exo_arg = it->udi_arg; YENV[-2] = (CELL)( pt+1 );
BITS32 *start = c+(it->links[off]+1); YENV[-1] = (CELL)( end );
BITS32 *end = c+(it->links[off]+(n+1)); YENV -= 2;
S = it->cls+it->arity*start[0]; return it->code;
if ( end > start ) { }
YENV[-2] = (CELL)( start+1 ); return NEXTOP(NEXTOP(it->code,lp),lp);
YENV[-1] = (CELL)( end ); }
YENV -= 2; at = AtomOfTerm(op);
return it->code; if (at == AtomAny || at == AtomMin) {
} S = it->cls+it->arity*pt[0];
} } else if (at == AtomMax) {
return NEXTOP(NEXTOP(it->code,lp),lp); S = it->cls+it->arity*end[0];
} } else if (at == AtomUnique) {
if (end-2 > pt)
return FAILCODE;
S = it->cls+it->arity*pt[0];
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
static yamop * static yamop *
IntervalEnterUDIIndex(struct index_t *it USES_REGS) IntervalEnterUDIIndex(struct index_t *it USES_REGS)
@ -270,57 +257,24 @@ IntervalEnterUDIIndex(struct index_t *it USES_REGS)
BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity; BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity;
// printf("off=%d it=%p %p---%p\n", off, it, it->cls, S); // printf("off=%d it=%p %p---%p\n", off, it, it->cls, S);
attvar_record *attv; attvar_record *attv;
Atom at;
t = Deref(t); t = Deref(t);
if (!IsVarTerm(t)) if (!IsVarTerm(t))
return FALSE; return FALSE;
if(!IsAttVar(VarOfTerm(t))) if(!IsAttVar(VarOfTerm(t)))
return FALSE; return Interval(it, MkVarTerm(), MkVarTerm(), MkVarTerm(), off PASS_REGS);
attv = RepAttVar(VarOfTerm(t)); attv = RepAttVar(VarOfTerm(t));
t = attv->Atts; t = attv->Atts;
a1 = ArgOfTerm(2,t); a1 = ArgOfTerm(2,t);
if (IsAtomTerm(a1)) { if (IsVarTerm(a1)) {
at = AtomOfTerm(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 { } else {
Functor f = FunctorOfTerm(a1); return Interval(it, ArgOfTerm(1,a1), ArgOfTerm(2,a1), ArgOfTerm(3,a1), off PASS_REGS);
at = NameOfFunctor(f);
} }
if (at == AtomMax) {
return Max(it, off PASS_REGS);
} else if (at == AtomMin) {
return Min(it, off PASS_REGS);
} else if (at == AtomGT) {
Term arg = ArgOfTerm(1, a1);
if (IsVarTerm(arg))
return All(it, off PASS_REGS);
else if (!IsIntTerm(arg)) {
Yap_Error(TYPE_ERROR_INTEGER, arg, "data-base constraint");
return FAILCODE;
}
return Gt(it, IntOfTerm(arg), off PASS_REGS);
} else if (at == AtomLT) {
Term arg = ArgOfTerm(1, a1);
if (IsVarTerm(arg))
return All(it, off PASS_REGS);
else if (!IsIntTerm(arg)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
return FAILCODE;
}
return Lt(it, IntOfTerm(arg), off PASS_REGS);
} else if (at == AtomEQ) {
Term arg = ArgOfTerm(1, a1);
if (IsVarTerm(arg))
return All(it, off PASS_REGS);
else if (!IsIntTerm(arg)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
return FAILCODE;
}
return Eq(it, IntOfTerm(arg), off PASS_REGS);
}
return FAILCODE;
} }
static int static int
@ -328,7 +282,7 @@ IntervalRetryUDIIndex(struct index_t *it USES_REGS)
{ {
CELL *w = (CELL*)(B+1); CELL *w = (CELL*)(B+1);
BITS32 *end = (BITS32 *) w[it->arity+2], BITS32 *end = (BITS32 *) w[it->arity+2],
*pt = (BITS32 *) w[it->arity+1]; *pt = (BITS32 *) w[it->arity+1];
BITS32 f = *pt; BITS32 f = *pt;
S = it->cls+it->arity*f; S = it->cls+it->arity*f;

2
H/iatoms.h
View File

@ -11,6 +11,7 @@
AtomAlarm = Yap_FullLookupAtom("$alarm"); AtomAlarm = Yap_FullLookupAtom("$alarm");
AtomAlias = Yap_LookupAtom("alias"); AtomAlias = Yap_LookupAtom("alias");
AtomAltNot = Yap_LookupAtom("not"); AtomAltNot = Yap_LookupAtom("not");
AtomAny = Yap_LookupAtom("any");
AtomAppend = Yap_LookupAtom("append"); AtomAppend = Yap_LookupAtom("append");
AtomArg = Yap_LookupAtom("arg"); AtomArg = Yap_LookupAtom("arg");
AtomArray = Yap_FullLookupAtom("$array"); AtomArray = Yap_FullLookupAtom("$array");
@ -311,6 +312,7 @@
AtomUndefp = Yap_FullLookupAtom("$undefp"); AtomUndefp = Yap_FullLookupAtom("$undefp");
AtomUnderflow = Yap_LookupAtom("underflow"); AtomUnderflow = Yap_LookupAtom("underflow");
AtomUnificationStack = Yap_LookupAtom("unification_stack"); AtomUnificationStack = Yap_LookupAtom("unification_stack");
AtomUnique = Yap_LookupAtom("unique");
AtomUnsignedByte = Yap_LookupAtom("unsigned_byte"); AtomUnsignedByte = Yap_LookupAtom("unsigned_byte");
AtomUnsignedChar = Yap_LookupAtom("unsigned_char"); AtomUnsignedChar = Yap_LookupAtom("unsigned_char");
AtomUser = Yap_LookupAtom("user"); AtomUser = Yap_LookupAtom("user");

2
H/ratoms.h
View File

@ -11,6 +11,7 @@
AtomAlarm = AtomAdjust(AtomAlarm); AtomAlarm = AtomAdjust(AtomAlarm);
AtomAlias = AtomAdjust(AtomAlias); AtomAlias = AtomAdjust(AtomAlias);
AtomAltNot = AtomAdjust(AtomAltNot); AtomAltNot = AtomAdjust(AtomAltNot);
AtomAny = AtomAdjust(AtomAny);
AtomAppend = AtomAdjust(AtomAppend); AtomAppend = AtomAdjust(AtomAppend);
AtomArg = AtomAdjust(AtomArg); AtomArg = AtomAdjust(AtomArg);
AtomArray = AtomAdjust(AtomArray); AtomArray = AtomAdjust(AtomArray);
@ -311,6 +312,7 @@
AtomUndefp = AtomAdjust(AtomUndefp); AtomUndefp = AtomAdjust(AtomUndefp);
AtomUnderflow = AtomAdjust(AtomUnderflow); AtomUnderflow = AtomAdjust(AtomUnderflow);
AtomUnificationStack = AtomAdjust(AtomUnificationStack); AtomUnificationStack = AtomAdjust(AtomUnificationStack);
AtomUnique = AtomAdjust(AtomUnique);
AtomUnsignedByte = AtomAdjust(AtomUnsignedByte); AtomUnsignedByte = AtomAdjust(AtomUnsignedByte);
AtomUnsignedChar = AtomAdjust(AtomUnsignedChar); AtomUnsignedChar = AtomAdjust(AtomUnsignedChar);
AtomUser = AtomAdjust(AtomUser); AtomUser = AtomAdjust(AtomUser);

4
H/tatoms.h
View File

@ -20,6 +20,8 @@
#define AtomAlias Yap_heap_regs->AtomAlias_ #define AtomAlias Yap_heap_regs->AtomAlias_
Atom AtomAltNot_; Atom AtomAltNot_;
#define AtomAltNot Yap_heap_regs->AtomAltNot_ #define AtomAltNot Yap_heap_regs->AtomAltNot_
Atom AtomAny_;
#define AtomAny Yap_heap_regs->AtomAny_
Atom AtomAppend_; Atom AtomAppend_;
#define AtomAppend Yap_heap_regs->AtomAppend_ #define AtomAppend Yap_heap_regs->AtomAppend_
Atom AtomArg_; Atom AtomArg_;
@ -620,6 +622,8 @@
#define AtomUnderflow Yap_heap_regs->AtomUnderflow_ #define AtomUnderflow Yap_heap_regs->AtomUnderflow_
Atom AtomUnificationStack_; Atom AtomUnificationStack_;
#define AtomUnificationStack Yap_heap_regs->AtomUnificationStack_ #define AtomUnificationStack Yap_heap_regs->AtomUnificationStack_
Atom AtomUnique_;
#define AtomUnique Yap_heap_regs->AtomUnique_
Atom AtomUnsignedByte_; Atom AtomUnsignedByte_;
#define AtomUnsignedByte Yap_heap_regs->AtomUnsignedByte_ #define AtomUnsignedByte Yap_heap_regs->AtomUnsignedByte_
Atom AtomUnsignedChar_; Atom AtomUnsignedChar_;

157
library/exo_interval.yap
View File

@ -9,48 +9,85 @@
:- module(exo_interval, :- module(exo_interval,
[max/2, [max/2,
min/2, min/2,
any/2,
max/3,
min/3,
any/3,
(#<)/2, (#<)/2,
(#>)/2, (#>)/2,
(#=<)/2,
(#>=)/2,
(#=)/2, (#=)/2,
op(700, xfx, (#>)), op(700, xfx, (#>)),
op(700, xfx, (#<)), op(700, xfx, (#<)),
op(700, xfx, (#>=)),
op(700, xfx, (#=<)),
op(700, xfx, (#=))]). op(700, xfx, (#=))]).
:- meta_predicate :- meta_predicate max(?,0,?), min(?,0,?), any(?,0,?).
max(?,0),
min(?,0).
max(X, G) :- max(X, G, X) :-
attvar(X), insert_atts(X, i(_,_,max)),
get_attr(X, exo_interval, Atts), !,
throw(error('cannot handle combination of attributes ')).
max(X, G) :-
var(X),
put_attr(X, exo_interval, max),
call(G). call(G).
min(X, G) :- min(X, G, X) :-
attvar(X), insert_atts(X, i(_,_,min)),
get_attr(X, exo_interval, Atts), !, call(G).
throw(error('cannot handle combination of attributes ')).
min(X, G) :- max(X, X) :-
var(X), insert_atts(X, i(_,_,max)).
put_attr(X, exo_interval, min),
call(G). min(X, X) :-
insert_atts(X, i(_,_,min)).
X #> Y :- X #> Y :-
( var(X) -> put_attr(X, exo_interval, '>'(Y) ) ; true ), ( var(X) -> insert_atts(X, i(Y,_,_))
( var(Y) -> put_attr(X, exo_interval, '<'(X) ) ; true ), ;
when((nonvar(X), nonvar(Y)), X > Y). ( var(Y) -> insert_atts(Y, i(_,X,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(_,X,_))
;
X > Y
).
X #>= Y :-
( var(X) -> insert_atts(X, i(Y-1,_,_))
;
( var(Y) -> insert_atts(Y, i(X+1,_,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(_,X+1,_))
;
X >= Y
).
X #< Y :- X #< Y :-
( var(X) -> put_attr(X, exo_interval, '<'(Y) ) ; true ), ( var(X) -> insert_atts(X, i(_,Y,_))
( var(Y) -> put_attr(X, exo_interval, '>'(X) ) ; true ), ;
when((nonvar(X), nonvar(Y)), X < Y). ( var(Y) -> insert_atts(Y, i(X,_,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(X,_,_))
;
X < Y
).
X #= Y :- X #=< Y :-
X = Y, ( var(X) -> insert_atts(X, i(Y+1,_,_))
( var(X) -> put_attr(X, exo_interval, '='(Y) ) ; true ). ;
( var(Y) -> insert_atts(Y, i(X-1,_,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(X-1,_,_))
;
X =< Y
).
attribute_goals(X) --> attribute_goals(X) -->
{ get_attr(X, exo_interval, Op) }, { get_attr(X, exo_interval, Op) },
@ -58,6 +95,70 @@ attribute_goals(X) -->
{ Op = min } -> [min(X)] ; { Op = min } -> [min(X)] ;
{ Op = '>'(Y) } -> [X #> Y] ; { Op = '>'(Y) } -> [X #> Y] ;
{ Op = '<'(Y) } -> [X #< Y] ; { Op = '<'(Y) } -> [X #< Y] ;
{ Op = '='(Y) } -> [X #= Y] ). { Op = range(A,B,C) } ->
range_min(A,X),
range_max(B,X),
range_op(C, X)
).
range_min(Y, _X) -->
{ var(Y) }, !,
[].
range_min(Y, X) -->
[X #> Y].
range_max(Y, _X) -->
{ var(Y) }, !,
[].
range_max(Y, X) -->
[X #< Y].
range_op(Y, _X) -->
{ var(Y) }, !,
[].
range_op(Y, X) -->
{ Op =.. [Y, X] },
[Op].
insert_atts(V, Att) :-
( nonvar(V) ->
throw( error(uninstantion_error(V), exo_interval) )
; attvar(V) ->
get_attr(V, exo_interval, Att0),
expand_atts(Att, Att0, NAtt)
;
NAtt = Att
),
put_attr(V, exo_interval, NAtt).
expand_atts(i(A1, B1, C1), i(A2, B2, C2), i(A3,B3,C3)) :-
expand_min(A1, A2, A3),
expand_max(B1, B2, B3),
expand_op(C1, C2, C3).
expand_min(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
ground(A1), ground(A2) -> A3 is max(A1,A2) ;
A3 = max(A1,A2)
).
expand_max(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
ground(A1), ground(A2) -> A3 is min(A1,A2) ;
A3 = min(A1,A2)
).
expand_op(A1, A2, A3) :-
(var(A1) -> A3 = A2;
var(A2) -> A3 = A1;
A1 == A2 -> A3 = A1;
A1 == unique -> A3 = unique;
A2 == unique -> A3 = unique;
A2 == min, A1 = max -> A3 = unique;
A1 == min, A2 = max -> A3 = unique;
A1 == min -> A3 = min; A2 == min -> A3 = min;
A1 == max -> A3 = max; A2 == max -> A3 = max;
A3 = single
).

2
misc/ATOMS
View File

@ -16,6 +16,7 @@ A AfUnix N "AF_UNIX"
A Alarm F "$alarm" A Alarm F "$alarm"
A Alias N "alias" A Alias N "alias"
A AltNot N "not" A AltNot N "not"
A Any N "any"
A Append N "append" A Append N "append"
A Arg N "arg" A Arg N "arg"
A Array F "$array" A Array F "$array"
@ -316,6 +317,7 @@ A Undefined N "undefined"
A Undefp F "$undefp" A Undefp F "$undefp"
A Underflow N "underflow" A Underflow N "underflow"
A UnificationStack N "unification_stack" A UnificationStack N "unification_stack"
A Unique N "unique"
A UnsignedByte N "unsigned_byte" A UnsignedByte N "unsigned_byte"
A UnsignedChar N "unsigned_char" A UnsignedChar N "unsigned_char"
A User N "user" A User N "user"