18static char SccsId[] =
"%W% %G%";
46static Term Eval(Term t1 USES_REGS);
48static Term get_matrix_element(Term t1, Term t2 USES_REGS) {
49 if (!IsPairTerm(t2)) {
50 if (t2 == MkAtomTerm(AtomLength)) {
52 while (IsApplTerm(t1)) {
54 if (NameOfFunctor(f) != AtomNil) {
55 return MkIntegerTerm(sz);
57 sz *= ArityOfFunctor(f);
58 t1 = ArgOfTerm(1, t1);
60 return MkIntegerTerm(sz);
62 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2,
"X is Y^[A]");
65 while (IsPairTerm(t2)) {
67 Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
68 if (!IsIntegerTerm(indxt)) {
69 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2,
"X is Y^[A]");
72 indx = IntegerOfTerm(indxt);
73 if (!IsApplTerm(t1)) {
74 Yap_ArithError(TYPE_ERROR_EVALUABLE, t1,
"X is Y^[A]");
78 if (ArityOfFunctor(f) < indx) {
79 Yap_ArithError(TYPE_ERROR_EVALUABLE, t1,
"X is Y^[A]");
83 t1 = ArgOfTerm(indx, t1);
87 Yap_ArithError(TYPE_ERROR_EVALUABLE, t2,
"X is Y^[A]");
90 return Eval(t1 PASS_REGS);
93static Term Eval(Term t USES_REGS) {
96 Yap_ArithError(INSTANTIATION_ERROR, t,
"in arithmetic");
97 }
else if (IsNumTerm(t)) {
99 }
else if (IsAtomTerm(t)) {
101 Atom name = AtomOfTerm(t);
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);
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);
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");
121 Int n = ArityOfFunctor(fun);
122 Atom name = NameOfFunctor(fun);
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);
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);
137 *RepAppl(t) = (CELL)AtomFoundVar;
138 t1 = Eval(ArgOfTerm(1, t) PASS_REGS);
140 *RepAppl(t) = (CELL)fun;
144 *RepAppl(t) = (CELL)fun;
145 return Yap_eval_unary(p->FOfEE, t1);
147 t2 = Eval(ArgOfTerm(2, t) PASS_REGS);
148 *RepAppl(t) = (CELL)fun;
151 return Yap_eval_binary(p->FOfEE, t1, t2);
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");
160 return Eval(HeadOfTerm(t) PASS_REGS);
164Term Yap_InnerEval__(Term t USES_REGS) {
return Eval(t PASS_REGS); }
173 bt = Eval(Deref(XREGS[2]), &res);
176 return (EvalToTerm(bt, &res));
196static Int p_is(USES_REGS1) {
198 yap_error_number err;
200 Term t = Deref(ARG2);
202 Yap_EvalError(INSTANTIATION_ERROR, t,
"X is Y");
204 }
else if (IsNumTerm(t)) {
205 return Yap_unify(ARG1, t);
209 out = Yap_InnerEval(Deref(ARG2));
210 if ((err = Yap_FoundArithError()) == YAP_NO_ERROR)
212 if (err == RESOURCE_ERROR_STACK) {
213 LOCAL_Error_TYPE = YAP_NO_ERROR;
215 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
219 Yap_EvalError(err, takeIndicator(ARG2),
"X is Exp");
223 return Yap_unify_constant(ARG1, out);
232static Int p_isnan(USES_REGS1) {
235 while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
236 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
237 LOCAL_Error_TYPE = YAP_NO_ERROR;
239 Yap_EvalError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
243 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
247 if (IsVarTerm(out)) {
248 Yap_EvalError(INSTANTIATION_ERROR, out,
"isnan/1");
251 if (!IsFloatTerm(out)) {
252 Yap_EvalError(TYPE_ERROR_FLOAT, out,
"isnan/1");
255 return isnan(FloatOfTerm(out));
264static Int p_isinf(USES_REGS1) {
267 while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
268 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
269 LOCAL_Error_TYPE = YAP_NO_ERROR;
271 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
275 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
279 if (IsVarTerm(out)) {
280 Yap_EvalError(INSTANTIATION_ERROR, out,
"isinf/1");
283 if (!IsFloatTerm(out)) {
284 Yap_EvalError(TYPE_ERROR_FLOAT, out,
"isinf/1");
287 return isinf(FloatOfTerm(out));
298static Int p_logsum(USES_REGS1) {
299 Term t1 = Deref(ARG1);
300 Term t2 = Deref(ARG2);
305 if (IsFloatTerm(t1)) {
306 f1 = FloatOfTerm(t1);
308 }
else if (IsIntegerTerm(t1)) {
309 f1 = IntegerOfTerm(t1);
311 }
else if (IsBigIntTerm(t1)) {
312 f1 = Yap_gmp_to_float(t1);
315 while (!(t1 = Eval(t1 PASS_REGS))) {
316 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
317 LOCAL_Error_TYPE = YAP_NO_ERROR;
319 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
323 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
331 if (IsFloatTerm(t2)) {
332 f2 = FloatOfTerm(t2);
334 }
else if (IsIntegerTerm(t2)) {
335 f2 = IntegerOfTerm(t2);
337 }
else if (IsBigIntTerm(t2)) {
338 f2 = Yap_gmp_to_float(t2);
341 while (!(t2 = Eval(t2 PASS_REGS))) {
342 if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
343 LOCAL_Error_TYPE = YAP_NO_ERROR;
345 Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
349 Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
356 Float fi = exp(f2 - f1);
357 return Yap_unify(ARG3, MkFloatTerm(f1 + log(1 + fi)));
359 Float fi = exp(f1 - f2);
360 return Yap_unify(ARG3, MkFloatTerm(f2 + log(1 + fi)));
364void Yap_EvalError__(
const char *file,
const char *
function,
int lineno,
365 yap_error_number type, Term where, ...) {
369 if (!LOCAL_ErrorMessage)
370 LOCAL_ErrorMessage = malloc(4096);
371 buf = LOCAL_ErrorMessage;
374 format = va_arg(ap,
char *);
375 if (format != NULL) {
377 (void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap);
379 (void)vsprintf(buf, format, ap);
401static Int cont_between(USES_REGS1) {
402 Term t1 = EXTRA_CBACK_ARG(3, 1);
403 Term t2 = EXTRA_CBACK_ARG(3, 2);
406 if (IsIntegerTerm(t1)) {
412 i1 = IntegerOfTerm(t1);
413 tn = add_int(i1, 1 PASS_REGS);
414 EXTRA_CBACK_ARG(3, 1) = tn;
422 cmp = Yap_acmp(t1, t2 PASS_REGS);
427 tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
428 EXTRA_CBACK_ARG(3, 1) = tn;
435static Int init_between(USES_REGS1) {
436 Term t1 = Deref(ARG1);
437 Term t2 = Deref(ARG2);
440 Yap_EvalError(INSTANTIATION_ERROR, t1,
"between/3");
444 Yap_EvalError(INSTANTIATION_ERROR, t1,
"between/3");
447 if (!IsIntegerTerm(t1) && !IsBigIntTerm(t1)) {
448 Yap_EvalError(TYPE_ERROR_INTEGER, t1,
"between/3");
451 if (!IsIntegerTerm(t2) && !IsBigIntTerm(t2) && t2 != MkAtomTerm(AtomInf) &&
452 t2 != MkAtomTerm(AtomInfinity)) {
453 Yap_EvalError(TYPE_ERROR_INTEGER, t2,
"between/3");
456 if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
457 Int i1 = IntegerOfTerm(t1);
458 Int i2 = IntegerOfTerm(t2);
462 if (!IsVarTerm(t3)) {
463 if (!IsIntegerTerm(t3)) {
464 if (!IsBigIntTerm(t3)) {
465 Yap_EvalError(TYPE_ERROR_INTEGER, t3,
"between/3");
470 Int i3 = IntegerOfTerm(t3);
471 if (i3 >= i1 && i3 <= i2)
482 }
else if (IsIntegerTerm(t1) && IsAtomTerm(t2)) {
483 Int i1 = IntegerOfTerm(t1);
487 if (!IsVarTerm(t3)) {
488 if (!IsIntegerTerm(t3)) {
489 if (!IsBigIntTerm(t3)) {
490 Yap_EvalError(TYPE_ERROR_INTEGER, t3,
"between/3");
495 Int i3 = IntegerOfTerm(t3);
502 Term t3 = Deref(ARG3);
505 if (!IsVarTerm(t3)) {
506 if (!IsIntegerTerm(t3) && !IsBigIntTerm(t3)) {
507 Yap_EvalError(TYPE_ERROR_INTEGER, t3,
"between/3");
510 if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2, t3 PASS_REGS) >= 0 &&
515 cmp = Yap_acmp(t1, t2 PASS_REGS);
523 EXTRA_CBACK_ARG(3, 1) = t1;
524 EXTRA_CBACK_ARG(3, 2) = t2;
525 return cont_between(PASS_REGS1);
528void Yap_InitEval(
void) {
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);
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.