yap-6.3/C/arith1.c

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		arith1.c						 *
* Last rev:								 *
* mods:									 *
* comments:	arithmetical expression evaluation			 *
*									 *
*************************************************************************/
#ifdef SCCS
static char     SccsId[] = "%W% %G%";
#endif

/*
 * This file implements unary arithmetic operations in YAP
 *
 */

#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
#include "eval.h"

#define E_FUNC   blob_type
#define E_ARGS   , arith_retptr o

#define RINT(v)     (o)->Int = v; return(long_int_e)
#define RFLOAT(v)   (o)->dbl = v; return(double_e)
#define RBIG(v)     (o)->big = v; return(big_int_e)
#if  USE_GMP
static blob_type
float_to_int(Float v, union arith_ret *o)
{
  Int i = (Int)v;
  if (i-v == 0.0) {
    o->Int = i;
    return(long_int_e);
  } else {
    MP_INT *new = Yap_PreAllocBigNum();

    mpz_set_d(new, v);
    o->big = new;
    return(big_int_e);
  }
}
#define RBIG_FL(v)  return(float_to_int(v,o))
#else
#define RBIG_FL(v)  (o)->Int = (Int)v; return(long_int_e)
#endif
#define RERROR()    return(db_ref_e)

inline static Functor
AritFunctorOfTerm(Term t) {
  if (IsVarTerm(t)) {
    return(FunctorDBRef);
  }
  if (IsApplTerm(t)) {
    return(FunctorOfTerm(t));
  } else {
    if (IsIntTerm(t))
      return(FunctorLongInt);
    else
      return(FunctorDBRef);
  }
}

static Term
EvalToTerm(blob_type f, union arith_ret *res)
{
  switch (f) {
  case long_int_e:
    return(MkIntegerTerm(res->Int));
  case double_e:
    return(MkFloatTerm(res->dbl));
#ifdef USE_GMP
  case big_int_e:
    return(Yap_MkBigIntTerm(res->big));
#endif
  default:
    return(TermNil);
  }
}

typedef blob_type (*f_unexp)(Term, arith_retptr);

typedef struct init_un_eval {
  char          *OpName;
  f_unexp        f;
} InitUnEntry;

/* Some compilers just don't get it */

#ifdef __MINGW32__
#undef HAVE_ASINH
#undef HAVE_ACOSH
#undef HAVE_ATANH
#undef HAVE_FINITE
#endif

#if !HAVE_ASINH
#define asinh(F)  (log((F)+sqrt((F)*(F)+1)))
#endif
#if !HAVE_ACOSH
#define acosh(F)  (log((F)+sqrt((F)*(F)-1)))
#endif
#if !HAVE_ATANH
#define atanh(F)  (log((1+(F))/(1-(F)))/2)
#endif

/*
  do nothing...
*/
static E_FUNC
p_uplus(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  blob_type bt;
  union arith_ret v;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(IntegerOfTerm(t));
  case double_e:
    RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
  case big_int_e:
    {
      RBIG(Yap_BigIntOfTerm(t));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(v.Int);
    case double_e:
      RFLOAT(v.dbl);
#ifdef USE_GMP
    case big_int_e:
      {
	RBIG(v.big);
      }
#endif
    default:
      /* Error */
      RERROR();
    }
  }
}

/*
  unary minus: -
*/
static E_FUNC
p_uminus(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(-IntegerOfTerm(t));
  case double_e:
    RFLOAT(-FloatOfTerm(t));
#ifdef USE_GMP
  case big_int_e:
    {
      MP_INT *new = Yap_PreAllocBigNum();

      mpz_neg(new, Yap_BigIntOfTerm(t));
      RBIG(new);
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(-v.Int);
    case double_e:
      RFLOAT(-v.dbl);
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = Yap_PreAllocBigNum();

	mpz_neg(new, v.big);
	RBIG(new);
      }
#endif
    default:
      /* Error */
      RERROR();
    }
  }
}

/*
  unary negation is \
*/
static E_FUNC
p_unot(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(~IntegerOfTerm(t));
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t));
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    {
      MP_INT *new = Yap_PreAllocBigNum();

      mpz_com(new, Yap_BigIntOfTerm(t));
      RBIG(new);
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(~v.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t, "\\(%f)", v.dbl);
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = Yap_PreAllocBigNum();
	
	mpz_com(new, v.big);
	RBIG(new);
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

/*
  exponentiation exp(x)
*/
static E_FUNC
p_exp(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RFLOAT(exp(IntegerOfTerm(t)));
  case double_e:
    RFLOAT(exp(FloatOfTerm(t)));
#ifdef USE_GMP
  case big_int_e:
    RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RFLOAT(exp(v.Int));
    case double_e:
      RFLOAT(exp(v.dbl));
#ifdef USE_GMP
    case big_int_e:
      RFLOAT(mpz_get_d(v.big));
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

/*
  natural logarithm log(x)
*/
static E_FUNC
p_log(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  if (dbl > 0) {
    RFLOAT(log(dbl));
  } else if (dbl == 0) {
    Yap_Error(DOMAIN_ERROR_NOT_ZERO, t, "log(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  } else {
    Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
}

/*
  base 10 logarithm log10(x)
*/
static E_FUNC
p_log10(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  if (dbl > 0) {
    RFLOAT(log10(dbl));
  } else if (dbl == 0) {
    Yap_Error(DOMAIN_ERROR_NOT_ZERO, t, "log10(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  } else {
    Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log10(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
}

/*
  square root sqrt(x)
*/
static E_FUNC
p_sqrt(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl, out;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
  out = sqrt(dbl);
#if HAVE_ISNAN
  if (isnan(out)) {
    Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
#endif
  RFLOAT(out);
}

/*
  sine sin(x) ? why did they take the e
*/
static E_FUNC
p_sin(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(sin(dbl));
}

/*
  cosine cos(x)
*/
static E_FUNC
p_cos(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(cos(dbl));
}

/*
  tangent tan(x)
*/
static E_FUNC
p_tan(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(tan(dbl));
}

/*
  hyperbolic sine  sinh(x) = (exp(x) - exp(-x)) / 2.
*/
static E_FUNC
p_sinh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(sinh(dbl));
}

/*
  hyperbolic cosine  cosh(x) = (exp(x) + exp(-x)) / 2.
*/
static E_FUNC
p_cosh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(cosh(dbl));
}

/*
  hyperbolic tangent  tanh(x)
*/
static E_FUNC
p_tanh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(tanh(dbl));
}

/*
  asin(x) arc sine function
*/
static E_FUNC
p_asin(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl, out;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  out = asin(dbl);
#if HAVE_ISNAN
  if (isnan(out)) {
    Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
#endif
  RFLOAT(out);
}

/*
  acos(x) arc cosine function
*/
static E_FUNC
p_acos(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl, out;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  out = acos(dbl);
#if HAVE_ISNAN
  if (isnan(out)) {
    Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
#endif
  RFLOAT(out);
}

/*
  atan(x) arc tangent function
*/
static E_FUNC
p_atan(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(atan(dbl));
}

/*
  asinh(x) arc hyperbolic sine
*/
static E_FUNC
p_asinh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(asinh(dbl));
}

/*
  acosh(x) arc hyperbolic cosine
*/
static E_FUNC
p_acosh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl, out;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  out = acosh(dbl);
#if HAVE_ISNAN
  if (isnan(out)) {
    Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acosh(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
#endif
  RFLOAT(out);
}

/*
  atanh(x) arc hyperbolic tangent
*/
static E_FUNC
p_atanh(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl, out;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    dbl = IntegerOfTerm(t);
    break;
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    dbl = mpz_get_d(Yap_BigIntOfTerm(t));
    break;
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      dbl = v.Int;
      break;
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      dbl = mpz_get_d(v.big);
      break;
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  out = atanh(dbl);
#if HAVE_ISNAN
  if (isnan(out)) {
    Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acosh(%f)", dbl);
    P = (yamop *)FAILCODE;
    RERROR();
  }
#endif
  RFLOAT(out);
}

/*
  floor(x) maximum integer greatest or equal to X

  There are really two built-ins:
  SICStus converts from int/big/float -> float
  ISO only converts from float -> int/big

*/
static E_FUNC
p_floor(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(IntegerOfTerm(t));
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s != NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", IntegerOfTerm(t));
	P = (yamop *)FAILCODE;
	Yap_FreeCodeSpace(s);
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(v.Int);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s != NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(mpz_get_d(v.big));
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
    RBIG_FL(floor(dbl));
  } else {
    RFLOAT(floor(dbl));
  }
}

/*
  ceiling(x) minimum integer smallest or equal to X
*/
static E_FUNC
p_ceiling(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(IntegerOfTerm(t));
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s != NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%s)", IntegerOfTerm(t));
	Yap_FreeCodeSpace(s);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(v.Int);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s != NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(mpz_get_d(v.big));
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
    RBIG_FL(ceil(dbl));
  } else {
    RFLOAT(ceil(dbl));
  }
}

/* WIN32 machines do not necessarily have rint. This will do for now */
#if HAVE_RINT
#define my_rint(X) rint(X)
#else
static
double my_rint(double x)
{ 
  double y, z; 
  Int n; 
  
  if (x >= 0) { 
    y = x + 0.5; 
    z = floor(y); 
    n = (int) z; 
    if (y == z && n % 2)
      return(z-1); 
  } else { 
    y = x - 0.5; 
    z = ceil(y); 
    n = (int) z; 
    if (y == z && n % 2)
      return(z+1); 
  }
  return(z); 
}
#endif

/*
  round(x) integer closest to 0
*/
static E_FUNC
p_round(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(IntegerOfTerm(t));
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s != NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%s)", IntegerOfTerm(t));
	Yap_FreeCodeSpace(s);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(v.Int);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s == NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(mpz_get_d(v.big));
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
  
  if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
    double vl = my_rint(dbl);
    RBIG_FL(vl);
  } else {
    double vl = my_rint(dbl);
    RFLOAT(vl);
  }
}

/*
  truncate(x) integer closest to 0
*/
static E_FUNC
p_truncate(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(IntegerOfTerm(t));
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s != NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%s)", IntegerOfTerm(t));
	Yap_FreeCodeSpace(s);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(v.Int);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s == NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(mpz_get_d(v.big));
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  if (dbl >= 0 ) {
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      RBIG_FL(floor(dbl));
    } else {
      RFLOAT(floor(dbl));
    }
  } else {
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      RBIG_FL(ceil(dbl));
    } else {
      RFLOAT(ceil(dbl));
    }
  }
}

/*
  integer(x) SICStus integer closest to 0, similar to truncate
*/
static E_FUNC
p_integer(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(IntegerOfTerm(t));
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    RBIG(Yap_BigIntOfTerm(t));
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(v.Int);
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      RBIG(v.big);
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
  if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) {
    RINT((Int) dbl);
  } else {
#ifdef USE_GMP
    MP_INT *new = Yap_PreAllocBigNum();

    mpz_set_d(new, dbl);
    RBIG(new);
#else
    Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1");
    P = (yamop *)FAILCODE;
    RERROR();	    
#endif
  }
}

/*
  float(x) SICStus float
*/
static E_FUNC
p_float(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RFLOAT(IntegerOfTerm(t));
  case double_e:
    RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
  case big_int_e:
    RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RFLOAT(v.Int);
    case double_e:
      RFLOAT(v.dbl);
#ifdef USE_GMP
    case big_int_e:
      RFLOAT(mpz_get_d(v.big));
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

static Int
msb(Int inp)	/* calculate the most significant bit for an integer */
{
  /* the obvious solution: do it by using binary search */
  Int out = 0;
  int off = sizeof(CELL)*4;

  if (inp < 0) {
    Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
	  "msb/1 received %d", inp);
    P = (yamop *)FAILCODE;
    return(0);
  }

  while (off) {
    int limit = 1 << (off);
    if (inp >= limit) {
      out += off;
      inp >>= off;
    }
    off >>= 1;
  }
  return(out);
}

/*
  abs(x): absolute value of a number
*/
static E_FUNC
p_abs(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(labs(IntegerOfTerm(t)));
  case double_e:
    RFLOAT(fabs(FloatOfTerm(t)));
#ifdef USE_GMP
  case big_int_e:
    {
      MP_INT *new = Yap_PreAllocBigNum();

      mpz_abs(new, Yap_BigIntOfTerm(t));
      RBIG(new);
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(labs(v.Int));
    case double_e:
      RFLOAT(fabs(v.dbl));
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = Yap_PreAllocBigNum();

	mpz_abs(new, v.big);
	RBIG(new);
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

/*
  msb(x) most significant bit
*/
static E_FUNC
p_msb(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    RINT(msb(IntegerOfTerm(t)));
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t));
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    RINT(mpz_sizeinbase(Yap_BigIntOfTerm(t),2));
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT(v.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", v.dbl);
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      RINT(mpz_sizeinbase(v.big,2));
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

/*
  float_fractional_part(x) fraction for a float.
*/
static E_FUNC
p_ffracp(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(0.0);
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s != NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%s)", IntegerOfTerm(t));
	Yap_FreeCodeSpace(s);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(0.0);
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(0.0);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s == NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(0.0);
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }

  RFLOAT(dbl-ceil(dbl));
}

/*
  float_integer_part(x) integer for a float.
*/
static E_FUNC
p_fintp(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
      P = (yamop *)FAILCODE;
      RERROR();
    } else {
      RFLOAT(IntegerOfTerm(t));
    }
  case double_e:
    dbl = FloatOfTerm(t);
    break;
#ifdef USE_GMP
  case big_int_e:
    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
      MP_INT *big = Yap_BigIntOfTerm(t);
      Int sz = 2+mpz_sizeinbase(big,10);
      char *s = Yap_AllocCodeSpace(sz);

      if (s == NULL) {
	mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%s)", IntegerOfTerm(t));
	Yap_FreeCodeSpace(s);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(t)");
	P = (yamop *)FAILCODE;
	RERROR();
      }
    } else {
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", v.Int);
	P = (yamop *)FAILCODE;
	RERROR();
      } else {
	RFLOAT(v.Int);
      }
    case double_e:
      dbl = v.dbl;
      break;
#ifdef USE_GMP
    case big_int_e:
      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
	MP_INT *big = v.big;
	Int sz = 2+mpz_sizeinbase(big,10);
	char *s = Yap_AllocCodeSpace(sz);

	if (s == NULL) {
	  mpz_get_str(s, 10, Yap_BigIntOfTerm(t));
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%s)", IntegerOfTerm(t));
	  Yap_FreeCodeSpace(s);
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(t)");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
      } else {
	RFLOAT(mpz_get_d(v.big));
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
  RFLOAT(rint(dbl));
}

/*
  sign(x) sign of a number.
*/
static E_FUNC
p_sign(Term t E_ARGS)
{
  Functor f = AritFunctorOfTerm(t);
  union arith_ret v;
  blob_type bt;
  Float dbl;

  switch (BlobOfFunctor(f)) {
  case long_int_e:
    {
      Int x = IntegerOfTerm(t);

      RINT((x > 0 ? 1 : (x < 0 ? -1 : 0)));
    }
  case double_e:
    dbl = FloatOfTerm(t);

    RINT((dbl > 0.0 ? 1 : (dbl < 0.0 ? -1 : 0)));
#ifdef USE_GMP
  case big_int_e:
    RINT(mpz_sgn(Yap_BigIntOfTerm(t)));
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt = Yap_Eval(t, &v);
    /* second case, no need no evaluation */
    switch (bt) {
    case long_int_e:
      RINT((v.Int > 0 ? 1 : (v.Int < 0 ? -1 : 0)));
    case double_e:
      RINT((v.dbl > 0.0 ? 1 : (v.dbl < 0.0 ? -1 : 0)));
#ifdef USE_GMP
    case big_int_e:
      RINT(mpz_sgn(v.big));
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  }
}

static InitUnEntry InitUnTab[] = {
  {"+", p_uplus},
  {"-", p_uminus},
  {"\\", p_unot},
  {"exp", p_exp},
  {"log", p_log},
  {"log10", p_log10},
  {"sqrt", p_sqrt},
  {"sin", p_sin},
  {"cos", p_cos},
  {"tan", p_tan},
  {"sinh", p_sinh},
  {"cosh", p_cosh},
  {"tanh", p_tanh},
  {"asin", p_asin},
  {"acos", p_acos},
  {"atan", p_atan},
  {"asinh", p_asinh},
  {"acosh", p_acosh},
  {"atanh", p_atanh},
  {"floor", p_floor},
  {"ceiling", p_ceiling},
  {"round", p_round},
  {"truncate", p_truncate},
  {"integer", p_integer},
  {"float", p_float},
  {"abs", p_abs},
  {"msb", p_msb},
  {"float_fractional_part", p_ffracp},
  {"float_integer_part", p_fintp},
  {"sign", p_sign}
};

static Int 
p_unary_is(void)
{				/* X is Y	 */
  Term t = Deref(ARG2);
  union arith_ret res;

  if (IsVarTerm(t)) {
    Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y");
    return(FALSE);
  }
  if (IsIntTerm(t)) {
    blob_type f = InitUnTab[IntOfTerm(t)].f(Deref(ARG3),&res);
    return (Yap_unify_constant(ARG1,EvalToTerm(f,&res)));
  }
  if (IsAtomTerm(t)) {
    Atom name = AtomOfTerm(t);
    ExpEntry *p;
    blob_type f;

    if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 1)))) {
      Term ti[2];

      /* error */
      ti[0] = t;
      ti[1] = MkIntTerm(1);
      t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti);
      Yap_Error(TYPE_ERROR_EVALUABLE, t,
	    "functor %s/%d for arithmetic expression",
	    RepAtom(name)->StrOfAE,1);
      P = (yamop *)FAILCODE;
      return(FALSE);
    }
    f = p->FOfEE.unary(Deref(ARG3),&res);
    return (Yap_unify_constant(ARG1,EvalToTerm(f,&res)));
  }
  return(FALSE);
}

void
Yap_InitUnaryExps(void)
{
  unsigned int    i;
  ExpEntry       *p;

  for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
    AtomEntry *ae = RepAtom(Yap_LookupAtom(InitUnTab[i].OpName));
    WRITE_LOCK(ae->ARWLock);
    if (Yap_GetExpPropHavingLock(ae, 1)) {
      WRITE_UNLOCK(ae->ARWLock);
      break;
    }
    p = (ExpEntry *) Yap_AllocAtomSpace(sizeof(ExpEntry));
    p->KindOfPE = ExpProperty;
    p->ArityOfEE = 1;
    p->ENoOfEE = 1;
    p->FOfEE.unary = InitUnTab[i].f;
    p->NextOfPE = ae->PropsOfAE;
    ae->PropsOfAE = AbsExpProp(p);
    WRITE_UNLOCK(ae->ARWLock);
  }
  Yap_InitCPred("is", 3, p_unary_is, TestPredFlag | SafePredFlag);
}

/* This routine is called from Restore to make sure we have the same arithmetic operators */
int
Yap_ReInitUnaryExps(void)
{
  unsigned int i;
  Prop p;

  for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
    AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitUnTab[i].OpName));

    WRITE_LOCK(ae->ARWLock);
    if ((p = Yap_GetExpPropHavingLock(ae, 1)) == NULL) {
      WRITE_UNLOCK(ae->ARWLock);
      return(FALSE);
    }
    RepExpProp(p)->FOfEE.unary = InitUnTab[i].f;
    WRITE_UNLOCK(ae->ARWLock);
  }
  return(TRUE);
}