This commit is contained in:
Vítor Santos Costa 2018-10-23 13:19:07 +01:00
commit 37d9810a99
11 changed files with 91 additions and 226 deletions

View File

@ -77,7 +77,7 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
static void InitConsultStack(void) {
CACHE_REGS
LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) *
InitialConsultCapacity);
InitialConsultCapacity);
if (LOCAL_ConsultLow == NULL) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitCodes");
return;
@ -94,20 +94,32 @@ void Yap_ResetConsultStack(void) {
LOCAL_ConsultCapacity = InitialConsultCapacity;
}
/**
* Are we compiling a file?
*
*/
bool Yap_Consulting(USES_REGS1) {
return LOCAL_ConsultBase != NULL
&& LOCAL_ConsultSp != LOCAL_ConsultLow+LOCAL_ConsultCapacity;
}
/******************************************************************
ADDING AND REMOVE INFO TO A PROCEDURE
******************************************************************/
/*
* we have three kinds of predicates: dynamic DynamicPredFlag
* static CompiledPredFlag fast FastPredFlag all the
/**
* we have three kinds of predicates:
* + dynamic DynamicPredFlag
* + static CompiledPredFlag fast
* + fast FastPredFlag.
*
* all the
* database predicates are supported for dynamic predicates only abolish and
* assertz are supported for static predicates no database predicates are
* supportted for fast predicates
*/
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
@ -251,9 +263,9 @@ void Yap_BuildMegaClause(PredEntry *ap) {
if (ap->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MegaClausePredFlag
#ifdef TABLING
| TabledPredFlag
| TabledPredFlag
#endif /* TABLING */
| UDIPredFlag) ||
| UDIPredFlag) ||
ap->cs.p_code.FirstClause == NULL || ap->cs.p_code.NOfClauses < 16) {
return;
}

View File

@ -679,6 +679,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->errorLine = lineno;
r->errorFunction = function;
r->errorFile = file;
r->prologConsulting = Yap_Consulting();
LOCAL_PrologMode |= InErrorMode;
Yap_ClearExs();
// first, obtain current location
@ -1034,7 +1035,7 @@ static Int print_exception(USES_REGS1) {
static Int query_exception(USES_REGS1) {
const char *query;
const char *query = NULL;
Term t;
if (IsAtomTerm((t = Deref(ARG1))))
@ -1045,13 +1046,13 @@ static Int query_exception(USES_REGS1) {
return false;
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
Term t3 = Deref(ARG3);
if (IsVarTerm(t3)) {
//if (IsVarTerm(t3)) {
Term rc = queryErr(query, y);
// Yap_DebugPlWriteln(rc);
return Yap_unify(ARG3, rc);
} else {
return setErr(query, y, t3);
}
// } else {
// return setErr(query, y, t3);
// }
}
@ -1261,7 +1262,7 @@ static Int is_predicate_indicator(USES_REGS1) {
void Yap_InitErrorPreds(void) {
CACHE_REGS
Yap_InitCPred("$print_exception", 1, print_exception, 0);
Yap_InitCPred("$print_exception<", 1, print_exception, 0);
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);

View File

@ -95,34 +95,27 @@ if (APPLE)
endif()
option (WITH_EXTENSIONS "packages and libraries that add value to YAP" ON)
if (ANDROID)
OPTION(WITH_MYDDAS " Enable MYDDAS driver" ON)
OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ON)
elseif(WITH_EXTENSIONS)
if (WITH_MYDDAS)
OPTION(WITH_MYSQL " Enable MYDDAS MYSQL driver" ON)
OPTION(WITH_ODBC " Enable MYDDAS ODBC driver" ON)
OPTION(WITH_POSTGRES " Enable MYDDAS POSTGRES driver" ON)
OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ON)
endif()
OPTION(WITH_SWIG " Enable SWIG interfaces to foreign languages" ON)
OPTION(WITH_RAPTOR " Enable the RAPTOR RDF library" ON)
OPTION(WITH_XML2 " Enable the RAPTOR XML2 library" ON)
OPTION(WITH_XML " Enable the Prolog XML library" ON)
OPTION(WITH_CLPBN" Enable the CLPBN and PFL probabilistic languages" ON)
IF (WITH_CLPBN)
OPTION(WITH_HORUS " Enable the HORUS inference libraray for CLPBN and PFL" ON)
ENDIF()
option(WITH_PROBLOG "include Problog-I." ON)
OPTION(WITH_CPLINT " Enable the cplint probabilistic language" ON)
option(WITH_GECODE "interface gecode constraint solver" ON)
option(WITH_LBFGS "interface with lbfgs" ON)
option(WITH_PRISM "use PRISM system in YAP" ON)
option(WITH_PYTHON "Allow Python->YAP and YAP->Python" ON)
option(WITH_R "Use R Interface" ON)
option(WITH_JAVA "Try to use Java (currently Java 6,7,8)" ON)
endif()
OPTION(WITH_MYDDAS " Enable MYDDAS driver" ${WITH_EXTENSIONS})
OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ${WITH_MYDDAS})
OPTION(WITH_MYSQL " Enable MYDDAS MYSQL driver" ${WITH_MYDDAS})
OPTION(WITH_ODBC " Enable MYDDAS ODBC driver" ${WITH_MYDDAS})
OPTION(WITH_POSTGRES " Enable MYDDAS POSTGRES driver" ${WITH_MYDDAS})
OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ${WITH_MYDDAS})
OPTION(WITH_SWIG " Enable SWIG interfaces to foreign languages" ${WITH_EXTENSIONS})
OPTION(WITH_RAPTOR " Enable the RAPTOR RDF library" ${WITH_EXTENSIONS})
OPTION(WITH_XML2 " Enable the RAPTOR XML2 library" ${WITH_EXTENSIONS})
OPTION(WITH_XML " Enable the Prolog XML library" ${WITH_EXTENSIONS})
OPTION(WITH_CLPBN" Enable the CLPBN and PFL probabilistic languages" ${WITH_EXTENSIONS})
OPTION(WITH_HORUS " Enable the HORUS inference libraray for CLPBN and PFL" ${WITH_CLPBN})
option(WITH_PROBLOG "include Problog-I." ${WITH_EXTENSIONS})
OPTION(WITH_CPLINT " Enable the cplint probabilistic language" ${WITH_EXTENSIONS})
option(WITH_GECODE "interface gecode constraint solver" ${WITH_EXTENSIONS})
option(WITH_LBFGS "interface with lbfgs" ${WITH_EXTENSIONS})
option(WITH_PRISM "use PRISM system in YAP" ${WITH_EXTENSIONS})
option(WITH_PYTHON "Allow Python->YAP and YAP->Python" ${WITH_EXTENSIONS})
option(WITH_R "Use R Interface" ${WITH_EXTENSIONS})
option(WITH_JAVA "Try to use Java (currently Java 6,7,8)" ${WITH_EXTENSIONS})
set(CMAKE_POSITION_INDEPENDENT_CODE TRUE)
set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE)

24
H/Yap.h
View File

@ -50,7 +50,7 @@
#endif /* THREADS && (YAPOR_COW || YAPOR_SBA || YAPOR_COPY) */
// Bad export from Python
#include "config.h"
#include "YapConfig.h"
#ifndef COROUTINING
#define COROUTINING 1
@ -74,6 +74,28 @@
#include <stdint.h>
#endif
typedef YAP_Int Int;
typedef YAP_UInt UInt;
typedef YAP_Short Short;
typedef YAP_UShort UShort;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
typedef YAP_CELL CELL;
typedef YAP_Term Term;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
typedef YAP_Int Int;
typedef YAP_Float Float;
typedef YAP_handle_t yhandle_t;
#define TermZERO ((Term)0)
/*
#define RATIONAL_TREES 1

View File

@ -1,116 +0,0 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: Yap.h *
* mods: *
* comments: abstract type definitions for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
#ifndef YAP_H
#include "YapTermConfig.h"
#include "config.h"
typedef void *Functor;
typedef void *Atom;
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#define ALIGN_BY_TYPE(X, TYPE) \
(((CELL)(X) + (sizeof(TYPE) - 1)) & ~(sizeof(TYPE) - 1))
#ifndef EXTERN
#ifdef MSC_VER
#define EXTERN
#else
#define EXTERN extern
#endif
#endif
/* defines integer types Int and UInt (unsigned) with the same size as a ptr
** and integer types Short and UShort with half the size of a ptr */
#if defined(PRIdPTR)
typedef intptr_t Int;
typedef uintptr_t UInt;
#elif defined(_WIN64)
typedef int64_t Int;
typedef uint64_t UInt;
#elif defined(_WIN32)
typedef int32_t Int;
typedef uint32_t UInt;
#elif SIZEOF_LONG_INT == SIZEOF_INT_P
typedef long int Int;
typedef unsigned long int UInt;
#elif SIZEOF_INT == SIZEOF_INT_P
typedef int Int;
typedef unsigned int UInt;
#else
#error Yap require integer types of the same size as a pointer
#endif
/* */ typedef short int Short;
/* */ typedef unsigned short int UShort;
typedef UInt CELL;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
#include "YapFormat.h"
/*************************************************************************************************
type casting macros
*************************************************************************************************/
typedef UInt Term;
typedef Int yhandle_t;
typedef double Float;
#if SIZEOF_INT < SIZEOF_INT_P
#define SHORT_INTS 1
#else
#define SHORT_INTS 0
#endif
#ifdef __GNUC__
typedef long long int YAP_LONG_LONG;
typedef unsigned long long int YAP_ULONG_LONG;
#else
typedef long int YAP_LONG_LONG;
typedef unsigned long int YAP_ULONG_LONG;
#endif
#define Unsigned(V) ((CELL)(V))
#define Signed(V) ((Int)(V))

View File

@ -128,6 +128,7 @@ extern X_API Int YAP_RunGoalOnce(Term);
/* cdmgr.c */
extern Term Yap_all_calls(void);
extern Atom Yap_ConsultingFile(USES_REGS1);
extern bool Yap_Consulting(USES_REGS1);
extern struct pred_entry *Yap_PredForChoicePt(choiceptr bptr, op_numbers *op);
extern void Yap_InitCdMgr(void);
extern struct pred_entry *Yap_PredFromClause(Term t USES_REGS);

View File

@ -55,4 +55,6 @@
#endif
#include "YapTerm.h"
#endif

View File

@ -2115,4 +2115,6 @@ calls it, or to nothing if 'inline' is not supported under any name. */
#endif
#endif
#include "YapTermConfig.h"
#endif

View File

@ -50,35 +50,6 @@
#include <stdio.h>
#include <stdlib.h>
/* The YAP main types */
#include "YapTerm.h"
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
/**
FALSE and TRUE are the pre-standard versions,
still widely used.
*/
#ifndef TRUE
#define TRUE true
#endif
#ifndef FALSE
#define FALSE false
#endif
#ifndef YAP_Bool
typedef bool YAP_Bool;
#endif
/**
This term can never be constructed as a valid term, so it is
used as a "BAD" term
*/
#define TermZERO ((Term)0)
#include "YapConfig.h"

View File

@ -13,17 +13,11 @@
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
#ifndef YAP_H
#include "YapTermConfig.h"
#include "config.h"
#include <stddef.h>
#endif
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#if HAVE_STDTYPES_H
#include <stdtypes.h>
#endif
/* truth-values */
@ -41,6 +35,13 @@ typedef int _Bool;
#endif
#endif /* HAVE_STDBOOL_H */
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#if HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#define ALIGN_BY_TYPE(X, TYPE) \
(((CELL)(X) + (sizeof(TYPE) - 1)) & ~(sizeof(TYPE) - 1))
@ -113,31 +114,6 @@ typedef void *YAP_Atom;
typedef void *YAP_Functor;
#ifdef YAP_H
typedef YAP_Int Int;
typedef YAP_UInt UInt;
typedef YAP_Short Short;
typedef YAP_UShort UShort;
typedef uint16_t BITS16;
typedef int16_t SBITS16;
typedef uint32_t BITS32;
typedef YAP_CELL CELL;
typedef YAP_Term Term;
#define WordSize sizeof(BITS16)
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
typedef YAP_Int Int;
typedef YAP_Float Float;
typedef YAP_handle_t yhandle_t;
#endif
#include "YapError.h"
#include "../os/encoding.h"

View File

@ -210,6 +210,7 @@ compose_message(error(E, Exc), Level) -->
c_goal( error(E, Exc), Level ),
caller( error(E, Exc), Level ),
extra_info( error(E, Exc), Level ),
% { stop_low_level_trace },
!,
[nl],
[nl].
@ -255,16 +256,16 @@ compose_message(Throw, _Level) -->
!,
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
location(error(syntax_error(_),Info), _Level , LC) -->
location( error(_,Info), Level, _LC ) -->
{ '$error_descriptor'(Info, Desc) },
{ query_exception(parserReadingCode, Desc, true) },
{LC > 0},
{ query_exception(prologConsulting, Desc, true) },
{ query_exception(parserReadingCode, Desc, true)},
!,
{
query_exception(parserFile, Desc, FileName),
query_exception(parserLine, Desc, LN)
},
[ '~a:~d:~d: ' - [FileName,LN,0] ] .
[ '~a:~d:~d: ~a:' - [FileName,LN,0,Level] ] .
location(style_check(A,LN,FileName,B ), Level , LC) -->
!,
display_consulting( FileName, Level,style_check(A,LN,FileName,B ), LC ),
@ -310,7 +311,7 @@ main_message( error(syntax_error(Msg),Info), Level, _LC ) -->
query_exception(parserTextB, Desc, T),
query_exception(parserLine, Desc, L)
},
[' ~a: syntax error ~s' - [Level,Msg]],
[' syntax error ~s' - [Level,Msg]],
[nl],
[' ~s <<== at line ~d == ~s !' - [J,L,T], nl ].
main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) -->
@ -379,7 +380,6 @@ display_consulting( F, Level, _, LC) -->
display_consulting(_F, _, _, _LC) -->
[].
c_goal( error(syntax_error(_),Info), _) --> !.
c_goal( error(_,Info), _) -->
{ '$error_descriptor'(Info, Desc) },
({ query_exception(errorGoal, Desc, Call),
@ -399,6 +399,7 @@ c_goal( error(_,Info), _) -->
!.
c_goal(_,_) --> [].
caller( error(syntax_error(_),_Info), _Level ) --> !.
caller( error(_,Info), Level ) -->
{ '$error_descriptor'(Info, Desc) },
{ query_exception(errorFile, Desc, File),