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 #include "Yap.h"
19
20 #ifdef MULTI_ASSIGNMENT_VARIABLES
21
22 #include "Yatom.h"
23 #include "YapHeap.h"
24 #include "eval.h"
25
26 STD_PROTO(static Int p_setarg, (void));
27 STD_PROTO(static Int p_create_mutable, (void));
28 STD_PROTO(static Int p_get_mutable, (void));
29 STD_PROTO(static Int p_update_mutable, (void));
30 STD_PROTO(static Int p_is_mutable, (void));
31
32 static Int
p_setarg(void)33 p_setarg(void)
34 {
35 CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
36 Int i;
37
38 if (IsVarTerm(t3) &&
39 VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
40 /* local variable */
41 Term tn = MkVarTerm();
42 Bind_Local(VarOfTerm(t3), tn);
43 t3 = tn;
44 }
45 if (IsVarTerm(ti)) {
46 Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
47 return FALSE;
48 } else {
49 if (IsIntTerm(ti))
50 i = IntOfTerm(ti);
51 else {
52 Term te = Yap_Eval(ti);
53 if (IsIntegerTerm(te)) {
54 i = IntegerOfTerm(te);
55 } else {
56 Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
57 return FALSE;
58 }
59 }
60 }
61 if (IsVarTerm(ts)) {
62 Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
63 } else if(IsApplTerm(ts)) {
64 CELL *pt;
65 if (IsExtensionFunctor(FunctorOfTerm(ts))) {
66 Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
67 return FALSE;
68 }
69 if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
70 if (i<0)
71 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
72 return FALSE;
73 if (i==0)
74 Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
75 return FALSE;
76 }
77 pt = RepAppl(ts)+i;
78 /* the evil deed is to be done now */
79 MaBind(pt, t3);
80 } else if(IsPairTerm(ts)) {
81 CELL *pt;
82 if (i < 1 || i > 2) {
83 if (i<0)
84 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
85 return FALSE;
86 }
87 pt = RepPair(ts)+i-1;
88 /* the evil deed is to be done now */
89 MaBind(pt, t3);
90 } else {
91 Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
92 return FALSE;
93 }
94 return TRUE;
95 }
96
97
98 /* One problem with MAVars is that they you always trail on
99 non-determinate bindings. This is not cool if you have a long
100 determinate computation. One alternative could be to use
101 timestamps.
102
103 Because of !, the only timestamp one can trust is the trailpointer
104 (ouch..). The trail is not reclaimed after cuts. Also, if there was
105 a conditional binding, the trail is sure to have been increased
106 since the last choicepoint. For maximum effect, we can actually
107 store the current value of TR in the timestamp field, giving a way
108 to actually follow a link of all trailings for these variables.
109
110 */
111
112 /* create and initialise a new timed var. The problem is: how to set
113 the clock?
114
115 If I give it the current value of B->TR, we may have trouble if no
116 non-determinate bindings are made before the next
117 choice-point. Just to make sure this doesn't cause trouble, if (TR
118 == B->TR) we will add a little something ;-).
119 */
120
121 static Term
NewTimedVar(CELL val)122 NewTimedVar(CELL val)
123 {
124 Term out;
125 timed_var *tv;
126 if (IsVarTerm(val) &&
127 VarOfTerm(val) > H) {
128 Term nval = MkVarTerm();
129 Bind_Local(VarOfTerm(val), nval);
130 val = nval;
131 }
132 out = AbsAppl(H);
133 *H++ = (CELL)FunctorMutable;
134 tv = (timed_var *)H;
135 RESET_VARIABLE(&(tv->clock));
136 tv->value = val;
137 H += sizeof(timed_var)/sizeof(CELL);
138 return(out);
139 }
140
141 Term
Yap_NewTimedVar(CELL val)142 Yap_NewTimedVar(CELL val)
143 {
144 return NewTimedVar(val);
145 }
146
147 Term
Yap_NewEmptyTimedVar(void)148 Yap_NewEmptyTimedVar(void)
149 {
150 Term out = AbsAppl(H);
151 timed_var *tv;
152 *H++ = (CELL)FunctorMutable;
153 tv = (timed_var *)H;
154 RESET_VARIABLE(&(tv->clock));
155 RESET_VARIABLE(&(tv->value));
156 H += sizeof(timed_var)/sizeof(CELL);
157 return(out);
158 }
159
160 static Term
ReadTimedVar(Term inv)161 ReadTimedVar(Term inv)
162 {
163 timed_var *tv = (timed_var *)(RepAppl(inv)+1);
164 return(tv->value);
165 }
166
167 Term
Yap_ReadTimedVar(Term inv)168 Yap_ReadTimedVar(Term inv)
169 {
170 return ReadTimedVar(inv);
171 }
172
173
174 /* update a timed var with a new value */
175 static Term
UpdateTimedVar(Term inv,Term new)176 UpdateTimedVar(Term inv, Term new)
177 {
178 timed_var *tv = (timed_var *)(RepAppl(inv)+1);
179 CELL t = tv->value;
180 CELL* timestmp = (CELL *)(tv->clock);
181 if (IsVarTerm(new) &&
182 VarOfTerm(new) > H) {
183 Term nnew = MkVarTerm();
184 Bind_Local(VarOfTerm(new), nnew);
185 new = nnew;
186 }
187 if (timestmp > B->cp_h
188 #if FROZEN_STACKS
189 && timestmp > H_FZ
190 #endif
191 ) {
192 /* last assignment more recent than last B */
193 #if SBA
194 if (Unsigned((Int)(tv)-(Int)(H_FZ)) >
195 Unsigned((Int)(B_FZ)-(Int)(H_FZ)))
196 *STACK_TO_SBA(&(tv->value)) = new;
197 else
198 #endif
199 tv->value = new;
200 } else {
201 Term nclock = (Term)H;
202 MaBind(&(tv->value), new);
203 *H++ = TermFoundVar;
204 MaBind(&(tv->clock), nclock);
205 }
206 return(t);
207 }
208
209 /* update a timed var with a new value */
210 Term
Yap_UpdateTimedVar(Term inv,Term new)211 Yap_UpdateTimedVar(Term inv, Term new)
212 {
213 return UpdateTimedVar(inv, new);
214 }
215
216 static Int
p_create_mutable(void)217 p_create_mutable(void)
218 {
219 Term t = NewTimedVar(Deref(ARG1));
220 return(Yap_unify(ARG2,t));
221 }
222
223 static Int
p_get_mutable(void)224 p_get_mutable(void)
225 {
226 Term t = Deref(ARG2);
227 if (IsVarTerm(t)) {
228 Yap_Error(INSTANTIATION_ERROR, t, "get_mutable/3");
229 return(FALSE);
230 }
231 if (!IsApplTerm(t)) {
232 Yap_Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
233 return(FALSE);
234 }
235 if (FunctorOfTerm(t) != FunctorMutable) {
236 Yap_Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
237 return(FALSE);
238 }
239 t = ReadTimedVar(t);
240 return(Yap_unify(ARG1, t));
241 }
242
243 static Int
p_update_mutable(void)244 p_update_mutable(void)
245 {
246 Term t = Deref(ARG2);
247 if (IsVarTerm(t)) {
248 Yap_Error(INSTANTIATION_ERROR, t, "update_mutable/3");
249 return(FALSE);
250 }
251 if (!IsApplTerm(t)) {
252 Yap_Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
253 return(FALSE);
254 }
255 if (FunctorOfTerm(t) != FunctorMutable) {
256 Yap_Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
257 return(FALSE);
258 }
259 UpdateTimedVar(t, Deref(ARG1));
260 return(TRUE);
261 }
262
263 static Int
p_is_mutable(void)264 p_is_mutable(void)
265 {
266 Term t = Deref(ARG1);
267 if (IsVarTerm(t)) {
268 return(FALSE);
269 }
270 if (!IsApplTerm(t)) {
271 return(FALSE);
272 }
273 if (FunctorOfTerm(t) != FunctorMutable) {
274 return(FALSE);
275 }
276 return(TRUE);
277 }
278
279 #endif
280
281 void
Yap_InitMaVarCPreds(void)282 Yap_InitMaVarCPreds(void)
283 {
284 #ifdef MULTI_ASSIGNMENT_VARIABLES
285 /* The most famous contributions of SICStus to the Prolog language */
286 Yap_InitCPred("setarg", 3, p_setarg, SafePredFlag);
287 Yap_InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
288 Yap_InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
289 Yap_InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
290 Yap_InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
291 #endif
292 }
293