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

Merge ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-08-07 09:58:22 +01:00
commit f6596da27d
14 changed files with 360 additions and 364 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/init.c
View File

@ -984,6 +984,7 @@ void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
static void InitStdPreds(struct yap_boot_params *yapi) static void InitStdPreds(struct yap_boot_params *yapi)
{ {
CurrentModule = PROLOG_MODULE;
Yap_InitCPreds(); Yap_InitCPreds();
Yap_InitBackCPreds(); Yap_InitBackCPreds();
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();

6
mkdocs/mkdocs.yml
View File

@ -1,7 +1,11 @@
site_name: 'YAP' site_name: 'YAP'
theme: 'readthedocs' theme: 'readthedocs'
markdown_extensions: markdown_extensions:
use_directory_urls: false - smarty
- toc:
permalink: True
- sane_lists
use_directory_urls: false
plugins: plugins:
- search - search
- awesome-pages: - awesome-pages:

6
os/streams.c
View File

@ -1551,11 +1551,7 @@ FILE *Yap_FileDescriptorFromStream(Term t) {
return rc; return rc;
} }
void void Yap_InitBackIO(void)
Yap_InitBackIO (
void)
{ {
Yap_InitCPredBack("stream_property", 2, 2, stream_property, Yap_InitCPredBack("stream_property", 2, 2, stream_property,
cont_stream_property, SafePredFlag | SyncPredFlag); cont_stream_property, SafePredFlag | SyncPredFlag);

43
packages/myddas/myddas_shared.c
View File

@ -680,28 +680,13 @@ void Yap_MYDDAS_delete_all_myddas_structs(void) {
void init_myddas(void) { void init_myddas(void) {
CACHE_REGS CACHE_REGS
if (myddas_initialised)
{
return;
}
#if USE_MYDDAS
Term cm=CurrentModule; Term cm=CurrentModule;
CurrentModule = USER_MODULE; CurrentModule = USER_MODULE;
if (myddas_initialised)
return;
#ifdef __ANDROID__
init_sqlite3();
#endif
#if defined MYDDAS_ODBC
Yap_InitBackMYDDAS_ODBCPreds();
#endif
#endif
#if defined MYDDAS_ODBC
Yap_InitMYDDAS_ODBCPreds();
#endif
#if defined USE_MYDDAS
Yap_InitMYDDAS_SharedPreds();
#endif
#if defined MYDDAS_TOP_LEVEL && \
defined MYDDAS_MYSQL // && defined HAVE_LIBREADLINE
Yap_InitMYDDAS_TopLevelPreds();
#endif
#if USE_MYDDAS
#define stringify(X) _stringify(X) #define stringify(X) _stringify(X)
#define _stringify(X) #X #define _stringify(X) #X
Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL; Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL;
@ -709,12 +694,28 @@ void init_myddas(void) {
MkAtomTerm(Yap_LookupAtom(stringify(MYDDAS_VERSION)))); MkAtomTerm(Yap_LookupAtom(stringify(MYDDAS_VERSION))));
Yap_HaltRegisterHook((HaltHookFunc)Yap_MYDDAS_delete_all_myddas_structs, Yap_HaltRegisterHook((HaltHookFunc)Yap_MYDDAS_delete_all_myddas_structs,
NULL); NULL);
Yap_InitMYDDAS_SharedPreds();
Yap_InitBackMYDDAS_SharedPreds();
#undef stringify #undef stringify
#undef _stringify #undef _stringify
Yap_MYDDAS_delete_all_myddas_structs(); Yap_MYDDAS_delete_all_myddas_structs();
#if defined MYDDAS_ODBC
Yap_InitBackMYDDAS_ODBCPreds();
#endif
#endif
#if defined MYDDAS_ODBC
Yap_InitMYDDAS_ODBCPreds();
#endif
#if defined MYDDAS_TOP_LEVEL && \
defined MYDDAS_MYSQL // && defined HAVE_LIBREADLINE
Yap_InitMYDDAS_TopLevelPreds();
#endif #endif
c_db_initialize_myddas(PASS_REGS1); c_db_initialize_myddas(PASS_REGS1);
myddas_initialised = TRUE; #ifdef __ANDROiD__
init_sqlite3();
#endif
#endif
myddas_initialised = true;
CurrentModule = cm; CurrentModule = cm;
} }

127
packages/myddas/pl/myddas.ypp
View File

@ -22,6 +22,7 @@
#ifdef DEBUG #ifdef DEBUG
:- yap_flag(single_var_warnings,on). :- yap_flag(single_var_warnings,on).
:- yap_flag(write_strings,on).
#endif #endif
#define SWITCH(Contype, G) \ #define SWITCH(Contype, G) \
@ -181,7 +182,7 @@
member/2 member/2
]). ]).
:- set(verbose,silent). :- set_prolog_flag(verbose,silent).
@ -230,108 +231,108 @@ db_open(postgres,Connection,Host/Db/Port,User,Password) :-
integer(Port),!, integer(Port),!,
db_open(postgres,Connection,Host/Db/Port/_,User,Password). % Var to be NULL, the default socket db_open(postgres,Connection,Host/Db/Port/_,User,Password). % Var to be NULL, the default socket
db_open(postgres,Connection,Host/Db/Socket,User,Password) :- !, db_open(postgres,Connection,Host/Db/Socket,User,Password) :- !,
db_open(postgres,Connection,Host/Db/0/Socket,User,Password). % 0 is default port db_open(postgres,Connection,Host/Db/0/Socket,User,Password). % 0 is default port
db_open(postgres,Connection,Host/Db,User,Password) :- db_open(postgres,Connection,Host/Db,User,Password) :-
db_open(postgres,Connection,Host/Db/0/_,User,Password). % 0 is default port and Var to be NULL, the default socpket db_open(postgres,Connection,Host/Db/0/_,User,Password). % 0 is default port and Var to be NULL, the default socpket
#endif #endif
#ifdef MYDDAS_ODBC #ifdef MYDDAS_ODBC
db_open(odbc,Connection,ODBCEntry,User,Password) :- db_open(odbc,Connection,ODBCEntry,User,Password) :-
'$error_checks'(db_open(odbc,Connection,ODBCEntry,User,Password)), '$error_checks'(db_open(odbc,Connection,ODBCEntry,User,Password)),
c_odbc_connect(ODBCEntry,User,Password,Con), c_odbc_connect(ODBCEntry,User,Password,Con),
set_value(Connection,Con). set_value(Connection,Con).
#endif #endif
%% sqlite3 %% sqlite3
db_open(sqlite3,Connection,File,User,Password) :- db_open(sqlite3,Connection,File,User,Password) :-
'$error_checks'(db_open(sqlite3,Connection,File,User,Password)), '$error_checks'(db_open(sqlite3,Connection,File,User,Password)),
c_sqlite3_connect(File,User,Password,Con), c_sqlite3_connect(File,User,Password,Con),
set_value(Connection,Con). set_value(Connection,Con).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% db_close/1 %% db_close/1
%% db_close/0 %% db_close/0
% %
% close a connection _Con_: all its resources are returned, and all undefined % close a connection _Con_: all its resources are returned, and all undefined
% predicates are abolished. Default is to close `myddas`. % predicates are abolished. Default is to close `myddas`.
db_close:- db_close:-
db_close(myddas). db_close(myddas).
db_close(Protocol):- db_close(Protocol):-
'$error_checks'(db_close(Protocol)), '$error_checks'(db_close(Protocol)),
get_value(Protocol,Con), get_value(Protocol,Con),
c_db_connection_type(Con,ConType), c_db_connection_type(Con,ConType),
( '$abolish_all'(Con) ; ( '$abolish_all'(Con) ;
set_value(Protocol,[]), % "deletes" atom set_value(Protocol,[]), % "deletes" atom
C_SWITCH( ConType, disconnect(Con) ) C_SWITCH( ConType, disconnect(Con) )
). ).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% db_verbose/1 % db_verbose/1
% %
% %
db_verbose(X):- db_verbose(X):-
var(X),!, var(X),!,
get_value(db_verbose,X). get_value(db_verbose,X).
db_verbose(N):-!, db_verbose(N):-!,
set_value(db_verbose,N). set_value(db_verbose,N).
%default value %default value
:- set_value(db_verbose,0). :- set_value(db_verbose,0).
:- set_value(db_verbose_filename,myddas_queries). :- set_value(db_verbose_filename,myddas_queries).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% db_module/1 % db_module/1
% %
% %
db_module(X):- db_module(X):-
var(X),!, var(X),!,
get_value(db_module,X). get_value(db_module,X).
db_module(ModuleName):- db_module(ModuleName):-
set_value(db_module,ModuleName). set_value(db_module,ModuleName).
% default value % default value
:- db_module(user). :- db_module(user).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% db_is_database_predicate(+,+,+) % db_is_database_predicate(+,+,+)
% %
% %
db_is_database_predicate(Module,PredName,Arity):- db_is_database_predicate(Module,PredName,Arity):-
'$error_checks'(db_is_database_predicate(PredName,Arity,Module)), '$error_checks'(db_is_database_predicate(PredName,Arity,Module)),
c_db_check_if_exists_pred(PredName,Arity,Module). c_db_check_if_exists_pred(PredName,Arity,Module).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#ifdef MYDDAS_STATS #ifdef MYDDAS_STATS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% db_stats(+,-) % db_stats(+,-)
% %
% %
db_stats(List):- db_stats(List):-
db_stats(myddas,List). db_stats(myddas,List).
db_stats(Protocol,List):- db_stats(Protocol,List):-
'$error_checks'(db_stats(Protocol,List)), '$error_checks'(db_stats(Protocol,List)),
NumberOfStats = 10, NumberOfStats = 10,
'$make_a_list'(NumberOfStats,ListX1), '$make_a_list'(NumberOfStats,ListX1),
( var(Protocol) -> ( var(Protocol) ->
c_db_stats(0,ListX1) c_db_stats(0,ListX1)
; ;
get_value(Protocol,Conn), get_value(Protocol,Conn),
c_db_stats(Conn,ListX1) c_db_stats(Conn,ListX1)
), ),
'$make_stats_list'(ListX1,List). '$make_stats_list'(ListX1,List).
#ifdef DEBUG #ifdef DEBUG
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% db_stats_time(+,-) % db_stats_time(+,-)
% Reference is C pointer (memory reference) % Reference is C puuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;uuuuu;ointer (memory reference)
% %
db_stats_time(Reference,Time):- db_stats_time(Reference,Time):-
'$error_checks'(db_stats_time(Reference,Time)), '$error_checks'(db_stats_time(Reference,Time)),
@ -449,7 +450,6 @@ db_assert(Connection,PredName):-
'$error_checks'(db_insert2(Connection,PredName,Code)), '$error_checks'(db_insert2(Connection,PredName,Code)),
'$get_values_for_insert'(Code,ValuesList,RelName), '$get_values_for_insert'(Code,ValuesList,RelName),
'$make_atom'(['INSERT INTO `',RelName,'` VALUES '|ValuesList],SQL), '$make_atom'(['INSERT INTO `',RelName,'` VALUES '|ValuesList],SQL),
get_value(Connection,Con), get_value(Connection,Con),
c_db_connection_type(Con,ConType), c_db_connection_type(Con,ConType),
'$write_or_not'(SQL), '$write_or_not'(SQL),
@ -685,17 +685,18 @@ db_describe(Connection,Y,Z) :-
db_datalog_show_tables :- db_datalog_show_tables :-
db_datalog_show_tables(myddas). db_datalog_show_tables(myddas).
db_show_tables :-
'$error_checks'(db_datalog_show_tables),
get_value(myddas,Con),
c_db_connection_type(Con,DBMS),
DBMS:datalog_show_tables.
db_datalog_show_tables(Connection) :- db_datalog_show_tables(Connection) :-
'$error_checks'(db_datalog_show_tables(Connection) ), '$error_checks'(db_datalog_show_tables(Connection) ),
get_value(Connection,Con), get_value(Connection,Con),
c_db_connection_type(Con,DBMS), c_db_connection_type(Con,DBMS),
switch( DBMS, datalog_show_tables(Connection) ). switch( DBMS, datalog_show_tables(Connection) ).
db_datalog_show_tables :-
'$error_checks'(db_datalog_show_tables),
get_value(myddas,Con),
c_db_connection_type(Con,DBMS),
DBMS:datalog_show_tables.
/** /**
@pred db_show_tables(+,?). @pred db_show_tables(+,?).

11
packages/myddas/pl/myddas_assert_predicates.ypp
View File

@ -230,7 +230,7 @@ db_abolish(PredName,Arity):-
% %
db_listing:- db_listing:-
c_db_connection(Con), c_db_connection(Con),
c_db_preds_conn(Con,Module,Name,Arity), user:c_db_preds_conn(Con,Module,Name,Arity),
listing(Module:Name/Arity), listing(Module:Name/Arity),
fail. fail.
db_listing. db_listing.
@ -243,15 +243,15 @@ db_listing.
% %
db_listing(Module:Name/Arity):-!, db_listing(Module:Name/Arity):-!,
c_db_connection(Con), c_db_connection(Con),
c_db_preds_conn(Con,Module,Name,Arity), user:c_db_preds_conn(Con,Module,Name,Arity),
listing(Module:Name/Arity). listing(Module:Name/Arity).
db_listing(Name/Arity):-!, db_listing(Name/Arity):-!,
c_db_connection(Con), c_db_connection(Con),
c_db_preds_conn(Con,Module,Name,Arity), user:c_db_preds_conn(Con,Module,Name,Arity),
listing(Module:Name/Arity). listing(Module:Name/Arity).
db_listing(Name):- db_listing(Name):-
c_db_connection(Con), c_db_connection(Con),
c_db_preds_conn(Con,Module,Name,Arity), user:c_db_preds_conn(Con,Module,Name,Arity),
listing(Module:Name/Arity). listing(Module:Name/Arity).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@ -260,13 +260,12 @@ db_listing(Name):-
% %
table_arity( Con, ConType, RelationName, Arity ) :- table_arity( Con, ConType, RelationName, Arity ) :-
c_db_connection_type(Con,ConType), c_db_connection_type(Con,ConType),
writeln( ConType ),
% get relation arity % get relation arity
( ConType == mysql -> ( ConType == mysql ->
c_db_my_number_of_fields(RelationName,Con,Arity) c_db_my_number_of_fields(RelationName,Con,Arity)
; ;
ConType == postgres -> ConType == postgres ->
c_postgres_number_of_fields(RelationName,Con,Arity) c_postgres_number_of_fields(RelationName,Con,Arit)
; ;
ConType == odbc -> ConType == odbc ->
c_odbc_number_of_fields(RelationName,Con,Arity) c_odbc_number_of_fields(RelationName,Con,Arity)

3
packages/myddas/pl/myddas_driver.ypp
View File

@ -28,7 +28,7 @@
#define NAME() 'YAPodbc' #define NAME() 'YAPodbc'
#define MODULE() user #define MODULE() user
#define INIT() init_odbc #define INIT() init_odbc
#elif defined( postgres ) #elif defined( postrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrs )
#undef postgres #undef postgres
#define DBMS(x) postgres_##x #define DBMS(x) postgres_##x
#define c_DBMS(x) c_postgres_##x #define c_DBMS(x) c_postgres_##x
@ -101,7 +101,6 @@ DBMS(result_set)(store_result):-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% DBMS(db_datalog_describe)/2 % DBMS(db_datalog_describe)/2
% %

3
packages/myddas/sqlite3/sqlitest.yap
View File

@ -14,6 +14,9 @@ main_ :-
main_ . main_ .
:- if yap_flag(android,true). :- if yap_flag(android,true).
init :-
catch(db_open(sqlite3,'chinook.db',_,_), _, fail),
!.
init :- init :-
db_open(sqlite3, '/data/user/0/pt.up.yap.yapdroid/files/Yap/chinook.db', _, _), db_open(sqlite3, '/data/user/0/pt.up.yap.yapdroid/files/Yap/chinook.db', _, _),
% db_open(sqlite3, 'chinook.db', _, _), % db_open(sqlite3, 'chinook.db', _, _),

2
packages/python/py4yap.h
View File

@ -8,6 +8,8 @@
#define PASS_REGS #define PASS_REGS
#define USES_REGS #define USES_REGS
#include "Yap.h"
//@{ //@{
/** @brief Prolog to Python library /** @brief Prolog to Python library

2
packages/python/pypreds.c
View File

@ -591,7 +591,7 @@ static int python_import(term_t mname, term_t mod) {
const char *sn, *as = NULL; const char *sn, *as = NULL;
Term t = Deref(ARG1), sm; Term t = Deref(ARG1), sm;
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = (Functor)*RepAppl(t);
if (f != FunctorAs) if (f != FunctorAs)
return false; return false;
do_as = true; do_as = true;

7
packages/python/swig/CMakeLists.txt
View File

@ -54,8 +54,7 @@ endif()
COMMAND ${SWIG_EXECUTABLE} -c++ -python -O -py3 -module "yap" -addextern -I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/H/generated -I${CMAKE_SOURCE_DIR}/include COMMAND ${SWIG_EXECUTABLE} -c++ -python -O -py3 -module "yap" -addextern -I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/H/generated -I${CMAKE_SOURCE_DIR}/include
-I${CMAKE_SOURCE_DIR}/OPTYap -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/utf8proc -I.././.. -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/packages/python -I${CMAKE_SOURCE_DIR}/OPTYap -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/utf8proc -I.././.. -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/packages/python
-outdir ${CMAKE_CURRENT_BINARY_DIR}/yap4py -I${GMP_INCLUDE_DIRS} -DX_API="" -o ${CMAKE_CURRENT_BINARY_DIR}/yap4py/yap_wrap.cxx -oh ${CMAKE_CURRENT_BINARY_DIR}/yap4py/yap_wrap.hh ${SWIG_SOURCES} -outdir ${CMAKE_CURRENT_BINARY_DIR}/yap4py -I${GMP_INCLUDE_DIRS} -DX_API="" -o ${CMAKE_CURRENT_BINARY_DIR}/yap4py/yap_wrap.cxx -oh ${CMAKE_CURRENT_BINARY_DIR}/yap4py/yap_wrap.hh ${SWIG_SOURCES}
COMMAND ${PYTHON_EXECUTABLE} setup.py sdist ${bdist} WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
DEPENDS ${SWIG_SOURCES} Py4YAP YAP++ yap4py/yapi.cpp YAP4PY_PY DEPENDS ${SWIG_SOURCES} Py4YAP YAP++ yap4py/yapi.cpp YAP4PY_PY
) )
@ -70,7 +69,9 @@ endif()
DEPENDS ${PYTHON_SOURCES} DEPENDS ${PYTHON_SOURCES}
) )
install(CODE "execute_process(COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed . install(CODE "execute_process(
COMMAND ${PYTHON_EXECUTABLE} setup.py sdist ${bdist}
COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed .
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})" WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR})"
DEPENDS Py4YAP ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ${YAP_INSTALL_DLLDIR} ) DEPENDS Py4YAP ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ${YAP_INSTALL_DLLDIR} )

6
packages/python/swig/setup.py.in
View File

@ -84,8 +84,8 @@ native_sources = ["yap4py/yap_wrap.cxx","yap4py/yapi.cpp"]
extensions = [Extension('_yap', native_sources, extensions = [Extension('_yap', native_sources,
define_macros=[('MAJOR_VERSION', '1'), define_macros=[('MAJOR_VERSION', '@YAP_MAJOR_VERSION@'),
('MINOR_VERSION', '0'), ('MINOR_VERSION', '@YAP_MINOR_VERSION@'),
('_YAP_NOT_INSTALLED_', '1'), ('_YAP_NOT_INSTALLED_', '1'),
('YAP_PYTHON', '1'), ('YAP_PYTHON', '1'),
('PYTHONSWIG', '1'), ('PYTHONSWIG', '1'),
@ -104,7 +104,7 @@ extensions = [Extension('_yap', native_sources,
'${CMAKE_SOURCE_DIR}/os', '${CMAKE_SOURCE_DIR}/os',
'${CMAKE_SOURCE_DIR}/utf8proc', '${CMAKE_SOURCE_DIR}/utf8proc',
'${CMAKE_SOURCE_DIR}/packages/python', '${CMAKE_SOURCE_DIR}/packages/python',
'../../..', '${CMAKE_BINARY_DIR}',
'${CMAKE_SOURCE_DIR}/CXX' ] '${CMAKE_SOURCE_DIR}/CXX' ]
)] )]

16
packages/python/yap_kernel/CMakeLists.txt
View File

@ -185,7 +185,6 @@ yap_ipython/sphinxext/ipython_console_highlighting.py
yap_ipython/sphinxext/ipython_directive.py yap_ipython/sphinxext/ipython_directive.py
yap_ipython/nbformat.py yap_ipython/nbformat.py
yap_ipython/paths.py yap_ipython/paths.py
yap_ipython/_version.py
yap_ipython/nbconvert.py yap_ipython/nbconvert.py
yap_ipython/qt.py yap_ipython/qt.py
yap_ipython/html.py yap_ipython/html.py
@ -413,23 +412,12 @@ add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kerne
DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/kernel.js DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/kernel.js
) )
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js
COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/meta.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/
DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/meta.js
)
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js
COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/yap.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/yap.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js
DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/yap.js DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/yap.js
) )
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/mode.js
COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/mode.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/
DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/mode.js
)
foreach(f ${FILES}) foreach(f ${FILES})
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${f} add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${f}
COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/${f} ${CMAKE_CURRENT_BINARY_DIR}/${f} COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/${f} ${CMAKE_CURRENT_BINARY_DIR}/${f}
@ -441,13 +429,13 @@ endforeach()
add_custom_target(YAP_KERNEL ALL add_custom_target(YAP_KERNEL ALL
COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/mode.js ${OUTS} YAP4PY DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${OUTS} YAP4PY
) )
install(CODE "execute_process( install(CODE "execute_process(
COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps . COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps .
COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec
ERROR_VARIABLE setupErr ERROR_VARIABLE setupErr

491
pl/preds.yap
View File

@ -112,7 +112,7 @@ undefined results.
*/ */
assert_static(C) :- assert_static(C) :-
'$assert'(C , assertz_static, _ ). '$assert'(C , assertz_static, _ ).
/** @pred asserta_static(: _C_) /** @pred asserta_static(: _C_)
@ -122,7 +122,7 @@ Adds clause _C_ as the first clause for a static procedure.
*/ */
asserta_static(C) :- asserta_static(C) :-
'$assert'(C , asserta_static, _ ). '$assert'(C , asserta_static, _ ).
/** @pred assertz_static(: _C_) /** @pred assertz_static(: _C_)
@ -142,7 +142,7 @@ static predicates, if source mode was on when they were compiled:
*/ */
assertz_static(C) :- assertz_static(C) :-
'$assert'(C , assertz_static, _ ). '$assert'(C , assertz_static, _ ).
/** @pred clause(+ _H_, _B_) is iso /** @pred clause(+ _H_, _B_) is iso
@ -158,9 +158,9 @@ This predicate is applicable to static procedures compiled with
*/ */
clause(V0,Q) :- clause(V0,Q) :-
'$yap_strip_module'(V0, M, V), '$yap_strip_module'(V0, M, V),
must_be_of_type( callable, V ), must_be_of_type( callable, V ),
'$clause'(V,M,Q,_). '$clause'(V,M,Q,_).
/** @pred clause(+ _H_, _B_,- _R_) /** @pred clause(+ _H_, _B_,- _R_)
@ -170,9 +170,9 @@ to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures. erase/1 on the reference on static procedures.
*/ */
clause(P,Q,R) :- clause(P,Q,R) :-
'$instance_module'(R,M0), !, '$instance_module'(R,M0), !,
instance(R,T0), instance(R,T0),
( T0 = (H :- B) -> Q = B ; H=T0, Q = true), ( T0 = (H :- B) -> Q = B ; H=T0, Q = true),
'$yap_strip_module'(P, M, T), '$yap_strip_module'(P, M, T),
'$yap_strip_module'(M0:H, M1, H1), '$yap_strip_module'(M0:H, M1, H1),
( (
@ -183,44 +183,44 @@ clause(P,Q,R) :-
M1:H1 = T M1:H1 = T
). ).
clause(V0,Q,R) :- clause(V0,Q,R) :-
'$yap_strip_module'(V0, M, V), '$yap_strip_module'(V0, M, V),
must_be_of_type( callable, V ), must_be_of_type( callable, V ),
'$clause'(V,M,Q,R). '$clause'(V,M,Q,R).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
'$is_exo'(P, M), !, '$is_exo'(P, M), !,
Q = true, Q = true,
R = '$exo_clause'(M,P), R = '$exo_clause'(M,P),
'$execute0'(P, M). '$execute0'(P, M).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
'$is_log_updatable'(P, M), !, '$is_log_updatable'(P, M), !,
'$log_update_clause'(P,M,Q,R). '$log_update_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
'$is_source'(P, M), !, '$is_source'(P, M), !,
'$static_clause'(P,M,Q,R). '$static_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
'$some_recordedp'(M:P), !, '$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),R). '$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
\+ '$undefined'(P,M), \+ '$undefined'(P,M),
( '$is_system_predicate'(P,M) -> true ; ( '$is_system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ), '$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity), functor(P,Name,Arity),
'$do_error'(permission_error(access,private_procedure,Name/Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q,R)). clause(M:P,Q,R)).
'$init_preds' :- '$init_preds' :-
once('$do_static_clause'(_,_,_,_,_)), once('$do_static_clause'(_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause0'(_,_,_,_,_,_)), once('$do_log_upd_clause0'(_,_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause'(_,_,_,_,_,_)), once('$do_log_upd_clause'(_,_,_,_,_,_)),
fail. fail.
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause_erase'(_,_,_,_,_,_)), once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
fail. fail.
'$init_preds'. '$init_preds'.
@ -237,16 +237,16 @@ and _I_ is bound to its position.
*/ */
nth_clause(V,I,R) :- nth_clause(V,I,R) :-
strip_module(V, M1, P), !, strip_module(V, M1, P), !,
'$nth_clause'(P, M1, I, R). '$nth_clause'(P, M1, I, R).
'$nth_clause'(P,M,I,R) :- '$nth_clause'(P,M,I,R) :-
var(I), var(R), !, var(I), var(R), !,
'$clause'(P,M,_,R), '$clause'(P,M,_,R),
'$fetch_nth_clause'(P,M,I,R). '$fetch_nth_clause'(P,M,I,R).
'$nth_clause'(P,M,I,R) :- '$nth_clause'(P,M,I,R) :-
'$fetch_nth_clause'(P,M,I,R). '$fetch_nth_clause'(P,M,I,R).
/** @pred abolish(+ _P_,+ _N_) /** @pred abolish(+ _P_,+ _N_)
@ -256,19 +256,19 @@ including whether it is dynamic or static, multifile, or
meta-predicate, will be lost. meta-predicate, will be lost.
*/ */
abolish(N0,A) :- abolish(N0,A) :-
strip_module(N0, Mod, N), !, strip_module(N0, Mod, N), !,
'$abolish'(N,A,Mod). '$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !, '$abolish'(N,A,M) :- var(N), !,
'$do_error'(instantiation_error,abolish(M:N,A)). '$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- var(A), !, '$abolish'(N,A,M) :- var(A), !,
'$do_error'(instantiation_error,abolish(M:N,A)). '$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- '$abolish'(N,A,M) :-
( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ), ( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
fail. fail.
'$abolish'(N,A,M) :- functor(T,N,A), '$abolish'(N,A,M) :- functor(T,N,A),
( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ; ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
/* else */ '$abolishs'(T,M) ). /* else */ '$abolishs'(T,M) ).
/** @pred abolish(+ _PredSpec_) is iso /** @pred abolish(+ _PredSpec_) is iso
@ -283,141 +283,141 @@ dynamic procedures. Under other modes it will abolish any procedures.
*/ */
abolish(X0) :- abolish(X0) :-
strip_module(X0,M,X), strip_module(X0,M,X),
'$abolish'(X,M). '$abolish'(X,M).
'$abolish'(X,M) :- '$abolish'(X,M) :-
current_prolog_flag(language, sicstus), !, current_prolog_flag(language, sicstus), !,
'$new_abolish'(X,M). '$new_abolish'(X,M).
'$abolish'(X, M) :- '$abolish'(X, M) :-
'$old_abolish'(X,M). '$old_abolish'(X,M).
'$new_abolish'(V,M) :- var(V), !, '$new_abolish'(V,M) :- var(V), !,
'$abolish_all'(M). '$abolish_all_in_module'(M).
'$new_abolish'(A/V,M) :- atom(A), var(V), !, '$new_abolish'(A/V,M) :- atom(A), var(V), !,
'$abolish_all_atoms'(A,M). '$abolish_all_atoms'(A,M).
'$new_abolish'(Na//Ar1, M) :- '$new_abolish'(Na//Ar1, M) :-
integer(Ar1), integer(Ar1),
!, !,
Ar is Ar1+2, Ar is Ar1+2,
'$new_abolish'(Na//Ar, M). '$new_abolish'(Na//Ar, M).
'$new_abolish'(Na/Ar, M) :- '$new_abolish'(Na/Ar, M) :-
functor(H, Na, Ar), functor(H, Na, Ar),
'$is_dynamic'(H, M), !, '$is_dynamic'(H, M), !,
'$abolishd'(H, M). '$abolishd'(H, M).
'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures. '$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures.
functor(T, Na, Ar), functor(T, Na, Ar),
'$undefined'(T, M), !. '$undefined'(T, M), !.
'$new_abolish'(Na/Ar, M) :- '$new_abolish'(Na/Ar, M) :-
'$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)). '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)).
'$new_abolish'(T, M) :- '$new_abolish'(T, M) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all'(M) :- '$abolish_all_in_module'(M) :-
'$current_predicate'(Na, M, S, _), '$current_predicate'(Na, M, S, _),
functor(S, Na, Ar), functor(S, Na, Ar),
'$new_abolish'(Na/Ar, M), '$new_abolish'(Na/Ar, M),
fail. fail.
'$abolish_all'(_). '$abolish_all_in_module'(_).
'$abolish_all_atoms'(Na, M) :- '$abolish_all_atoms'(Na, M) :-
'$current_predicate'(Na,M,S,_), '$current_predicate'(Na,M,S,_),
functor(S, Na, Ar), functor(S, Na, Ar),
'$new_abolish'(Na/Ar, M), '$new_abolish'(Na/Ar, M),
fail. fail.
'$abolish_all_atoms'(_,_). '$abolish_all_atoms'(_,_).
'$check_error_in_predicate_indicator'(V, Msg) :- '$check_error_in_predicate_indicator'(V, Msg) :-
var(V), !, var(V), !,
'$do_error'(instantiation_error, Msg). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(M:S, Msg) :- !, '$check_error_in_predicate_indicator'(M:S, Msg) :- !,
'$check_error_in_module'(M, Msg), '$check_error_in_module'(M, Msg),
'$check_error_in_predicate_indicator'(S, Msg). '$check_error_in_predicate_indicator'(S, Msg).
'$check_error_in_predicate_indicator'(S, Msg) :- '$check_error_in_predicate_indicator'(S, Msg) :-
S \= _/_, S \= _/_,
S \= _//_, !, S \= _//_, !,
'$do_error'(type_error(predicate_indicator,S), Msg). '$do_error'(type_error(predicate_indicator,S), Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :- '$check_error_in_predicate_indicator'(Na/_, Msg) :-
var(Na), !, var(Na), !,
'$do_error'(instantiation_error, Msg). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :- '$check_error_in_predicate_indicator'(Na/_, Msg) :-
\+ atom(Na), !, \+ atom(Na), !,
'$do_error'(type_error(atom,Na), Msg). '$do_error'(type_error(atom,Na), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
var(Ar), !, var(Ar), !,
'$do_error'(instantiation_error, Msg). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
\+ integer(Ar), !, \+ integer(Ar), !,
'$do_error'(type_error(integer,Ar), Msg). '$do_error'(type_error(integer,Ar), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
Ar < 0, !, Ar < 0, !,
'$do_error'(domain_error(not_less_than_zero,Ar), Msg). '$do_error'(domain_error(not_less_than_zero,Ar), Msg).
% not yet implemented! % not yet implemented!
%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :- %'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
% Ar < maxarity, !, % Ar < maxarity, !,
% '$do_error'(type_error(representation_error(max_arity),Ar), Msg). % '$do_error'(type_error(representation_error(max_arity),Ar), Msg).
'$check_error_in_module'(M, Msg) :- '$check_error_in_module'(M, Msg) :-
var(M), !, var(M), !,
'$do_error'(instantiation_error, Msg). '$do_error'(instantiation_error, Msg).
'$check_error_in_module'(M, Msg) :- '$check_error_in_module'(M, Msg) :-
\+ atom(M), !, \+ atom(M), !,
'$do_error'(type_error(atom,M), Msg). '$do_error'(type_error(atom,M), Msg).
'$old_abolish'(V,M) :- var(V), !, '$old_abolish'(V,M) :- var(V), !,
( true -> % current_prolog_flag(language, sicstus) -> ( true -> % current_prolog_flag(language, sicstus) ->
'$do_error'(instantiation_error,abolish(M:V)) '$do_error'(instantiation_error,abolish(M:V))
; ;
'$abolish_all_old'(M) '$abolish_all_old'(M)
). ).
'$old_abolish'(N/A, M) :- !, '$old_abolish'(N/A, M) :- !,
'$abolish'(N, A, M). '$abolish'(N, A, M).
'$old_abolish'(A,M) :- atom(A), !, '$old_abolish'(A,M) :- atom(A), !,
( current_prolog_flag(language, iso) -> ( current_prolog_flag(language, iso) ->
'$do_error'(type_error(predicate_indicator,A),abolish(M:A)) '$do_error'(type_error(predicate_indicator,A),abolish(M:A))
; ;
'$abolish_all_atoms_old'(A,M) '$abolish_all_atoms_old'(A,M)
). ).
'$old_abolish'([], _) :- !. '$old_abolish'([], _) :- !.
'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M). '$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M).
'$old_abolish'(T, M) :- '$old_abolish'(T, M) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all_old'(M) :- '$abolish_all_old'(M) :-
'$current_predicate'(Na, M, S, _), '$current_predicate'(Na, M, S, _),
functor( S, Na, Ar ), functor( S, Na, Ar ),
'$abolish'(Na, Ar, M), '$abolish'(Na, Ar, M),
fail. fail.
'$abolish_all_old'(_). '$abolish_all_old'(_).
'$abolish_all_atoms_old'(Na, M) :- '$abolish_all_atoms_old'(Na, M) :-
'$current_predicate'(Na, M, S, _), '$current_predicate'(Na, M, S, _),
functor(S, Na, Ar), functor(S, Na, Ar),
'$abolish'(Na, Ar, M), '$abolish'(Na, Ar, M),
fail. fail.
'$abolish_all_atoms_old'(_,_). '$abolish_all_atoms_old'(_,_).
'$abolishs'(G, M) :- '$system_predicate'(G,M), !, '$abolishs'(G, M) :- '$system_predicate'(G,M), !,
functor(G,Name,Arity), functor(G,Name,Arity),
'$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
'$abolishs'(G, Module) :- '$abolishs'(G, Module) :-
current_prolog_flag(language, sicstus), % only do this in sicstus mode current_prolog_flag(language, sicstus), % only do this in sicstus mode
'$undefined'(G, Module), '$undefined'(G, Module),
functor(G,Name,Arity), functor(G,Name,Arity),
print_message(warning,no_match(abolish(Module:Name/Arity))). print_message(warning,no_match(abolish(Module:Name/Arity))).
'$abolishs'(G, M) :- '$abolishs'(G, M) :-
'$is_multifile'(G,M), '$is_multifile'(G,M),
functor(G,Name,Arity), functor(G,Name,Arity),
recorded('$mf','$mf_clause'(_,Name,Arity,M,_Ref),R), recorded('$mf','$mf_clause'(_,Name,Arity,M,_Ref),R),
erase(R), erase(R),
% no need erase(Ref), % no need erase(Ref),
fail. fail.
'$abolishs'(T, M) :- '$abolishs'(T, M) :-
recorded('$import','$import'(_,M,_,_,T,_,_),R), recorded('$import','$import'(_,M,_,_,T,_,_),R),
erase(R), erase(R),
fail. fail.
'$abolishs'(G, M) :- '$abolishs'(G, M) :-
'$purge_clauses'(G, M), fail. '$purge_clauses'(G, M), fail.
'$abolishs'(_, _). '$abolishs'(_, _).
/** @pred stash_predicate(+ _Pred_) /** @pred stash_predicate(+ _Pred_)
@ -426,16 +426,16 @@ Make predicate _Pred_ invisible to new code, and to `current_predicate/2`,
functor can be declared. functor can be declared.
**/ **/
stash_predicate(P0) :- stash_predicate(P0) :-
strip_module(P0, M, P), strip_module(P0, M, P),
'$stash_predicate2'(P, M). '$stash_predicate2'(P, M).
'$stash_predicate2'(V, M) :- var(V), !, '$stash_predicate2'(V, M) :- var(V), !,
'$do_error'(instantiation_error,stash_predicate(M:V)). '$do_error'(instantiation_error,stash_predicate(M:V)).
'$stash_predicate2'(N/A, M) :- !, '$stash_predicate2'(N/A, M) :- !,
functor(S,N,A), functor(S,N,A),
'$stash_predicate'(S, M) . '$stash_predicate'(S, M) .
'$stash_predicate2'(PredDesc, M) :- '$stash_predicate2'(PredDesc, M) :-
'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)). '$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)).
/** @pred hide_predicate(+ _Pred_) /** @pred hide_predicate(+ _Pred_)
Make predicate _Pred_ invisible to `current_predicate/2`, Make predicate _Pred_ invisible to `current_predicate/2`,
@ -443,9 +443,9 @@ Make predicate _Pred_ invisible to `current_predicate/2`,
**/ **/
hide_predicate(P0) :- hide_predicate(P0) :-
'$yap_strip_module'(P0, M, P), '$yap_strip_module'(P0, M, P),
must_be_of_type(callable, M:P), must_be_of_type(callable, M:P),
'$hide_predicate'(P, M). '$hide_predicate'(P, M).
/** @pred predicate_property( _P_, _Prop_) is iso /** @pred predicate_property( _P_, _Prop_) is iso
@ -492,13 +492,13 @@ or built-in.
*/ */
predicate_property(Pred,Prop) :- predicate_property(Pred,Prop) :-
( (
current_predicate(_,Pred), current_predicate(_,Pred),
'$yap_strip_module'(Pred, Mod, TruePred) '$yap_strip_module'(Pred, Mod, TruePred)
; ;
'$current_predicate'(_,M,Pred,system), '$current_predicate'(_,M,Pred,system),
'$yap_strip_module'(M:Pred, Mod, TruePred) '$yap_strip_module'(M:Pred, Mod, TruePred)
), ),
( (
'$pred_exists'(TruePred, Mod) '$pred_exists'(TruePred, Mod)
-> ->
@ -506,41 +506,41 @@ predicate_property(Pred,Prop) :-
NPred = TruePred NPred = TruePred
; ;
'$get_undefined_pred'(TruePred, Mod, NPred, M) '$get_undefined_pred'(TruePred, Mod, NPred, M)
), ),
'$predicate_property'(NPred,M,Mod,Prop). '$predicate_property'(NPred,M,Mod,Prop).
'$predicate_property'(P,M,_,built_in) :- '$predicate_property'(P,M,_,built_in) :-
'$is_system_predicate'(P,M). '$is_system_predicate'(P,M).
'$predicate_property'(P,M,_,source) :- '$predicate_property'(P,M,_,source) :-
'$predicate_flags'(P,M,F,F), '$predicate_flags'(P,M,F,F),
F /\ 0x00400000 =\= 0. F /\ 0x00400000 =\= 0.
'$predicate_property'(P,M,_,tabled) :- '$predicate_property'(P,M,_,tabled) :-
'$predicate_flags'(P,M,F,F), '$predicate_flags'(P,M,F,F),
F /\ 0x00000040 =\= 0. F /\ 0x00000040 =\= 0.
'$predicate_property'(P,M,_,dynamic) :- '$predicate_property'(P,M,_,dynamic) :-
'$is_dynamic'(P,M). '$is_dynamic'(P,M).
'$predicate_property'(P,M,_,static) :- '$predicate_property'(P,M,_,static) :-
\+ '$is_dynamic'(P,M), \+ '$is_dynamic'(P,M),
\+ '$undefined'(P,M). \+ '$undefined'(P,M).
'$predicate_property'(P,M,_,meta_predicate(Q)) :- '$predicate_property'(P,M,_,meta_predicate(Q)) :-
functor(P,Na,Ar), functor(P,Na,Ar),
prolog:'$meta_predicate'(Na,M,Ar,Q). prolog:'$meta_predicate'(Na,M,Ar,Q).
'$predicate_property'(P,M,_,multifile) :- '$predicate_property'(P,M,_,multifile) :-
'$is_multifile'(P,M). '$is_multifile'(P,M).
'$predicate_property'(P,M,_,public) :- '$predicate_property'(P,M,_,public) :-
'$is_public'(P,M). '$is_public'(P,M).
'$predicate_property'(P,M,_,thread_local) :- '$predicate_property'(P,M,_,thread_local) :-
'$is_thread_local'(P,M). '$is_thread_local'(P,M).
'$predicate_property'(P,M,M,exported) :- '$predicate_property'(P,M,M,exported) :-
functor(P,N,A), functor(P,N,A),
once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)), once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)),
lists:memberchk(N/A,Publics). lists:memberchk(N/A,Publics).
'$predicate_property'(P,M,M0,imported_from(M0)) :- '$predicate_property'(P,M,M0,imported_from(M0)) :-
M \= M0. M \= M0.
'$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :- '$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :-
'$number_of_clauses'(P,Mod,NCl). '$number_of_clauses'(P,Mod,NCl).
'$predicate_property'(P,Mod,_,file(F)) :- '$predicate_property'(P,Mod,_,file(F)) :-
'$owner_file'(P,Mod,F). '$owner_file'(P,Mod,F).
/** /**
@ -552,22 +552,22 @@ Given predicate _P_, _NCls_ is the number of clauses for
indices to those clauses (in bytes). indices to those clauses (in bytes).
*/ */
predicate_statistics(V,NCls,Sz,ISz) :- var(V), !, predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)). '$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_statistics(P0,NCls,Sz,ISz) :- predicate_statistics(P0,NCls,Sz,ISz) :-
strip_module(P0, M, P), strip_module(P0, M, P),
'$predicate_statistics'(P,M,NCls,Sz,ISz). '$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !, '$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !,
'$predicate_statistics'(P,M,NCls,Sz,ISz). '$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(P,M,NCls,Sz,ISz) :- '$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$is_log_updatable'(P, M), !, '$is_log_updatable'(P, M), !,
'$lu_statistics'(P,NCls,Sz,ISz,M). '$lu_statistics'(P,NCls,Sz,ISz,M).
'$predicate_statistics'(P,M,_,_,_) :- '$predicate_statistics'(P,M,_,_,_) :-
'$is_system_predicate'(P,M), !, fail. '$is_system_predicate'(P,M), !, fail.
'$predicate_statistics'(P,M,_,_,_) :- '$predicate_statistics'(P,M,_,_,_) :-
'$undefined'(P,M), !, fail. '$undefined'(P,M), !, fail.
'$predicate_statistics'(P,M,NCls,Sz,ISz) :- '$predicate_statistics'(P,M,NCls,Sz,ISz) :-
'$static_pred_statistics'(P,M,NCls,Sz,ISz). '$static_pred_statistics'(P,M,NCls,Sz,ISz).
/** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_) /** @pred predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
@ -580,36 +580,36 @@ of space required to store indices to those clauses (in bytes).
*/ */
predicate_erased_statistics(P,NCls,Sz,ISz) :- predicate_erased_statistics(P,NCls,Sz,ISz) :-
var(P), !, var(P), !,
current_predicate(_,P), current_predicate(_,P),
predicate_erased_statistics(P,NCls,Sz,ISz). predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(P0,NCls,Sz,ISz) :- predicate_erased_statistics(P0,NCls,Sz,ISz) :-
strip_module(P0,M,P), strip_module(P0,M,P),
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz). '$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
/** @pred current_predicate( _A_, _P_) /** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/ */
current_predicate(A,T0) :- current_predicate(A,T0) :-
'$yap_strip_module'(T0, M, T), '$yap_strip_module'(T0, M, T),
( var(Mod) ( var(Mod)
-> ->
'$all_current_modules'(M) '$all_current_modules'(M)
; ;
true true
), ),
(nonvar(T) -> functor(T, A, _) ; true ), (nonvar(T) -> functor(T, A, _) ; true ),
( (
'$current_predicate'(A,M, T, user) '$current_predicate'(A,M, T, user)
; ;
(nonvar(T) (nonvar(T)
-> ->
'$imported_predicate'(T, M, T1, M1) '$imported_predicate'(T, M, T1, M1)
; ;
'$generate_imported_predicate'(T, M, T1, M1) '$generate_imported_predicate'(T, M, T1, M1)
), ),
functor(T1, A, _), functor(T1, A, _),
\+ '$is_system_predicate'(T1,M1) \+ '$is_system_predicate'(T1,M1)
). ).
/** @pred system_predicate( ?_P_ ) /** @pred system_predicate( ?_P_ )
@ -617,7 +617,7 @@ current_predicate(A,T0) :-
Defines the relation: indicator _P_ refers to a currently defined system predicate. Defines the relation: indicator _P_ refers to a currently defined system predicate.
*/ */
system_predicate(P0) :- system_predicate(P0) :-
'$yap_strip_module'(P0, M0, P), '$yap_strip_module'(P0, M0, P),
( M= M0 ; M0 \= user, M = user ; M0 \= prolog, M = prolog ), ( M= M0 ; M0 \= user, M = user ; M0 \= prolog, M = prolog ),
( (
var(P) var(P)
@ -668,7 +668,7 @@ system_predicate(P0) :-
*/ */
system_predicate(A, P0) :- system_predicate(A, P0) :-
'$yap_strip_module'(P0, M, P), '$yap_strip_module'(P0, M, P),
( (
nonvar(P) nonvar(P)
-> ->
@ -688,35 +688,35 @@ system_predicate(A, P0) :-
_Na_ is the name of the predicate, and _Ar_ its arity. _Na_ is the name of the predicate, and _Ar_ its arity.
*/ */
current_predicate(F0) :- current_predicate(F0) :-
'$yap_strip_module'(F0, M, F), '$yap_strip_module'(F0, M, F),
must_bind_to_type( predicate_indicator, F ), must_bind_to_type( predicate_indicator, F ),
'$c_i_predicate'( F, M ). '$c_i_predicate'( F, M ).
'$c_i_predicate'( A/N, M ) :- '$c_i_predicate'( A/N, M ) :-
!, !,
( (
ground(A/N) ground(A/N)
-> ->
atom(A), integer(N), atom(A), integer(N),
functor(S, A, N), functor(S, A, N),
current_predicate(A, M:S) current_predicate(A, M:S)
; ;
current_predicate(A, M:S), current_predicate(A, M:S),
functor(S, A, N) functor(S, A, N)
). ).
'$c_i_predicate'( A//N, M ) :- '$c_i_predicate'( A//N, M ) :-
( (
ground(A) ground(A)
-> ->
atom(A), integer(N), atom(A), integer(N),
N2 is N+2, N2 is N+2,
functor(S, A, N2), functor(S, A, N2),
current_predicate(A, M:S) current_predicate(A, M:S)
; ;
current_predicate(A, M:S), current_predicate(A, M:S),
functor(S, A, N2), functor(S, A, N2),
N is N2-2 N is N2-2
). ).
/** @pred current_key(? _A_,? _K_) /** @pred current_key(? _A_,? _K_)
@ -726,17 +726,17 @@ name is the atom _A_. It can be used to generate all the keys for
the internal data-base. the internal data-base.
*/ */
current_key(A,K) :- current_key(A,K) :-
'$current_predicate'(A,idb,K,user). '$current_predicate'(A,idb,K,user).
% do nothing for now. % do nothing for now.
'$noprofile'(_, _). '$noprofile'(_, _).
'$ifunctor'(Pred,Na,Ar) :- '$ifunctor'(Pred,Na,Ar) :-
(Ar > 0 -> (Ar > 0 ->
functor(Pred, Na, Ar) functor(Pred, Na, Ar)
; ;
Pred = Na Pred = Na
). ).
/** @pred compile_predicates(: _ListOfNameArity_) /** @pred compile_predicates(: _ListOfNameArity_)
@ -752,68 +752,69 @@ of the program that is generated at runtime but does not change during
the remainder of the program execution. the remainder of the program execution.
*/ */
compile_predicates(Ps) :- compile_predicates(Ps) :-
'$current_module'(Mod), '$current_module'(Mod),
'$compile_predicates'(Ps, Mod, compile_predicates(Ps)). '$compile_predicates'(Ps, Mod, compile_predicates(Ps)).
'$compile_predicates'(V, _, Call) :- '$compile_predicates'(V, _, Call) :-
var(V), !, var(V), !,
'$do_error'(instantiation_error,Call). '$do_error'(instantiation_error,Call).
'$compile_predicates'(M:Ps, _, Call) :- '$compile_predicates'(M:Ps, _, Call) :-
'$compile_predicates'(Ps, M, Call). '$compile_predicates'(Ps, M, Call).
'$compile_predicates'([], _, _). '$compile_predicates'([], _, _).
'$compile_predicates'([P|Ps], M, Call) :- '$compile_predicates'([P|Ps], M, Call) :-
'$compile_predicate'(P, M, Call), '$compile_predicate'(P, M, Call),
'$compile_predicates'(Ps, M, Call). '$compile_predicates'(Ps, M, Call).
'$compile_predicate'(P, _M, Call) :- '$compile_predicate'(P, _M, Call) :-
var(P), !, var(P), !,
'$do_error'(instantiation_error,Call). '$do_error'(instantiation_error,Call).
'$compile_predicate'(M:P, _, Call) :- '$compile_predicate'(M:P, _, Call) :-
'$compile_predicate'(P, M, Call). '$compile_predicate'(P, M, Call).
'$compile_predicate'(Na/Ar, Mod, _Call) :- '$compile_predicate'(Na/Ar, Mod, _Call) :-
functor(G, Na, Ar), functor(G, Na, Ar),
findall([G|B],clause(Mod:G,B),Cls), findall([G|B],clause(Mod:G,B),Cls),
abolish(Mod:Na,Ar), abolish(Mod:Na,Ar),
'$add_all'(Cls, Mod). '$add_all'(Cls, Mod).
'$add_all'([], _). '$add_all'([], _).
'$add_all'([[G|B]|Cls], Mod) :- '$add_all'([[G|B]|Cls], Mod) :-
assert_static(Mod:(G:-B)), assert_static(Mod:(G:-B)),
'$add_all'(Cls, Mod). '$add_all'(Cls, Mod).
clause_property(ClauseRef, file(FileName)) :- clause_property(ClauseRef, file(FileName)) :-
( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R) ( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
-> true -> true
; ;
instance_property(ClauseRef, 2, FileName) ). instance_property(ClauseRef, 2, FileName) ).
clause_property(ClauseRef, source(FileName)) :- clause_property(ClauseRef, source(FileName)) :-
( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R) ( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
-> true -> true
; ;
instance_property(ClauseRef, 2, FileName) ). instance_property(ClauseRef, 2, FileName) ).
clause_property(ClauseRef, line_count(LineNumber)) :- clause_property(ClauseRef, line_count(LineNumber)) :-
instance_property(ClauseRef, 4, LineNumber), instance_property(ClauseRef, 4, LineNumber),
LineNumber > 0. LineNumber > 0.
clause_property(ClauseRef, fact) :- clause_property(ClauseRef, fact) :-
instance_property(ClauseRef, 3, true). instance_property(ClauseRef, 3, true).
clause_property(ClauseRef, erased) :- clause_property(ClauseRef, erased) :-
instance_property(ClauseRef, 0, true). instance_property(ClauseRef, 0, true).
clause_property(ClauseRef, predicate(PredicateIndicator)) :- clause_property(ClauseRef, predicate(PredicateIndicator)) :-
instance_property(ClauseRef, 1, PredicateIndicator). instance_property(ClauseRef, 1, PredicateIndicator).
'$set_predicate_attribute'(M:N/Ar, Flag, V) :- '$set_predicate_attribute'(M:N/Ar, Flag, V) :-
functor(P, N, Ar), functor(P, N, Ar),
'$set_flag'(P, M, Flag, V). '$set_flag'(P, M, Flag, V).
%% '$set_flag'(P, M, trace, off) :- %% '$set_flag'(P, M, trace, off) :-
% set a predicate flag % set a predicate flag
% %
'$set_flag'(P, M, trace, off) :- '$set_flag'(P, M, trace, off) :-
'$predicate_flags'(P,M,F,F), '$predicate_flags'(P,M,F,F),
FN is F \/ 0x400000000, FN is F \/ 0x400000000,
'$predicate_flags'(P,M,F,FN). '$predicate_flags'(P,M,F,FN).
/** /**
@} @}
*/ */