This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/H/eval.h
2014-01-24 19:59:42 +00:00

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();
}