support for PL_ mpz and mpq ops

add missing atom_nchars
This commit is contained in:
Vítor Santos Costa 2010-06-18 23:24:36 +01:00
parent 4c45f8c4b1
commit d1d149b9fd
4 changed files with 112 additions and 0 deletions

View File

@ -1594,6 +1594,47 @@ Yap_gmp_to_size(Term t, int base)
return 1;
}
int
Yap_term_to_existing_big(Term t, MP_INT *b)
{
if (IsVarTerm(t))
return FALSE;
if (IsIntegerTerm(t)) {
mpz_set_si(b,IntegerOfTerm(t));
return TRUE;
}
if (IsBigIntTerm(t)) {
if (RepAppl(t)[1] != BIG_INT)
return FALSE;
mpz_set(b,Yap_BigIntOfTerm(t));
return TRUE;
}
return FALSE;
}
int
Yap_term_to_existing_rat(Term t, MP_RAT *b)
{
if (IsVarTerm(t))
return FALSE;
if (IsIntegerTerm(t)) {
mpq_set_si(b, IntegerOfTerm(t), 1);
return TRUE;
}
if (IsBigIntTerm(t)) {
CELL flag = RepAppl(t)[1];
if (flag == BIG_INT) {
mpq_set_z(b, Yap_BigIntOfTerm(t));
return TRUE;
}
if (flag == BIG_RATIONAL) {
mpq_set(b, Yap_BigRatOfTerm(t));
return TRUE;
}
}
return FALSE;
}
#endif

View File

@ -305,6 +305,9 @@ Term STD_PROTO(Yap_gmp_popcount,(Term));
char * STD_PROTO(Yap_gmp_to_string,(Term, char *, size_t, int));
size_t STD_PROTO(Yap_gmp_to_size,(Term, int));
int STD_PROTO(Yap_term_to_existing_big,(Term, MP_INT *));
int STD_PROTO(Yap_term_to_existing_rat,(Term, MP_RAT *));
#endif
inline EXTERN Term Yap_Mk64IntegerTerm(YAP_LONG_LONG);

View File

@ -399,6 +399,7 @@ extern X_API int PL_cons_functor_v(term_t, functor_t,term_t);
extern X_API int PL_cons_list(term_t, term_t, term_t);
extern X_API int PL_put_atom(term_t, atom_t);
extern X_API int PL_put_atom_chars(term_t, const char *);
extern X_API int PL_put_atom_nchars(term_t, size_t ,const char *);
extern X_API int PL_put_float(term_t, double);
extern X_API int PL_put_functor(term_t, functor_t t);
extern X_API int PL_put_int64(term_t, int64_t);
@ -561,6 +562,13 @@ PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
#endif
#if USE_GMP
PL_EXPORT(int) PL_get_mpz(term_t t, mpz_t mpz);
PL_EXPORT(int) PL_unify_mpz(term_t t, mpz_t mpz);
PL_EXPORT(int) PL_get_mpq(term_t t, mpq_t mpz);
PL_EXPORT(int) PL_unify_mpq(term_t t, mpq_t mpz);
#endif
extern X_API const char *PL_cwd(void);
void swi_install(void);

View File

@ -757,6 +757,40 @@ X_API int PL_get_int64(term_t ts, int64_t *i)
}
#if USE_GMP
/*******************************
* GMP *
*******************************/
X_API int PL_get_mpz(term_t t, mpz_t mpz)
{
Term t0 = Yap_GetFromSlot(t);
return Yap_term_to_existing_big(t0, mpz);
}
X_API int PL_unify_mpz(term_t t, mpz_t mpz)
{
Term iterm = Yap_MkBigIntTerm(mpz);
return Yap_unify(Yap_GetFromSlot(t),iterm);
}
X_API int PL_get_mpq(term_t t, mpq_t mpz)
{
Term t0 = Yap_GetFromSlot(t);
return Yap_term_to_existing_rat(t0, mpz);
}
X_API int PL_unify_mpq(term_t t, mpq_t mpq)
{
Term iterm = Yap_MkBigRatTerm(mpq);
return Yap_unify(Yap_GetFromSlot(t),iterm);
}
#endif
X_API int PL_get_list(term_t ts, term_t h, term_t tl)
{
YAP_Term t = Yap_GetFromSlot(ts);
@ -1092,6 +1126,32 @@ X_API int PL_put_atom_chars(term_t t, const char *s)
return TRUE;
}
X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s)
{
Atom at;
char *buf;
if (strlen(s) > len) {
while (!(buf = (char *)Yap_AllocCodeSpace(len+1))) {
if (!Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
strncpy(buf, s, len);
} else {
buf = (char *)s;
}
while (!(at = Yap_LookupAtom(buf))) {
if (!Yap_growheap(FALSE, 0L, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
Yap_PutInSlot(t,MkAtomTerm(at));
return TRUE;
}
X_API int PL_put_float(term_t t, double fl)
{
Yap_PutInSlot(t,YAP_MkFloatTerm(fl));