linux backport
file exists system predicate $source_file -> $user source hide and make system preds fix check_head_and_body user_expansion never fails goal expansion is controlled b dynamic procedure add must_be_of_type predicate_indicator fix neat_call, debug flag is user controlled use simplecudd, not ptoblogbdd compile all of myddas fx junk in file_name fix warnings use common file opening struct and funds avoid pairs module fix db queues
This commit is contained in:
parent
c0f00e7a0f
commit
50c8724322
10
.gitignore
vendored
10
.gitignore
vendored
@ -123,3 +123,13 @@ packages/swig/java/*wrap*
|
||||
*.jar
|
||||
|
||||
packages/cplint/approx/simplecuddLPADs/LPADBDD
|
||||
|
||||
packages/swi-minisat2/˜:ilp
|
||||
|
||||
packages/cplint/L
|
||||
|
||||
packages/CLPBN/horus/hcli
|
||||
|
||||
packages/bdd/simplecudd/problogbdd
|
||||
|
||||
packages/bdd/cudd_config.h
|
||||
|
24
C/cdmgr.c
24
C/cdmgr.c
@ -2142,14 +2142,14 @@ static Int p_is_no_trace(USES_REGS1) { /* '$undefined'(P,Mod) */
|
||||
|
||||
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
|
||||
if (EndOfPAEntr(pe))
|
||||
return TRUE;
|
||||
return true;
|
||||
PELOCK(36, pe);
|
||||
if (pe->PredFlags & NoTracePredFlag) {
|
||||
if (pe->PredFlags & (NoTracePredFlag|HiddenPredFlag)) {
|
||||
UNLOCKPE(57, pe);
|
||||
return TRUE;
|
||||
return true;
|
||||
}
|
||||
UNLOCKPE(59, pe);
|
||||
return FALSE;
|
||||
return false;
|
||||
}
|
||||
|
||||
static Int p_set_no_trace(USES_REGS1) { /* '$set_no_trace'(+Fun,+M) */
|
||||
@ -2438,7 +2438,7 @@ static Int
|
||||
bool out;
|
||||
|
||||
pe = get_pred(Deref(ARG1), Deref(ARG2), "system_predicate");
|
||||
if (EndOfPAEntr(pe))
|
||||
if (EndOfPAEntr(pe) || pe->OpcodeOfPred == UNDEF_OPCODE)
|
||||
return FALSE;
|
||||
PELOCK(27, pe);
|
||||
out = (pe->PredFlags & SystemPredFlags);
|
||||
@ -2984,7 +2984,7 @@ restart_system_pred:
|
||||
}
|
||||
|
||||
static Int /* $system_predicate(P) */
|
||||
p_hide_predicate(USES_REGS1) {
|
||||
hide_predicate(USES_REGS1) {
|
||||
PredEntry *pe;
|
||||
|
||||
Term t1 = Deref(ARG1);
|
||||
@ -3017,13 +3017,13 @@ restart_system_pred:
|
||||
}
|
||||
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
|
||||
} else if (IsPairTerm(t1)) {
|
||||
return TRUE;
|
||||
return true;
|
||||
} else
|
||||
return FALSE;
|
||||
return false;
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
pe->PredFlags |= (HiddenPredFlag | NoTracePredFlag);
|
||||
return TRUE;
|
||||
return false;
|
||||
pe->PredFlags |= (NoSpyPredFlag|NoTracePredFlag);
|
||||
return true;
|
||||
}
|
||||
|
||||
static Int /* $hidden_predicate(P) */
|
||||
@ -4648,7 +4648,7 @@ void Yap_InitCdMgr(void) {
|
||||
SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
|
||||
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
|
||||
Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
|
||||
Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag);
|
||||
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
|
||||
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
|
||||
Yap_InitCPred("$log_update_clause", 4, p_log_update_clause, SyncPredFlag);
|
||||
|
17
C/cmppreds.c
17
C/cmppreds.c
@ -556,13 +556,28 @@ p_compare( USES_REGS1 )
|
||||
{ /* compare(?Op,?T1,?T2) */
|
||||
Int r = compare(Deref(ARG2), Deref(ARG3));
|
||||
Atom p;
|
||||
|
||||
Term t = Deref(ARG1);
|
||||
if (r < 0)
|
||||
p = AtomLT;
|
||||
else if (r > 0)
|
||||
p = AtomGT;
|
||||
else
|
||||
p = AtomEQ;
|
||||
if (!IsVarTerm(t)) {
|
||||
if (IsAtomTerm(t)) {
|
||||
Atom a = AtomOfTerm(t);
|
||||
if (a == p)
|
||||
return true;
|
||||
if (a != AtomLT &&
|
||||
a != AtomGT &&
|
||||
a != AtomEq)
|
||||
Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
return Yap_unify_constant(ARG1, MkAtomTerm(p));
|
||||
}
|
||||
|
||||
|
22
C/dbase.c
22
C/dbase.c
@ -5106,7 +5106,8 @@ static Int p_dequeue(USES_REGS1) {
|
||||
db_queue *father_key;
|
||||
QueueEntry *cur_instance;
|
||||
Term Father = Deref(ARG1);
|
||||
|
||||
Int rc;
|
||||
|
||||
if (IsVarTerm(Father)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, Father, "dequeue");
|
||||
return FALSE;
|
||||
@ -5120,16 +5121,11 @@ static Int p_dequeue(USES_REGS1) {
|
||||
/* an empty queue automatically goes away */
|
||||
WRITE_UNLOCK(father_key->QRWLock);
|
||||
FreeDBSpace((char *)father_key);
|
||||
return FALSE;
|
||||
return false;
|
||||
}
|
||||
if (!Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS))
|
||||
return FALSE;
|
||||
if (cur_instance == father_key->LastInQueue)
|
||||
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
||||
else
|
||||
father_key->FirstInQueue = cur_instance->next;
|
||||
rc = Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS);
|
||||
WRITE_UNLOCK(father_key->QRWLock);
|
||||
return TRUE;
|
||||
return rc;
|
||||
}
|
||||
}
|
||||
|
||||
@ -5151,13 +5147,7 @@ static Int p_dequeue_unlocked(USES_REGS1) {
|
||||
FreeDBSpace((char *)father_key);
|
||||
return FALSE;
|
||||
}
|
||||
if (!Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS))
|
||||
return FALSE;
|
||||
if (cur_instance == father_key->LastInQueue)
|
||||
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
||||
else
|
||||
father_key->FirstInQueue = cur_instance->next;
|
||||
return TRUE;
|
||||
return Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS);
|
||||
}
|
||||
}
|
||||
|
||||
|
30
C/errors.c
30
C/errors.c
@ -655,6 +655,35 @@ is_callable( USES_REGS1 )
|
||||
return false;
|
||||
}
|
||||
|
||||
static Int
|
||||
is_predicate_indicator( USES_REGS1 )
|
||||
{
|
||||
Term G = Deref(ARG1);
|
||||
//Term Context = Deref(ARG2);
|
||||
Term mod = CurrentModule;
|
||||
|
||||
G = Yap_YapStripModule(G, &mod);
|
||||
if (IsVarTerm(G)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, G, NULL);
|
||||
return false;
|
||||
}
|
||||
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
|
||||
return false;
|
||||
}
|
||||
if (IsApplTerm(G)) {
|
||||
Functor f = FunctorOfTerm(G);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
|
||||
}
|
||||
if (f == FunctorSlash || f == FunctorDoubleSlash) {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Yap_InitErrorPreds( void )
|
||||
@ -664,5 +693,6 @@ Yap_InitErrorPreds( void )
|
||||
CurrentModule = ERROR_MODULE;
|
||||
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag);
|
||||
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);
|
||||
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, TestPredFlag);
|
||||
CurrentModule = cm;
|
||||
}
|
||||
|
@ -923,8 +923,9 @@ static PropEntry *nextPredForAtom(PropEntry *p, Term task) {
|
||||
if (p == NIL)
|
||||
return NIL;
|
||||
pe = RepPredProp(p);
|
||||
if (pe->ArityOfPE == 0) {
|
||||
// if atom prop, search atom list
|
||||
if (pe->ArityOfPE == 0 ||
|
||||
(pe->PredFlags & (NumberDBPredFlag |AtomDBPredFlag) ) ) {
|
||||
// if atom prop, search atom list
|
||||
return followLinkedListOfProps(p->NextOfPE, task);
|
||||
} else {
|
||||
FunctorEntry *f = pe->FunctorOfPred;
|
||||
@ -1060,7 +1061,7 @@ static Int cont_current_predicate(USES_REGS1) {
|
||||
}
|
||||
} else if (IsNonVarTerm(t1)) {
|
||||
PropEntry *np, *p;
|
||||
// run over the same atomany predicate defined for that atom
|
||||
// run over the same atom any predicate defined for that atom
|
||||
// may be fair bait, depends on whether we know the module.
|
||||
p = AbsPredProp(pp);
|
||||
if (!p) {
|
||||
@ -1114,6 +1115,7 @@ static Int cont_current_predicate(USES_REGS1) {
|
||||
// operating across all modules.
|
||||
PredEntry *npp = pp;
|
||||
ModEntry *me;
|
||||
|
||||
if (!pp) {
|
||||
pp = firstModulesPred(CurrentModules->PredForME, CurrentModules, task);
|
||||
}
|
||||
|
@ -12,6 +12,8 @@ cmake_minimum_required(VERSION 2.8)
|
||||
# set path to additional CMake modules
|
||||
set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH})
|
||||
|
||||
|
||||
|
||||
# set(CMAKE_BUILD_TYPE Debug)
|
||||
|
||||
set (MACOSX_RPATH ON)
|
||||
|
@ -61,7 +61,7 @@ functions are then exported through corresponding FLI C-functions
|
||||
#define Yap_RebootSlots(wid) Yap_RebootSlots__(wid PASS_REGS)
|
||||
|
||||
static inline void Yap_RebootSlots__(int wid USES_REGS) {
|
||||
// // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
|
||||
// fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot);
|
||||
REMOTE_CurSlot(wid) = 1;
|
||||
}
|
||||
|
||||
@ -166,9 +166,9 @@ INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) {
|
||||
}
|
||||
|
||||
/// @brief create a new slot with term t
|
||||
// #define Yap_InitSlot(t) \
|
||||
// (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__) \
|
||||
// ? Yap_InitSlot__(t PASS_REGS) \
|
||||
// #define Yap_InitSlot(t)
|
||||
// (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__)
|
||||
// ? Yap_InitSlot__(t PASS_REGS)
|
||||
// : -1)
|
||||
#define Yap_InitSlot(t) Yap_InitSlot__(t PASS_REGS)
|
||||
|
||||
@ -199,9 +199,9 @@ INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS) {
|
||||
return old_slots;
|
||||
}
|
||||
|
||||
//#define Yap_InitSlots(n, ts) \
|
||||
// (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__) \
|
||||
// ? Yap_InitSlots__(n, ts PASS_REGS) \
|
||||
//#define Yap_InitSlots(n, ts)
|
||||
// (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__)
|
||||
// ? Yap_InitSlots__(n, ts PASS_REGS)
|
||||
// : -1)
|
||||
#define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS)
|
||||
|
||||
|
@ -13,13 +13,14 @@ ENDIF (MYSQL_INCLUDE_DIR)
|
||||
FIND_PATH(MYSQL_INCLUDE_DIR mysql.h
|
||||
/usr/local/include/mysql
|
||||
/usr/include/mysql
|
||||
/usr/include/mariadb
|
||||
)
|
||||
|
||||
SET(MYSQL_NAMES mysqlclient mysqlclient_r)
|
||||
SET(MYSQL_NAMES mysqlclient mysqlclient_r mariadb )
|
||||
FIND_LIBRARY(MYSQL_LIBRARY
|
||||
NAMES ${MYSQL_NAMES}
|
||||
PATHS /usr/lib /usr/local/lib
|
||||
PATH_SUFFIXES mysql
|
||||
PATH_SUFFIXES mysql mariadb
|
||||
)
|
||||
|
||||
IF (MYSQL_INCLUDE_DIR AND MYSQL_LIBRARY)
|
||||
|
192
cmake/FindPostgreSQL.cmake
Normal file
192
cmake/FindPostgreSQL.cmake
Normal file
@ -0,0 +1,192 @@
|
||||
#.rst:
|
||||
# FindPostgreSQL
|
||||
# --------------
|
||||
#
|
||||
# Find the PostgreSQL installation.
|
||||
#
|
||||
# This module defines
|
||||
#
|
||||
# ::
|
||||
#
|
||||
# PostgreSQL_LIBRARIES - the PostgreSQL libraries needed for linking
|
||||
# PostgreSQL_INCLUDE_DIRS - the directories of the PostgreSQL headers
|
||||
# PostgreSQL_LIBRARY_DIRS - the link directories for PostgreSQL libraries
|
||||
# PostgreSQL_VERSION_STRING - the version of PostgreSQL found (since CMake 2.8.8)
|
||||
|
||||
#=============================================================================
|
||||
# Copyright 2004-2009 Kitware, Inc.
|
||||
#
|
||||
# Distributed under the OSI-approved BSD License (the "License");
|
||||
# see accompanying file Copyright.txt for details.
|
||||
#
|
||||
# This software is distributed WITHOUT ANY WARRANTY; without even the
|
||||
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
# See the License for more information.
|
||||
#=============================================================================
|
||||
# (To distribute this file outside of CMake, substitute the full
|
||||
# License text for the above reference.)
|
||||
|
||||
# ----------------------------------------------------------------------------
|
||||
# History:
|
||||
# This module is derived from the module originally found in the VTK source tree.
|
||||
#
|
||||
# ----------------------------------------------------------------------------
|
||||
# Note:
|
||||
# PostgreSQL_ADDITIONAL_VERSIONS is a variable that can be used to set the
|
||||
# version mumber of the implementation of PostgreSQL.
|
||||
# In Windows the default installation of PostgreSQL uses that as part of the path.
|
||||
# E.g C:\Program Files\PostgreSQL\8.4.
|
||||
# Currently, the following version numbers are known to this module:
|
||||
# "9.4" "9.3" "9.2" "9.1" "9.0" "8.4" "8.3" "8.2" "8.1" "8.0"
|
||||
#
|
||||
# To use this variable just do something like this:
|
||||
# set(PostgreSQL_ADDITIONAL_VERSIONS "9.2" "8.4.4")
|
||||
# before calling find_package(PostgreSQL) in your CMakeLists.txt file.
|
||||
# This will mean that the versions you set here will be found first in the order
|
||||
# specified before the default ones are searched.
|
||||
#
|
||||
# ----------------------------------------------------------------------------
|
||||
# You may need to manually set:
|
||||
# PostgreSQL_INCLUDE_DIR - the path to where the PostgreSQL include files are.
|
||||
# PostgreSQL_LIBRARY_DIR - The path to where the PostgreSQL library files are.
|
||||
# If FindPostgreSQL.cmake cannot find the include files or the library files.
|
||||
#
|
||||
# ----------------------------------------------------------------------------
|
||||
# The following variables are set if PostgreSQL is found:
|
||||
# PostgreSQL_FOUND - Set to true when PostgreSQL is found.
|
||||
# PostgreSQL_INCLUDE_DIRS - Include directories for PostgreSQL
|
||||
# PostgreSQL_LIBRARY_DIRS - Link directories for PostgreSQL libraries
|
||||
# PostgreSQL_LIBRARIES - The PostgreSQL libraries.
|
||||
#
|
||||
# ----------------------------------------------------------------------------
|
||||
# If you have installed PostgreSQL in a non-standard location.
|
||||
# (Please note that in the following comments, it is assumed that <Your Path>
|
||||
# points to the root directory of the include directory of PostgreSQL.)
|
||||
# Then you have three options.
|
||||
# 1) After CMake runs, set PostgreSQL_INCLUDE_DIR to <Your Path>/include and
|
||||
# PostgreSQL_LIBRARY_DIR to wherever the library pq (or libpq in windows) is
|
||||
# 2) Use CMAKE_INCLUDE_PATH to set a path to <Your Path>/PostgreSQL<-version>. This will allow find_path()
|
||||
# to locate PostgreSQL_INCLUDE_DIR by utilizing the PATH_SUFFIXES option. e.g. In your CMakeLists.txt file
|
||||
# set(CMAKE_INCLUDE_PATH ${CMAKE_INCLUDE_PATH} "<Your Path>/include")
|
||||
# 3) Set an environment variable called ${PostgreSQL_ROOT} that points to the root of where you have
|
||||
# installed PostgreSQL, e.g. <Your Path>.
|
||||
#
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
set(PostgreSQL_INCLUDE_PATH_DESCRIPTION "top-level directory containing the PostgreSQL include directories. E.g /usr/local/include/PostgreSQL/8.4 or C:/Program Files/PostgreSQL/8.4/include")
|
||||
set(PostgreSQL_INCLUDE_DIR_MESSAGE "Set the PostgreSQL_INCLUDE_DIR cmake cache entry to the ${PostgreSQL_INCLUDE_PATH_DESCRIPTION}")
|
||||
set(PostgreSQL_LIBRARY_PATH_DESCRIPTION "top-level directory containing the PostgreSQL libraries.")
|
||||
set(PostgreSQL_LIBRARY_DIR_MESSAGE "Set the PostgreSQL_LIBRARY_DIR cmake cache entry to the ${PostgreSQL_LIBRARY_PATH_DESCRIPTION}")
|
||||
set(PostgreSQL_ROOT_DIR_MESSAGE "Set the PostgreSQL_ROOT system variable to where PostgreSQL is found on the machine E.g C:/Program Files/PostgreSQL/8.4")
|
||||
|
||||
|
||||
set(PostgreSQL_KNOWN_VERSIONS ${PostgreSQL_ADDITIONAL_VERSIONS}
|
||||
"9.5" "9.4" "9.3" "9.2" "9.1" "9.0" "8.4" "8.3" "8.2" "8.1" "8.0")
|
||||
|
||||
# Define additional search paths for root directories.
|
||||
set( PostgreSQL_ROOT_DIRECTORIES
|
||||
ENV PostgreSQL_ROOT
|
||||
${PostgreSQL_ROOT}
|
||||
)
|
||||
foreach(suffix ${PostgreSQL_KNOWN_VERSIONS})
|
||||
if(WIN32)
|
||||
list(APPEND PostgreSQL_LIBRARY_ADDITIONAL_SEARCH_SUFFIXES
|
||||
"PostgreSQL/${suffix}/lib")
|
||||
list(APPEND PostgreSQL_INCLUDE_ADDITIONAL_SEARCH_SUFFIXES
|
||||
"PostgreSQL/${suffix}/include")
|
||||
list(APPEND PostgreSQL_TYPE_ADDITIONAL_SEARCH_SUFFIXES
|
||||
"PostgreSQL/${suffix}/include/server")
|
||||
endif()
|
||||
if(UNIX)
|
||||
list(APPEND PostgreSQL_TYPE_ADDITIONAL_SEARCH_SUFFIXES
|
||||
"postgresql/${suffix}/server")
|
||||
endif()
|
||||
endforeach()
|
||||
|
||||
#
|
||||
# Look for an installation.
|
||||
#
|
||||
find_path(PostgreSQL_INCLUDE_DIR
|
||||
NAMES libpq-fe.h
|
||||
PATHS
|
||||
# Look in other places.
|
||||
${PostgreSQL_ROOT_DIRECTORIES}
|
||||
PATH_SUFFIXES
|
||||
pgsql
|
||||
postgresql
|
||||
include
|
||||
${PostgreSQL_INCLUDE_ADDITIONAL_SEARCH_SUFFIXES}
|
||||
# Help the user find it if we cannot.
|
||||
DOC "The ${PostgreSQL_INCLUDE_DIR_MESSAGE}"
|
||||
)
|
||||
|
||||
find_path(PostgreSQL_TYPE_INCLUDE_DIR
|
||||
NAMES catalog/pg_type.h
|
||||
PATHS
|
||||
# Look in other places.
|
||||
${PostgreSQL_ROOT_DIRECTORIES}
|
||||
PATH_SUFFIXES
|
||||
postgresql
|
||||
pgsql/server
|
||||
postgresql/server
|
||||
include/server
|
||||
${PostgreSQL_TYPE_ADDITIONAL_SEARCH_SUFFIXES}
|
||||
# Help the user find it if we cannot.
|
||||
DOC "The ${PostgreSQL_INCLUDE_DIR_MESSAGE}"
|
||||
)
|
||||
|
||||
# The PostgreSQL library.
|
||||
set (PostgreSQL_LIBRARY_TO_FIND pq)
|
||||
# Setting some more prefixes for the library
|
||||
set (PostgreSQL_LIB_PREFIX "")
|
||||
if ( WIN32 )
|
||||
set (PostgreSQL_LIB_PREFIX ${PostgreSQL_LIB_PREFIX} "lib")
|
||||
set (PostgreSQL_LIBRARY_TO_FIND ${PostgreSQL_LIB_PREFIX}${PostgreSQL_LIBRARY_TO_FIND})
|
||||
endif()
|
||||
|
||||
find_library(PostgreSQL_LIBRARY
|
||||
NAMES ${PostgreSQL_LIBRARY_TO_FIND}
|
||||
PATHS
|
||||
${PostgreSQL_ROOT_DIRECTORIES}
|
||||
PATH_SUFFIXES
|
||||
lib
|
||||
${PostgreSQL_LIBRARY_ADDITIONAL_SEARCH_SUFFIXES}
|
||||
# Help the user find it if we cannot.
|
||||
DOC "The ${PostgreSQL_LIBRARY_DIR_MESSAGE}"
|
||||
)
|
||||
get_filename_component(PostgreSQL_LIBRARY_DIR ${PostgreSQL_LIBRARY} PATH)
|
||||
|
||||
if (PostgreSQL_INCLUDE_DIR)
|
||||
# Some platforms include multiple pg_config.hs for multi-lib configurations
|
||||
# This is a temporary workaround. A better solution would be to compile
|
||||
# a dummy c file and extract the value of the symbol.
|
||||
file(GLOB _PG_CONFIG_HEADERS "${PostgreSQL_INCLUDE_DIR}/pg_config*.h")
|
||||
foreach(_PG_CONFIG_HEADER ${_PG_CONFIG_HEADERS})
|
||||
if(EXISTS "${_PG_CONFIG_HEADER}")
|
||||
file(STRINGS "${_PG_CONFIG_HEADER}" pgsql_version_str
|
||||
REGEX "^#define[\t ]+PG_VERSION[\t ]+\".*\"")
|
||||
if(pgsql_version_str)
|
||||
string(REGEX REPLACE "^#define[\t ]+PG_VERSION[\t ]+\"([^\"]*)\".*"
|
||||
"\\1" PostgreSQL_VERSION_STRING "${pgsql_version_str}")
|
||||
break()
|
||||
endif()
|
||||
endif()
|
||||
endforeach()
|
||||
unset(pgsql_version_str)
|
||||
endif()
|
||||
|
||||
# Did we find anything?
|
||||
#nclude(${CMAKE_CURRENT_LIST_DIR}/FindPackageHandleStandardArgs.cmake)
|
||||
find_package_handle_standard_args(PostgreSQL
|
||||
REQUIRED_VARS PostgreSQL_LIBRARY PostgreSQL_INCLUDE_DIR PostgreSQL_TYPE_INCLUDE_DIR
|
||||
VERSION_VAR PostgreSQL_VERSION_STRING)
|
||||
set(PostgreSQL_FOUND ${POSTGRESQL_FOUND})
|
||||
|
||||
# Now try to get the include and library path.
|
||||
if(PostgreSQL_FOUND)
|
||||
set(PostgreSQL_INCLUDE_DIRS ${PostgreSQL_INCLUDE_DIR} ${PostgreSQL_TYPE_INCLUDE_DIR} )
|
||||
set(PostgreSQL_LIBRARY_DIRS ${PostgreSQL_LIBRARY_DIR} )
|
||||
set(PostgreSQL_LIBRARIES ${PostgreSQL_LIBRARY_TO_FIND})
|
||||
endif()
|
||||
|
||||
mark_as_advanced(PostgreSQL_INCLUDE_DIR PostgreSQL_TYPE_INCLUDE_DIR PostgreSQL_LIBRARY )
|
@ -34,9 +34,10 @@ E(DOMAIN_ERROR_NON_EMPTY_LIST, DOMAIN_ERROR, "non_empty_list")
|
||||
E(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, DOMAIN_ERROR, "not_less_than_zero")
|
||||
E(DOMAIN_ERROR_NOT_NL, DOMAIN_ERROR, "not_nl")
|
||||
E(DOMAIN_ERROR_NOT_ZERO, DOMAIN_ERROR, "not_zero")
|
||||
E(DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR, "out_of_range")
|
||||
E(DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR, "operator_priority")
|
||||
E(DOMAIN_ERROR_OPERATOR_SPECIFIER, DOMAIN_ERROR, "operator_specifier")
|
||||
E(DOMAIN_ERROR_ORDER, DOMAIN_ERROR, "order")
|
||||
E(DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR, "out_of_range")
|
||||
E(DOMAIN_ERROR_PROLOG_FLAG, DOMAIN_ERROR, "prolog_flag")
|
||||
E(DOMAIN_ERROR_RADIX, DOMAIN_ERROR, "radix")
|
||||
E(DOMAIN_ERROR_READ_OPTION, DOMAIN_ERROR, "read_option")
|
||||
|
@ -2,7 +2,7 @@
|
||||
set (MPI_SOURCES
|
||||
hash.c prologterms2c.c yap_mpi.c)
|
||||
|
||||
macro_optional_find_package(Mpi ON)
|
||||
macro_optional_find_package(MPI ON)
|
||||
macro_log_feature (MPI_C_FOUND "Mpi"
|
||||
"Use Mpi System"
|
||||
"http://www.mpi.org" FALSE)
|
||||
|
@ -125,7 +125,7 @@ random number generator. The integer `X` must be in the range
|
||||
|
||||
|
||||
*/
|
||||
:- use_module(library(pairs)).
|
||||
%:- use_module(library(pairs)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
|
||||
|
@ -204,15 +204,6 @@ that it is up to the user to close the pipe.
|
||||
The atom _File_ corresponds to an existing file.
|
||||
|
||||
|
||||
*/
|
||||
/** @pred file_exists(+ _File_,+ _Permissions_)
|
||||
|
||||
The atom _File_ corresponds to an existing file with permissions
|
||||
compatible with _Permissions_. YAP currently only accepts for
|
||||
permissions to be described as a number. The actual meaning of this
|
||||
number is Operating System dependent.
|
||||
|
||||
|
||||
*/
|
||||
/** @pred file_property(+ _File_,? _Property_)
|
||||
|
||||
@ -567,16 +558,6 @@ file_property(File, Type, Size, Date, Permissions, LinkName) :-
|
||||
file_property(File, Type, Size, Date, Permissions, LinkName, Error),
|
||||
handle_system_internal(Error, off, file_property(File)).
|
||||
|
||||
file_exists(File) :-
|
||||
var(File), !,
|
||||
throw(error(instantiation_error,file_exists(File))).
|
||||
file_exists(File) :-
|
||||
\+ atom(File), !,
|
||||
throw(error(type_error(atom,File),file_exists(File))).
|
||||
file_exists(IFile) :-
|
||||
true_file_name(IFile, File),
|
||||
file_property(File, _Type, _Size, _Date, _Permissions, _, Error),
|
||||
var(Error).
|
||||
|
||||
file_exists(File, Permissions) :-
|
||||
var(File), !,
|
||||
|
@ -32,14 +32,16 @@ tell(F) :-
|
||||
current_output(Stream),
|
||||
stream_property(Stream,file_name(F)),
|
||||
!.
|
||||
tell(F) :- current_stream(_,write,Stream), '$user_file_name'(Stream, F), !,
|
||||
tell(F) :-
|
||||
current_stream(_,write,Stream),
|
||||
'$user_file_name'(Stream, F), !,
|
||||
set_output(Stream).
|
||||
tell(Stream) :-
|
||||
'$stream'(Stream),
|
||||
current_stream(_,write,Stream), !,
|
||||
set_output(Stream).
|
||||
tell(F) :-
|
||||
open(F,write,Stream),
|
||||
open(F,append,Stream),
|
||||
set_output(Stream).
|
||||
|
||||
telling(File) :-
|
||||
@ -48,6 +50,7 @@ telling(File) :-
|
||||
( stream_property(user_output,file_name(NFile)) -> File = user ; File = NFile ).
|
||||
|
||||
told :- current_output(Stream),
|
||||
!,
|
||||
set_output(user),
|
||||
close(Stream).
|
||||
|
||||
|
49
os/files.c
49
os/files.c
@ -296,6 +296,36 @@ exists_file(USES_REGS1)
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
file_exists(USES_REGS1)
|
||||
{
|
||||
Term tname = Deref(ARG1);
|
||||
char *file_name;
|
||||
|
||||
if (IsVarTerm(tname)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, tname, "access");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm (tname)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
|
||||
return FALSE;
|
||||
} else {
|
||||
#if HAVE_STAT
|
||||
struct SYSTEM_STAT ss;
|
||||
|
||||
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
|
||||
if (SYSTEM_STAT(file_name, &ss) != 0) {
|
||||
if (errno == ENOENT)
|
||||
return false;
|
||||
PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, tname, "error %s", strerror(errno) );
|
||||
return false;
|
||||
}
|
||||
return true;
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
time_file(USES_REGS1)
|
||||
@ -501,10 +531,12 @@ file_base_name ( USES_REGS1 )
|
||||
while (i && !Yap_dir_separator((int)c[--i]));
|
||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(c+i)));
|
||||
} else {
|
||||
char *c = RepAtom(at)->StrOfAE;
|
||||
const char *c = RepAtom(at)->StrOfAE;
|
||||
char *s;
|
||||
#if HAVE_BASENAME
|
||||
s = basename( c );
|
||||
char c1[YAP_FILENAME_MAX+1];
|
||||
strncpy( c1, c, YAP_FILENAME_MAX);
|
||||
s = basename( c1 );
|
||||
#else
|
||||
Int i = strlen(c);
|
||||
while (i && !Yap_dir_separator((int)c[--i]));
|
||||
@ -524,7 +556,7 @@ file_directory_name ( USES_REGS1 )
|
||||
Atom at;
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
|
||||
return FALSE;
|
||||
return false;
|
||||
}
|
||||
at = AtomOfTerm(t);
|
||||
if (IsWideAtom(at)) {
|
||||
@ -538,12 +570,14 @@ file_directory_name ( USES_REGS1 )
|
||||
wcsncpy(s, c, i);
|
||||
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(s)));
|
||||
} else {
|
||||
char *c = RepAtom(at)->StrOfAE;
|
||||
const char *c = RepAtom(at)->StrOfAE;
|
||||
#if HAVE_BASENAME
|
||||
char *s;
|
||||
s = dirname( c );
|
||||
const char *s;
|
||||
char c1[YAP_FILENAME_MAX+1];
|
||||
strncpy( c1, c, YAP_FILENAME_MAX);
|
||||
s = dirname( c1 );
|
||||
#else
|
||||
char *s[YAP_FILENAME_MAX+1];
|
||||
char s[YAP_FILENAME_MAX+1];
|
||||
Int i = strlen(c);
|
||||
while (i && !Yap_dir_separator((int)c[--i]));
|
||||
if (Yap_dir_separator((int)c[i])) {
|
||||
@ -639,6 +673,7 @@ Yap_InitFiles( void )
|
||||
Yap_InitCPred ("access", 1, access_path, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("exists_directory", 1, exists_directory, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("exists_file", 1, exists_file, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$file_exists", 1, file_exists, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("time_file64", 2, time_file, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("time_file", 2, time_file, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("file_size", 2,file_size, SafePredFlag|SyncPredFlag);
|
||||
|
13
os/iopreds.c
13
os/iopreds.c
@ -355,8 +355,6 @@ Int PlIOError__(const char *file, const char *function, int lineno,
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef DEBUG
|
||||
|
||||
static int eolflg = 1;
|
||||
|
||||
static char my_line[200] = {0};
|
||||
@ -488,8 +486,6 @@ void Yap_DebugWriteIndicator(PredEntry *ap) {
|
||||
Yap_DebugPutc(stderr, '\n');
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* static */
|
||||
int FilePutc(int sno, int ch) {
|
||||
StreamDesc *s = &GLOBAL_Stream[sno];
|
||||
@ -1194,7 +1190,7 @@ static void check_bom(int sno, StreamDesc *st) {
|
||||
}
|
||||
}
|
||||
|
||||
static bool initStream(int sno, FILE *fd, const char *name, Term file_name,
|
||||
bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
|
||||
encoding_t encoding, stream_flags_t flags,
|
||||
Atom open_mode) {
|
||||
StreamDesc *st = &GLOBAL_Stream[sno];
|
||||
@ -1408,9 +1404,10 @@ do_open(Term file_name, Term t2,
|
||||
if (errno == ENOENT)
|
||||
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG6, "%s: %s", fname,
|
||||
strerror(errno)));
|
||||
else
|
||||
else {
|
||||
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s",
|
||||
fname, strerror(errno)));
|
||||
}
|
||||
}
|
||||
#if MAC
|
||||
if (open_mode == AtomWrite) {
|
||||
@ -1418,7 +1415,7 @@ do_open(Term file_name, Term t2,
|
||||
}
|
||||
#endif
|
||||
flags &= ~(Free_Stream_f);
|
||||
if (!initStream(sno, fd, fname, file_name, encoding, flags, open_mode))
|
||||
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode))
|
||||
return false;
|
||||
if (open_mode == AtomWrite) {
|
||||
if (needs_bom && !write_bom(sno, st))
|
||||
@ -1521,7 +1518,7 @@ int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) {
|
||||
at = AtomWrite;
|
||||
} else
|
||||
at = AtomRead;
|
||||
initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at);
|
||||
Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at);
|
||||
return sno;
|
||||
}
|
||||
|
||||
|
@ -50,6 +50,9 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
|
||||
af_unix /* or AF_FILE */
|
||||
} socket_domain;
|
||||
|
||||
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
|
||||
encoding_t encoding, stream_flags_t flags,
|
||||
Atom open_mode);
|
||||
extern Term Yap_InitSocketStream(int, socket_info, socket_domain);
|
||||
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
|
||||
extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
|
||||
|
30
os/mem.c
30
os/mem.c
@ -158,17 +158,30 @@ MemPutc(int sno, int ch)
|
||||
CACHE_REGS
|
||||
int sno;
|
||||
StreamDesc *st;
|
||||
|
||||
FILE *f;
|
||||
encoding_t encoding;
|
||||
stream_flags_t flags;
|
||||
|
||||
sno = GetFreeStreamD();
|
||||
if (sno < 0)
|
||||
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1"));
|
||||
st = &GLOBAL_Stream[sno];
|
||||
Yap_DefaultStreamOps( st );
|
||||
st = GLOBAL_Stream+sno;
|
||||
if (encp)
|
||||
encoding = *encp;
|
||||
else
|
||||
encoding = LOCAL_encoding;
|
||||
#if MAY_READ
|
||||
// like any file stream.
|
||||
st->status = Input_Stream_f | InMemory_Stream_f | Seekable_Stream_f;
|
||||
st->file = fmemopen( (void *)nbuf, nchars, "r");
|
||||
f = fmemopen( (void *)nbuf, nchars, "r");
|
||||
flags = Input_Stream_f | InMemory_Stream_f | Seekable_Stream_f;
|
||||
#else
|
||||
f = NULL;
|
||||
flags = Input_Stream_f | InMemory_Stream_f;
|
||||
#endif
|
||||
Yap_initStream(sno, f, NULL, TermNil,
|
||||
encoding, flags, AtomRead);
|
||||
// like any file stream.
|
||||
#if !MAY_READ
|
||||
/* currently these streams are not seekable */
|
||||
st->status = Input_Stream_f | InMemory_Stream_f;
|
||||
st->u.mem_string.pos = 0;
|
||||
@ -178,13 +191,6 @@ MemPutc(int sno, int ch)
|
||||
st->u.mem_string.src = src;
|
||||
#endif
|
||||
Yap_MemOps( st );
|
||||
st->linepos = 0;
|
||||
st->charcount = 0;
|
||||
st->linecount = 1;
|
||||
if (encp)
|
||||
st->encoding = *encp;
|
||||
else
|
||||
st->encoding = LOCAL_encoding;
|
||||
UNLOCK(st->streamlock);
|
||||
return sno;
|
||||
}
|
||||
|
@ -36,7 +36,7 @@ rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS)
|
||||
Int status;
|
||||
UInt max_inp, buf_sz, sz;
|
||||
char *buf;
|
||||
int binary_stream;
|
||||
bool binary_stream;
|
||||
|
||||
if (sno < 0)
|
||||
return FALSE;
|
||||
@ -118,12 +118,10 @@ read_line_to_string( USES_REGS1 )
|
||||
Int status;
|
||||
UInt max_inp, buf_sz;
|
||||
char *buf;
|
||||
int binary_stream;
|
||||
|
||||
if (sno < 0)
|
||||
return FALSE;
|
||||
status = GLOBAL_Stream[sno].status;
|
||||
binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f;
|
||||
if (status & Eof_Stream_f) {
|
||||
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
||||
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
|
||||
@ -149,7 +147,7 @@ read_line_to_string( USES_REGS1 )
|
||||
if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) {
|
||||
/* we're done */
|
||||
|
||||
if (!GLOBAL_Stream[sno].status & Eof_Stream_f) {
|
||||
if (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
|
||||
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
||||
/* handle CR before NL */
|
||||
if ((Int)sz-2 >= 0 && buf[sz-2] == 13)
|
||||
|
15
os/streams.c
15
os/streams.c
@ -255,18 +255,7 @@ static Int representation_error(int sno, Term t2 USES_REGS) {
|
||||
}
|
||||
|
||||
static Int file_name(int sno, Term t2 USES_REGS) {
|
||||
char s[MAXPATHLEN + 1];
|
||||
int f = Yap_GetStreamFd(sno);
|
||||
Term rc;
|
||||
char *name = Yap_guessFileName(f, sno, s, MAXPATHLEN);
|
||||
if (name)
|
||||
rc = MkAtomTerm(Yap_LookupAtom(name));
|
||||
else
|
||||
return false;
|
||||
if (!IsVarTerm(t2) && !isatom(t2)) {
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify_constant(t2, rc);
|
||||
return Yap_unify_constant(t2, MkAtomTerm(GLOBAL_Stream[sno].name) );
|
||||
}
|
||||
|
||||
static Int file_no(int sno, Term t2 USES_REGS) {
|
||||
@ -788,7 +777,7 @@ static Int set_stream(USES_REGS1) { /* Init current_stream */
|
||||
Yap_CheckStream(ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,
|
||||
"set_stream_position/2");
|
||||
if (sno < 0) {
|
||||
return (FALSE);
|
||||
return false;
|
||||
}
|
||||
return do_set_stream(sno, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
|
@ -1,6 +0,0 @@
|
||||
@x0
|
||||
0.286554426939
|
||||
@x1
|
||||
0.517024484197
|
||||
@x2
|
||||
0.425979613559
|
@ -730,8 +730,8 @@ update_query(QueryID,Symbol,What_To_Update) :-
|
||||
problog_flag(sigmoid_slope,Slope),
|
||||
problog_dir(PD),
|
||||
((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'),
|
||||
convert_filename_to_problog_path('problogbdd', ProblogBDD),
|
||||
atomic_concat([ProblogBDD,
|
||||
convert_filename_to_problog_path('simplecudd', Simplecudd),
|
||||
atomic_concat([Simplecudd,
|
||||
' -i "', Probabilities_File, '"',
|
||||
' -l "', Query_Directory,'/query_',QueryID, '"',
|
||||
' -m ', Method,
|
||||
|
@ -410,14 +410,14 @@ init_learning :-
|
||||
learning_initialized,
|
||||
!.
|
||||
init_learning :-
|
||||
convert_filename_to_problog_path('problogbdd_lfi', Path),
|
||||
convert_filename_to_problog_path('simplecudd_lfi', Path),
|
||||
(
|
||||
file_exists(Path)
|
||||
->
|
||||
true;
|
||||
(
|
||||
problog_path(PD),
|
||||
format(user_error, 'WARNING: Can not find file: problogbdd_lfi. Please place file in problog path: ~q~n',[PD]),
|
||||
format(user_error, 'WARNING: Can not find file: simplecudd_lfi. Please place file in problog path: ~q~n',[PD]),
|
||||
fail
|
||||
)
|
||||
),
|
||||
@ -885,7 +885,7 @@ update_query(QueryID,ClusterID ,Method,Command,PID,Output_File_Name) :-
|
||||
create_bdd_output_file_name(QueryID,ClusterID,Iteration,Output_File_Name),
|
||||
create_bdd_file_name(QueryID,ClusterID,BDD_File_Name),
|
||||
|
||||
convert_filename_to_problog_path('problogbdd_lfi',Absolute_Name),
|
||||
convert_filename_to_problog_path('simplecudd_lfi',Absolute_Name),
|
||||
|
||||
atomic_concat([Absolute_Name,
|
||||
' -i "', Input_File_Name, '"',
|
||||
|
@ -10,7 +10,7 @@ add_executable (Problogbdd
|
||||
${SRC})
|
||||
|
||||
set_target_properties (Problogbdd PROPERTIES
|
||||
OUTPUT_NAME problogbdd
|
||||
OUTPUT_NAME simplecudd
|
||||
)
|
||||
|
||||
target_link_libraries(Problogbdd
|
||||
|
@ -1,16 +1,7 @@
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#ifdef MYDDAS_SQLITE3
|
||||
#include <sqlite3.h>
|
||||
#endif /*MYDDAS_MYSQL*/
|
||||
#include "Yap.h"
|
||||
#include "cut_c.h"
|
||||
#ifdef MYDDAS_ODBC
|
||||
#include <sql.h>
|
||||
#endif /*MYDDAS_ODBC*/
|
||||
#ifdef MYDDAS_MYSQL
|
||||
#include <mysql/mysql.h>
|
||||
#endif /*MYDDAS_MYSQL*/
|
||||
|
||||
#include "myddas.h"
|
||||
#include "myddas_util.h"
|
||||
|
@ -10,7 +10,7 @@ set(SO_MAJOR 1)
|
||||
set(SO_MINOR 0)
|
||||
set(SO_PATCH 0)
|
||||
|
||||
macro_optional_find_package(MYSQL ON)
|
||||
macro_optional_find_package(MySQL ON)
|
||||
|
||||
macro_log_feature (MYSQL_FOUND "MySQL"
|
||||
"MYSQL Driver for MYDDAS Data-Base Interface "
|
||||
|
@ -20,7 +20,7 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <mysql/mysql.h>
|
||||
#include <mysql.h>
|
||||
#include "Yap.h"
|
||||
#include "Yatom.h"
|
||||
#include "cut_c.h"
|
||||
|
@ -18,7 +18,7 @@
|
||||
#include "Yap.h"
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <mysql/mysql.h>
|
||||
#include <mysql.h>
|
||||
#include <myddas_util.h>
|
||||
|
||||
#ifdef MYDDAS_MYSQL
|
||||
|
@ -7,20 +7,21 @@ set(SO_MAJOR 1)
|
||||
set(SO_MINOR 0)
|
||||
set(SO_PATCH 0)
|
||||
|
||||
macro_optional_find_package(POSTGRESQL ON)
|
||||
macro_optional_find_package(PostgreSQL ON)
|
||||
|
||||
macro_log_feature (POSTGRES_FOUND "postgres"
|
||||
"POSTGRES Driver for MYDDAS Data-Base Interface "
|
||||
macro_log_feature (PostgreSQL_FOUND "postgres"
|
||||
"PostgreSQL Driver for MYDDAS Data-Base Interface "
|
||||
"http://www.postgres.org" FALSE)
|
||||
|
||||
if (POSTGRES_FOUND)
|
||||
# POSTGRES_INCLUDE_DIRECTORIES, where to find sql.h
|
||||
# POSTGRES_LIBRARIES, the libraries to link against to use POSTGRES
|
||||
# POSTGRES_FOUND. If false, you cannot build anything that requires Postgres.
|
||||
if (PostgreSQL_FOUND)
|
||||
# PostgreSQL_FOUND - Set to true when PostgreSQL is found.
|
||||
# PostgreSQL_INCLUDE_DIRS - Include directories for PostgreSQL
|
||||
# PostgreSQL_LIBRARY_DIRS - Link directories for PostgreSQL libraries
|
||||
# PostgreSQL_LIBRARIES - The PostgreSQL libraries.
|
||||
add_library (Yappostgres SHARED ${YAPPOSTGRES_SOURCES})
|
||||
add_definitions (-DMYDDAS_POSTGRES=1)
|
||||
target_link_libraries(Yappostgres libYap ${POSTGRES_LIBRARIES})
|
||||
include_directories (${POSTGRES_INCLUDE_DIRECTORIES} ..)
|
||||
target_link_libraries(Yappostgres libYap ${PostgreSQL_LIBRARIES})
|
||||
include_directories (${PostgreSQL_INCLUDE_DIRS} ..)
|
||||
set_target_properties (Yappostgres PROPERTIES
|
||||
POSITION_INDEPENDENT_CODE ON
|
||||
VERSION "${SO_MAJOR}.${SO_MINOR}.${SO_PATCH}"
|
||||
@ -31,6 +32,6 @@ if (POSTGRES_FOUND)
|
||||
LIBRARY DESTINATION ${libdir}
|
||||
)
|
||||
else()
|
||||
add_definitions (-DMYDDAS_POSTGRES=0)
|
||||
endif (POSTGRES_FOUND)
|
||||
add_definitions (-DMYDDAS_PostgreSQL=0)
|
||||
endif (PostgreSQL_FOUND)
|
||||
|
||||
|
6
packages/myddas/postgres/myddas_wkb2prolog.h
Normal file
6
packages/myddas/postgres/myddas_wkb2prolog.h
Normal file
@ -0,0 +1,6 @@
|
||||
#ifndef MYDDAS_WKB2PROLOG_H_
|
||||
# define MYDDAS_WKB2PROLOG_H_
|
||||
|
||||
Term wkb2prolog(char *wkb) ;
|
||||
|
||||
#endif /* !MYDDAS_WKB2PROLOG_H_ */
|
@ -1,700 +0,0 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: myddas_mysql.c *
|
||||
* Last rev: 22/03/05 *
|
||||
* mods: *
|
||||
* comments: Predicates for comunicating with a mysql database system *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
#if defined MYDDAS_MYSQL
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <mysql/mysql.h>
|
||||
#include "Yap.h"
|
||||
#include "Yatom.h"
|
||||
#include "cut_c.h"
|
||||
#include "myddas.h"
|
||||
#ifdef MYDDAS_STATS
|
||||
#include "myddas_structs.h"
|
||||
#include "myddas_statistics.h"
|
||||
#endif
|
||||
#include "myddas_wkb2prolog.h"
|
||||
|
||||
#define IS_SQL_INT(FIELD) FIELD == FIELD_TYPE_INT24 || \
|
||||
FIELD == FIELD_TYPE_LONG || \
|
||||
FIELD == FIELD_TYPE_LONGLONG || \
|
||||
FIELD == FIELD_TYPE_SHORT || \
|
||||
FIELD == FIELD_TYPE_TINY
|
||||
|
||||
#define IS_SQL_FLOAT(FIELD) FIELD == FIELD_TYPE_DECIMAL || \
|
||||
FIELD == FIELD_TYPE_DOUBLE || \
|
||||
FIELD == FIELD_TYPE_FLOAT
|
||||
|
||||
#define IS_SQL_GEOMETRY(FIELD) FIELD == FIELD_TYPE_GEOMETRY
|
||||
|
||||
static Int null_id = 0;
|
||||
|
||||
static Int c_db_my_connect( USES_REGS1 );
|
||||
static Int c_db_my_disconnect( USES_REGS1 );
|
||||
static Int c_db_my_number_of_fields( USES_REGS1 );
|
||||
static Int c_db_my_get_attributes_types( USES_REGS1 );
|
||||
static Int c_db_my_query( USES_REGS1 );
|
||||
static Int c_db_my_table_write( USES_REGS1 );
|
||||
static Int c_db_my_row( USES_REGS1 );
|
||||
static Int c_db_my_row_cut( USES_REGS1 );
|
||||
static Int c_db_my_get_fields_properties( USES_REGS1 );
|
||||
static Int c_db_my_get_next_result_set( USES_REGS1 );
|
||||
static Int c_db_my_get_database( USES_REGS1 );
|
||||
static Int c_db_my_change_database( USES_REGS1 );
|
||||
|
||||
void Yap_InitMYDDAS_MySQLPreds(void)
|
||||
{
|
||||
/* db_connect: Host x User x Passwd x Database x Connection x ERROR_CODE */
|
||||
Yap_InitCPred("c_db_my_connect", 7, c_db_my_connect, 0);
|
||||
|
||||
/* db_number_of_fields: Relation x Connection x NumberOfFields */
|
||||
Yap_InitCPred("c_db_my_number_of_fields",3, c_db_my_number_of_fields, 0);
|
||||
|
||||
/* db_get_attributes_types: Relation x TypesList */
|
||||
Yap_InitCPred("c_db_my_get_attributes_types", 3, c_db_my_get_attributes_types, 0);
|
||||
|
||||
/* db_query: SQLQuery x ResultSet x Connection */
|
||||
Yap_InitCPred("c_db_my_query", 5, c_db_my_query, 0);
|
||||
|
||||
/* db_disconnect: Connection */
|
||||
Yap_InitCPred("c_db_my_disconnect", 1,c_db_my_disconnect, 0);
|
||||
|
||||
/* db_table_write: Result Set */
|
||||
Yap_InitCPred("c_db_my_table_write", 1, c_db_my_table_write, 0);
|
||||
|
||||
/* db_get_fields_properties: PredName x Connnection x PropertiesList*/
|
||||
Yap_InitCPred("c_db_my_get_fields_properties",3,c_db_my_get_fields_properties,0);
|
||||
|
||||
|
||||
Yap_InitCPred("c_db_my_get_next_result_set",2,c_db_my_get_next_result_set,0);
|
||||
|
||||
/* c_db_my_get_database: Connnection x DataBaseName */
|
||||
Yap_InitCPred("c_db_my_get_database",2,c_db_my_get_database,0);
|
||||
|
||||
/* c_db_my_change_database: Connnection x DataBaseName */
|
||||
Yap_InitCPred("c_db_my_change_database",2,c_db_my_change_database,0);
|
||||
|
||||
|
||||
}
|
||||
|
||||
void Yap_InitBackMYDDAS_MySQLPreds(void)
|
||||
{
|
||||
/* db_row: ResultSet x Arity x ListOfArgs */
|
||||
Yap_InitCPredBackCut("c_db_my_row", 3, sizeof(Int),
|
||||
c_db_my_row,
|
||||
c_db_my_row,
|
||||
c_db_my_row_cut, 0);
|
||||
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_connect( USES_REGS1 ) {
|
||||
Term arg_file = Deref(ARG1);
|
||||
Term arg_db = Deref(ARG2);
|
||||
|
||||
sqlite3 *db;
|
||||
|
||||
char *file = AtomName(AtomOfTerm(arg_file));
|
||||
|
||||
rc = sqlite3_open(argv[1], &db);
|
||||
if( rc ){
|
||||
fprintf(stderr, "Can't open database: %s\n", sqlite3_errmsg(db));
|
||||
sqlite3_close(db);
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
if (!Yap_unify(arg_db, MkIntegerTerm((Int)db)))
|
||||
return FALSE;
|
||||
else
|
||||
{
|
||||
/* Criar um novo no na lista de ligacoes*/
|
||||
new = myddas_util_add_connection(db,NULL);
|
||||
|
||||
if (new == NULL){
|
||||
#ifdef DEBUG
|
||||
fprintf(stderror, "ERROR: ** c_db_my_connect ** Error allocating memory\n");
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
/* db_query: SQLQuery x ResultSet x Connection */
|
||||
static Int
|
||||
c_db_my_query( USES_REGS1 ) {
|
||||
Term arg_sql_query = Deref(ARG1);
|
||||
Term arg_result_set = Deref(ARG2);
|
||||
Term arg_conn = Deref(ARG3);
|
||||
Term arg_mode = Deref(ARG4);
|
||||
Term arg_arity = Deref(ARG5);
|
||||
|
||||
char *sql = AtomName(AtomOfTerm(arg_sql_query));
|
||||
char *mode = AtomName(AtomOfTerm(arg_mode));
|
||||
MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn));
|
||||
|
||||
MYSQL_RES *res_set;
|
||||
|
||||
MyddasInt length=strlen(sql);
|
||||
|
||||
#ifdef MYDDAS_STATS
|
||||
MYDDAS_UTIL_CONNECTION node = myddas_util_search_connection(conn);
|
||||
MyddasULInt count = 0;
|
||||
|
||||
/* Count the number of querys made to the server */
|
||||
MyddasULInt number_querys;
|
||||
MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE(node,number_querys);
|
||||
MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE(node,++number_querys);
|
||||
MYDDAS_STATS_CON_GET_NUMBER_QUERIES_MADE_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_NUMBER_QUERIES_MADE_COUNT(node,++count);
|
||||
|
||||
/* Measure time spent by the MySQL Server
|
||||
processing the SQL Query */
|
||||
MYDDAS_STATS_TIME start,end,total_time,diff;
|
||||
start = myddas_stats_walltime();
|
||||
#endif
|
||||
|
||||
/* Send query to server and process it */
|
||||
if (mysql_real_query(conn, sql, length) != 0)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("ERROR: **c_db_my_query** Error on query! %s\n",sql);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
#ifdef MYDDAS_STATS
|
||||
/* Measure time spent by the MySQL Server
|
||||
processing the SQL Query */
|
||||
end = myddas_stats_walltime();
|
||||
|
||||
MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy);
|
||||
myddas_stats_subtract_time(diff,end,start);
|
||||
diff = myddas_stats_time_copy_to_final(diff);
|
||||
|
||||
MYDDAS_FREE(end,struct myddas_stats_time_struct);
|
||||
MYDDAS_FREE(start,struct myddas_stats_time_struct);
|
||||
|
||||
MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER(node,total_time);
|
||||
/* Automacally updates the MYDDAS_STRUCTURE */
|
||||
myddas_stats_add_time(total_time,diff,total_time);
|
||||
MYDDAS_STATS_CON_GET_TOTAL_TIME_DBSERVER_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_TOTAL_TIME_DBSERVER_COUNT(node,++count);
|
||||
|
||||
MYDDAS_STATS_TIME time = NULL;
|
||||
MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER(node,time);
|
||||
myddas_stats_move_time(diff,time);
|
||||
MYDDAS_STATS_CON_GET_LAST_TIME_DBSERVER_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_LAST_TIME_DBSERVER_COUNT(node,++count);
|
||||
#endif
|
||||
|
||||
/* guardar os tuplos do lado do cliente */
|
||||
if (strcmp(mode,"store_result")!=0) //True
|
||||
res_set = mysql_use_result(conn);
|
||||
else{
|
||||
|
||||
#ifdef MYDDAS_STATS
|
||||
/* Measure time spent by the MySQL Server
|
||||
transferring the result of the last query
|
||||
back to the client */
|
||||
start = myddas_stats_walltime();
|
||||
#endif
|
||||
res_set = mysql_store_result(conn);
|
||||
#ifdef MYDDAS_STATS
|
||||
/* Measure time spent by the MySQL Server
|
||||
transferring the result of the last query
|
||||
back to the client */
|
||||
end = myddas_stats_walltime();
|
||||
|
||||
MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy);
|
||||
myddas_stats_subtract_time(diff,end,start);
|
||||
diff = myddas_stats_time_copy_to_final(diff);
|
||||
|
||||
MYDDAS_FREE(end,struct myddas_stats_time_struct);
|
||||
MYDDAS_FREE(start,struct myddas_stats_time_struct);
|
||||
|
||||
MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING(node,total_time);
|
||||
/* Automacally updates the MYDDAS_STRUCTURE */
|
||||
myddas_stats_add_time(total_time,diff,total_time);
|
||||
MYDDAS_STATS_CON_GET_TOTAL_TIME_TRANSFERING_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_TOTAL_TIME_TRANSFERING_COUNT(node,++count);
|
||||
|
||||
time = NULL;
|
||||
MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING(node,time);
|
||||
MYDDAS_STATS_CON_GET_LAST_TIME_TRANSFERING_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_LAST_TIME_TRANSFERING_COUNT(node,++count);
|
||||
myddas_stats_move_time(diff,time);
|
||||
|
||||
/* Measure the number of Rows returned from the server */
|
||||
if (res_set != NULL)
|
||||
{
|
||||
/* With an INSERT statement, mysql_(use or store)_result()
|
||||
returns a NULL pointer*/
|
||||
|
||||
/* This is only works if we use mysql_store_result */
|
||||
MyddasUInt numberRows = mysql_num_rows(res_set);
|
||||
MyddasUInt rows;
|
||||
|
||||
MYDDAS_STATS_CON_GET_TOTAL_ROWS(node,rows);
|
||||
numberRows = numberRows + rows;
|
||||
MYDDAS_STATS_CON_SET_TOTAL_ROWS(node,numberRows);
|
||||
MYDDAS_STATS_CON_GET_TOTAL_ROWS_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_TOTAL_ROWS_COUNT(node,++count);
|
||||
|
||||
/* Calculate the ammount of data sent by the server */
|
||||
MyddasUInt total,number_fields = mysql_num_fields(res_set);
|
||||
MYSQL_ROW row;
|
||||
MyddasULInt i;
|
||||
total=0;
|
||||
while ((row = mysql_fetch_row(res_set)) != NULL){
|
||||
mysql_field_seek(res_set,0);
|
||||
|
||||
for(i=0;i<number_fields;i++){
|
||||
if (row[i] != NULL)
|
||||
total = total + strlen(row[i]);
|
||||
}
|
||||
}
|
||||
MYDDAS_STATS_CON_SET_LAST_BYTES_TRANSFERING_FROM_DBSERVER(node,total);
|
||||
MYDDAS_STATS_CON_GET_LAST_BYTES_TRANSFERING_FROM_DBSERVER_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_LAST_BYTES_TRANSFERING_FROM_DBSERVER_COUNT(node,++count);
|
||||
|
||||
MyddasUInt bytes = 0;
|
||||
MYDDAS_STATS_CON_GET_TOTAL_BYTES_TRANSFERING_FROM_DBSERVER(node,bytes);
|
||||
total = total + bytes;
|
||||
MYDDAS_STATS_CON_SET_TOTAL_BYTES_TRANSFERING_FROM_DBSERVER(node,total);
|
||||
MYDDAS_STATS_CON_GET_TOTAL_BYTES_TRANSFERING_FROM_DBSERVER_COUNT(node,count);
|
||||
MYDDAS_STATS_CON_SET_TOTAL_BYTES_TRANSFERING_FROM_DBSERVER_COUNT(node,++count);
|
||||
mysql_data_seek(res_set,0);
|
||||
}
|
||||
#endif
|
||||
|
||||
}
|
||||
if (res_set == NULL)
|
||||
{
|
||||
//INSERT statements don't return any res_set
|
||||
if (mysql_field_count(conn) == 0)
|
||||
return TRUE;
|
||||
#ifdef DEBUG
|
||||
printf("Empty Query!\n");
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
if (!Yap_unify(arg_arity, MkIntegerTerm(mysql_num_fields(res_set)))){
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
if (!Yap_unify(arg_result_set, MkIntegerTerm((Int) res_set)))
|
||||
{
|
||||
mysql_free_result(res_set);
|
||||
return FALSE;
|
||||
}
|
||||
else
|
||||
{
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_number_of_fields( USES_REGS1 ) {
|
||||
Term arg_relation = Deref(ARG1);
|
||||
Term arg_conn = Deref(ARG2);
|
||||
Term arg_fields = Deref(ARG3);
|
||||
|
||||
char *relation = AtomName(AtomOfTerm(arg_relation));
|
||||
MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn));
|
||||
|
||||
char sql[256];
|
||||
|
||||
MYSQL_RES *res_set;
|
||||
|
||||
sprintf(sql,"DESCRIBE `%s`",relation);
|
||||
|
||||
/* executar a query SQL */
|
||||
if (mysql_query(conn, sql) != 0)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("ERROR: **c_db_my_number_of_fields** Error on the query! %s\n",sql);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
/* guardar os tuplos do lado do cliente */
|
||||
if ((res_set = mysql_store_result(conn)) == NULL)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("ERROR: **c_db_my_number_of_fields** Error storing the query! %s\n",sql);
|
||||
#endif
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
if (!Yap_unify(arg_fields, MkIntegerTerm(mysql_num_rows(res_set)))){
|
||||
mysql_free_result(res_set);
|
||||
return FALSE;
|
||||
}
|
||||
mysql_free_result(res_set);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
/* db_get_attributes_types: RelName x Connection -> TypesList */
|
||||
static Int
|
||||
c_db_my_get_attributes_types( USES_REGS1 ) {
|
||||
Term arg_relation = Deref(ARG1);
|
||||
Term arg_conn = Deref(ARG2);
|
||||
Term arg_types_list = Deref(ARG3);
|
||||
|
||||
char *relation = AtomName(AtomOfTerm(arg_relation));
|
||||
MYSQL *conn = (MYSQL *) IntegerOfTerm(arg_conn);
|
||||
char sql[256];
|
||||
|
||||
MYSQL_RES *res_set;
|
||||
MYSQL_ROW row;
|
||||
Term head, list;
|
||||
|
||||
sprintf(sql,"DESCRIBE `%s`",relation);
|
||||
|
||||
Int length = strlen(sql);
|
||||
|
||||
/* executar a query SQL */
|
||||
if (mysql_real_query(conn, sql, length) != 0)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("Erro na query! %s\n",sql);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
/* guardar os tuplos do lado do cliente */
|
||||
if ((res_set = mysql_store_result(conn)) == NULL)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("Query vazia!\n");
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
list = arg_types_list;
|
||||
|
||||
while ((row = mysql_fetch_row(res_set)) != NULL)
|
||||
{
|
||||
head = HeadOfTerm(list);
|
||||
Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[0])));
|
||||
list = TailOfTerm(list);
|
||||
head = HeadOfTerm(list);
|
||||
list = TailOfTerm(list);
|
||||
|
||||
if (strncmp(row[1], "smallint",8) == 0 || strncmp(row[1],"int",3) == 0 ||
|
||||
strncmp(row[1], "mediumint",9) == 0 || strncmp(row[1], "tinyint",7) == 0 ||
|
||||
strncmp(row[1], "bigint",6) == 0 || strcmp(row[1], "year") == 0)
|
||||
Yap_unify(head, MkAtomTerm(Yap_LookupAtom("integer")));
|
||||
else if (strcmp(row[1], "float") == 0 || strncmp(row[1], "double",6) == 0
|
||||
|| strcmp(row[1], "real") == 0)
|
||||
Yap_unify(head, MkAtomTerm(Yap_LookupAtom("real")));
|
||||
else Yap_unify(head, MkAtomTerm(Yap_LookupAtom("string")));
|
||||
}
|
||||
|
||||
mysql_free_result(res_set);
|
||||
return TRUE;
|
||||
|
||||
}
|
||||
|
||||
/* db_disconnect */
|
||||
static Int
|
||||
c_db_my_disconnect( USES_REGS1 ) {
|
||||
Term arg_conn = Deref(ARG1);
|
||||
|
||||
MYSQL *conn = (MYSQL *) IntegerOfTerm(arg_conn);
|
||||
|
||||
if ((myddas_util_search_connection(conn)) != NULL)
|
||||
{
|
||||
myddas_util_delete_connection(conn);
|
||||
mysql_close(conn);
|
||||
return TRUE;
|
||||
}
|
||||
else
|
||||
{
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
/* db_table_write: Result Set */
|
||||
static Int
|
||||
c_db_my_table_write( USES_REGS1 ) {
|
||||
Term arg_res_set = Deref(ARG1);
|
||||
|
||||
MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_res_set);
|
||||
|
||||
myddas_util_table_write(res_set);
|
||||
mysql_free_result(res_set);
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_row_cut( USES_REGS1 ) {
|
||||
MYSQL_RES *mysql_res=NULL;
|
||||
|
||||
mysql_res = (MYSQL_RES *) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1));
|
||||
mysql_free_result(mysql_res);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
/* db_row: ResultSet x Arity_ListOfArgs x ListOfArgs -> */
|
||||
static Int
|
||||
c_db_my_row( USES_REGS1 ) {
|
||||
#ifdef MYDDAS_STATS
|
||||
/* Measure time used by the */
|
||||
/* c_db_my_row function */
|
||||
MYDDAS_STATS_TIME start,end,total_time,diff;
|
||||
MyddasULInt count = 0;
|
||||
start = myddas_stats_walltime();
|
||||
#endif
|
||||
Term arg_result_set = Deref(ARG1);
|
||||
Term arg_arity = Deref(ARG2);
|
||||
Term arg_list_args = Deref(ARG3);
|
||||
|
||||
MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_result_set);
|
||||
EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((Int)res_set);
|
||||
MYSQL_ROW row;
|
||||
MYSQL_FIELD *field;
|
||||
|
||||
|
||||
Term head, list, null_atom[1];
|
||||
Int i, arity;
|
||||
|
||||
arity = IntegerOfTerm(arg_arity);
|
||||
|
||||
while(TRUE)
|
||||
{
|
||||
if ((row = mysql_fetch_row(res_set)) != NULL)
|
||||
{
|
||||
mysql_field_seek(res_set,0);
|
||||
list = arg_list_args;
|
||||
|
||||
for (i = 0; i < arity; i++)
|
||||
{
|
||||
/* Aqui ser<65>o feitas as convers<72>es de tipos de dados */
|
||||
field = mysql_fetch_field(res_set);
|
||||
head = HeadOfTerm(list);
|
||||
list = TailOfTerm(list);
|
||||
|
||||
if (row[i] == NULL)
|
||||
{
|
||||
null_atom[0] = MkIntegerTerm(null_id++);
|
||||
|
||||
if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom)))
|
||||
continue;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (IS_SQL_INT(field->type))
|
||||
{
|
||||
if (!Yap_unify(head, MkIntegerTerm(atoi(row[i]))))
|
||||
continue;
|
||||
}
|
||||
else if (IS_SQL_FLOAT(field->type))
|
||||
{
|
||||
if (!Yap_unify(head, MkFloatTerm(atof(row[i]))))
|
||||
continue;
|
||||
}
|
||||
else if (IS_SQL_GEOMETRY(field->type))
|
||||
{
|
||||
if (!Yap_unify(head, wkb2prolog(row[i])))
|
||||
continue;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[i]))))
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
#ifdef MYDDAS_STATS
|
||||
end = myddas_stats_walltime();
|
||||
|
||||
MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy);
|
||||
myddas_stats_subtract_time(diff,end,start);
|
||||
diff = myddas_stats_time_copy_to_final(diff);
|
||||
|
||||
MYDDAS_FREE(end,struct myddas_stats_time_struct);
|
||||
MYDDAS_FREE(start,struct myddas_stats_time_struct);
|
||||
|
||||
MYDDAS_STATS_GET_DB_ROW_FUNCTION(total_time);
|
||||
myddas_stats_add_time(total_time,diff,total_time);
|
||||
MYDDAS_STATS_GET_DB_ROW_FUNCTION_COUNT(count);
|
||||
MYDDAS_STATS_SET_DB_ROW_FUNCTION_COUNT(++count);
|
||||
|
||||
MYDDAS_FREE(diff,struct myddas_stats_time_struct);
|
||||
#endif /* MYDDAS_STATS */
|
||||
return TRUE;
|
||||
}
|
||||
else
|
||||
{
|
||||
mysql_free_result(res_set);
|
||||
#ifdef MYDDAS_STATS
|
||||
end = myddas_stats_walltime();
|
||||
|
||||
MYDDAS_STATS_INITIALIZE_TIME_STRUCT(diff,time_copy);
|
||||
myddas_stats_subtract_time(diff,end,start);
|
||||
diff = myddas_stats_time_copy_to_final(diff);
|
||||
|
||||
MYDDAS_FREE(end,struct myddas_stats_time_struct);
|
||||
MYDDAS_FREE(start,struct myddas_stats_time_struct);
|
||||
|
||||
MYDDAS_STATS_GET_DB_ROW_FUNCTION(total_time);
|
||||
myddas_stats_add_time(total_time,diff,total_time);
|
||||
MYDDAS_STATS_GET_DB_ROW_FUNCTION_COUNT(count);
|
||||
MYDDAS_STATS_SET_DB_ROW_FUNCTION_COUNT(++count);
|
||||
|
||||
MYDDAS_FREE(diff,struct myddas_stats_time_struct);
|
||||
#endif /* MYDDAS_STATS */
|
||||
cut_fail(); /* This macro already does a return FALSE */
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_get_fields_properties( USES_REGS1 ) {
|
||||
Term nome_relacao = Deref(ARG1);
|
||||
Term arg_conn = Deref(ARG2);
|
||||
Term fields_properties_list = Deref(ARG3);
|
||||
Term head, list;
|
||||
|
||||
char *relacao = AtomName(AtomOfTerm(nome_relacao));
|
||||
char sql[256];
|
||||
Int num_fields,i;
|
||||
MYSQL_FIELD *fields;
|
||||
MYSQL_RES *res_set;
|
||||
MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn));
|
||||
|
||||
|
||||
/* LIMIT 0 -> We only need the meta information about the fields
|
||||
to know their properties, we don't need the results of the
|
||||
query*/
|
||||
sprintf (sql,"SELECT * FROM `%s` LIMIT 0",relacao);
|
||||
|
||||
Int length=strlen(sql);
|
||||
|
||||
/* executar a query SQL */
|
||||
if (mysql_real_query(conn, sql, length) != 0)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
printf("Erro na query! %s\n",sql);
|
||||
#endif
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"),4);
|
||||
|
||||
Term properties[4];
|
||||
|
||||
|
||||
/* guardar os tuplos do lado do cliente */
|
||||
/* nao precisamos do resultado, mas apenas no res_set */
|
||||
/* para obter a informa<6D><61>o atrav<61>s do mysql_fetch_fields*/
|
||||
res_set = mysql_store_result(conn);
|
||||
|
||||
num_fields = mysql_num_fields(res_set);
|
||||
fields = mysql_fetch_fields(res_set);
|
||||
|
||||
list = fields_properties_list;
|
||||
|
||||
|
||||
|
||||
for (i=0;i<num_fields;i++)
|
||||
{
|
||||
head = HeadOfTerm(list);
|
||||
|
||||
properties[0] = MkAtomTerm(Yap_LookupAtom(fields[i].name));
|
||||
|
||||
if (fields[i].flags & NOT_NULL_FLAG)
|
||||
properties[1] = MkIntegerTerm(1); //Can't be NULL
|
||||
else
|
||||
properties[1] = MkIntegerTerm(0);
|
||||
|
||||
if (fields[i].flags & PRI_KEY_FLAG)
|
||||
properties[2] = MkIntegerTerm(1); //It''s a primary key
|
||||
else
|
||||
properties[2] = MkIntegerTerm(0);
|
||||
|
||||
if (fields[i].flags & AUTO_INCREMENT_FLAG)
|
||||
properties[3] = MkIntegerTerm(1); //It's auto_incremented field
|
||||
else
|
||||
properties[3] = MkIntegerTerm(0);
|
||||
|
||||
|
||||
list = TailOfTerm(list);
|
||||
if (!Yap_unify(head, Yap_MkApplTerm(functor,4,properties))){
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
mysql_free_result(res_set);
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
/* c_db_my_get_next_result_set: Connection * NextResSet */
|
||||
static Int
|
||||
c_db_my_get_next_result_set( USES_REGS1 ) {
|
||||
Term arg_conn = Deref(ARG1);
|
||||
Term arg_next_res_set = Deref(ARG2);
|
||||
|
||||
MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn));
|
||||
MYSQL_RES *res_set=NULL;
|
||||
|
||||
if (mysql_next_result(conn) == 0){
|
||||
res_set = mysql_store_result(conn);
|
||||
Yap_unify(arg_next_res_set, MkIntegerTerm((Int) res_set));
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_get_database( USES_REGS1 ) {
|
||||
Term arg_con = Deref(ARG1);
|
||||
Term arg_database = Deref(ARG2);
|
||||
|
||||
MYSQL *con = (MYSQL *) (IntegerOfTerm(arg_con));
|
||||
|
||||
if (!Yap_unify(arg_database,MkAtomTerm(Yap_LookupAtom(con->db))))
|
||||
return FALSE;
|
||||
|
||||
return TRUE;
|
||||
|
||||
}
|
||||
|
||||
static Int
|
||||
c_db_my_change_database( USES_REGS1 ) {
|
||||
Term arg_con = Deref(ARG1);
|
||||
Term arg_database = Deref(ARG2);
|
||||
|
||||
MYSQL *con = (MYSQL *) (IntegerOfTerm(arg_con));
|
||||
char *database = AtomName(AtomOfTerm(arg_database));
|
||||
|
||||
if (mysql_select_db(con,database)!=0)
|
||||
return FALSE;
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
#endif /* MYDDAS_MYSQL */
|
@ -3,7 +3,7 @@ set( YAPSQLITE3_SOURCES
|
||||
myddas_sqlite3.c
|
||||
)
|
||||
|
||||
macro_optional_find_package(SQLITE3 ON)
|
||||
macro_optional_find_package(Sqlite3 ON)
|
||||
|
||||
macro_log_feature (SQLITE3_FOUND "Sqlite3"
|
||||
"Sqlite3 Data-Base "
|
||||
|
@ -432,18 +432,18 @@ load_files(Files,Opts) :-
|
||||
true
|
||||
).
|
||||
'$lf'(user, Mod, _, TOpts) :- !,
|
||||
b_setval('$source_file', user_input),
|
||||
b_setval('$user_source_file', user,user_input),
|
||||
'$do_lf'(Mod, user_input, user_input, user_input, TOpts).
|
||||
'$lf'(user_input, Mod, _, TOpts) :- !,
|
||||
b_setval('$source_file', user_input),
|
||||
b_setval('$user_source_file', user_input),
|
||||
'$do_lf'(Mod, user_input, user_input, user_input, TOpts).
|
||||
'$lf'(File, Mod, Call, TOpts) :-
|
||||
'$lf_opt'(stream, TOpts, Stream),
|
||||
b_setval('$source_file', File),
|
||||
b_setval('$user_source_file', File),
|
||||
( var(Stream) ->
|
||||
/* need_to_open_file */
|
||||
( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ),
|
||||
( open(Y, read, Stream) -> true ; '$do_error'(permission_error(input,stream,Y),Call) )
|
||||
( open(Y, read, Stream) -> true ; '$do_error'(permission_error(input,stream,Y),Call) )
|
||||
;
|
||||
stream_property(Stream, file_name(Y))
|
||||
), !,
|
||||
|
@ -673,7 +673,7 @@ b_getval(GlobalVariable, Val) :-
|
||||
'$debug_stop'( State ) :-
|
||||
'$debug_state'( State ),
|
||||
b_setval('$trace',off),
|
||||
set_prolog_flag(debug, false),
|
||||
% set_prolog_flag(debug, false),
|
||||
b_setval('$spy_glist',[]),
|
||||
'$disable_debugging'.
|
||||
|
||||
|
91
pl/debug.yap
91
pl/debug.yap
@ -534,12 +534,11 @@ be lost.
|
||||
'$execute_nonstop'(G1,M).
|
||||
'$spycall'(G, M, _, _) :-
|
||||
'$is_metapredicate'(G, M),
|
||||
!,
|
||||
'$expand_meta_call'(M:G, [], G10),
|
||||
G10 \== M:G,
|
||||
CP is '$last_choice_pt',
|
||||
'$debugger_input',
|
||||
G10 = NM:NG,
|
||||
'$debugger_expand_meta_call'(M:G, [], G10),
|
||||
G10 \== M:G,
|
||||
CP is '$last_choice_pt',
|
||||
'$debugger_input',
|
||||
G10 = NM:NG,
|
||||
'$do_spy'(NG, NM, CP, spy).
|
||||
'$spycall'(G, M, _, _) :-
|
||||
'$tabled_predicate'(G,M),
|
||||
@ -557,21 +556,27 @@ be lost.
|
||||
(
|
||||
'$is_source'( G, M ) % use the interpreter
|
||||
->
|
||||
'$clause'(G, M, Cl, _),
|
||||
(
|
||||
'$clause'(G, M, Cl, _)
|
||||
*->
|
||||
% I may backtrack to here from far away
|
||||
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true )
|
||||
;
|
||||
(
|
||||
'$static_clause'(G,M,_,R),
|
||||
'$stop_creeping'(_) ,
|
||||
% I may backtrack to here from far away
|
||||
(
|
||||
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
|
||||
;
|
||||
InRedo = true
|
||||
)
|
||||
)
|
||||
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true )
|
||||
)
|
||||
;
|
||||
(
|
||||
'$static_clause'(G,M,_,R)
|
||||
*->
|
||||
'$stop_creeping'(_),
|
||||
(
|
||||
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
|
||||
;
|
||||
InRedo = true
|
||||
)
|
||||
)
|
||||
;
|
||||
( '$continue_debugging_goal'(no, '$execute_nonstop'(G,M) ) ; InRedo = true )
|
||||
).
|
||||
% I may backtrack to here from far away
|
||||
|
||||
%
|
||||
%
|
||||
@ -630,7 +635,7 @@ be lost.
|
||||
% but creep is default
|
||||
'__NB_setval__'('$trace',on),
|
||||
% make sure we run this code outside debugging mode.
|
||||
set_prolog_flag(debug, false),
|
||||
% set_prolog_flag(debug, false),
|
||||
repeat,
|
||||
'$trace_msg'(P,G,Module,L,Deterministic),
|
||||
(
|
||||
@ -641,7 +646,7 @@ be lost.
|
||||
write(user_error,' ? '), get_code(debugger_input,C),
|
||||
'$action'(C,P,L,G,Module,Debug)
|
||||
),
|
||||
(Debug = on
|
||||
/* (Debug = on
|
||||
->
|
||||
set_prolog_flag(debug, true)
|
||||
;
|
||||
@ -650,7 +655,7 @@ be lost.
|
||||
set_prolog_flag(debug, true)
|
||||
;
|
||||
set_prolog_flag(debug, false)
|
||||
),
|
||||
), */
|
||||
!.
|
||||
|
||||
'$trace_msg'(P,G,Module,L,Deterministic) :-
|
||||
@ -693,14 +698,14 @@ be lost.
|
||||
'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute
|
||||
read(debugger_input, G),
|
||||
% don't allow yourself to be caught by creep.
|
||||
current_prolog_flag(debug, OldDeb),
|
||||
set_prolog_flag(debug, false),
|
||||
% current_prolog_flag(debug, OldDeb),
|
||||
% set_prolog_flag(debug, false),
|
||||
( '$execute'(G) -> true ; true),
|
||||
% at this point we are done with leap or skip
|
||||
'__NB_setval__'('$debug_run',off),
|
||||
% but creep is default
|
||||
'__NB_setval__'('$trace',on),
|
||||
set_prolog_flag(debug, OldDeb),
|
||||
% set_prolog_flag(debug, OldDeb),
|
||||
% '$skipeol'(0'!), % '
|
||||
fail.
|
||||
'$action'(0'<,_,_,_,_,_) :- !, % <'Depth
|
||||
@ -709,7 +714,7 @@ be lost.
|
||||
fail.
|
||||
'$action'(0'C,_,_,_,_,_) :-
|
||||
yap_flag(system_options, Opts),
|
||||
memberchk( call_tracer, Opts),
|
||||
lists:memberchk( call_tracer, Opts),
|
||||
!, % <'Depth
|
||||
'$skipeol'(0'C),
|
||||
'$start_low_level_trace',
|
||||
@ -786,7 +791,7 @@ be lost.
|
||||
nodebug.
|
||||
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
|
||||
'$scan_number'(0'r,CallId,ScanNumber), % '
|
||||
set_prolog_flag(debug, true),
|
||||
% set_prolog_flag(debug, true),
|
||||
throw(error('$retry_spy'(ScanNumber),[])).
|
||||
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
|
||||
'$skipeol'(0's), % '
|
||||
@ -830,7 +835,7 @@ be lost.
|
||||
% that's what follows
|
||||
'$continue_debugging'(_, _) :-
|
||||
false,
|
||||
current_prolog_flag( debug, false ),
|
||||
% current_prolog_flag( debug, false ),
|
||||
!.
|
||||
'$continue_debugging'(_, debugger) :- !.
|
||||
% do not need to debug!
|
||||
@ -988,18 +993,14 @@ be lost.
|
||||
'$get_deb_depth_char_by_char'(C,_,10) :- '$skipeol'(C).
|
||||
|
||||
'$set_deb_depth'(D) :-
|
||||
recorded('$print_options','$debugger'(L),R), !,
|
||||
'$delete_if_there'(L, max_depth(_), LN),
|
||||
erase(R),
|
||||
recorda('$print_options','$debugger'([max_depth(D)|LN]),_).
|
||||
'$set_deb_depth'(D) :-
|
||||
recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(D)]),_).
|
||||
yap_flag(debugger_print_options,L),
|
||||
'$delete_if_there'(L, max_depth(_), max_depth(D), LN),
|
||||
yap_flag(debugger_print_options,LN).
|
||||
|
||||
'$delete_if_there'([], _, []).
|
||||
'$delete_if_there'([T|L], T, LN) :- !,
|
||||
'$delete_if_there'(L, T, LN).
|
||||
'$delete_if_there'([Q|L], T, [Q|LN]) :-
|
||||
'$delete_if_there'(L, T, LN).
|
||||
'$delete_if_there'([], _, TN, [TN]).
|
||||
'$delete_if_there'([T|L], T, TN, [TN|L]).
|
||||
'$delete_if_there'([Q|L], T, TN, [Q|LN]) :-
|
||||
'$delete_if_there'(L, T, TN, LN).
|
||||
|
||||
'$debugger_deterministic_goal'(G) :-
|
||||
yap_hacks:current_choicepoints(CPs0),
|
||||
@ -1033,6 +1034,15 @@ be lost.
|
||||
'$debugger_skip_loop_spy2'(CPs,CPs1).
|
||||
'$debugger_skip_loop_spy2'(CPs,CPs).
|
||||
|
||||
'$debugger_expand_meta_call'( G, M, G1 ) :-
|
||||
'$expand_meta_call'( G, M, G0 ),
|
||||
(
|
||||
'$is_system_predicate'(G0,M) ->
|
||||
'$debugger_process_meta_arguments'(G0, M, G1)
|
||||
;
|
||||
G1 = G0
|
||||
).
|
||||
|
||||
'$debugger_process_meta_arguments'(G, M, G1) :-
|
||||
functor(G,F,N),
|
||||
'$meta_predicate'(F,M,N,D), !, % we're in an argument
|
||||
@ -1040,6 +1050,7 @@ be lost.
|
||||
G =.. [F|BGs],
|
||||
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s),
|
||||
G1 =.. [F|BG1s].
|
||||
'$debugger_process_meta_arguments'(G, M, G).
|
||||
|
||||
'$ldebugger_process_meta_args'([], _, [], []).
|
||||
'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$spy'([M1|G1])|BG1s]) :-
|
||||
@ -1047,6 +1058,8 @@ be lost.
|
||||
N >= 0,
|
||||
!,
|
||||
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).
|
||||
|
@ -86,7 +86,8 @@ representation_error(Reason) :-
|
||||
% | negative_integer | Integer < 0 |
|
||||
% | oneof(L) | Ground term that is member of L |
|
||||
% | list(Type) | Proper list with elements of Type |
|
||||
% | list_or_partial_list | A list or an open list (ending in a variable |
|
||||
% | list_or_partial_list | A list or an open list (ending in a variable) |
|
||||
% | predicate_indicator | a predicate indicator of the form M:N/A or M:N//A |
|
||||
%
|
||||
% @throws instantiation_error if Term is insufficiently
|
||||
% instantiated and type_error(Type, Term) if Term is not of Type.
|
||||
@ -100,6 +101,9 @@ must_be(Type, X, Comment) :-
|
||||
must_be_of_type(callable, X) :-
|
||||
!,
|
||||
is_callable(X, _).
|
||||
must_be_of_type(predicate_indicator, X) :-
|
||||
!,
|
||||
is_predicate_indicator(X, _).
|
||||
must_be_of_type(Type, X) :-
|
||||
( has_type(Type, X)
|
||||
-> true
|
||||
@ -108,6 +112,9 @@ must_be_of_type(Type, X) :-
|
||||
|
||||
inline(must_be_of_type( callable, X ), error:is_callable(X, _) ).
|
||||
|
||||
must_be_of_type(predicate_indicator, X, Comment) :-
|
||||
!,
|
||||
is_predicate_indicator(X, Comment).
|
||||
must_be_of_type(callable, X, Comment) :-
|
||||
!,
|
||||
is_callable(X, Comment).
|
||||
|
@ -271,6 +271,10 @@ prolog:'\\+'(A, S0, S) :-
|
||||
|
||||
:- dynamic system:goal_expansion/2.
|
||||
|
||||
:- dynamic prolog:'$goal_expansion_allowed'/0.
|
||||
|
||||
prolog:'$goal_expansion_allowed'.
|
||||
|
||||
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
|
||||
catch(prolog:'$translate_rule'(
|
||||
(pseudo_nt --> Mod:NT), Rule),
|
||||
|
@ -212,7 +212,7 @@ location( error(_,Term), Level ) -->
|
||||
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
|
||||
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ],
|
||||
[nl].
|
||||
location( error(_,Term), Level ) -->
|
||||
location( error(_,Term), Level ) -->
|
||||
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
|
||||
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ],
|
||||
[nl].
|
||||
|
@ -322,12 +322,6 @@ meta_predicate declaration
|
||||
'$yap_strip_module'(BM:G, NBM, GM),
|
||||
'$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars).
|
||||
|
||||
'$user_expansion'(MG, M2:G2) :-
|
||||
'_user_expand_goal'(MG, MG2),
|
||||
!,
|
||||
'$yap_strip_module'( MG2, M2, G2).
|
||||
'$user_expansion'(MG, MG).
|
||||
|
||||
|
||||
'$import_expansion'(M:G, M1:G1) :-
|
||||
'$imported_predicate'(G, M, G1, M1),
|
||||
@ -377,12 +371,14 @@ o:p(B) :- n:g, X is 2+3, call(B).
|
||||
|
||||
'$user_expansion'(M0N:G0N, M1:G1) :-
|
||||
'_user_expand_goal'(M0N:G0N, M:G),
|
||||
!,
|
||||
( M:G == M0N:G0N
|
||||
->
|
||||
M1:G1 = M:G
|
||||
;
|
||||
'$user_expansion'(M:G, M1:G1)
|
||||
).
|
||||
'$user_expansion'(MG, MG).
|
||||
|
||||
'$match_mod'(G, HMod, SMod, M, O) :-
|
||||
(
|
||||
|
@ -48,7 +48,7 @@ name with the `:/2` operator.
|
||||
'$current_module'(_,N).
|
||||
'$module_dec'(N, Ps) :-
|
||||
source_location(F,_Line),
|
||||
'$nb_getval'( '$source_file', F0 , fail),
|
||||
'$nb_getval'( '$user_source_file', F0 , fail),
|
||||
'$add_module_on_file'(N, F, F0, Ps),
|
||||
'$current_module'(_,N).
|
||||
|
||||
|
@ -178,9 +178,9 @@ source/0 ( (see Setting the Compiler)).
|
||||
*/
|
||||
retract( C ) :-
|
||||
strip_module( C, M, C0),
|
||||
'$check_head_and_body'(C0,M,H,B,retract(M:C)),
|
||||
'$predicate_flags'(H, M, F, F),
|
||||
'$retract2'(F, H,M,B,_).
|
||||
'$check_head_and_body'(M:C0,M1,H,B,retract(M:C)),
|
||||
'$predicate_flags'(H, M1, F, F),
|
||||
'$retract2'(F, H, M1, B,_).
|
||||
|
||||
'$retract2'(F, H, M, B, R) :-
|
||||
F /\ 0x08000000 =:= 0x08000000, !,
|
||||
@ -219,9 +219,9 @@ retract(M:C,R) :- !,
|
||||
|
||||
'$retract'(C, M0, R) :-
|
||||
db_reference(R),
|
||||
!,
|
||||
'$is_dynamic'(H,M),
|
||||
'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
|
||||
'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
|
||||
dynamic(H,M),
|
||||
!,
|
||||
instance(R,(H:-B)),
|
||||
erase(R).
|
||||
'$retract'(C,M0,R) :-
|
||||
|
15
pl/preds.yap
15
pl/preds.yap
@ -440,19 +440,10 @@ Make predicate _Pred_ invisible to `current_predicate/2`,
|
||||
`listing`, and friends.
|
||||
|
||||
**/
|
||||
hide_predicate(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,hide_predicate(V)).
|
||||
hide_predicate(P0) :-
|
||||
strip_module(P0, M, P),
|
||||
'$hide_predicate2'(P, M).
|
||||
|
||||
'$hide_predicate2'(V, M) :- var(V), !,
|
||||
'$do_error'(instantiation_error,hide_predicate(M:V)).
|
||||
'$hide_predicate2'(N/A, M) :- !,
|
||||
functor(S,N,A),
|
||||
'$hide_predicate'(S, M) .
|
||||
'$hide_predicate2'(PredDesc, M) :-
|
||||
'$do_error'(type_error(predicate_indicator,PredDesc),hide_predicate(M:PredDesc)).
|
||||
'$yap_strip_module'(P0, M, P),
|
||||
must_be_of_type(callable, M:P),
|
||||
'$hide_predicate'(P, M).
|
||||
|
||||
/** @pred predicate_property( _P_, _Prop_) is iso
|
||||
|
||||
|
@ -20,39 +20,44 @@ xc/*************************************************************************
|
||||
% This protects all code from further changes
|
||||
% and also makes it impossible from some predicates to be seen
|
||||
'$protect' :-
|
||||
current_atom(Name),
|
||||
current_atom(Name),
|
||||
'$current_predicate'(Name,M,P,_),
|
||||
M \= user,
|
||||
functor(P,Name,Arity),
|
||||
'$new_system_predicate'(Name,Arity,M),
|
||||
sub_atom(Name,0,1,_, '$'),
|
||||
'$hide'(Name),
|
||||
\+ '$visible'(Name),
|
||||
hide_predicate(M:P),
|
||||
fail.
|
||||
'$protect' :-
|
||||
'$all_current_modules'(M),
|
||||
M \= user,
|
||||
'$current_predicate'(_,M,P,_),
|
||||
functor(P,N,A),
|
||||
'$new_system_predicate'(N,A,M),
|
||||
% writeln(N/A),
|
||||
current_atom(Name),
|
||||
sub_atom(Name,0,1,_, '$'),
|
||||
\+ '$visible'(Name),
|
||||
hide_atom(Name),
|
||||
fail.
|
||||
'$protect'.
|
||||
|
||||
|
||||
% hide all atoms who start by '$'
|
||||
'$hide'('$VAR') :- !, fail. /* not $VAR */
|
||||
'$hide'('$dbref') :- !, fail. /* not stream position */
|
||||
'$hide'('$stream') :- !, fail. /* not $STREAM */
|
||||
'$hide'('$stream_position') :- !, fail. /* not stream position */
|
||||
'$hide'('$hacks') :- !, fail.
|
||||
'$hide'('$source_location') :- !, fail.
|
||||
'$hide'('$messages') :- !, fail.
|
||||
'$hide'('$push_input_context') :- !, fail.
|
||||
'$hide'('$pop_input_context') :- !, fail.
|
||||
'$hide'('$set_source_module') :- !, fail.
|
||||
'$hide'('$declare_module') :- !, fail.
|
||||
'$hide'('$store_clause') :- !, fail.
|
||||
'$hide'('$skip_list') :- !, fail.
|
||||
'$hide'('$win_insert_menu_item') :- !, fail.
|
||||
'$hide'('$set_predicate_attribute') :- !, fail.
|
||||
'$hide'('$parse_quasi_quotations') :- !, fail.
|
||||
'$hide'('$quasi_quotation') :- !, fail.
|
||||
'$hide'('$qq_open') :- !, fail.
|
||||
%'$hide'(Name) :- hide_atom(Name), fail.
|
||||
'$visible'('$'). /* not $VAR */
|
||||
'$visible'('$VAR'). /* not $VAR */
|
||||
'$visible'('$dbref'). /* not stream position */
|
||||
'$visible'('$stream'). /* not $STREAM */
|
||||
'$visible'('$stream_position'). /* not stream position */
|
||||
'$visible'('$hacks').
|
||||
'$visible'('$source_location').
|
||||
'$visible'('$messages').
|
||||
'$visible'('$push_input_context').
|
||||
'$visible'('$pop_input_context').
|
||||
'$visible'('$set_source_module').
|
||||
'$visible'('$declare_module').
|
||||
'$visible'('$store_clause').
|
||||
'$visible'('$skip_list').
|
||||
'$visible'('$win_insert_menu_item').
|
||||
'$visible'('$set_predicate_attribute').
|
||||
'$visible'('$parse_quasi_quotations').
|
||||
'$visible'('$quasi_quotation').
|
||||
'$visible'('$qq_open').
|
||||
'$visible'('$live').
|
||||
'$visible'('$init_prolog').
|
||||
|
||||
|
@ -754,8 +754,8 @@ qload_file( F0 ) :-
|
||||
user:'$file_property'( '$lf_loaded'( F, Age, _ ) ),
|
||||
recordaifnot('$source_file','$source_file'( F, Age, SourceModule), _),
|
||||
fail.
|
||||
'$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList, _TOpts) :-
|
||||
b_setval('$source_file', F0 ),
|
||||
'$qload_file'(_S, _SourceModule, File, FilePl, F0, _ImportList, _TOpts) :-
|
||||
b_setval('$user_source_file', F0 ),
|
||||
'$process_directives'( FilePl ),
|
||||
fail.
|
||||
'$qload_file'(_S, SourceModule, _File, FilePl, _F0, ImportList, TOpts) :-
|
||||
|
@ -108,7 +108,7 @@ Z * @pred '$undefp_expand'(+ M0:G0, -MG)
|
||||
% make sure we do not loop on undefined predicates
|
||||
'$stop_creeping'(Current),
|
||||
yap_flag( unknown, _, fail),
|
||||
yap_flag( debug, Debug, false),
|
||||
% yap_flag( debug, Debug, false),
|
||||
(
|
||||
'$undefp_search'(M0:G0, NM:NG),
|
||||
( M0 \== NM -> true ; G0 \== NG ),
|
||||
@ -116,7 +116,7 @@ Z * @pred '$undefp_expand'(+ M0:G0, -MG)
|
||||
'$pred_exists'(NG,NM)
|
||||
->
|
||||
yap_flag( unknown, _, Action),
|
||||
yap_flag( debug, _, Debug),
|
||||
% yap_flag( debug, _, Debug),
|
||||
(
|
||||
Current == true
|
||||
->
|
||||
@ -127,7 +127,7 @@ Z * @pred '$undefp_expand'(+ M0:G0, -MG)
|
||||
)
|
||||
;
|
||||
yap_flag( unknown, _, Action),
|
||||
yap_flag( debug, _, Debug),
|
||||
% yap_flag( debug, _, Debug),
|
||||
'$handle_error'(Action,G0,M0)
|
||||
).
|
||||
|
||||
|
@ -431,6 +431,15 @@ stream_position_data(Prop, Term, Value) :-
|
||||
atom_codes(Char, [Code]),
|
||||
'$codes_to_chars'(String0, String, Chars).
|
||||
|
||||
/** @pred file_exists(+ _File__)
|
||||
|
||||
The atom _File_ corresponds to an existing file or directory.
|
||||
|
||||
|
||||
*/
|
||||
file_exists(IFile) :-
|
||||
true_file_name(IFile, File),
|
||||
'$file_exists'(File).
|
||||
|
||||
/**
|
||||
@}
|
||||
|
177
regression/modules/L
Normal file
177
regression/modules/L
Normal file
@ -0,0 +1,177 @@
|
||||
% YAP 6.3.4-60a8efb4RS Yap_RecoverSlots:208
|
||||
(compiled 2015-12-15T14:05:17@VITORs-MacBook-Pro.localRS Yap_RecoverSlots:208
|
||||
)
|
||||
!!! syntax error: expected to find ')', found ]
|
||||
:-RS Yap_RecoverSlots:208
|
||||
moduleRS Yap_RecoverSlots:208
|
||||
( ytestRS Yap_RecoverSlots:208
|
||||
, [run_testRS Yap_RecoverSlots:208
|
||||
/RS Yap_RecoverSlots:208
|
||||
1RS Yap_RecoverSlots:208
|
||||
,
|
||||
run_testsRS Yap_RecoverSlots:208
|
||||
/RS Yap_RecoverSlots:208
|
||||
0RS Yap_RecoverSlots:208
|
||||
,
|
||||
test_modeRS Yap_RecoverSlots:208
|
||||
/RS Yap_RecoverSlots:208
|
||||
0RS Yap_RecoverSlots:208
|
||||
,
|
||||
opRS Yap_RecoverSlots:208
|
||||
( 1150RS Yap_RecoverSlots:208
|
||||
, fxRS Yap_RecoverSlots:208
|
||||
, testRS Yap_RecoverSlots:208
|
||||
),
|
||||
opRS Yap_RecoverSlots:208
|
||||
( 999RS Yap_RecoverSlots:208
|
||||
, xfxRS Yap_RecoverSlots:208
|
||||
, givenRS Yap_RecoverSlots:208
|
||||
,
|
||||
opRS Yap_RecoverSlots:208
|
||||
( 998RS Yap_RecoverSlots:208
|
||||
, xfxRS Yap_RecoverSlots:208
|
||||
, returnsRS Yap_RecoverSlots:208
|
||||
) <== HERE ==> ] )
|
||||
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
!!! syntax error: expected operator, got 'returns'
|
||||
run_testRS Yap_RecoverSlots:208
|
||||
( Lab ):-RS Yap_RecoverSlots:208
|
||||
|
||||
source_moduleRS Yap_RecoverSlots:208
|
||||
( M ),
|
||||
testRS Yap_RecoverSlots:208
|
||||
( Lab, ( G <== HERE ==> returnsRS Yap_RecoverSlots:208
|
||||
SolsgivenRS Yap_RecoverSlots:208
|
||||
Program ), Done ),
|
||||
ensure_groundRS Yap_RecoverSlots:208
|
||||
( Done ),
|
||||
formatRS Yap_RecoverSlots:208
|
||||
( '~w : 'RS Yap_RecoverSlots:208
|
||||
, [Lab] ),
|
||||
resetRS Yap_RecoverSlots:208
|
||||
( Streams ),
|
||||
assertallRS Yap_RecoverSlots:208
|
||||
( Program, Refs ),
|
||||
conj2listRS Yap_RecoverSlots:208
|
||||
( Sols, LSols ),
|
||||
catchRS Yap_RecoverSlots:208
|
||||
( do_returnsRS Yap_RecoverSlots:208
|
||||
( M:RS Yap_RecoverSlots:208
|
||||
G, LSols, Lab ), Ball, endRS Yap_RecoverSlots:208
|
||||
( Ball ) ),
|
||||
shutdownRS Yap_RecoverSlots:208
|
||||
( Streams, Refs )
|
||||
|
||||
!!! syntax error: expected operator, got 'returns'
|
||||
run_testRS Yap_RecoverSlots:208
|
||||
( Lab ):-RS Yap_RecoverSlots:208
|
||||
|
||||
source_moduleRS Yap_RecoverSlots:208
|
||||
( M ),
|
||||
testRS Yap_RecoverSlots:208
|
||||
( Lab, ( G <== HERE ==> returnsRS Yap_RecoverSlots:208
|
||||
Sols ), Done ),
|
||||
ensure_groundRS Yap_RecoverSlots:208
|
||||
( Done ),
|
||||
formatRS Yap_RecoverSlots:208
|
||||
( '~w : 'RS Yap_RecoverSlots:208
|
||||
, [Lab] ),
|
||||
resetRS Yap_RecoverSlots:208
|
||||
( Streams ),
|
||||
conj2listRS Yap_RecoverSlots:208
|
||||
( Sols, LSols ),
|
||||
catchRS Yap_RecoverSlots:208
|
||||
( do_returnsRS Yap_RecoverSlots:208
|
||||
( M:RS Yap_RecoverSlots:208
|
||||
G, LSols, Lab ), Ball, endRS Yap_RecoverSlots:208
|
||||
( Ball ) ),
|
||||
shutdownRS Yap_RecoverSlots:208
|
||||
( Streams, _ )
|
||||
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
!!! syntax error: expected operator, got 'returns'
|
||||
infoRS Yap_RecoverSlots:208
|
||||
( A <== HERE ==> returnsRS Yap_RecoverSlots:208
|
||||
B, _, ( AreturnsRS Yap_RecoverSlots:208
|
||||
B ), gRS Yap_RecoverSlots:208
|
||||
( _, okRS Yap_RecoverSlots:208
|
||||
) ):-RS Yap_RecoverSlots:208
|
||||
!RS Yap_RecoverSlots:208
|
||||
|
||||
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
!!! syntax error: expected to find ')', found <EOT>
|
||||
do_returnsRS Yap_RecoverSlots:208
|
||||
( G0, Sols0, Lab ):-RS Yap_RecoverSlots:208
|
||||
|
||||
counterRS Yap_RecoverSlots:208
|
||||
( I ),
|
||||
fetchRS Yap_RecoverSlots:208
|
||||
( I, Sols0, Pattern0, Next ),
|
||||
(
|
||||
Pattern0=RS Yap_RecoverSlots:208
|
||||
( V0=@=RS Yap_RecoverSlots:208
|
||||
Target0 ),
|
||||
copy_termRS Yap_RecoverSlots:208
|
||||
( G0-RS Yap_RecoverSlots:208
|
||||
V0, G-RS Yap_RecoverSlots:208
|
||||
VGF ),
|
||||
catchRS Yap_RecoverSlots:208
|
||||
( answerRS Yap_RecoverSlots:208
|
||||
( G, VGF, Target0, Lab, Sol ), Error, Sol=RS Yap_RecoverSlots:208
|
||||
errorRS Yap_RecoverSlots:208
|
||||
( G, Error ) ),
|
||||
stepRS Yap_RecoverSlots:208
|
||||
( _I, Sols, G0, Sol, Lab ),
|
||||
!RS Yap_RecoverSlots:208
|
||||
<== HERE ==>
|
||||
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
RS Yap_RecoverSlots:208
|
||||
?- \^\% YAP exiting: cannot handle signal 3
|
16
regression/modules/goal_expansion_tests.yap
Normal file
16
regression/modules/goal_expansion_tests.yap
Normal file
@ -0,0 +1,16 @@
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
|
||||
test a(X) returns atom(X) .+
|
||||
given user:goal_expansion(a(X), current_atom(X))
|
||||
|
||||
test m:a(3,X) returns X =@= 15,
|
||||
given user:goal_expansion(a(X,Y), Y is X*5)
|
||||
|
||||
test m:a(3,X) returns X =@= 9
|
||||
given user:goal_expansion(a(X,Y), m, Y is X*X ))
|
||||
|
||||
test m:a(3,X) returns X =@= 9
|
||||
given user:goal_expansion(a(X,Y), m, Y is X*X ), user:goal_expansion(a(X), X is 3*5)
|
||||
|
32
regression/parse/run
Normal file
32
regression/parse/run
Normal file
@ -0,0 +1,32 @@
|
||||
#!/usr/local/bin/yap
|
||||
#.
|
||||
#
|
||||
#
|
||||
|
||||
:- use_module(library(system)).
|
||||
|
||||
main :-
|
||||
source_dir( Dir ),
|
||||
directory_files(Dir/input/parse,[_,_|Files]),
|
||||
member( File, Files ),
|
||||
atom_concat(test_, Number, File),
|
||||
run( File ),
|
||||
match( File ),
|
||||
fail.
|
||||
main.
|
||||
|
||||
run(File) :-
|
||||
open( Dir/in/File, read, Stream ),
|
||||
tmp_dir( Tmp ),
|
||||
open( Tmp/File, Write, Output ),
|
||||
parse( Stream, Output ).
|
||||
|
||||
parse( Stream, Output ) :-
|
||||
catch( take(Stream, Term ), ERR, TERM = err__(ERR) ),
|
||||
show( Stream, Output, Term ).
|
||||
|
||||
take( Stream, Term ) :-
|
||||
repeat,
|
||||
read_term( Stream, Term ),
|
||||
( Term == end_of_file -> ! ; true ).
|
||||
|
831
utils/sysgraph
Executable file
831
utils/sysgraph
Executable file
@ -0,0 +1,831 @@
|
||||
#!/usr/local/bin/yap -L -- $*
|
||||
#.
|
||||
|
||||
:- style_check(all).
|
||||
|
||||
:- yap_flag( write_strings, on).
|
||||
:- yap_flag( gc_trace, verbose ).
|
||||
|
||||
:- use_module(library(readutil)).
|
||||
:- use_module(library(lineutils)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(maplist)).
|
||||
:- use_module(library(system)).
|
||||
|
||||
:- use_module(library(analysis/graphs)).
|
||||
:- use_module(library(analysis/load)).
|
||||
|
||||
:- initialization(main).
|
||||
|
||||
:- style_check(all).
|
||||
|
||||
:- yap_flag( double_quotes, string ).
|
||||
%:- yap_flag( dollar_as_lower_case, on ).
|
||||
|
||||
:- dynamic
|
||||
node/4,
|
||||
edge/1,
|
||||
public/2,
|
||||
private/2,
|
||||
module_on/3,
|
||||
exported/1,
|
||||
dir/2,
|
||||
consulted/2,
|
||||
op_export/3,
|
||||
library/1,
|
||||
undef/2,
|
||||
c_dep/2,
|
||||
do_comment/5,
|
||||
module_file/2.
|
||||
|
||||
% @short node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet
|
||||
%
|
||||
|
||||
|
||||
inline( !/0 ).
|
||||
inline( (\+)/1 ).
|
||||
inline( (fail)/0 ).
|
||||
inline( (false)/0 ).
|
||||
inline( (repeat)/0 ).
|
||||
inline( (true)/0 ).
|
||||
inline( []/0 ).
|
||||
|
||||
% @short edge(+SourceModule:module, +SourcePredicate:pred_indicator, +TargetPredicate:pred_indicator, +InFile:file) is nondet
|
||||
%
|
||||
|
||||
main :-
|
||||
init,
|
||||
fail.
|
||||
main :-
|
||||
unix(argv([D])),
|
||||
Dirs = ['C'-prolog,
|
||||
'os'-prolog,
|
||||
'pl'-prolog,
|
||||
'OPTYap'-prolog,
|
||||
'library'-user,
|
||||
% 'swi/console'-user
|
||||
'packages'-user
|
||||
],
|
||||
% maplist(distribute(D), Dirs, Paths),
|
||||
load( D, Dirs ),
|
||||
maplist( pl_graphs, Dirs ),
|
||||
fail.
|
||||
main :-
|
||||
%%% phase 4: construct graph
|
||||
retractall( consulted(_,_) ),
|
||||
undefs,
|
||||
doubles,
|
||||
% pl_exported(pl).
|
||||
c_links,
|
||||
mkdocs.
|
||||
|
||||
distribute( Root, File-Class, Path-Class) :-
|
||||
sub_atom(Root,_,_,1,/),
|
||||
!,
|
||||
atom_concat(Root, File, Path ).
|
||||
distribute( Root, File-Class, Path-Class) :-
|
||||
atom_concat([Root, /, File], Path ).
|
||||
|
||||
init :-
|
||||
retractall(dir(_)),
|
||||
retractall(edge(_)),
|
||||
retractall(private(_,_)),
|
||||
retractall(public(_,_)),
|
||||
retractall(undef(_,_)),
|
||||
retractall(consulted(_,_)),
|
||||
retractall(module_on(_,_,_)),
|
||||
retractall(op_export(_,_,_)),
|
||||
retractall(exported(_)),
|
||||
retractall(do_comment(_,_,_,_,_)).
|
||||
init :-
|
||||
user_c_dep(A,B),
|
||||
do_user_c_dep(A,B),
|
||||
fail.
|
||||
init :-
|
||||
user_skip(A),
|
||||
do_user_skip(A),
|
||||
fail.
|
||||
init :-
|
||||
user_expand(N,A),
|
||||
do_user_expand(N,A),
|
||||
fail.
|
||||
init :-
|
||||
catch( make_directory(tmp), _, fail),
|
||||
fail.
|
||||
init.
|
||||
|
||||
init_loop( _Dirs ).
|
||||
|
||||
doubles :-
|
||||
node(M, P, F-_, _),
|
||||
node(M1, P, F1-_, _),
|
||||
M @< M1,
|
||||
is_public( P, M, F),
|
||||
is_public( P, M1, F1),
|
||||
format('~w vs ~w~n', [M:P,M1:P]),
|
||||
fail.
|
||||
doubles.
|
||||
|
||||
undefs :-
|
||||
trace,
|
||||
format('UNDEFINED procedure calls:~n',[]),
|
||||
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('[]', []).
|
||||
out_list([El]) :-
|
||||
format('[~q]', [El]).
|
||||
out_list([E1,E2|Es]) :-
|
||||
format('[~q', [E1]),
|
||||
maplist(out_el, [E2|Es]),
|
||||
format(']', []).
|
||||
|
||||
out_el( El ) :-
|
||||
format(',~n ~q',[El]).
|
||||
|
||||
pub(M, P) :-
|
||||
node(M, P, _, _),
|
||||
P = N/_A,
|
||||
\+ sub_atom(N,0,1,_,'$').
|
||||
|
||||
has_edge(M1, P1, M, F) :-
|
||||
edge(M1:P1, _P, F:_),
|
||||
node(M1, P1, _, _),
|
||||
M1 \= prolog,
|
||||
M1 \= M,
|
||||
\+ is_public(P1, M1, _).
|
||||
|
||||
mod_priv(M, P) :-
|
||||
node(M, P, _, _),
|
||||
node(M, P, _, _),
|
||||
\+ is_public(P, M, _),
|
||||
edge(M1:P, _P0, _), M1 \= M.
|
||||
|
||||
priv(M, P) :-
|
||||
node(M, P, F:_, _),
|
||||
\+ is_public(P, M, _),
|
||||
edge(_:P, _P1, F1:_), F1 \= F.
|
||||
|
||||
% utilities
|
||||
|
||||
split_string( S , Cs, N) :-
|
||||
string_codes(S, S1),
|
||||
string_codes(Cs, NCs),
|
||||
split(S1, NCs, Ncs0),
|
||||
maplist(remove_escapes, Ncs0, Ncs),
|
||||
maplist(string_codes, N, Ncs).
|
||||
|
||||
remove_escapes([0'\\ ,A|Cs], [A|NCs]) :- !, %'
|
||||
remove_escapes(Cs, NCs).
|
||||
remove_escapes([A|Cs], [A|NCs]) :-
|
||||
remove_escapes(Cs, NCs).
|
||||
remove_escapes( [], [] ).
|
||||
|
||||
always_strip_module(V, M, V1) :- var(V), !,
|
||||
V = M:call(V1).
|
||||
always_strip_module(M0:A, M0, call(A)) :- var(A), !.
|
||||
always_strip_module(_:M0:A, M1, B) :- !,
|
||||
always_strip_module(M0:A, M1, B).
|
||||
always_strip_module(M0:A, M0, call(A)) :- var(A),!.
|
||||
always_strip_module(M0:A, M0, A).
|
||||
|
||||
c_links :-
|
||||
open('tmp/foreigns.yap', write, S),
|
||||
clinks(S),
|
||||
fail.
|
||||
c_links :-
|
||||
open('tmp/foreigns.c', write, S),
|
||||
cclinks(S),
|
||||
fail.
|
||||
|
||||
clinks(S) :-
|
||||
module_file( F, NM ),
|
||||
format( S, 'mod( ~q , ~q ).~n', [NM, F] ),
|
||||
fail.
|
||||
clinks(S) :-
|
||||
system_predicate(C),
|
||||
functor(C, N, A),
|
||||
format( S, 'sys ~q/~d.~n', [N, A] ),
|
||||
fail.
|
||||
clinks(S) :-
|
||||
exported( ( Fi0-M:F/A :- Fi1-M1:F1/A ) ),
|
||||
( M \= M1 -> M \= prolog ; F \= F1 ),
|
||||
% functor(S0, F, A),
|
||||
% S0 =.. [F| Args],
|
||||
% S1 =.. [F1| Args],
|
||||
% numbervars(Args, 0, _),
|
||||
format( S, '% ~q <- ~q.~n~q:~q imports ~q:~q. ~n', [Fi0, Fi1, M,F/A, M1,F1/A] ),
|
||||
fail.
|
||||
clinks(S) :-
|
||||
close(S).
|
||||
|
||||
cclinks(S) :-
|
||||
node( M, F/A, File-_Line, c(F)),
|
||||
% functor( S0, F, A),
|
||||
% S0 =.. [F| Args],
|
||||
% S1 =.. [foreign, F| Args],
|
||||
% numbervars(Args, 0, _),
|
||||
format( S, '/// @file ~a~n', [File] ),
|
||||
format( S, '/// @memberof ~a ~a:~a/~d~n', [F, M, F, A] ),
|
||||
fail.
|
||||
cclinks(S) :-
|
||||
close(S).
|
||||
|
||||
warn_singletons(_Vars, _Pos).
|
||||
|
||||
%%
|
||||
% comment( +Comment )
|
||||
%
|
||||
% Handle documentation comments
|
||||
%
|
||||
comment( _Pos - Comment) :-
|
||||
skip_blanks(1, Comment, N),
|
||||
doc( Comment, N ),
|
||||
format( "%s\n", [Comment] ),
|
||||
!.
|
||||
comment( _Pos - _Comment).
|
||||
|
||||
skip_blanks(I, Comment, N) :-
|
||||
get_string_code( I, Comment, Code ),
|
||||
code_type( Code, space ),
|
||||
I1 is I+1,
|
||||
skip_blanks(I1, Comment, N).
|
||||
skip_blanks(N, _Comment, N).
|
||||
|
||||
doc( Comment , N ) :-
|
||||
N1 is N+1,
|
||||
sub_string( Comment, N1, 3, _, Header ),
|
||||
( Header == "/**" -> true ; Header == "/*!" ), !, % */
|
||||
N4 is N+4,
|
||||
get_string_code( N4, Comment, Code ),
|
||||
code_type( Code, space ).
|
||||
doc( Comment, N ) :-
|
||||
N1 is N+1,
|
||||
sub_string( Comment, N1, 2, _, Header ),
|
||||
( Header == "%%" -> true ; Header == "%!" ),
|
||||
N3 is N+3,
|
||||
get_string_code( N3, Comment, Code ),
|
||||
code_type( Code, space ).
|
||||
|
||||
|
||||
%%
|
||||
% search_file( +Target, +Location, +FileType, -File )
|
||||
%
|
||||
%
|
||||
% Directories into atoms
|
||||
search_file( Loc , F, Type, FN ) :-
|
||||
search_file0( Loc , F, Type, FN ),
|
||||
!.
|
||||
search_file( Loc , F, _FN ) :-
|
||||
format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]),
|
||||
fail.
|
||||
|
||||
%
|
||||
% handle some special cases.
|
||||
%
|
||||
search_file0( F, _, _Type, FN ) :-
|
||||
doexpand(F, FN), !.
|
||||
search_file0( A/B, F, Type, FN ) :- !,
|
||||
term_to_atom(A/B, AB),
|
||||
search_file0( AB, F, Type, FN ).
|
||||
% libraries can be anywhere in the source.
|
||||
search_file0( LibLoc, F, Type, FN ) :-
|
||||
LibLoc =.. [Dir,File],
|
||||
!,
|
||||
( term_to_atom( Dir/File, Full ) ; Full = File ),
|
||||
search_file0( Full, F, Type, FN ).
|
||||
%try to use your base
|
||||
search_file0( Loc , F, c, FN ) :-
|
||||
atom_concat( D, '.yap', F),
|
||||
atom_concat( [ D, '/', Loc], F1),
|
||||
check_suffix( F1 , c, NLoc ),
|
||||
absolute_file_name( NLoc, FN),
|
||||
file_base_name( FN, LocNam),
|
||||
file_directory_name( FN, D),
|
||||
dir( D, LocNam ).
|
||||
search_file0( Loc , F, Type, FN ) :-
|
||||
file_directory_name( F, FD),
|
||||
check_suffix( Loc , Type, LocS ),
|
||||
atom_concat( [ FD, '/', LocS], NLoc),
|
||||
absolute_file_name( NLoc, FN),
|
||||
file_base_name( FN, LocNam),
|
||||
file_directory_name( FN, D),
|
||||
dir( D, LocNam).
|
||||
search_file0( Loc , _F, Type, FN ) :-
|
||||
file_base_name( Loc, Loc0),
|
||||
file_directory_name( Loc, LocD),
|
||||
check_suffix( Loc0 , Type, LocS ),
|
||||
dir( D, LocS),
|
||||
sub_dir( D, DD),
|
||||
atom_concat( [ DD, '/', LocD], NLoc),
|
||||
absolute_file_name( NLoc, D),
|
||||
atom_concat( [D,'/', LocS], FN).
|
||||
search_file0( Loc , _F, Type, FN ) :-
|
||||
file_base_name( Loc, Loc0),
|
||||
check_suffix( Loc0 , Type, LocS ),
|
||||
dir( D, LocS),
|
||||
atom_concat( [D,'/', LocS], FN).
|
||||
% you try using the parent
|
||||
|
||||
sub_dir( D, D ).
|
||||
sub_dir( D, DD) :-
|
||||
D \= '/',
|
||||
atom_concat( D, '/..', DD0),
|
||||
absolute_file_name( DD0, DDA),
|
||||
sub_dir( DDA, DD).
|
||||
|
||||
% files must be called .yap or .pl
|
||||
% if it is .yap...
|
||||
check_suffix( Loc , pl, Loc ) :-
|
||||
atom_concat( _, '.yap', Loc ), !.
|
||||
%, otherwise, .pl
|
||||
check_suffix( Loc , pl, Loc ) :-
|
||||
atom_concat( _, '.pl', Loc ), !.
|
||||
%, otherwise, .prolog
|
||||
check_suffix( Loc , pl, Loc ) :-
|
||||
atom_concat( _, '.prolog', Loc ), !.
|
||||
%, otherwise, .P
|
||||
% try adding suffix
|
||||
check_suffix( Loc0 , pl, Loc ) :-
|
||||
member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']),
|
||||
atom_concat( Loc0, Suf, Loc ).
|
||||
check_suffix( Loc , c, Loc ) :-
|
||||
atom_concat( _, '.c', Loc ), !.
|
||||
%, otherwise, .pl
|
||||
check_suffix( Loc , c, Loc ) :-
|
||||
atom_concat( _, '.icc', Loc ), !.
|
||||
%, otherwise, .prolog
|
||||
check_suffix( Loc , c, Loc ) :-
|
||||
atom_concat( _, '.cpp', Loc ), !.
|
||||
%, otherwise, .P
|
||||
% try adding suffix
|
||||
check_suffix( Loc0 , c, Loc ) :-
|
||||
member( Suf , ['.c', '.icc' , '.cpp']),
|
||||
atom_concat( Loc0, Suf, Loc ).
|
||||
|
||||
|
||||
|
||||
match_file( LocD, Loc0, Type, FN ) :-
|
||||
var(LocD), !,
|
||||
dir( LocD, Loc0 ),
|
||||
atom_concat( [LocD, '/', Loc0], F ),
|
||||
absolute_file_name( F, Type, FN ),
|
||||
exists( FN ).
|
||||
match_file( SufLocD, Loc0, Type, FN ) :-
|
||||
dir( LocD, Loc0 ),
|
||||
atom_concat(_, SufLocD, LocD ),
|
||||
atom_concat( [LocD, '/', Loc0], Type, FN ).
|
||||
|
||||
|
||||
new_op( F, M, op(X,Y,Z) ) :-
|
||||
nb_getval( private, true ),
|
||||
!,
|
||||
private( F, M, op(X,Y,Z) ),
|
||||
op( X, Y, Z).
|
||||
new_op( F, M, op( X, Y, Z) ) :-
|
||||
public( F, M, op( X, Y, Z) ).
|
||||
|
||||
|
||||
ypp(F, error(syntax_error(syntax_error),[syntax_error(read(_228515),between(K,L,M),_,_L,_)-_]) ) :-
|
||||
format('SYNTAX ERROR at file ~a, line ~d (~d - ~d).~n', [F,L,K,M] ),
|
||||
break.
|
||||
|
||||
preprocess_file(F,NF) :-
|
||||
atom_concat(_, '.ypp', F ), !,
|
||||
atom_concat( [ 'cpp -CC -w -DMYDDAS_MYSQL -DMYDDAS_ODBC -DMYDDAS_STATS -DMYDDAS_TOP_LEVEL -P ',F], OF ),
|
||||
NF = pipe( OF ).
|
||||
preprocess_file(F,F).
|
||||
|
||||
|
||||
%%%%%%%
|
||||
%% declare a concept export1able
|
||||
public( F, M, op(X,Y,Z) ) :-
|
||||
retract( private( F, M:op(X,Y,Z) ) ),
|
||||
fail.
|
||||
public( F, M, op(X,Y,Z) ) :- !,
|
||||
assert( op_export(F, _M, op(X,Y,Z) ) ),
|
||||
assert_new( public( F, M:op(X,Y,Z) ) ),
|
||||
(
|
||||
( M == user ; M == prolog )
|
||||
->
|
||||
op( X, Y, prolog:Z )
|
||||
;
|
||||
op( X, Y, M:Z )
|
||||
).
|
||||
public( F, M, M:N/Ar ) :-
|
||||
retract( private( F, M:N/Ar ) ),
|
||||
fail.
|
||||
public( F, M, N/Ar ) :-
|
||||
assert_new( public( F, M:N/Ar ) ),
|
||||
\+ node( M, N/Ar, F-_, _ ),
|
||||
nb_getval( line, L ),
|
||||
assert( node( M, N/Ar, F-L, prolog ) ), !.
|
||||
public( _F, _M, _/_Ar ).
|
||||
public( F, M, M:N//Ar ) :-
|
||||
Ar2 is Ar+2,
|
||||
retract( private( F, M:N/Ar2 ) ),
|
||||
fail.
|
||||
public( F, M, N//Ar ) :-
|
||||
Ar2 is Ar+2,
|
||||
assert_new( public( F, M:N/Ar2 ) ),
|
||||
\+ node( M, N/Ar2, F-_, _ ),
|
||||
nb_getval( line, L ),
|
||||
assert( node( M, N/Ar2, F-L, prolog ) ), !.
|
||||
public( _F, _M, _//_Ar ).
|
||||
|
||||
private( F, M, op(X,Y,Z) ) :-
|
||||
assert_new( private( F, M:op(X,Y,Z) ) ),
|
||||
(
|
||||
( M == user ; M == prolog )
|
||||
->
|
||||
op( X, Y, prolog:Z )
|
||||
;
|
||||
op( X, Y, M:Z )
|
||||
), !.
|
||||
private( _F, _M, op(_X,_Y,_Z) ).
|
||||
private( F, M, N/Ar ) :-
|
||||
assert_new( private( F, M:N/Ar ) ),
|
||||
\+ node( M, N/Ar, F-_, _ ),
|
||||
nb_getval( line, L ),
|
||||
assert( node( M, N/Ar, F-L, prolog ) ), !.
|
||||
private( _F, _M, _N/_Ar ).
|
||||
private( F, M, N//Ar ) :-
|
||||
Ar2 is Ar+2,
|
||||
assert_new( private( F, M:N/Ar2 ) ),
|
||||
\+ node( M, N/Ar2, F-_, _ ),
|
||||
nb_getval( line, L ),
|
||||
assert_new( node( M, N/Ar2, F-L, prolog ) ), !.
|
||||
private( _F, _M, _N//_Ar ).
|
||||
|
||||
is_public( F, M, OP ) :-
|
||||
public( F, M:OP ).
|
||||
|
||||
is_private( F, M, OP ) :-
|
||||
private( F, M :OP ).
|
||||
|
||||
assert_new( G ) :- G, !.
|
||||
assert_new( G ) :- assert( G ).
|
||||
|
||||
error( Error ) :- throw(Error ).
|
||||
|
||||
|
||||
%% mkdocs inserts a file with a sequence of comments into a sequence of Prolog/C files.
|
||||
%
|
||||
%
|
||||
mkdocs :-
|
||||
open( 'tmp/pages', write, S1),
|
||||
close( S1 ),
|
||||
open( 'tmp/bads', write, S2),
|
||||
close( S2 ),
|
||||
open( 'tmp/groups', write, S3),
|
||||
close( S3 ),
|
||||
open( 'tmp/groups.yap', write, S4),
|
||||
close( S4 ),
|
||||
open( 'docs/yapdocs.yap', read, S),
|
||||
repeat,
|
||||
(
|
||||
blanks(S, Comment, Rest)
|
||||
->
|
||||
get_comment(S, Rest),
|
||||
store_comment( Comment ),
|
||||
fail
|
||||
;
|
||||
close(S),
|
||||
!,
|
||||
add_comments
|
||||
).
|
||||
|
||||
blanks( S , T, TF) :-
|
||||
read_line_to_codes(S, T1, T2),
|
||||
( T1 == end_of_file -> fail;
|
||||
T2 == [] -> fail;
|
||||
T1 \== T2, foldl( check, [0'/,0'*,0'*],T1, _) -> TF = T2, T = T1 ; % '
|
||||
blanks( S , T, TF) ).
|
||||
|
||||
get_comment( S , T) :-
|
||||
read_line_to_codes(S, T, T0),
|
||||
( T == end_of_file -> T = [];
|
||||
T0 == [] -> T=[];
|
||||
diff_end( [0'*,0'/,10],T, T0 ) -> true ;
|
||||
get_comment( S , T0) ).
|
||||
|
||||
check(C, [C0|L], L) :-
|
||||
C == C0.
|
||||
|
||||
diff_end( L, T, [] ) :-
|
||||
append(_, L, T).
|
||||
|
||||
store_comment(Comment) :-
|
||||
header( Pred, A, Comment, _ ),
|
||||
atom_codes( P, Pred),
|
||||
( node( Mod, P/A, File-Line, Type) ->
|
||||
true
|
||||
;
|
||||
format('Missing definition for ~q.~n', [P/A] ),
|
||||
node( Mod, P/Ar, File-Line, Type),
|
||||
format(' ~w exists.~n',[Mod:P/Ar]),
|
||||
fail
|
||||
),
|
||||
( node( M1, P/A, _, _), M1 \= Mod -> Dup = true ; Dup = false),
|
||||
!,
|
||||
string_codes( C, Comment ),
|
||||
assert( do_comment( File, Line, C, Type, Dup ) ).
|
||||
store_comment(Comment) :-
|
||||
page( Comment, _ ), !,
|
||||
open( 'tmp/pages', append, S),
|
||||
format(S, '*******************************~n~n~s~n~n', [Comment]),
|
||||
close(S).
|
||||
store_comment(Comment) :-
|
||||
defgroup( Comment, _ ), !,
|
||||
open( 'tmp/groups', append, S),
|
||||
format(S, '*******************************~n~n~s~n~n', [Comment]),
|
||||
close(S).
|
||||
store_comment(Comment) :-
|
||||
open( 'tmp/bads', append, S),
|
||||
format(S, '*******************************~n~n~s~n~n', [Comment]),
|
||||
close(S).
|
||||
|
||||
defgroup -->
|
||||
"/**", % */
|
||||
blanks_or_stars,
|
||||
"@defgroup".
|
||||
defgroup -->
|
||||
"%%", % */
|
||||
blanks_or_percs,
|
||||
"@defgroup".
|
||||
|
||||
page -->
|
||||
"/**", % */
|
||||
blanks,
|
||||
"@page".
|
||||
|
||||
header(Pred, Arity) -->
|
||||
"/**", % */
|
||||
blanks,
|
||||
"@pred",
|
||||
blanks,
|
||||
atom(_),
|
||||
":",
|
||||
!,
|
||||
atom(Pred),
|
||||
atom_pred(Arity).
|
||||
header(Pred, Arity) -->
|
||||
"/**", % */
|
||||
blanks,
|
||||
"@pred",
|
||||
blanks,
|
||||
atom(Pred),
|
||||
atom_pred(Arity),
|
||||
!.
|
||||
header(Pred, 2, Comment, _) :-
|
||||
split(Comment, [[0'/,0'*,0'*],[0'@,0'p,0'r,0'e,0'd],_,Pred,_,[0'i,0's]|_]), !.
|
||||
|
||||
|
||||
atom_pred(Arity) -->
|
||||
"/", !,
|
||||
int( 0, Arity ).
|
||||
atom_pred(N) -->
|
||||
"(",
|
||||
!,
|
||||
decl(1,N).
|
||||
atom_pred(0) -->
|
||||
blanks, !.
|
||||
|
||||
int(I0, I) -->
|
||||
[A],
|
||||
{ A >= "0", A =< "9" },
|
||||
!,
|
||||
{ I1 is I0*10+(A-"0") },
|
||||
int(I1, I).
|
||||
int( I, I ) --> [].
|
||||
|
||||
decl(I, I) -->
|
||||
")", !.
|
||||
decl(I0, I) -->
|
||||
",", !,
|
||||
{ I1 is I0+1 },
|
||||
decl(I1, I).
|
||||
decl(I0, I) -->
|
||||
[_],
|
||||
decl( I0, I).
|
||||
|
||||
skip_early_comment(C) -->
|
||||
[C], !,
|
||||
skip_early_comment(C).
|
||||
skip_early_comment(C) -->
|
||||
( " " ; "\t" ; "\n" ), !,
|
||||
skip_early_comment(C).
|
||||
skip_early_comment(C) -->
|
||||
"@", ( "{" ; "}" ), !,
|
||||
skip_early_comment(C).
|
||||
skip_early_comment(_) --> [].
|
||||
|
||||
blanks --> " ", !, blanks.
|
||||
blanks --> "\t", !, blanks.
|
||||
blanks --> [].
|
||||
|
||||
atom([A|As]) -->
|
||||
[A],
|
||||
{ A >= "a", A =< "z" },
|
||||
atom2( As ).
|
||||
|
||||
atom2([A|As]) -->
|
||||
[A],
|
||||
{ A >= "a", A =< "z" -> true ;
|
||||
A >= "A", A =< "Z" -> true ;
|
||||
A >= "0", A =< "9" -> true ;
|
||||
A =:= "_"
|
||||
},
|
||||
!,
|
||||
atom2( As ).
|
||||
atom2([]) --> [].
|
||||
|
||||
add_comments :-
|
||||
open('tmp/comments.yap', write, S),
|
||||
findall(File, do_comment( File, Line, C, Type, Dup), Fs0 ),
|
||||
(
|
||||
sort(Fs0, Fs),
|
||||
member( File, Fs ),
|
||||
setof(Line-C-Type-Dup, do_comment( File, Line, C, Type, Dup) , Lines0 ),
|
||||
reverse( Lines0, Lines),
|
||||
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\
|
||||
mv x ~a~n~n',[Dup,CN, Line1, File, File])
|
||||
;
|
||||
close(S)
|
||||
),
|
||||
fail.
|
||||
add_comments :-
|
||||
listing( open_comment ).
|
||||
|
||||
check_comment( Comment, CN, _Line, _qFile ) :-
|
||||
string_codes( Comment, [_,_,_|C]),
|
||||
check_groups(0,_C,[]),
|
||||
check_quotes(0,C,[]),
|
||||
(
|
||||
append(C0,[0'@,0'},0' ,0'*,0'/,10], C) -> %'
|
||||
append(C0,[0'*,0'/,10], CN)
|
||||
;
|
||||
CN = C
|
||||
),
|
||||
!.
|
||||
check_comment( Comment, Comment, Line, File ) :-
|
||||
format(user_error,'*** bad comment ~a ~d~n~n~s~n~', [File,Line,Comment]).
|
||||
|
||||
check_groups(0) --> [].
|
||||
|
||||
|
||||
check_quotes( 0 ) --> [].
|
||||
check_quotes( 0 ) -->
|
||||
"`", !,
|
||||
check_quotes( 1 ).
|
||||
check_quotes( 1 ) -->
|
||||
"`", !,
|
||||
check_quotes( 0 ).
|
||||
check_quotes( 1 ) -->
|
||||
"\"", !, { fail }.
|
||||
check_quotes( 1 ) -->
|
||||
"'", !, { fail }. %'
|
||||
check_quotes( N ) -->
|
||||
[_],
|
||||
check_quotes( N ).
|
||||
|
||||
|
||||
%%%
|
||||
% ops_default sets operators back to YAP default.
|
||||
%
|
||||
ops_default :-
|
||||
abolish( default_ops/1 ),
|
||||
A = (_,_), functor(A,Comma,2),
|
||||
findall(op(X,Y,prolog:Z), ( current_op(X,Y,prolog:Z), Z\= Comma ), L),
|
||||
assert_static( default_ops(L) ).
|
||||
|
||||
:- initialization(ops_default, now).
|
||||
|
||||
ops_restore :-
|
||||
A = (_,_), functor(A,Comma,2),
|
||||
current_op(_X,Y,prolog:Z),
|
||||
Z\= Comma,
|
||||
op(0,Y,prolog:Z),
|
||||
fail.
|
||||
ops_restore :-
|
||||
default_ops(L),
|
||||
maplist( call, L ).
|
||||
|
||||
do_user_c_dep(F1, F2) :-
|
||||
absolute_file_name(F1, A1),
|
||||
absolute_file_name(F2, A2),
|
||||
assert(c_dep(A1, A2)).
|
||||
do_user_skip(F1) :-
|
||||
absolute_file_name(F1, A1),
|
||||
assert(doskip(A1)).
|
||||
do_user_expand(F, F1) :-
|
||||
absolute_file_name(F1, A1),
|
||||
assert(doexpand(F, A1)).
|
||||
|
||||
user_deps( F, M ) :-
|
||||
c_dep(F, A2),
|
||||
c_file(A2 , M),
|
||||
fail.
|
||||
user_deps( _F, _M ).
|
||||
|
||||
user_c_dep( 'packages/jpl/jpl.pl', 'packages/jpl/src/c/jpl.c' ).
|
||||
user_c_dep( 'packages/real/real.pl', 'packages/real/real.c' ).
|
||||
user_c_dep( 'packages/odbc/odbc.pl', 'packages/odbc/odbc.c' ).
|
||||
user_c_dep( 'packages/clib/unix.pl', 'packages/clib/unix.c' ).
|
||||
user_c_dep( 'packages/clib/cgi.pl', 'packages/clib/cgi.c' ).
|
||||
user_c_dep( 'packages/clib/crypt.pl', 'packages/clib/crypt.c' ).
|
||||
user_c_dep( 'packages/clib/filesex.pl', 'packages/clib/files.c' ).
|
||||
user_c_dep( 'packages/clib/mime.pl', 'packages/clib/mime.c' ).
|
||||
user_c_dep( 'packages/clib/socket.pl', 'packages/clib/socket.c' ).
|
||||
user_c_dep( 'packages/clib/socket.pl', 'packages/clib/winpipe.c' ).
|
||||
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/cgi_stream.c' ).
|
||||
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/stream_range.c' ).
|
||||
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_chunked.c' ).
|
||||
user_c_dep( 'packages/http/http_stream.pl', 'packages/http/http_error.c' ).
|
||||
user_c_dep( 'packages/swi-minisat2/minisat.pl', 'packages/swi-minisat2/C/pl-minisat.C' ).
|
||||
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/gecode4_yap.cc' ).
|
||||
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_forward_auto_generated.icc' ).
|
||||
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_init_auto_generated.icc' ).
|
||||
user_c_dep( 'packages/gecode/gecode.yap', 'packages/gecode/4.2.1/gecode_yap_cc_impl_auto_generated.icc' ).
|
||||
user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/atom_map.c' ).
|
||||
user_c_dep( 'packages/semweb/rdf_db.pl', 'packages/semweb/resource.c' ).
|
||||
user_c_dep( 'packages/sgml/sgml.pl', 'packages/sgml/quote.c' ).
|
||||
user_c_dep( 'swi/library/readutil.pl', 'packages/clib/readutil.c' ).
|
||||
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_shared.c' ).
|
||||
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_odbc.c' ).
|
||||
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_mysql.c' ).
|
||||
user_c_dep( 'packages/myddas/pl/myddas.ypp', 'packages/myddas/myddas_top_level.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/bpx.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/error.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/fputil.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/gamma.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/glue.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/idtable_preds.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/random.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/termpool.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/vector.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/core/xmalloc.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_ml.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_aux_vb.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_ml.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/em_preds.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/flags.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/graph_aux.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/hindsight.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/util.c' ).
|
||||
user_c_dep( 'packages/prism/src/prolog/prism.yap', 'packages/prism/src/c/up/viterbi.c' ).
|
||||
|
||||
doskip( D):- sub_atom( D, _, _, 0, '~' ).
|
||||
doskip( D):- sub_atom( D, _, _, 0, '/.' ).
|
||||
doskip( D):- sub_atom( D, _, _, 0, '/..' ).
|
||||
doskip( D):- sub_atom( D, _, _, 0, '/.git' ).
|
||||
doskip( D):- sub_atom( D, _, _, _, '/.#' ).
|
||||
doskip( D):- sub_atom( D, _, _, 0, '#' ).
|
||||
doskip( D):- user_skip( D ).
|
||||
|
||||
user_skip( 'packages/gecode/3.6.0').
|
||||
user_skip( 'packages/gecode/3.7.0').
|
||||
user_skip( 'packages/gecode/3.7.1').
|
||||
user_skip( 'packages/gecode/3.7.2').
|
||||
user_skip( 'packages/gecode/3.7.3').
|
||||
user_skip( 'packages/gecode/4.0.0').
|
||||
user_skip( 'packages/gecode/4.2.0').
|
||||
user_skip( 'packages/gecode/4.2.1').
|
||||
user_skip( 'packages/gecode/gecode3.yap' ).
|
||||
user_skip( 'packages/gecode/gecode3_yap.cc' ).
|
||||
user_skip( 'packages/gecode/gecode3_yap_hand_written.yap').
|
||||
user_skip( 'packages/gecode/gecode3.yap-common.icc').
|
||||
user_skip( 'packages/prism/src/prolog/core').
|
||||
user_skip( 'packages/prism/src/prolog/up').
|
||||
user_skip( 'packages/prism/src/prolog/mp').
|
||||
user_skip( 'packages/prism/src/prolog/trans').
|
||||
user_skip( 'packages/prism/src/prolog/bp').
|
||||
user_skip( 'packages/prism/src/c').
|
||||
|
||||
user_expand( library(clpfd), 'library/clp/clpfd.pl' ).
|
Reference in New Issue
Block a user