indenting; warning; exceptions; small fixes

This commit is contained in:
Vítor Santos Costa 2016-03-29 02:02:43 +01:00
parent 6bc4acec15
commit f3e8b8b3da
51 changed files with 2220 additions and 2221 deletions

View File

@ -565,6 +565,8 @@ macro_optional_find_package (MPI OFF)
endif (MPI_C_FOUND)
## add_subDIRECTORY(utils)
add_custom_target (main ALL DEPENDS ${YAP_STARTUP} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )
#
# include subdirectories configuration
@ -590,6 +592,7 @@ install (
)
macro_display_feature_log()
if(POLICY CMP0058)
cmake_policy(SET CMP0058 NEW)

View File

@ -12,7 +12,7 @@ extern "C" {
void YAP_UserCPredicate(const char *, YAP_UserCPred, YAP_Arity arity);
void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term);
void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int);
void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
}
@ -512,9 +512,7 @@ void YAPQuery::close()
CACHE_REGS
RECOVER_MACHINE_REGS();
if (EX /* && !(q_flags & (true PL_Q_CATCH_EXCEPTION)) */) {
EX = (struct DB_TERM *)NULL;
}
Yap_ResetException(worker_id);
/* need to implement backtracking here */
if (q_open != 1 || q_state == 0) {
RECOVER_MACHINE_REGS();

View File

@ -74,7 +74,7 @@ extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, Y
/* void UserBackCPredicate(const char *name, int *init(), int *cont(), int
arity, int extra) */
extern void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int);
extern void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p);

View File

@ -11,7 +11,7 @@
* interface to a YAP Query;
* uses an SWI-like status info internally.
*/
class YAPQuery: public YAPPredicate, open_query_struct {
class YAPQuery: public YAPPredicate, public open_query_struct {
YAPListTerm vnames;
YAPTerm goal;
Term names;

View File

@ -121,7 +121,6 @@ typedef struct regstore_t
CELL *AuxSp_; /* 9 Auxiliary stack pointer */
ADDR AuxTop_; /* 10 Auxiliary stack top */
/* visualc*/
struct DB_TERM * EX_; /* 18 */
Term CurrentModule_;
struct myddas_global *MYDDAS_GLOBAL_POINTER;
#if defined(YAPOR_SBA) || defined(TABLING)
@ -641,7 +640,6 @@ INLINE_ONLY EXTERN inline void restore_B(void) {
#define AuxSp Yap_REGS.AuxSp_
#define AuxTop Yap_REGS.AuxTop_
#define CurrentTrailTop Yap_REGS.CurrentTrailTop_
#define EX Yap_REGS.EX_
#define DEPTH Yap_REGS.DEPTH_
#if defined(YAPOR_SBA) || defined(TABLING)
#define H_FZ Yap_REGS.H_FZ_

459
H/Yap.h
View File

@ -21,20 +21,28 @@
// #error Do not explicitly define YAPOR
#endif /* YAPOR */
#if (defined(YAPOR_COPY) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || (defined(YAPOR_COW) && (defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || (defined(YAPOR_SBA) && defined(YAPOR_THREADS))
#if (defined(YAPOR_COPY) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || \
(defined(YAPOR_COW) && (defined(YAPOR_SBA) || defined(YAPOR_THREADS))) || \
(defined(YAPOR_SBA) && defined(YAPOR_THREADS))
#error Do not define multiple or-parallel models
#endif /* (YAPOR_COPY && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_COW && (YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_SBA || YAPOR_THREADS) */
#endif /* (YAPOR_COPY && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS)) || \
(YAPOR_COW && (YAPOR_SBA || YAPOR_THREADS)) || (YAPOR_SBA || \
YAPOR_THREADS) */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
defined(YAPOR_THREADS)
#define YAPOR 1
#define FIXED_STACKS 1
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
#if defined(TABLING) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))
#if defined(TABLING) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS))
#error TABLING only works with YAPOR_COPY
#endif /* TABLING && (YAPOR_COW || YAPOR_SBA || YAPOR_THREADS) */
#if defined(THREADS) && (defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_COPY))
#if defined(THREADS) && \
(defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_COPY))
#error THREADS only works with YAPOR_THREADS
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
@ -66,7 +74,6 @@
#include <stdint.h>
#endif
/*
#define RATIONAL_TREES 1
@ -104,31 +111,31 @@
#endif /* COROUTINING && !TERM_EXTENSIONS */
/**
* Stolen from Mozzila, this code should deal with bad implementations of stdc++.
* Stolen from Mozzila, this code should deal with bad implementations of
* stdc++.
*
* Use C++11 nullptr if available; otherwise use a C++ typesafe template; and
* for C, fall back to longs. See bugs 547964 and 626472.
*/
#if !defined(nullptr) && !defined(HAVE_NULLPTR)
#ifndef __cplusplus
# define nullptr ((void*)0)
#define nullptr NULL
#elif defined(__GNUC__)
# define nullptr __null
#define nullptr __null
#elif defined(_WIN64)
# define nullptr 0LL
#define nullptr 0LL
#else
# define nullptr 0L
#define nullptr 0L
#endif
#endif /* defined(HAVE_NULLPTR) */
/* Microsoft's Visual C++ Compiler */
#ifdef _MSC_VER /* adjust a config.h from mingw32 to work with vc++ */
#ifdef _MSC_VER /* adjust a config.h from mingw32 to work with vc++ */
#ifdef HAVE_GCC
#undef HAVE_GCC
#endif /* HAVE_GCC */
#ifdef USE_THREADED_CODE
#undef USE_THREADED_CODE
#ifdef USE_THREADED_CODE
#undef USE_THREADED_CODE
#endif /* USE_THREADED_CODE */
#define inline __inline
#define YAP_VERSION "YAP-6.3.4"
@ -169,8 +176,7 @@
#endif /* HAVE_GCC */
/* funcions that return a generic pointer */
typedef void * (*fptr_t)(void);
typedef void *(*fptr_t)(void);
/*************************************************************************************************
main exports in YapInterface.h
@ -183,37 +189,34 @@ typedef void * (*fptr_t)(void);
/* expect controls the direction of branches */
#ifdef HAVE___BUILTIN_EXPECT
#define likely(x) __builtin_expect((x), 1)
#define unlikely(x) __builtin_expect((x), 0)
#define likely(x) __builtin_expect((x), 1)
#define unlikely(x) __builtin_expect((x), 0)
#else
#define likely(x) (x)
#define unlikely(x) (x)
#define likely(x) (x)
#define unlikely(x) (x)
#endif
#ifdef THREADS
#if USE_PTHREAD_LOCKING
#ifndef _XOPEN_SOURCE
#define _XOPEN_SOURCE 600
#endif /* !_XOPEN_SOURCE */
#endif /* !_XOPEN_SOURCE */
#endif /* USE_PTHREAD_LOCKING */
#include <pthread.h>
#endif /* THREADS */
/* null pointer */
#define NIL 0
#define NIL 0
/* Basic types */
#if HAVE_SIGPROF && (defined(__linux__) || defined(__APPLE__))
#if HAVE_SIGPROF && (defined(__linux__) || defined(__APPLE__))
#define LOW_PROF 1
#endif
#if !defined(HAVE_STRNLEN)
INLINE_ONLY inline EXTERN size_t
strnlen(const char *s, size_t maxlen);
INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen);
INLINE_ONLY inline EXTERN size_t
strnlen(const char *s, size_t maxlen)
{
INLINE_ONLY inline EXTERN size_t strnlen(const char *s, size_t maxlen) {
size_t i = 0;
while (s[i]) {
if (i == maxlen)
@ -232,7 +235,8 @@ strnlen(const char *s, size_t maxlen)
#endif /* FORCE_SECOND_QUADRANT */
#if !defined(IN_SECOND_QUADRANT)
#if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(mips) || (__DragonFly__)
#if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || \
defined(mips) || (__DragonFly__)
#if defined(YAPOR) && defined(__alpha)
#define MMAP_ADDR 0x40000000
@ -245,35 +249,37 @@ strnlen(const char *s, size_t maxlen)
#endif /* YAPOR && __alpha */
#elif __svr4__ || defined(__SVR4)
#define MMAP_ADDR 0x02000000
#endif /* __linux__ || __FreeBSD__ || __NetBSD__ || mips || __APPLE__ || __DragonFly__ */
#endif /* __linux__ || __FreeBSD__ || __NetBSD__ || mips || __APPLE__ || \
__DragonFly__ */
#endif /* !IN_SECOND_QUADRANT */
/* #define RANDOMIZE_START_ADDRESS 1 */
#ifdef USE_SYSTEM_MALLOC
#define HEAP_INIT_BASE 0L
#define AtomBase NULL
#define HEAP_INIT_BASE 0L
#define AtomBase NULL
#else /* !USE_SYSTEM_MALLOC */
#if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && !defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS)
#define HEAP_INIT_BASE (MMAP_ADDR)
#define AtomBase ((char *)MMAP_ADDR)
#else /*! (MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS) */
#define HEAP_INIT_BASE ((CELL)Yap_HeapBase)
#define AtomBase (Yap_HeapBase)
#endif /* MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && !RANDOMIZE_START_ADDRESS */
#if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && \
!defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS)
#define HEAP_INIT_BASE (MMAP_ADDR)
#define AtomBase ((char *)MMAP_ADDR)
#else /*! (MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && \
!RANDOMIZE_START_ADDRESS) */
#define HEAP_INIT_BASE ((CELL)Yap_HeapBase)
#define AtomBase (Yap_HeapBase)
#endif /* MMAP_ADDR && (USE_MMAP || USE_SHMAT) && !__simplescalar__ && \
!RANDOMIZE_START_ADDRESS */
#endif /* USE_SYSTEM_MALLOC */
#ifndef ALIGN_LONGS
#define ALIGN_LONGS 1
#endif
#define K1 ((CELL)1024)
#define K16 ((CELL)(1024*64))
#define K64 ((CELL)(1024*64))
#define M1 ((CELL)(1024*1024))
#define M2 ((CELL)(2048*1024))
#define K1 ((CELL)1024)
#define K16 ((CELL)(1024 * 64))
#define K64 ((CELL)(1024 * 64))
#define M1 ((CELL)(1024 * 1024))
#define M2 ((CELL)(2048 * 1024))
#if ALIGN_LONGS
typedef CELL SFLAGS;
@ -285,17 +291,16 @@ typedef char *ADDR;
typedef CELL OFFSET;
typedef unsigned char *CODEADDR;
#define TermPtr(V) ((Term *)(V))
#define Addr(V) ((ADDR)(V))
#define TermPtr(V) ((Term *) (V))
#define Addr(V) ((ADDR) (V))
#define CodePtr(V) ((CODEADDR)(V))
#define CellPtr(V) ((CELL *)(V))
#define OpCodePtr(V) ((OPCODE *)(V))
#define OpRegPtr(V) ((OPREG *)(V))
#define SmallPtr(V) ((SMALLUNSGN *)(V))
#define WordPtr(V) ((BITS16 *)(V))
#define DisplPtr(V) ((DISPREG *)(V))
#define CodePtr(V) ((CODEADDR)(V))
#define CellPtr(V) ((CELL *)(V))
#define OpCodePtr(V) ((OPCODE *)(V))
#define OpRegPtr(V) ((OPREG *)(V))
#define SmallPtr(V) ((SMALLUNSGN *)(V))
#define WordPtr(V) ((BITS16 *)(V))
#define DisplPtr(V) ((DISPREG *)(V))
#if !defined(YAPOR) && !defined(THREADS)
#include <nolocks.h>
@ -305,7 +310,6 @@ typedef unsigned char *CODEADDR;
#define _XOPEN_SOURCE 600
#endif
#include <locks_pthread.h>
typedef pthread_mutex_t lockvar;
typedef pthread_rwlock_t rwlock_t;
@ -335,21 +339,22 @@ typedef volatile int lockvar;
#define FUNC_WRITE_LOCK(X) WRITE_LOCK((X)->FRWLock)
#define FUNC_WRITE_UNLOCK(X) WRITE_UNLOCK((X)->FRWLock)
/*************************************************************************************************
use an auxiliary function for ranges
*************************************************************************************************/
#ifdef __GNUC__
#define IN_BETWEEN(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) <= \
Unsigned((Int)(MAX)-(Int)(MIN)) )
#define IN_BETWEEN(MIN, X, MAX) \
(Unsigned((Int)(X) - (Int)(MIN)) <= Unsigned((Int)(MAX) - (Int)(MIN)))
#define OUTSIDE(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) > \
Unsigned((Int)(MAX)-(Int)(MIN)) )
#define OUTSIDE(MIN, X, MAX) \
(Unsigned((Int)(X) - (Int)(MIN)) > Unsigned((Int)(MAX) - (Int)(MIN)))
#else
#define IN_BETWEEN(MIN,X,MAX) ((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX))
#define IN_BETWEEN(MIN, X, MAX) \
((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX))
#define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX))
#define OUTSIDE(MIN, X, MAX) \
((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX))
#endif
/*************************************************************************************************
@ -362,7 +367,6 @@ typedef volatile int lockvar;
Coroutining
*************************************************************************************************/
#ifdef COROUTINING
/* Support for co-routining */
#include "corout.h"
@ -382,10 +386,12 @@ typedef volatile int lockvar;
#if defined(YAPOR) || defined(TABLING)
#include "opt.structs.h"
#include "opt.proto.h"
#include "opt.macros.h"
#endif /* YAPOR || TABLING */
#include "opt.proto.h"
#include "opt.macros.h"
#endif /* YAPOR || TABLING */
/*************************************************************************************************
variables concerned with Error Handling
@ -404,8 +410,7 @@ typedef volatile int lockvar;
#include "YapError.h"
typedef enum
{
typedef enum {
GPROF_NO_EVENT,
GPROF_NEW_PRED_FUNC,
GPROF_NEW_PRED_THREAD,
@ -432,7 +437,6 @@ typedef enum
#define MAX_EMPTY_WAKEUPS 16
/*************************************************************************************************
prototypes
*************************************************************************************************/
@ -441,7 +445,7 @@ typedef enum
#include "YapTags.h"
#define TermSize sizeof(Term)
#define TermSize sizeof(Term)
/*************************************************************************************************
variables related to memory allocation
@ -463,48 +467,45 @@ extern ADDR Yap_HeapBase;
extern int Yap_output_msg;
#endif
#if __ANDROID__
#include <jni.h>
#include <android/asset_manager.h>
#include <android/asset_manager_jni.h>
#include <android/log.h>
#include <jni.h>
extern AAssetManager * Yap_assetManager;
extern AAssetManager *Yap_assetManager;
extern void *Yap_openAssetFile( const char *path ) ;
extern bool Yap_isAsset( const char *path );
extern bool Yap_AccessAsset( const char *name , int mode);
extern bool Yap_AssetIsFile( const char *name );
extern bool Yap_AssetIsDir( const char *name );
extern int64_t Yap_AssetSize( const char *name );
extern void *Yap_openAssetFile(const char *path);
extern bool Yap_isAsset(const char *path);
extern bool Yap_AccessAsset(const char *name, int mode);
extern bool Yap_AssetIsFile(const char *name);
extern bool Yap_AssetIsDir(const char *name);
extern int64_t Yap_AssetSize(const char *name);
#endif
/*************************************************************************************************
variables concerned with atoms table
*************************************************************************************************/
#define MaxHash 3333
#define MaxWideHash (MaxHash/10+1)
#define MaxHash 3333
#define MaxWideHash (MaxHash / 10 + 1)
#define FAIL_RESTORE 0
#define FAIL_RESTORE 0
#define DO_EVERYTHING 1
#define DO_ONLY_CODE 2
#define DO_ONLY_CODE 2
/*************************************************************************************************
common instructions codes
*************************************************************************************************/
#define MAX_PROMPT 256
#define MAX_PROMPT 256
#if USE_THREADED_CODE
/*************************************************************************************************
reverse lookup of instructions
*************************************************************************************************/
typedef struct opcode_tab_entry
{
typedef struct opcode_tab_entry {
OPCODE opc;
op_numbers opnum;
} op_entry;
@ -515,102 +516,103 @@ typedef struct opcode_tab_entry
Prolog may be in several modes
*************************************************************************************************/
typedef enum
{
BootMode = 0x1, /* if booting or restoring */
UserMode = 0x2, /* Normal mode */
CritMode = 0x4, /* If we are meddling with the heap */
AbortMode = 0x8, /* expecting to abort */
InterruptMode = 0x10, /* under an interrupt */
InErrorMode = 0x20, /* under an interrupt */
ConsoleGetcMode = 0x40, /* blocked reading from console */
ExtendStackMode = 0x80, /* trying to extend stack */
GrowHeapMode = 0x100, /* extending Heap */
GrowStackMode = 0x200, /* extending Stack */
GCMode = 0x400, /* doing Garbage Collecting */
ErrorHandlingMode = 0x800, /* doing error handling */
CCallMode = 0x1000, /* In c Call */
UnifyMode = 0x2000, /* In Unify Code */
UserCCallMode = 0x4000, /* In User C-call Code */
MallocMode = 0x8000, /* Doing malloc, realloc, free */
SystemMode = 0x10000, /* in system mode */
AsyncIntMode = 0x20000, /* YAP has just been interrupted from the outside */
InReadlineMode = 0x40000 /* YAP has just been interrupted from the outside */
typedef enum {
BootMode = 0x1, /** if booting or restoring */
UserMode = 0x2, /** Normal mode */
CritMode = 0x4, /** If we are meddling with the heap */
AbortMode = 0x8, /** expecting to abort */
InterruptMode = 0x10, /*8 under an interrupt */
InErrorMode = 0x20, /** error handling */
ConsoleGetcMode = 0x40, /** blocked reading from console */
ExtendStackMode = 0x80, /** trying to extend stack */
GrowHeapMode = 0x100, /** extending Heap */
GrowStackMode = 0x200, /** extending Stack */
GCMode = 0x400, /** doing Garbage Collecting */
ErrorHandlingMode = 0x800, /** doing error handling */
CCallMode = 0x1000, /** In c Call */
UnifyMode = 0x2000, /** In Unify Code */
UserCCallMode = 0x4000, /** In User C-call Code */
MallocMode = 0x8000, /** Doing malloc, realloc, free */
SystemMode = 0x10000, /** in system mode */
AsyncIntMode = 0x20000, /** YAP has just been interrupted from the outside */
InReadlineMode =
0x40000, /** YAP has just been interrupted from the outside */
TopGoalMode = 0x40000 /** creating a new autonomous goal */
} prolog_exec_mode;
/*************************************************************************************************
number of modules
*************************************************************************************************/
#define DefaultMaxModules 256
#define DefaultMaxModules 256
/*************************************************************************************************
Critical sections
*************************************************************************************************/
#ifdef YAPOR
#define YAPEnterCriticalSection() \
{ \
if (worker_id != GLOBAL_locks_who_locked_heap) { \
LOCK(GLOBAL_locks_heap_access); \
GLOBAL_locks_who_locked_heap = worker_id; \
} \
LOCAL_PrologMode |= CritMode; \
LOCAL_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_CritLocks--; \
if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \
} \
GLOBAL_locks_who_locked_heap = MAX_WORKERS; \
UNLOCK(GLOBAL_locks_heap_access); \
} \
}
#define YAPEnterCriticalSection() \
{ \
if (worker_id != GLOBAL_locks_who_locked_heap) { \
LOCK(GLOBAL_locks_heap_access); \
GLOBAL_locks_who_locked_heap = worker_id; \
} \
LOCAL_PrologMode |= CritMode; \
LOCAL_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_CritLocks--; \
if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \
} \
GLOBAL_locks_who_locked_heap = MAX_WORKERS; \
UNLOCK(GLOBAL_locks_heap_access); \
} \
}
#elif defined(THREADS)
#define YAPEnterCriticalSection() \
{ \
/* LOCK(BGL); */ \
LOCAL_PrologMode |= CritMode; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \
Yap_RestartYap( 1 ); \
} \
/* UNLOCK(BGL); */ \
}
#define YAPEnterCriticalSection() \
{ \
/* LOCK(BGL); */ \
LOCAL_PrologMode |= CritMode; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_Error(ABORT_EVENT, 0, ""); \
Yap_RestartYap(1); \
} \
/* UNLOCK(BGL); */ \
}
#else
#define YAPEnterCriticalSection() \
{ \
LOCAL_PrologMode |= CritMode;/* printf("%d, %s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \
LOCAL_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_CritLocks--; \
/*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \
if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_RestartYap( 1 ); \
} \
} \
}
#define YAPEnterCriticalSection() \
{ \
LOCAL_PrologMode |= \
CritMode; /* printf("%d, \
%s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \
LOCAL_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
LOCAL_CritLocks--; \
/*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \
if (!LOCAL_CritLocks) { \
LOCAL_PrologMode &= ~CritMode; \
if (LOCAL_PrologMode & AbortMode) { \
LOCAL_PrologMode &= ~AbortMode; \
Yap_RestartYap(1); \
} \
} \
}
#endif /* YAPOR */
/* when we are calling the InitStaff procedures */
#define AT_BOOT 0
#define AT_RESTORE 1
#define AT_BOOT 0
#define AT_RESTORE 1
/*************************************************************************************************
mutable variables
@ -618,63 +620,60 @@ typedef enum
/* I assume that the size of this structure is a multiple of the size
of CELL!!! */
typedef struct TIMED_MAVAR
{
typedef struct TIMED_MAVAR {
CELL value;
CELL clock;
} timed_var;
/*************************************************************************************************
execution mode
*************************************************************************************************/
typedef enum
{
INTERPRETED = 0x1, /* interpreted */
MIXED_MODE_USER = 0x2, /* mixed mode only for user predicates */
MIXED_MODE_ALL = 0x4, /* mixed mode for all predicates */
COMPILE_USER = 0x8, /* compile all user predicates*/
COMPILE_ALL = 0x10 /* compile all predicates */
} yap_exec_mode;
typedef enum {
INTERPRETED = 0x1, /* interpreted */
MIXED_MODE_USER = 0x2, /* mixed mode only for user predicates */
MIXED_MODE_ALL = 0x4, /* mixed mode for all predicates */
COMPILE_USER = 0x8, /* compile all user predicates*/
COMPILE_ALL = 0x10 /* compile all predicates */
} yap_exec_mode;
#define MIXED_MODE ( MIXED_MODE_USER | MIXED_MODE_ALL )
#define MIXED_MODE (MIXED_MODE_USER | MIXED_MODE_ALL)
#define COMPILED ( COMPILE_USER | COMPILE_ALL )
#define COMPILED (COMPILE_USER | COMPILE_ALL)
/************************/
// queues are an example of collections of DB objects
typedef struct queue_entry {
struct queue_entry *next;
struct DB_TERM *DBT;
} QueueEntry;
// queues are an example of collections of DB objects
typedef struct queue_entry {
struct queue_entry *next;
struct DB_TERM *DBT;
} QueueEntry;
typedef struct idb_queue
{
struct FunctorEntryStruct *id; /* identify this as being pointed to by a DBRef */
SMALLUNSGN Flags; /* always required */
#if PARALLEL_YAP
rwlock_t QRWLock; /* a simple lock to protect this entry */
#endif
QueueEntry *FirstInQueue, *LastInQueue;
} db_queue;
typedef struct idb_queue {
struct FunctorEntryStruct
*id; /* identify this as being pointed to by a DBRef */
SMALLUNSGN Flags; /* always required */
#if PARALLEL_YAP
rwlock_t QRWLock; /* a simple lock to protect this entry */
#endif
QueueEntry *FirstInQueue, *LastInQueue;
} db_queue;
void Yap_init_tqueue( db_queue *dbq );
void Yap_destroy_tqueue( db_queue *dbq USES_REGS);
void Yap_init_tqueue(db_queue *dbq);
void Yap_destroy_tqueue(db_queue *dbq USES_REGS);
bool Yap_enqueue_tqueue(db_queue *father_key, Term t USES_REGS);
bool Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first, bool release USES_REGS);
bool Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first,
bool release USES_REGS);
#ifdef THREADS
typedef struct thread_mbox {
Term name;
pthread_mutex_t mutex;
pthread_cond_t cond;
struct idb_queue msgs;
int nmsgs, nclients; // if nclients < 0 mailbox has been closed.
bool open;
struct thread_mbox *next;
Term name;
pthread_mutex_t mutex;
pthread_cond_t cond;
struct idb_queue msgs;
int nmsgs, nclients; // if nclients < 0 mailbox has been closed.
bool open;
struct thread_mbox *next;
} mbox_t;
typedef struct thandle {
@ -685,7 +684,7 @@ typedef struct thandle {
UInt sysize;
void *stack_address;
Term tdetach;
Term cmod, texit_mod;
Term cmod, texit_mod;
struct DB_TERM *tgoal, *texit;
int id;
int ret;
@ -693,7 +692,7 @@ typedef struct thandle {
REGSTORE *current_yaam_regs;
struct pred_entry *local_preds;
pthread_t pthread_handle;
mbox_t mbox_handle;
mbox_t mbox_handle;
int ref_count;
#ifdef LOW_LEVEL_TRACER
long long int thread_inst_count;
@ -730,18 +729,17 @@ typedef struct gc_ma_hash_entry_struct {
tr_fr_ptr loc;
struct gc_ma_hash_entry_struct *more;
#endif
CELL* addr;
CELL *addr;
struct gc_ma_hash_entry_struct *next;
} gc_ma_hash_entry;
typedef int (*Agc_hook)(Atom);
typedef int (*Agc_hook)(Atom);
typedef struct scratch_block_struct {
char *ptr;
UInt sz, msz;
} scratch_block;
/* scanner types */
#include "ScannerTypes.h"
@ -759,23 +757,22 @@ extern struct global_data Yap_Global;
#if defined(THREADS)
extern struct worker_local *Yap_local[MAX_THREADS];
#define REMOTE(wid) (Yap_local[wid])
#define REMOTE(wid) (Yap_local[wid])
#elif defined(YAPOR)
extern struct worker_local *Yap_local;
#define REMOTE(wid) (Yap_local + wid)
#define REMOTE(wid) (Yap_local + wid)
#else /* !THREADS && !YAPOR */
extern struct worker_local Yap_local;
#define REMOTE(wid) (&Yap_local)
#define REMOTE(wid) (&Yap_local)
#endif
#include "encoding.h"
#include <stdio.h>
#define YP_FILE FILE
#define YP_FILE FILE
#include <YapHeap.h>
/*************************************************************************************************
unification routines
*************************************************************************************************/
@ -812,37 +809,33 @@ Global variables for JIT
#endif
#if DEBUGX
inline static void
LOG0(const char *f, int l, const char *fmt, ...)
{
inline static void LOG0(const char *f, int l, const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
#if __ANDROID__
__android_log_print(ANDROID_LOG_INFO, "YAP ", fmt, ap);
#else __WINDOWS__
FILE * fd;
fd = fopen("c:\\cygwin\\Log.txt", "a");
vfprintf(fd, fmt, ap);
fclose(fd);
FILE *fd;
fd = fopen("c:\\cygwin\\Log.txt", "a");
vfprintf(fd, fmt, ap);
fclose(fd);
#endif
vfprintf(stderr, fmt, ap);
va_end(ap);
vfprintf(stderr, fmt, ap);
va_end(ap);
}
#define LOG( ... ) LOG0( __FILE__, __LINE__, __VA_ARGS__ )
#define LOG(...) LOG0(__FILE__, __LINE__, __VA_ARGS__)
#define REGS_LOG( ... ) CACHE_REGS LOG0( __FILE__, __LINE__, __VA_ARGS__ )
#define REGS_LOG(...) CACHE_REGS LOG0(__FILE__, __LINE__, __VA_ARGS__)
#else
#define LOG( ... )
#define LOG(...)
#define REGS_LOG( ... )
#define REGS_LOG(...)
#endif
// YAP lexicon
#include "GitSHA1.h"
#endif /* YAP_H */

View File

@ -23,31 +23,32 @@
#include "inline-only.h"
EXTERN Int Yap_unify(Term a,Term b);
EXTERN Int Yap_unify(Term a, Term b);
INLINE_ONLY EXTERN inline Term Deref(Term a);
INLINE_ONLY EXTERN inline Term Deref(Term a)
{
while(IsVarTerm(a)) {
Term *b = (Term *) a;
a = *b;
if(a==((Term) b)) return a;
}
return(a);
INLINE_ONLY EXTERN inline Term Deref(Term a) {
while (IsVarTerm(a)) {
Term *b = (Term *)a;
a = *b;
if (a == ((Term)b))
return a;
}
return (a);
}
INLINE_ONLY EXTERN inline CELL *GetTermAdress(Term a);
INLINE_ONLY EXTERN inline Term Derefa(CELL *b);
INLINE_ONLY EXTERN inline Term
Derefa(CELL *b)
{
INLINE_ONLY EXTERN inline Term Derefa(CELL *b) {
Term a = *b;
restart:
restart:
if (!IsVarTerm(a)) {
return(a);
return (a);
} else if (a == (CELL)b) {
return(a);
return (a);
} else {
b = (CELL *)a;
a = *b;
@ -55,64 +56,42 @@ Derefa(CELL *b)
}
}
INLINE_ONLY inline EXTERN Term ArgOfTerm (int i, Term t);
INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t);
INLINE_ONLY inline EXTERN Term
ArgOfTerm (int i, Term t)
INLINE_ONLY inline EXTERN Term ArgOfTerm(int i, Term t)
{
return (Term) (Derefa (RepAppl (t) + (i)));
return (Term)(Derefa(RepAppl(t) + (i)));
}
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term);
INLINE_ONLY inline EXTERN Term HeadOfTerm (Term);
INLINE_ONLY inline EXTERN Term
HeadOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t)));
INLINE_ONLY inline EXTERN Term HeadOfTerm(Term t) {
return (Term)(Derefa(RepPair(t)));
}
INLINE_ONLY inline EXTERN Term TailOfTerm(Term);
INLINE_ONLY inline EXTERN Term TailOfTerm (Term);
INLINE_ONLY inline EXTERN Term
TailOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t) + 1));
INLINE_ONLY inline EXTERN Term TailOfTerm(Term t) {
return (Term)(Derefa(RepPair(t) + 1));
}
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t);
INLINE_ONLY inline EXTERN Term ArgOfTermCell (int i, Term t);
INLINE_ONLY inline EXTERN Term
ArgOfTermCell (int i, Term t)
{
return (Term) ((CELL) (RepAppl (t) + (i)));
INLINE_ONLY inline EXTERN Term ArgOfTermCell(int i, Term t) {
return (Term)((CELL)(RepAppl(t) + (i)));
}
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term);
INLINE_ONLY inline EXTERN Term HeadOfTermCell (Term);
INLINE_ONLY inline EXTERN Term
HeadOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t)));
INLINE_ONLY inline EXTERN Term HeadOfTermCell(Term t) {
return (Term)((CELL)(RepPair(t)));
}
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term);
INLINE_ONLY inline EXTERN Term TailOfTermCell (Term);
INLINE_ONLY inline EXTERN Term
TailOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t) + 1));
INLINE_ONLY inline EXTERN Term TailOfTermCell(Term t) {
return (Term)((CELL)(RepPair(t) + 1));
}
#endif /* YAPCOMPOUNDTERM_H */

View File

@ -195,15 +195,14 @@ void Yap_InitEval(void);
void Yap_fail_all(choiceptr bb USES_REGS);
Term Yap_ExecuteCallMetaCall(Term);
void Yap_InitExecFs(void);
Int Yap_JumpToEnv(Term);
Term Yap_RunTopGoal(Term);
void Yap_ResetExceptionTerm(int);
Int Yap_execute_goal(Term, int, Term, bool);
Int Yap_exec_absmi(bool, yap_reset_t);
bool Yap_JumpToEnv(Term);
Term Yap_RunTopGoal(Term, bool);
bool Yap_execute_goal(Term, int, Term, bool);
bool Yap_exec_absmi(bool, yap_reset_t);
void Yap_trust_last(void);
Term Yap_GetException(void);
void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
int Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool pass_exception USES_REGS);
int Yap_dogc(int extra_args, Term *tp USES_REGS);
Term Yap_PredicateIndicator(Term t, Term mod);

View File

@ -38,21 +38,7 @@ INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) {
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p);
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); }
INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a);
@ -503,9 +489,8 @@ don't forget to also add in qly.h
typedef uint64_t pred_flags_t;
#define DiscontiguousPredFlag \
(( \
pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over \
the place.. */
((pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over \
the place.. */
#define SysExportPredFlag ((pred_flags_t)0x800000000)
/* reuse export list to prolog module. */
#define NoTracePredFlag \
@ -518,8 +503,9 @@ typedef uint64_t pred_flags_t;
((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */
#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */
#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */
#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user \
*/
#define UserCPredFlag \
((pred_flags_t)0x10000000) /* CPred defined by the user \
*/
#define LogUpdatePredFlag \
((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */
#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */
@ -533,9 +519,10 @@ typedef uint64_t pred_flags_t;
((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */
#define SyncPredFlag \
((pred_flags_t)0x00100000) /* has to synch before it can execute */
#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for an atom key \
*/
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for a number key */
#define NumberDBPredFlag \
((pred_flags_t)0x00080000) /* entry for an atom key \
*/
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for a number key */
// #define GoalExPredFlag ((pred_flags_t)0x00020000) /// predicate that is
// called by goal_expand */
#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */
@ -552,9 +539,10 @@ typedef uint64_t pred_flags_t;
#define SequentialPredFlag \
((pred_flags_t)0x00000020) /* may not create parallel choice points! */
#define ProfiledPredFlag \
((pred_flags_t)0x00000010) /* pred is being profiled */
#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred \
*/
((pred_flags_t)0x00000010) /* pred is being profiled */
#define BackCPredFlag \
((pred_flags_t)0x00000008) /* Myddas Imported pred \
*/
#define ModuleTransparentPredFlag \
((pred_flags_t)0x00000004) /* ModuleTransparent pred */
#define SWIEnvPredFlag ((pred_flags_t)0x00000002) /* new SWI interface */
@ -563,9 +551,11 @@ typedef uint64_t pred_flags_t;
#define SystemPredFlags \
(AsmPredFlag | StandardPredFlag | CPredFlag | BinaryPredFlag | BackCPredFlag)
#define ForeignPredFlags \
(AsmPredFlag | SWIEnvPredFlag | CPredFlag | BinaryPredFlag | UDIPredFlag | CArgsPredFlag | UserCPredFlag|SafePredFlag|BackCPredFlag)
(AsmPredFlag | SWIEnvPredFlag | CPredFlag | BinaryPredFlag | UDIPredFlag | \
CArgsPredFlag | UserCPredFlag | SafePredFlag | BackCPredFlag)
#define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag )
#define StatePredFlags \
(InUsePredFlag | CountPredFlag | SpiedPredFlag | IndexedPredFlag)
#define is_system(pe) (pe->PredFlags & SystemPredFlags)
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
#define is_foreign(pe) (pe->PredFlags & ForeignPredFlags)
@ -696,15 +686,20 @@ typedef enum {
} dbentry_flags;
/* predicate initialization */
void Yap_InitCPred(const char *name, arity_t arity, CPredicate f, pred_flags_t flags);
void Yap_InitAsmPred(const char *name, arity_t arity, int code, CPredicate asmc, pred_flags_t flags);
void Yap_InitCmpPred(const char *name, arity_t arity, CmpPredicate cmp, pred_flags_t flags);
void Yap_InitCPredBack(const char *name, arity_t arity, arity_t extra, CPredicate call,
CPredicate retry, pred_flags_t flags);
void Yap_InitCPredBackCut(const char *name, arity_t arity, arity_t extra, CPredicate call,
CPredicate retry, CPredicate cut, pred_flags_t flags);
void Yap_InitCPredBack_(const char *name, arity_t arity, arity_t extra, CPredicate call,
CPredicate retry, CPredicate cut, pred_flags_t flags);
void Yap_InitCPred(const char *name, arity_t arity, CPredicate f,
pred_flags_t flags);
void Yap_InitAsmPred(const char *name, arity_t arity, int code, CPredicate asmc,
pred_flags_t flags);
void Yap_InitCmpPred(const char *name, arity_t arity, CmpPredicate cmp,
pred_flags_t flags);
void Yap_InitCPredBack(const char *name, arity_t arity, arity_t extra,
CPredicate call, CPredicate retry, pred_flags_t flags);
void Yap_InitCPredBackCut(const char *name, arity_t arity, arity_t extra,
CPredicate call, CPredicate retry, CPredicate cut,
pred_flags_t flags);
void Yap_InitCPredBack_(const char *name, arity_t arity, arity_t extra,
CPredicate call, CPredicate retry, CPredicate cut,
pred_flags_t flags);
/* *********************** DBrefs **************************************/
@ -1615,7 +1610,8 @@ INLINE_ONLY inline EXTERN const char *AtomName(Atom at) {
INLINE_ONLY inline EXTERN const char *AtomTermName(Term t);
/**
* AtomTermName(Term t): get a string with the name of a term storing an Atom. Assumes 8
* AtomTermName(Term t): get a string with the name of a term storing an Atom.
*Assumes 8
*bit representation.
*
* @param t the atom term
@ -1628,4 +1624,22 @@ INLINE_ONLY inline EXTERN const char *AtomTermName(Term t) {
return RepAtom(AtomOfTerm(t))->rep.uStrOfAE;
}
bool Yap_ResetException(int wid);
bool Yap_HasException(void);
Term Yap_GetException(void);
Term Yap_PeekException(void);
bool Yap_PutException(Term t);
INLINE_ONLY inline EXTERN bool Yap_HasException(void) {
return LOCAL_BallTerm != NULL;
}
INLINE_ONLY inline EXTERN DBTerm *Yap_RefToException(void) {
DBTerm *dbt = LOCAL_BallTerm;
LOCAL_BallTerm = NULL;
return dbt;
}
INLINE_ONLY inline EXTERN void Yap_CopyException(DBTerm *dbt) {
LOCAL_BallTerm = dbt;
}
bool Yap_RaiseException(void);
#endif

2127
H/absmi.h

File diff suppressed because it is too large Load Diff

View File

@ -10,44 +10,62 @@
#endif
typedef struct cut_c_str *cut_c_str_ptr;
struct cut_c_str{
struct cut_c_str {
cut_c_str_ptr before;
void *try_userc_cut_yamop;
};
#define CUT_C_STR_SIZE ((sizeof(struct cut_c_str))/(sizeof(CELL)))
#define CUT_C_STR_SIZE ((sizeof(struct cut_c_str)) / (sizeof(CELL)))
#define EXTRA_CBACK_CUT_ARG(Type,Offset) \
EXTRA_CBACK_ARG( PP->ArityOfPE, Offset )
#define EXTRA_CBACK_CUT_ARG(Type, Offset) EXTRA_CBACK_ARG(PP->ArityOfPE, Offset)
#define CBACK_CUT_ARG(Offset) \
B->cp_args[ (Offset) - 1 ]
#define CBACK_CUT_ARG(Offset) B->cp_args[(Offset)-1]
#define CUT_C_PUSH(YAMOP,S_YREG) \
{ \
if ((YAMOP)->y_u.OtapFs.f){ \
S_YREG = S_YREG - CUT_C_STR_SIZE; \
cut_c_str_ptr new_top = (cut_c_str_ptr) S_YREG; \
new_top->try_userc_cut_yamop = YAMOP; \
cut_c_push(new_top); \
} \
}
#define CUT_C_PUSH(YAMOP, S_YREG) \
{ \
if ((YAMOP)->y_u.OtapFs.f) { \
S_YREG = S_YREG - CUT_C_STR_SIZE; \
cut_c_str_ptr new_top = (cut_c_str_ptr)S_YREG; \
new_top->try_userc_cut_yamop = YAMOP; \
cut_c_push(new_top); \
} \
}
#define POP_CHOICE_POINT(cp) \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && \
((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP))
#define POP_CHOICE_POINT(cp) \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)LOCAL_LocalBase) && ((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP))
#define POP_EXECUTE() \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = (CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = (PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
#define POP_EXECUTE() \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = \
(PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop();
#define POP_FAIL(handler) \
if (handler) { yamop *oap = handler->cp_ap; \
handler->cp_ap = NOCODE; \
P = (yamop *)FAILCODE; \
choiceptr olB = B; B = handler; \
HR = handler->cp_h; \
/* DBTerm *ref = Yap_RefToException(); */ \
Yap_exec_absmi(true, false); \
B = olB; handler->cp_ap = oap; }
#define POP_FAIL_EXECUTE(handler) \
POP_FAIL(handler); \
cut_c_str_ptr TOP = Yap_REGS.CUT_C_TOP; \
CPredicate func = \
(CPredicate)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.f; \
PredEntry *pred = \
(PredEntry *)((yamop *)TOP->try_userc_cut_yamop)->y_u.OtapFs.p; \
YAP_ExecuteOnCut(pred, func, TOP); \
cut_c_pop();
/*Initializes CUT_C_TOP*/
void cut_c_initialize(int wid );
void cut_c_initialize(int wid);
/*Removes a choice_point from the stack*/
void cut_c_pop(void);

View File

@ -142,3 +142,7 @@
#define GLOBAL_MaxPriority Yap_global->MaxPriority_
#define GLOBAL_FileAliases Yap_global->FileAliases_
#define GLOBAL_NOfFileAliases Yap_global->NOfFileAliases_
#define GLOBAL_SzOfFileAliases Yap_global->SzOfFileAliases_

View File

@ -5,12 +5,6 @@
#define LOCAL_FileAliases LOCAL->FileAliases_
#define REMOTE_FileAliases(wid) REMOTE(wid)->FileAliases_
#define LOCAL_NOfFileAliases LOCAL->NOfFileAliases_
#define REMOTE_NOfFileAliases(wid) REMOTE(wid)->NOfFileAliases_
#define LOCAL_SzOfFileAliases LOCAL->SzOfFileAliases_
#define REMOTE_SzOfFileAliases(wid) REMOTE(wid)->SzOfFileAliases_
#define LOCAL_c_input_stream LOCAL->c_input_stream_
#define REMOTE_c_input_stream(wid) REMOTE(wid)->c_input_stream_
#define LOCAL_c_output_stream LOCAL->c_output_stream_
@ -137,18 +131,24 @@
#define REMOTE_ScannerStack(wid) REMOTE(wid)->ScannerStack_
#define LOCAL_ScannerExtraBlocks LOCAL->ScannerExtraBlocks_
#define REMOTE_ScannerExtraBlocks(wid) REMOTE(wid)->ScannerExtraBlocks_
#define LOCAL_BallTerm LOCAL->BallTerm_
#define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_
#define LOCAL_CBorder LOCAL->CBorder_
#define REMOTE_CBorder(wid) REMOTE(wid)->CBorder_
#define LOCAL_MaxActiveSignals LOCAL->MaxActiveSignals_
#define REMOTE_MaxActiveSignals(wid) REMOTE(wid)->MaxActiveSignals_
#define LOCAL_Signals LOCAL->Signals_
#define REMOTE_Signals(wid) REMOTE(wid)->Signals_
#define LOCAL_IPredArity LOCAL->IPredArity_
#define REMOTE_IPredArity(wid) REMOTE(wid)->IPredArity_
#define LOCAL_ProfEnd LOCAL->ProfEnd_
#define REMOTE_ProfEnd(wid) REMOTE(wid)->ProfEnd_
#define LOCAL_UncaughtThrow LOCAL->UncaughtThrow_
#define REMOTE_UncaughtThrow(wid) REMOTE(wid)->UncaughtThrow_
#define LOCAL_DoingUndefp LOCAL->DoingUndefp_
#define REMOTE_DoingUndefp(wid) REMOTE(wid)->DoingUndefp_
#define LOCAL_StartCharCount LOCAL->StartCharCount_

View File

@ -141,4 +141,8 @@ EXTERNAL char* GLOBAL_CharConversionTable;
EXTERNAL char* GLOBAL_CharConversionTable2;
/* max priority */
EXTERNAL int GLOBAL_MaxPriority;
/// alias table access
EXTERNAL struct AliasDescS* GLOBAL_FileAliases;
EXTERNAL int GLOBAL_NOfFileAliases;
EXTERNAL int GLOBAL_SzOfFileAliases;

View File

@ -87,6 +87,7 @@ EXTERNAL AtomHashEntry *HashChain;
#ifdef EUROTRA
EXTERNAL Term TermDollarU;
#endif
EXTERNAL Term TermAnswer;
//modules
EXTERNAL Term USER_MODULE;
EXTERNAL Term IDB_MODULE;

View File

@ -141,4 +141,8 @@ const char* RestoreFile_;
char* CharConversionTable2_;
/* max priority */
int MaxPriority_;
/// alias table access
struct AliasDescS* FileAliases_;
int NOfFileAliases_;
int SzOfFileAliases_;
} w_shared;

View File

@ -5,9 +5,6 @@
// Stuff that must be considered local to a thread or worker
typedef struct worker_local {
// Streams
struct AliasDescS* FileAliases_;
int NOfFileAliases_;
int SzOfFileAliases_;
int c_input_stream_;
int c_output_stream_;
int c_error_stream_;
@ -77,12 +74,18 @@ typedef struct worker_local {
struct pred_entry* TmpPred_;
char* ScannerStack_;
struct scanner_extra_alloc* ScannerExtraBlocks_;
/// worker control information
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm_;
/// stack limit after which the stack is managed by C-code.
Int CBorder_;
/// max number of signals (uint64_t)
UInt MaxActiveSignals_;
/// actual life signals
uint64_t Signals_;
/// indexing help data?
UInt IPredArity_;
yamop* ProfEnd_;
int UncaughtThrow_;
int DoingUndefp_;
Int StartCharCount_;
Int StartLineCount_;

View File

@ -314,6 +314,7 @@
AtomResize = Yap_LookupAtom("resize"); TermResize = MkAtomTerm(AtomResize);
AtomResourceError = Yap_LookupAtom("resource_error"); TermResourceError = MkAtomTerm(AtomResourceError);
AtomRestoreRegs = Yap_FullLookupAtom("$restore_regs"); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs);
AtomRetry = Yap_LookupAtom("retry"); TermRetry = MkAtomTerm(AtomRetry);
AtomRetryCounter = Yap_LookupAtom("retry_counter"); TermRetryCounter = MkAtomTerm(AtomRetryCounter);
AtomRTree = Yap_LookupAtom("rtree"); TermRTree = MkAtomTerm(AtomRTree);
AtomSafe = Yap_FullLookupAtom("$safe"); TermSafe = MkAtomTerm(AtomSafe);
@ -520,7 +521,7 @@
FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2);
FunctorProcedure = Yap_MkFunctor(AtomProcedure,5);
FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,1);
FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,4);
FunctorQuery = Yap_MkFunctor(AtomQuery,1);
FunctorRecordedWithKey = Yap_MkFunctor(AtomRecordedWithKey,6);
FunctorRDiv = Yap_MkFunctor(AtomRDiv,2);

View File

@ -141,4 +141,8 @@ static void InitGlobal(void) {
GLOBAL_CharConversionTable2 = NULL;
GLOBAL_MaxPriority = 1200;
GLOBAL_FileAliases = Yap_InitStandardAliases();
}

View File

@ -5,9 +5,6 @@
static void InitWorker(int wid) {
REMOTE_FileAliases(wid) = Yap_InitStandardAliases();
REMOTE_c_input_stream(wid) = 0;
REMOTE_c_output_stream(wid) = 1;
REMOTE_c_error_stream(wid) = 2;
@ -77,12 +74,18 @@ static void InitWorker(int wid) {
REMOTE_TmpPred(wid) = NULL;
REMOTE_ScannerStack(wid) = NULL;
REMOTE_ScannerExtraBlocks(wid) = NULL;
REMOTE_BallTerm(wid) = NULL;
REMOTE_CBorder(wid) = 0;
REMOTE_MaxActiveSignals(wid) = 64L;
REMOTE_Signals(wid) = 0L;
REMOTE_IPredArity(wid) = 0L;
REMOTE_ProfEnd(wid) = NULL;
REMOTE_UncaughtThrow(wid) = FALSE;
REMOTE_DoingUndefp(wid) = FALSE;
REMOTE_StartCharCount(wid) = 0L;
REMOTE_StartLineCount(wid) = 0L;

View File

@ -314,6 +314,7 @@
AtomResize = AtomAdjust(AtomResize); TermResize = MkAtomTerm(AtomResize);
AtomResourceError = AtomAdjust(AtomResourceError); TermResourceError = MkAtomTerm(AtomResourceError);
AtomRestoreRegs = AtomAdjust(AtomRestoreRegs); TermRestoreRegs = MkAtomTerm(AtomRestoreRegs);
AtomRetry = AtomAdjust(AtomRetry); TermRetry = MkAtomTerm(AtomRetry);
AtomRetryCounter = AtomAdjust(AtomRetryCounter); TermRetryCounter = MkAtomTerm(AtomRetryCounter);
AtomRTree = AtomAdjust(AtomRTree); TermRTree = MkAtomTerm(AtomRTree);
AtomSafe = AtomAdjust(AtomSafe); TermSafe = MkAtomTerm(AtomSafe);

View File

@ -61,9 +61,6 @@ static void RestoreWorker(int wid USES_REGS) {
@ -77,6 +74,8 @@ static void RestoreWorker(int wid USES_REGS) {
RestoreBallTerm(wid);
@ -88,6 +87,10 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef COROUTINING
REMOTE_WokenGoals(wid) = TermToGlobalAdjust(REMOTE_WokenGoals(wid));
REMOTE_AttsMutableList(wid) = TermToGlobalAdjust(REMOTE_AttsMutableList(wid));

View File

@ -314,6 +314,7 @@ Atom AtomReset; Term TermReset;
Atom AtomResize; Term TermResize;
Atom AtomResourceError; Term TermResourceError;
Atom AtomRestoreRegs; Term TermRestoreRegs;
Atom AtomRetry; Term TermRetry;
Atom AtomRetryCounter; Term TermRetryCounter;
Atom AtomRTree; Term TermRTree;
Atom AtomSafe; Term TermSafe;

File diff suppressed because it is too large Load Diff

View File

@ -23,7 +23,7 @@ ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0)
/// bad access, I/O
ECLASS(PERMISSION_ERROR, "permission_error", 3)
/// something that could not be represented into a type
ECLASS(REPRESENTATION_ERROR, "representation_error", 2)
ECLASS(REPRESENTATION_ERROR, "representation_error", 1)
/// not enough ....
ECLASS(RESOURCE_ERROR, "resource_error", 2)
/// bad text
@ -122,6 +122,7 @@ E2(PERMISSION_ERROR_REPOSITION_STREAM, PERMISSION_ERROR, "reposition", "stream")
E(REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR, "character")
E(REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR, "character_code")
E(REPRESENTATION_ERROR_IN_CHARACTER_CODE, REPRESENTATION_ERROR, "in_character_code")
E(REPRESENTATION_ERROR_INT, REPRESENTATION_ERROR, "int")
E(REPRESENTATION_ERROR_MAX_ARITY, REPRESENTATION_ERROR, "max_arity")
E(REPRESENTATION_ERROR_VARIABLE, REPRESENTATION_ERROR, "variable")
@ -145,6 +146,7 @@ E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error")
E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error")
E(ABORT_EVENT, EVENT, "abort")
E(THROW_EVENT, EVENT, "throw")
E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow")
E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow")
E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow")
@ -164,6 +166,7 @@ E(TYPE_ERROR_DBREF, TYPE_ERROR, "dbref")
E(TYPE_ERROR_DBTERM, TYPE_ERROR, "dbterm")
E(TYPE_ERROR_EVALUABLE, TYPE_ERROR, "evaluable")
E(TYPE_ERROR_FLOAT, TYPE_ERROR, "float")
E(TYPE_ERROR_IN_CHARACTER, TYPE_ERROR, "in_character")
E(TYPE_ERROR_INTEGER, TYPE_ERROR, "integer")
E(TYPE_ERROR_KEY, TYPE_ERROR, "key")
E(TYPE_ERROR_LIST, TYPE_ERROR, "list")

View File

@ -1760,7 +1760,7 @@ extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Ar
/* void UserBackCPredicate(const char *name, int *init(), int *cont(), int
arity, int extra) */
extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int);
extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
/* YAP_Int YAP_ListLength(YAP_Term t) */
extern X_API YAP_Int YAP_ListLength(YAP_Term);
@ -1769,7 +1769,7 @@ extern X_API size_t YAP_UTF8_TextLength(YAP_Term t);
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), int
arity, int extra) */
extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_UserCPred, YAP_Arity, unsigned int);
extern X_API void YAP_UserBackCutCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity);
/* void CallProlog(YAP_Term t) */
extern X_API YAP_Int YAP_CallProlog(YAP_Term t);

View File

@ -23,6 +23,7 @@ set (LIBRARY_PL
lineutils.yap
listing.yap
lists.yap
log2md.yap
nb.yap
ordsets.yap
mapargs.yap

View File

@ -1308,7 +1308,8 @@ X_API int PL_raise_exception(term_t exception)
{
CACHE_REGS
LOCAL_Error_TYPE=YAP_NO_ERROR;
EX = Yap_StoreTermInDB(Yap_GetFromSlot(exception),0);
Yap_PutException(Yap_GetFromSlot(exception));
Yap_RaiseException( );
return 0;
}
@ -2307,7 +2308,7 @@ X_API void
PL_clear_exception(void)
{
CACHE_REGS
EX = NULL;
Yap_ResetException(worker_id);
}
X_API int
@ -2623,8 +2624,8 @@ X_API void PL_close_query(qid_t qi)
{
CACHE_REGS
if (EX && !(qi->q_flags & (PL_Q_CATCH_EXCEPTION))) {
EX = NULL;
if (Yap_HasException() && !(qi->q_flags & (PL_Q_CATCH_EXCEPTION))) {
Yap_ResetException(worker_id);
}
/* need to implement backtracking here */
if (qi->q_open != 1 || qi->q_state == 0) {

View File

@ -5,7 +5,7 @@
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_APR_1_APR_MD5_H
/* #undef HAVE_APR_1_APR_MD5_H */
#define HAVE_APR_1_APR_MD5_H 1
#endif

View File

@ -319,6 +319,7 @@ A Reset N "reset"
A Resize N "resize"
A ResourceError N "resource_error"
A RestoreRegs F "$restore_regs"
A Retry N "retry"
A RetryCounter N "retry_counter"
A RTree N "rtree"
A Safe F "$safe"
@ -525,7 +526,7 @@ F Portray Portray 1
F PrintMessage PrintMessage 2
F Procedure Procedure 5
F PrologConstraint Prolog 2
F ProtectStack ProtectStack 1
F ProtectStack ProtectStack 4
F Query Query 1
F RecordedWithKey RecordedWithKey 6
F RDiv RDiv 2

View File

@ -168,6 +168,10 @@ char* CharConversionTable2 =NULL
/* max priority */
int MaxPriority =1200
/// alias table access
struct AliasDescS* FileAliases =Yap_InitStandardAliases()
int NOfFileAliases void
int SzOfFileAliases void
END_GLOBAL_DATA

View File

@ -2,10 +2,6 @@
START_WORKER_LOCAL
// Streams
struct AliasDescS* FileAliases =Yap_InitStandardAliases()
int NOfFileAliases void
int SzOfFileAliases void
int c_input_stream =0
int c_output_stream =1
int c_error_stream =2
@ -83,16 +79,25 @@ Int ArenaOverflows =0L
Int DepthArenas =0
int ArithError =FALSE
struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
/// worker control information
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid)
/// stack limit after which the stack is managed by C-code.
Int CBorder =0
/// max number of signals (uint64_t)
UInt MaxActiveSignals =64L
/// actual life signals
uint64_t Signals =0L
/// indexing help data?
UInt IPredArity =0L
yamop* ProfEnd =NULL
int UncaughtThrow =FALSE
int DoingUndefp =FALSE
Int StartCharCount =0L
Int StartLineCount =0L

View File

@ -2,9 +2,8 @@
:- module(clpbn_gviz,
[clpbn2gviz/4]).
clpbn2gviz(Stream, Name, Network, Output) :-
format(Stream, 'digraph ~w {
graph [ rankdir="LR" ];~n',[Name]),
clpbn2gviz(Stream, Name, Network, Node, Edge, Output) :-
format(Stream, 'digraph ~w { ~n graph [ rankdir="LR" ];~n',[Name]),
output_vars(Stream, Network),
info_ouput(Stream, Output),
format(Stream, '}~n',[]).

View File

@ -204,7 +204,8 @@ in_table(K, V) :-
store_in_table(K, V) :-
b_getval(clpbn_tables, Tab),
b_hash_insert(Tab, K, V).
b_hash_insert(Tab, K, V, NewTab),
( Tab == NewTab -> true ; b_setval(clpbn_tables, NewTab)).
clpbn_tabled_clause(M:Head, Body) :- !,
clpbn_tabled_clause(Head, M, Body).

View File

@ -27,6 +27,6 @@
/* Define to 1 if you have the <util.h> header file. */
#ifndef HAVE_UTIL_H
/* #undef HAVE_UTIL_H */
#define HAVE_UTIL_H 1
#endif

Binary file not shown.

View File

@ -807,7 +807,7 @@ void termhandler(int num) { exit(3); }
void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
const char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) &&
@ -828,7 +828,7 @@ void myexpand(extmanager MyManager, DdNode *Current) {
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found = NULL;
char *curnode; //, *dynvalue;
const char *curnode; //, *dynvalue;
double lvalue, hvalue, tvalue;
// density_integral dynvalue_parsed;
@ -1062,7 +1062,7 @@ double CalcExpectedCountsDown(extmanager *MyManager, DdNode *Current,
Queue q = QueueNew();
// fprintf(stderr", =====> queue is: %p \n",q);
int i;
char *curnode, *curh, *curl, *dynvalue;
const char *curnode, *curh, *curl, *dynvalue;
DdNode *h, *l, *node;
ComparisonFunction fun;
hisnode *Found = NULL, *lfound, *hfound;
@ -1230,7 +1230,7 @@ double CalcExpectedCountsUp(extmanager *MyManager, DdNode *Current,
DdNode *h, *l;
hisnode *Found;
char *curnode = NULL;
const char *curnode = NULL;
double lvalue, hvalue, tvalue;
// tvalue=0.0;
int ivalue;
@ -1293,7 +1293,7 @@ gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar,
char *TargetPattern, int type) {
DdNode *h, *l;
hisnode *Found;
char *curnode = NULL, *dynvalue;
const char *curnode = NULL, *dynvalue;
gradientpair lowvalue, highvalue, tvalue;
double this_probability;
double *gradient;

View File

@ -208,7 +208,7 @@ double cumulative_normal_dsigma(double low, double high,double mu,double sigma)
// this function parses two strings "$a;$b" and "???_???l$ch$d" where $a-$d are (real) numbers
// it is used to parse in the parameters of continues variables from the input file
density_integral parse_density_integral_string(char *input, char *variablename) {
density_integral parse_density_integral_string(char *input, const char *variablename) {
density_integral result;
int i;
char garbage[64], s1[64],s2[64],s3[64],s4[64];

View File

@ -166,4 +166,4 @@ double Phi(double x);
double cumulative_normal(double low, double high, double sigma, double mu);
double cumulative_normal_dmu(double low, double high,double mu,double sigma);
double cumulative_normal_dsigma(double low, double high,double mu,double sigma);
density_integral parse_density_integral_string(char *input, char *variablename);
density_integral parse_density_integral_string(char *input, const char *variablename);

View File

@ -249,7 +249,7 @@ typedef struct _bddfileheader {
typedef struct _namedvars {
int varcnt;
int varstart;
const char ** vars;
char ** vars;
int *loaded;
double *dvalue;
int *ivalue;

View File

@ -1831,7 +1831,7 @@ jni_create_jvm_c(
JNIEnv *env;
JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath));
vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */
vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */
if ( classpath )
{
cpoptp = (char *)malloc(strlen(classpath)+20);

View File

@ -205,7 +205,6 @@ private(_).
'$do_live'/0,
'$'/0,
'$find_goal_definition'/4,
'$handle_throw'/3,
'$head_and_body'/3,
'$inform_as_reconsulted'/2,
'$init_system'/0,
@ -1417,8 +1416,8 @@ bootstrap(F) :-
!.
'$loop'(Stream,Status) :-
% start_low_level_trace,
'$current_module'( OldModule ),
repeat,
'$current_module'( OldModule, OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)
@ -1554,11 +1553,7 @@ is responsible to capture uncaught exceptions.
*/
catch(G, C, A) :-
'$catch'(C,A,_),
'$$save_by'(CP0),
'$execute'(G),
'$$save_by'(CP1),
(CP0 == CP1 -> !; true ).
'$catch'(G,_,[C|A]).
% makes sure we have an environment.
'$true'.
@ -1571,11 +1566,24 @@ catch(G, C, A) :-
%
'$system_catch'(G, M, C, A) :-
% check current trail
'$catch'(C,A,_),
'$$save_by'(CP0),
'$execute_nonstop'(G, M),
'$catch'(M:G,_,[C|A]).
'$catch'(MG,_,_) :-
'$$save_by'(CP0),
'$execute'(MG),
'$$save_by'(CP1),
% remove catch
(CP0 == CP1 -> !; true ).
'$catch'(_,C0,[C|A]) :-
nonvar(C0),
C0 = throw(Ball),
( catch_ball( Ball, C)
->
'$execute'(A)
;
throw(Ball)
).
%
% throw has to be *exactly* after system catch!
@ -1588,11 +1596,6 @@ stopped, and the exception is sent to the ancestor goals until reaching
a matching catch/3, or until reaching top-level.
*/
throw(_Ball) :-
% use existing ball
'$get_exception'(Ball),
!,
'$jump_env_and_store_ball'(Ball).
throw(Ball) :-
( var(Ball) ->
'$do_error'(instantiation_error,throw(Ball))
@ -1601,21 +1604,6 @@ throw(Ball) :-
'$jump_env_and_store_ball'(Ball)
).
% just create a choice-point
'$catch'(_,_,_).
'$catch'(_,_,_) :- fail.
'$handle_throw'(_, _, _).
'$handle_throw'(C, A, _Ball) :-
'$reset_exception'(Ball),
% reset info
(catch_ball(Ball, C) ->
'$execute'(A)
;
throw(Ball)
).
catch_ball(Abort, _) :-
Abort == '$abort', !, fail.
% system defined throws should be ignored by user, unless the

View File

@ -263,10 +263,10 @@ This is similar to <tt>call_cleanup/1</tt> with an additional
*/
call_cleanup(Goal, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
'$setup_call_catcher_cleanup'(true, Goal, Catcher, Cleanup).
call_cleanup(Goal, Catcher, Cleanup) :-
setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
'$setup_call_catcher_cleanup'(true, Goal, Catcher, Cleanup).
/** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
@ -280,145 +280,13 @@ such as the ones received from `call_with_time_limit/2` or thread_signal/2. In
most uses, _Setup_ will perform temporary side-effects required by
_Goal_ that are finally undone by _Cleanup_.
Success or failure of _Cleanup_ is ignored and choice-points it
created are destroyed (as once/1). If _Cleanup_ throws an exception,
this is executed as normal.
Typically, this predicate is used to cleanup permanent data storage
required to execute _Goal_, close file-descriptors, etc. The example
below provides a non-deterministic search for a term in a file, closing
the stream as needed.
~~~~~{.prolog}
term_in_file(Term, File) :-
setup_call_cleanup(open(File, read, In),
term_in_stream(Term, In),
close(In) ).
term_in_stream(Term, In) :-
repeat,
read(In, T),
( T == end_of_file
-> !, fail
; T = Term
).
~~~~~
Note that it is impossible to implement this predicate in Prolog other than
by reading all terms into a list, close the file and call member/2.
Without setup_call_cleanup/3 there is no way to gain control if the
choice-point left by `repeat` is removed by a cut or an exception.
`setup_call_cleanup/2` can also be used to test determinism of a goal:
~~~~~
?- setup_call_cleanup(true,(X=1;X=2), Det=yes).
X = 1 ;
X = 2,
Det = yes ;
~~~~~
This predicate is under consideration for inclusion into the ISO standard.
For compatibility with other Prolog implementations see `call_cleanup/2`.
*/
setup_call_cleanup(Setup, Goal, Cleanup) :-
setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
/** @pred setup_call_catcher_cleanup(: _Setup_,: _Goal_, + _Catcher_,: _CleanUpGoal_)
setup_call_cleanup(Setup,Goal, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup, Goal, Catcher, Cleanup).
Similar to `setup_call_cleanup( _Setup_, _Goal_, _Cleanup_)` with
additional information on the reason of calling _Cleanup_. Prior
to calling _Cleanup_, _Catcher_ unifies with the termination
code. If this unification fails, _Cleanup_ is
*not* called.
*/
setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
yap_hacks:disable_interrupts,
'$check_goal_for_setup_call_cleanup'(Setup, setup_call_cleanup(Setup, Goal, Cleanup)),
catch('$do_setup'(Setup),Exception,'$handle_broken_setup'(Exception)),
'$check_goal_for_setup_call_cleanup'(Cleanup, setup_call_cleanup(Setup, Goal, Cleanup)),
'$safe_call_cleanup'(Goal,Cleanup,Catcher,Exception).
% make sure we don't lose interrupts if we get exceptions
% with setup.
'$handle_broken_setup'(Exception) :-
yap_hacks:enable_interrupts,
throw(Exception).
'$check_goal_for_setup_call_cleanup'(Goal, G) :-
strip_module(Goal, _, MG),
(
var(MG)
->
yap_hacks:enable_interrupts,
'$do_error'(instantiation_error,G)
;
true
).
% this is simple, do nothing
'$do_setup'(A:true) :- atom(A), !.
% this is tricky: please don't forget that interrupts are disabled at this point
% and that they will only be enabled after setting up Cleanup
'$do_setup'(Setup) :-
(
'$execute'(Setup),
% we don't need to care about enabling interrupts
!
;
% reenable interrupts if Setup failed
yap_hacks:enable_interrupts,
fail
).
'$cleanup_exception'(Exception, exception(Exception), Cleanup) :- !,
% whatever happens, let exception go through
catch('$clean_call'(_,Cleanup),_,true),
throw(Exception).
'$cleanup_exception'(Exception, _, _) :-
throw(Exception).
'$safe_call_cleanup'(Goal, Cleanup, Catcher, _Exception) :-
'$coroutining':freeze_goal(Catcher, '$clean_call'(_Active, Cleanup)),
(
yap_hacks:trail_suspension_marker(Catcher),
yap_hacks:enable_interrupts,
'$current_choice_point'(CP0),
'$execute'(Goal),
'$current_choice_point'(CPF),
(
CP0 =:= CPF
->
Catcher = exit,
!
;
true
)
;
Catcher = fail,
fail
).
'$holds_true'.
% The first argument is used by JumpEnv to verify if a throw
% is going to be handled by the cleanup catcher. If it is so,
% clean_call will not be called from JumpToEnv.
'$clean_call'(_, Cleanup) :-
'$execute'(Cleanup), !.
'$clean_call'(_, _).
'$cc_check_throw' :-
'$nb_getval'('$catch', Ball, fail),
throw(Ball).
setup_call_catcher_cleanup(Setup,Goal, Catcher, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup, Goal, Catcher, Cleanup).
/** @pred call_with_args(+ _Name_,...,? _Ai_,...)
@ -781,3 +649,4 @@ prolog_current_frame(Env) :-
/**
@}
*/

View File

@ -1043,10 +1043,11 @@ be lost.
).
'$debugger_process_meta_arguments'(G, M, G1) :-
functor(G,F,N),
'$meta_predicate'(F,M,N,D), !, % we're in an argument
'$yap_strip_module'( M:G, MM, GM ),
functor(GM,F,N),
'$meta_predicate'(F,MM,N,D), !, % we're in an argument
D =.. [F|BMs],
G =.. [F|BGs],
GM =.. [F|BGs],
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s),
G1 =.. [F|BG1s].
'$debugger_process_meta_arguments'(G, _M, G).
@ -1055,10 +1056,10 @@ be lost.
'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$spy'([M1|G1])|BG1s]) :-
number(N),
N >= 0,
'$yap_strip_module'( M:G, M1, G1 ),
functor(G1, Na, _),
Na \= '$trace_call',
!,
strip_module( M:G, M1, G1 ),
functor(G1, N, _),
N \= '$trace_call',
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).

View File

@ -106,9 +106,7 @@ otherwise.
'$continue_static_clause'(A,B,C,D,E).
'$do_static_clause'(_,_,_,_,_).
:- '$handle_throw'(_,_,_), !.
:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
\:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- bootstrap('arith.yap').

View File

@ -209,21 +209,21 @@ compose_message(Term, Level) -->
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_), _ , _) -->
!,
[ '~a:~d:0: ' - [FileName,LN] ] .
[ '~a:~d:0 ' - [FileName,LN] ] .
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
% { stream_position_data( line_count, LN) },
!,
[ '~a:~d:0: ' - [FileName,LN] ] .
[ '~a:~d:0 ' - [FileName,LN] ] .
location( error(_,Term), Level, LC ) -->
{ source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !,
display_consulting( F0, Level, LC ),
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
[ '~a:~d:0: ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
location( error(_,Term), Level, LC ) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
display_consulting( File, Level, LC ),
[ '~a:~d:0: ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message(error(Msg,Info), _, _) --> {var(Info)}, !,

View File

@ -78,7 +78,6 @@ and therefore he should try to avoid them whenever possible.
:- use_system_module( '$_boot', ['$check_head_and_body'/4,
'$check_if_reconsulted'/2,
'$handle_throw'/3,
'$head_and_body'/3,
'$inform_as_reconsulted'/2]).
@ -205,9 +204,6 @@ clause(V0,Q,R) :-
'$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q,R)).
'$init_preds' :-
once('$handle_throw'(_,_,_)),
fail.
'$init_preds' :-
once('$do_static_clause'(_,_,_,_,_)),
fail.

View File

@ -45,7 +45,7 @@ build_graph(F, Mod) :-
nb_setval( line, Line ),
nb_getval( current_module, MC0 ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_graph( T, F, Pos, MC ),
get_graph( T, F, Line, MC ),
fail
).
@ -57,31 +57,34 @@ get_graph( V , _F, _Pos, _M ) :-
get_graph( T, _F, _Pos, _M0 ) :-
var(T),
!.
get_graph( M:T, F, _Pos, _M0 ) :- !,
get_graph( T, F, _Pos, M ).
get_graph( ( M:H :- B), F, _Pos, M0 ) :-
get_graph( M:T, F, Pos, _M0 ) :- !,
always_strip_module(M:T, NM, NT),
get_graph( NT, F, Pos, NM ).
get_graph( ( M:H :- B), F, Pos, M0 ) :-
!,
get_graph( (H :- M0:B), F, _Pos, M ).
get_graph( ( M:H --> B), F, _Pos, M0 ) :-
get_graph( (H :- M0:B), F, Pos, M ).
get_graph( ( M:H --> B), F, Pos, M0 ) :-
!,
get_graph( ( H --> M0:B), F, Pos, M ).
get_graph( ( A, _ --> B), F, Pos, M ) :-
!,
get_graph( ( H --> M0:B), F, _Pos, M ).
get_graph( ( A, _ --> B), F, _Pos, M ) :-
get_graph( ( A --> B), F, _Pos, M ).
get_graph( (H --> B), F, _Pos, M ) :-
get_graph( (H --> B), F, Pos, M ) :-
!,
functor( H, N, Ar),
Ar2 is Ar+2,
add_deps( B, M, M:N/Ar2, F, _Pos, 2 ).
get_graph( (H :- B), F, _Pos, M ) :-
add_deps( B, M, M:N/Ar2, F, Pos, 2 ).
get_graph( (H :- B), F, Pos, M ) :-
!,
functor( H, N, Ar),
add_deps( B, M, M:N/Ar, F, _Pos, 0 ).
add_deps( B, M, M:N/Ar, F, Pos, 0 ).
%% switches to new file n
get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!,
source_graphs( M, F, Fs ).
get_graph( (?- _ ), _F, _Pos, _M ) :- !.
get_graph( (:- _ ), _F, _Pos, _M ) :- !.
get_graph( _H, _F, _Pos, _M ).
source_graphs( M, F, Fs ) :-
maplist( source_graph( M, F ), Fs ), !.
@ -131,13 +134,12 @@ add_deps(A, M, P, F, Pos, L) :-
Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), _Pos ) :-
ground(F0-M:Goal), !,
assert_new_e( ( Target :- F0-M:N/Ar ) ).
put_dep( (Target :- F0-G0 ), _Pos ) :-
ground(F0-G0), !,
Target = F-G,
assert_new_e( F, G, F0, G0 ).
put_dep(_,_).
% prolog is visible ( but maybe not same file ).
% prolog is visible ( but maybe not same file )
m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ).

View File

@ -24,9 +24,9 @@ scan_dir( Dir -user) :-
pl_interfs(0, Dir-user ),
%%% phase 2: find C-code predicates
c_preds( Dir-user ).
// the c-builtins do not depend on prolog code.
% the c-builtins do not depend on prolog code.
scan_dir( Dir -prolog) :-
c_preds( Dir-user ).
c_preds( Dir-user ),
pl_interfs(0, Dir-user ).
%%% phase 2: find C-code predicates
@ -54,7 +54,7 @@ rdir( FRoot ) :-
rdir(_).
c_preds(Dir - Mod) :-
format('%~*| C ************* ~a\n', [1,Dir]),
% format('%~*| C ************* ~a\n', [1,Dir]),
atom( Dir ),
absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ),
( ( sub_atom(File,_,_,0,'.c')
@ -116,7 +116,7 @@ c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ).
c_ext( S, Mod, F ) :-
repeat,
stream_property( S, position(Pos) ),
@ -130,11 +130,11 @@ c_ext( S, Mod, F ) :-
( sub_string( Codes, _, _, _, `NULL` )
->
!
;
;
split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]),
atom_string(N,NS),
atom_string(Fu,FS),
catch( number_string(A, AS), Error, handle( String , Error ) ),
catch( number_string(A, AS), Error, handle( String , Error ) ),
stream_position_data( line_count, Pos, Line ),
assert( node( Mod , N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
@ -274,10 +274,9 @@ clean_up(_,_).
%
%
%
pl_interfs(Lev0, Dir - Mod) :-
\+ ( fullskip( Dir ) ),
format('%~*| ************* ~a\n', [Lev0,Dir]),
% format('%~*| ************* ~a\n', [Lev0,Dir]),
Lev is Lev0+1,
nb_setval( current_module, Mod ),
atom( Dir ),
@ -310,7 +309,7 @@ pl_interfs(_, _).
pl_interface(F, Mod, _Lev) :-
module_on( F , _Mod, L ),
maplist( private(F, Mod), L ),
!.
!.
pl_interface(F, Mod, _) :-
consulted(F, Mod ),
!.
@ -329,7 +328,7 @@ pl_interface(F, Mod, Lev) :-
catch( open(PF, read, S, [script(true)]) , _, fail ),
repeat,
nb_getval( current_module, MR ),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( MR:Throw)),
catch( read_clause( S, T, [module( MR ),term_position(Pos),comment(Comment)] ), Throw, loop_error( MR:Throw)),
( T == end_of_file
->
@ -351,7 +350,7 @@ pl_interface(F, Mod, Lev) :-
),
clean_up( MR, F ),
nb_setval( current_module, M0 )
% writeln('***************************<<<<<<<<<<<'-M0),
% (current_op(X,Y,O), write(M0:O), fail;nl)
;
@ -361,7 +360,7 @@ pl_interface(F, Mod, Lev) :-
( Mod == prolog -> MC = prolog ; MC = MC0 ),
Lev1 is Lev+1,
get_interface( T, F, MC, Lev1 ),
get_graph( T, F, Pos, MC ),
get_graph( T, F, Pos, MC ),
fail
).
@ -403,7 +402,7 @@ get_directive( V , _F, _M , _Lev) :-
get_directive( module( NM0, Is ), F, _M , _Lev) :-
!,
(
(NM0 = system(_) -> NM = prolog ; NM = NM0 ),
(NM0 = system(NM) -> true ; NM0 = system(NM,_) -> true ; NM = NM0 ),
assert(module_file( F, NM ) ),
nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ),
@ -415,28 +414,25 @@ get_directive( module( NM0, Is ), F, _M , _Lev) :-
writeln(oops:module( NM0, Is )),
fail
).
get_directive( reexport( Loc, Is ), F, M , Lev) :-
!,
( % find the file
search_file(Loc, F, prolog, F1),
pl_interface(F1, M, Lev),
module_on( F1 , NM, Is0),
(var(Is) ->
Is = Is0
;
true
),
% extend the interface.rg
retract( module_on( F , M, IsOld) ),
append( Is, IsOld, NIs ),
assert( module_on( F , M, NIs) ),
maplist( exported(F, M, F1, NM), NIs )
fail
).
get_directive( use_module( Loc, Is ), F, M , Lev) :- !,
get_directive( reexport( Loc, Is ), F, M , Lev) :-
!,
search_file( Loc, F, prolog, F1),
pl_interface(F1, M, Lev),
module_on( F1 , NM, Is0),
(var(Is) ->
Is = Is0
;
true
),
% extend the interface.rg
retract( module_on( F , M, IsOld) ),
append( Is, IsOld, NIs ),
assert( module_on( F , M, NIs) ),
maplist( exported(F, M, F1, NM), NIs ).
get_directive( use_module( Loc, Is ), F, M , Lev) :-
!,
include_files( F, M, Is, Lev, Loc ).
get_directive( use_module( Loc ), F, M , Lev) :- !,
get_directive( use_module( Loc ), F, M , Lev) :-
!,
include_files0( F, M, Lev, Loc ).
% nb_getval(current_module,MM), writeln(NM:MM:M).
@ -517,7 +513,7 @@ get_directive( thread_local( T ), F, M , _Lev) :-
declare_functors( T, F, M ).
get_directive( op( X, Y, Z), _F, M , _Lev) :-
!,
new_op(M,X,Y,Z).
new_op(M,M,X,Y,Z).
get_directive( record( Records ), F, M , _Lev) :-
!,
handle_record( Records, F, M).
@ -590,27 +586,23 @@ handle_pred( M, N, A, F ) :-
)
).
exported( _NF, _F, _NM, M, op(X,Y,Z)) :-
exported( _NF, _F, NM, M, op(X,Y,Z)) :-
!,
new_op(M,X,Y,Z).
new_op(M, NM, X,Y,Z).
exported( NF, F, NM, M, N/A) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new_e( ( (F-M:N/A :- NF-NM:N/A )) ).
assert_new_e( F,M:N/A , NF, NM:N/A ).
exported( NF, F, NM, M, N/A as NN) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new_e( ( ( F-M:NN/A :- NF-NM:N/A ) ) ).
assert_new_e( F,M:NN/A , NF,NM:N/A ).
exported( NF, F, NM, M, N//A) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new_e( ( (F-M:N/A2 :- NF-NM:N/A2) ) ).
assert_new_e( F,M:N/A2 , NF, NM:N/A2 ).
exported( NF, F, NM, M, N//A as NN) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new_e( ( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
assert_new_e( F, M:NN/A2 , NF, NM:N/A2 ).
@ -632,13 +624,12 @@ include_file( F, M, Is, Lev, Loc ) :-
is_list( Loc ), !,
maplist( include_file( F, M, Is, Lev), Loc ).
include_file( F, M, Is0, Lev, Loc ) :-
% depth visit
% depth visit\
(
nb_getval( private, Private ), % find the file
nb_getval( private, Private ), % find the file
once( search_file( Loc, F, prolog, NF ) ),
pl_interface(NF, M, Lev),
% should verify Is in _Is
% link b
%trace,
( module_on(NF, NM, Is)
->
@ -652,7 +643,7 @@ include_file( F, M, Is0, Lev, Loc ) :-
true
;
writeln(bad_include_file( F, M, Is0, Lev, Loc )),
fail
fail
).
source_files( F, M, Lev, Files ) :-
@ -727,7 +718,6 @@ declare_term(F, M, S) :-
functor(S, N, A),
handle_pred( M, N, A, F ).
handle(Line, Error ) :-
handle(Line, Error ) :-
format('~s caused Error ~w~n~n', [Line, Error]),
fail.

View File

@ -26,7 +26,7 @@
:- dynamic
node/4,
edge/1,
public/2,
(public)/2,
private/2,
module_on/3,
exported/1,
@ -79,7 +79,6 @@ main :-
main :-
%%% phase 4: construct graph
retractall( consulted(_,_) ),
trace,
find_undefs,
doubles,
% pl_exported(pl).
@ -146,50 +145,6 @@ doubles :-
fail.
doubles.
find_undefs :-
format('UNDEFINED procedure calls:~n',[]),
pmodule(M),
format(' module ~a:~n',[M]),
predicate_in_module(M, P),
\+ edge((_-M:P :- _)),
format(' ~w:~n',[P]),
fail.
find_undefs.
pmodule(M) :-
findall(M, node(M, _,_,_), Ms),
sort(Ms, SMs),
member(M, SMs).
predicate_in_module(M, P) :-
findall(P, node(M, P,_,_), Ps),
sort(Ps, SPs),
member(P, SPs).
/*
setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ),
member( Mod, Ms ),
format(' module ~a:~n',[Mod]),
setof(NA, Target^F^Line^undef( ( Target :- F-Mod:NA ), Line ), Ns ),
member( NA, Ns ),
\+ node( Mod , NA , _File1, _ ),
\+ node( prolog , NA , _File2, _ ),
format(' predicate ~w:~n',[NA]),
(
setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ),
member(F-L, FLs ),
format(' line ~w, file ~a~n',[L,F]),
fail
;
setof(F-M,Type^node( M, NA, F, Type ) , FMs ),
format(' same name at:~n',[]),
member((F-L)-M, FMs ),
format(' module ~a, file ~a, line ~d~n',[M,F,L]),
fail
).
undefs.
*/
out_list([]) :-
format('[]', []).
@ -338,23 +293,24 @@ library('..').
:- dynamic user:prolog_file_type/2.
prolog_file_type(c, '.c').
prolog_file_type(c, '.h').
prolog_file_type(c, '.h.cmake').
prolog_file_type(c, '.i').
%prolog_file_type(chr, prolog).
prolog_file_type(c, c).
prolog_file_type(h, c).
prolog_file_type('h.cmake', c).
prolog_file_type('i', c).
%
% handle some special cases.
%
search_file( S , LocF, Type, FN ) :-
functor(S, _, N),
search_file( S , LocF, Type, FN ) :-
functor(S, _, N),
N> 0,
!,
arg(N, S, A),
search_file( A , LocF, Type, FN ).
%try to use your base
search_file( F0, LocF, Type, FO ) :-
file_directory_name(LocF, D),
file_directory_name(LocF, D),
file_base_name(F0, B),
findall(F, fsuffix(Type, B, F), Fs),
Fs = [_|_],
@ -369,11 +325,11 @@ search_file( F0, LocF, Type, FO ) :-
search_file( Loc , F, Type, _FN ) :-
format('~n~n~n###############~n~n FAILED TO FIND ~w.~a when at ~a~n~n###############~n~n~n', [Loc, Type, F ]),
fail.
fsuffix(Type,F0, F) :-
( user:prolog_file_type(Suffix, Type),
(atom_concat('.', _, Suffix)
->
->
Suffix = DSuffix
;
atom_concat('.', Suffix, DSuffix)
@ -385,8 +341,8 @@ fsuffix(Type,F0, F) :-
file_base_name(F1, B),
file(F, B),
atom_concat(_, F1, F).
quantf(F, F1, I-F1) :-
atom_length(F1,M),
between(0,M,I),
@ -397,10 +353,17 @@ quantf(F, F1, I-F1) :-
% if it is .yap...
new_op( prolog, _X,_Y,_Z ) :- !.
new_op( M, X,Y,Z ) :-
op( X, Y, M:Z).
new_op( M, M, X, Y, Z ) :- !,
myop( X, Y, M:Z).
new_op( M1, M2, X,Y,Z ) :-
myop( X, Y, M1:Z),
myop( X, Y, M2:Z).
myop(_X, _Y, _M:P) :-
system_op(P),
!.
myop(X, Y, M:P) :-
op(X, Y, M:P).
error(_F, Error) :-
print_message( error, Error ),
@ -416,7 +379,7 @@ preprocess_file(F,F).
%%%%%%%
%% declare a concept exportable
public( _F, M, op(X,Y,Z) ) :- !,
new_op(M,X,Y,Z).
new_op(M,M,X,Y,Z).
public( F, M, M:N/Ar ) :-
retract( private( F, M:N/Ar ) ),
fail.
@ -445,7 +408,7 @@ public( _F, _M, _//_Ar ).
private( _F, M, op(X,Y,Z) ) :-
!,
new_op( M,X, Y, Z ).
new_op(M,M,X, Y, Z ).
private( F, M, N/Ar ) :-
assert_new( private( F, M:N/Ar ) ),
\+ node( M, N/Ar, F-_, _ ),
@ -468,10 +431,10 @@ is_private( F, M, OP ) :-
assert_new_e((A-MG :- B-MG1 )) :-
yap_strip_module(MG, M, P),
yap_strip_module(MG1, M1, P1),
assert(edge((A-M:P :- B-M1:P1 ) )).
assert_new_e( A , MG , B, MG1 ) :-
always_strip_module(MG, M, P),
always_strip_module(MG1, M1, P1),
assert_new(edge((A-M:P :- B-M1:P1 ) )).
assert_new( G ) :- G, !.
@ -662,7 +625,7 @@ add_comments :-
member(Line-Comment-Type-Dup, Lines),
check_comment( Comment, CN, Line, File ),
Line1 is Line-1,
format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\
format(S, '#~a~ncat << "EOF" > tmp~n~sEOF~nsed -e "~dr tmp" ~a > x~n\c
mv x ~a~n~n',[Dup,CN, Line1, File, File])
;
close(S)
@ -800,8 +763,7 @@ user_skip( 'packages/prism/src/prolog').
user_skip( 'packages/prism').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ).
loop_error(_, Msg) :-
writeln(Msg),
fail.