diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

make between/3 a C-builtin.

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-04-29 18:22:53 -05:00
parent c04f04d078
commit 64a61e2479
8 changed files with 146 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/cmppreds.c
View File

@ -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 )

131
C/eval.c
View File

@ -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);
}

1
H/Yapproto.h
View File

@ -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 */

1
H/iatoms.h
View File

@ -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");

1
H/ratoms.h
View File

@ -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);

2
H/tatoms.h
View File

@ -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_;

1
misc/ATOMS
View File

@ -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"

70
pl/arith.yap
View File

@ -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)