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

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2014-10-23 02:11:03 +01:00
commit 1ba8656e73
4 changed files with 59 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/arith2.c
View File

@ -253,7 +253,7 @@ p_div2(Term t1, Term t2 USES_REGS) {
/* two bignums */ /* two bignums */
return Yap_gmp_div2_big_big(t1, t2); return Yap_gmp_div2_big_big(t1, t2);
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
default: default:
RERROR(); RERROR();
} }
@ -282,7 +282,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
RINT(i1%i2); RINT(i1%i2);
} }
case (CELL)double_e: case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
case (CELL)big_int_e: case (CELL)big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2); return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
@ -292,7 +292,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
} }
break; break;
case (CELL)double_e: case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2");
case (CELL)big_int_e: case (CELL)big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
@ -304,7 +304,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
/* two bignums */ /* two bignums */
return Yap_gmp_rem_big_big(t1, t2); return Yap_gmp_rem_big_big(t1, t2);
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
default: default:
RERROR(); RERROR();
} }
@ -350,7 +350,7 @@ p_rdiv(Term t1, Term t2 USES_REGS) {
case (CELL)big_int_e: case (CELL)big_int_e:
return Yap_gmq_rdiv_big_big(t1, t2); return Yap_gmq_rdiv_big_big(t1, t2);
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
default: default:
RERROR(); RERROR();
} }

62
C/atomic.c
View File

@ -638,10 +638,13 @@ init_atom_concat3( USES_REGS1 )
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
at = Yap_SubtractTailAtom( Deref(ARG3), t2 PASS_REGS ); at = Yap_SubtractTailAtom( Deref(ARG3), t2 PASS_REGS );
ot = ARG1; ot = ARG1;
} else { } else if (Yap_IsGroundTerm(t3)) {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS));
return cont_atom_concat3( PASS_REGS1 ); return cont_atom_concat3( PASS_REGS1 );
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
} }
if (at) { if (at) {
if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed(); if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed();
@ -732,10 +735,13 @@ init_atomic_concat3( USES_REGS1 )
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
at = Yap_SubtractTailAtom( t3, CastToAtom(t2) PASS_REGS ); at = Yap_SubtractTailAtom( t3, CastToAtom(t2) PASS_REGS );
ot = ARG1; ot = ARG1;
} else if (Yap_IsGroundTerm(t3)) {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS));
return cont_atomic_concat3( PASS_REGS1 );
} else { } else {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); LOCAL_Error_TYPE = INSTANTIATION_ERROR;
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS)); LOCAL_Error_Term = t1;
return cont_atomic_concat3( PASS_REGS1 );
} }
if (at) { if (at) {
if (Yap_unify(ot, CastToNumeric(at))) cut_succeed(); if (Yap_unify(ot, CastToNumeric(at))) cut_succeed();
@ -804,10 +810,13 @@ init_string_concat3( USES_REGS1 )
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
tf = Yap_SubtractTailString( t3, t2 PASS_REGS ); tf = Yap_SubtractTailString( t3, t2 PASS_REGS );
ot = ARG1; ot = ARG1;
} else if (Yap_IsGroundTerm(t3)) {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS));
return cont_string_concat3( PASS_REGS1 );
} else { } else {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); LOCAL_Error_TYPE = INSTANTIATION_ERROR;
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS)); LOCAL_Error_Term = t1;
return cont_string_concat3( PASS_REGS1 );
} }
if (tf) { if (tf) {
if (Yap_unify(ot, tf)) { cut_succeed(); } if (Yap_unify(ot, tf)) { cut_succeed(); }
@ -1216,23 +1225,29 @@ p_atomics_to_string3( USES_REGS1 )
static Int static Int
p_atom_length( USES_REGS1 ) p_atom_length( USES_REGS1 )
{ {
Term t1; Term t1 = Deref(ARG1);;
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
ssize_t len; ssize_t len;
if (!Yap_IsGroundTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "atom_length/2");
return(FALSE);
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "atom_length/2");
return(FALSE);
}
if (Yap_IsGroundTerm(t2)) { if (Yap_IsGroundTerm(t2)) {
if (!IsIntegerTerm(t2)) { if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2");
return(FALSE); return(FALSE);
} } else if ((len = IntegerOfTerm(t2)) < 0) {
if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2");
return(FALSE); return(FALSE);
} }
} }
restart_aux: restart_aux:
t1 = Deref(ARG1);
len = Yap_AtomicToLength(t1 PASS_REGS); len = Yap_AtomicToLength(t1 PASS_REGS);
if (len != (size_t)-1) if (len != (size_t)-1)
return Yap_unify( ARG2, MkIntegerTerm(len) ); return Yap_unify( ARG2, MkIntegerTerm(len) );
@ -1246,23 +1261,30 @@ restart_aux:
static Int static Int
p_atomic_length( USES_REGS1 ) p_atomic_length( USES_REGS1 )
{ {
Term t1; Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
ssize_t len; ssize_t len;
if (!Yap_IsGroundTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "atomic_length/2");
return(FALSE);
} else if (!IsAtomicTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "atomic_length/2");
return(FALSE);
}
if (Yap_IsGroundTerm(t2)) { if (Yap_IsGroundTerm(t2)) {
if (!IsIntegerTerm(t2)) { if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2"); Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2");
return(FALSE); return(FALSE);
} }
if (FALSE && (len = IntegerOfTerm(t2)) < 0) { if ((len = IntegerOfTerm(t2)) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2"); Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2");
return(FALSE); return(FALSE);
} }
} }
restart_aux: restart_aux:
t1 = Deref(ARG1);
len = Yap_AtomicToLength(t1 PASS_REGS); len = Yap_AtomicToLength(t1 PASS_REGS);
if (len != (size_t)-1) if (len != (size_t)-1)
return Yap_unify( ARG2, MkIntegerTerm(len) ); return Yap_unify( ARG2, MkIntegerTerm(len) );
@ -1831,6 +1853,10 @@ init_sub_atomic( int sub_atom USES_REGS )
return FALSE; return FALSE;
} else { } else {
min = IntegerOfTerm(tbef); min = IntegerOfTerm(tbef);
if ((Int)min < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5");
return FALSE;
};
mask |= SUB_ATOM_HAS_MIN; mask |= SUB_ATOM_HAS_MIN;
bnds++; bnds++;
} }
@ -1841,6 +1867,10 @@ init_sub_atomic( int sub_atom USES_REGS )
return FALSE; return FALSE;
} else { } else {
len = IntegerOfTerm(tsize); len = IntegerOfTerm(tsize);
if ((Int)len < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5");
return FALSE;
};
mask |= SUB_ATOM_HAS_SIZE; mask |= SUB_ATOM_HAS_SIZE;
bnds++; bnds++;
} }
@ -1851,6 +1881,10 @@ init_sub_atomic( int sub_atom USES_REGS )
return FALSE; return FALSE;
} else { } else {
after = IntegerOfTerm(tafter); after = IntegerOfTerm(tafter);
if ((Int)after < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5");
return FALSE;
};
mask |= SUB_ATOM_HAS_AFTER; mask |= SUB_ATOM_HAS_AFTER;
bnds++; bnds++;
} }

6
C/gmp_support.c
View File

@ -778,7 +778,7 @@ Yap_gmp_rem_big_int(Term t, Int i2)
{ {
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) { if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
} else { } else {
MP_INT *b = Yap_BigIntOfTerm(t); MP_INT *b = Yap_BigIntOfTerm(t);
MP_INT new; MP_INT new;
@ -795,7 +795,7 @@ Yap_gmp_rem_int_big(Int i1, Term t)
CACHE_REGS CACHE_REGS
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) { if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
} else { } else {
/* integer is much smaller */ /* integer is much smaller */
return MkIntegerTerm(i1); return MkIntegerTerm(i1);
@ -829,7 +829,7 @@ Yap_gmp_gcd_int_big(Int i, Term t)
CACHE_REGS CACHE_REGS
CELL *pt = RepAppl(t); CELL *pt = RepAppl(t);
if (pt[1] != BIG_INT) { if (pt[1] != BIG_INT) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t, "gcd/2");
} else { } else {
/* integer is much smaller */ /* integer is much smaller */
if (i > 0) { if (i > 0) {

3
pl/preds.yap
View File

@ -675,6 +675,9 @@ retractall(V) :-
; ;
'$retractall_lu'(T,M) '$retractall_lu'(T,M)
) )
;
\+ callable(T) ->
'$do_error'(type_error(callable,T),retractall(T))
; ;
'$undefined'(T,M) -> '$undefined'(T,M) ->
functor(T,Na,Ar), functor(T,Na,Ar),