429 lines
9.6 KiB
C
429 lines
9.6 KiB
C
/*************************************************************************
|
|
* *
|
|
* YAP Prolog @(#)eval.h 1.2
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: eval.h *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: arithmetical functions info *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
#include <stdlib.h>
|
|
|
|
/* C library used to implement floating point functions */
|
|
#if HAVE_MATH_H
|
|
#include <math.h>
|
|
#endif
|
|
#ifdef HAVE_FLOAT_H
|
|
#include <float.h>
|
|
#endif
|
|
#ifdef HAVE_IEEEFP_H
|
|
#include <ieeefp.h>
|
|
#endif
|
|
#ifdef HAVE_LIMITS_H
|
|
#include <limits.h>
|
|
#endif
|
|
|
|
#ifdef LONG_MAX
|
|
#define Int_MAX LONG_MAX
|
|
#else
|
|
#define Int_MAX ((Int)((~((CELL)0))>>1))
|
|
#endif
|
|
#ifdef LONG_MIN
|
|
#define Int_MIN LONG_MIN
|
|
#else
|
|
#define Int_MIN (-Int_MAX-(CELL)1)
|
|
#endif
|
|
|
|
#define PLMAXTAGGEDINT (MAX_ABS_INT-((CELL)1))
|
|
#define PLMINTAGGEDINT (-MAX_ABS_INT)
|
|
|
|
#define PLMAXINT Int_MAX
|
|
#define PLMININT Int_MIN
|
|
|
|
typedef enum {
|
|
op_pi,
|
|
op_e,
|
|
op_epsilon,
|
|
op_inf,
|
|
op_nan,
|
|
op_random,
|
|
op_cputime,
|
|
op_heapused,
|
|
op_localsp,
|
|
op_globalsp,
|
|
op_b,
|
|
op_env,
|
|
op_tr,
|
|
op_stackfree
|
|
} arith0_op;
|
|
|
|
typedef enum {
|
|
op_uplus,
|
|
op_uminus,
|
|
op_unot,
|
|
op_exp,
|
|
op_log,
|
|
op_log10,
|
|
op_sqrt,
|
|
op_sin,
|
|
op_cos,
|
|
op_tan,
|
|
op_sinh,
|
|
op_cosh,
|
|
op_tanh,
|
|
op_asin,
|
|
op_acos,
|
|
op_atan,
|
|
op_asinh,
|
|
op_acosh,
|
|
op_atanh,
|
|
op_floor,
|
|
op_ceiling,
|
|
op_round,
|
|
op_truncate,
|
|
op_integer,
|
|
op_float,
|
|
op_abs,
|
|
op_lsb,
|
|
op_msb,
|
|
op_popcount,
|
|
op_ffracp,
|
|
op_fintp,
|
|
op_sign,
|
|
op_lgamma,
|
|
op_erf,
|
|
op_erfc,
|
|
op_rational,
|
|
op_rationalize,
|
|
op_random1
|
|
} arith1_op;
|
|
|
|
typedef enum {
|
|
op_plus,
|
|
op_minus,
|
|
op_times,
|
|
op_fdiv,
|
|
op_mod,
|
|
op_rem,
|
|
op_div,
|
|
op_idiv,
|
|
op_sll,
|
|
op_slr,
|
|
op_and,
|
|
op_or,
|
|
op_xor,
|
|
op_atan2,
|
|
/* C-Prolog exponentiation */
|
|
op_power,
|
|
/* ISO-Prolog exponentiation */
|
|
/* op_power, */
|
|
op_power2,
|
|
/* Quintus exponentiation */
|
|
/* op_power, */
|
|
op_gcd,
|
|
op_min,
|
|
op_max,
|
|
op_rdiv
|
|
} arith2_op;
|
|
|
|
Functor EvalArg(Term);
|
|
|
|
/* Needed to handle numbers:
|
|
these two macros are fundamental in the integer/float conversions */
|
|
|
|
#ifdef C_PROLOG
|
|
#define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
|
|
#else
|
|
#define FlIsInt(X) ( FALSE )
|
|
#endif
|
|
|
|
|
|
|
|
#ifdef M_WILLIAMS
|
|
#define MkEvalFl(X) MkFloatTerm(X)
|
|
#else
|
|
#define MkEvalFl(X) ( FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X) )
|
|
#endif
|
|
|
|
|
|
/* Macros used by some of the eval functions */
|
|
#define REvalInt(I) { eval_int = (I); return(FInt); }
|
|
#define REvalFl(F) { eval_flt = (F); return(FFloat); }
|
|
#define REvalError() { return(FError); }
|
|
|
|
/* this macro, dependent on the particular implementation
|
|
is used to interface the arguments into the C libraries */
|
|
#ifdef MPW
|
|
#define FL(X) ((extended)(X))
|
|
#else
|
|
#define FL(X) ((double)(X))
|
|
#endif
|
|
|
|
void Yap_InitConstExps(void);
|
|
void Yap_InitUnaryExps(void);
|
|
void Yap_InitBinaryExps(void);
|
|
|
|
int Yap_ReInitConstExps(void);
|
|
int Yap_ReInitUnaryExps(void);
|
|
int Yap_ReInitBinaryExps(void);
|
|
|
|
Term Yap_eval_atom(Int);
|
|
Term Yap_eval_unary(Int,Term);
|
|
Term Yap_eval_binary(Int,Term,Term);
|
|
|
|
Term Yap_InnerEval(Term);
|
|
Int Yap_ArithError(yap_error_number,Term,char *msg, ...);
|
|
|
|
#include "inline-only.h"
|
|
INLINE_ONLY inline EXTERN Term
|
|
Yap_Eval(Term t);
|
|
|
|
INLINE_ONLY inline EXTERN Term
|
|
Yap_Eval(Term t)
|
|
{
|
|
if (t == 0L || ( !IsVarTerm(t) && IsNumTerm(t) ))
|
|
return t;
|
|
return Yap_InnerEval(t);
|
|
}
|
|
|
|
#ifdef P
|
|
inline static Term
|
|
Yap_FoundArithError(Term t, Term inp)
|
|
{
|
|
CACHE_REGS
|
|
if (LOCAL_Error_TYPE) {
|
|
Yap_Error(LOCAL_Error_TYPE, (inp ? inp : LOCAL_Error_Term), LOCAL_ErrorMessage);
|
|
P = FAILCODE;
|
|
return 0L;
|
|
}
|
|
return t;
|
|
}
|
|
#endif
|
|
|
|
|
|
#define RINT(v) return(MkIntegerTerm(v))
|
|
#define RFLOAT(v) return(MkFloatTerm(v))
|
|
#define RBIG(v) return(Yap_MkBigIntTerm(v))
|
|
#define RERROR() return(0L)
|
|
|
|
static inline blob_type
|
|
ETypeOfTerm(Term t)
|
|
{
|
|
if (IsIntTerm(t))
|
|
return long_int_e;
|
|
if (IsApplTerm(t)) {
|
|
Functor f = FunctorOfTerm(t);
|
|
if (f == FunctorDouble)
|
|
return double_e;
|
|
if (f == FunctorLongInt)
|
|
return long_int_e;
|
|
if (f == FunctorBigInt) {
|
|
return big_int_e;
|
|
}
|
|
}
|
|
return db_ref_e;
|
|
}
|
|
|
|
#if USE_GMP
|
|
char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
|
|
|
|
Term Yap_gmq_rdiv_int_int(Int, Int);
|
|
Term Yap_gmq_rdiv_int_big(Int, Term);
|
|
Term Yap_gmq_rdiv_big_int(Term, Int);
|
|
Term Yap_gmq_rdiv_big_big(Term, Term);
|
|
|
|
Term Yap_gmp_add_ints(Int, Int);
|
|
Term Yap_gmp_sub_ints(Int, Int);
|
|
Term Yap_gmp_mul_ints(Int, Int);
|
|
Term Yap_gmp_sll_ints(Int, Int);
|
|
Term Yap_gmp_add_int_big(Int, Term);
|
|
Term Yap_gmp_sub_int_big(Int, Term);
|
|
Term Yap_gmp_sub_big_int(Term, Int);
|
|
Term Yap_gmp_mul_int_big(Int, Term);
|
|
Term Yap_gmp_div_int_big(Int, Term);
|
|
Term Yap_gmp_div_big_int(Term, Int);
|
|
Term Yap_gmp_div2_big_int(Term, Int);
|
|
Term Yap_gmp_fdiv_int_big(Int, Term);
|
|
Term Yap_gmp_fdiv_big_int(Term, Int);
|
|
Term Yap_gmp_and_int_big(Int, Term);
|
|
Term Yap_gmp_ior_int_big(Int, Term);
|
|
Term Yap_gmp_xor_int_big(Int, Term);
|
|
Term Yap_gmp_sll_big_int(Term, Int);
|
|
Term Yap_gmp_add_big_big(Term, Term);
|
|
Term Yap_gmp_sub_big_big(Term, Term);
|
|
Term Yap_gmp_mul_big_big(Term, Term);
|
|
Term Yap_gmp_div_big_big(Term, Term);
|
|
Term Yap_gmp_div2_big_big(Term, Term);
|
|
Term Yap_gmp_fdiv_big_big(Term, Term);
|
|
Term Yap_gmp_and_big_big(Term, Term);
|
|
Term Yap_gmp_ior_big_big(Term, Term);
|
|
Term Yap_gmp_xor_big_big(Term, Term);
|
|
Term Yap_gmp_mod_big_big(Term, Term);
|
|
Term Yap_gmp_mod_big_int(Term, Int);
|
|
Term Yap_gmp_mod_int_big(Int, Term);
|
|
Term Yap_gmp_rem_big_big(Term, Term);
|
|
Term Yap_gmp_rem_big_int(Term, Int);
|
|
Term Yap_gmp_rem_int_big(Int, Term);
|
|
Term Yap_gmp_exp_int_int(Int,Int);
|
|
Term Yap_gmp_exp_int_big(Int,Term);
|
|
Term Yap_gmp_exp_big_int(Term,Int);
|
|
Term Yap_gmp_exp_big_big(Term,Term);
|
|
Term Yap_gmp_gcd_int_big(Int,Term);
|
|
Term Yap_gmp_gcd_big_big(Term,Term);
|
|
|
|
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
|
|
|
|
Term Yap_gmp_float_to_big(Float);
|
|
Term Yap_gmp_float_to_rational(Float);
|
|
Term Yap_gmp_float_rationalize(Float);
|
|
Float Yap_gmp_to_float(Term);
|
|
Term Yap_gmp_add_float_big(Float, Term);
|
|
Term Yap_gmp_sub_float_big(Float, Term);
|
|
Term Yap_gmp_sub_big_float(Term, Float);
|
|
Term Yap_gmp_mul_float_big(Float, Term);
|
|
Term Yap_gmp_fdiv_float_big(Float, Term);
|
|
Term Yap_gmp_fdiv_big_float(Term, Float);
|
|
|
|
int Yap_gmp_cmp_big_int(Term, Int);
|
|
#define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I))
|
|
int Yap_gmp_cmp_big_float(Term, Float);
|
|
#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
|
|
int Yap_gmp_cmp_big_big(Term, Term);
|
|
|
|
int Yap_gmp_tcmp_big_int(Term, Int);
|
|
#define Yap_gmp_tcmp_int_big(I, T) (-Yap_gmp_tcmp_big_int(T, I))
|
|
int Yap_gmp_tcmp_big_float(Term, Float);
|
|
#define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
|
|
int Yap_gmp_tcmp_big_big(Term, Term);
|
|
|
|
Term Yap_gmp_neg_int(Int);
|
|
Term Yap_gmp_abs_big(Term);
|
|
Term Yap_gmp_neg_big(Term);
|
|
Term Yap_gmp_unot_big(Term);
|
|
Term Yap_gmp_floor(Term);
|
|
Term Yap_gmp_ceiling(Term);
|
|
Term Yap_gmp_round(Term);
|
|
Term Yap_gmp_trunc(Term);
|
|
Term Yap_gmp_float_fractional_part(Term);
|
|
Term Yap_gmp_float_integer_part(Term);
|
|
Term Yap_gmp_sign(Term);
|
|
Term Yap_gmp_lsb(Term);
|
|
Term Yap_gmp_msb(Term);
|
|
Term Yap_gmp_popcount(Term);
|
|
|
|
char * Yap_gmp_to_string(Term, char *, size_t, int);
|
|
size_t Yap_gmp_to_size(Term, int);
|
|
|
|
int Yap_term_to_existing_big(Term, MP_INT *);
|
|
int Yap_term_to_existing_rat(Term, MP_RAT *);
|
|
|
|
void Yap_gmp_set_bit(Int i, Term t);
|
|
#endif
|
|
|
|
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i) PASS_REGS)
|
|
|
|
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
|
|
|
|
INLINE_ONLY inline EXTERN Term
|
|
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
|
|
{
|
|
if (i <= Int_MAX && i >= Int_MIN) {
|
|
return MkIntegerTerm((Int)i);
|
|
} else {
|
|
#if USE_GMP
|
|
return Yap_gmp_big_from_64bits(i);
|
|
#else
|
|
return MkIntTerm(-1);
|
|
#endif
|
|
}
|
|
}
|
|
|
|
|
|
#if __clang__ && FALSE /* not in OSX yet */
|
|
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }
|
|
#endif
|
|
|
|
inline static Term
|
|
add_int(Int i, Int j USES_REGS)
|
|
{
|
|
#if USE_GMP
|
|
UInt w = (UInt)i+(UInt)j;
|
|
if (i > 0) {
|
|
if (j > 0 && (Int)w < 0) goto overflow;
|
|
} else {
|
|
if (j < 0 && (Int)w > 0) goto overflow;
|
|
}
|
|
RINT( (Int)w);
|
|
/* Integer overflow, we need to use big integers */
|
|
overflow:
|
|
return Yap_gmp_add_ints(i, j);
|
|
#else
|
|
RINT(i+j);
|
|
#endif
|
|
}
|
|
|
|
static inline Term
|
|
p_plus(Term t1, Term t2 USES_REGS) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* two integers */
|
|
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
|
|
case double_e:
|
|
{
|
|
/* integer, double */
|
|
Float fl1 = (Float)IntegerOfTerm(t1);
|
|
Float fl2 = FloatOfTerm(t2);
|
|
RFLOAT(fl1+fl2);
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
|
|
#endif
|
|
default:
|
|
RERROR();
|
|
}
|
|
case double_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* float * integer */
|
|
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
|
|
case double_e:
|
|
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
|
|
#endif
|
|
default:
|
|
RERROR();
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
|
|
case big_int_e:
|
|
/* two bignums */
|
|
return Yap_gmp_add_big_big(t1, t2);
|
|
case double_e:
|
|
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
|
|
default:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
default:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|