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

more changes to support SWI Input/Output. Now it compiles, which does

Browse Source 
not mean it would work!
This commit is contained in:
Vítor Santos Costa 2008-12-22 12:03:14 +00:00
parent 60b899ee4d
commit 43e70f2003
13 changed files with 208 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
C/c_interface.c
View File

@ -1065,6 +1065,18 @@ YAP_PutInSlot(long slot, Term t)
}
typedef enum
{ FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
typedef struct context
{ int * context; /* context value */
frg_code control; /* FRG_* action */
struct PL_local_data *engine; /* invoking engine */
} scontext ;
typedef Int (*CPredicate1)(long);
typedef Int (*CPredicate2)(long,long);
typedef Int (*CPredicate3)(long,long,long);
@ -1073,10 +1085,17 @@ typedef Int (*CPredicate5)(long,long,long,long,long);
typedef Int (*CPredicate6)(long,long,long,long,long,long);
typedef Int (*CPredicate7)(long,long,long,long,long,long,long);
typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long);
typedef Int (*CPredicateV)(Int,Int,struct context *);
Int
YAP_Execute(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & CArgsPredFlag) {
CPredicateV codev = exec_code;
struct context ctx;
return ((codev)((&ARG1)-LCL0,0,&ctx));
}
if (pe->PredFlags & CArgsPredFlag) {
switch (pe->ArityOfPE) {
case 0:

1
C/init.c
View File

@ -1317,6 +1317,7 @@ InitCodes(void)
Yap_heap_regs->functor_clist = Yap_MkFunctor(Yap_FullLookupAtom("$when"), 4);
Yap_heap_regs->functor_comma = Yap_MkFunctor(AtomComma, 2);
Yap_heap_regs->functor_csult = Yap_MkFunctor(AtomCsult, 1);
Yap_heap_regs->functor_dot = Yap_MkFunctor(AtomDot, 2);
Yap_heap_regs->functor_eq = Yap_MkFunctor(AtomEq, 2);
Yap_heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_in_mod"), 2);
Yap_heap_regs->functor_execute2_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_wo_mod"), 2);

1
C/tracer.c
View File

@ -396,7 +396,6 @@ volatile int vsc_wait;
static Int p_vsc_wait(void)
{
fprintf(stderr,"attach %d\n",(int)getpid());
while (!vsc_wait);
vsc_wait=1;
return(TRUE);

2
H/Heap.h
View File

@ -463,6 +463,7 @@ typedef struct various_codes {
functor_creep,
functor_csult,
functor_cut_by,
functor_dot,
functor_eq,
functor_execute_in_mod,
functor_execute2_in_mod,
@ -778,6 +779,7 @@ extern struct various_codes *Yap_heap_regs;
#define FunctorCreep Yap_heap_regs->functor_creep
#define FunctorCsult Yap_heap_regs->functor_csult
#define FunctorCutBy Yap_heap_regs->functor_cut_by
#define FunctorDot Yap_heap_regs->functor_dot
#define FunctorEq Yap_heap_regs->functor_eq
#define FunctorExecuteInMod Yap_heap_regs->functor_execute_in_mod
#define FunctorExecute2InMod Yap_heap_regs->functor_execute2_in_mod

1
H/Yatom.h
View File

@ -665,6 +665,7 @@ typedef enum
ProfiledPredFlag = 0x00000010L, /* pred is being profiled */
MyddasPredFlag = 0x00000008L, /* Myddas Imported pred */
ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */
SWIEnvPredFlag = 0x00000002L /* new SWI interface */
} pred_flag;
/* profile data */

1
H/rheap.h
View File

@ -904,6 +904,7 @@ restore_codes(void)
Yap_heap_regs->functor_comma = FuncAdjust(Yap_heap_regs->functor_comma);
Yap_heap_regs->functor_creep = FuncAdjust(Yap_heap_regs->functor_creep);
Yap_heap_regs->functor_csult = FuncAdjust(Yap_heap_regs->functor_csult);
Yap_heap_regs->functor_dot = FuncAdjust(Yap_heap_regs->functor_dot);
Yap_heap_regs->functor_eq = FuncAdjust(Yap_heap_regs->functor_eq);
Yap_heap_regs->functor_execute_in_mod = FuncAdjust(Yap_heap_regs->functor_execute_in_mod);
Yap_heap_regs->functor_execute2_in_mod = FuncAdjust(Yap_heap_regs->functor_execute2_in_mod);

1
Makefile.in
View File

@ -572,6 +572,7 @@ mycb: $(srcdir)/mycb.c
$(CC) $(CFLAGS) $(srcdir)/mycb.c -o mycb
all: startup
(cd LGPL/PLStream; $(MAKE))
@INSTALL_DLLS@ (cd library/random; $(MAKE))
@INSTALL_DLLS@ (cd library/regex; $(MAKE))
@INSTALL_DLLS@ (cd library/rltree; $(MAKE))

4
config.h.in
View File

@ -61,6 +61,7 @@
#undef HAVE_IEEEFP_H
#undef HAVE_IO_H
#undef HAVE_LIMITS_H
#undef HAVE_LOCALE_H
#undef HAVE_MACH_O_DYLD_H
#undef HAVE_MALLOC_H
#undef HAVE_MATH_H
@ -70,6 +71,7 @@
#undef HAVE_NETDB_H
#undef HAVE_NETINET_IN_H
#undef HAVE_PTHREAD_H
#undef HAVE_PWD_H
#undef HAVE_READLINE_READLINE_H
#undef HAVE_REGEX_H
#undef HAVE_SIGINFO_H
@ -91,6 +93,7 @@
#undef HAVE_SYS_TYPES_H
#undef HAVE_SYS_UCONTEXT_H
#undef HAVE_SYS_UN_H
#undef HAVE_SYS_WAIT_H
#undef HAVE_TIME_H
#undef HAVE_UNISTD_H
#undef HAVE_WCTYPE_H
@ -156,6 +159,7 @@
#undef HAVE_FETESTEXCEPT
#undef HAVE_FGETPOS
#undef HAVE_FINITE
#undef HAVE_FTIME
#undef HAVE_GETCWD
#undef HAVE_GETENV
#undef HAVE_GETHOSTBYNAME

18
configure vendored
View File

@ -8284,7 +8284,8 @@ done
for ac_header in malloc.h math.h memory.h mpi.h
for ac_header in locale.h malloc.h math.h memory.h mpi.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -8426,7 +8427,8 @@ done
for ac_header in netdb.h netinet/in.h regex.h
for ac_header in netdb.h netinet/in.h pwd.h regex.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -9279,7 +9281,8 @@ done
for ac_header in sys/ucontext.h sys/un.h
for ac_header in sys/ucontext.h sys/un.h sys/wait.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -14257,7 +14260,8 @@ done
for ac_func in fesettrapenable fgetpos finite getcwd getenv
for ac_func in fesettrapenable fgetpos finite ftime getcwd getenv
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
{ echo "$as_me:$LINENO: checking for $ac_func" >&5
@ -16209,12 +16213,13 @@ mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp
mkdir -p LGPL/chr
mkdir -p LGPL/swi_console
mkdir -p LGPL/PLStream
mkdir -p GPL
mkdir -p GPL/clpqr
mkdir -p GPL/http
mkdir -p cplint
ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile"
ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile LGPL/PLStream/Makefile"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@ -16796,6 +16801,7 @@ do
"GPL/http/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/http/Makefile" ;;
"GPL/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/Makefile" ;;
"cplint/Makefile") CONFIG_FILES="$CONFIG_FILES cplint/Makefile" ;;
"LGPL/PLStream/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/PLStream/Makefile" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
@ -17449,4 +17455,4 @@ fi
make depend
(cd LGPL/PLStream; make depend; cd ../..)

13
configure.in
View File

@ -1020,14 +1020,14 @@ AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(arpa/inet.h ctype.h direct.h dirent.h dlfcn.h)
AC_CHECK_HEADERS(errno.h fcntl.h)
AC_CHECK_HEADERS(fenv.h fpu_control.h ieeefp.h io.h limits.h)
AC_CHECK_HEADERS(malloc.h math.h memory.h mpi.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h regex.h)
AC_CHECK_HEADERS(locale.h malloc.h math.h memory.h mpi.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h pwd.h regex.h)
AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h string.h stropts.h)
AC_CHECK_HEADERS(sys/conf.h sys/file.h)
AC_CHECK_HEADERS(sys/mman.h sys/param.h sys/resource.h sys/select.h)
AC_CHECK_HEADERS(sys/shm.h sys/socket.h sys/stat.h)
AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h)
AC_CHECK_HEADERS(sys/ucontext.h sys/un.h)
AC_CHECK_HEADERS(sys/ucontext.h sys/un.h sys/wait.h)
AC_CHECK_HEADERS(time.h unistd.h wctype.h winsock.h winsock2.h)
AC_CHECK_HEADERS(mach-o/dyld.h)
if test "$yap_cv_gmp" != "no"
@ -1290,7 +1290,7 @@ fi
dnl Checks for library functions.
AC_TYPE_SIGNAL
AC_CHECK_FUNCS(acosh asinh atanh chdir ctime dlopen dup2)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite getcwd getenv)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite ftime getcwd getenv)
AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
AC_CHECK_FUNCS(isatty isnan kill labs link lgamma)
@ -1450,12 +1450,13 @@ mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp
mkdir -p LGPL/chr
mkdir -p LGPL/swi_console
mkdir -p LGPL/PLStream
mkdir -p GPL
mkdir -p GPL/clpqr
mkdir -p GPL/http
mkdir -p cplint
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile)
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile LGPL/PLStream/Makefile)
make depend
(cd LGPL/PLStream; make depend; cd ../..)

58
include/SWI-Prolog.h
View File

@ -13,11 +13,6 @@
#ifndef _FLI_H_INCLUDED
#define _FLI_H_INCLUDED
#ifndef __SWI_PROLOG__ /* use this to switch on Prolog dialect */
#define __SWI_PROLOG__ /* normally defined by the plld compiler driver */
#endif
//=== includes ===============================================================
#include "config.h"
#include <YapInterface.h>
@ -36,6 +31,46 @@
#endif
#endif
/*******************************
* EXPORT *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
See SWI-Prolog.h, containing the same code for an explanation on this
stuff.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
typedef int bool;
typedef unsigned long term_t;
typedef void *module_t;
typedef void *record_t;
@ -83,6 +118,7 @@ typedef void *PL_engine_t;
#define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */
#define PL_FA_VARARGS (0x08) /* call using t0, ac, ctx */
#define PL_FA_CREF (0x10) /* Internal: has clause-reference */
#define PL_FA_ISO (0x20) /* Internal: ISO core predicate */
/* begin from pl-itf.h */
#define PL_VARIABLE (1) /* nothing */
@ -163,6 +199,13 @@ consistent with the definitions in pl-itf.h, which is included with
users foreign language code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define NOTRACE PL_FA_NOTRACE
#define META PL_FA_TRANSPARENT
#define NDET PL_FA_NONDETERMINISTIC
#define VA PL_FA_VARARGS
#define CREF PL_FA_CREF
#define ISO PL_FA_ISO
typedef enum
{ FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
@ -223,6 +266,8 @@ typedef struct foreign_context *control_t;
#define ForeignContextPtr(h) ((void *)(h)->context)
#define ForeignEngine(h) ((h)->engine)
#define FRG(n, a, f, flags) { n, a, f, flags }
/* end from pl-itf.h */
/*******************************
@ -240,9 +285,6 @@ typedef struct foreign_context *control_t;
#define PL_Q_DETERMINISTIC 0x20 /* call was deterministic */
#endif
/* copied from old SICStus/SWI interface */
typedef void install_t;
#define PL_fail return FALSE /* fail */
#define PL_succeed return TRUE /* success */

33
include/SWI-Stream.h
View File

@ -2,17 +2,34 @@
#ifndef _PL_STREAM_H
#define _PL_STREAM_H
#ifndef X_API
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifndef PL_EXPORT
#define PL_EXPORT(type) extern X_API type
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
/* This appears to make the wide-character support compile and work
on HPUX 11.23. There really should be a cleaner way ...

115
library/yap2swi/yap2swi.c
View File

@ -52,6 +52,18 @@ SWIAtomToAtom(atom_t at)
return (Atom)at;
}
static inline functor_t
FunctorToSWIFunctor(Functor at)
{
return (functor_t)at;
}
static inline Functor
SWIFunctorToFunctor(functor_t at)
{
return (Functor)at;
}
static void
PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
{
@ -86,6 +98,23 @@ UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mo
CurrentModule = cm;
}
static void
UserCPredicateVarargs(char *a, CPredicate def, unsigned long int arity, Term mod)
{
PredEntry *pe;
Term cm = CurrentModule;
CurrentModule = mod;
Yap_InitCPred(a, arity, def, UserCPredFlag);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a),mod));
} else {
Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
pe->PredFlags |= SWIEnvPredFlag;
CurrentModule = cm;
}
char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS];
static int buf_index = 0;
@ -381,7 +410,7 @@ X_API int PL_get_functor(term_t ts, functor_t *f)
if ( IsAtomTerm(t)) {
*f = t;
} else {
*f = (functor_t)YAP_FunctorOfTerm(t);
*f = FunctorToSWIFunctor(FunctorOfTerm(t));
}
return 1;
}
@ -669,9 +698,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
functor_t f;
Atom at = SWIAtomToAtom(name);
if (arity == 0) {
f = (functor_t)MkAtomTerm(at);
f = FunctorToSWIFunctor((Functor)MkAtomTerm(at));
} else {
f = (functor_t)Yap_MkFunctor(at,arity);
f = FunctorToSWIFunctor(Yap_MkFunctor(at,arity));
}
return f;
}
@ -679,9 +708,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
X_API atom_t PL_functor_name(functor_t f)
{
if (IsAtomTerm(f)) {
return AtomToSWIAtom(AtomOfTerm(f));
return AtomToSWIAtom(AtomOfTerm((Term)SWIFunctorToFunctor(f)));
} else {
return AtomToSWIAtom(NameOfFunctor((Functor)f));
return AtomToSWIAtom(NameOfFunctor(SWIFunctorToFunctor(f)));
}
}
@ -690,7 +719,7 @@ X_API int PL_functor_arity(functor_t f)
if (IsAtomTerm(f)) {
return 0;
} else {
return YAP_ArityOfFunctor((YAP_Functor)f);
return ArityOfFunctor(SWIFunctorToFunctor(f));
}
}
@ -703,12 +732,13 @@ X_API void PL_cons_functor(term_t d, functor_t f,...)
va_list ap;
int arity, i;
YAP_Term *tmp = (YAP_CELL *)buffers;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((YAP_Term)f)) {
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d, (YAP_Term)f);
return;
}
arity = YAP_ArityOfFunctor((YAP_Functor)f);
arity = ArityOfFunctor(ff);
if (arity > TMP_BUF_SIZE/sizeof(YAP_CELL)) {
fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity);
return;
@ -718,25 +748,26 @@ X_API void PL_cons_functor(term_t d, functor_t f,...)
tmp[i] = Yap_GetFromSlot(va_arg(ap, term_t));
}
va_end (ap);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2))
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,YAP_MkPairTerm(tmp[0],tmp[1]));
else
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,tmp));
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)ff,arity,tmp));
}
X_API void PL_cons_functor_v(term_t d, functor_t f,term_t a0)
{
int arity;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm(f)) {
Yap_PutInSlot(d,(YAP_Term)f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d,(Term)ff);
return;
}
arity = YAP_ArityOfFunctor((YAP_Functor)f);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2))
arity = ArityOfFunctor(ff);
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,YAP_MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1)));
else
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(a0)));
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)ff,arity,YAP_AddressFromSlot(a0)));
}
X_API void PL_cons_list(term_t d, term_t h, term_t t)
@ -762,14 +793,16 @@ X_API void PL_put_float(term_t t, double fl)
X_API void PL_put_functor(term_t t, functor_t f)
{
long int arity;
if (IsAtomTerm(f)) {
Yap_PutInSlot(t,f);
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(t,(Term)ff);
} else {
arity = YAP_ArityOfFunctor((YAP_Functor)f);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2))
arity = ArityOfFunctor(ff);
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(t,YAP_MkNewPairTerm());
else
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)f,arity));
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity));
}
}
@ -910,11 +943,14 @@ X_API int PL_unify_integer(term_t t, long n)
X_API int PL_unify_functor(term_t t, functor_t f)
{
YAP_Term tt = Yap_GetFromSlot(t);
Functor ff = SWIFunctorToFunctor(f);
if (YAP_IsVarTerm(tt))
return YAP_Unify(tt, YAP_MkNewApplTerm((YAP_Functor)f,YAP_ArityOfFunctor((YAP_Functor)f)));
return YAP_Unify(tt, YAP_MkNewApplTerm((YAP_Functor)ff,YAP_ArityOfFunctor((YAP_Functor)f)));
if (YAP_IsPairTerm(tt))
return ff == FunctorDot;
if (!YAP_IsApplTerm(tt))
return FALSE;
return f == (functor_t)YAP_FunctorOfTerm(tt);
return ff == FunctorOfTerm(tt);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
@ -1144,18 +1180,19 @@ get_term(arg_types **buf)
functor_t f = ptr->arg.f;
long int arity, i;
term_t loc;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((YAP_Term)f)) {
t = (YAP_Term)f;
if (IsAtomTerm((Term)ff)) {
t = (Term)ff;
break;
}
arity = YAP_ArityOfFunctor((YAP_Functor)f);
arity = YAP_ArityOfFunctor((YAP_Functor)ff);
loc = Yap_NewSlots(arity);
ptr++;
for (i= 0; i < arity; i++) {
Yap_PutInSlot(loc+i,get_term(&ptr));
}
t = YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(loc));
t = YAP_MkApplTerm((YAP_Functor)ff,arity,YAP_AddressFromSlot(loc));
}
break;
case PL_LIST:
@ -1230,9 +1267,10 @@ X_API int PL_unify_term(term_t l,...)
case PL_FUNCTOR:
{
functor_t f = va_arg(ap, functor_t);
Functor ff = SWIFunctorToFunctor(f);
ptr->arg.f = f;
if (!IsAtomTerm((YAP_Term)f)) {
nels += YAP_ArityOfFunctor((YAP_Functor)f);
if (!IsAtomTerm((YAP_Term)ff)) {
nels += YAP_ArityOfFunctor((YAP_Functor)ff);
}
}
break;
@ -1309,10 +1347,11 @@ X_API int PL_is_compound(term_t ts)
X_API int PL_is_functor(term_t ts, functor_t f)
{
YAP_Term t = Yap_GetFromSlot(ts);
Functor ff = SWIFunctorToFunctor(f);
if (YAP_IsApplTerm(t)) {
return YAP_FunctorOfTerm(t) == (YAP_Functor)f;
return FunctorOfTerm(t) == (Functor)ff;
} else if (YAP_IsPairTerm(t)) {
return FunctorOfTerm(t) == Yap_MkFunctor(AtomDot,2);
return FunctorOfTerm(t) == FunctorDot;
} else
return 0;
}
@ -1541,11 +1580,11 @@ X_API atom_t PL_module_name(module_t m)
X_API predicate_t PL_pred(functor_t f, module_t m)
{
if (IsAtomTerm(f)) {
return YAP_Predicate(YAP_AtomOfTerm(f),0,(YAP_Module)m);
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)f)) {
return YAP_Predicate(YAP_AtomOfTerm((Term)f),0,(YAP_Module)m);
} else {
YAP_Functor tf = (YAP_Functor)f;
return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),(YAP_Module)m);
return YAP_Predicate((YAP_Atom)NameOfFunctor(ff),ArityOfFunctor(ff),(YAP_Module)m);
}
}
@ -1670,7 +1709,9 @@ X_API void PL_register_extensions(PL_extension *ptr)
YAP_Error(0,YAP_MkIntTerm(ptr->flags),"non-implemented flag %x when creating predicates", ptr->flags);
return;
}
if (ptr->flags & PL_FA_TRANSPARENT)
if (ptr->flags & PL_FA_VARARGS)
UserCPredicateVarargs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (ptr->flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
@ -1684,7 +1725,9 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
YAP_Error(0,YAP_MkIntTerm(flags),"non-implemented flag %x when creating predicates", flags);
return;
}
if (flags & PL_FA_TRANSPARENT)
if (flags & PL_FA_VARARGS)
UserCPredicateVarargs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (module == NULL)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,YAP_CurrentModule());