static Int p_profiling_start_point( USES_REGS1 ) { // this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) { Term t = Deref(ARG1); Float v; // valid value for ARG1 is just 'float' if (IsFloatTerm(t)) { v = FloatOfTerm(t); if (v < 0.0 || v >= 1.0) { // value passed by argument is out of known range Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,""); return FALSE; } ExpEnv.config_struc.profiling_startp = v; return TRUE; } else { // ARG1 is not float Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"profiling_start_point/1 (1st arg)"); return FALSE; } } else { // current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION' Yap_NilError(INCOMPATIBLEMODE_WARNING,""); return FALSE; } }
/// @memberof isnan/1 static Int p_isinf( USES_REGS1 ) { /* X is Y */ Term out = 0L; while (!(out = Eval(Deref(ARG1) PASS_REGS))) { if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) { Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage); return FALSE; } } else { Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } } if (IsVarTerm(out)) { Yap_EvalError(INSTANTIATION_ERROR, out, "isinf/1"); return FALSE; } if (!IsFloatTerm(out)) { Yap_EvalError(TYPE_ERROR_FLOAT, out, "isinf/1"); return FALSE; } return isinf(FloatOfTerm(out)); }
static Int p_frequency_bound( USES_REGS1 ) { // this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) { Term t = Deref(ARG1); // valid values for ARG1 are 'integer' and 'float' if (IsIntTerm(t) || IsFloatTerm(t)) { // ARG1 is integer or float // getting ARG1 value Float v; if (IsIntTerm(t)) v = (Float)IntOfTerm(t); if (IsFloatTerm(t)) v = FloatOfTerm(t); // setting 'frequency bound' if 'frequency type' is 'COUNTER' if (ExpEnv.config_struc.frequency_type == COUNTER) { if (v < 20.0) { fprintf(stderr,"%.2f is a very low value for the active frequency type. Reconsider its value...\n", v); return FALSE; } ExpEnv.config_struc.frequency_bound = roundf(v); return TRUE; } // setting 'frequency bound' if 'frequency type' is 'TIME' else { if (v <= 0.0 || v > 0.49) { fprintf(stderr,"%.2f is an invalid or a very high value for the active frequency type. Reconsider its value...\n", v); return FALSE; } ExpEnv.config_struc.frequency_bound = v; return TRUE; } } else { // ARG1 is not an 'integer' or 'float' Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequency_bound/1 (1st arg)"); return FALSE; } } else { // current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION' Yap_NilError(INCOMPATIBLEMODE_WARNING,""); return FALSE; } }
static inline Float get_float(Term t) { if (IsFloatTerm(t)) { return FloatOfTerm(t); } if (IsIntTerm(t)) { return IntOfTerm(t); } if (IsLongIntTerm(t)) { return LongIntOfTerm(t); } #ifdef USE_GMP if (IsBigIntTerm(t)) { return Yap_gmp_to_float(t); } #endif return 0.0; }
static Int p_set_depth_limit_for_next_call( USES_REGS1 ) { Term d = Deref(ARG1); if (IsVarTerm(d)) { Yap_Error(INSTANTIATION_ERROR, d, "set-depth_limit"); return(FALSE); } else if (!IsIntegerTerm(d)) { if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) { DEPTH = RESET_DEPTH(); return TRUE; } Yap_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit"); return(FALSE); } d = MkIntTerm(IntegerOfTerm(d)*2); DEPTH = d; return(TRUE); }
/* maximum: max(x,y) */ static Term p_max(Term t1, Term t2) { switch (ETypeOfTerm(t1)) { case long_int_e: switch (ETypeOfTerm(t2)) { case long_int_e: { Int i1 = IntegerOfTerm(t1); Int i2 = IntegerOfTerm(t2); return((i1 > i2 ? t1 : t2)); } case double_e: { /* integer, double */ Int i = IntegerOfTerm(t1); Float fl = FloatOfTerm(t2); if (i >= fl) { return t1; } return t2; } case big_int_e: #ifdef USE_GMP if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) > 0) { return t1; } return t2; #endif default: RERROR(); } break; case double_e: switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { Int i = IntegerOfTerm(t2); Float fl = FloatOfTerm(t1); if (i >= fl) { return t2; } return t1; } case double_e: { Float fl1 = FloatOfTerm(t1); Float fl2 = FloatOfTerm(t2); if (fl1 >= fl2) { return t1; } return t2; } case big_int_e: #ifdef USE_GMP if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) > 0) { return t1; } return t2; #endif default: RERROR(); } break; case big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { case long_int_e: if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) > 0) { return t1; } return t2; case big_int_e: if (Yap_gmp_cmp_big_big(t1, t2) > 0) { return t1; } return t2; case double_e: if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) > 0) { return t1; } return t2; default: RERROR(); } #endif default: RERROR(); } RERROR(); }
/* power: x^y */ static Term p_exp(Term t1, Term t2 USES_REGS) { switch (ETypeOfTerm(t1)) { case long_int_e: switch (ETypeOfTerm(t2)) { case long_int_e: { Int i1 = IntegerOfTerm(t1); Int i2 = IntegerOfTerm(t2); Int pow = ipow(i1,i2); if (i2 < 0) { return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "%d ^ %d", i1, i2); } #ifdef USE_GMP /* two integers */ if ((i1 && !pow)) { /* overflow */ return Yap_gmp_exp_int_int(i1, i2); } #endif RINT(pow); } 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 i = IntegerOfTerm(t1); return Yap_gmp_exp_int_big(i,t2); } #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); return Yap_gmp_exp_big_int(t1,i); } case big_int_e: /* two bignums, makes no sense */ return Yap_gmp_exp_big_big(t1,t2); case double_e: { Float dbl = FloatOfTerm(t2); RFLOAT(pow(Yap_gmp_to_float(t1),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(); }
/* 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(); }
/* 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(); }
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 compare_complex(register CELL *pt0, register CELL *pt0_end, register CELL *pt1) { CACHE_REGS register CELL **to_visit = (CELL **)HR; register Int out = 0; loop: while (pt0 < pt0_end) { register CELL d0, d1; ++pt0; ++pt1; d0 = Derefa(pt0); d1 = Derefa(pt1); if (IsVarTerm(d0)) { if (IsVarTerm(d1)) { out = Signed(d0) - Signed(d1); if (out) goto done; } else { out = -1; goto done; } } else if (IsVarTerm(d1)) { out = 1; goto done; } else { if (d0 == d1) continue; else if (IsAtomTerm(d0)) { if (IsAtomTerm(d1)) out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1)); else if (IsPrimitiveTerm(d1)) out = 1; else out = -1; /* I know out must be != 0 */ goto done; } else if (IsIntTerm(d0)) { if (IsIntTerm(d1)) out = IntOfTerm(d0) - IntOfTerm(d1); else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = IntOfTerm(d0) - LongIntOfTerm(d1); #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1); #endif } else if (IsRefTerm(d1)) out = 1; else out = -1; if (out != 0) goto done; } else if (IsFloatTerm(d0)) { if (IsFloatTerm(d1)) { out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1)); } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } else if (IsStringTerm(d0)) { if (IsStringTerm(d1)) { out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)); } else if (IsIntTerm(d1)) out = 1; else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = 1; #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = 1; #endif } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } else if (IsLongIntTerm(d0)) { if (IsIntTerm(d1)) out = LongIntOfTerm(d0) - IntOfTerm(d1); else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = LongIntOfTerm(d0) - LongIntOfTerm(d1); #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1); #endif } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } #ifdef USE_GMP else if (IsBigIntTerm(d0)) { if (IsIntTerm(d1)) { out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1)); } else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1)); } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_big_big(d0, d1); } else if (IsRefTerm(d1)) out = 1; else out = -1; if (out != 0) goto done; } #endif else if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { if (IsApplTerm(d1)) { Functor f = FunctorOfTerm(d1); if (IsExtensionFunctor(f)) out = 1; else if (!(out = 2 - ArityOfFunctor(f))) out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE); } else out = 1; goto done; } #ifdef RATIONAL_TREES to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit[3] = (CELL *)*pt0; to_visit += 4; *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit += 3; } #endif pt0 = RepPair(d0) - 1; pt0_end = RepPair(d0) + 1; pt1 = RepPair(d1) - 1; continue; } else if (IsRefTerm(d0)) { if (IsRefTerm(d1)) out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0)); else out = -1; goto done; } else if (IsApplTerm(d0)) { register Functor f; register CELL *ap2, *ap3; if (!IsApplTerm(d1)) { out = 1; goto done; } else { /* store the terms to visit */ Functor f2; ap2 = RepAppl(d0); ap3 = RepAppl(d1); f = (Functor)(*ap2); if (IsExtensionFunctor(f)) { out = 1; goto done; } f2 = (Functor)(*ap3); if (IsExtensionFunctor(f2)) { out = -1; goto done; } /* compare functors */ if (f != (Functor)*ap3) { if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2))) out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2)); goto done; } #ifdef RATIONAL_TREES to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit[3] = (CELL *)*pt0; to_visit += 4; *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit += 3; } #endif d0 = ArityOfFunctor(f); pt0 = ap2; pt0_end = ap2 + d0; pt1 = ap3; continue; } } } } /* Do we still have compound terms to visit */ if (to_visit > (CELL **)HR) { #ifdef RATIONAL_TREES to_visit -= 4; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; *pt0 = (CELL)to_visit[3]; #else to_visit -= 3; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; #endif goto loop; } done: /* failure */ #ifdef RATIONAL_TREES while (to_visit > (CELL **)HR) { to_visit -= 4; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; *pt0 = (CELL)to_visit[3]; } #endif return (out); }
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; } }
static int unifiable(CELL d0, CELL d1) { CACHE_REGS #if THREADS #undef Yap_REGS register REGSTORE *regp = Yap_regp; #define Yap_REGS (*regp) #elif SHADOW_REGS #if defined(B) || defined(TR) register REGSTORE *regp = &Yap_REGS; #define Yap_REGS (*regp) #endif /* defined(B) || defined(TR) */ #endif #if SHADOW_HB register CELL *HBREG = HB; #endif register CELL *pt0, *pt1; deref_head(d0, unifiable_unk); unifiable_nvar: /* d0 is bound */ deref_head(d1, unifiable_nvar_unk); unifiable_nvar_nvar: /* both arguments are bound */ if (d0 == d1) return TRUE; if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { return (FALSE); } pt0 = RepPair(d0); pt1 = RepPair(d1); return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1)); } else if (IsApplTerm(d0)) { pt0 = RepAppl(d0); d0 = *pt0; if (!IsApplTerm(d1)) return (FALSE); pt1 = RepAppl(d1); d1 = *pt1; if (d0 != d1) { return (FALSE); } else { if (IsExtensionFunctor((Functor)d0)) { switch(d0) { case (CELL)FunctorDBRef: return(pt0 == pt1); case (CELL)FunctorLongInt: return(pt0[1] == pt1[1]); case (CELL)FunctorString: return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0); case (CELL)FunctorDouble: return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); #ifdef USE_GMP case (CELL)FunctorBigInt: return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0); #endif /* USE_GMP */ default: return(FALSE); } } return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0), pt1)); } } else { return (FALSE); } deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar); /* d0 is bound and d1 is unbound */ *(pt1) = d0; DO_TRAIL(pt1, d0); return (TRUE); deref_body(d0, pt0, unifiable_unk, unifiable_nvar); /* pt0 is unbound */ deref_head(d1, unifiable_var_unk); unifiable_var_nvar: /* pt0 is unbound and d1 is bound */ *pt0 = d1; DO_TRAIL(pt0, d1); return TRUE; deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar); /* d0 and pt1 are unbound */ UnifyAndTrailCells(pt0, pt1); return (TRUE); #if THREADS #undef Yap_REGS #define Yap_REGS (*Yap_regp) #elif SHADOW_REGS #if defined(B) || defined(TR) #undef Yap_REGS #endif /* defined(B) || defined(TR) */ #endif }
static int OCUnify(register CELL d0, register CELL d1) { CACHE_REGS register CELL *pt0, *pt1; #if SHADOW_HB register CELL *HBREG = HB; #endif deref_head(d0, oc_unify_unk); oc_unify_nvar: /* d0 is bound */ deref_head(d1, oc_unify_nvar_unk); oc_unify_nvar_nvar: if (d0 == d1) { return (!rational_tree(d0)); } /* both arguments are bound */ if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { return (FALSE); } pt0 = RepPair(d0); pt1 = RepPair(d1); return (OCUnify_complex(pt0 - 1, pt0 + 1, pt1 - 1)); } else if (IsApplTerm(d0)) { if (!IsApplTerm(d1)) return (FALSE); pt0 = RepAppl(d0); d0 = *pt0; pt1 = RepAppl(d1); d1 = *pt1; if (d0 != d1) { return (FALSE); } else { if (IsExtensionFunctor((Functor)d0)) { switch(d0) { case (CELL)FunctorDBRef: return(pt0 == pt1); case (CELL)FunctorLongInt: return(pt0[1] == pt1[1]); case (CELL)FunctorDouble: return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); case (CELL)FunctorString: return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0); #ifdef USE_GMP case (CELL)FunctorBigInt: return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0); #endif /* USE_GMP */ default: return(FALSE); } } return (OCUnify_complex(pt0, pt0 + ArityOfFunctor((Functor) d0), pt1)); } } else { return(FALSE); } deref_body(d1, pt1, oc_unify_nvar_unk, oc_unify_nvar_nvar); /* d0 is bound and d1 is unbound */ YapBind(pt1, d0); /* local variables cannot be in a term */ if (pt1 > HR && pt1 < LCL0) return TRUE; if (rational_tree(d0)) return(FALSE); return (TRUE); deref_body(d0, pt0, oc_unify_unk, oc_unify_nvar); /* pt0 is unbound */ deref_head(d1, oc_unify_var_unk); oc_unify_var_nvar: /* pt0 is unbound and d1 is bound */ YapBind(pt0, d1); /* local variables cannot be in a term */ if (pt0 > HR && pt0 < LCL0) return TRUE; if (rational_tree(d1)) return(FALSE); return (TRUE); deref_body(d1, pt1, oc_unify_var_unk, oc_unify_var_nvar); /* d0 and pt1 are unbound */ UnifyCells(pt0, pt1); return (TRUE); return (TRUE); }
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */ { if (t1 == t2) return 0; if (IsVarTerm(t1)) { if (IsVarTerm(t2)) return Signed(t1) - Signed(t2); return -1; } else if (IsVarTerm(t2)) { /* get rid of variables */ return 1; } if (IsAtomOrIntTerm(t1)) { if (IsAtomTerm(t1)) { if (IsAtomTerm(t2)) return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2)); if (IsPrimitiveTerm(t2)) return 1; if (IsStringTerm(t2)) return 1; return -1; } else { if (IsIntTerm(t2)) { return IntOfTerm(t1) - IntOfTerm(t2); } if (IsApplTerm(t2)) { Functor fun2 = FunctorOfTerm(t2); switch ((CELL)fun2) { case double_e: return 1; case long_int_e: return IntOfTerm(t1) - LongIntOfTerm(t2); #ifdef USE_GMP case big_int_e: return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2); #endif case db_ref_e: return 1; case string_e: return -1; } } return -1; } } else if (IsPairTerm(t1)) { if (IsApplTerm(t2)) { Functor f = FunctorOfTerm(t2); if (IsExtensionFunctor(f)) return 1; else { if (f != FunctorDot) return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE); else { return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2)); } } } if (IsPairTerm(t2)) { return ( compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1)); } else return 1; } else { /* compound term */ Functor fun1 = FunctorOfTerm(t1); if (IsExtensionFunctor(fun1)) { /* float, long, big, dbref */ switch ((CELL)fun1) { case double_e: { if (IsFloatTerm(t2)) return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2))); if (IsRefTerm(t2)) return 1; return -1; } case long_int_e: { if (IsIntTerm(t2)) return LongIntOfTerm(t1) - IntOfTerm(t2); if (IsFloatTerm(t2)) { return 1; } if (IsLongIntTerm(t2)) return LongIntOfTerm(t1) - LongIntOfTerm(t2); #ifdef USE_GMP if (IsBigIntTerm(t2)) { return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2); } #endif if (IsRefTerm(t2)) return 1; return -1; } #ifdef USE_GMP case big_int_e: { if (IsIntTerm(t2)) return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2)); if (IsFloatTerm(t2)) { return 1; } if (IsLongIntTerm(t2)) return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2)); if (IsBigIntTerm(t2)) { return Yap_gmp_tcmp_big_big(t1, t2); } if (IsRefTerm(t2)) return 1; return -1; } #endif case string_e: { if (IsApplTerm(t2)) { Functor fun2 = FunctorOfTerm(t2); switch ((CELL)fun2) { case double_e: return 1; case long_int_e: return 1; #ifdef USE_GMP case big_int_e: return 1; #endif case db_ref_e: return 1; case string_e: return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)); } return -1; } return -1; } case db_ref_e: if (IsRefTerm(t2)) return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1)); return -1; } } if (!IsApplTerm(t2)) { if (IsPairTerm(t2)) { Int out; Functor f = FunctorOfTerm(t1); if (!(out = ArityOfFunctor(f)) - 2) out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, "."); return out; } return 1; } else { Functor fun2 = FunctorOfTerm(t2); Int r; if (IsExtensionFunctor(fun2)) { return 1; } r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2); if (r) return r; r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2)); if (r) return r; else return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1), RepAppl(t2))); } } }
/// @memberof logsum/3 static Int p_logsum( USES_REGS1 ) { /* X is Y */ Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); int done = FALSE; Float f1, f2; while (!done) { if (IsFloatTerm(t1)) { f1 = FloatOfTerm(t1); done = TRUE; } else if (IsIntegerTerm(t1)) { f1 = IntegerOfTerm(t1); done = TRUE; #if USE_GMP } else if (IsBigIntTerm(t1)) { f1 = Yap_gmp_to_float(t1); done = TRUE; #endif } else { while (!(t1 = Eval(t1 PASS_REGS))) { if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) { Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage); return FALSE; } } else { Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } } } } done = FALSE; while (!done) { if (IsFloatTerm(t2)) { f2 = FloatOfTerm(t2); done = TRUE; } else if (IsIntegerTerm(t2)) { f2 = IntegerOfTerm(t2); done = TRUE; #if USE_GMP } else if (IsBigIntTerm(t2)) { f2 = Yap_gmp_to_float(t2); done = TRUE; #endif } else { while (!(t2 = Eval(t2 PASS_REGS))) { if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { LOCAL_Error_TYPE = YAP_NO_ERROR; if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) { Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage); return FALSE; } } else { Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } } } } if (f1 >= f2) { Float fi = exp(f2-f1); return Yap_unify(ARG3,MkFloatTerm(f1+log(1+fi))); } else { Float fi = exp(f1-f2); return Yap_unify(ARG3,MkFloatTerm(f2+log(1+fi))); } }
static Int p_frequencyty2( USES_REGS1 ) { // this predicate works only 'SMART_JIT' and 'CONTINUOUS_COMPILATION' modes if (ExpEnv.config_struc.execution_mode == SMART_JIT || ExpEnv.config_struc.execution_mode == CONTINUOUS_COMPILATION) { Term t = Deref(ARG1); // valid value for ARG1 is just 'atom' if (IsAtomTerm(t)) { Term u = Deref(ARG2); // valid values for ARG2 are 'integer' and 'float' if (IsIntTerm(u) || IsFloatTerm(u)) { // ARG1 is atom and ARG2 is integer or float int i = 0, j = 0; char *tmp; // getting string from atom and stores it on 'str' char *str = (char*)malloc(YAP_AtomNameLength(AtomOfTerm(t))*sizeof(char)); strcpy(str, AtomName(AtomOfTerm(t))); // Making upper characters of 'str' (for comparison) UPPER_ENTRY(str); // getting ARG2 value Float v; if (IsIntTerm(u)) v = (Float)IntOfTerm(u); if (IsFloatTerm(u)) v = FloatOfTerm(u); // setting 'frequency type' and 'frequency bound' if 'COUNTER' if (strcmp(str, "COUNTER") == 0 || strcmp(str, "COUNT") == 0) { if (v < 20.0) { // Very low frequency bound to apply on 'COUNTER' fprintf(stderr,"%.2f is a very low value for the active frequency type. Reconsider its value...\n", v); return FALSE; } ExpEnv.config_struc.frequency_type = COUNTER; ExpEnv.config_struc.frequency_bound = roundf(v); return TRUE; } // setting 'frequency type' and 'frequency bound' if 'TIME' else if (strcmp(str, "TIME") == 0 || strcmp(str, "TIMING") == 0) { if (v <= 0.0 || v > 0.49) { // Very low frequency bound to apply on 'COUNTER' fprintf(stderr,"%.2f is an invalid or a very high value for the active frequency type. Reconsider its value...\n", v); return FALSE; } ExpEnv.config_struc.frequency_type = TIME; ExpEnv.config_struc.frequency_bound = v; return TRUE; } else { // value passed by argument (ARG1) is out of known range Yap_Error(OUT_OF_KNOWNRANGE_ERROR,t,""); return FALSE; } } else { // ARG2 is not an 'integer' or 'float' Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequencyty/2 (2nd arg)"); return FALSE; } } else { // ARG1 is not an atom Yap_NilError(INVALID_PARAMETER_TYPE_ERROR,"frequencyty/2 (1st arg)"); return FALSE; } } else { // current execution mode differs of 'SMART_JIT' and 'CONTINUOUS_COMPILATION' Yap_NilError(INCOMPATIBLEMODE_WARNING,""); return FALSE; } }