YAP 7.1.0
YapEval.h
Go to the documentation of this file.
1/*************************************************************************
2* *
3* YAP Prolog @(#)YapEval.h 1.2
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: YapEval.h *
12* Last rev: *
13* mods: *
14* comments: arithmetical functions info *
15* *
16*************************************************************************/
17
108#ifndef EVAL_H
109#define EVAL_H 1
110
111#include <stdlib.h>
112
113/* C library used to implement floating point functions */
114#if HAVE_MATH_H
115#include <math.h>
116#endif
117#ifdef HAVE_FLOAT_H
118#include <float.h>
119#endif
120#ifdef HAVE_IEEEFP_H
121#include <ieeefp.h>
122#endif
123#ifdef HAVE_LIMITS_H
124#include <limits.h>
125#endif
126#ifdef HAVE_FENV_H
127#include <fenv.h>
128#endif
129#ifdef HAVE_STRINGS_H
130#include <strings.h>
131#endif
132#ifdef HAVE_STRING_H
133#include <string.h>
134#endif
135
136#ifdef LONG_MAX
137#define Int_MAX LONG_MAX
138#else
139#define Int_MAX ((Int)((~((CELL)0)) >> 1))
140#endif
141#ifdef LONG_MIN
142#define Int_MIN LONG_MIN
143#else
144#define Int_MIN (-Int_MAX - (CELL)1)
145#endif
146
147#define PLMAXTAGGEDINT (MAX_ABS_INT - ((CELL)1))
148#define PLMINTAGGEDINT (-MAX_ABS_INT)
149
150#define PLMAXINT Int_MAX
151#define PLMININT Int_MIN
152
153#ifndef INFINITY
154#define INFINITY (1.0 / 0.0)
155#endif
156
157#ifndef NAN
158#define NAN (0.0 / 0.0)
159#endif
160
166typedef enum {
200 op_nan,
201 op_random,
202 op_cputime,
203 op_heapused,
204 op_localsp,
205 op_globalsp,
206 op_b,
207 op_env,
208 op_tr,
209 op_stackfree
210} arith0_op;
211
217typedef enum {
279 op_sqrt,
280 op_sin,
281 op_cos,
282 op_tan,
283 op_sinh,
284 op_cosh,
285 op_tanh,
286 op_asin,
287 op_acos,
288 op_atan,
289 op_asinh,
290 op_acosh,
291 op_atanh,
292 op_floor,
293 op_ceiling,
294 op_round,
295 op_truncate,
296 op_integer,
297 op_float,
298 op_abs,
299 op_lsb,
300 op_msb,
301 op_popcount,
302 op_ffracp,
303 op_fintp,
304 op_sign,
305 op_lgamma,
306 op_erf,
307 op_erfc,
308 op_rational,
309 op_rationalize,
310 op_random1
311} arith1_op;
312
319typedef enum {
320 op_plus, //> *_X_+ _Y_ [ISO]*,
321 //> Addition, implemented between any two types of numbers
322 op_minus, //> *_X_- _Y_ [ISO]*,
323 //> Subtraction, implemented between any two types of numbers
324 op_times, //> *_X_\* _Y_ [ISO]*,
325 //> Product.
326 op_fdiv, //> *_X_/ _Y_ [ISO]*,
327 //> Floating Point Division.
328 op_mod, //> *_X_ mod _Y_ [ISO]* @anchor mod_2,
329//> Integer Modulus, always positive
330 op_rem, //> *_X_ rem _Y_ [ISO]* @anchor rem_2,
331//> Integer Remainder, always with the same size as the first argument, _X_.
332 op_div, //>*_X_// _Y_ [ISO]*,
333//> Integer division.
334 op_idiv, //* _X_ div _Y_ [ISO]* @anchor div_2,
335 //> Integer division, as if defined by `( _X_ - _X_ mod _Y_)// _Y_`.
336
337 op_sll, //>
338 op_slr, //>
339 op_and, //>
340 op_or, //>
341 op_xor, //>
342 op_atan2, //>
343 /* C-Prolog exponentiation */
344 op_power, //>
345 /* ISO-Prolog exponentiation */
346 /* op_power, //> */
347 op_power2, //>
348 /* Quintus exponentiation */
349 /* op_power, //> */
350 op_gcd, //>
351 op_min, //>
352 op_max, //>
353 op_rdiv //>
354} arith2_op;
355
357
358extern yap_error_number Yap_MathException__(USES_REGS1);
359extern Functor EvalArg(Term);
360
361/* Needed to handle numbers:
362 these two macros are fundamental in the integer/float conversions */
363
364#ifdef C_PROLOG
365#define FlIsInt(X) ((X) == (Int)(X) && IntInBnd((X)))
366#else
367#define FlIsInt(X) (FALSE)
368#endif
369
370#ifdef M_WILLIAMS
371#define MkEvalFl(X) MkFloatTerm(X)
372#else
373#define MkEvalFl(X) (FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X))
374#endif
375
376/* Macros used by some of the eval functions */
377#define REvalInt(I) \
378 { \
379 eval_int = (I); \
380 return (FInt); \
381 }
382#define REvalFl(F) \
383 { \
384 eval_flt = (F); \
385 return (FFloat); \
386 }
387
388#define REvalError() \
389 { return (FError); }
390
391/* this macro, dependent on the particular implementation
392 is used to interface the arguments into the C libraries */
393#ifdef MPW
394#define FL(X) ((extended)(X))
395#else
396#define FL(X) ((double)(X))
397#endif
398
399extern void Yap_InitConstExps(void);
400extern void Yap_InitUnaryExps(void);
401extern void Yap_InitBinaryExps(void);
402
403extern int Yap_ReInitConstExps(void);
404extern int Yap_ReInitUnaryExps(void);
405extern int Yap_ReInitBinaryExps(void);
406
407extern Term Yap_eval_atom(Int);
408extern Term Yap_eval_unary(Int, Term);
409extern Term Yap_eval_binary(Int, Term, Term);
410
411extern Term Yap_InnerEval__(Term USES_REGS);
412
413#define Yap_EvalError(id, t, ...) \
414 Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
415void Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
416 ...);
417
418#define Yap_ArithError(id, t, ...) \
419 Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
420#define Yap_BinError(id) \
421 Yap_ThrowError__(true,__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
422#define Yap_AbsmiError(id) \
423 Yap_ThrowError__(true,__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
424
425
426#include "inline-only.h"
427
428#define Yap_MathException() Yap_MathException__(PASS_REGS1)
429
430#define Yap_InnerEval(x) Yap_InnerEval__(x PASS_REGS)
431#define Yap_Eval(x) Yap_Eval__(x PASS_REGS)
432#define Yap_FoundArithError() Yap_FoundArithError__(PASS_REGS1)
433
434INLINE_ONLY Term Yap_Eval__(Term t USES_REGS);
435
436INLINE_ONLY Term Yap_Eval__(Term t USES_REGS) {
437 if (t == 0L || (!IsVarTerm(t) && IsNumTerm(t)))
438 return t;
439 return Yap_InnerEval(t);
440}
441
442#if HAVE_FECLEAREXCEPT
443inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
444#else
445inline static void Yap_ClearExs(void) {}
446#endif
447
448inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
449 if (LOCAL_Error_TYPE != YAP_NO_ERROR)
450 return LOCAL_Error_TYPE;
451 if (trueGlobalPrologFlag(
452 ARITHMETIC_EXCEPTIONS_FLAG)) // test support for exception
453 return Yap_MathException();
454 return YAP_NO_ERROR;
455}
456
457static inline Term takeIndicator(Term t) {
458 Term ts[2];
459 if (IsAtomTerm(t)) {
460 ts[0] = t;
461 ts[1] = MkIntTerm(0);
462 } else if (IsPairTerm(t)) {
463 ts[0] = TermNil;
464 ts[1] = MkIntTerm(2);
465 } else {
466 CACHE_REGS
467 ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
468 ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
469 }
470 return Yap_MkApplTerm(FunctorSlash, 2, ts);
471}
472
473extern Atom Yap_NameOfUnaryOp(int i);
474extern Atom Yap_NameOfBinaryOp(int i);
475
476#define RINT(v) return (MkIntegerTerm(v))
477#define RFLOAT(v) return (MkFloatTerm(v))
478#define RBIG(v) return (Yap_MkBigIntTerm(v))
479#define RERROR() \
480 { \
481 return (0L); \
482 }
483
484static inline blob_type ETypeOfTerm(Term t) {
485 if (IsIntTerm(t))
486 return long_int_e;
487 if (IsApplTerm(t)) {
488 Functor f = FunctorOfTerm(t);
489 if (f == FunctorDouble)
490 return double_e;
491 if (f == FunctorLongInt)
492 return long_int_e;
493 if (f == FunctorBigInt) {
494 return big_int_e;
495 }
496 }
497 return db_ref_e;
498}
499
500extern char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
501
502extern Term Yap_gmq_rdiv_int_int(Int, Int);
503extern Term Yap_gmq_rdiv_int_big(Int, Term);
504extern Term Yap_gmq_rdiv_big_int(Term, Int);
505extern Term Yap_gmq_rdiv_big_big(Term, Term);
506
507extern Term Yap_gmp_add_ints(Int, Int);
508extern Term Yap_gmp_sub_ints(Int, Int);
509extern Term Yap_gmp_mul_ints(Int, Int);
510extern Term Yap_gmp_sll_ints(Int, Int);
511extern Term Yap_gmp_add_int_big(Int, Term);
512extern Term Yap_gmp_sub_int_big(Int, Term);
513extern Term Yap_gmp_sub_big_int(Term, Int);
514extern Term Yap_gmp_mul_int_big(Int, Term);
515extern Term Yap_gmp_div_int_big(Int, Term);
516extern Term Yap_gmp_div_big_int(Term, Int);
517extern Term Yap_gmp_div2_big_int(Term, Int);
518extern Term Yap_gmp_fdiv_int_big(Int, Term);
519extern Term Yap_gmp_fdiv_big_int(Term, Int);
520extern Term Yap_gmp_and_int_big(Int, Term);
521extern Term Yap_gmp_ior_int_big(Int, Term);
522extern Term Yap_gmp_xor_int_big(Int, Term);
523extern Term Yap_gmp_sll_big_int(Term, Int);
524extern Term Yap_gmp_add_big_big(Term, Term);
525extern Term Yap_gmp_sub_big_big(Term, Term);
526extern Term Yap_gmp_mul_big_big(Term, Term);
527extern Term Yap_gmp_div_big_big(Term, Term);
528extern Term Yap_gmp_div2_big_big(Term, Term);
529extern Term Yap_gmp_fdiv_big_big(Term, Term);
530extern Term Yap_gmp_and_big_big(Term, Term);
531extern Term Yap_gmp_ior_big_big(Term, Term);
532extern Term Yap_gmp_xor_big_big(Term, Term);
533extern Term Yap_gmp_mod_big_big(Term, Term);
534extern Term Yap_gmp_mod_big_int(Term, Int);
535extern Term Yap_gmp_mod_int_big(Int, Term);
536extern Term Yap_gmp_rem_big_big(Term, Term);
537extern Term Yap_gmp_rem_big_int(Term, Int);
538extern Term Yap_gmp_rem_int_big(Int, Term);
539extern Term Yap_gmp_exp_int_int(Int, Int);
540extern Term Yap_gmp_exp_int_big(Int, Term);
541extern Term Yap_gmp_exp_big_int(Term, Int);
542extern Term Yap_gmp_exp_big_big(Term, Term);
543extern Term Yap_gmp_gcd_int_big(Int, Term);
544extern Term Yap_gmp_gcd_big_big(Term, Term);
545
546extern Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
547
548extern Term Yap_gmp_float_to_big(Float);
549extern Term Yap_gmp_float_to_rational(Float);
550extern Term Yap_gmp_float_rationalize(Float);
551extern Float Yap_gmp_to_float(Term);
552extern Term Yap_gmp_add_float_big(Float, Term);
553extern Term Yap_gmp_sub_float_big(Float, Term);
554extern Term Yap_gmp_sub_big_float(Term, Float);
555extern Term Yap_gmp_mul_float_big(Float, Term);
556extern Term Yap_gmp_fdiv_float_big(Float, Term);
557extern Term Yap_gmp_fdiv_big_float(Term, Float);
558
559extern int Yap_gmp_cmp_big_int(Term, Int);
560extern int Yap_gmp_cmp_int_big(Int, Term);
561extern int Yap_gmp_cmp_big_float(Term, Float);
562#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
563extern int Yap_gmp_cmp_big_big(Term, Term);
564
565extern int Yap_gmp_tcmp_big_int(Term, Int);
566extern int Yap_gmp_tcmp_int_big(Int, Term);
567extern int Yap_gmp_tcmp_big_float(Term, Float);
568#define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
569extern int Yap_gmp_tcmp_big_big(Term, Term);
570
571extern Term Yap_gmp_neg_int(Int);
572extern Term Yap_gmp_abs_big(Term);
573extern Term Yap_gmp_neg_big(Term);
574extern Term Yap_gmp_unot_big(Term);
575extern Term Yap_gmp_floor(Term);
576extern Term Yap_gmp_ceiling(Term);
577extern Term Yap_gmp_round(Term);
578extern Term Yap_gmp_trunc(Term);
579extern Term Yap_gmp_float_fractional_part(Term);
580extern Term Yap_gmp_float_integer_part(Term);
581extern Term Yap_gmp_sign(Term);
582extern Term Yap_gmp_lsb(Term);
583extern Term Yap_gmp_msb(Term);
584extern Term Yap_gmp_popcount(Term);
585
586extern char *Yap_gmp_to_string(Term, char *, size_t, int);
587extern size_t Yap_gmp_to_size(Term, int);
588
589extern int Yap_term_to_existing_big(Term, MP_INT *);
590extern int Yap_term_to_existing_rat(Term, MP_RAT *);
591
592extern void Yap_gmp_set_bit(Int i, Term t);
593
594#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i)PASS_REGS)
595
596INLINE_ONLY Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
597
598INLINE_ONLY Term
599__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
600 if (i <= Int_MAX && i >= Int_MIN) {
601 return MkIntegerTerm((Int)i);
602 } else {
603 return Yap_gmp_big_from_64bits(i);
604 }
605}
606
607#if __clang__ && FALSE /* not in OSX yet */
608#define DO_ADD() \
609 if (__builtin_sadd_overflow(i1, i2, &z)) { \
610 goto overflow; \
611 }
612#endif
613
614inline static Term add_int(Int i, Int j USES_REGS) {
615 UInt w = (UInt)i + (UInt)j;
616 if (i > 0) {
617 if (j > 0 && (Int)w < 0)
618 goto overflow;
619 } else {
620 if (j < 0 && (Int)w > 0)
621 goto overflow;
622 }
623 RINT((Int)w);
624/* Integer overflow, we need to use big integers */
625overflow:
626 return Yap_gmp_add_ints(i, j);
627}
628
629/* calculate the most significant bit for an integer */
630Int Yap_msb(Int inp USES_REGS);
631
632static inline Term p_plus(Term t1, Term t2 USES_REGS) {
633 switch (ETypeOfTerm(t1)) {
634 case long_int_e:
635 switch (ETypeOfTerm(t2)) {
636 case long_int_e:
637 /* two integers */
638 return add_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
639 case double_e: {
640 /* integer, double */
641 Float fl1 = (Float)IntegerOfTerm(t1);
642 Float fl2 = FloatOfTerm(t2);
643 RFLOAT(fl1 + fl2);
644 }
645 case big_int_e:
646 return (Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
647 default:
648 RERROR();
649 }
650 case double_e:
651 switch (ETypeOfTerm(t2)) {
652 case long_int_e:
653 /* float * integer */
654 RFLOAT(FloatOfTerm(t1) + IntegerOfTerm(t2));
655 case double_e:
656 RFLOAT(FloatOfTerm(t1) + FloatOfTerm(t2));
657 case big_int_e:
658 return Yap_gmp_add_float_big(FloatOfTerm(t1), t2);
659 default:
660 RERROR();
661 }
662 case big_int_e:
663 switch (ETypeOfTerm(t2)) {
664 case long_int_e:
665 return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
666 case big_int_e:
667 /* two bignums */
668 return Yap_gmp_add_big_big(t1, t2);
669 case double_e:
670 return Yap_gmp_add_float_big(FloatOfTerm(t2), t1);
671 default:
672 RERROR();
673 }
674 default:
675 RERROR();
676 }
677 RERROR();
678}
679
680#ifndef PI
681#ifdef M_PI
682#define PI M_PI
683#else
684#define PI 3.14159265358979323846
685#endif
686#endif
687
688#ifndef M_E
689#define M_E 2.7182818284590452354
690#endif
691
692#ifndef INFINITY
693#define INFINITY (1.0 / 0.0)
694#endif
695
696#ifndef NAN
697#define NAN (0.0 / 0.0)
698#endif
699
700/* copied from SWI-Prolog */
701#ifndef DBL_EPSILON /* normal for IEEE 64-bit double */
702#define DBL_EPSILON 0.00000000000000022204
703#endif
704
705#endif
arith1_op
unary operators
Definition: YapEval.h:217
@ op_log
log( X ), natural logarithm of X
Definition: YapEval.h:257
@ op_log10
log10( X ) [ISO]
Definition: YapEval.h:278
@ op_exp
exp( X ), natural exponentiation of X
Definition: YapEval.h:249
@ op_unot
\ X, The bitwise negation of X
Definition: YapEval.h:241
@ op_uminus
- X: the complement of X
Definition: YapEval.h:231
@ op_uplus
+ X: the value of X
Definition: YapEval.h:224
arith0_op
constant operators
Definition: YapEval.h:166
@ op_pi
pi [ISO]
Definition: YapEval.h:173
@ op_epsilon
epsilon
Definition: YapEval.h:187
@ op_e
e
Definition: YapEval.h:180
@ op_inf
inf
Definition: YapEval.h:199
arith2_op
binary operators
Definition: YapEval.h:319