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

handle int64 in 32 bits no gmp as floats..

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-05-04 22:26:53 +01:00
parent cf39051162
commit 6738682c26
2 changed files with 382 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/pl-yap.c
View File

@ -1146,8 +1146,15 @@ X_API int PL_unify_int64__LD(term_t t, int64_t n ARG_LD)
#else #else
if ((long)n == n) if ((long)n == n)
return PL_unify_integer(t, n); return PL_unify_integer(t, n);
fprintf(stderr,"Error in PL_unify_int64: please install GMP\n"); // use a double, but will mess up writing.
return FALSE; else {
union {
int64_t i;
double d;
} udi_;
udi_.i = n;
return PL_unify_float(t, udi_.d);
}
#endif #endif
} }

594
library/dialect/swi/fli/swi.c
View File

@ -9,6 +9,27 @@
*/ */
/**
*
* @defgroup swi-c-interface SWI-Prolog Foreign Language Interface.
*
*
* @tableofcontents
*
* A reimplementation of Jan Wielemaker's SWI-Prolog C-language interface, it supports
* most of the functionality in the original implementation. It allows for:
*
* - Term Construction, Access, and Unification
* - Manipulation of Atoms, Strings, Lists of Codes and Lists of Atoms
* - Query evaluation
* - Thread and Prolog engine management
* - Data-Base Access
*
* In this interface, all Prolog data known by C is referenced through term references (term_t), hence
* Prolog has all the information necessary to perform its memory management without special precautions
* from the C programmer.
*/
#define PL_KERNEL 1 #define PL_KERNEL 1
//=== includes =============================================================== //=== includes ===============================================================
@ -34,6 +55,10 @@
#include <signal.h> #include <signal.h>
#endif #endif
#if !HAVE_SNPRINTF
#define snprintf(X,Y,Z,A) sprintf(X,Z,A)
#endif
#define PL_KERNEL 1 #define PL_KERNEL 1
#include <pl-shared.h> #include <pl-shared.h>
@ -127,16 +152,25 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
CurrentModule = cm; CurrentModule = cm;
} }
/* SWI: void PL_agc_hook(void) */ /** @defgroup swi-ATOMS Atom Construction
* @ingroup swi-c-interface
* @{
* */
/* SWI: void PL_agc_hook(void) */
/** @brief Atom garbage collection hook
*
*/
X_API PL_agc_hook_t X_API PL_agc_hook_t
PL_agc_hook(PL_agc_hook_t entry) PL_agc_hook(PL_agc_hook_t entry)
{ {
return (PL_agc_hook_t)YAP_AGCRegisterHook((YAP_agc_hook)entry); return (PL_agc_hook_t)YAP_AGCRegisterHook((YAP_agc_hook)entry);
} }
/* SWI: char* PL_atom_chars(atom_t atom) /** @brief extract the text representation from atom
YAP: char* AtomName(Atom) */ *
*/
X_API char* PL_atom_chars(atom_t a) /* SAM check type */ X_API char* PL_atom_chars(atom_t a) /* SAM check type */
{ {
Atom at = SWIAtomToAtom(a); Atom at = SWIAtomToAtom(a);
@ -145,8 +179,9 @@ X_API char* PL_atom_chars(atom_t a) /* SAM check type */
return RepAtom(at)->StrOfAE; return RepAtom(at)->StrOfAE;
} }
/* SWI: char* PL_atom_chars(atom_t atom) /** @brief extract the text representation from atom, including its length
YAP: char* AtomName(Atom) */ *
*/
X_API char* PL_atom_nchars(atom_t a, size_t *len) /* SAM check type */ X_API char* PL_atom_nchars(atom_t a, size_t *len) /* SAM check type */
{ {
char *s = RepAtom(SWIAtomToAtom(a))->StrOfAE; char *s = RepAtom(SWIAtomToAtom(a))->StrOfAE;
@ -154,15 +189,25 @@ X_API char* PL_atom_nchars(atom_t a, size_t *len) /* SAM check type */
return s; return s;
} }
/* SWI: term_t PL_copy_term_ref(term_t from) /** @}
YAP: NO EQUIVALENT */ *
/* SAM TO DO */ * @defgroup swi-term_references Term References
* @ingroup swi-c-interface
* @{
* */
/** @brief duplicate a term reference
*
*/
X_API term_t PL_copy_term_ref(term_t from) X_API term_t PL_copy_term_ref(term_t from)
{ {
CACHE_REGS CACHE_REGS
return Yap_InitSlot(Yap_GetFromSlot(from PASS_REGS) PASS_REGS); return Yap_InitSlot(Yap_GetFromSlot(from PASS_REGS) PASS_REGS);
} }
/** @brief create a new term reference
*
*/
X_API term_t PL_new_term_ref(void) X_API term_t PL_new_term_ref(void)
{ {
@ -171,6 +216,10 @@ X_API term_t PL_new_term_ref(void)
return to; return to;
} }
/** @brief create several new term references
*
* @par n is the number of references
*/
X_API term_t PL_new_term_refs(int n) X_API term_t PL_new_term_refs(int n)
{ {
CACHE_REGS CACHE_REGS
@ -178,6 +227,9 @@ X_API term_t PL_new_term_refs(int n)
return to; return to;
} }
/** @brief dispose of all term references created since after
*
*/
X_API void PL_reset_term_refs(term_t after) X_API void PL_reset_term_refs(term_t after)
{ {
CACHE_REGS CACHE_REGS
@ -185,10 +237,50 @@ X_API void PL_reset_term_refs(term_t after)
Yap_RecoverSlots(after-new PASS_REGS); Yap_RecoverSlots(after-new PASS_REGS);
} }
/* begin PL_get_* functions =============================*/ /** @}
* @defgroup swi-term_manipulation Term Manipulation
* @ingroup swi-c-interface
* */
/* SWI: int PL_get_arg(int index, term_t t, term_t a) /**
YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/ * @defgroup swi-get-operations Reading Terms
* @ingroup swi-term_manipulation
* @{
* */
/** @brief *name is assigned the name and *arity the arity if term ts, or the operaton fails.
*
*/
X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsAtomTerm(t)) {
*name = AtomToSWIAtom(AtomOfTerm(t));
*arity = 0;
return 1;
}
if (YAP_IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
return 0;
}
*name = AtomToSWIAtom(NameOfFunctor(f));
*arity = ArityOfFunctor(f);
return 1;
}
if (YAP_IsPairTerm(t)) {
*name = AtomToSWIAtom(AtomDot);
*arity = 2;
return 1;
}
return 0;
}
/** @brief a is assigned the argument index from term ts
*
*/
X_API int PL_get_arg(int index, term_t ts, term_t a) X_API int PL_get_arg(int index, term_t ts, term_t a)
{ {
CACHE_REGS CACHE_REGS
@ -211,8 +303,9 @@ X_API int PL_get_arg(int index, term_t ts, term_t a)
return 1; return 1;
} }
/* SWI: int PL_get_arg(int index, term_t t, term_t a) /** @brief *ap is assigned the name and *ip the arity from term ts
YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/ *
*/
X_API int PL_get_compound_name_arity(term_t ts, atom_t *ap, int *ip) X_API int PL_get_compound_name_arity(term_t ts, atom_t *ap, int *ip)
{ {
CACHE_REGS CACHE_REGS
@ -237,6 +330,158 @@ X_API int PL_get_compound_name_arity(term_t ts, atom_t *ap, int *ip)
} }
} }
/** @brief *a is assigned the atom in term ts, or the operation fails
*
*/
X_API int PL_get_atom(term_t ts, atom_t *a)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsAtomTerm(t))
return 0;
*a = AtomToSWIAtom(AtomOfTerm(t));
return 1;
}
/** @brief *i is assigned the int in term ts, or the operation fails
*
*/
/* SWI: int PL_get_integer(term_t t, int *i)
YAP: long int YAP_IntOfTerm(Term) */
X_API int PL_get_integer(term_t ts, int *i)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm(t) || !IsIntegerTerm(t) )
return 0;
*i = (int)IntegerOfTerm(t);
return 1;
}
/** @brief *i is assigned the boolean atom `true` or `false` in term ts, or the operation fails
*
*/
X_API int PL_get_long(term_t ts, long *i)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (!YAP_IsIntTerm(t) ) {
if (YAP_IsFloatTerm(t)) {
double dbl = YAP_FloatOfTerm(t);
if (dbl - (long)dbl == 0.0) {
*i = (long)dbl;
return 1;
}
}
return 0;
}
*i = YAP_IntOfTerm(t);
return 1;
}
/* SWI: int PL_get_bool(term_t t, int *i)
YAP: long int YAP_AtomOfTerm(Term) */
X_API int PL_get_bool(term_t ts, int *i)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
Atom at;
if (!IsAtomTerm(t) )
return 0;
at = AtomOfTerm(t);
if (at == AtomTrue) {
*i = TRUE;
return 1;
}
if (at == AtomFalse) {
*i = FALSE;
return 1;
}
return 0;
}
/** @brief *a is assigned the int64 in term ts, or the operation fails
*
*/
X_API int PL_get_int64(term_t ts, int64_t *i)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (!YAP_IsIntTerm(t) ) {
if (YAP_IsFloatTerm(t)) {
double dbl = YAP_FloatOfTerm(t);
if (dbl - (int64_t)dbl == 0.0) {
*i = (int64_t)dbl;
return 1;
}
#if SIZEOF_INT_P==4 && !USE_GMP
{
union {
double d;
int64_t i;
} udbi_;
udbi_.d = YAP_FloatOfTerm(t);
*i = udbi_.i;
return 1;
}
#endif
return 0;
}
#if USE_GMP
else if (YAP_IsBigNumTerm(t)) {
MP_INT g;
char s[64];
YAP_BigNumOfTerm(t, (void *)&g);
if (mpz_sizeinbase(&g,2) > 64) {
return 0;
}
mpz_get_str (s, 10, &g);
#ifdef _WIN32
sscanf(s, "%I64d", (long long int *)i);
#else
sscanf(s, "%lld", (long long int *)i);
#endif
return 1;
}
#endif
return 0;
}
*i = YAP_IntOfTerm(t);
return 1;
}
/** @brief *a is assigned the intptr_t in term ts, or the operation fails
*
*/
X_API int PL_get_intptr(term_t ts, intptr_t *a)
{
CACHE_REGS
Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsIntegerTerm(t) )
return 0;
*a = (intptr_t)(IntegerOfTerm(t));
return 1;
}
/** @brief *a is assigned the uintptr_t in term ts, or the operation fails
*
*/
X_API int PL_get_uintptr(term_t ts, uintptr_t *a)
{
CACHE_REGS
Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsIntegerTerm(t) )
return 0;
*a = (uintptr_t)(IntegerOfTerm(t));
return 1;
}
/** @brief a is assigned the argument index from term ts
*
*/
X_API int _PL_get_arg(int index, term_t ts, term_t a) X_API int _PL_get_arg(int index, term_t ts, term_t a)
{ {
CACHE_REGS CACHE_REGS
@ -256,47 +501,11 @@ X_API int _PL_get_arg(int index, term_t ts, term_t a)
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS); Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1; return 1;
} }
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_atom(term_t ts, atom_t *a)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsAtomTerm(t))
return 0;
*a = AtomToSWIAtom(AtomOfTerm(t));
return 1;
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) /** @brief *a is assigned the string representation of the atom in term ts, or the operation fails
YAP: YAP_Atom YAP_AtomOfTerm(Term) */ *
X_API int PL_get_intptr(term_t ts, intptr_t *a) */
{
CACHE_REGS
Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsIntegerTerm(t) )
return 0;
*a = (intptr_t)(IntegerOfTerm(t));
return 1;
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_uintptr(term_t ts, uintptr_t *a)
{
CACHE_REGS
Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !IsIntegerTerm(t) )
return 0;
*a = (uintptr_t)(IntegerOfTerm(t));
return 1;
}
/* SWI: int PL_get_atom_chars(term_t t, char **s)
YAP: char* AtomName(Atom) */
X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */
{ {
CACHE_REGS CACHE_REGS
@ -307,8 +516,9 @@ X_API int PL_get_atom_chars(term_t ts, char **a) /* SAM check type */
return 1; return 1;
} }
/* SWI: int PL_get_atom_chars(term_t t, char **s) /** @brief *a is assigned the string representation of the atom in term ts, and *len its size, or the operation fails
YAP: char* AtomName(Atom) */ *
*/
X_API int PL_get_atom_nchars(term_t ts, size_t *len, char **s) /* SAM check type */ X_API int PL_get_atom_nchars(term_t ts, size_t *len, char **s) /* SAM check type */
{ {
CACHE_REGS CACHE_REGS
@ -320,38 +530,38 @@ X_API int PL_get_atom_nchars(term_t ts, size_t *len, char **s) /* SAM check typ
return 1; return 1;
} }
/* /** PL_get_chars converts a term t to a string.
int PL_get_chars(term_t +t, char **s, unsigned flags) Convert the *
argument term t to a 0-terminated C-string. flags is a bitwise * From the SWI manual:
disjunction from two groups of constants. The first specifies which *
term-types should converted and the second how the argument is * int PL_get_chars(term_t +t, char **s, unsigned flags) Convert the
stored. Below is a specification of these constants. BUF_RING * argument term t to a 0-terminated C-string. flags is a bitwise
implies, if the data is not static (as from an atom), the data is * disjunction from two groups of constants. The first specifies which
copied to the next buffer from a ring of sixteen (16) buffers. This is a * term-types should converted and the second how the argument is
convenient way of converting multiple arguments passed to a foreign * stored. Below is a specification of these constants. BUF_RING
predicate to C-strings. If BUF_MALLOC is used, the data must be * implies, if the data is not static (as from an atom), the data is
freed using free() when not needed any longer. * copied to the next buffer from a ring of sixteen (16) buffers. This is a
* convenient way of converting multiple arguments passed to a foreign
* predicate to C-strings. If BUF_MALLOC is used, the data must be
* freed using free() when not needed any longer.
CVT_ATOM Convert if term is an atom - CVT_ATOM Convert if term is an atom
CVT_STRING Convert if term is a string - CVT_STRING Convert if term is a string
CVT_LIST Convert if term is a list of integers between 1 and 255 - CVT_LIST Convert if term is a list of integers between 1 and 255
CVT_INTEGER Convert if term is an integer (using %d) - CVT_INTEGER Convert if term is an integer (using %d)
CVT_FLOAT Convert if term is a float (using %f) - CVT_FLOAT Convert if term is a float (using %f)
CVT_NUMBER Convert if term is a integer or float - CVT_NUMBER Convert if term is a integer or float
CVT_ATOMIC Convert if term is atomic - CVT_ATOMIC Convert if term is atomic
CVT_VARIABLE Convert variable to print-name - CVT_VARIABLE Convert variable to print-name
CVT_ALL Convert if term is any of the above, except for variables - CVT_ALL Convert if term is any of the above, except for variables
BUF_DISCARDABLE Data must copied immediately - BUF_DISCARDABLE Data must copied immediately
BUF_RING Data is stored in a ring of buffers - BUF_RING Data is stored in a ring of buffers
BUF_MALLOC Data is copied to a new buffer returned by malloc(3) - BUF_MALLOC Data is copied to a new buffer returned by malloc(3)
*/ */
#if !HAVE_SNPRINTF /** @brief *f is assigned the functor of term ts, or the operation fails
#define snprintf(X,Y,Z,A) sprintf(X,Z,A) *
#endif */
/* SWI: int PL_get_functor(term_t t, functor_t *f)
YAP: YAP_Functor YAP_FunctorOfTerm(Term) */
X_API int PL_get_functor(term_t ts, functor_t *f) X_API int PL_get_functor(term_t ts, functor_t *f)
{ {
CACHE_REGS CACHE_REGS
@ -364,10 +574,11 @@ X_API int PL_get_functor(term_t ts, functor_t *f)
return 1; return 1;
} }
/* SWI: int PL_get_float(term_t t, double *f) /** @brief *f is assigned the floating point number of term ts, or the operation fails
YAP: double YAP_FloatOfTerm(Term) */ *
*/
X_API int PL_get_float(term_t ts, double *f) /* SAM type check*/ X_API int PL_get_float(term_t ts, double *f) /* SAM type check*/
{ {
CACHE_REGS CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS); YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( IsFloatTerm(t)) { if ( IsFloatTerm(t)) {
@ -384,6 +595,9 @@ X_API int PL_get_float(term_t ts, double *f) /* SAM type check*/
return 1; return 1;
} }
/** @brief *s is assigned the string representation of the string in term ts, and *len its size, or the operation fails
*
*/
X_API int PL_get_string_chars(term_t t, char **s, size_t *len) X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
{ {
CACHE_REGS CACHE_REGS
@ -396,7 +610,26 @@ X_API int PL_get_string_chars(term_t t, char **s, size_t *len)
return TRUE; return TRUE;
} }
/** @brief h is assigned the head of the pair term ts, and tl its tail, or the operation fails
*
*/
X_API int PL_get_list(term_t ts, term_t h, term_t tl)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm(t) || !IsPairTerm(t) ) {
return 0;
}
Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(tl,TailOfTerm(t) PASS_REGS);
return 1;
}
/** @brief h is assigned the head of the pair term ts, or the operation fails
*
*/
X_API int PL_get_head(term_t ts, term_t h) X_API int PL_get_head(term_t ts, term_t h)
{ {
CACHE_REGS CACHE_REGS
@ -408,102 +641,28 @@ X_API int PL_get_head(term_t ts, term_t h)
return 1; return 1;
} }
/** @brief *s is assigned the string representation of the term ts, and *len its size, or the operation fails
*
*/
X_API int PL_get_string(term_t t, char **s, size_t *len) X_API int PL_get_string(term_t t, char **s, size_t *len)
{ {
return PL_get_string_chars(t, s, len); return PL_get_string_chars(t, s, len);
} }
/* SWI: int PL_get_integer(term_t t, int *i) /**
YAP: long int YAP_IntOfTerm(Term) */ * @}
X_API int PL_get_integer(term_t ts, int *i) * */
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm(t) || !IsIntegerTerm(t) )
return 0;
*i = (int)IntegerOfTerm(t);
return 1;
}
/* SWI: int PL_get_bool(term_t t, int *i) /**
YAP: long int YAP_AtomOfTerm(Term) */ * @defgroup swi-unify-operations Unifying Terms
X_API int PL_get_bool(term_t ts, int *i) * @ingroup swi-term_manipulation
{ * @{
CACHE_REGS * */
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
Atom at;
if (!IsAtomTerm(t) )
return 0;
at = AtomOfTerm(t);
if (at == AtomTrue) {
*i = TRUE;
return 1;
}
if (at == AtomFalse) {
*i = FALSE;
return 1;
}
return 0;
}
X_API int PL_get_long(term_t ts, long *i)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (!YAP_IsIntTerm(t) ) {
if (YAP_IsFloatTerm(t)) {
double dbl = YAP_FloatOfTerm(t);
if (dbl - (long)dbl == 0.0) {
*i = (long)dbl;
return 1;
}
}
return 0;
}
*i = YAP_IntOfTerm(t);
return 1;
}
X_API int PL_get_int64(term_t ts, int64_t *i) /** @brief t unifies with the true/false value in a.
{ *
#if SIZE_OF_INT_P==8 */
return PL_get_long(ts, (long *)i);
#else
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (!YAP_IsIntTerm(t) ) {
if (YAP_IsFloatTerm(t)) {
double dbl = YAP_FloatOfTerm(t);
if (dbl - (int64_t)dbl == 0.0) {
*i = (int64_t)dbl;
return 1;
}
#if USE_GMP
} else if (YAP_IsBigNumTerm(t)) {
MP_INT g;
char s[64];
YAP_BigNumOfTerm(t, (void *)&g);
if (mpz_sizeinbase(&g,2) > 64) {
return 0;
}
mpz_get_str (s, 10, &g);
#ifdef _WIN32
sscanf(s, "%I64d", (long long int *)i);
#else
sscanf(s, "%lld", (long long int *)i);
#endif
return 1;
#endif
}
return 0;
}
*i = YAP_IntOfTerm(t);
return 1;
#endif
}
X_API int PL_unify_bool(term_t t, int a) X_API int PL_unify_bool(term_t t, int a)
{ {
CACHE_REGS CACHE_REGS
@ -550,18 +709,6 @@ X_API int PL_unify_mpq(term_t t, mpq_t mpq)
#endif #endif
X_API int PL_get_list(term_t ts, term_t h, term_t tl)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsVarTerm(t) || !IsPairTerm(t) ) {
return 0;
}
Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(tl,TailOfTerm(t) PASS_REGS);
return 1;
}
/* SWI: int PL_get_module(term_t t, module_t *m) */ /* SWI: int PL_get_module(term_t t, module_t *m) */
X_API int PL_get_module(term_t ts, module_t *m) X_API int PL_get_module(term_t ts, module_t *m)
{ {
@ -585,34 +732,6 @@ X_API module_t PL_new_module(atom_t swiat)
return Yap_GetModuleEntry(t); return Yap_GetModuleEntry(t);
} }
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_name_arity(term_t ts, atom_t *name, int *arity)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (IsAtomTerm(t)) {
*name = AtomToSWIAtom(AtomOfTerm(t));
*arity = 0;
return 1;
}
if (YAP_IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
return 0;
}
*name = AtomToSWIAtom(NameOfFunctor(f));
*arity = ArityOfFunctor(f);
return 1;
}
if (YAP_IsPairTerm(t)) {
*name = AtomToSWIAtom(AtomDot);
*arity = 2;
return 1;
}
return 0;
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a) /* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */ YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_nil(term_t ts) X_API int PL_get_nil(term_t ts)
@ -913,7 +1032,18 @@ X_API int PL_put_int64(term_t t, int64_t n)
Yap_PutInSlot(t,YAP_MkBigNumTerm((void *)&rop) PASS_REGS); Yap_PutInSlot(t,YAP_MkBigNumTerm((void *)&rop) PASS_REGS);
return TRUE; return TRUE;
#else #else
return FALSE; // use a double, but will mess up writing.
Int x = n;
if (x == n)
return PL_put_integer(t, x);
else {
union {
int64_t i;
double d;
} udi_;
udi_.i = n;
return PL_put_float(t, udi_.d);
}
#endif #endif
} }
@ -1134,8 +1264,15 @@ X_API int PL_unify_int64(term_t t, int64_t n)
#else #else
if ((long)n == n) if ((long)n == n)
return PL_unify_integer(t, n); return PL_unify_integer(t, n);
fprintf(stderr,"Error in PL_unify_int64: please install GMP\n"); // use a double, but will mess up writing.
return FALSE; else {
union {
int64_t i;
double d;
} udi_;
udi_.i = n;
return PL_unify_float(t, udi_.d);
}
#endif #endif
} }
@ -1492,8 +1629,21 @@ int PL_unify_termv(term_t l, va_list ap)
*pt++ = YAP_MkBigNumTerm((void *)&rop); *pt++ = YAP_MkBigNumTerm((void *)&rop);
} }
#else #else
fprintf(stderr, "PL_unify_term: PL_int64 not supported\n"); {
exit(1); int64_t i = (Int)va_arg(ap, int64_t);
intptr_t x = i;
if (x == i)
*pt++ = MkIntegerTerm( x );
else {
// use a double, but will mess up writing.
union {
int64_t i;
double d;
} udi_;
udi_.i = i;
*pt++ = MkFloatTerm(udi_.d);
}
}
#endif #endif
break; break;
case PL_FUNCTOR: case PL_FUNCTOR:
@ -2406,13 +2556,15 @@ X_API int PL_is_inf(term_t st)
{ {
CACHE_REGS CACHE_REGS
Term t = Deref(Yap_GetFromSlot(st PASS_REGS)); Term t = Deref(Yap_GetFromSlot(st PASS_REGS));
Float fl;
if (IsVarTerm(t)) return FALSE; if (IsVarTerm(t)) return FALSE;
if (!IsFloatTerm(t)) return FALSE; if (!IsFloatTerm(t)) return FALSE;
fl = FloatOfTerm(t);
#if HAVE_ISINF #if HAVE_ISINF
Float fl;
fl = FloatOfTerm(t);
return isinf(fl); return isinf(fl);
#elif HAVE_FPCLASS #elif HAVE_FPCLASS
Float fl;
fl = FloatOfTerm(t);
return (fpclass(fl) == FP_NINF || fpclass(fl) == FP_PINF); return (fpclass(fl) == FP_NINF || fpclass(fl) == FP_PINF);
#else #else
return FALSE; return FALSE;