YAP 7.1.0
exo_udi.c
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: exo.c *
12* comments: Exo compilation *
13* *
14* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ * *
15* $Log: not supported by cvs2svn $ *
16* *
17* *
18*************************************************************************/
19
20#include "Yap.h"
21#include "clause.h"
22#include "yapio.h"
23#include "YapEval.h"
24#include "tracer.h"
25#include "attvar.h"
26#ifdef YAPOR
27#include "or.macros.h"
28#endif /* YAPOR */
29#ifdef TABLING
30#include "tab.macros.h"
31#endif /* TABLING */
32#if HAVE_STRING_H
33#include <string.h>
34#endif
35#include <udi.h>
36
37
38static int
39compar(const void *ip0, const void *jp0) {
40 CACHE_REGS
41 BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
42 Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
43 Term j = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *jp)[LOCAL_exo_arg];
44 //fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), IntOfTerm(j));
45 return IntOfTerm(i)-IntOfTerm(j);
46}
47
48static Int
49cmp_extra_args(CELL *si, CELL *sj, struct index_t *it)
50{
51 UInt m = it->udi_free_args;
52 UInt m0 = 1, x;
53
54 for (x=0; x< it->arity; x++) {
55 if (m0 & m) {
56 if (si[x] != sj[x]) {
57 if (IsIntTerm(si[x]))
58 return IntOfTerm(si[x])-IntOfTerm(sj[x]);
59 return AtomOfTerm(si[x])-AtomOfTerm(sj[x]);
60 }
61 m -= m0;
62 if (m == 0)
63 return 0;
64 }
65 m0 <<= 1;
66 }
67 return 0;
68}
69
70static int
71compar2(const void *ip0, const void *jp0) {
72 CACHE_REGS
73 BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
74 struct index_t *it = LOCAL_exo_it;
75 Term* si = EXO_OFFSET_TO_ADDRESS(it, *ip);
76 Term* sj = EXO_OFFSET_TO_ADDRESS(it, *jp);
77 int cmp = cmp_extra_args(si, sj, it);
78 if (cmp)
79 return cmp;
80 return IntOfTerm(si[LOCAL_exo_arg])-IntOfTerm(sj[LOCAL_exo_arg]);
81}
82
83static int
84compare(const BITS32 *ip, Int j USES_REGS) {
85 Term i = EXO_OFFSET_TO_ADDRESS(LOCAL_exo_it, *ip)[LOCAL_exo_arg];
86 //fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j);
87 return IntOfTerm(i)-j;
88}
89
90static UInt free_args(UInt b[], UInt arity, UInt i) {
91 UInt j;
92 UInt rc = 0;
93
94 for (j=0; j<arity; j++) {
95 if (i !=j && b[j] == 0)
96 rc |= 1<<j;
97 }
98 return rc;
99}
100
101static BITS32*
102NEXT_DIFFERENT(BITS32 *pt0, BITS32 *pte, struct index_t *it)
103{
104 Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
105 Term* sj;
106
107 do {
108 pt0++;
109 if (pt0 == pte)
110 return NULL;
111 sj = EXO_OFFSET_TO_ADDRESS(it, *pt0);
112 } while (!cmp_extra_args(si, sj, it));
113 return pt0;
114}
115
116static BITS32*
117PREV_DIFFERENT(BITS32 *pt0, BITS32 *pte, struct index_t *it)
118{
119 Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
120 Term* sj;
121
122 do {
123 pt0--;
124 if (pt0 == pte)
125 return NULL;
126 sj = EXO_OFFSET_TO_ADDRESS(it, *pt0);
127 } while (!cmp_extra_args(si, sj, it));
128 return pt0;
129}
130
131static BITS32*
132NEXT_MIN(BITS32 *pt0, BITS32 *pte, Term tmin, Term tmax, struct index_t *it)
133{
134 Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
135 int do_min, do_max;
136 Int min = 0, max = 0;
137
138 if (IsVarTerm(tmin)) {
139 do_min = FALSE;
140 } else {
141 do_min = TRUE;
142 min = IntOfTerm(tmin);
143 }
144 if (IsVarTerm(tmax)) {
145 do_max = FALSE;
146 } else {
147 do_max = TRUE;
148 max = IntOfTerm(tmax);
149 }
150
151 while ((do_min && IntOfTerm(si[it->udi_arg]) < min) ||
152 (do_max && IntOfTerm(si[it->udi_arg]) > max)) {
153 pt0++;
154 if (pt0 == pte)
155 return NULL;
156 si = EXO_OFFSET_TO_ADDRESS(it, *pt0);
157 }
158 return pt0;
159}
160
161static BITS32*
162NEXT_MAX(BITS32 *pt0, BITS32 *pte, Term tmin, Term tmax, struct index_t *it)
163{
164 Term* si = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
165 int do_min, do_max;
166 Int min = 0, max = 0;
167
168 if (IsVarTerm(tmin)) {
169 do_min = FALSE;
170 } else {
171 do_min = TRUE;
172 min = IntOfTerm(tmin);
173 }
174 if (IsVarTerm(tmax)) {
175 do_max = FALSE;
176 } else {
177 do_max = TRUE;
178 max = IntOfTerm(tmax);
179 }
180
181 while ((do_min && IntOfTerm(si[it->udi_arg]) < min) ||
182 (do_max && IntOfTerm(si[it->udi_arg]) > max)) {
183 pt0--;
184 if (pt0 == pte)
185 return NULL;
186 si = EXO_OFFSET_TO_ADDRESS(it, *pt0);
187 }
188 return pt0;
189}
190
191static void
192IntervalUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
193{
194 size_t sz;
195 struct index_t *it = *ip;
196 yamop *code;
197
198 /* hard-wired implementation for the Interval case */
199 Int i = it->udi_arg;
200 /* it is bound, use hash */
201 if (it->bmap & b[i]) return;
202 /* no constraints, nothing to gain */
203 //if (!IsAttVar(VarOfTerm(Deref(XREGS[i+1])))) return;
204 LOCAL_exo_it = it;
205 LOCAL_exo_base = it->bcls;
206 LOCAL_exo_arity = it->arity;
207 LOCAL_exo_arg = i;
208 it->udi_free_args = free_args(b, it->arity, i);
209 if (!it->key) {
210 UInt ncls = it->ap->cs.p_code.NOfClauses, i;
211 BITS32 *sorted;
212 /* handle ll variables */
213 sz = sizeof(BITS32)*(ncls);
214 /* allocate space */
215 if (!(it->udi_data = (BITS32*)Yap_AllocCodeSpace(sz)))
216 return;
217 sorted = (BITS32*)it->udi_data;
218 for (i=0; i< ncls; i++)
219 sorted[i] = i;
220 qsort(sorted, (size_t)ncls, sizeof(BITS32), compar);
221 it->links = NULL;
222 } else {
223 BITS32 *sorted0, *sorted;
224
225 /* be conservative */
226 if (it->udi_free_args)
227 sz = sizeof(BITS32)*(2*it->ntrys+3*it->nentries);
228 else
229 sz = sizeof(BITS32)*(it->ntrys+2*it->nentries);
230 /* allocate space */
231 if (!(it->udi_data = (BITS32*)malloc(sz)))
232 return;
233 sorted0 = sorted = (BITS32 *)it->udi_data;
234 sorted++; /* leave an initial hole */
235 for (i=0; i < it->hsize; i++) {
236 if (it->key[i]) {
237 BITS32 *s0 = sorted;
238 BITS32 offset = it->key[i], offset0 = offset;
239
240 *sorted++ = 0;
241 do {
242 *sorted++ = offset;
243 offset = it->links[offset];
244 } while (offset);
245 // S = EXO_OFFSET_TO_ADDRESS(it, offset0); Yap_DebugPlWrite(S[0]);
246 // fprintf(stderr, " key[i]=%d offset=%d %d\n", it->key[i], offset0, (sorted-s0)-1);
247 if (sorted-s0 == 2) {
248 it->links[offset0] = 0;
249 sorted = s0;
250 } else {
251 /* number of elements comes first */
252 *s0 = sorted - (s0+1);
253 qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar);
254 it->links[offset0] = s0-sorted0;
255 if (it->udi_free_args) {
256 memcpy(sorted, s0+1, sizeof(BITS32)*(*s0));
257 qsort(sorted, (size_t)*s0, sizeof(BITS32), compar2);
258 sorted += *s0;
259 }
260 }
261 }
262 }
263 sz = sizeof(BITS32)*(sorted-sorted0);
264 it->udi_data = (BITS32 *)realloc((char *)it->udi_data, sz);
265 }
266 it->is_udi = i+1;
267 code = it->code;
268 code->opc = Yap_opcode(_try_exo_udi);
269 code = NEXTOP(code, lp);
270 code->opc = Yap_opcode(_retry_exo_udi);
271}
272
273 static BITS32 *
274 binary_search(BITS32 *start, BITS32 *end, Int x USES_REGS)
275 {
276 BITS32 *mid;
277 while (start < end) {
278 int cmp;
279 mid = start + (end-start)/2;
280 cmp = compare(mid, x PASS_REGS);
281 if (!cmp)
282 return mid;
283 if (cmp > 0) {
284 end = mid-1;
285 } else
286 start = mid+1;
287 }
288 return start;
289 }
290
291 static yamop *
292Interval(struct index_t *it, Term min, Term max, Term op, BITS32 off USES_REGS)
293 {
294 BITS32 *c;
295 BITS32 n;
296 BITS32 *pt;
297 BITS32 *end;
298 Atom at;
299
300 LOCAL_exo_it = it;
301 LOCAL_exo_base = it->bcls;
302 LOCAL_exo_arity = it->arity;
303 LOCAL_exo_arg = it->udi_arg;
304 if (!it->links) {
305 c = (BITS32 *)it->udi_data;
306 n = it->nels;
307 pt = c;
308 end = c+(n-1);
309 } else if (it->links[off]) {
310 c = (BITS32 *)it->udi_data;
311 n = c[it->links[off]];
312 pt = c;
313 end = c+(it->links[off]+n);
314 // fprintf(stderr," %d links %d=%d \n", off, it->links[off], n);
315 } else {
316 if (!IsVarTerm(min)) {
317 Int x;
318 if (!IsIntegerTerm(min)) {
319 min = Yap_Eval(min);
320 if (!IsIntegerTerm(min)) {
321 Yap_Error(TYPE_ERROR_INTEGER, min, "data-base constraint");
322 return FAILCODE;
323 }
324 }
325 x = IntegerOfTerm(min);
326 if (x >= IntegerOfTerm(S[LOCAL_exo_arg])) {
327 return FAILCODE;
328 }
329 }
330 if (!IsVarTerm(max)) {
331 Int x;
332 if (!IsIntegerTerm(max)) {
333 max = Yap_Eval(max);
334 if (!IsIntegerTerm(max)) {
335 Yap_Error(TYPE_ERROR_INTEGER, max, "data-base constraint");
336 return FAILCODE;
337 }
338 }
339 x = IntegerOfTerm(max);
340 if (x <= IntegerOfTerm(S[LOCAL_exo_arg])) {
341 return FAILCODE;
342 }
343 }
344 return NEXTOP(NEXTOP(it->code,lp),lp);
345 }
346
347 if (!IsVarTerm(min)) {
348 Int x;
349 if (!IsIntegerTerm(min)) {
350 min = Yap_Eval(min);
351 if (!IsIntegerTerm(min)) {
352 Yap_Error(TYPE_ERROR_INTEGER, min, "data-base constraint");
353 return FAILCODE;
354 }
355 }
356 x = IntegerOfTerm(min);
357 if (n > 8) {
358 int cmp;
359 pt = binary_search(pt, end, x PASS_REGS);
360 while ( pt < end+1 && (cmp = compare(pt, x PASS_REGS)) <= 0 ) {
361 if (cmp > 0) break;
362 pt++;
363 }
364 } else {
365 while ( pt < end+1 && compare(pt, x PASS_REGS) <= 0 ) {
366 pt++;
367 }
368 }
369 if (pt > end)
370 return FAILCODE;
371 }
372 if (!IsVarTerm(max)) {
373 Int x;
374 BITS32 *pt1;
375 Int n = end-pt;
376
377 if (!IsIntegerTerm(max)) {
378 max = Yap_Eval(max);
379 if (!IsIntegerTerm(max)) {
380 Yap_Error(TYPE_ERROR_INTEGER, max, "data-base constraint");
381 return FAILCODE;
382 }
383 }
384 x = IntegerOfTerm(max);
385 if (n > 8) {
386 int cmp;
387 pt1 = binary_search(pt, end, x PASS_REGS);
388 while ( pt1 >= pt && (cmp = compare(pt1, x PASS_REGS)) >= 0 ) {
389 if (cmp < 0) break;
390 pt1--;
391 }
392 } else {
393 pt1 = end;
394 while ( pt1 >= pt && compare(pt1, x PASS_REGS) >= 0 ) {
395 pt1--;
396 }
397 }
398 if (pt1 < pt)
399 return FAILCODE;
400 end = pt1;
401 }
402 if (IsVarTerm(op)) {
403 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
404 if (pt < end ) {
405 YENV[-1] = (CELL)( end );
406 YENV[-2] = (CELL)( pt+1 );
407 YENV -= 2;
408 return it->code;
409 }
410 return NEXTOP(NEXTOP(it->code,lp),lp);
411 }
412 at = AtomOfTerm(op);
413 if (at == AtomAny || at == AtomMinimum) {
414 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
415 } else if (at == AtomMaximum) {
416 S = EXO_OFFSET_TO_ADDRESS(it, end[0]);
417 } else if (at == AtomUnique) {
418 if (end-2 > pt)
419 return FAILCODE;
420 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
421 } else if (at == AtomMin) {
422 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
423 if (it->udi_free_args) {
424 BITS32 *ptn;
425 pt = c+(it->links[off]+n+1);
426 end = pt+n;
427 pt = NEXT_MIN(pt, end, min, max, it);
428 if (!pt)
429 return FAILCODE;
430 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
431 ptn = NEXT_DIFFERENT(pt, end, it);
432 if (ptn)
433 ptn = NEXT_MIN(ptn, end, min, max, it);
434 if ( ptn ) {
435 YENV[-1] = min; // what we are doing
436 YENV[-2] = max; // what we are doing
437 YENV[-3] = (CELL) end; // what we are doing
438 YENV[-4] = MkAtomTerm(AtomMin); // what we are doing
439 YENV[-5] = (CELL)( ptn ); // where we are in pt0 array
440 YENV -= 5;
441 return it->code;
442 }
443 }
444 return NEXTOP(NEXTOP(it->code,lp),lp);
445 } else if (at == AtomMax) {
446 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
447 if (it->udi_free_args) {
448 BITS32 *ptn;
449 end = c+(it->links[off]+n);
450 pt = end+n;
451 pt = NEXT_MAX(pt, end, min, max, it);
452 if (!pt)
453 return FAILCODE;
454 S = EXO_OFFSET_TO_ADDRESS(it, pt[0]);
455 ptn = PREV_DIFFERENT(pt, end, it);
456 if (ptn)
457 ptn = NEXT_MAX(ptn, end, min, max, it);
458 if ( ptn ) {
459 YENV[-1] = min; // what we are doing
460 YENV[-2] = max; // what we are doing
461 YENV[-3] = (CELL) end; // what we are doing
462 YENV[-4] = MkAtomTerm(AtomMax); // what we are doing
463 YENV[-5] = (CELL)( ptn ); // where we are in pt0 array
464 YENV -= 5;
465 return it->code;
466 }
467 }
468 return NEXTOP(NEXTOP(it->code,lp),lp);
469 }
470 return NEXTOP(NEXTOP(it->code,lp),lp);
471 }
472
473static yamop *
474IntervalEnterUDIIndex(struct index_t *it USES_REGS)
475{
476 Int i = it->udi_arg;
477 Term t = XREGS[i+1], a1;
478 BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S);
479 // printf("off=%d it=%p %p---%p\n", off, it, it->cls, S);
480 attvar_record *attv;
481
482 t = Deref(t);
483 if (!IsVarTerm(t))
484 return FALSE;
485 if(!IsAttVar(VarOfTerm(t)))
486 return Interval(it, MkVarTerm(), MkVarTerm(), MkVarTerm(), off PASS_REGS);
487 attv = RepAttVar(VarOfTerm(t));
488 t = attv->Atts;
489 a1 = ArgOfTerm(2,t);
490 if (IsVarTerm(a1)) {
491 Yap_Error(INSTANTIATION_ERROR, t, "executing exo_interval constraints");
492 return FAILCODE;
493 } else if (!IsApplTerm(a1)) {
494 Yap_Error(TYPE_ERROR_COMPOUND, a1, "executing exo_interval constraints");
495 return FAILCODE;
496 } else {
497 return Interval(it, ArgOfTerm(1,a1), ArgOfTerm(2,a1), ArgOfTerm(3,a1), off PASS_REGS);
498 }
499}
500
501static int
502IntervalRetryUDIIndex(struct index_t *it USES_REGS)
503{
504 CELL *w = (CELL*)(B+1)+it->arity;
505 if (IsVarTerm(w[2])) {
506 BITS32 *end = (BITS32 *) w[2],
507 *pt = (BITS32 *) w[1];
508 BITS32 f = *pt;
509
510 S = EXO_OFFSET_TO_ADDRESS(it, f);
511 if (pt++ == end) return FALSE;
512 w[1] = (CELL)pt;
513 } else {
514 BITS32 *pt0 = (BITS32 *)w[1];
515 BITS32 *pte = (BITS32 *)w[3];
516 Atom what = AtomOfTerm(w[2]);
517 Term min = w[5];
518 Term max = w[4];
519
520 S = EXO_OFFSET_TO_ADDRESS(it, pt0[0]);
521 if ( what == AtomMin ) {
522 pt0 = NEXT_DIFFERENT(pt0, pte, it);
523 if (pt0)
524 pt0 = NEXT_MIN(pt0, pte, min, max, it);
525 } else {
526 pt0 = PREV_DIFFERENT(pt0, pte, it);
527 if (pt0)
528 pt0 = NEXT_MAX(pt0, pte, min, max, it);
529 }
530 if (!pt0) {
531 return FALSE;
532 }
533 w[1] = (CELL)pt0;
534 }
535 return TRUE;
536}
537
538
539static struct udi_control_block IntervalCB;
540
541typedef struct exo_udi_access_t {
542 CRefitExoIndex refit;
544
545static struct exo_udi_access_t ExoCB;
546
547static void *
548IntervalUdiInit (Term spec, int arg, int arity) {
549 ExoCB.refit = IntervalUDIRefitIndex;
550 return (void *)&ExoCB;
551}
552
553static void *
554IntervalUdiInsert (void *control,
555 Term term, int arg, void *data)
556{
557 CACHE_REGS
558
559 struct index_t **ip = (struct index_t **)term;
560 (*ip)->udi_arg = arg-1;
561 (ExoCB.refit)(ip, LOCAL_ibnds PASS_REGS);
562 (*ip)->udi_first = (void *)IntervalEnterUDIIndex;
563 (*ip)->udi_next = (void *)IntervalRetryUDIIndex;
564 return control;
565}
566
567static int IntervalUdiDestroy(void *control)
568{
569 return TRUE;
570}
571
572
573
574void Yap_udi_Interval_init(void) {
575 UdiControlBlock cb = &IntervalCB;
576 Atom name = Yap_LookupAtom("exo_interval");
577 memset((void *) cb,0, sizeof(*cb));
578
579 /*TODO: ask vitor why this gives a warning*/
580 cb->decl= (YAP_Atom)name;
581 Yap_MkEmptyWakeUp(name);
582 cb->init= IntervalUdiInit;
583 cb->insert=IntervalUdiInsert;
584 cb->search=NULL;
585 cb->destroy=IntervalUdiDestroy;
586
587 Yap_UdiRegister(cb);
588}
Main definitions.
Attributed variales are controlled by the attvar_record.
Definition: attvar.h:49
A matrix.
Definition: matrix.c:68
Definition: amidefs.h:264