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

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:
Vítor Santos Costa 2016-01-04 14:11:09 +00:00
parent c0f00e7a0f
commit 50c8724322
51 changed files with 1576 additions and 948 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitignore vendored
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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;
}

8
C/stdpreds.c
View File

@ -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);
}

2
CMakeLists.txt
View File

@ -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)

14
H/YapHandles.h
View File

@ -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)

5
cmake/FindMySQL.cmake
View File

@ -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
View 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 )

3
include/YapErrors.h
View File

@ -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
library/lammpi/CMakeLists.txt
View File

@ -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)

2
library/random.yap
View File

@ -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)).

19
library/system.yap
View File

@ -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), !,

7
os/edio.yap
View 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
View File

@ -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
View File

@ -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;
}

3
os/iopreds.h
View File

@ -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
View File

@ -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;
}

6
os/readutil.c
View File

@ -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
View File

@ -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);
}

6
packages/ProbLog/problog_examples/queries/input.txt
View File

@ -1,6 +0,0 @@
@x0
0.286554426939
@x1
0.517024484197
@x2
0.425979613559

4
packages/ProbLog/problog_learning.yap
View File

@ -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,

6
packages/ProbLog/problog_lfi.yap
View File

@ -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, '"',

2
packages/bdd/simplecudd/CMakeLists.txt
View File

@ -10,7 +10,7 @@ add_executable (Problogbdd
${SRC})
set_target_properties (Problogbdd PROPERTIES
OUTPUT_NAME problogbdd
OUTPUT_NAME simplecudd
)
target_link_libraries(Problogbdd

9
packages/myddas/myddas_util.c
View File

@ -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"

2
packages/myddas/mysql/CMakeLists.txt
View File

@ -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 "

2
packages/myddas/mysql/myddas_mysql.c
View File

@ -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"

2
packages/myddas/mysql/myddas_util.c
View File

@ -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

23
packages/myddas/postgres/CMakeLists.txt
View File

@ -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
View File

@ -0,0 +1,6 @@
#ifndef MYDDAS_WKB2PROLOG_H_
# define MYDDAS_WKB2PROLOG_H_
Term wkb2prolog(char *wkb) ;
#endif /* !MYDDAS_WKB2PROLOG_H_ */

700
packages/myddas/sqlite.c
View File

@ -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 */

2
packages/myddas/sqlite3/CMakeLists.txt
View File

@ -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 "

8
pl/consult.yap
View File

@ -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))
), !,

2
pl/control.yap
View File

@ -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
View File

@ -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).

9
pl/error.yap
View File

@ -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).

4
pl/grammar.yap
View File

@ -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),

2
pl/messages.yap
View File

@ -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].

8
pl/meta.yap
View File

@ -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) :-
(

2
pl/newmod.yap
View File

@ -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).

12
pl/preddyns.yap
View File

@ -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
View File

@ -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

59
pl/protect.yap
View File

@ -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').

4
pl/qly.yap
View File

@ -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) :-

6
pl/undefined.yap
View File

@ -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)
).

9
pl/yio.yap
View File

@ -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
View 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
View 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
View 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
View 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' ).