more changes to support SWI Input/Output. Now it compiles, which does
not mean it would work!
This commit is contained in:
Vítor Santos Costa
parent
60b899ee4d
commit
43e70f2003
@ -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
1
C/init.c
@ -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);
|
||||
|
||||
@ -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
2
H/Heap.h
@ -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
|
||||
|
||||
@ -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 */
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
18
configure
vendored
@ -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
13
configure.in
@ -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 ../..)
|
||||
|
||||
@ -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 */
|
||||
|
||||
|
||||
@ -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
|
||||
#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*/
|
||||
|
||||
/* This appears to make the wide-character support compile and work
|
||||
on HPUX 11.23. There really should be a cleaner way ...
|
||||
|
||||
@ -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,12 +1725,14 @@ 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)
|
||||
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());
|
||||
else
|
||||
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom((char *)module)));
|
||||
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());
|
||||
else
|
||||
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom((char *)module)));
|
||||
}
|
||||
|
||||
X_API void PL_load_extensions(PL_extension *ptr)
|
||||
|
||||
Reference in New Issue
Block a user