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

Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-05-01 11:34:01 -05:00
commit d644ea494d
5 changed files with 133 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
C/exo_udi.c
View File

@ -36,8 +36,6 @@
#define YAP_Atom Atom
#include <udi.h>
#define arg_of_interest() 0
static int
compar(const void *ip0, const void *jp0) {
@ -59,7 +57,7 @@ compare(const BITS32 *ip, Int j USES_REGS) {
static void
RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
{
size_t sz;
struct index_t *it = *ip;
@ -67,8 +65,8 @@ RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
UInt arity = it->arity;
yamop *code;
/* hard-wired implementation for the range case */
Int i = arg_of_interest();
/* 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 */
@ -79,6 +77,7 @@ RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
if (!(it->udi_data = malloc(sz)))
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;
@ -87,21 +86,21 @@ RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
BITS32 *s0 = sorted;
BITS32 offset = it->key[i]/arity, offset0 = offset;
if (offset) {
*sorted++ = 0;
while (offset) {
*sorted++ = offset;
offset = it->links[offset];
}
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;
}
*sorted++ = 0;
do {
*sorted++ = offset;
offset = it->links[offset];
} while (offset);
// S = it->cls+it->arity*offset0; Yap_DebugPlWrite(S[1]);
// 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;
}
}
}
@ -144,7 +143,7 @@ Gt(struct index_t *it, Int x, BITS32 off USES_REGS)
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = arg_of_interest();
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) {
@ -177,7 +176,7 @@ Lt(struct index_t *it, Int x, BITS32 off USES_REGS)
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = arg_of_interest();
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) {
@ -210,7 +209,7 @@ Eq(struct index_t *it, Int x, BITS32 off USES_REGS)
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = arg_of_interest();
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) {
@ -249,7 +248,7 @@ All(struct index_t *it, BITS32 off USES_REGS)
LOCAL_exo_base = it->cls;
LOCAL_exo_arity = it->arity;
LOCAL_exo_arg = arg_of_interest();
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];
@ -264,11 +263,12 @@ All(struct index_t *it, BITS32 off USES_REGS)
}
static yamop *
RangeEnterUDIIndex(struct index_t *it USES_REGS)
IntervalEnterUDIIndex(struct index_t *it USES_REGS)
{
Int i = arg_of_interest();
Int i = it->udi_arg;
Term t = XREGS[i+1], a1;
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;
@ -324,7 +324,7 @@ RangeEnterUDIIndex(struct index_t *it USES_REGS)
}
static int
RangeRetryUDIIndex(struct index_t *it USES_REGS)
IntervalRetryUDIIndex(struct index_t *it USES_REGS)
{
CELL *w = (CELL*)(B+1);
BITS32 *end = (BITS32 *) w[it->arity+2],
@ -338,7 +338,7 @@ RangeRetryUDIIndex(struct index_t *it USES_REGS)
}
static struct udi_control_block RangeCB;
static struct udi_control_block IntervalCB;
typedef struct exo_udi_access_t {
CRefitExoIndex refit;
@ -347,43 +347,44 @@ typedef struct exo_udi_access_t {
static struct exo_udi_access_t ExoCB;
static void *
RangeUdiInit (Term spec, int arg, int arity) {
ExoCB.refit = RangeUDIRefitIndex;
IntervalUdiInit (Term spec, int arg, int arity) {
ExoCB.refit = IntervalUDIRefitIndex;
return (void *)&ExoCB;
}
static void *
RangeUdiInsert (void *control,
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 *)RangeEnterUDIIndex;
(*ip)->udi_next = (void *)RangeRetryUDIIndex;
(*ip)->udi_first = (void *)IntervalEnterUDIIndex;
(*ip)->udi_next = (void *)IntervalRetryUDIIndex;
return control;
}
static int RangeUdiDestroy(void *control)
static int IntervalUdiDestroy(void *control)
{
return TRUE;
}
void Yap_udi_range_init(void) {
UdiControlBlock cb = &RangeCB;
void Yap_udi_Interval_init(void) {
UdiControlBlock cb = &IntervalCB;
memset((void *) cb,0, sizeof(*cb));
/*TODO: ask vitor why this gives a warning*/
cb->decl=Yap_LookupAtom("range");
cb->decl=Yap_LookupAtom("exo_interval");
cb->init= RangeUdiInit;
cb->insert=RangeUdiInsert;
cb->init= IntervalUdiInit;
cb->insert=IntervalUdiInsert;
cb->search=NULL;
cb->destroy=RangeUdiDestroy;
cb->destroy=IntervalUdiDestroy;
Yap_UdiRegister(cb);
}

1
H/clause.h
View File

@ -177,6 +177,7 @@ typedef struct index_t {
size_t size;
yamop *code;
void *udi_data, *udi_first, *udi_next;
UInt udi_arg;
} Index_t;
INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);

29
docs/yap.tex
View File

@ -197,6 +197,7 @@ Subnodes of Library
* Apply:: SWI-Compatible Apply library.
* Association Lists:: Binary Tree Implementation of Association Lists.
* AVL Trees:: Predicates to add and lookup balanced binary trees.
* Exo Intervals:: Play with the UDI and exo-compilation
* Heaps:: Labelled binary tree where the key of each node is less
than or equal to the keys of its children.
* Lambda:: Ulrich Neumerkel's Lambda Library
@ -8698,6 +8699,7 @@ Library, Extensions, Built-ins, Top
* Block Diagram:: Block Diagrams of Prolog code
* Cleanup:: Call With registered Cleanup Calls
* DGraphs:: Directed Graphs Implemented With Red-Black Trees
* Exo Intervals:: Play with the UDI and exo-compilation
* Heaps:: Labelled binary tree where the key of each node is less
than or equal to the keys of its children.
* LAM:: LAM MPI
@ -9044,7 +9046,7 @@ have key @var{Key}.
@end table
@node AVL Trees, Heaps, Association Lists, Library
@node AVL Trees, Exo Intervals, Association Lists, Library
@section AVL Trees
@cindex AVL trees
@ -9082,7 +9084,30 @@ Lookup an element with key @var{Key} in the AVL tree
@end table
@node Heaps, Lists, AVL Trees, Library
@node Exo Intervals, Heaps, AVL Trees, Library
@section AVL Trees
@cindex AVL trees
This package assumes you use UDI exo-indexing, that is:
@example
:- udi(diagnoses(exo_interval,?,?)).
:- load_files(db, [consult(exo)]).
@end example
It is designed to optimise the following type of queries:
@example
?- max(X, diagnoses(X, 9, Y)).
?- min(X, diagnoses(X, 9, 36211117)).
?- X #< Y, min(X, diagnoses(9, X, 36211117)), diagnoses(Y, 9, _).
@end example
The first argument gives the time, the second the patient, and the
third the condition code. The first query should find the last time
the patient 9 had any code reported, the second looks for the first
report of code 36211117, and the last searches for reports after this
one. All queries be bound by constant or log(n) time.
@node Heaps, Lists, Exo Intervals, Library
@section Heaps
@cindex heap

1
library/Makefile.in
View File

@ -40,6 +40,7 @@ PROGRAMS= \
$(srcdir)/dbqueues.yap \
$(srcdir)/dbusage.yap \
$(srcdir)/dgraphs.yap \
$(srcdir)/exo_interval.yap \
$(srcdir)/expand_macros.yap \
$(srcdir)/gensym.yap \
$(srcdir)/hacks.yap \

63
library/exo_interval.yap Normal file
View File

@ -0,0 +1,63 @@
% This file has been included as an YAP library by Vitor Santos Costa, 2013
% it implements a very simple interval solver designed to interact with the exo
% data-base.
% It assumes simple queries and a contiguous interval,
% and does not really expect to do non-trivial
% constraint propagation and solving.
:- module(exo_interval,
[max/2,
min/2,
(#<)/2,
(#>)/2,
(#=)/2,
op(700, xfx, (#>)),
op(700, xfx, (#<)),
op(700, xfx, (#=))]).
:- meta_predicate
max(?,0),
min(?,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),
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),
call(G).
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).
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).
X #= Y :-
X = Y,
( var(X) -> put_attr(X, exo_interval, '='(Y) ) ; true ).
attribute_goals(X) -->
{ get_attr(X, exo_interval, Op) },
( { Op = max } -> [max(X)] ;
{ Op = min } -> [min(X)] ;
{ Op = '>'(Y) } -> [X #> Y] ;
{ Op = '<'(Y) } -> [X #< Y] ;
{ Op = '='(Y) } -> [X #= Y] ).