YAP 7.1.0
attvar.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: attvar.c * Last rev:
12 ** mods: * comments: YAP support for attributed vars *
13 * *
14 *************************************************************************/
15
16#ifdef SCCS
17static char SccsId[] = "%W% %G%";
18#endif
19
20#include "Yap.h"
21
22#include "YapHeap.h"
23#include "Yatom.h"
24#include "attvar.h"
25#include "heapgc.h"
26
36void Yap_suspend_goal(Term tg USES_REGS) {
37 // if (LOCAL_DoNotWakeUp)
38 // return;
39 Yap_signal(YAP_WAKEUP_SIGNAL);
40 /* follow the chain */
41 Term WGs = Yap_ReadTimedVar(LOCAL_WokenGoals);
42 if (IsVarTerm(WGs) || WGs == TermTrue) {
43 Yap_UpdateTimedVar(LOCAL_WokenGoals, tg);
44 } else {
45 if (!IsApplTerm(WGs) || FunctorOfTerm(WGs) != FunctorComma) {
46 Term t[2];
47 t[1] = tg;
48 t[0] = WGs;
49 WGs = Yap_MkApplTerm(FunctorComma, 2, t);
50 Yap_UpdateTimedVar(LOCAL_WokenGoals, WGs);
51 } else {
52 CELL *pt = HR;
53 Term nt;
54 HR += 3;
55 while (IsApplTerm(WGs) && (nt = ArgOfTerm(2, WGs)) != TermTrue) {
56 WGs = nt;
57 }
58 Term newTail = AbsAppl(HR);
59 *pt++ = (CELL)FunctorComma;
60 *pt++ = TermTrue;
61 MaBind(RepAppl(WGs) + 2, newTail);
62 }
63 }
64}
65
66void AddToQueue(attvar_record *attv USES_REGS) {
67 Term t[2];
68 Term ng;
69
70 t[0] = (CELL) & (attv->Done);
71 t[1] = attv->Future;
72 ng = Yap_MkApplTerm(FunctorAttGoal, 2, t);
73 Yap_suspend_goal(ng PASS_REGS);
74}
75void AddCompareToQueue(Term Cmp, Term t1, Term t2 USES_REGS) {
76 Term ts[3];
77 ts[0] = Cmp;
78 ts[1] = MkGlobal(t1);
79 ts[2] = MkGlobal(t2);
80 Term tg = Yap_MkApplTerm(FunctorCompare, 3, ts);
81 Yap_suspend_goal(tg PASS_REGS);
82}
83
84void AddUnifToQueue(Term t1, Term t2 USES_REGS) {
85 Term ts[2];
86 ts[0] = MkGlobal(t1);
87 ts[1] = MkGlobal(t2);
88 Term tg = Yap_MkApplTerm(FunctorEq, 2, ts);
89 Yap_suspend_goal(tg PASS_REGS);
90}
91
92static attvar_record *BuildNewAttVar(USES_REGS1) {
93 attvar_record *newv;
94
95 /* add a new attributed variable */
96 newv = (attvar_record *)HR;
97 HR = (CELL *)(newv + 1);
98 newv->AttFunc = FunctorAttVar;
99 RESET_VARIABLE(&(newv->Future));
100 RESET_VARIABLE(&(newv->Done));
101 RESET_VARIABLE(&(newv->Atts));
102 return newv;
103}
104
105typedef struct cp_frame {
106 CELL *start_cp;
107 CELL *end_cp;
108 CELL *to;
109#ifdef RATIONAL_TREES
110 CELL oldv;
111 int ground;
112#endif
113} copy_frame;
114
115static int CopyAttVar(CELL *orig, void *tvp, CELL *res USES_REGS) {
116 struct cp_frame **to_visit_ptr = tvp;
117 register attvar_record *attv = RepAttVar(orig);
118 register attvar_record *newv;
119 struct cp_frame *to_visit = *to_visit_ptr;
120 CELL *vt;
121
122 if (!(newv = BuildNewAttVar(PASS_REGS1)))
123 return FALSE;
124 vt = &(attv->Atts);
125 to_visit->start_cp = vt - 1;
126 to_visit->end_cp = vt;
127 if (IsVarTerm(attv->Atts)) {
128 Bind_Global_NonAtt(&newv->Atts, (CELL)HR);
129 to_visit->to = HR;
130 HR++;
131 } else {
132 to_visit->to = &(newv->Atts);
133 }
134 to_visit->oldv = vt[-1];
135 to_visit->ground = FALSE;
136 *to_visit_ptr = to_visit + 1;
137 *res = (CELL) & (newv->Done);
138 return TRUE;
139}
140
141static Term AttVarToTerm(CELL *orig) {
142 attvar_record *attv = RepAttVar(orig);
143
144 return attv->Atts;
145}
146
147static int IsEmptyWakeUp(Term atts) {
148 Atom name = NameOfFunctor(FunctorOfTerm(atts));
149 Atom *pt = EmptyWakeups;
150 int i = 0;
151 while (i < MaxEmptyWakeups) {
152 if (pt[i++] == name)
153 return TRUE;
154 }
155 return FALSE;
156}
157
158void Yap_MkEmptyWakeUp(Atom mod) {
159 if (MaxEmptyWakeups == MAX_EMPTY_WAKEUPS)
160 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
161 "too many modules that do not wake up");
162 EmptyWakeups[MaxEmptyWakeups++] = mod;
163}
164
165static int TermToAttVar(Term attvar, Term to USES_REGS) {
166 attvar_record *attv = BuildNewAttVar(PASS_REGS1);
167 if (!attv)
168 return FALSE;
169 Bind_Global_NonAtt(&attv->Atts, attvar);
170 *VarOfTerm(to) = AbsAttVar(attv);
171 return TRUE;
172}
173
174static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
175 RESET_VARIABLE(pt1);
176 // get record
177 attvar_record *attv = RepAttVar(pt1);
178 reg2 = MkGlobal(Deref(reg2));
179
180 Term td = Deref(attv->Done);
181 if (IsEmptyWakeUp(attv->Atts)) {
182 /* no attributes to wake */
183 Bind_Global_NonAtt(&(attv->Done), reg2);
184 // LOCAL_DoNotWakeUp = false;
185 return;
186 }
187 // next case is impossible>
188 if (!IsUnboundVar(&attv->Future)) {
189 if (td != reg2) {
190 AddUnifToQueue(td, reg2);
191 }
192 // LOCAL_DoNotWakeUp = false;
193 return;
194 }
195 if (!IsVarTerm(reg2)) {
196 if (IsVarTerm(attv->Future)) {
197 Bind_Global_NonAtt(&(attv->Future), reg2);
198 AddToQueue(attv PASS_REGS);
199 } else {
200 AddUnifToQueue((Term)pt1, reg2 PASS_REGS);
201 }
202 // LOCAL_DoNotWakeUp = false;
203 return;
204 }
205 CELL *pt2 = VarOfTerm(reg2);
206 if (pt1 == pt2 || attv->Future == reg2) {
207 // LOCAL_DoNotWakeUp = false;
208 return;
209 }
210 if (!IsAttVar(pt2)) {
211 Bind_Global_NonAtt(pt2, attv->Done);
212 // LOCAL_DoNotWakeUp = false;
213 return;
214 }
215 attvar_record *susp2 = RepAttVar(pt2);
216 Term td2 = Deref(susp2->Done);
217 if (td2 == td || td2 == attv->Future) {
218 return;
219 }
220 if (IsEmptyWakeUp(susp2->Atts)) {
221 /* no attributes to wake */
222 Bind_Global_NonAtt(pt2, attv->Done);
223 // LOCAL_DoNotWakeUp = false;
224 return;
225 }
226 reg2 = Deref(susp2->Future);
227 if (!IsVarTerm(reg2)) {
228 Bind_Global_NonAtt(pt1, reg2);
229 AddToQueue(attv PASS_REGS);
230 }
231 if (attv > susp2) {
232 Bind_Global_NonAtt(&attv->Future, susp2->Done);
233 AddToQueue(attv PASS_REGS);
234 } else {
235 Bind_Global_NonAtt(&susp2->Future, attv->Done);
236 AddToQueue(susp2 PASS_REGS);
237 }
238 // LOCAL_DoNotWakeUp = false;
239}
240
241void Yap_WakeUp(CELL *pt0) {
242 CACHE_REGS
243 if (LOCAL_DoNotWakeUp)
244 return;
245 LOCAL_DoNotWakeUp = true;
246 CELL d0 = *pt0;
247 RESET_VARIABLE(pt0);
248 WakeAttVar(pt0, d0 PASS_REGS);
249 LOCAL_DoNotWakeUp = false;
250 if (LOCAL_Signals)
251 CreepFlag = (CELL)LCL0;
252}
253
254static void mark_attvar(CELL *orig) { return; }
255
256static Term BuildAttTerm(Functor mfun, UInt ar USES_REGS) {
257 CELL *h0 = HR;
258 UInt i;
259
260 if (HR + (1024 + ar) > ASP) {
261 LOCAL_Error_Size = ar * sizeof(CELL);
262 return 0L;
263 }
264 HR[0] = (CELL)mfun;
265 RESET_VARIABLE(HR + 1);
266 HR += 2;
267 for (i = 1; i < ar; i++) {
268 *HR = TermVoidAtt;
269 HR++;
270 }
271 return AbsAppl(h0);
272}
273
274// SICStus Style
275static Term SearchAttsForModule(Term start, Functor mfun) {
276 do {
277 if (IsVarTerm(start))
278 return start;
279 if (!IsApplTerm(start))
280 return TermNil;
281 if ( FunctorOfTerm(start) == mfun) {
282 return start;
283 }
284 Term a1 = ArgOfTerm(1, start);
285 if (FunctorOfTerm(start) == FunctorAtt1) {
286 if (IsAtomTerm(a1) && NameOfFunctor(mfun) == AtomOfTerm(a1))
287 return TermNil;
288 start = ArgOfTerm(3, start);
289 } else {
290 start = a1;
291 }
292 } while (TRUE);
293}
294
295static Term SearchAttsForModuleFunctorName(Term start, Atom mname) {
296 do {
297 Atom at;
298 if (IsVarTerm(start))
299 return start;
300 if (!IsApplTerm(start))
301 return TermNil;
302 if ((at = NameOfFunctor(FunctorOfTerm(start))) == mname) {
303 return start;
304 }
305 Term a1 = ArgOfTerm(1, start);
306 if (FunctorOfTerm(start) == FunctorAtt1) {
307 if (IsAtomTerm(a1) && at == AtomOfTerm(a1))
308 return TermNil;
309 start = ArgOfTerm(3, start);
310 } else {
311 start = a1;
312 }
313 } while (TRUE);
314}
315
316// SWI style
317static Term SearchAttsForModuleName(Term start, Atom mname) {
318 do {
319 if (IsVarTerm(start))
320 return 0;
321 if (!IsApplTerm(start))
322 return 0;
323 if (NameOfFunctor(FunctorOfTerm(start)) == mname) {
324 return start;
325 }
326 Term a1 = ArgOfTerm(1, start);
327 if (FunctorOfTerm(start) == FunctorAtt1) {
328 if (IsAtomTerm(a1) && mname == AtomOfTerm(a1))
329 return ArgOfTerm(2, start);
330 start = ArgOfTerm(3, start);
331 } else {
332 start = a1;
333 }
334 } while (TRUE);
335}
336
338static void AddNewModule(attvar_record *attv, Term t, int new,
339 int do_it USES_REGS) {
340 CELL *newp = RepAppl(t) + 2;
341 UInt i, ar = ArityOfFunctor((Functor)newp[-2]);
342
343 for (i = 1; i < ar; i++) {
344 Term n = Deref(*newp);
345 if (n == TermFreeTerm) {
346 *newp = TermVoidAtt;
347 } else {
348 if (n != TermVoidAtt)
349 do_it = TRUE;
350 }
351 newp++;
352 }
353 if (!do_it)
354 return;
355 if (new) {
356 attv->Atts = t;
357 } else if (IsVarTerm(attv->Atts)) {
358 MaBind(&(attv->Atts), t);
359 } else {
360 Term *wherep = &attv->Atts;
361
362 do {
363 if (IsVarTerm(*wherep)) {
364 Bind_Global_NonAtt(wherep, t);
365 return;
366 } else {
367 wherep = RepAppl(Deref(*wherep)) + 1;
368 }
369 } while (TRUE);
370 }
371}
372
373static void ReplaceAtts(attvar_record *attv, Term oatt, Term att USES_REGS) {
374 UInt ar = ArityOfFunctor(FunctorOfTerm(oatt)), i;
375 CELL *oldp = RepAppl(oatt) + 1;
376 CELL *newp;
377
378 if (oldp > HB) {
379 oldp++;
380 newp = RepAppl(att) + 2;
381 /* if deterministic */
382
383 for (i = 1; i < ar; i++) {
384 Term n = Deref(*newp);
385 if (n != TermFreeTerm) {
386 *oldp = n;
387 }
388 oldp++;
389 newp++;
390 }
391 return;
392 }
393 newp = RepAppl(att) + 1;
394 *newp++ = *oldp++;
395 for (i = 1; i < ar; i++) {
396 Term n = Deref(*newp);
397
398 if (n == TermFreeTerm) {
399 *newp = Deref(*oldp);
400 }
401 oldp++;
402 newp++;
403 }
404 if (attv->Atts == oatt) {
405 if (RepAppl(attv->Atts) >= HB)
406 attv->Atts = att;
407 else
408 MaBind(&(attv->Atts), att);
409 } else {
410 Term *wherep = &attv->Atts;
411
412 do {
413 if (*wherep == oatt) {
414 MaBind(wherep, att);
415 return;
416 } else {
417 wherep = RepAppl(Deref(*wherep)) + 1;
418 }
419 } while (TRUE);
420 }
421}
422
423static void DelAllAtts(attvar_record *attv USES_REGS) {
424 MaBind(&(attv->Done), attv->Future);
425}
426
427static void DelAtts(attvar_record *attv, Term oatt USES_REGS) {
428 Term t = ArgOfTerm(1, oatt);
429 if (attv->Atts == oatt) {
430 if (IsVarTerm(t)) {
431 DelAllAtts(attv PASS_REGS);
432 return;
433 }
434 if (RepAppl(attv->Atts) >= HB)
435 attv->Atts = t;
436 else
437 MaBind(&(attv->Atts), t);
438 } else {
439 Term *wherep = &attv->Atts;
440
441 do {
442 if (*wherep == oatt) {
443 MaBind(wherep, t);
444 return;
445 } else {
446 wherep = RepAppl(Deref(*wherep)) + 1;
447 }
448 } while (TRUE);
449 }
450}
451
452static void PutAtt(Int pos, Term atts, Term att USES_REGS) {
453 if (IsVarTerm(att) && VarOfTerm(att) > HR && VarOfTerm(att) < LCL0) {
454 /* globalise locals */
455 Term tnew = MkVarTerm();
456 Bind_NonAtt(VarOfTerm(att), tnew);
457 att = tnew;
458 }
459 MaBind(RepAppl(atts) + pos, att);
460}
461
462static Int BindAttVar(attvar_record *attv USES_REGS) {
463 Term done = Deref(attv->Done);
464 Term value = Deref(attv->Future);
465 if (value != done)
466 Bind_Global_NonAtt(&(attv->Done), value);
467 return true;
468 if (IsVarTerm(done) && IsUnboundVar(&attv->Done)) {
469 /* make sure we are not trying to bind a variable against itself */
470 if (!IsVarTerm(value)) {
471 Bind_Global_NonAtt(&(attv->Done), value);
472 } else if (IsVarTerm(value)) {
473 Term t = value;
474 if (IsVarTerm(t)) {
475 if (IsAttachedTerm(t)) {
476 attvar_record *attv2 = RepAttVar(VarOfTerm(t));
477 if (attv2 < attv) {
478 Bind_Global_NonAtt(&(attv2->Done), AbsAttVar(attv));
479 } else if (attv2 != attv) {
480 Bind_Global_NonAtt(&(attv->Done), AbsAttVar(attv2));
481 }
482 } else {
483 Yap_Error(SYSTEM_ERROR_INTERNAL, value,
484 "attvar was bound when unset");
485 return (FALSE);
486 }
487 } else {
488 Bind_Global_NonAtt(&(attv->Done), t);
489 }
490 }
491 return true;
492 } else {
493 Yap_Error(SYSTEM_ERROR_INTERNAL, (CELL) & (attv->Done),
494 "attvar was bound when set");
495 return (FALSE);
496 }
497}
498
499static Int UnBindAttVar(attvar_record *attv) {
500 RESET_VARIABLE(&(attv->Done));
501 return (TRUE);
502}
503
504static Term GetAllAtts(attvar_record *attv) {
505 /* check if we are already there */
506 return attv->Atts;
507}
508
510
514
516static Int put_att(USES_REGS1) {
517 /* receive a variable in ARG1 */
518 Term inp = Deref(ARG1);
519 /* if this is unbound, ok */
520 if (IsVarTerm(inp)) {
521 attvar_record *attv;
522 Atom modname = AtomOfTerm(Deref(ARG2));
523 UInt ar = IntegerOfTerm(Deref(ARG3));
524 Functor mfun;
525 Term tatts;
526 int new = FALSE;
527
528 if (IsAttachedTerm(inp)) {
529 attv = RepAttVar(VarOfTerm(inp));
530 } else {
531 while (!(attv = BuildNewAttVar(PASS_REGS1))) {
532 LOCAL_Error_Size = sizeof(attvar_record);
533 if (!Yap_dogc()) {
534 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
535 return FALSE;
536 }
537 }
538 new = TRUE;
539 }
540 mfun = Yap_MkFunctor(modname, ar);
541 if ((tatts = SearchAttsForModule(attv->Atts, mfun)) == 0) {
542 while (!(tatts = BuildAttTerm(mfun, ar PASS_REGS))) {
543 if (!Yap_dogc()) {
544 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
545 return FALSE;
546 }
547 }
548 {
549 CELL *ptr = VarOfTerm(Deref(ARG1));
550 CELL d0 = AbsAttVar(attv);
551 Bind_NonAtt(ptr, d0);
552 }
553 AddNewModule(attv, tatts, new, TRUE PASS_REGS);
554 }
555 PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, Deref(ARG5) PASS_REGS);
556 return TRUE;
557 } else {
558 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
559 "first argument of put_attributes/2");
560 return FALSE;
561 }
562}
563
564static Int rm_att(USES_REGS1) {
565 /* receive a variable in ARG1 */
566 Term inp = Deref(ARG1);
567 /* if this is unbound, ok */
568 if (IsVarTerm(inp)) {
569 attvar_record *attv;
570 Atom modname = AtomOfTerm(Deref(ARG2));
571 UInt ar = IntegerOfTerm(Deref(ARG3));
572 Functor mfun;
573 Term tatts;
574 int new = FALSE;
575
576 if (IsAttachedTerm(inp)) {
577 attv = RepAttVar(VarOfTerm(inp));
578 } else {
579 while (!(attv = BuildNewAttVar(PASS_REGS1))) {
580 LOCAL_Error_Size = sizeof(attvar_record);
581 if (!Yap_dogc()) {
582 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
583 return FALSE;
584 }
585 }
586 new = TRUE;
587 Yap_unify(ARG1, AbsAttVar(attv));
588 }
589 mfun = Yap_MkFunctor(modname, ar);
590 if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts, mfun))) {
591 while (!(tatts = BuildAttTerm(mfun, ar PASS_REGS))) {
592 if (!Yap_dogc()) {
593 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
594 return FALSE;
595 }
596 }
597 AddNewModule(attv, tatts, new, FALSE PASS_REGS);
598 } else {
599 PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, TermVoidAtt PASS_REGS);
600 }
601 return TRUE;
602 } else {
603 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp, "first argument of rm_att/2");
604 return (FALSE);
605 }
606}
607
608static Int put_atts(USES_REGS1) {
609 /* receive a variable in ARG1 */
610 Term inp = Deref(ARG1);
611
612 /* if this is unbound, ok */
613 if (IsVarTerm(inp)) {
614 attvar_record *attv;
615 Term otatts;
616 Term tatts = Deref(ARG2);
617 Functor mfun = FunctorOfTerm(tatts);
618 int new = FALSE;
619
620 if (IsAttachedTerm(inp)) {
621 attv = RepAttVar(VarOfTerm(inp));
622 } else {
623 while (!(attv = BuildNewAttVar(PASS_REGS1))) {
624 LOCAL_Error_Size = sizeof(attvar_record);
625 if (!Yap_dogc(PASS_REGS1)) {
626 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
627 return FALSE;
628 }
629 }
630 new = TRUE;
631 Yap_unify(ARG1, AbsAttVar(attv));
632 }
633 /* we may have a stack shift meanwhile!! */
634 tatts = Deref(ARG2);
635 if (IsVarTerm(tatts)) {
636 Yap_Error(INSTANTIATION_ERROR, tatts, "second argument of put_att/2");
637 return FALSE;
638 } else if (!IsApplTerm(tatts)) {
639 Yap_Error(TYPE_ERROR_COMPOUND, tatts, "second argument of put_att/2");
640 return FALSE;
641 }
642 if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts, mfun))) {
643 AddNewModule(attv, tatts, new, FALSE PASS_REGS);
644 } else {
645 ReplaceAtts(attv, otatts, tatts PASS_REGS);
646 }
647 return TRUE;
648 } else {
649 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
650 "first argument of put_att/2");
651 return FALSE;
652 }
653}
654
655static Int del_atts(USES_REGS1) {
656 /* receive a variable in ARG1 */
657 Term inp = Deref(ARG1);
658 Term otatts;
659
660 /* if this is unbound, ok */
661 if (IsVarTerm(inp)) {
662 attvar_record *attv;
663 Term tatts = Deref(ARG2);
664 Functor mfun = FunctorOfTerm(tatts);
665
666 if (IsAttachedTerm(inp)) {
667 attv = RepAttVar(VarOfTerm(inp));
668 } else {
669 return TRUE;
670 }
671 if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts, mfun))) {
672 return TRUE;
673 } else {
674 DelAtts(attv, otatts PASS_REGS);
675 }
676 return TRUE;
677 } else {
678 return TRUE;
679 }
680}
681
682static Int del_all_atts(USES_REGS1) {
683 /* receive a variable in ARG1 */
684 Term inp = Deref(ARG1);
685
686 /* if this is unbound, ok */
687 if (IsVarTerm(inp) && IsAttachedTerm(inp)) {
688 attvar_record *attv;
689
690 attv = RepAttVar(VarOfTerm(inp));
691 DelAllAtts(attv PASS_REGS);
692 }
693 return TRUE;
694}
695
696static Int get_atts(USES_REGS1) {
697 /* receive a variable in ARG1 */
698 Term inp = Deref(ARG1);
699 /* if this is unbound, ok */
700 if (IsVarTerm(inp)) {
701 if (IsAttachedTerm(inp)) {
702 attvar_record *attv;
703 Term tatts;
704 Term access = Deref(ARG2);
705 Functor mfun = FunctorOfTerm(access);
706 UInt ar, i;
707 CELL *old, *new;
708
709 attv = RepAttVar(VarOfTerm(inp));
710 if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts, mfun)))
711 return FALSE;
712
713 ar = ArityOfFunctor(mfun);
714 new = RepAppl(access) + 2;
715 old = RepAppl(tatts) + 2;
716 for (i = 1; i < ar; i++, new ++, old++) {
717 if (*new != TermFreeTerm) {
718 if (*old == TermVoidAtt && *new != TermVoidAtt)
719 return FALSE;
720 if (*new == TermVoidAtt &&*old != TermVoidAtt)
721 return FALSE;
722 if (!Yap_unify(*new, *old))
723 return FALSE;
724 }
725 }
726 return TRUE;
727 } else {
728 /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
729 return FALSE;
730 }
731 } else {
732 return (FALSE);
733 }
734}
735
736static Int free_att(USES_REGS1) {
737 /* receive a variable in ARG1 */
738 Term inp = Deref(ARG1);
739 /* if this is unbound, ok */
740 if (IsVarTerm(inp)) {
741 Atom modname = AtomOfTerm(Deref(ARG2));
742
743 if (IsAttachedTerm(inp)) {
744 attvar_record *attv;
745 Term tout, tatts;
746
747 attv = RepAttVar(VarOfTerm(inp));
748 if ((tatts = SearchAttsForModuleFunctorName(attv->Atts, modname)) == 0)
749 return TRUE;
750 tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)), tatts);
751 return (tout == TermVoidAtt);
752 } else {
753 /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
754 return TRUE;
755 }
756 } else {
757 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
758 "first argument of free_att/2");
759 return (FALSE);
760 }
761}
762
763//
764// SICStus style attribute search
765//
766
767static Int get_att(USES_REGS1) {
768 /* receive a variable in ARG1 */
769 Term inp = Deref(ARG1);
770 /* if this is unbound, ok */
771 if (IsVarTerm(inp)) {
772 if (IsAttachedTerm(inp)) {
773 attvar_record *attv;
774 Term tatts;
775 Term access = Deref(ARG2);
776 Functor mfun = FunctorOfTerm(access);
777 UInt ar, i;
778 CELL *old, *new;
779
780 attv = RepAttVar(VarOfTerm(inp));
781 if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts, mfun)))
782 return FALSE;
783
784 ar = ArityOfFunctor(mfun);
785 new = RepAppl(access) + 2;
786 old = RepAppl(tatts) + 2;
787 for (i = 1; i < ar; i++, new ++, old++) {
788 if (*new != TermFreeTerm) {
789 if (*old == TermVoidAtt && *new != TermVoidAtt)
790 return FALSE;
791 if (*new == TermVoidAtt &&*old != TermVoidAtt)
792 return FALSE;
793 if (!Yap_unify(*new, *old))
794 return FALSE;
795 }
796 }
797 return TRUE;
798 } else {
799 /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
800 return FALSE;
801 }
802 } else {
803 return (FALSE);
804 }
805}
806
807static Int has_atts(USES_REGS1) {
808 /* receive a variable in ARG1 */
809 Term inp = Deref(ARG1);
810 /* if this is unbound, ok */
811 if (IsVarTerm(inp)) {
812 if (IsAttachedTerm(inp)) {
813 attvar_record *attv;
814 Term access = Deref(ARG2);
815 Functor mfun = FunctorOfTerm(access);
816
817 attv = RepAttVar(VarOfTerm(inp));
818 return SearchAttsForModule(attv->Atts, mfun) != 0;
819 } else {
820 /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
821 return FALSE;
822 }
823 } else {
824 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
825 "first argument of has_atts/2");
826 return (FALSE);
827 }
828}
829
830static Int bind_attvar(USES_REGS1) {
831 /* receive a variable in ARG1 */
832 Term inp = Deref(ARG1);
833 /* if this is unbound, ok */
834 if (IsVarTerm(inp)) {
835 if (IsAttachedTerm(inp)) {
836 attvar_record *attv = RepAttVar(VarOfTerm(inp));
837 return (BindAttVar(attv PASS_REGS));
838 }
839 return (true);
840 } else {
841 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
842 "first argument of bind_attvar/2");
843 return (false);
844 }
845}
846
847static Int wake_up_done(USES_REGS1) {
848 // LOCAL_DoNotWakeUp = false;
849 return true;
850}
851
852static Int wake_up_start(USES_REGS1) {
853 // LOCAL_DoNotWakeUp = true;
854 return true;
855}
856static Int unbind_attvar(USES_REGS1) {
857 /* receive a variable in ARG1 */
858 Term inp = Deref(ARG1);
859 /* if this is unbound, ok */
860 if (IsVarTerm(inp)) {
861 if (IsAttachedTerm(inp)) {
862 attvar_record *attv = RepAttVar(VarOfTerm(inp));
863 return (UnBindAttVar(attv));
864 }
865 return (TRUE);
866 } else {
867 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
868 "first argument of bind_attvar/2");
869 return (FALSE);
870 }
871}
872
873static Int get_all_atts(USES_REGS1) {
874 /* receive a variable in ARG1 */
875 Term inp = Deref(ARG1);
876 /* if this is unbound, ok */
877 if (IsVarTerm(inp)) {
878 if (IsAttachedTerm(inp)) {
879 attvar_record *attv = RepAttVar(VarOfTerm(inp));
880 return Yap_unify(ARG2, GetAllAtts(attv));
881 }
882 return TRUE;
883 } else {
884 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
885 "first argument of get_all_atts/2");
886 return FALSE;
887 }
888}
889
890static int ActiveAtt(Term tatt, UInt ar) {
891 CELL *cp = RepAppl(tatt) + 1;
892 UInt i;
893
894 for (i = 1; i < ar; i++) {
895 if (cp[i] != TermVoidAtt)
896 return TRUE;
897 }
898 return FALSE;
899}
900
901static Int modules_with_atts(USES_REGS1) {
902 /* receive a variable in ARG1 */
903 Term inp = Deref(ARG1);
904 /* if this is unbound, ok */
905 if (IsVarTerm(inp)) {
906 if (IsAttachedTerm(inp)) {
907 attvar_record *attv = RepAttVar(VarOfTerm(inp));
908 CELL *h0 = HR;
909 Term tatt;
910
911 if (IsVarTerm(tatt = attv->Atts))
912 return Yap_unify(ARG2, TermNil);
913 while (!IsVarTerm(tatt)) {
914 Functor f = FunctorOfTerm(tatt);
915 if (HR != h0)
916 HR[-1] = AbsPair(HR);
917 if (ActiveAtt(tatt, ArityOfFunctor(f))) {
918 *HR = MkAtomTerm(NameOfFunctor(f));
919 HR += 2;
920 }
921 tatt = ArgOfTerm(1, tatt);
922 }
923 if (h0 != HR) {
924 HR[-1] = TermNil;
925 return Yap_unify(ARG2, AbsPair(h0));
926 }
927 }
928 return Yap_unify(ARG2, TermNil);
929 } else {
930 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
931 "first argument of modules_with_attributes/2");
932 return FALSE;
933 }
934}
935
937
941
951static Int get_attr(USES_REGS1) {
952 /* receive a variable in ARG1 */
953 Term inp = Deref(ARG1);
954 /* if this is unbound, ok */
955 Atom modname = AtomOfTerm(must_be_module(ARG2));
956 if (!IsVarTerm(inp))
957 return false;
958
959 if (IsAttachedTerm(inp)) {
960 attvar_record *attv;
961 Term tatts;
962
963 attv = RepAttVar(VarOfTerm(inp));
964 if ((tatts = SearchAttsForModuleName(attv->Atts, modname)) == 0)
965 return false;
966 return Yap_unify(tatts, ARG3);
967 } else {
968 return false;
969 }
970}
971
980static Int get_attrs(USES_REGS1) {
981 /* receive a variable in ARG1 */
982 Term inp = Deref(ARG1);
983 /* if this is unbound, ok */
984 if (!IsVarTerm(inp) || !IsAttachedTerm(inp)) {
985 return false;
986 }
987 attvar_record *attv;
988 attv = RepAttVar(VarOfTerm(inp));
989 return Yap_unify(ARG2, attv->Atts);
990 return TRUE;
991}
992
1005static Int put_attr(USES_REGS1) {
1006 /* receive a variable in ARG1 */
1007 attvar_record *attv;
1008 Term inp = must_be_unbound(ARG1);
1009 Term ts[3];
1010 ts[0] = must_be_module(ARG2);
1011
1012 /* if this is unbound, ok */
1013 if (IsVarTerm(inp)) {
1014
1015 if (IsAttachedTerm(inp)) {
1016 attv = RepAttVar(VarOfTerm(inp));
1017 ts[2] = attv->Atts;
1018 MaBind(&attv->Atts, Yap_MkApplTerm(FunctorAtt1, 3, ts));
1019 Term start = attv->Atts;
1020 do {
1021 if (IsVarTerm(start))
1022 break;
1023 if (!IsApplTerm(start))
1024 break;
1025 if (FunctorOfTerm(start) != FunctorAtt1) {
1026 start = ArgOfTerm(1, start);
1027 continue;
1028 }
1029 if (ts[0] != ArgOfTerm(1, start)) {
1030 start = ArgOfTerm(3, start);
1031 continue;
1032 }
1033 // got it
1034 MaBind(RepAppl(start) + 2, Deref(ARG3));
1035 return true;
1036 } while (TRUE);
1037 ts[1] = MkGlobal(ARG3);
1038 if (IsVarTerm(attv->Atts))
1039 ts[2] = TermNil;
1040 else
1041 ts[2] = attv->Atts;
1042
1043 MaBind(&attv->Atts, Yap_MkApplTerm(FunctorAtt1, 3, ts))
1044 } else {
1045
1046 while (!(attv = BuildNewAttVar(PASS_REGS1))) {
1047 LOCAL_Error_Size = sizeof(attvar_record);
1048 if (!Yap_dogc()) {
1049 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1050 return FALSE;
1051 }
1052 }
1053 S = HR;
1054 HR += 4;
1055 *S++ = (CELL)FunctorAtt1;
1056 *S++ = Deref(ARG2);
1057 *S++ = MkGlobal(ARG3);
1058 *S++ = TermNil;
1059 attv->Atts = AbsAppl(S - 4);
1060 inp = Deref(ARG1);
1061 MaBind(VarOfTerm(inp), attv->Done);
1062 }
1063 }
1064 return true;
1065}
1066
1075static Int put_attrs(USES_REGS1) {
1076 /* receive a variable in ARG1 */
1077 Term inp = Deref(ARG1);
1078 /* if this is unbound, ok */
1079 if (!IsVarTerm(inp) || IsAttachedTerm(inp)) {
1080 return false;
1081 }
1082 attvar_record *attv;
1083 attv = RepAttVar(VarOfTerm(inp));
1084 MaBind(&attv->Atts, Deref(ARG2));
1085 return TRUE;
1086}
1087
1099static Int del_attr(USES_REGS1) {
1100 /* receive a variable in ARG1 */
1101 Term inp = Deref(ARG1);
1102 Term mod = must_be_module(ARG2);
1103 /* if this is unbound, ok */
1104 if (!IsVarTerm(inp) || IsAttachedTerm(inp)) {
1105 return false;
1106 }
1107 attvar_record *attv = RepAttVar(VarOfTerm(inp));
1108 Term start = attv->Atts, *outside = &attv->Atts;
1109 do {
1110 if (IsVarTerm(start))
1111 return true;
1112 if (!IsApplTerm(start))
1113 return true;
1114 if (FunctorOfTerm(start) != FunctorAtt1) {
1115 outside = RepAppl(start) + 1;
1116 start = ArgOfTerm(1, start);
1117 continue;
1118 }
1119 if (mod != ArgOfTerm(1, start)) {
1120 outside = RepAppl(start) + 3;
1121 start = ArgOfTerm(3, start);
1122 continue;
1123 }
1124 // got it
1125 Term next = ArgOfTerm(3, start);
1126 if (outside == &attv->Atts && next == TermNil) {
1127 DelAllAtts(attv PASS_REGS);
1128 } else {
1129 MaBind(outside, next);
1130 }
1131 return true;
1132 } while (TRUE);
1133 return TRUE;
1134}
1135
1145static Int del_attrs(USES_REGS1) {
1146 /* receive a variable in ARG1 */
1147 Term inp = Deref(ARG1);
1148 /* if this is unbound, ok */
1149 if (!IsVarTerm(inp) || !IsAttachedTerm(inp)) {
1150 return false;
1151 }
1152 attvar_record *attv;
1153 attv = RepAttVar(VarOfTerm(inp));
1154 DelAllAtts(attv PASS_REGS);
1155 return TRUE;
1156}
1157
1159static Int swi_all_atts(USES_REGS1) {
1160 /* receive a variable in ARG1 */
1161 Term inp = Deref(ARG1);
1162 /* if this is unbound, ok */
1163 if (IsVarTerm(inp)) {
1164 if (IsAttachedTerm(inp)) {
1165 attvar_record *attv = RepAttVar(VarOfTerm(inp));
1166 return Yap_unify(ARG2, attv->Atts);
1167 }
1168 return Yap_unify(ARG2, TermNil);
1169 } else {
1170 Yap_Error(REPRESENTATION_ERROR_VARIABLE, inp,
1171 "first argument of get_all_swi_atts/2");
1172 return FALSE;
1173 }
1174}
1175
1176static Term AllAttVars(USES_REGS1) {
1177 CELL *pt = H0;
1178 CELL *myH = HR;
1179
1180 while (pt < myH) {
1181 Term reg = *pt;
1182 Functor f = (Functor)reg;
1183 if (reg == (CELL)FunctorAttVar) {
1184 if (IsUnboundVar(pt + 1)) {
1185 if (ASP - myH < 1024) {
1186 LOCAL_Error_Size = (ASP - HR) * sizeof(CELL);
1187 return 0L;
1188 }
1189 if (myH != HR) {
1190 myH[-1] = AbsPair(myH);
1191 }
1192 myH[0] = AbsAttVar((attvar_record *)pt);
1193 myH += 2;
1194 }
1195 pt += (1 + ATT_RECORD_ARITY);
1196 } else if (IsExtensionFunctor(f) && reg > 0 && reg % sizeof(CELL) == 0) {
1197 ssize_t bigsz = SizeOfOpaqueTerm(pt, reg);
1198 if (bigsz <= 0 || pt + bigsz > HR || !IsAtomTerm(pt[bigsz - 1])) {
1199 *pt++ = reg;
1200 continue;
1201 }
1202 CELL end = CloseExtension(pt);
1203 pt += bigsz - 1;
1204 *pt = end;
1205 } else {
1206 pt++;
1207 }
1208 }
1209 if (myH != HR) {
1210 Term out = AbsPair(HR);
1211 myH[-1] = TermNil;
1212 HR = myH;
1213 return out;
1214 } else {
1215 return TermNil;
1216 }
1217}
1218
1219static Int all_attvars(USES_REGS1) {
1220 do {
1221 Term out;
1222
1223 if (!(out = AllAttVars(PASS_REGS1))) {
1224 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1225 return FALSE;
1226 } else {
1227 return Yap_unify(ARG1, out);
1228 }
1229 } while (TRUE);
1230}
1231
1240static Int is_attvar(USES_REGS1) {
1241 Term t = Deref(ARG1);
1242 return (IsVarTerm(t) && IsAttVar(VarOfTerm(t)));
1243}
1244
1245/* check if we are not redoing effort */
1246static Int attvar_bound(USES_REGS1) {
1247 Term t = Deref(ARG1);
1248 return IsVarTerm(t) && IsAttachedTerm(t) &&
1249 !IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done));
1250}
1251
1252static Int void_term(USES_REGS1) { return Yap_unify(ARG1, TermVoidAtt); }
1253
1254static Int free_term(USES_REGS1) { return Yap_unify(ARG1, TermFreeTerm); }
1255
1256static Int fast_unify(USES_REGS1) {
1257 /*
1258 Case we want to unify two variables, but we do not
1259 think there is a point in waking them up
1260 */
1261 Term t1, t2;
1262 CELL *a, *b;
1263 if (!IsVarTerm(t1 = Deref(ARG1)))
1264 return FALSE;
1265 if (!IsVarTerm(t2 = Deref(ARG2)))
1266 return FALSE;
1267 a = VarOfTerm(t1);
1268 b = VarOfTerm(t2);
1269 if (a > b) {
1270 Bind_Global_NonAtt(a, t2);
1271 } else if ((a) < (b)) {
1272 Bind_Global_NonAtt(b, t1);
1273 }
1274 return TRUE;
1275}
1276
1277void Yap_InitAttVarPreds(void) {
1278 CACHE_REGS
1279 Yap_InitCPred("get_all_swi_atts", 2, swi_all_atts, SafePredFlag);
1280 Yap_InitCPred("put_attr", 3, put_attr, 0);
1281 Yap_InitCPred("put_attrs", 2, put_attrs, 0);
1282 Yap_InitCPred("get_attr", 3, get_attr, SafePredFlag);
1283 Yap_InitCPred("get_attrs", 2, get_attrs, SafePredFlag);
1284 Yap_InitCPred("del_attr", 2, del_attr, SafePredFlag);
1285 Yap_InitCPred("del_attrs", 1, del_attrs, SafePredFlag);
1286 Term OldCurrentModule = CurrentModule;
1287 CurrentModule = ATTRIBUTES_MODULE;
1288 GLOBAL_attas[attvars_ext].bind_op = WakeAttVar;
1289 GLOBAL_attas[attvars_ext].copy_term_op = CopyAttVar;
1290 GLOBAL_attas[attvars_ext].to_term_op = AttVarToTerm;
1291 GLOBAL_attas[attvars_ext].term_to_op = TermToAttVar;
1292 GLOBAL_attas[attvars_ext].mark_op = mark_attvar;
1293 Yap_InitCPred("get_att", 4, get_att, SafePredFlag);
1294 Yap_InitCPred("free_att", 3, free_att, SafePredFlag);
1295 Yap_InitCPred("put_att", 5, put_att, 0);
1296 Yap_InitCPred("has_module_atts", 2, has_atts, SafePredFlag);
1297 Yap_InitCPred("get_all_atts", 2, get_all_atts, SafePredFlag);
1298 Yap_InitCPred("get_module_atts", 2, get_atts, SafePredFlag);
1299 Yap_InitCPred("put_module_atts", 2, put_atts, 0);
1300 Yap_InitCPred("del_all_module_atts", 2, del_atts, 0);
1301 Yap_InitCPred("del_all_atts", 1, del_all_atts, 0);
1302 Yap_InitCPred("rm_att", 4, rm_att, 0);
1303 Yap_InitCPred("bind_attvar", 1, bind_attvar, SafePredFlag);
1304 Yap_InitCPred("unbind_attvar", 1, unbind_attvar, SafePredFlag);
1305 Yap_InitCPred("modules_with_attributes", 2, modules_with_atts, SafePredFlag);
1306 Yap_InitCPred("void_term", 1, void_term, SafePredFlag);
1307 Yap_InitCPred("free_term", 1, free_term, SafePredFlag);
1308 Yap_InitCPred("fast_unify_attributed", 2, fast_unify, 0);
1309 Yap_InitCPred("all_attvars", 1, all_attvars, 0);
1310 CurrentModule = OldCurrentModule;
1311 Yap_InitCPred("attvar", 1, is_attvar, SafePredFlag | TestPredFlag);
1312 Yap_InitCPred("$att_bound", 1, attvar_bound, SafePredFlag | TestPredFlag);
1313 Yap_InitCPred("$wake_up_start", 0, wake_up_start, 0);
1314 Yap_InitCPred("$wake_up_done", 0, wake_up_done, 0);
1315}
Yap.h
Main definitions.
cp_frame
Definition: attvar.c:105
copy_frame
Definition: utilpreds.c:517
attvar_struct
Attributed variales are controlled by the attvar_record.
Definition: attvar.h:49