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

generalise interval handling

Browse Source
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,9 +384,12 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
if (i->is_udi)
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
else return code;
} else
} else if(i->is_udi) {
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
} else {
return i->code;
}
}
CELL
Yap_NextExo(choiceptr cptr, struct index_t *it)

290
C/exo_udi.c
View File

@ -51,7 +51,7 @@ static int
compare(const BITS32 *ip, Int j USES_REGS) {
BITS32 *bs = LOCAL_exo_base;
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;
}
@ -61,7 +61,6 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
{
size_t sz;
struct index_t *it = *ip;
BITS32 *sorted0, *sorted;
UInt arity = it->arity;
yamop *code;
@ -71,6 +70,25 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
if (it->bmap & b[i]) return;
/* no constraints, nothing to gain */
if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return;
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = 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 = malloc(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 */
sz = sizeof(BITS32)*(it->ntrys+it->nentries);
/* allocate space */
@ -78,9 +96,6 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
return;
sorted0 = sorted = (BITS32 *)it->udi_data;
sorted++; /* leave an initial hole */
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = i;
for (i=0; i < it->hsize; i++) {
if (it->key[i]) {
BITS32 *s0 = sorted;
@ -104,6 +119,7 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
}
}
}
}
it->is_udi = i+1;
code = it->code;
code->opc = Yap_opcode(_try_exo_udi);
@ -111,153 +127,124 @@ IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
code->opc = Yap_opcode(_retry_exo_udi);
}
static yamop *
Min(struct index_t *it, BITS32 off USES_REGS)
static BITS32 *
binary_search(BITS32 *start, BITS32 *end, Int x USES_REGS)
{
if (it->links[off]) {
BITS32 *c = (BITS32 *)it->udi_data;
BITS32 f = c[it->links[off]+1];
S = it->cls+it->arity*f;
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 NEXTOP(NEXTOP(it->code,lp),lp);
return start;
}
static yamop *
Max(struct index_t *it, 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 *)it->udi_data;
BITS32 n = c[it->links[off]];
BITS32 f = c[it->links[off]+n];
S = it->cls+it->arity*f;
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
static yamop *
Gt(struct index_t *it, Int x, BITS32 off USES_REGS)
{
if (it->links[off]) {
BITS32 *c = (BITS32 *)it->udi_data;
BITS32 n = c[it->links[off]];
BITS32 *c;
BITS32 n;
BITS32 *pt;
BITS32 *end;
Atom at;
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = it->udi_arg;
BITS32 *pt = c+(it->links[off]+1);
BITS32 *end = c+(it->links[off]+(n+2));
if (n > 8 && FALSE) {
// start = binary_search(start,end, x, it);
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+(it->links[off]+1);
end = c+(it->links[off]+n);
} else {
while ( pt < end && compare(pt, x PASS_REGS) <= 0 ) {
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)
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 = it->cls+it->arity*pt[0];
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 *
Lt(struct index_t *it, Int x, BITS32 off USES_REGS)
{
if (it->links[off]) {
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 *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)
at = AtomOfTerm(op);
if (at == AtomAny || at == AtomMin) {
S = it->cls+it->arity*pt[0];
} else if (at == AtomMax) {
S = it->cls+it->arity*end[0];
} else if (at == AtomUnique) {
if (end-2 > pt)
return FAILCODE;
while ( pt < end && compare(pt, x PASS_REGS) < 0 ) {
pt++;
}
}
S = it->cls+it->arity*start[0];
pt --;
if ( pt > start ) {
YENV[-2] = (CELL)( start+1 );
YENV[-1] = (CELL)( pt );
YENV -= 2;
return it->code;
}
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
static yamop *
Eq(struct index_t *it, Int x, BITS32 off USES_REGS)
{
if (it->links[off]) {
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;
start = pt;
pt ++;
while ( pt < end && (c = compare(pt, x PASS_REGS)) == 0 ) {
pt++;
}
}
S = it->cls+it->arity*start[0];
pt --;
if ( pt > start ) {
YENV[-2] = (CELL)( start+1 );
YENV[-1] = (CELL)( pt );
YENV -= 2;
return it->code;
}
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
static yamop *
All(struct index_t *it, BITS32 off USES_REGS)
{
if (it->links[off]) {
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 *start = c+(it->links[off]+1);
BITS32 *end = c+(it->links[off]+(n+1));
S = it->cls+it->arity*start[0];
if ( end > start ) {
YENV[-2] = (CELL)( start+1 );
YENV[-1] = (CELL)( end );
YENV -= 2;
return it->code;
}
S = it->cls+it->arity*pt[0];
}
return NEXTOP(NEXTOP(it->code,lp),lp);
}
@ -270,57 +257,24 @@ IntervalEnterUDIIndex(struct index_t *it USES_REGS)
BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity;
// printf("off=%d it=%p %p---%p\n", off, it, it->cls, S);
attvar_record *attv;
Atom at;
t = Deref(t);
if (!IsVarTerm(t))
return FALSE;
if(!IsAttVar(VarOfTerm(t)))
return FALSE;
return Interval(it, MkVarTerm(), MkVarTerm(), MkVarTerm(), off PASS_REGS);
attv = RepAttVar(VarOfTerm(t));
t = attv->Atts;
a1 = ArgOfTerm(2,t);
if (IsAtomTerm(a1)) {
at = AtomOfTerm(a1);
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 {
Functor f = FunctorOfTerm(a1);
at = NameOfFunctor(f);
return Interval(it, ArgOfTerm(1,a1), ArgOfTerm(2,a1), ArgOfTerm(3,a1), off PASS_REGS);
}
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

2
H/iatoms.h
View File

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

2
H/ratoms.h
View File

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

4
H/tatoms.h
View File

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

155
library/exo_interval.yap
View File

@ -9,48 +9,85 @@
:- module(exo_interval,
[max/2,
min/2,
any/2,
max/3,
min/3,
any/3,
(#<)/2,
(#>)/2,
(#=<)/2,
(#>=)/2,
(#=)/2,
op(700, xfx, (#>)),
op(700, xfx, (#<)),
op(700, xfx, (#>=)),
op(700, xfx, (#=<)),
op(700, xfx, (#=))]).
:- meta_predicate
max(?,0),
min(?,0).
:- meta_predicate max(?,0,?), min(?,0,?), any(?,0,?).
max(X, G) :-
attvar(X),
get_attr(X, exo_interval, Atts), !,
throw(error('cannot handle combination of attributes ')).
max(X, G) :-
var(X),
put_attr(X, exo_interval, max),
max(X, G, X) :-
insert_atts(X, i(_,_,max)),
call(G).
min(X, G) :-
attvar(X),
get_attr(X, exo_interval, Atts), !,
throw(error('cannot handle combination of attributes ')).
min(X, G) :-
var(X),
put_attr(X, exo_interval, min),
min(X, G, X) :-
insert_atts(X, i(_,_,min)),
call(G).
max(X, X) :-
insert_atts(X, i(_,_,max)).
min(X, X) :-
insert_atts(X, i(_,_,min)).
X #> Y :-
( var(X) -> put_attr(X, exo_interval, '>'(Y) ) ; true ),
( var(Y) -> put_attr(X, exo_interval, '<'(X) ) ; true ),
when((nonvar(X), nonvar(Y)), X > Y).
( var(X) -> insert_atts(X, i(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 :-
( var(X) -> put_attr(X, exo_interval, '<'(Y) ) ; true ),
( var(Y) -> put_attr(X, exo_interval, '>'(X) ) ; true ),
when((nonvar(X), nonvar(Y)), X < Y).
( var(X) -> insert_atts(X, i(_,Y,_))
;
( var(Y) -> insert_atts(Y, i(X,_,_) ) ;
true
)
;
var(Y) -> insert_atts(Y, i(X,_,_))
;
X < Y
).
X #= Y :-
X = Y,
( var(X) -> put_attr(X, exo_interval, '='(Y) ) ; true ).
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
).
attribute_goals(X) -->
{ get_attr(X, exo_interval, Op) },
@ -58,6 +95,70 @@ attribute_goals(X) -->
{ Op = min } -> [min(X)] ;
{ 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 Alias N "alias"
A AltNot N "not"
A Any N "any"
A Append N "append"
A Arg N "arg"
A Array F "$array"
@ -316,6 +317,7 @@ A Undefined N "undefined"
A Undefp F "$undefp"
A Underflow N "underflow"
A UnificationStack N "unification_stack"
A Unique N "unique"
A UnsignedByte N "unsigned_byte"
A UnsignedChar N "unsigned_char"
A User N "user"