YAP 7.1.0
mavar.c
Go to the documentation of this file.
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: mavar.c *
12* Last rev: *
13* mods: *
14* comments: support from multiple assignment variables in YAP *
15* *
16*************************************************************************/
17
18
24/*
25@defgroup Term_Modification Term Modification
26@ingroup YAPTerms
27@{
28
29It is sometimes useful to change the value of instantiated
30variables. Although, this is against the spirit of logic programming, it
31is sometimes useful. As in other Prolog systems, YAP has
32several primitives that allow updating Prolog terms. Note that these
33primitives are also backtrackable.
34
35The setarg/3 primitive allows updating any argument of a Prolog
36compound terms. The _mutable_ family of predicates provides
37<em>mutable variables</em>. They should be used instead of setarg/3,
38as they allow the encapsulation of accesses to updatable
39variables. Their implementation can also be more efficient for long
40deterministic computations.
41
42YAP also include non_backtrackable versions of these routines, that
43should be used with care.
44
45
46*/
47
48
49#include "Yap.h"
50
51#include "Yatom.h"
52#include "YapHeap.h"
53#include "YapEval.h"
54#include "YapArenas.h"
55
56static Int p_setarg( USES_REGS1 );
57static Int p_create_mutable( USES_REGS1 );
58static Int p_get_mutable( USES_REGS1 );
59static Int p_update_mutable( USES_REGS1 );
60static Int p_is_mutable( USES_REGS1 );
61
69static Int
70p_setarg( USES_REGS1 )
71{
72 CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
73 Int i;
74
75 if (IsVarTerm(t3) &&
76 VarOfTerm(t3) > HR &&VarOfTerm(t3) < ASP) {
77 /* local variable */
78 Term tn = MkVarTerm();
79 Bind_Local(VarOfTerm(t3), tn);
80 t3 = tn;
81 }
82 if (IsVarTerm(ti)) {
83 Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
84 return FALSE;
85 } else {
86 if (IsIntTerm(ti))
87 i = IntOfTerm(ti);
88 else {
89 Term te = Yap_Eval(ti);
90 if (IsIntegerTerm(te)) {
91 i = IntegerOfTerm(te);
92 } else {
93 Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
94 return FALSE;
95 }
96 }
97 }
98 if (IsVarTerm(ts)) {
99 Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
100 } else if(IsApplTerm(ts)) {
101 CELL *pt;
102 if (IsExtensionFunctor(FunctorOfTerm(ts))) {
103 Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
104 return FALSE;
105 }
106 if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
107 if (i<0)
108 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
109 return FALSE;
110 if (i==0)
111 Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
112 return FALSE;
113 }
114 pt = RepAppl(ts)+i;
115 /* the evil deed is to be done now */
116 MaBind(pt, t3);
117 } else if(IsPairTerm(ts)) {
118 CELL *pt;
119 if (i < 1 || i > 2) {
120 if (i<0)
121 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
122 return FALSE;
123 }
124 pt = RepPair(ts)+i-1;
125 /* the evil deed is to be done now */
126 MaBind(pt, t3);
127 } else {
128 Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
129 return FALSE;
130 }
131 return TRUE;
132}
133
134
135/* One problem with MAVars is that they you always trail on
136 non-determinate bindings. This is not cool if you have a long
137 determinate computation. One alternative could be to use
138 timestamps.
139
140 Because of !, the only timestamp one can trust is the trailpointer
141 (ouch..). The trail is not reclaimed after cuts. Also, if there was
142 a conditional binding, the trail is sure to have been increased
143 since the last choicepoint. For maximum effect, we can actually
144 store the current value of TR in the timestamp field, giving a way
145 to actually follow a link of all trailings for these variables.
146
147*/
148
149/* create and initialize a new timed var. The problem is: how to set
150 the clock?
151
152 If I give it the current value of B->TR, we may have trouble if no
153 non-determinate bindings are made before the next
154 choice-point. Just to make sure this doesn't cause trouble, if (TR
155 == B->TR) we will add a little something ;-).
156 */
157
158static Term
159NewTimedVar(CELL val USES_REGS)
160{
161 Term out;
162 timed_var *tv;
163 if (IsVarTerm(val) &&
164 VarOfTerm(val) > HR) {
165 Term nval = MkVarTerm();
166 Bind_Local(VarOfTerm(val), nval);
167 val = nval;
168 }
169 out = AbsAppl(HR);
170 *HR++ = (CELL)FunctorMutable;
171 tv = (timed_var *)HR;
172 RESET_VARIABLE(&(tv->clock));
173 tv->value = val;
174 HR += sizeof(timed_var)/sizeof(CELL);
175 return(out);
176}
177
178Term
179Yap_NewTimedVar(CELL val)
180{
181 CACHE_REGS
182 return NewTimedVar(val PASS_REGS);
183}
184
185Term
186Yap_NewEmptyTimedVar( void )
187{
188 CACHE_REGS
189 Term out = AbsAppl(HR);
190 timed_var *tv;
191 *HR++ = (CELL)FunctorMutable;
192 tv = (timed_var *)HR;
193 RESET_VARIABLE(&(tv->clock));
194 RESET_VARIABLE(&(tv->value));
195 HR += sizeof(timed_var)/sizeof(CELL);
196 return(out);
197}
198
199Term
200Yap_NewCompactTimedVar( Term v )
201{
202 CACHE_REGS
203 Term out = AbsAppl(HR);
204 timed_var *tv;
205 *HR++ = (CELL)FunctorMutable;
206 tv = (timed_var *)HR;
207 RESET_VARIABLE(&(tv->clock));
208 tv->value = v;
209 HR += sizeof(timed_var)/sizeof(CELL);
210 return(out);
211}
212
213static Term
214ReadTimedVar(Term inv)
215{
216 timed_var *tv = (timed_var *)(RepAppl(inv)+1);
217 return(Deref(tv->value));
218}
219
220Term
221Yap_ReadTimedVar(Term inv)
222{
223 return ReadTimedVar(inv);
224}
225
226
227/* update a timed var with a new value */
228static Term
229UpdateTimedVar(Term inv, Term new USES_REGS)
230{
231 timed_var *tv = (timed_var *)(RepAppl(inv)+1);
232 CELL t = tv->value;
233 CELL* timestmp = (CELL *)(tv->clock);
234 if (IsVarTerm(new) &&
235 VarOfTerm(new) > HR) {
236 Term nnew = MkVarTerm();
237 Bind_Local(VarOfTerm(new), nnew);
238 new = nnew;
239 }
240 if (timestmp > B->cp_h
241#if FROZEN_STACKS
242 && timestmp > H_FZ
243#endif
244 ) {
245 /* last assignment more recent than last B */
246#if YAPOR_SBA
247 if (Unsigned((Int)(tv)-(Int)(H_FZ)) >
248 Unsigned((Int)(B_FZ)-(Int)(H_FZ)))
249 *STACK_TO_SBA(&(tv->value)) = new;
250 else
251#endif
252 tv->value = new;
253 } else {
254 Term nclock = (Term)HR;
255 *HR++ = TermFoundVar;
256 MaBind(&(tv->clock), nclock);
257 MaBind(&(tv->value), new);
258 }
259 return(t);
260}
261
262/* update a timed var with a new value */
263Term
264Yap_UpdateTimedVar(Term inv, Term new)
265{
266 CACHE_REGS
267 return UpdateTimedVar(inv, new PASS_REGS);
268}
269
275static Int
276p_create_mutable( USES_REGS1 )
277{
278 Term t = NewTimedVar(Deref(ARG1) PASS_REGS);
279 return(Yap_unify(ARG2,t));
280}
281
287static Int
288p_get_mutable( USES_REGS1 )
289{
290 Term t = Deref(ARG2);
291 if (IsVarTerm(t)) {
292 Yap_Error(INSTANTIATION_ERROR, t, "get_mutable/3");
293 return(FALSE);
294 }
295 if (!IsApplTerm(t)) {
296 Yap_Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
297 return(FALSE);
298 }
299 if (FunctorOfTerm(t) != FunctorMutable) {
300 Yap_Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
301 return(FALSE);
302 }
303 t = ReadTimedVar(t);
304 return(Yap_unify(ARG1, t));
305}
306
315static Int
316p_update_mutable( USES_REGS1 )
317{
318 Term t = Deref(ARG2);
319 if (IsVarTerm(t)) {
320 Yap_Error(INSTANTIATION_ERROR, t, "update_mutable/3");
321 return(FALSE);
322 }
323 if (!IsApplTerm(t)) {
324 Yap_Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
325 return(FALSE);
326 }
327 if (FunctorOfTerm(t) != FunctorMutable) {
328 Yap_Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
329 return(FALSE);
330 }
331 UpdateTimedVar(t, Deref(ARG1) PASS_REGS);
332 return(TRUE);
333}
334
340static Int
341p_is_mutable( USES_REGS1 )
342{
343 Term t = Deref(ARG1);
344 if (IsVarTerm(t)) {
345 return(FALSE);
346 }
347 if (!IsApplTerm(t)) {
348 return(FALSE);
349 }
350 if (FunctorOfTerm(t) != FunctorMutable) {
351 return(FALSE);
352 }
353 return(TRUE);
354}
355
389static Int nb_setarg(USES_REGS1) {
390 Term wheret = Deref(ARG1);
391 Term dest;
392 Term to;
393 UInt arity, pos;
394 CELL *destp;
395
396 if (IsVarTerm(wheret)) {
397 Yap_ThrowError(INSTANTIATION_ERROR, wheret, "nb_setarg");
398 return FALSE;
399 }
400 if (!IsIntegerTerm(wheret)) {
401 Yap_ThrowError(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
402 return FALSE;
403 }
404 pos = IntegerOfTerm(wheret);
405 dest = Deref(ARG2);
406 if (IsVarTerm(dest)) {
407 Yap_ThrowError(INSTANTIATION_ERROR, dest, "nb_setarg");
408 return FALSE;
409 } else if (IsPrimitiveTerm(dest)) {
410 arity = 0;
411 } else if (IsPairTerm(dest)) {
412 arity = 2;
413 } else {
414 arity = ArityOfFunctor(FunctorOfTerm(dest));
415 }
416 if (pos < 1 || pos > arity)
417 return FALSE;
418 COPY(ARG3);
419
420 to = Deref(ARG3);
421 to = CopyTermToArena(Deref(ARG3), FALSE, TRUE, NULL, &LOCAL_GlobalArena, NULL
422 PASS_REGS);
423 if (to == 0L)
424 return FALSE;
425
426 dest = Deref(ARG2);
427 if (IsPairTerm(dest)) {
428 destp = RepPair(dest) - 1;
429 } else {
430 destp = RepAppl(dest);
431 }
432 destp[pos] = to;
433 return TRUE;
434}
435
446static Int nb_set_shared_arg(USES_REGS1) {
447 Term wheret = Deref(ARG1);
448 Term dest;
449 Term to;
450 UInt arity, pos;
451 CELL *destp;
452
453 if (IsVarTerm(wheret)) {
454 Yap_ThrowError(INSTANTIATION_ERROR, wheret, "nb_setarg");
455 return FALSE;
456 }
457 if (!IsIntegerTerm(wheret)) {
458 Yap_ThrowError(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
459 return FALSE;
460 }
461 pos = IntegerOfTerm(wheret);
462 dest = Deref(ARG2);
463 if (IsVarTerm(dest)) {
464 Yap_ThrowError(INSTANTIATION_ERROR, dest, "nb_setarg");
465 return FALSE;
466 } else if (IsPrimitiveTerm(dest)) {
467 arity = 0;
468 } else if (IsPairTerm(dest)) {
469 arity = 2;
470 } else {
471 arity = ArityOfFunctor(FunctorOfTerm(dest));
472 }
473 if (pos < 1 || pos > arity)
474 return FALSE;
475 COPY(ARG3);
476 to = CopyTermToArena(Deref(ARG3), TRUE, TRUE, NULL, &LOCAL_GlobalArena, NULL PASS_REGS);
477 if (to == 0L)
478 return FALSE;
479 dest = Deref(ARG2);
480 if (IsPairTerm(dest)) {
481 destp = RepPair(dest) - 1;
482 } else {
483 destp = RepAppl(dest);
484 }
485 destp[pos] = to;
486 return TRUE;
487}
488
499static Int nb_linkarg(USES_REGS1) {
500 Term wheret = Deref(ARG1);
501 Term dest;
502 UInt arity, pos;
503 CELL *destp;
504
505 if (IsVarTerm(wheret)) {
506 Yap_ThrowError(INSTANTIATION_ERROR, wheret, "nb_setarg");
507 return FALSE;
508 }
509 if (!IsIntegerTerm(wheret)) {
510 Yap_ThrowError(TYPE_ERROR_INTEGER, wheret, "nb_setarg");
511 return FALSE;
512 }
513 pos = IntegerOfTerm(wheret);
514 dest = Deref(ARG3);
515 if (IsVarTerm(dest)) {
516 Yap_ThrowError(INSTANTIATION_ERROR, dest, "nb_setarg");
517 return FALSE;
518 } else if (IsPrimitiveTerm(dest)) {
519 arity = 0;
520 destp = NULL;
521 } else if (IsPairTerm(dest)) {
522 arity = 2;
523 destp = RepPair(dest) - 1;
524 } else {
525 arity = ArityOfFunctor(FunctorOfTerm(dest));
526 destp = RepAppl(dest);
527 }
528 if (pos < 1 || pos > arity)
529 return FALSE;
530 dest = Deref(ARG2);
531 destp[pos] = Deref(ARG3);
532 return TRUE;
533}
534
561static Int nb_linkval(USES_REGS1) {
562 Term t = Deref(ARG1), to;
563 GlobalEntry *ge;
564 if (IsVarTerm(t)) {
565 Yap_ThrowError(INSTANTIATION_ERROR, t, "nb_linkval");
566 return (TermNil);
567 } else if (!IsAtomTerm(t)) {
568 Yap_ThrowError(TYPE_ERROR_ATOM, t, "nb_linkval");
569 return (FALSE);
570 }
571 ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS);
572 to = Deref(ARG2);
573 WRITE_LOCK(ge->GRWLock);
574 ge->global = to;
575 WRITE_UNLOCK(ge->GRWLock);
576 return TRUE;
577}
578
579
580void
581Yap_InitMaVarCPreds(void)
582{
583#ifdef MULTI_ASSIGNMENT_VARIABLES
584 Yap_InitCPred("setarg", 3, p_setarg, SafePredFlag);
585 Yap_InitCPred("nb_setarg", 3, nb_setarg, 0L);
586 Yap_InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
587 Yap_InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
588 Yap_InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
589 Yap_InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
590 Yap_InitCPred("nb_set_shared_arg", 3, nb_set_shared_arg, 0L);
591 Yap_InitCPred("nb_linkval", 2, nb_linkval, 0L);
592 Yap_InitCPred("nb_linkarg", 3, nb_linkarg, 0L);
593#endif
594}
595
Main definitions.
Definition: Yatom.h:151