/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: arith2.c * * Last rev: * * mods: * * comments: arithmetical expression evaluation * * * *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif /** @file arith2.c @addtogroup arithmetic_operators These are the binary numeric operators currently supported by YAP. - _X_+ _Y_ [ISO]
Sum. - _X_- _Y_ [ISO]
Difference. - _X_\* _Y_ [ISO]
Product. - _X_/ _Y_ [ISO]
Quotient. - _X_// _Y_ [ISO]
Integer quotient. - _X_ mod _Y_ [ISO]
@anchor mod_2 Integer module operator, always positive. - _X_ rem _Y_ [ISO]
@anchor rem_2 Integer remainder, similar to `mod` but always has the same sign as `X`. - _X_ div _Y_ [ISO]
@anchor div_2 Integer division, as if defined by `( _X_ - _X_ mod _Y_)// _Y_`. - max( _X_, _Y_) [ISO]
@anchor max_2 The greater value of _X_ and _Y_. - min( _X_, _Y_) [ISO]
@anchor min_2 The lesser value of _X_ and _Y_. - _X_ ^ _Y_ [ISO]
_X_ raised to the power of _Y_, (from the C-Prolog syntax). - exp( _X_, _Y_)
@anchor exp_2 _X_ raised to the power of _Y_, (from the Quintus Prolog syntax). - _X_ \*\* _Y_ [ISO]
_X_ raised to the power of _Y_ (from ISO). - _X_ /\\ _Y_ [ISO]
Integer bitwise conjunction. - _X_ \\/ _Y_ [ISO]
Integer bitwise disjunction. - _X_ # _Y_
Integer bitwise exclusive disjunction. - _X_ \>\< _Y_
Integer bitwise exclusive disjunction. - xor( _X_ , _Y_) [ISO]
@anchor xor_2 Integer bitwise exclusive disjunction. - _X_ \<\< _Y_
Integer bitwise left logical shift of _X_ by _Y_ places. - _X_ \>\> _Y_ [ISO]
Integer bitwise right logical shift of _X_ by _Y_ places. - gcd( _X_, _Y_)
@anchor gcd_2 The greatest common divisor of the two integers _X_ and _Y_. - atan( _X_, _Y_)
@anchor atan_2 Four-quadrant arc tangent. Also available as `atan2/2`. - atan2( _X_, _Y_) [ISO]
@anchor atan2_2 Four-quadrant arc tangent. - _X_ rdiv _Y_ [ISO]
@anchor rdiv_2
Rational division.
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "eval.h"
#include "arith2.h"
typedef struct init_un_eval {
char *OpName;
arith2_op f;
} InitBinEntry;
static Term
p_mod(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
RINT(mod);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
break;
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0");
return Yap_gmp_mod_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_mod_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Term
p_div2(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int res, mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1);
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"// /2 with %d and %d", i1, i2);
#endif
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
res = (i1 - mod) / i2;
RINT(res);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
break;
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0");
return Yap_gmp_div2_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_div2_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Term
p_rem(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
RINT(i1%i2);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
if (IntegerOfTerm(t2) == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0");
return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_rem_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Term
p_rdiv(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP
switch (ETypeOfTerm(t1)) {
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1);
return Yap_gmq_rdiv_int_int(i1, i2);
}
case (CELL)big_int_e:
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_int_big(IntegerOfTerm(t1), t2);
default:
RERROR();
}
break;
case (CELL)big_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
if (IntegerOfTerm(t2) == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0");
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
return Yap_gmq_rdiv_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
default:
RERROR();
}
#else
RERROR();
#endif
}
/*
Floating point division: /
*/
static Term
p_fdiv(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i2 = IntegerOfTerm(t2);
/* two integers */
RFLOAT((((Float)IntegerOfTerm(t1))/(Float)i2));
}
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1/fl2);
}
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_fdiv_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float / integer */
{
Int i2 = IntegerOfTerm(t2);
RFLOAT(FloatOfTerm(t1)/(Float)i2);
}
case double_e:
{
Float f2 = FloatOfTerm(t2);
RFLOAT(FloatOfTerm(t1)/f2);
}
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_fdiv_float_big(FloatOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_fdiv_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
/* two bignums*/
return Yap_gmp_fdiv_big_big(t1, t2);
case double_e:
return Yap_gmp_fdiv_big_float(t1, FloatOfTerm(t2));
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
/*
xor #
*/
static Term
p_xor(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_xor_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
return Yap_gmp_xor_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
/*
atan2: arc tangent x/y
*/
static Term
p_atan2(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
RFLOAT(atan2(IntegerOfTerm(t1),IntegerOfTerm(t2)));
case double_e:
RFLOAT(atan2(IntegerOfTerm(t1),FloatOfTerm(t2)));
case big_int_e:
#ifdef USE_GMP
{
Int i1 = IntegerOfTerm(t1);
Float f2 = Yap_gmp_to_float(t2);
RFLOAT(atan2(i1,f2));
}
#endif
default:
RERROR();
break;
}
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float / integer */
{
Int i2 = IntegerOfTerm(t2);
RFLOAT(atan2(FloatOfTerm(t1),i2));
}
case double_e:
{
Float f2 = FloatOfTerm(t2);
RFLOAT(atan2(FloatOfTerm(t1),f2));
}
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(atan2(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
{
Float dbl1 = Yap_gmp_to_float(t1);
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(atan2(dbl1,i));
}
case big_int_e:
/* two bignums */
RFLOAT(atan2(dbl1,Yap_gmp_to_float(t2)));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(dbl1,dbl));
}
default:
RERROR();
}
}
#endif
default:
RERROR();
}
RERROR();
}
/*
power: x^y
*/
static Term
p_power(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i2 = IntegerOfTerm(t2);
/* two integers */
RFLOAT(pow(IntegerOfTerm(t1),i2));
}
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(pow(fl1,fl2));
}
case big_int_e:
#ifdef USE_GMP
{
Int i1 = IntegerOfTerm(t1);
Float f2 = Yap_gmp_to_float(t2);
RFLOAT(pow(i1,f2));
}
#endif
default:
RERROR();
}
break;
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float / integer */
{
Int i2 = IntegerOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),i2));
}
case double_e:
{
Float f2 = FloatOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),f2));
}
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(pow(Yap_gmp_to_float(t1),i));
}
case big_int_e:
/* two bignums */
RFLOAT(pow(Yap_gmp_to_float(t1),Yap_gmp_to_float(t2)));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
}
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
/* next function is adapted from:
Inline C++ integer exponentiation routines
Version 1.01
Copyright (C) 1999-2004 John C. Bowman