diff --git a/C/cmppreds.c b/C/cmppreds.c index 1f13f76ae..24d825d8a 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -599,6 +599,13 @@ a_cmp(Term t1, Term t2 USES_REGS) } } +Int +Yap_acmp(Term t1, Term t2 USES_REGS) +{ + Int out = a_cmp(t1, t2 PASS_REGS); + if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; } + return out; +} static Int p_acomp( USES_REGS1 ) diff --git a/C/eval.c b/C/eval.c index 56e6739cc..f51ce1ff1 100644 --- a/C/eval.c +++ b/C/eval.c @@ -223,6 +223,136 @@ Yap_ArithError(yap_error_number type, Term where, char *format,...) return 0L; } +static Int cont_between( USES_REGS1 ) +{ + Term t1 = EXTRA_CBACK_ARG(3,1); + Term t2 = EXTRA_CBACK_ARG(3,2); + + Yap_unify(ARG3, t1); + if (IsIntegerTerm(t1) && (IsIntegerTerm(t2) || IsAtomTerm(t2))) { + Int i1; + Term tn; + + if (t1 == t2) + cut_succeed(); + i1 = IntegerOfTerm(t1); + i1++; + tn = MkIntegerTerm(i1); + EXTRA_CBACK_ARG(3,1) = MkIntegerTerm(i1); + HB = B->cp_h = H; + return TRUE; + } else { + Term t[2]; + Term tn; + Int cmp; + + cmp = Yap_acmp(t1, t2); + if (cmp == 0) + cut_succeed(); + t[0] = t1; + t[1] = MkIntTerm(1); + tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t)); + EXTRA_CBACK_ARG(3,1) = tn; + HB = B->cp_h = H; + return TRUE; + } +} + +static Int +init_between( USES_REGS1 ) +{ + Term t1 = Deref(ARG1); + Term t2 = Deref(ARG2); + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "between/3"); + return FALSE; + } + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR, t1, "between/3"); + return FALSE; + } + if (!IsIntegerTerm(t1) && + !IsBigIntTerm(t1)) { + Yap_Error(TYPE_ERROR_INTEGER, t1, "between/3"); + return FALSE; + } + if (!IsIntegerTerm(t2) && + !IsBigIntTerm(t2) && + t2 != MkAtomTerm(AtomInf) && + t2 != MkAtomTerm(AtomInfinity)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "between/3"); + return FALSE; + } + if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { + Int i1 = IntegerOfTerm(t1); + Int i2 = IntegerOfTerm(t2); + Term t3; + + t3 = Deref(ARG3); + if (!IsVarTerm(t3)) { + if (!IsIntegerTerm(t3)) { + if (!IsBigIntTerm(t3)) { + Yap_Error(TYPE_ERROR_INTEGER, t3, "between/3"); + return FALSE; + } + cut_fail(); + } else { + Int i3 = IntegerOfTerm(t3); + if (i3 >= i1 && i3 <= i2) + cut_succeed(); + cut_fail(); + } + } + if (i1 > i2) cut_fail(); + if (i1 == i2) { + Yap_unify(ARG3, t1); + cut_succeed(); + } + } else if (IsIntegerTerm(t1) && IsAtomTerm(t2)) { + Int i1 = IntegerOfTerm(t1); + Term t3; + + t3 = Deref(ARG3); + if (!IsVarTerm(t3)) { + if (!IsIntegerTerm(t3)) { + if (!IsBigIntTerm(t3)) { + Yap_Error(TYPE_ERROR_INTEGER, t3, "between/3"); + return FALSE; + } + cut_fail(); + } else { + Int i3 = IntegerOfTerm(t3); + if (i3 >= i1) + cut_succeed(); + cut_fail(); + } + } + } else { + Term t3 = Deref(ARG3); + Int cmp; + + if (!IsVarTerm(t3)) { + if (!IsIntegerTerm(t3) && !IsBigIntTerm(t3)) { + Yap_Error(TYPE_ERROR_INTEGER, t3, "between/3"); + return FALSE; + } + if (Yap_acmp(t3, t1) >= 0 && Yap_acmp(t2,t3) >= 0 && P != FAILCODE) + cut_succeed(); + cut_fail(); + } + cmp = Yap_acmp(t1, t2); + if (cmp > 0) cut_fail(); + if (cmp == 0) { + Yap_unify(ARG3, t1); + cut_succeed(); + } + } + EXTRA_CBACK_ARG(3,1) = t1; + EXTRA_CBACK_ARG(3,2) = t2; + return cont_between( PASS_REGS1 ); +} + void Yap_InitEval(void) { @@ -231,5 +361,6 @@ Yap_InitEval(void) Yap_InitUnaryExps(); Yap_InitBinaryExps(); Yap_InitCPred("is", 2, p_is, 0L); + Yap_InitCPredBack("between", 3, 2, init_between, cont_between, 0); } diff --git a/H/Yapproto.h b/H/Yapproto.h index 6edde1f83..3d02c3d3f 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -138,6 +138,7 @@ void Yap_HidePred(struct pred_entry *pe); /* cmppreds.c */ Int Yap_compare_terms(Term,Term); +Int Yap_acmp(Term, Term USES_REGS); void Yap_InitCmpPreds(void); /* compiler.c */ diff --git a/H/iatoms.h b/H/iatoms.h index 93efe6964..21a801e98 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -138,6 +138,7 @@ AtomIOMode = Yap_LookupAtom("io_mode"); AtomId = Yap_LookupAtom("id"); AtomInf = Yap_LookupAtom("inf"); + AtomInfinity = Yap_LookupAtom("infinity"); AtomInitGoal = Yap_FullLookupAtom("$init_goal"); AtomInitProlog = Yap_FullLookupAtom("$init_prolog"); AtomInStackExpansion = Yap_LookupAtom("in stack expansion"); diff --git a/H/ratoms.h b/H/ratoms.h index db4a835cd..c0cdbe9f5 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -138,6 +138,7 @@ AtomIOMode = AtomAdjust(AtomIOMode); AtomId = AtomAdjust(AtomId); AtomInf = AtomAdjust(AtomInf); + AtomInfinity = AtomAdjust(AtomInfinity); AtomInitGoal = AtomAdjust(AtomInitGoal); AtomInitProlog = AtomAdjust(AtomInitProlog); AtomInStackExpansion = AtomAdjust(AtomInStackExpansion); diff --git a/H/tatoms.h b/H/tatoms.h index eb7a57198..d98452b6f 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -274,6 +274,8 @@ #define AtomId Yap_heap_regs->AtomId_ Atom AtomInf_; #define AtomInf Yap_heap_regs->AtomInf_ + Atom AtomInfinity_; +#define AtomInfinity Yap_heap_regs->AtomInfinity_ Atom AtomInitGoal_; #define AtomInitGoal Yap_heap_regs->AtomInitGoal_ Atom AtomInitProlog_; diff --git a/misc/ATOMS b/misc/ATOMS index a8eed647d..1b539c7c4 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -143,6 +143,7 @@ A IDB N "idb" A IOMode N "io_mode" A Id N "id" A Inf N "inf" +A Infinity N "infinity" A InitGoal F "$init_goal" A InitProlog F "$init_prolog" A InStackExpansion N "in stack expansion" diff --git a/pl/arith.yap b/pl/arith.yap index c18411ab5..7bb153350 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -280,74 +280,6 @@ do_not_compile_expressions :- set_value('$c_arith',[]). /* Arithmetics */ -between(I,M,J) :- - ( - var(I) - -> - '$do_error'(instantiation_error,between(I,M,J)) - ; - integer(I) - -> - ( - var(M) - -> - '$do_error'(instantiation_error,between(I,M,J)) - ; - integer(M) - -> - ( - var(J) - -> - I =< M, '$between'(I,M,J) - ; - integer(J) - -> - J >= I, J =< M - ; - '$do_error'(type_error(integer, J),between(I,M,J)) - ) - ; - M == inf -> - ( - var(J) - -> - '$between_inf'(I,J) - ; - integer(J) - -> - J >= I - ; - '$do_error'(type_error(integer, J),between(I,M,J)) - ) - ; - M == infinity -> - ( - var(J) - -> - '$between_inf'(I,J) - ; - integer(J) - -> - J >= I - ; - '$do_error'(type_error(integer, J),between(I,M,J)) - ) - ; - '$do_error'(type_error(integer, M),between(I,M,J)) - ) - ; - '$do_error'(type_error(integer, I),between(I,M,J)) - ). - -'$between'(I,M,I) :- (I == M -> ! ; true ). -'$between'(I0,I,J) :- I0 < I, - '$plus'(I0, 1, I1), - '$between'(I1,I,J). - -'$between_inf'(I,I). -'$between_inf'(I,J) :- - '$plus'(I, 1, I1), - '$between_inf'(I1,J). % M and N nonnegative integers, N is the successor of M @@ -404,6 +336,8 @@ succ(M,N) :- N < 0, '$do_error'(domain_error(not_less_than_zero, N),succ(M,N)). + + plus(X, Y, Z) :- ( var(X)