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

C/exo_udi.c

@@ -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 */
+  /* hard-wired implementation for the Interval case */
-  Int i = arg_of_interest();
+  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;
-	*sorted++ = 0;
+      do {
-	while (offset) {
+	*sorted++ = offset;
-	  *sorted++ = offset;
+	offset = it->links[offset];
-	  offset = it->links[offset];
+      } while (offset);
-	}
+      //      S = it->cls+it->arity*offset0; Yap_DebugPlWrite(S[1]);
-	if (sorted-s0 == 2) {
+      // fprintf(stderr, " key[i]=%d offset=%d  %d\n", it->key[i], offset0, (sorted-s0)-1);
-	  it->links[offset0] = 0;
+      if (sorted-s0 == 2) {
-	  sorted = s0;
+	it->links[offset0] = 0;
-	} else {
+	sorted = s0;
-	  /* number of elements comes first */
+      } else {
-	  *s0 = sorted - (s0+1);
+	/* number of elements comes first */
-	  qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar); 
+	*s0 = sorted - (s0+1);
-	  it->links[offset0] = s0-sorted0;
+	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) {
+IntervalUdiInit (Term spec, int arg, int arity) {
-  ExoCB.refit = RangeUDIRefitIndex;
+  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_first = (void *)IntervalEnterUDIIndex;
-  (*ip)->udi_next = (void *)RangeRetryUDIIndex;
+  (*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) {
+void Yap_udi_Interval_init(void) {
-  UdiControlBlock cb = &RangeCB;
+  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->init= IntervalUdiInit;
-  cb->insert=RangeUdiInsert;
+  cb->insert=IntervalUdiInsert;
   cb->search=NULL;
-  cb->destroy=RangeUdiDestroy;
+  cb->destroy=IntervalUdiDestroy;
 
   Yap_UdiRegister(cb);
 }

H/clause.h

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

docs/yap.tex

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

library/Makefile.in

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

library/exo_interval.yap

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