static Int p_binary_is(void) { /* X is Y */ Term t = Deref(ARG2); Term t1, t2; if (IsVarTerm(t)) { Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } t1 = Yap_Eval(Deref(ARG3)); if (!Yap_FoundArithError(t1, ARG3)) { return FALSE; } t2 = Yap_Eval(Deref(ARG4)); if (!Yap_FoundArithError(t2, ARG4)) { return FALSE; } if (IsIntTerm(t)) { Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L); if (!tout) return FALSE; return Yap_unify_constant(ARG1,tout); } if (IsAtomTerm(t)) { Atom name = AtomOfTerm(t); ExpEntry *p; Term out; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(1); t = Yap_MkApplTerm(FunctorSlash, 2, ti); Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,2); P = FAILCODE; return(FALSE); } if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L))) return FALSE; return Yap_unify_constant(ARG1,out); } return FALSE; }
static Int do_arith23(arith2_op op) { /* X is Y */ Term t = Deref(ARG1); Int out; Term t1, t2; if (IsVarTerm(t)) { Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } t1 = Yap_Eval(t); if (t1 == 0L) return FALSE; t2 = Yap_Eval(Deref(ARG2)); if (t2 == 0L) return FALSE; if (!(out=Yap_FoundArithError(eval2(op, t1, t2), 0L))) return FALSE; return Yap_unify_constant(ARG3,out); }
static Int a_cmp(Term t1, Term t2 USES_REGS) { if (IsVarTerm(t1)) { Yap_ArithError(INSTANTIATION_ERROR, t1, "while doing arithmetic comparison"); } if (IsVarTerm(t2)) { Yap_ArithError(INSTANTIATION_ERROR, t2, "while doing arithmetic comparison"); } if (IsFloatTerm(t1) && IsFloatTerm(t2)) { return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2)); } if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2)); } t1 = Yap_Eval(t1); if (!t1) { return FALSE; } if (IsIntegerTerm(t1)) { Int i1 = IntegerOfTerm(t1); t2 = Yap_Eval(t2); if (IsIntegerTerm(t2)) { Int i2 = IntegerOfTerm(t2); return int_cmp(i1 - i2); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan"); } #endif return flt_cmp(i1 - f2); #ifdef USE_GMP } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_int_big(i1, t2); #endif } else { return FALSE; } } else if (IsFloatTerm(t1)) { Float f1 = FloatOfTerm(t1); #if HAVE_ISNAN if (isnan(f1)) { Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1, "trying to evaluate nan"); } #endif t2 = Yap_Eval(t2); #if HAVE_ISNAN if (isnan(f1)) return -1; #endif if (IsIntegerTerm(t2)) { Int i2 = IntegerOfTerm(t2); return flt_cmp(f1 - i2); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan"); } #endif return flt_cmp(f1 - f2); #ifdef USE_GMP } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_float_big(f1, t2); #endif } else { return FALSE; } #ifdef USE_GMP } else if (IsBigIntTerm(t1)) { { t2 = Yap_Eval(t2); if (IsIntegerTerm(t2)) { return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan"); } #endif return Yap_gmp_cmp_big_float(t1, f2); } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_big_big(t1, t2); } else { return FALSE; } } #endif } else { return FALSE; } }
static Int p_setarg( USES_REGS1 ) { CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3); Int i; if (IsVarTerm(t3) && VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) { /* local variable */ Term tn = MkVarTerm(); Bind_Local(VarOfTerm(t3), tn); t3 = tn; } if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3"); return FALSE; } else { if (IsIntTerm(ti)) i = IntOfTerm(ti); else { Term te = Yap_Eval(ti); if (IsIntegerTerm(te)) { i = IntegerOfTerm(te); } else { Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3"); return FALSE; } } } if (IsVarTerm(ts)) { Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3"); } else if(IsApplTerm(ts)) { CELL *pt; if (IsExtensionFunctor(FunctorOfTerm(ts))) { Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); return FALSE; } if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) { if (i<0) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); return FALSE; if (i==0) Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3"); return FALSE; } pt = RepAppl(ts)+i; /* the evil deed is to be done now */ MaBind(pt, t3); } else if(IsPairTerm(ts)) { CELL *pt; if (i < 1 || i > 2) { if (i<0) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); return FALSE; } pt = RepPair(ts)+i-1; /* the evil deed is to be done now */ MaBind(pt, t3); } else { Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); return FALSE; } return TRUE; }
static inline Int a_cmp(Term t1, Term t2) { ArithError = FALSE; if (IsVarTerm(t1)) { ArithError = TRUE; Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2"); return FALSE; } if (IsVarTerm(t2)) { ArithError = TRUE; Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2"); return FALSE; } if (IsFloatTerm(t1) && IsFloatTerm(t2)) { return flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)); } if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { return int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2)); } t1 = Yap_Eval(t1); if (!t1) { return FALSE; } if (IsIntegerTerm(t1)) { Int i1 = IntegerOfTerm(t1); t2 = Yap_Eval(t2); if (IsIntegerTerm(t2)) { Int i2 = IntegerOfTerm(t2); return int_cmp(i1-i2); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_Error_Term = t2; Yap_ErrorMessage = "trying to evaluate nan"; ArithError = TRUE; } #endif return flt_cmp(i1-f2); #ifdef USE_GMP } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_int_big(i1,t2); #endif } else { return FALSE; } } else if (IsFloatTerm(t1)) { Float f1 = FloatOfTerm(t1); #if HAVE_ISNAN if (isnan(f1)) { Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_Error_Term = t1; Yap_ErrorMessage = "trying to evaluate nan"; ArithError = TRUE; } #endif t2 = Yap_Eval(t2); #if HAVE_ISNAN if (isnan(f1)) return -1; #endif if (IsIntegerTerm(t2)) { Int i2 = IntegerOfTerm(t2); return flt_cmp(f1-i2); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_Error_Term = t2; Yap_ErrorMessage = "trying to evaluate nan"; ArithError = TRUE; } #endif return flt_cmp(f1-f2); #ifdef USE_GMP } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_float_big(f1,t2); #endif } else { return FALSE; } #ifdef USE_GMP } else if (IsBigIntTerm(t1)) { { t2 = Yap_Eval(t2); if (IsIntegerTerm(t2)) { return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)); } else if (IsFloatTerm(t2)) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED; Yap_Error_Term = t2; Yap_ErrorMessage = "trying to evaluate nan"; ArithError = TRUE; } #endif return Yap_gmp_cmp_big_float(t1, f2); } else if (IsBigIntTerm(t2)) { return Yap_gmp_cmp_big_big(t1, t2); } else { return FALSE; } } #endif } else { return FALSE; } }