Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3
This commit is contained in:
commit
1ba8656e73
10
C/arith2.c
10
C/arith2.c
@ -253,7 +253,7 @@ p_div2(Term t1, Term t2 USES_REGS) {
|
||||
/* two bignums */
|
||||
return Yap_gmp_div2_big_big(t1, t2);
|
||||
case double_e:
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
|
||||
default:
|
||||
RERROR();
|
||||
}
|
||||
@ -282,7 +282,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
|
||||
RINT(i1%i2);
|
||||
}
|
||||
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:
|
||||
#ifdef USE_GMP
|
||||
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
|
||||
@ -292,7 +292,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
|
||||
}
|
||||
break;
|
||||
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:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
@ -304,7 +304,7 @@ p_rem(Term t1, Term t2 USES_REGS) {
|
||||
/* two bignums */
|
||||
return Yap_gmp_rem_big_big(t1, t2);
|
||||
case double_e:
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
|
||||
default:
|
||||
RERROR();
|
||||
}
|
||||
@ -350,7 +350,7 @@ p_rdiv(Term t1, Term t2 USES_REGS) {
|
||||
case (CELL)big_int_e:
|
||||
return Yap_gmq_rdiv_big_big(t1, t2);
|
||||
case double_e:
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
|
||||
default:
|
||||
RERROR();
|
||||
}
|
||||
|
62
C/atomic.c
62
C/atomic.c
@ -638,10 +638,13 @@ init_atom_concat3( USES_REGS1 )
|
||||
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
|
||||
at = Yap_SubtractTailAtom( Deref(ARG3), t2 PASS_REGS );
|
||||
ot = ARG1;
|
||||
} else {
|
||||
} else if (Yap_IsGroundTerm(t3)) {
|
||||
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
|
||||
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS));
|
||||
return cont_atom_concat3( PASS_REGS1 );
|
||||
} else {
|
||||
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
|
||||
LOCAL_Error_Term = t1;
|
||||
}
|
||||
if (at) {
|
||||
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)) {
|
||||
at = Yap_SubtractTailAtom( t3, CastToAtom(t2) PASS_REGS );
|
||||
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 {
|
||||
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
|
||||
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS));
|
||||
return cont_atomic_concat3( PASS_REGS1 );
|
||||
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
|
||||
LOCAL_Error_Term = t1;
|
||||
}
|
||||
if (at) {
|
||||
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)) {
|
||||
tf = Yap_SubtractTailString( t3, t2 PASS_REGS );
|
||||
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 {
|
||||
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
|
||||
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS));
|
||||
return cont_string_concat3( PASS_REGS1 );
|
||||
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
|
||||
LOCAL_Error_Term = t1;
|
||||
}
|
||||
if (tf) {
|
||||
if (Yap_unify(ot, tf)) { cut_succeed(); }
|
||||
@ -1216,23 +1225,29 @@ p_atomics_to_string3( USES_REGS1 )
|
||||
static Int
|
||||
p_atom_length( USES_REGS1 )
|
||||
{
|
||||
Term t1;
|
||||
Term t1 = Deref(ARG1);;
|
||||
Term t2 = Deref(ARG2);
|
||||
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 (!IsIntegerTerm(t2)) {
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
|
||||
} else if ((len = IntegerOfTerm(t2)) < 0) {
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2");
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
restart_aux:
|
||||
t1 = Deref(ARG1);
|
||||
len = Yap_AtomicToLength(t1 PASS_REGS);
|
||||
if (len != (size_t)-1)
|
||||
return Yap_unify( ARG2, MkIntegerTerm(len) );
|
||||
@ -1246,23 +1261,30 @@ restart_aux:
|
||||
static Int
|
||||
p_atomic_length( USES_REGS1 )
|
||||
{
|
||||
Term t1;
|
||||
Term t1 = Deref(ARG1);
|
||||
Term t2 = Deref(ARG2);
|
||||
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 (!IsIntegerTerm(t2)) {
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2");
|
||||
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");
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
restart_aux:
|
||||
t1 = Deref(ARG1);
|
||||
len = Yap_AtomicToLength(t1 PASS_REGS);
|
||||
if (len != (size_t)-1)
|
||||
return Yap_unify( ARG2, MkIntegerTerm(len) );
|
||||
@ -1831,6 +1853,10 @@ init_sub_atomic( int sub_atom USES_REGS )
|
||||
return FALSE;
|
||||
} else {
|
||||
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;
|
||||
bnds++;
|
||||
}
|
||||
@ -1841,6 +1867,10 @@ init_sub_atomic( int sub_atom USES_REGS )
|
||||
return FALSE;
|
||||
} else {
|
||||
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;
|
||||
bnds++;
|
||||
}
|
||||
@ -1851,6 +1881,10 @@ init_sub_atomic( int sub_atom USES_REGS )
|
||||
return FALSE;
|
||||
} else {
|
||||
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;
|
||||
bnds++;
|
||||
}
|
||||
|
@ -778,7 +778,7 @@ Yap_gmp_rem_big_int(Term t, Int i2)
|
||||
{
|
||||
CELL *pt = RepAppl(t);
|
||||
if (pt[1] != BIG_INT) {
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
|
||||
} else {
|
||||
MP_INT *b = Yap_BigIntOfTerm(t);
|
||||
MP_INT new;
|
||||
@ -795,7 +795,7 @@ Yap_gmp_rem_int_big(Int i1, Term t)
|
||||
CACHE_REGS
|
||||
CELL *pt = RepAppl(t);
|
||||
if (pt[1] != BIG_INT) {
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
|
||||
} else {
|
||||
/* integer is much smaller */
|
||||
return MkIntegerTerm(i1);
|
||||
@ -829,7 +829,7 @@ Yap_gmp_gcd_int_big(Int i, Term t)
|
||||
CACHE_REGS
|
||||
CELL *pt = RepAppl(t);
|
||||
if (pt[1] != BIG_INT) {
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "gcd/2");
|
||||
} else {
|
||||
/* integer is much smaller */
|
||||
if (i > 0) {
|
||||
|
@ -675,6 +675,9 @@ retractall(V) :-
|
||||
;
|
||||
'$retractall_lu'(T,M)
|
||||
)
|
||||
;
|
||||
\+ callable(T) ->
|
||||
'$do_error'(type_error(callable,T),retractall(T))
|
||||
;
|
||||
'$undefined'(T,M) ->
|
||||
functor(T,Na,Ar),
|
||||
|
Reference in New Issue
Block a user