YAP 7.1.0
eval.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: eval.c *
12* Last rev: *
13* mods: *
14* comments: arithmetical expression evaluation *
15* *
16*************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
22
23
24
30#include "Yap.h"
31
32#include "YapHeap.h"
33#include "Yatom.h"
34#include "YapEval.h"
35#if HAVE_STDARG_H
36#include <stdarg.h>
37#endif
38#include <stdlib.h>
39#if HAVE_UNISTD_H
40#include <unistd.h>
41#endif
42#if HAVE_FENV_H
43#include <fenv.h>
44#endif
45
46static Term Eval(Term t1 USES_REGS);
47
48static Term get_matrix_element(Term t1, Term t2 USES_REGS) {
49 if (!IsPairTerm(t2)) {
50 if (t2 == MkAtomTerm(AtomLength)) {
51 Int sz = 1;
52 while (IsApplTerm(t1)) {
53 Functor f = FunctorOfTerm(t1);
54 if (NameOfFunctor(f) != AtomNil) {
55 return MkIntegerTerm(sz);
56 }
57 sz *= ArityOfFunctor(f);
58 t1 = ArgOfTerm(1, t1);
59 }
60 return MkIntegerTerm(sz);
61 }
62 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
63 return FALSE;
64 }
65 while (IsPairTerm(t2)) {
66 Int indx;
67 Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
68 if (!IsIntegerTerm(indxt)) {
69 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
70 return FALSE;
71 }
72 indx = IntegerOfTerm(indxt);
73 if (!IsApplTerm(t1)) {
74 Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
75 return FALSE;
76 } else {
77 Functor f = FunctorOfTerm(t1);
78 if (ArityOfFunctor(f) < indx) {
79 Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
80 return FALSE;
81 }
82 }
83 t1 = ArgOfTerm(indx, t1);
84 t2 = TailOfTerm(t2);
85 }
86 if (t2 != TermNil) {
87 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
88 return FALSE;
89 }
90 return Eval(t1 PASS_REGS);
91}
92
93static Term Eval(Term t USES_REGS) {
94
95 if (IsVarTerm(t)) {
96 Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic");
97 } else if (IsNumTerm(t)) {
98 return t;
99 } else if (IsAtomTerm(t)) {
100 ExpEntry *p;
101 Atom name = AtomOfTerm(t);
102
103 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
104 Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
105 "atom %s in arithmetic expression",
106 RepAtom(name)->StrOfAE);
107 }
108 return Yap_eval_atom(p->FOfEE);
109 } else if (IsApplTerm(t)) {
110 Functor fun = FunctorOfTerm(t);
111 if (fun == FunctorString) {
112 const char *s = (const char *)StringOfTerm(t);
113 if (s[1] == '\0')
114 return MkIntegerTerm(s[0]);
115 Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
116 "string in arithmetic expression");
117 } else if ((Atom)fun == AtomFoundVar) {
118 Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
119 "cyclic term in arithmetic expression");
120 } else {
121 Int n = ArityOfFunctor(fun);
122 Atom name = NameOfFunctor(fun);
123 ExpEntry *p;
124 Term t1, t2;
125
126 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
127 Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
128 "functor %s/%d for arithmetic expression",
129 RepAtom(name)->StrOfAE, n);
130 }
131 if (p->FOfEE == op_power && p->ArityOfEE == 2) {
132 t2 = ArgOfTerm(2, t);
133 if (IsPairTerm(t2)) {
134 return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
135 }
136 }
137 *RepAppl(t) = (CELL)AtomFoundVar;
138 t1 = Eval(ArgOfTerm(1, t) PASS_REGS);
139 if (t1 == 0L) {
140 *RepAppl(t) = (CELL)fun;
141 return FALSE;
142 }
143 if (n == 1) {
144 *RepAppl(t) = (CELL)fun;
145 return Yap_eval_unary(p->FOfEE, t1);
146 }
147 t2 = Eval(ArgOfTerm(2, t) PASS_REGS);
148 *RepAppl(t) = (CELL)fun;
149 if (t2 == 0L)
150 return FALSE;
151 return Yap_eval_binary(p->FOfEE, t1, t2);
152 }
153 } /* else if (IsPairTerm(t)) */
154 {
155 if (TailOfTerm(t) != TermNil) {
156 Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
157 "string must contain a single character to be "
158 "evaluated as an arithmetic expression");
159 }
160 return Eval(HeadOfTerm(t) PASS_REGS);
161 }
162}
163
164Term Yap_InnerEval__(Term t USES_REGS) { return Eval(t PASS_REGS); }
165
166#ifdef BEAM
167Int BEAM_is(void);
168
169Int BEAM_is(void) { /* X is Y */
170 union arith_ret res;
171 blob_type bt;
172
173 bt = Eval(Deref(XREGS[2]), &res);
174 if (bt == db_ref_e)
175 return (NULL);
176 return (EvalToTerm(bt, &res));
177}
178
179#endif
180
196static Int p_is(USES_REGS1) { /* X is Y */
197 Term out;
198 yap_error_number err;
199
200 Term t = Deref(ARG2);
201 if (IsVarTerm(t)) {
202 Yap_EvalError(INSTANTIATION_ERROR, t, "X is Y");
203 return (FALSE);
204 } else if (IsNumTerm(t)) {
205 return Yap_unify(ARG1, t);
206 }
207 Yap_ClearExs();
208 do {
209 out = Yap_InnerEval(Deref(ARG2));
210 if ((err = Yap_FoundArithError()) == YAP_NO_ERROR)
211 break;
212 if (err == RESOURCE_ERROR_STACK) {
213 LOCAL_Error_TYPE = YAP_NO_ERROR;
214 if (!Yap_dogc()) {
215 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
216 return FALSE;
217 }
218 } else {
219 Yap_EvalError(err, takeIndicator(ARG2), "X is Exp");
220 return FALSE;
221 }
222 } while (TRUE);
223 return Yap_unify_constant(ARG1, out);
224}
225
232static Int p_isnan(USES_REGS1) { /* X isnan Y */
233 Term out = 0L;
234
235 while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
236 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
237 LOCAL_Error_TYPE = YAP_NO_ERROR;
238 if (!Yap_dogc()) {
239 Yap_EvalError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
240 return FALSE;
241 }
242 } else {
243 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
244 return FALSE;
245 }
246 }
247 if (IsVarTerm(out)) {
248 Yap_EvalError(INSTANTIATION_ERROR, out, "isnan/1");
249 return FALSE;
250 }
251 if (!IsFloatTerm(out)) {
252 Yap_EvalError(TYPE_ERROR_FLOAT, out, "isnan/1");
253 return FALSE;
254 }
255 return isnan(FloatOfTerm(out));
256}
257
264static Int p_isinf(USES_REGS1) { /* X is Y */
265 Term out = 0L;
266
267 while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
268 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
269 LOCAL_Error_TYPE = YAP_NO_ERROR;
270 if (!Yap_dogc()) {
271 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
272 return FALSE;
273 }
274 } else {
275 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
276 return FALSE;
277 }
278 }
279 if (IsVarTerm(out)) {
280 Yap_EvalError(INSTANTIATION_ERROR, out, "isinf/1");
281 return FALSE;
282 }
283 if (!IsFloatTerm(out)) {
284 Yap_EvalError(TYPE_ERROR_FLOAT, out, "isinf/1");
285 return FALSE;
286 }
287 return isinf(FloatOfTerm(out));
288}
289
298static Int p_logsum(USES_REGS1) { /* X is Y */
299 Term t1 = Deref(ARG1);
300 Term t2 = Deref(ARG2);
301 int done = FALSE;
302 Float f1, f2;
303
304 while (!done) {
305 if (IsFloatTerm(t1)) {
306 f1 = FloatOfTerm(t1);
307 done = TRUE;
308 } else if (IsIntegerTerm(t1)) {
309 f1 = IntegerOfTerm(t1);
310 done = TRUE;
311 } else if (IsBigIntTerm(t1)) {
312 f1 = Yap_gmp_to_float(t1);
313 done = TRUE;
314 } else {
315 while (!(t1 = Eval(t1 PASS_REGS))) {
316 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
317 LOCAL_Error_TYPE = YAP_NO_ERROR;
318 if (!Yap_dogc()) {
319 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
320 return FALSE;
321 }
322 } else {
323 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
324 return FALSE;
325 }
326 }
327 }
328 }
329 done = FALSE;
330 while (!done) {
331 if (IsFloatTerm(t2)) {
332 f2 = FloatOfTerm(t2);
333 done = TRUE;
334 } else if (IsIntegerTerm(t2)) {
335 f2 = IntegerOfTerm(t2);
336 done = TRUE;
337 } else if (IsBigIntTerm(t2)) {
338 f2 = Yap_gmp_to_float(t2);
339 done = TRUE;
340 } else {
341 while (!(t2 = Eval(t2 PASS_REGS))) {
342 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
343 LOCAL_Error_TYPE = YAP_NO_ERROR;
344 if (!Yap_dogc()) {
345 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
346 return FALSE;
347 }
348 } else {
349 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
350 return FALSE;
351 }
352 }
353 }
354 }
355 if (f1 >= f2) {
356 Float fi = exp(f2 - f1);
357 return Yap_unify(ARG3, MkFloatTerm(f1 + log(1 + fi)));
358 } else {
359 Float fi = exp(f1 - f2);
360 return Yap_unify(ARG3, MkFloatTerm(f2 + log(1 + fi)));
361 }
362}
363
364void Yap_EvalError__(const char *file, const char *function, int lineno,
365 yap_error_number type, Term where, ...) {
366 CACHE_REGS
367 va_list ap;
368 char *format, * buf;
369 if (!LOCAL_ErrorMessage)
370 LOCAL_ErrorMessage = malloc(4096);
371 buf = LOCAL_ErrorMessage;
372
373 va_start(ap, where);
374 format = va_arg(ap, char *);
375 if (format != NULL) {
376#if HAVE_VSNPRINTF
377 (void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap);
378#else
379 (void)vsprintf(buf, format, ap);
380#endif
381 } else {
382 buf[0] = '\0';
383 }
384 va_end(ap);
385 Yap_ThrowError__(file, function, lineno, type, where, buf);
386}
387
401static Int cont_between(USES_REGS1) {
402 Term t1 = EXTRA_CBACK_ARG(3, 1);
403 Term t2 = EXTRA_CBACK_ARG(3, 2);
404
405 Yap_unify(ARG3, t1);
406 if (IsIntegerTerm(t1)) {
407 Int i1;
408 Term tn;
409
410 if (t1 == t2)
411 cut_succeed();
412 i1 = IntegerOfTerm(t1);
413 tn = add_int(i1, 1 PASS_REGS);
414 EXTRA_CBACK_ARG(3, 1) = tn;
415 HB = B->cp_h = HR;
416 return TRUE;
417 } else {
418 Term t[2];
419 Term tn;
420 Int cmp;
421
422 cmp = Yap_acmp(t1, t2 PASS_REGS);
423 if (cmp == 0)
424 cut_succeed();
425 t[0] = t1;
426 t[1] = MkIntTerm(1);
427 tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
428 EXTRA_CBACK_ARG(3, 1) = tn;
429 HB = B->cp_h = HR;
430 return TRUE;
431 }
432}
433
434
435static Int init_between(USES_REGS1) {
436 Term t1 = Deref(ARG1);
437 Term t2 = Deref(ARG2);
438
439 if (IsVarTerm(t1)) {
440 Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
441 return FALSE;
442 }
443 if (IsVarTerm(t2)) {
444 Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
445 return FALSE;
446 }
447 if (!IsIntegerTerm(t1) && !IsBigIntTerm(t1)) {
448 Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3");
449 return FALSE;
450 }
451 if (!IsIntegerTerm(t2) && !IsBigIntTerm(t2) && t2 != MkAtomTerm(AtomInf) &&
452 t2 != MkAtomTerm(AtomInfinity)) {
453 Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3");
454 return FALSE;
455 }
456 if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
457 Int i1 = IntegerOfTerm(t1);
458 Int i2 = IntegerOfTerm(t2);
459 Term t3;
460
461 t3 = Deref(ARG3);
462 if (!IsVarTerm(t3)) {
463 if (!IsIntegerTerm(t3)) {
464 if (!IsBigIntTerm(t3)) {
465 Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
466 return FALSE;
467 }
468 cut_fail();
469 } else {
470 Int i3 = IntegerOfTerm(t3);
471 if (i3 >= i1 && i3 <= i2)
472 cut_succeed();
473 cut_fail();
474 }
475 }
476 if (i1 > i2)
477 cut_fail();
478 if (i1 == i2) {
479 Yap_unify(ARG3, t1);
480 cut_succeed();
481 }
482 } else if (IsIntegerTerm(t1) && IsAtomTerm(t2)) {
483 Int i1 = IntegerOfTerm(t1);
484 Term t3;
485
486 t3 = Deref(ARG3);
487 if (!IsVarTerm(t3)) {
488 if (!IsIntegerTerm(t3)) {
489 if (!IsBigIntTerm(t3)) {
490 Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
491 return FALSE;
492 }
493 cut_fail();
494 } else {
495 Int i3 = IntegerOfTerm(t3);
496 if (i3 >= i1)
497 cut_succeed();
498 cut_fail();
499 }
500 }
501 } else {
502 Term t3 = Deref(ARG3);
503 Int cmp;
504
505 if (!IsVarTerm(t3)) {
506 if (!IsIntegerTerm(t3) && !IsBigIntTerm(t3)) {
507 Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
508 return FALSE;
509 }
510 if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2, t3 PASS_REGS) >= 0 &&
511 P != FAILCODE)
512 cut_succeed();
513 cut_fail();
514 }
515 cmp = Yap_acmp(t1, t2 PASS_REGS);
516 if (cmp > 0)
517 cut_fail();
518 if (cmp == 0) {
519 Yap_unify(ARG3, t1);
520 cut_succeed();
521 }
522 }
523 EXTRA_CBACK_ARG(3, 1) = t1;
524 EXTRA_CBACK_ARG(3, 2) = t2;
525 return cont_between(PASS_REGS1);
526}
527
528void Yap_InitEval(void) {
529 /* here are the arithmetical predicates */
530 Yap_InitConstExps();
531 Yap_InitUnaryExps();
532 Yap_InitBinaryExps();
533 Yap_InitCPred("is", 2, p_is, 0L);
534 Yap_InitCPred("isnan", 1, p_isnan, TestPredFlag);
535 Yap_InitCPred("isinf", 1, p_isinf, TestPredFlag);
536 Yap_InitCPred("logsum", 3, p_logsum, TestPredFlag);
537 Yap_InitCPredBack("between", 3, 2, init_between, cont_between, 0);
538}
539
Main definitions.
void Yap_ThrowError__(const char *file, const char *function, int lineno, yap_error_number type, Term where, const char *msg,...)
Throw an error directly to the error handler.
Definition: errors.c:789