diff --git a/CMakeLists.txt b/CMakeLists.txt index e41b3f3..c346e12 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -3,12 +3,13 @@ project(swipl-cpp) include("../cmake/PrologPackage.cmake") -set(CMAKE_CXX_STANDARD 17) # TODO: is this needed? +set(CMAKE_CXX_STANDARD 17) # Some users of this require C++-17 +set(CMAKE_C_STANDARD 11) # swipl requires C-11 configure_file(config.h.cmake config.h) install_src(pkg_cpp_headers - FILES SWI-cpp.h SWI-cpp2.h DESTINATION + FILES SWI-cpp.h SWI-cpp2.h SWI-cpp2.cpp SWI-cpp2-plx.h DESTINATION ${SWIPL_INSTALL_INCLUDE}) swipl_examples(test_cpp.cpp test_ffi.c likes.cpp likes.pl README.md) @@ -35,5 +36,5 @@ swipl_plugin( TEST_ONLY MODULE test_cpp C_LIBS ${SOCKET_LIBRARIES} - C_SOURCES test_cpp.cpp) + C_SOURCES test_cpp.cpp SWI-cpp2.cpp) endif() diff --git a/SWI-cpp2-plx.h b/SWI-cpp2-plx.h new file mode 100644 index 0000000..b266490 --- /dev/null +++ b/SWI-cpp2-plx.h @@ -0,0 +1,553 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker and Peter Ludemann + E-mail: J.Wielemaker@vu.nl + WWW: http://www.swi-prolog.org + Copyright (c) 2000-2023, University of Amsterdam + VU University Amsterdam + SWI-Prolog Solutions b.v. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. +*/ + +// This file was derived from WUNUSED is changed to +// [[nodiscard]], and added to some functions that don't have WUNUSEd +// (possibly WUNUSED should be added for them in SWI-Prolog.h). + +// Commented out lines are because: +// - no return value +// - return value 0 doesn't mean "fail" +// - private +// - has "..." or similar that requires a bit more work. +// In addition, some functions that return a boolean as an "int" have +// been changed to use a C++ "bool" (the template functions PlWrap() +// and PlEx() have been written to handle this situations). + +// This file is included by SWI-cpp2.h -- it is kept separate because +// it is derived from SWI-Prolog.h + +#ifndef _SWI_CPP2_PLX_H +#define _SWI_CPP2_PLX_H + + +/* Wrapper macros - each PL_*() function has a corresponding Plx_*() wrapper: + PLX_EXCE is for functions whose return code only indicates an error + PLX_WRAP is for functions whose return code could mean either an error or failure + PLX_ASIS and PLX_VOID are for functions that are used as-is +*/ + +// TODO: remove PlWrapDebug() when global ordering bug is fixed +// https://github.com/SWI-Prolog/swipl-devel/issues/1155 + +#ifdef O_DEBUG +void PlWrapDebug(const char*); +#else +#define PlWrapDebug(m) +#endif + +#define PLX_EXCE(type, name, params, args) inline void Plx_ ## name params { PlWrapDebug("EXCE-" #name); PlEx(PL_ ## name args); } + +#define PLX_WRAP(type, name, params, args) [[nodiscard]] inline type Plx_ ## name params { PlWrapDebug("WRAP-" #name); return PlWrap(PL_ ## name args); } + +#define PLX_ASIS(type, name, params, args) [[nodiscard]] inline type Plx_ ## name params { PlWrapDebug("ASIS-"#name); return PL_ ## name args; } +#define PLX_VOID(type, name, params, args) inline void Plx_ ## name params { PlWrapDebug("VOID-" #name); PL_ ## name args; } + +PLX_ASIS(int , foreign_control , (control_t c), (c)) +PLX_ASIS(intptr_t , foreign_context , (control_t c), (c)) +PLX_ASIS(void * , foreign_context_address , (control_t c), (c)) +PLX_ASIS(predicate_t , foreign_context_predicate , (control_t c), (c)) + +PLX_VOID(void , register_extensions , (const PL_extension *e), (e)) +PLX_VOID(void , register_extensions_in_module , (const char *module, const PL_extension *e), (module, e)); + +// (skipped):: int PL_register_foreign(const char *name, int arity, pl_function_t func, int flags, ...); +// (skipped):: int PL_register_foreign_in_module( const char *module , const char *name, int arity, pl_function_t func, int flags, ...); + +// Deprecated: PL_load_extensions(const PL_extension *e); + +// TODO: document PL_license() +PLX_VOID(void , license , (const char *license, const char *module), (license, module)) + +PLX_ASIS(module_t , context , (), ()) +PLX_ASIS(atom_t , module_name , (module_t module), (module)) +PLX_WRAP(module_t , new_module , (atom_t name), (name)) +PLX_EXCE(int , strip_module , (term_t in, module_t *m, term_t out), (in, m, out)) +PLX_WRAP(fid_t , open_foreign_frame , (), ()) + +PLX_VOID(void , rewind_foreign_frame , (fid_t cid), (cid)) +PLX_VOID(void , close_foreign_frame , (fid_t cid), (cid)) +PLX_VOID(void , discard_foreign_frame , (fid_t cid), (cid)) + +PLX_WRAP(predicate_t , pred , (functor_t f, module_t m), (f, m)) +PLX_WRAP(predicate_t , predicate , (const char *name, int arity, const char* module), (name, arity, module)) +PLX_EXCE(int , predicate_info , (predicate_t pred, atom_t *name, size_t *arity, module_t *module), (pred, name, arity, module)) +PLX_WRAP(qid_t , open_query , (module_t m, int flags, predicate_t pred, term_t t0), (m, flags, pred, t0)) +// TODO: PL_next_solution() needs special handling: +// [[nodiscard]] int PL_next_solution(qid_t qid); +PLX_EXCE(int , close_query , (qid_t qid), (qid)) +PLX_EXCE(int , cut_query , (qid_t qid), (qid)) +PLX_ASIS(qid_t , current_query , (), ()) +PLX_ASIS(PL_engine_t , query_engine , (qid_t qid), (qid)) +PLX_ASIS(bool , can_yield , (), ()) +// [[nodiscard]] +PLX_WRAP(int , call , (term_t t, module_t m), (t, m)) +// TODO: Needs special case - see PL_next_solution(): +// [[nodiscard]] int PL_call_predicate(module_t m, int debug, predicate_t pred, term_t t0); +PLX_ASIS(term_t , exception , (qid_t qid), (qid)) +PLX_ASIS(int , raise_exception , (term_t exception), (exception)) +// Deprecated: int PL_throw(term_t exception); +PLX_VOID(void , clear_exception , (), ()) +// TODO: document PL_yielded() +PLX_ASIS(term_t , yielded , (qid_t qid), (qid)) +PLX_EXCE(int , assert , (term_t term, module_t m, int flags), (term, m, flags)) +PLX_WRAP(term_t , new_term_refs , (int n), (n)) +PLX_WRAP(term_t , new_term_ref , (), ()) +PLX_WRAP(term_t , copy_term_ref , (term_t from), (from)) +PLX_VOID(void , reset_term_refs , (term_t r), (r)) +/* [[deprecated]] */ +PLX_WRAP(atom_t , new_atom , (const char *s), (s)) + +PLX_WRAP(atom_t , new_atom_nchars , (size_t len, const char *s), (len, s)) +PLX_WRAP(atom_t , new_atom_wchars , (size_t len, const pl_wchar_t *s), (len, s)) +PLX_WRAP(atom_t , new_atom_mbchars , (int rep, size_t len, const char *s), (rep, len, s)) +// Deprecated: const char *PL_atom_chars(atom_t a); +PLX_WRAP(const char * , atom_nchars , (atom_t a, size_t *len), (a, len)) +PLX_EXCE(int , atom_mbchars , (atom_t a, size_t *len, char **s, unsigned int flags), (a, len, s, flags)) +PLX_WRAP(const wchar_t * , atom_wchars , (atom_t a, size_t *len), (a, len)) +PLX_VOID(void , register_atom , (atom_t a), (a)) +PLX_VOID(void , unregister_atom , (atom_t a), (a)) +// (skipped):: void _PL_debug_register_atom(atom_t a, const char *file, int line, const char *func); +// (skipped):: void _PL_debug_unregister_atom(atom_t a, const char *file, int line, const char *func); + +PLX_WRAP(functor_t , new_functor , (atom_t f, size_t a), (f, a)) +PLX_ASIS(atom_t , functor_name , (functor_t f), (f)) +PLX_ASIS(size_t , functor_arity , (functor_t f), (f)) +[[nodiscard]] +PLX_ASIS(bool , get_atom , (term_t t, atom_t *a), (t, a)) +[[nodiscard]] +PLX_ASIS(bool , get_bool , (term_t t, int *value), (t, value)) +[[nodiscard]] +PLX_ASIS(bool , get_atom_chars , (term_t t, char **a), (t, a)) +[[nodiscard]] +// Deprecated: int PL_get_string(term_t t, char **s, size_t *len); +[[nodiscard]] +PLX_ASIS(bool , get_chars , (term_t t, char **s, unsigned int flags), (t, s, flags)) +[[nodiscard]] +PLX_ASIS(bool , get_list_chars , (term_t l, char **s, unsigned int flags), (l, s, flags)) +[[nodiscard]] +PLX_ASIS(bool , get_atom_nchars , (term_t t, size_t *len, char **a), (t, len, a)) +[[nodiscard]] +PLX_ASIS(bool , get_list_nchars , (term_t l, size_t *len, char **s, unsigned int flags), (l, len, s, flags)) +[[nodiscard]] +PLX_ASIS(bool , get_nchars , (term_t t, size_t *len, char **s, unsigned int flags), (t, len, s, flags)) +[[nodiscard]] +PLX_ASIS(bool , get_integer , (term_t t, int *i), (t, i)) +[[nodiscard]] +PLX_ASIS(bool , get_long , (term_t t, long *i), (t, i)) +[[nodiscard]] +PLX_ASIS(bool , get_intptr , (term_t t, intptr_t *i), (t, i)) +[[nodiscard]] +PLX_ASIS(bool , get_pointer , (term_t t, void **ptr), (t, ptr)) +[[nodiscard]] +PLX_ASIS(bool , get_float , (term_t t, double *f), (t, f)) +[[nodiscard]] +PLX_ASIS(bool , get_functor , (term_t t, functor_t *f), (t, f)) +[[nodiscard]] +PLX_ASIS(bool , get_name_arity , (term_t t, atom_t *name, size_t *arity), (t, name, arity)) +[[nodiscard]] +PLX_ASIS(bool , get_compound_name_arity , (term_t t, atom_t *name, size_t *arity), (t, name, arity)) +[[nodiscard]] +PLX_ASIS(bool , get_module , (term_t t, module_t *module), (t, module)) +[[nodiscard]] +PLX_ASIS(bool , get_arg , (size_t index, term_t t, term_t a), (index, t, a)) +[[nodiscard]] +PLX_ASIS(bool , get_dict_key , (atom_t key, term_t dict, term_t value), (key, dict, value)) +[[nodiscard]] +PLX_ASIS(bool , get_list , (term_t l, term_t h, term_t t), (l, h, t)) +[[nodiscard]] +PLX_ASIS(bool , get_head , (term_t l, term_t h), (l, h)) +[[nodiscard]] +PLX_ASIS(bool , get_tail , (term_t l, term_t t), (l, t)) +[[nodiscard]] +PLX_ASIS(bool , get_nil , (term_t l), (l)) +[[nodiscard]] +[[deprecated]] +PLX_ASIS(int , get_term_value , (term_t t, term_value_t *v), (t, v)) +PLX_ASIS(char * , quote , (int chr, const char *data), (chr, data)) +PLX_ASIS(int , term_type , (term_t t), (t)) +PLX_ASIS(bool , is_variable , (term_t t), (t)) +PLX_ASIS(bool , is_ground , (term_t t), (t)) +PLX_ASIS(bool , is_atom , (term_t t), (t)) +PLX_ASIS(bool , is_integer , (term_t t), (t)) +PLX_ASIS(bool , is_string , (term_t t), (t)) +PLX_ASIS(bool , is_float , (term_t t), (t)) +PLX_ASIS(bool , is_rational , (term_t t), (t)) +PLX_ASIS(bool , is_compound , (term_t t), (t)) +PLX_ASIS(bool , is_callable , (term_t t), (t)) +PLX_ASIS(bool , is_functor , (term_t t, functor_t f), (t, f)) +PLX_ASIS(bool , is_list , (term_t t), (t)) +PLX_ASIS(bool , is_dict , (term_t t), (t)) +PLX_ASIS(bool , is_pair , (term_t t), (t)) +PLX_ASIS(bool , is_atomic , (term_t t), (t)) +PLX_ASIS(bool , is_number , (term_t t), (t)) +PLX_ASIS(bool , is_acyclic , (term_t t), (t)) +PLX_EXCE(int , put_variable , (term_t t), (t)) +PLX_EXCE(int , put_atom , (term_t t, atom_t a), (t, a)) +PLX_EXCE(int , put_bool , (term_t t, int val), (t, val)) +PLX_EXCE(int , put_atom_chars , (term_t t, const char *chars), (t, chars)) +PLX_EXCE(int , put_string_chars , (term_t t, const char *chars), (t, chars)) +PLX_EXCE(int , put_chars , (term_t t, int flags, size_t len, const char *chars), (t, flags, len, chars)) +PLX_EXCE(int , put_list_chars , (term_t t, const char *chars), (t, chars)) +PLX_EXCE(int , put_list_codes , (term_t t, const char *chars), (t, chars)) +PLX_EXCE(int , put_atom_nchars , (term_t t, size_t l, const char *chars), (t, l, chars)) +PLX_EXCE(int , put_string_nchars , (term_t t, size_t len, const char *chars), (t, len, chars)) +PLX_EXCE(int , put_list_nchars , (term_t t, size_t l, const char *chars), (t, l, chars)) +PLX_EXCE(int , put_list_ncodes , (term_t t, size_t l, const char *chars), (t, l, chars)) +PLX_EXCE(int , put_integer , (term_t t, long i), (t, i)) +PLX_EXCE(int , put_pointer , (term_t t, void *ptr), (t, ptr)) +PLX_EXCE(int , put_float , (term_t t, double f), (t, f)) +PLX_EXCE(int , put_functor , (term_t t, functor_t functor), (t, functor)) +PLX_EXCE(int , put_list , (term_t l), (l)) +PLX_EXCE(int , put_nil , (term_t l), (l)) +PLX_EXCE(int , put_term , (term_t t1, term_t t2), (t1, t2)) +PLX_EXCE(int , put_dict , (term_t t, atom_t tag, size_t len, const atom_t *keys, term_t values), (t, tag, len, keys, values)) +// (skipped):: int PL_cons_functor(term_t h, functor_t f, ...) WUNUSED; +PLX_EXCE(int , cons_functor_v , (term_t h, functor_t fd, term_t a0), (h, fd, a0)) +PLX_EXCE(int , cons_list , (term_t l, term_t h, term_t t), (l, h, t)) + +// [[nodiscard]] +PLX_WRAP(bool , unify , (term_t t1, term_t t2), (t1, t2)) +// [[nodiscard]] +PLX_WRAP(bool , unify_atom , (term_t t, atom_t a), (t, a)) +// [[nodiscard]] +PLX_WRAP(bool , unify_atom_chars , (term_t t, const char *chars), (t, chars)) +// [[nodiscard]] +PLX_WRAP(bool , unify_list_chars , (term_t t, const char *chars), (t, chars)) +// [[nodiscard]] +PLX_WRAP(bool , unify_list_codes , (term_t t, const char *chars), (t, chars)) +// [[nodiscard]] +PLX_WRAP(bool , unify_string_chars , (term_t t, const char *chars), (t, chars)) +// [[nodiscard]] +PLX_WRAP(bool , unify_atom_nchars , (term_t t, size_t l, const char *s), (t, l, s)) +// [[nodiscard]] +PLX_WRAP(bool , unify_list_ncodes , (term_t t, size_t l, const char *s), (t, l, s)) +// [[nodiscard]] +PLX_WRAP(bool , unify_list_nchars , (term_t t, size_t l, const char *s), (t, l, s)) +// [[nodiscard]] +PLX_WRAP(bool , unify_string_nchars , (term_t t, size_t len, const char *chars), (t, len, chars)) +// [[nodiscard]] +PLX_WRAP(bool , unify_bool , (term_t t, int n), (t, n)) +// [[nodiscard]] +PLX_WRAP(bool , unify_integer , (term_t t, intptr_t n), (t, n)) +// [[nodiscard]] +PLX_WRAP(bool , unify_float , (term_t t, double f), (t, f)) +// [[nodiscard]] +PLX_WRAP(bool , unify_pointer , (term_t t, void *ptr), (t, ptr)) +// [[nodiscard]] +PLX_WRAP(bool , unify_functor , (term_t t, functor_t f), (t, f)) +// [[nodiscard]] +PLX_WRAP(bool , unify_compound , (term_t t, functor_t f), (t, f)) +// [[nodiscard]] +PLX_WRAP(bool , unify_list , (term_t l, term_t h, term_t t), (l, h, t)) +// [[nodiscard]] +PLX_WRAP(bool , unify_nil , (term_t l), (l)) +// [[nodiscard]] +PLX_WRAP(bool , unify_arg , (size_t index, term_t t, term_t a), (index, t, a)) +// (skipped):: // [[nodiscard]] bool PL_unify_term(term_t t, ...) +// [[nodiscard]] +PLX_WRAP(bool , unify_chars , (term_t t, int flags, size_t len, const char *s), (t, flags, len, s)) + +// [[nodiscard]] +PLX_ASIS(bool , skip_list , (term_t list, term_t tail, size_t *len), (list, tail, len)) +// [[nodiscard]] +PLX_WRAP(bool , unify_wchars , (term_t t, int type, size_t len, const pl_wchar_t *s), (t, type, len, s)) +// [[nodiscard]] +PLX_WRAP(bool , unify_wchars_diff , (term_t t, term_t tail, int type, size_t len, const pl_wchar_t *s), (t, tail, type, len, s)) + +// [[nodiscard]] +PLX_ASIS(bool , get_wchars , (term_t l, size_t *length, pl_wchar_t **s, unsigned flags), (l, length, s, flags)) +// TODO: document PL_utf8_strlen +// [[nodiscard]] +PLX_ASIS(size_t , utf8_strlen , (const char *s, size_t len), (s, len)) +// [[nodiscard]] +PLX_ASIS(bool , get_int64 , (term_t t, int64_t *i), (t, i)) +// [[nodiscard]] +PLX_ASIS(bool , get_uint64 , (term_t t, uint64_t *i), (t, i)) +// [[nodiscard]] +PLX_WRAP(bool , unify_int64 , (term_t t, int64_t value), (t, value)) +// [[nodiscard]] +PLX_WRAP(bool , unify_uint64 , (term_t t, uint64_t value), (t, value)) +// [[nodiscard]] +PLX_EXCE(int , put_int64 , (term_t t, int64_t i), (t, i)) +// [[nodiscard]] +PLX_EXCE(int , put_uint64 , (term_t t, uint64_t i), (t, i)) +PLX_ASIS(bool , is_attvar , (term_t t), (t)) +PLX_WRAP(int , get_attr , (term_t v, term_t a), (v, a)) +PLX_EXCE(int , get_atom_ex , (term_t t, atom_t *a), (t, a)) +PLX_EXCE(int , get_integer_ex , (term_t t, int *i), (t, i)) +PLX_EXCE(int , get_long_ex , (term_t t, long *i), (t, i)) +PLX_EXCE(int , get_int64_ex , (term_t t, int64_t *i), (t, i)) +PLX_EXCE(int , get_uint64_ex , (term_t t, uint64_t *i), (t, i)) +PLX_EXCE(int , get_intptr_ex , (term_t t, intptr_t *i), (t, i)) +PLX_EXCE(int , get_size_ex , (term_t t, size_t *i), (t, i)) +PLX_EXCE(int , get_bool_ex , (term_t t, int *i), (t, i)) +PLX_EXCE(int , get_float_ex , (term_t t, double *f), (t, f)) +PLX_EXCE(int , get_char_ex , (term_t t, int *p, int eof), (t, p, eof)) +PLX_EXCE(int , unify_bool_ex , (term_t t, int val), (t, val)) +PLX_EXCE(int , get_pointer_ex , (term_t t, void **addrp), (t, addrp)) +PLX_EXCE(int , unify_list_ex , (term_t l, term_t h, term_t t), (l, h, t)) +PLX_EXCE(int , unify_nil_ex , (term_t l), (l)) +PLX_EXCE(int , get_list_ex , (term_t l, term_t h, term_t t), (l, h, t)) +PLX_EXCE(int , get_nil_ex , (term_t l), (l)) + +PLX_ASIS(int , instantiation_error , (term_t culprit), (culprit)) +PLX_ASIS(int , uninstantiation_error , (term_t culprit), (culprit)) +PLX_ASIS(int , representation_error , (const char *resource), (resource)) +PLX_ASIS(int , type_error , (const char *expected, term_t culprit), (expected, culprit)) +PLX_ASIS(int , domain_error , (const char *expected, term_t culprit), (expected, culprit)) +PLX_ASIS(int , existence_error , (const char *type, term_t culprit), (type, culprit)) +PLX_ASIS(int , permission_error , (const char *operation, const char *type, term_t culprit), (operation, type, culprit)) +PLX_ASIS(int , resource_error , (const char *resource), (resource)) +PLX_ASIS(int , syntax_error , (const char *msg, IOSTREAM *in), (msg, in)) + +PLX_ASIS(bool , is_blob , (term_t t, PL_blob_t **type), (t, type)) +PLX_WRAP(bool , unify_blob , (term_t t, void *blob, size_t len, PL_blob_t *type), (t, blob, len, type)) +PLX_WRAP(atom_t , new_blob , (void *blob, size_t len, PL_blob_t *type), (blob, len, type)) +PLX_EXCE(int , put_blob , (term_t t, void *blob, size_t len, PL_blob_t *type), (t, blob, len, type)) +PLX_WRAP(int , get_blob , (term_t t, void **blob, size_t *len, PL_blob_t **type), (t, blob, len, type)) +PLX_ASIS(void* , blob_data , (atom_t a, size_t *len, struct PL_blob_t **type), (a, len, type)) +PLX_VOID(void , register_blob_type , (PL_blob_t *type), (type)) +PLX_ASIS(PL_blob_t* , find_blob_type , (const char* name), (name)) +PLX_ASIS(bool , unregister_blob_type , (PL_blob_t *type), (type)) + +#ifdef __GNU_MP__ +[[nodiscard]] +PLX_WRAP(int , get_mpz , (term_t t, mpz_t mpz), (t, mpz)) +[[nodiscard]] +PLX_WRAP(bool , get_mpq , (term_t t, mpq_t mpq), (t, mpq)) +[[nodiscard]] +PLX_WRAP(bool , unify_mpz , (term_t t, mpz_t mpz), (t, mpz)) +[[nodiscard]] +PLX_WRAP(bool , unify_mpq , (term_t t, mpq_t mpq), (t, mpq)) +#endif + +PLX_ASIS(bool , get_file_name , (term_t n, char **name, int flags), (n, name, flags)) +PLX_ASIS(bool , get_file_nameW , (term_t n, wchar_t **name, int flags), (n, name, flags)) +// TODO: document PL_changed_cwd() +PLX_VOID(void , changed_cwd , (), ()) +// TODO: document PL_cwd() +PLX_ASIS(char * , cwd , (char *buf, size_t buflen), (buf, buflen)) + +PLX_EXCE(int , cvt_i_bool , (term_t p, int *c), (p, c)) +PLX_EXCE(int , cvt_i_char , (term_t p, char *c), (p, c)) +PLX_EXCE(int , cvt_i_schar , (term_t p, signed char *c), (p, c)) +PLX_EXCE(int , cvt_i_uchar , (term_t p, unsigned char *c), (p, c)) +PLX_EXCE(int , cvt_i_short , (term_t p, short *s), (p, s)) +PLX_EXCE(int , cvt_i_ushort , (term_t p, unsigned short *s), (p, s)) +PLX_EXCE(int , cvt_i_int , (term_t p, int *c), (p, c)) +PLX_EXCE(int , cvt_i_uint , (term_t p, unsigned int *c), (p, c)) +PLX_EXCE(int , cvt_i_long , (term_t p, long *c), (p, c)) +PLX_EXCE(int , cvt_i_ulong , (term_t p, unsigned long *c), (p, c)) +PLX_EXCE(int , cvt_i_llong , (term_t p, long long *c), (p, c)) +PLX_EXCE(int , cvt_i_ullong , (term_t p, unsigned long long *c), (p, c)) +PLX_EXCE(int , cvt_i_int32 , (term_t p, int32_t *c), (p, c)) +PLX_EXCE(int , cvt_i_uint32 , (term_t p, uint32_t *c), (p, c)) +PLX_EXCE(int , cvt_i_int64 , (term_t p, int64_t *c), (p, c)) +PLX_EXCE(int , cvt_i_uint64 , (term_t p, uint64_t *c), (p, c)) +PLX_EXCE(int , cvt_i_size_t , (term_t p, size_t *c), (p, c)) +PLX_EXCE(int , cvt_i_float , (term_t p, double *c), (p, c)) +PLX_EXCE(int , cvt_i_single , (term_t p, float *c), (p, c)) +PLX_EXCE(int , cvt_i_string , (term_t p, char **c), (p, c)) +PLX_EXCE(int , cvt_i_codes , (term_t p, char **c), (p, c)) +PLX_EXCE(int , cvt_i_atom , (term_t p, atom_t *c), (p, c)) +PLX_EXCE(int , cvt_i_address , (term_t p, void *c), (p, c)) +PLX_EXCE(int , cvt_o_int64 , (int64_t c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_float , (double c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_single , (float c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_string , (const char *c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_codes , (const char *c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_atom , (atom_t c, term_t p), (c, p)) +PLX_EXCE(int , cvt_o_address , (void *address, term_t p), (address, p)) + +PLX_WRAP(term_t , new_nil_ref , (), ()) +PLX_ASIS(int , cvt_encoding , (), ()) +PLX_ASIS(int , cvt_set_encoding , (int enc), (enc)) +// (skipped):: void SP_set_state(int state); +// (skipped):: int SP_get_state(); +PLX_ASIS(int , compare , (term_t t1, term_t t2), (t1, t2)) +PLX_ASIS(int , same_compound , (term_t t1, term_t t2), (t1, t2)) +// (skipped):: int PL_warning(const char *fmt , ...) WPRINTF12; +// (skipped):: int PL_warningX(const char *fmt , ...); +// (skipped):: void PL_fatal_error(const char *fmt , ...) WPRINTF12; +PLX_WRAP(record_t , record , (term_t term), (term)) +PLX_EXCE(int , recorded , (record_t record, term_t term), (record, term)) +PLX_VOID(void , erase , (record_t record), (record)) +PLX_WRAP(record_t , duplicate_record , (record_t r), (r)) +PLX_WRAP(char * , record_external , (term_t t, size_t *size), (t, size)) +PLX_EXCE(int , recorded_external , (const char *rec, term_t term), (rec, term)) +PLX_EXCE(int , erase_external , (char *rec), (rec)) +// (skipped):: int PL_set_prolog_flag(const char *name, int type, ...); +// (skipped):: PL_atomic_t _PL_get_atomic(term_t t); +// (skipped):: void _PL_put_atomic(term_t t, PL_atomic_t a); +// (skipped):: int _PL_unify_atomic(term_t t, PL_atomic_t a); +// (skipped):: int _PL_get_arg_sz(size_t index, term_t t, term_t a); +// (skipped):: int _PL_get_arg(int index, term_t t, term_t a); +PLX_VOID(void , mark_string_buffers , (buf_mark_t *mark), (mark)) +PLX_VOID(void , release_string_buffers_from_mark, (buf_mark_t mark), (mark)) +PLX_WRAP(bool , unify_stream , (term_t t, IOSTREAM *s), (t, s)) +// TODO: document PL_get_stream_handle +PLX_EXCE(int , get_stream_handle , (term_t t, IOSTREAM **s), (t, s)) +PLX_EXCE(int , get_stream , (term_t t, IOSTREAM **s, int flags), (t, s, flags)) +PLX_EXCE(int , get_stream_from_blob , (atom_t a, IOSTREAM**s, int flags), (a, s, flags)) +PLX_WRAP(IOSTREAM* , acquire_stream , (IOSTREAM *s), (s)) +PLX_EXCE(int , release_stream , (IOSTREAM *s), (s)) +// TODO: document PL_release_stream_noerror() +PLX_WRAP(int , release_stream_noerror , (IOSTREAM *s), (s)) +// TODO: document PL_open_resource() +PLX_WRAP(IOSTREAM * , open_resource , (module_t m, const char *name, const char *rc_class, const char *mode), (m, name, rc_class, mode)) + +// (skipped):: IOSTREAM **_PL_streams(void); /* base of streams */ +PLX_EXCE(int , write_term , (IOSTREAM *s, term_t term, int precedence, int flags), (s, term, precedence, flags)) +PLX_ASIS(bool , ttymode , (IOSTREAM *s), (s)) + +// TODO: PL_put_term_from_chars depends on CVT_EXCEPTION - ? make version that checks this and throws an exception? +PLX_ASIS(int , put_term_from_chars , (term_t t, int flags, size_t len, const char *s), (t, flags, len, s)) + +// PL_chars_to_term(), PL_wchars_to_term() put error into term for syntax errors +[[nodiscard]] +PLX_ASIS(int , chars_to_term , (const char *chars, term_t term), (chars, term)) +[[nodiscard]] +PLX_ASIS(int , wchars_to_term , (const pl_wchar_t *chars, term_t term), (chars, term)) + +// In the following, some of the functions can return `false` without +// a Prolog error; in these cases, a PlUnknownError is thrown. +// If you wish finer control, use the PL_*() version of the call. +PLX_EXCE(int , initialise , (int argc, char **argv), (argc, argv)) +PLX_EXCE(int , winitialise , (int argc, wchar_t **argv), (argc, argv)) +PLX_ASIS(bool , is_initialised , (int *argc, char ***argv), (argc, argv)) +PLX_EXCE(int , set_resource_db_mem , (const unsigned char *data, size_t size), (data, size)) +PLX_ASIS(bool , toplevel , (), ()) +PLX_EXCE(int , cleanup , (int status), (status)) +PLX_VOID(void , cleanup_fork , (), ()) +PLX_ASIS(int , halt , (int status), (status)) + +PLX_ASIS(void * , dlopen , (const char *file, int flags), (file, flags)) +PLX_ASIS(const char * , dlerror , (), ()) +PLX_ASIS(void * , dlsym , (void *handle, char *symbol), (handle, symbol)) +PLX_ASIS(int , dlclose , (void *handle), (handle)) + +// TODO: document PL_dispatch(), PL_add_to_protocol, etc. +PLX_ASIS(int , dispatch , (int fd, int wait), (fd, wait)) +PLX_VOID(void , add_to_protocol , (const char *buf, size_t count), (buf, count)) +PLX_ASIS(char * , prompt_string , (int fd), (fd)) +PLX_VOID(void , write_prompt , (int dowrite), (dowrite)) +PLX_VOID(void , prompt_next , (int fd), (fd)) +PLX_ASIS(char * , atom_generator , (const char *prefix, int state), (prefix, state)) +PLX_ASIS(pl_wchar_t* , atom_generator_w , (const pl_wchar_t *pref, pl_wchar_t *buffer, size_t buflen, int state), (pref, buffer, buflen, state)) + +PLX_ASIS(void * , malloc , (size_t size), (size)) +PLX_ASIS(void * , malloc_atomic , (size_t size), (size)) +PLX_ASIS(void * , malloc_uncollectable , (size_t size), (size)) +PLX_ASIS(void * , malloc_atomic_uncollectable , (size_t size), (size)) +PLX_ASIS(void * , realloc , (void *mem, size_t size), (mem, size)) +PLX_ASIS(void * , malloc_unmanaged , (size_t size), (size)) +PLX_ASIS(void * , malloc_atomic_unmanaged , (size_t size), (size)) +PLX_VOID(void , free , (void *mem), (mem)) +PLX_ASIS(int , linger , (void *mem), (mem)) + +PLX_ASIS(PL_dispatch_hook_t , dispatch_hook , (PL_dispatch_hook_t h), (h)) +PLX_VOID(void , abort_hook , (PL_abort_hook_t h), (h)) +PLX_VOID(void , initialise_hook , (PL_initialise_hook_t h), (h)) +PLX_ASIS(int , abort_unhook , (PL_abort_hook_t h), (h)) +PLX_ASIS(PL_agc_hook_t , agc_hook , (PL_agc_hook_t h), (h)) + +// TODO: int PL_scan_options(term_t options, int flags, const char *opttype, PL_option_t specs[], ...); +// Deprecated: void (*PL_signal(int sig, void (*func)(int)))(int); +PLX_ASIS(int , sigaction , (int sig, pl_sigaction_t *act, pl_sigaction_t *old), (sig, act, old)) +PLX_VOID(void , interrupt , (int sig), (sig)) +PLX_ASIS(int , raise , (int sig), (sig)) +PLX_ASIS(int , handle_signals , (), ()) +PLX_ASIS(int , get_signum_ex , (term_t sig, int *n), (sig, n)) +// (skipped):: int PL_action(int, ...); +PLX_VOID(void , on_halt , (int (*f)(int, void *), void *closure), (f, closure)); +PLX_VOID(void , exit_hook , (int (*f)(int, void *), void *closure), (f, closure)); +PLX_VOID(void , backtrace , (int depth, int flags), (depth, flags)) +PLX_ASIS(char * , backtrace_string , (int depth, int flags), (depth, flags)) +PLX_ASIS(int , check_data , (term_t data), (data)) +PLX_ASIS(int , check_stacks , (), ()) +PLX_ASIS(int , current_prolog_flag , (atom_t name, int type, void *ptr), (name, type, ptr)) +PLX_ASIS(unsigned int , version_info , (int which), (which)) +PLX_ASIS(intptr_t , query , (int i), (i)) +PLX_ASIS(int , thread_self , (), ()) +PLX_WRAP(int , unify_thread_id , (term_t t, int i), (t, i)) +PLX_WRAP(int , get_thread_id_ex , (term_t t, int *idp), (t, idp)) +PLX_ASIS(int , get_thread_alias , (int tid, atom_t *alias), (tid, alias)) +// TODO: document thread_attach_engine; make PLX_WRAP version (tid < 0) +PLX_ASIS(int , thread_attach_engine , (PL_thread_attr_t *attr), (attr)) +PLX_EXCE(int , thread_destroy_engine , (), ()) +PLX_ASIS(int , thread_at_exit , (void (*function)(void *), void *closure, int global), (function, closure, global)) +PLX_ASIS(int , thread_raise , (int tid, int sig), (tid, sig)) + +#if defined(_WINDOWS_) || defined(_WINDOWS_H) /* is included */ +PLX_ASIS(int , w32thread_raise , (DWORD dwTid, int sig), (dwTid, sig)) +PLX_ASIS(int , wait_for_console_input , (void *handle), (handle)) +PLX_ASIS(int , w32_wrap_ansi_console , (), ()) +PLX_ASIS(const char* , w32_running_under_wine , (), ()) +#endif + +PLX_ASIS(PL_engine_t , create_engine , (PL_thread_attr_t *attributes), (attributes)) +PLX_ASIS(int , set_engine , (PL_engine_t engine, PL_engine_t *old), (engine, old)) +PLX_ASIS(int , destroy_engine , (PL_engine_t engine), (engine)) +PLX_ASIS(hash_table_t , new_hash_table , (int size, void (*free_symbol)(void *n, void *v)), (size, free_symbol)) +PLX_ASIS(int , register_profile_type , (PL_prof_type_t *type), (type)) +PLX_ASIS(void* , prof_call , (void *handle, PL_prof_type_t *type), (handle, type)) +PLX_VOID(void , prof_exit , (void *node), (node)) +// (skipped):: PL_EXPORT_DATA(int) plugin_is_GPL_compatible; +// (skipped):: int emacs_module_init(void*); +PLX_ASIS(int , prolog_debug , (const char *topic), (topic)) +PLX_ASIS(int , prolog_nodebug , (const char *topic), (topic)) + +#if defined(_WINDOWS_) || defined(_WINDOWS_H) /* is included */ +PLX_EXCE(LRESULT , PL_win_message_proc , (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam), (hwnd, message, wParam, lParam)) +#endif + +// (skipped):: int _PL_get_xpce_reference(term_t t, xpceref_t *ref); +// (skipped):: int _PL_unify_xpce_reference(term_t t, xpceref_t *ref); +// (skipped):: int _PL_put_xpce_reference_i(term_t t, uintptr_t r); +// (skipped):: int _PL_put_xpce_reference_a(term_t t, atom_t name); + +PLX_ASIS(int , get_context , (struct pl_context_t *c, int thead_id), (c, thead_id)) +PLX_ASIS(int , step_context , (struct pl_context_t *c), (c)) +PLX_ASIS(int , describe_context , (struct pl_context_t *c, char *buf, size_t len), (c, buf, len)) + + +#undef PLX_EXCE +#undef PLX_WRAP +#undef PLX_ASIS +#undef PLX_VOID + +#endif /* _SWI_CPP2_PLX_H */ diff --git a/SWI-cpp2.cpp b/SWI-cpp2.cpp new file mode 100644 index 0000000..80c7e47 --- /dev/null +++ b/SWI-cpp2.cpp @@ -0,0 +1,754 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker and Peter Ludemann + E-mail: J.Wielemaker@vu.nl + WWW: http://www.swi-prolog.org + Copyright (c) 2000-2023, University of Amsterdam + VU University Amsterdam + SWI-Prolog Solutions b.v. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. +*/ + +/* If you wish, you can append SWI-cpp2.cpp file to SWI-pp2.h ... + to do this, you need this definition: + +#define _SWI_CPP2_CPP_inline inline + +*/ + +#ifndef _SWI_CPP2_CPP +#define _SWI_CPP2_CPP + +#ifndef _SWI_CPP2_CPP_inline +#define _SWI_CPP2_CPP_inline +#endif + +#include "SWI-cpp2.h" + + +_SWI_CPP2_CPP_inline +static +bool ex_is_resource_error(PlTerm ex) +{ // TODO: move the static PlFunctor to outside this function: https://github.com/SWI-Prolog/swipl-devel/issues/1155 + static PlFunctor FUNCTOR_error_2("error", 2); + static PlFunctor FUNCTOR_resource_error_1("resource_error", 1); + // The following doesn't check details of the resource error; if desired + // these can be added by ex[1][1].unify_atom(ATOM_stack), ATOM_memory, etc + return ( ex.is_functor(FUNCTOR_error_2) && + ex[1].is_functor(FUNCTOR_resource_error_1) ); +} + + +_SWI_CPP2_CPP_inline +void +PlWrap_impl(qid_t qid) +{ PlTerm_term_t ex(PL_exception(qid)); + if ( ex.not_null() ) + { // The error(resource_error(stack), _) exception is special because + // nothing can be put on the stack, so all we can do is report failure + // to the Prolog engine, which will take care of things. + // This means, of course, that a user catch(PlException&) won't catch + // this particular exception. + if ( ex_is_resource_error(ex) ) + throw PlExceptionFail(); + const PlException ex2(ex); + Plx_clear_exception(); // See https://swi-prolog.discourse.group/t/cpp2-exceptions/6040/66 + throw ex2; + } +} + + +_SWI_CPP2_CPP_inline +void +PlEx_impl(qid_t qid) +{ PlTerm_term_t ex(PL_exception(qid)); + if ( ex.not_null() ) + { // The error(resource_error(stack), _) exception is special because + // nothing can be put on the stack, so all we can do is report failure + // to the Prolog engine, which will take care of things. + // This means, of course, that a user catch(PlException&) won't catch + // this particular exception. + if ( ex_is_resource_error(ex) ) + throw PlExceptionFail(); + const PlException ex2(ex); + Plx_clear_exception(); // See https://swi-prolog.discourse.group/t/cpp2-exceptions/6040/66 + throw ex2; + } else + { // TODO: get the name of the PL_...() function that caused the problem: + throw PlUnknownError("Non-zero return code without exception"); + } +} + + +_SWI_CPP2_CPP_inline +const std::string +PlTerm::get_nchars(unsigned int flags) const +{ if ( is_null() ) + return ""; + PlStringBuffers _string_buffers; + char *s; + size_t len; + if ( ! (flags&BUF_MALLOC) ) + flags |= BUF_STACK; + PlEx(get_nchars(&len, &s, flags|CVT_EXCEPTION)); + if ( flags&BUF_MALLOC ) + { std::string result(s, len); + Plx_free(s); + return result; + } + return std::string(s, len); +} + + +_SWI_CPP2_CPP_inline +PlModule +PlContext() +{ return PlModule(Plx_context()); +} + +_SWI_CPP2_CPP_inline +PlException +PlGeneralError(PlTerm inside) +{ return PlException(PlCompound("error", PlTermv(inside, PlTerm_var()))); +} + +_SWI_CPP2_CPP_inline +PlException +PlTypeError(const char *expected, const PlTerm& actual) +{ // See PL_type_error() + return PlGeneralError(PlCompound("type_error", + PlTermv(PlTerm_atom(expected), actual))); +} + +_SWI_CPP2_CPP_inline +PlException +PlDomainError(const char *expected, const PlTerm& actual) +{ // See PL_domain_error() + return PlGeneralError(PlCompound("domain_error", + PlTermv(PlTerm_atom(expected), actual))); +} + +_SWI_CPP2_CPP_inline +PlException +PlDomainError(const PlTerm& expected, const PlTerm& actual) +{ // See PL_domain_error() + // This is used by + // PlDomainError(PlCompound("argv", PlTermv(PlTerm_integer(size_))), ...) + // for an out-of-bounds indexing error + return PlGeneralError(PlCompound("domain_error", + PlTermv(expected, actual))); +} + +_SWI_CPP2_CPP_inline +PlException +PlInstantiationError(const PlTerm& t) +{ // See PL_instantiation_error() + return PlGeneralError(PlCompound("instantiation_error", PlTermv(t))); +} + +_SWI_CPP2_CPP_inline +PlException +PlUninstantiationError(const PlTerm& t) +{ // See PL_uninstantiation_error() + return PlGeneralError(PlCompound("uninstantiation_error", PlTermv(t))); +} + +_SWI_CPP2_CPP_inline +PlException +PlRepresentationError(const char *resource) +{ // See PL_representation_error() + return PlGeneralError(PlCompound("representation_error", PlTermv(PlAtom(resource)))); + +} + +_SWI_CPP2_CPP_inline +PlException +PlExistenceError(const char *type, PlTerm actual) +{ // See PL_existence_error() + return PlGeneralError(PlCompound("existence_error", + PlTermv(PlTerm_atom(type), actual))); +} + +_SWI_CPP2_CPP_inline +PlException +PlPermissionError(const char *op, const char *type, const PlTerm& obj) +{ // See: Use PL_permission_error() + return PlGeneralError(PlCompound("permission_error", + PlTermv(PlTerm_atom(op), PlTerm_atom(type), obj))); +} + +_SWI_CPP2_CPP_inline +PlException +PlResourceError(const char *resource) +{ // See PL_resource_error() + return PlGeneralError(PlCompound("resource_error", + PlTermv(PlTerm_atom(resource)))); +} + +_SWI_CPP2_CPP_inline +PlException +PlUnknownError(const char *description) +{ // For PlWrap() + return PlGeneralError(PlCompound("unknown_error", + PlTermv(PlTerm_atom(description)))); +} + + + + + /******************************* + * ATOM IMPLEMENTATION * + *******************************/ + +_SWI_CPP2_CPP_inline +const std::wstring +PlAtom::as_wstring() const +{ PlStringBuffers _string_buffers; + size_t len; + const wchar_t *s = Plx_atom_wchars(C_, &len); + return std::wstring(s, len); +} + + + /******************************* + * TERM (BODY) * + *******************************/ + + /* PlTerm --> C */ + +_SWI_CPP2_CPP_inline +PlTerm +PlTerm::copy_term_ref() const +{ PlTerm_term_t t(Plx_copy_term_ref(C_)); + return t; +} + +_SWI_CPP2_CPP_inline +const std::string +PlTerm::as_string(PlEncoding enc) const +{ return get_nchars(CVT_ALL|CVT_WRITEQ|static_cast(enc)); +} + +_SWI_CPP2_CPP_inline +const std::wstring +PlTerm::as_wstring() const +{ wchar_t *s; + size_t len; + PlStringBuffers _string_buffers; + // TODO: split out get_wchars(), similar to get_nchars() + PlEx(get_wchars(&len, &s, CVT_ALL|CVT_WRITEQ|BUF_STACK|CVT_EXCEPTION)); + return std::wstring(s, len); +} + +_SWI_CPP2_CPP_inline +void +PlTerm::as_nil() const +{ get_nil_ex(); +} + +_SWI_CPP2_CPP_inline +double +PlTerm::as_float() const +{ double v; + get_float_ex(&v); + return v; +} + +_SWI_CPP2_CPP_inline +PlAtom +PlTerm::as_atom() const +{ PlAtom v(PlAtom::null); + get_atom_ex(&v); + return v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::eq_if_atom(PlAtom a) const +{ PlAtom v(PlAtom::null); + return get_atom(&v) && v == a; +} + +_SWI_CPP2_CPP_inline +void * +PlTerm::as_pointer() const +{ void *ptr; + get_pointer_ex(&ptr); + return ptr; +} + +_SWI_CPP2_CPP_inline +PlRecordRaw +PlTerm::record_raw() const +{ PlRecordRaw rec(*this); + return rec; +} + + + /******************************* + * LISTS * + *******************************/ + +_SWI_CPP2_CPP_inline +PlTerm_tail::PlTerm_tail(const PlTerm& l) +{ if ( l.is_variable() || l.is_list() ) + C_ = l.copy_term_ref().C_; + else + throw PlTypeError("list", l); +} + +_SWI_CPP2_CPP_inline +bool +PlTerm_tail::append(PlTerm e) +{ PlTerm_var tmp; + if ( unify_list(tmp, *this) && + tmp.unify_term(e) ) + { tmp.reset_term_refs(); + return true; + } + + return false; +} + +_SWI_CPP2_CPP_inline +bool PlTerm_tail::next(PlTerm& t) +{ if ( Plx_get_list(C_, t.C_, C_) ) + return true; + + if ( get_nil() ) + return false; + + throw PlTypeError("list", *this); +} + +_SWI_CPP2_CPP_inline +bool +PlRewindOnFail(std::function f) +{ PlFrame frame; + bool rc = f(); + if ( !rc ) + frame.rewind(); + return rc; +} + +_SWI_CPP2_CPP_inline +PlQuery +PlCurrentQuery() +{ return PlQuery(Plx_current_query()); +} + +_SWI_CPP2_CPP_inline +int +PlCall(const std::string& predicate, const PlTermv& args, int flags /* = PL_Q_PASS_EXCEPTION */ ) +{ PlQuery q(predicate, args, flags); + return q.next_solution(); +} + +_SWI_CPP2_CPP_inline +int +PlCall(const std::string& module, const std::string& predicate, const PlTermv& args, int flags /* = PL_Q_PASS_EXCEPTION */ ) +{ PlQuery q(module, predicate, args, flags); + return q.next_solution(); +} + +_SWI_CPP2_CPP_inline +int +PlCall(const std::string& goal, int flags /* = PL_Q_PASS_EXCEPTION */ ) +{ PlQuery q("call", PlTermv(PlCompound(goal)), flags); + return q.next_solution(); +} + +_SWI_CPP2_CPP_inline +int +PlCall(const std::wstring& goal, int flags /* = PL_Q_PASS_EXCEPTION */) +{ PlQuery q("call", PlTermv(PlCompound(goal)), flags); + return q.next_solution(); +} + +_SWI_CPP2_CPP_inline +int +PlCall(PlTerm goal, int flags /* = PL_Q_PASS_EXCEPTION */ ) +{ PlQuery q("call", PlTermv(goal), flags); + return q.next_solution(); +} + + + + /* compounds */ + +_SWI_CPP2_CPP_inline +PlTerm +PlTerm::operator [](size_t index) const +{ PlTerm t; + + if ( Plx_get_arg(index, C_, t.C_) ) + return t; + + if ( !is_compound() ) + throw PlTypeError("compound", *this); + + /* Construct error term and throw it */ + Plx_put_uint64(t.C_, index); + if ( index < 1 ) + throw PlDomainError("not_less_than_zero", t); + else + throw PlDomainError("arity", t); /* TODO: arity(t.C_) - see PlTermv::operator[] */ +} + +_SWI_CPP2_CPP_inline +size_t +PlTerm::arity() const +{ PlAtom name(PlAtom::null); + size_t arity; + if ( get_name_arity(&name, &arity) ) + return arity; + throw PlTypeError("compound", *this); +} + +_SWI_CPP2_CPP_inline +PlAtom +PlTerm::name() const +{ atom_t name; + size_t arity; + if ( Plx_get_name_arity(C_, &name, &arity) ) + return PlAtom(name); + throw PlTypeError("compound", *this); +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::name_arity(PlAtom *name, size_t *arity) const +{ atom_t name_a; + if ( Plx_get_name_arity(C_, &name_a, arity) ) + { if ( name ) + *name = PlAtom(name_a); + return true; + } + return false; +} + + + + /* comparison */ + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator ==(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 == v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator !=(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 != v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator <(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 < v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator >(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 > v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator <=(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 <= v; +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::operator >=(int64_t v) const +{ int64_t v0; + get_int64_ex(&v0); + return v0 >= v; +} + + /* comparison (string) */ + +_SWI_CPP2_CPP_inline +bool +PlTerm::eq(const char *s) const +{ char *s0; + + if ( get_chars(&s0, CVT_ALL) ) + return strcmp(s0, s) == 0; + + throw PlTypeError("text", *this); +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::eq(const wchar_t *s) const +{ wchar_t *s0; + + if ( Plx_get_wchars(C_, nullptr, &s0, CVT_ALL) ) + return wcscmp(s0, s) == 0; + + throw PlTypeError("text", *this); +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::eq(const std::string& s) const +{ char *s0; + + if ( get_chars(&s0, CVT_ALL) ) + return s.compare(s0) == 0; // Doesn't handle non-NUL terminated - but it's a deprecated method + + throw PlTypeError("text", *this); +} + +_SWI_CPP2_CPP_inline +bool +PlTerm::eq(const PlAtom& a) const +{ atom_t v; + + if ( Plx_get_atom(C_, &v) ) + return v == a.C_; + + throw PlTypeError("atom", *this); +} + + + /******************************* + * COMPOUND (BODY) * + *******************************/ + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const wchar_t *text) +{ term_t t = Plx_new_term_ref(); + if ( !Plx_wchars_to_term(text, t) ) + throw PlException(PlTerm_term_t(PlTerm_term_t(t))); + Plx_put_term(C_, t); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const std::string& text, PlEncoding enc) +{ term_t t = Plx_new_term_ref(); + PlEx(t != (term_t)0); + + // TODO: PL_put_term_from_chars() should take an unsigned int flags + PlEx(Plx_put_term_from_chars(t, static_cast(enc)|CVT_EXCEPTION, text.size(), text.data())); + Plx_put_term(C_, t); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const std::wstring& text) +{ term_t t = Plx_new_term_ref(); + PlEx(t != (term_t)0); + + // TODO: what is wchar_t equivalent of PL_put_term_from_chars()? + if ( !Plx_wchars_to_term(text.c_str(), t) ) // TODO: use text.size() + throw PlException(PlTerm_term_t(PlTerm_term_t(t))); + Plx_put_term(C_, t); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const char *functor, const PlTermv& args) +{ functor_t f = Plx_new_functor(Plx_new_atom(functor), args.size()); + PlEx(f != (functor_t)0); + Plx_cons_functor_v(C_, f, args.termv()); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const wchar_t *functor, const PlTermv& args) +{ functor_t f = Plx_new_functor(Plx_new_atom_wchars(wcslen(functor), functor), args.size()); + PlEx(f != (functor_t)0); + Plx_cons_functor_v(C_, f, args.termv()); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const std::string& functor, const PlTermv& args) +{ functor_t f = Plx_new_functor(Plx_new_atom_nchars(functor.size(), functor.data()), args.size()); + Plx_cons_functor_v(C_, f, args.termv()); +} + +_SWI_CPP2_CPP_inline +PlCompound::PlCompound(const std::wstring& functor, const PlTermv& args) +{ functor_t f = Plx_new_functor(Plx_new_atom_wchars(functor.size(), functor.data()), args.size()); + Plx_cons_functor_v(C_, f, args.termv()); +} + + /******************************* + * TERMV (BODY) * + *******************************/ + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlAtom& a) + : size_(1), + a0_(PlTerm_atom(a).C_) +{ PlEx(a0_ != (term_t)0); +} + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlTerm& m0) + : size_(1), + a0_(m0.C_) +{ // Assume that m0 is valid +} + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1) + : size_(2), + a0_(Plx_new_term_refs(2)) +{ PlEx(a0_ != (term_t)0); + Plx_put_term(a0_+0, m0.C_); + Plx_put_term(a0_+1, m1.C_); +} + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2) + : size_(3), + a0_(Plx_new_term_refs(3)) +{ PlEx(a0_ != (term_t)0); + Plx_put_term(a0_+0, m0.C_); + Plx_put_term(a0_+1, m1.C_); + Plx_put_term(a0_+2, m2.C_); +} + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2, const PlTerm& m3) + : size_(4), + a0_(Plx_new_term_refs(4)) +{ PlEx(a0_ != (term_t)0); + Plx_put_term(a0_+0, m0.C_); + Plx_put_term(a0_+1, m1.C_); + Plx_put_term(a0_+2, m2.C_); + Plx_put_term(a0_+3, m3.C_); +} + +_SWI_CPP2_CPP_inline +PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2, + const PlTerm& m3, const PlTerm& m4) + : size_(5), + a0_(Plx_new_term_refs(5)) +{ PlEx(a0_ != (term_t)0); + Plx_put_term(a0_+0, m0.C_); + Plx_put_term(a0_+1, m1.C_); + Plx_put_term(a0_+2, m2.C_); + Plx_put_term(a0_+3, m3.C_); + Plx_put_term(a0_+4, m4.C_); +} + +_SWI_CPP2_CPP_inline +PlTerm +PlTermv::operator [](size_t n) const +{ if ( n >= size_ ) + throw PlDomainError(PlCompound("argv", + PlTermv(PlTerm_integer(size_))), + PlTerm_integer(n)); + + return PlTerm_term_t(a0_+n); +} + + + /******************************* + * EXCEPTIONS (BODY) * + *******************************/ + +_SWI_CPP2_CPP_inline +PlTerm +PlException::string_term() const +{ PlFrame fr; + // Note that the result is a *term*, so it's unencoded (wchar_t + // or equivalent) and will be encoded when it's output. +// TODO: remove USE_PRINT_MESSAGE code (obsolete) +// - or use with_output_to(string(String), print_message(error, ...)) +#ifdef USE_PRINT_MESSAGE + PlTermv av(2); + PlCheckFail(av[0].unify_term(PlCompound("print_message", + PlTermv("error", term())))); + PlQuery q("$write_on_string", av); + if ( q.next_solution() ) + return av[1]; +#else + // '$messages':message_to_string(error(existence_error(procedure,unknown_predicate/1),context(system:call/1,_)), Str). + // Str = "call/1: Unknown procedure: unknown_predicate/1" + PlTermv av(2); + PlCheckFail(av[0].unify_term(term())); + PlQuery q("$messages", "message_to_string", av); + if ( q.next_solution() ) + return av[1]; +#endif + // TODO: return term_.as_string() + return PlTerm_string("[ERROR: Failed to generate message. Internal error]"); +} + + + /******************************* + * QUERY (BODY) * + *******************************/ + +_SWI_CPP2_CPP_inline +int +PlQuery::next_solution() +{ int rval = PL_next_solution(C_); + + if ( flags_ & PL_Q_EXT_STATUS ) + { // values are: + // PL_S_EXCEPTION, PL_S_FALSE PL_S_TRUE PL_S_LAST. PL_S_YIELD: + return rval; + } else + { if ( rval ) + return rval; + } + // If we get here, rval is "false". The user must specifically + // request PL_Q_CATCH_EXCEPTION; otherwise exception_qid() won't + // give an appropriate value. + if ( flags_ & PL_Q_CATCH_EXCEPTION ) + PlEx_impl(exception_qid()); + close_destroy(); + return rval; +} + + +#ifdef O_DEBUG +#include +void PlWrapDebug(const char*msg) { + // Sdprintf("***PlWrapDebug %s\n", msg); + // PL_check_stacks(); +} +#endif + +#endif /*_SWI_CPP2_CPP*/ diff --git a/SWI-cpp2.h b/SWI-cpp2.h index 32654a4..3863ad4 100644 --- a/SWI-cpp2.h +++ b/SWI-cpp2.h @@ -3,7 +3,7 @@ Author: Jan Wielemaker and Peter Ludemann E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (c) 2000-2022, University of Amsterdam + Copyright (c) 2000-2023, University of Amsterdam VU University Amsterdam SWI-Prolog Solutions b.v. All rights reserved. @@ -53,8 +53,8 @@ particularly integer conversions. *********************************************************************/ -#ifndef _SWI_CPP_H -#define _SWI_CPP_H +#ifndef _SWI_CPP2_H +#define _SWI_CPP2_H #include #include @@ -63,6 +63,7 @@ particularly integer conversions. #include #include #include +#include #if INT_MAX != 0x7fffffff #error "Unexpected value for INT_MAX" @@ -88,32 +89,57 @@ particularly integer conversions. class PlAtom; class PlTerm; class PlTermv; +class PlRecordRaw; +class PlRecordExternalCopy; -// A pseudo-exception for quick exist on failure, for use by the unify -// methods. This is special-cased in the PREDICATE et al macros. -// Note that it is *not* a subclass of PlException. See the -// documentation for more details on how this works with returning -// Prolog failure and returning exceptions. -class PlFail +// PlFail is a pseudo-exception for quick exist on failure, for use by +// the PlTerm::unify methods and PlQuery::next_solution(). This is +// special-cased in the PREDICATE et al macros. Note that it is *not* +// a subclass of PlException. See the documentation for more details +// on how this works with returning Prolog failure and returning +// exceptions. +class PlFail : public std::exception { public: explicit PlFail() {} + + virtual const char* what() const throw() override + { return "PlFail"; + } }; +// PlExceptionFail is a variant of PlFail, for when a resource error +// happens and we can't use PlException (because we're out of resources +// and therefore can't create any more terms). +class PlExceptionFail : public std::exception +{ +public: + explicit PlExceptionFail() {} + + virtual const char* what() const throw() override + { return "PlExceptionFail"; + } +}; + + +// Check the return code; if there's a Prolog exception, throw +// PlException else return the rc. If the rc is FALSE (e.g., from +// PL_unify_*() or PL_next_solution(), that rc is returned; you might +// wish to wrap the call in PlCheckFail(). +template [[nodiscard]] C_t PlWrap(C_t rc, qid_t qid = 0); + +// As PlWrap, but always throw an exception for non-zero rc. +// This is for functions that report errors but don't have an +// indication of "fail" - that is, almost everything except for +// functions like PL_unify_*() or PL_next_solution(). +template void PlEx(C_T rc, qid_t qid = 0); + +// Check the return code: if "false", throw PlFail. +inline void PlCheckFail(bool rc); + +#include "SWI-cpp2-plx.h" -// Throw PlFail on failure or exception. This exception is caught by -// the PREDICATE, which simply returns false ... if the failure was -// caused by an exception, SWI-Prolog will detect that and turn the -// failure into a Prolog exception. Therefore, there is no need for -// calling PL_exception(0) and doing something different if there is -// a pending Prolog exception (to call PL_exception(0), use -// PlException_qid()). -inline void -PlCheck(int rc) -{ if ( !rc ) - throw PlFail(); -} /******************************* @@ -128,13 +154,21 @@ template class WrappedC static constexpr C_t null = 0; bool is_null() const { return C_ == null; } bool not_null() const { return C_ != null; } - void verify() const; // Throw exception if is_null() + void set_null() { C_ = null; } explicit WrappedC(C_t v) : C_(v) { } - WrappedC(const WrappedC&) = default; - // WrappedC& operator =(const WrappedC&) = default; // deprecated/deleted in PlTerm - operator bool() const = delete; // Use not_null() instead + + WrappedC( const WrappedC&) = default; + WrappedC& operator =(const WrappedC&) = default; + WrappedC( WrappedC&&) = default; + WrappedC& operator =(WrappedC&&) = default; + ~WrappedC() { } + + operator bool() const = delete; // Use not_null(), is_null() instead + bool operator ==(const WrappedC& o) const { return C_ == o.C_; } + bool operator !=(const WrappedC& o) const { return C_ != o.C_; } + // reset() is common with "smart pointers"; wrapped wrapped atom_t, // term_t, etc. aren't "smart" in the same sense, but the objects // they refer to are garbage collected and some care is needed to @@ -147,13 +181,13 @@ template class WrappedC // TODO: #define SWI_DEFAULT_TEXT_ENCODING EncUTF8 // (set outside SWI-cpp2.h, with an appropriate default) // For the various "get/put/unify string" methods: -typedef enum PlEncoding -{ EncLatin1 = REP_ISO_LATIN_1, - EncUTF8 = REP_UTF8, - EncLocale = REP_MB +typedef enum class PlEncoding +{ Latin1 = REP_ISO_LATIN_1, + UTF8 = REP_UTF8, + Locale = REP_MB } PlEncoding; -static constexpr PlEncoding ENC_INPUT = EncLatin1; // TODO: EncUTF8? -static constexpr PlEncoding ENC_OUTPUT = EncLocale; +static constexpr PlEncoding ENC_INPUT = PlEncoding::Latin1; // TODO: EncUTF8? +static constexpr PlEncoding ENC_OUTPUT = PlEncoding::Locale; /******************************* @@ -161,17 +195,17 @@ static constexpr PlEncoding ENC_OUTPUT = EncLocale; *******************************/ class PlStringBuffers -{ +{ // This class depends on the details of PL_STRINGS_MARK() and PL_STRINGS_RELEASE(). private: buf_mark_t __PL_mark; public: explicit PlStringBuffers() - { PL_mark_string_buffers(&__PL_mark); // TODO: modify PL_STRINGS_MARK() to be used here + { Plx_mark_string_buffers(&__PL_mark); } ~PlStringBuffers() - { PL_release_string_buffers_from_mark(__PL_mark); // TODO: modify PL_STRINGS_RELEASE() to be used here + { Plx_release_string_buffers_from_mark(__PL_mark); } }; @@ -180,118 +214,144 @@ class PlStringBuffers * PROLOG CONSTANTS * *******************************/ -class PlFunctor : public WrappedC -{ -public: - PlFunctor(functor_t v) - : WrappedC(v) { } - // PlFunctor(const char*) is handled by std::string constructor - explicit PlFunctor(const std::string& name, size_t arity); - explicit PlFunctor(const std::wstring& name, size_t arity); - - bool operator ==(functor_t to) = delete; - - [[deprecated("use PlPredicate")]] predicate_t pred(module_t m) const { - predicate_t p = PL_pred(C_, m); - if ( p == nullptr ) - throw PlFail(); - return p; - } - - PlAtom name() const; - - size_t arity() const { - return PL_functor_arity(C_); - } -}; - - class PlAtom : public WrappedC { public: explicit PlAtom(atom_t v) : WrappedC(v) { } - explicit PlAtom(const std::string& text) // TODO: add encoding - : WrappedC(PL_new_atom_nchars(text.size(), text.data())) - { verify(); - } + explicit PlAtom(const std::string& text) + : WrappedC(Plx_new_atom_nchars(text.size(), text.data())) + { } explicit PlAtom(const std::wstring& text) - : WrappedC(PL_new_atom_wchars(text.size(), text.data())) - { verify(); - } + : WrappedC(Plx_new_atom_wchars(text.size(), text.data())) + { } explicit PlAtom(const char *text) - : WrappedC(PL_new_atom_nchars(static_cast(-1), text)) - { verify(); - } - - const std::string get_mbchars(unsigned int flags) const + : WrappedC(Plx_new_atom_nchars(static_cast(-1), text)) + { } + explicit PlAtom(PlEncoding rep, size_t len, const char *s) + : WrappedC(Plx_new_atom_mbchars(static_cast(rep), len, s)) + { } + explicit PlAtom(PlEncoding rep, std::string& text) // TODO: rep as optional with default ENC_INPUT + : WrappedC(Plx_new_atom_mbchars(static_cast(rep), text.size(), text.data())) + { } + + const std::string mbchars(unsigned int flags) const { PlStringBuffers _string_buffers; size_t len; char *s; - PlCheck(PL_atom_mbchars(C_, &len, &s, CVT_EXCEPTION|flags)); + Plx_atom_mbchars(C_, &len, &s, CVT_EXCEPTION|flags); return std::string(s, len); } const std::string as_string(PlEncoding enc=ENC_OUTPUT) const - { return get_mbchars(static_cast(enc)); + { return mbchars(static_cast(enc)); } const std::wstring as_wstring() const; - bool operator ==(const char *s) const + // TODO: operator == should be `override` + bool operator ==(const PlAtom& to) const /*override*/ { return C_ == to.C_; } + bool operator !=(const PlAtom& to) const /*override*/ { return C_ != to.C_; } + [[deprecated("use as_string() or ==PlAtom")]] bool operator ==(const char *s) const { return eq(s); } + bool operator ==(const wchar_t *s) const { return eq(s); } + [[deprecated("use as_string() or ==PlAtom")]] bool operator ==(const std::string& s) const { return eq(s); } + bool operator ==(const std::wstring& s) const { return eq(s); } + [[deprecated("use PlAtom instead of atomt_t")]] bool operator ==(atom_t to) const { return C_ == to; } + + [[deprecated("use as_string() or !=PlAtom")]] bool operator !=(const char *s) const { return !eq(s); } + bool operator !=(const wchar_t *s) const { return !eq(s); } + [[deprecated("use PlAtom instead of atom_t")]] bool operator !=(atom_t to) const { return C_ != to; } + + void register_ref() const + { Plx_register_atom(C_); + } + + void unregister_ref() const + { Plx_unregister_atom(C_); + } + + // TODO: replace blob_data() with C++ interface to blobs + void* blob_data(size_t *len, struct PL_blob_t **type) const + { return Plx_blob_data(C_, len, type); + } + +private: + bool eq(const char *s) const // used by deprecated operator == { PlStringBuffers _string_buffers; - return strcmp(s, PL_atom_nchars(C_, nullptr)) == 0; // TODO: use PL_atom_mbchars() or get_mbchars() + return strcmp(s, Plx_atom_nchars(C_, nullptr)) == 0; } - bool operator ==(const wchar_t *s) const + bool eq(const wchar_t *s) const // used by deprecated operator == { PlStringBuffers _string_buffers; - return wcscmp(s, PL_atom_wchars(C_, nullptr)) == 0; + return wcscmp(s, Plx_atom_wchars(C_, nullptr)) == 0; } - bool operator ==(const std::string& s) const + bool eq(const std::string& s) const // used by deprecated operator == { PlStringBuffers _string_buffers; size_t len; - const char* s0 = PL_atom_nchars(C_, &len); // TODO: use PL_atom_mbchars() or get_mbchars() + const char* s0 = Plx_atom_nchars(C_, &len); return std::string(s0, len) == s; } - bool operator ==(const std::wstring& s) const + bool eq(const std::wstring& s) const // used by deprecated operator == { PlStringBuffers _string_buffers; size_t len; - const wchar_t* s0 = PL_atom_wchars(C_, &len); + const wchar_t* s0 = Plx_atom_wchars(C_, &len); return std::wstring(s0, len) == s; } - bool operator ==(const PlAtom &a) const - { return C_ == a.C_; - } - [[deprecated("use PlAtom instead of atomt_t")]] bool operator ==(atom_t to) const - { return C_ == to; - } +}; - bool operator !=(const char *s) const - { return !(*this == s); - } - bool operator !=(const wchar_t *s) const - { return !(*this == s); - } - // TODO: add std::string, std::wstring - bool operator !=(const PlAtom &a) const - { return !(*this == a); - } - [[deprecated("use PlAtom instead of atom_t")]] bool operator !=(atom_t to) const - { return C_ != to; +class PlFunctor : public WrappedC +{ +public: + explicit PlFunctor(functor_t v) + : WrappedC(v) { } + + // PlFunctor(const char*) is handled by std::string constructor + + // TODO: add encoding to string + explicit PlFunctor(const std::string& name, size_t arity) + : WrappedC(null) + { PlAtom a(name); + C_ = Plx_new_functor(a.C_, arity); + Plx_unregister_atom(a.C_); } - void register_ref() const - { PL_register_atom(C_); + explicit PlFunctor(const std::wstring& name, size_t arity) + : WrappedC(null) + { PlAtom a(name); + C_ = Plx_new_functor(a.C_, arity); + Plx_unregister_atom(a.C_); } - void unregister_ref() const - { PL_unregister_atom(C_); + explicit PlFunctor(PlAtom name, size_t arity) + : WrappedC(Plx_new_functor(name.C_, arity)) { } + + [[deprecated("use PlPredicate")]] predicate_t pred(module_t m) const { + predicate_t p = Plx_pred(C_, m); + return p; } - // TODO: replace blob_data() with C++ interface to blobs - void* blob_data(size_t *len, struct PL_blob_t **type) const - { return PL_blob_data(C_, len, type); + PlAtom name() const { return PlAtom(Plx_functor_name(C_)); } + size_t arity() const { return Plx_functor_arity(C_); } +}; + + +class PlModule : public WrappedC +{ +public: + explicit PlModule(module_t m) + : WrappedC(m) { } + explicit PlModule(const std::string& name) + : WrappedC(Plx_new_module(PlAtom(name).C_)) + { } + explicit PlModule(PlAtom name) + : WrappedC(Plx_new_module(name.C_)) + { } + + PlAtom module_name() const + { return PlAtom(Plx_module_name(C_)); } + // TODO: strip_module }; + /******************************* * GENERIC PROLOG TERM * *******************************/ @@ -300,46 +360,119 @@ class PlTerm : public WrappedC { protected: explicit PlTerm() - : WrappedC(PL_new_term_ref()) - { verify(); - } - explicit PlTerm(term_t t) // See PlTerm_term_t for the public constructor - : WrappedC(t) {} - -private: - // Convenience methods for turning a SWI-Prolog exception into a C++ - // "throw". - [[nodiscard]] static bool chkex(int rc); // if failed due to exception, throw exception + : WrappedC(Plx_new_term_ref()) + { } public: - PlTerm(const PlTerm&) = default; explicit PlTerm(const PlAtom& a) - : WrappedC(PL_new_term_ref()) - { verify(); - PlCheck(PL_put_atom(C_, a.C_)); - } - - // PlTerm& operator =(const PlTerm&) = delete; // see below - - int type() const { return PL_term_type(C_); } // PL_VARIABLE, PL_ATOM, etc. - bool is_variable() const { return PL_is_variable(C_); } - bool is_ground() const { return PL_is_ground(C_); } - bool is_atom() const { return PL_is_atom(C_); } - bool is_integer() const { return PL_is_integer(C_); } - bool is_string() const { return PL_is_string(C_); } - bool is_float() const { return PL_is_float(C_); } - bool is_rational() const { return PL_is_rational(C_); } - bool is_compound() const { return PL_is_compound(C_); } - bool is_callable() const { return PL_is_callable(C_); } - bool is_list() const { return PL_is_list(C_); } - bool is_dict() const { return PL_is_dict(C_); } - bool is_pair() const { return PL_is_pair(C_); } - bool is_atomic() const { return PL_is_atomic(C_); } - bool is_number() const { return PL_is_number(C_); } - bool is_acyclic() const { return PL_is_acyclic(C_); } - bool is_functor(const PlFunctor& f) const { return PL_is_functor(C_, f.C_); } - - record_t record() const; + : WrappedC(Plx_new_term_ref()) + { Plx_put_atom(C_, a.C_); + } + + // TODO: why do the copy/move constructors get rid of some warning messages + // about deprecated operator = ? + PlTerm(const PlTerm&) = default; + PlTerm(PlTerm&&) = default; + + // TODO: PlTerm& operator =(const PlTerm&) = delete; // TODO: when the deprecated items below are removed + + [[nodiscard]] bool get_atom(PlAtom *A) const { return Plx_get_atom(C_, &A->C_); } + [[nodiscard]] bool get_bool(int *value) const { return Plx_get_bool(C_, value); } + [[nodiscard]] bool get_chars(char **s, unsigned int flags) const { return Plx_get_chars(C_, s, flags); } + [[nodiscard]] bool get_list_chars(char **s, unsigned int flags) const { return Plx_get_list_chars(C_, s, flags); } + [[nodiscard]] bool get_atom_nchars(size_t *len, char **a) const { return Plx_get_atom_nchars(C_, len, a); } + [[nodiscard]] bool get_list_nchars(size_t *len, char **s, unsigned int flags) const { return Plx_get_list_nchars(C_, len, s, flags); } + [[nodiscard]] bool get_nchars(size_t *len, char **s, unsigned int flags) const { return Plx_get_nchars(C_, len, s, flags); } + [[nodiscard]] bool get_wchars(size_t *length, pl_wchar_t **s, unsigned flags) const { return Plx_get_wchars(C_, length, s, flags); } + [[nodiscard]] bool get_integer(int *i) const { return Plx_get_integer(C_, i); } + [[nodiscard]] bool get_long(long *i) const { return Plx_get_long(C_, i); } + [[nodiscard]] bool get_intptr(intptr_t *i) const { return Plx_get_intptr(C_, i); } + [[nodiscard]] bool get_pointer(void **ptr) const { return Plx_get_pointer(C_, ptr); } + [[nodiscard]] bool get_float(double *f) const { return Plx_get_float(C_, f); } + [[nodiscard]] bool get_functor(PlFunctor *f) const { return Plx_get_functor(C_, &f->C_); } + [[nodiscard]] bool get_name_arity(PlAtom *name, size_t *arity) const { return Plx_get_name_arity(C_, &name->C_, arity); } + [[nodiscard]] bool get_compound_name_arity(PlAtom *name, size_t *arity) const { return Plx_get_compound_name_arity(C_, &name->C_, arity); } + [[nodiscard]] bool get_module(PlModule *module) const { return Plx_get_module(C_, &module->C_); } + [[nodiscard]] bool get_arg(size_t index, PlTerm a) const { return Plx_get_arg(index, C_, a.C_); } + [[nodiscard]] bool get_dict_key(PlAtom key, PlTerm dict, PlTerm value) const { return Plx_get_dict_key(key.C_, dict.C_, value.C_); } + [[nodiscard]] bool get_list(PlTerm h, PlTerm t) const { return Plx_get_list(C_, h.C_, t.C_); } + [[nodiscard]] bool get_head(PlTerm h) const { return Plx_get_head(C_, h.C_); } + [[nodiscard]] bool get_tail(PlTerm t) const { return Plx_get_tail(C_, t.C_); } + // TODO: get_mpz + // TODO: get_mpq + [[nodiscard]] bool get_nil() const { return Plx_get_nil(C_); } + [[nodiscard]] bool get_blob(void **blob, size_t *len, PL_blob_t **type) const { return Plx_get_blob(C_, blob, len, type); } + + [[nodiscard]] bool get_file_name(char **name, int flags) const { return Plx_get_file_name(C_, name, flags); } + [[nodiscard]] bool get_file_nameW(wchar_t **name, int flags) const { return Plx_get_file_nameW(C_, name, flags); } + + [[nodiscard]] bool get_attr(term_t a) const { return Plx_get_attr(C_, a); } + + void get_atom_ex(PlAtom *a) const { Plx_get_atom_ex(C_, &a->C_); } + void get_integer_ex(int *i) const { Plx_get_integer_ex(C_,i); } + void get_long_ex(long *i) const { Plx_get_long_ex(C_, i); } + void get_int64_ex(int64_t *i) const { Plx_get_int64_ex(C_, i); } + void get_uint64_ex(uint64_t *i) const { Plx_get_uint64_ex(C_, i); } + void get_intptr_ex(intptr_t *i) const { Plx_get_intptr_ex(C_, i); } + void get_size_ex(size_t *i) const { Plx_get_size_ex(C_, i); } + void get_bool_ex(int *i) const { Plx_get_bool_ex(C_, i); } + void get_float_ex(double *f) const { Plx_get_float_ex(C_, f); } + void get_char_ex(int *p, int eof) const { Plx_get_char_ex(C_, p, eof); } + void unify_bool_ex(int val) const { Plx_unify_bool_ex(C_, val); } + void get_pointer_ex(void **addrp) const { Plx_get_pointer_ex(C_, addrp); } + void unify_list_ex(PlTerm h, PlTerm t) const { Plx_unify_list_ex(C_, h.C_, t.C_); } + void unify_nil_ex() const { Plx_unify_nil_ex(C_); } + void get_list_ex(PlTerm h, PlTerm t) const { Plx_get_list_ex(C_, h.C_, t.C_); } + void get_nil_ex() const { Plx_get_nil_ex(C_); } + + int type() const { return Plx_term_type(C_); } // PL_VARIABLE, PL_ATOM, etc. + bool is_attvar() const { return Plx_is_attvar(C_); } + bool is_variable() const { return Plx_is_variable(C_); } + bool is_ground() const { return Plx_is_ground(C_); } + bool is_atom() const { return Plx_is_atom(C_); } + bool is_integer() const { return Plx_is_integer(C_); } + bool is_string() const { return Plx_is_string(C_); } + bool is_float() const { return Plx_is_float(C_); } + bool is_rational() const { return Plx_is_rational(C_); } + bool is_compound() const { return Plx_is_compound(C_); } + bool is_callable() const { return Plx_is_callable(C_); } + bool is_list() const { return Plx_is_list(C_); } + bool is_dict() const { return Plx_is_dict(C_); } + bool is_pair() const { return Plx_is_pair(C_); } + bool is_atomic() const { return Plx_is_atomic(C_); } + bool is_number() const { return Plx_is_number(C_); } + bool is_acyclic() const { return Plx_is_acyclic(C_); } + bool is_functor(const PlFunctor& f) const { return Plx_is_functor(C_, f.C_); } + bool is_blob(PL_blob_t **type) const { return Plx_is_blob(C_, type); } + + void put_variable() { Plx_put_variable(C_); } + void put_atom(PlAtom a) { Plx_put_atom(C_, a.C_); } + void put_bool(int val) { Plx_put_bool(C_, val); } + void put_atom_chars(const char *chars) { Plx_put_atom_chars(C_, chars); } + void put_string_chars(const char *chars) { Plx_put_string_chars(C_, chars); } + void put_chars(int flags, size_t len, const char *chars) { Plx_put_chars(C_, flags, len, chars); } + void put_list_chars(const char *chars) { Plx_put_list_chars(C_, chars); } + void put_list_codes(const char *chars) { Plx_put_list_codes(C_, chars); } + void put_atom_nchars(size_t l, const char *chars) { Plx_put_atom_nchars(C_, l, chars); } + void put_string_nchars(size_t len, const char *chars) { Plx_put_string_nchars(C_, len, chars); } + void put_list_nchars(size_t l, const char *chars) { Plx_put_list_nchars(C_, l, chars); } + void put_list_ncodes(size_t l, const char *chars) { Plx_put_list_ncodes(C_, l, chars); } + void put_integer(long i) { Plx_put_integer(C_, i); } + void put_pointer(void *ptr) { Plx_put_pointer(C_, ptr); } + void put_float(double f) { Plx_put_float(C_, f); } + void put_functor(PlFunctor functor) { Plx_put_functor(C_, functor.C_); } + void put_list() { Plx_put_list(C_); } + void put_nil() { Plx_put_nil(C_); } + void put_term(PlTerm t2) { Plx_put_term(C_, t2.C_); } + // TODO: PL_put_dict(term_t t, atom_t tag, size_t len, const atom_t *keys, term_t values) + // TODO: PL_cons_functor(term_t h, functor_t f, ...) + // TODO: PL_cons_functor_v(term_t h, functor_t fd, term_t a0) + // TODO: PL_cons_list(term_t l, term_t h, term_t t) + void put_blob( void *blob, size_t len, PL_blob_t *type) { Plx_put_blob(C_, blob, len, type); } + + // TODO: PL_unify_*()? + // TODO: PL_skip_list() + PlRecordRaw record_raw() const; /* PlTerm --> C */ [[deprecated("use as_long()")]] explicit operator long() const { return as_long(); } @@ -353,25 +486,25 @@ class PlTerm : public WrappedC // No need for overloading int64_t, size_t, etc.; these are defined // by the compiler in terms of one of the types below. // TODO: add wchar_t, char16_t, char32_t - void integer(bool *v) const { int v0; PlCheck(PL_cvt_i_bool(C_, &v0)); *v = v0; } - void integer(char *v) const { PlCheck(PL_cvt_i_char( C_, v)); } - void integer(int *v) const { PlCheck(PL_cvt_i_int( C_, v)); } - void integer(long *v) const { PlCheck(PL_cvt_i_long( C_, v)); } - void integer(long long *v) const { PlCheck(PL_cvt_i_llong( C_, v)); } - void integer(short *v) const { PlCheck(PL_cvt_i_short( C_, v)); } - void integer(signed char *v) const { PlCheck(PL_cvt_i_schar( C_, v)); } - void integer(unsigned char *v) const { PlCheck(PL_cvt_i_uchar( C_, v)); } - void integer(unsigned int *v) const { PlCheck(PL_cvt_i_uint( C_, v)); } - void integer(unsigned long *v) const { PlCheck(PL_cvt_i_ulong( C_, v)); } - void integer(unsigned long long *v) const { PlCheck(PL_cvt_i_ullong(C_, v)); } - void integer(unsigned short *v) const { PlCheck(PL_cvt_i_ushort(C_, v)); } + void integer(bool *v) const { int v0; Plx_cvt_i_bool(C_, &v0); *v = v0; } + void integer(char *v) const { Plx_cvt_i_char( C_, v); } + void integer(int *v) const { Plx_cvt_i_int( C_, v); } + void integer(long *v) const { Plx_cvt_i_long( C_, v); } + void integer(long long *v) const { Plx_cvt_i_llong( C_, v); } + void integer(short *v) const { Plx_cvt_i_short( C_, v); } + void integer(signed char *v) const { Plx_cvt_i_schar( C_, v); } + void integer(unsigned char *v) const { Plx_cvt_i_uchar( C_, v); } + void integer(unsigned int *v) const { Plx_cvt_i_uint( C_, v); } + void integer(unsigned long *v) const { Plx_cvt_i_ulong( C_, v); } + void integer(unsigned long long *v) const { Plx_cvt_i_ullong(C_, v); } + void integer(unsigned short *v) const { Plx_cvt_i_ushort(C_, v); } // All the conversion functions throw a PlTypeError exception if // they fail (because of the wrong Prolog type). If you want to be // safe, use is_XXX() first to verify the type. - std::string as_string(PlEncoding enc=ENC_OUTPUT) const; - std::wstring as_wstring() const; + const std::string as_string(PlEncoding enc=ENC_OUTPUT) const; + const std::wstring as_wstring() const; long as_long() const { long v; integer(&v); return v; } int32_t as_int32_t() const { int32_t v; integer(&v); return v; } uint32_t as_uint32_t() const { uint32_t v; integer(&v); return v; } @@ -389,35 +522,19 @@ class PlTerm : public WrappedC // TODO: PL_get_mpz(), PL_getr_mpq() - std::string get_nchars(unsigned int flags) const - { PlStringBuffers _string_buffers; - char *s; - size_t len; - PlCheck(PL_get_nchars(C_, &len, &s, flags|CVT_EXCEPTION)); - return std::string(s, len); - } + const std::string get_nchars(unsigned int flags) const; + // TODO: std::wstring get_wchars(unsigned int flags) const; PlAtom as_atom() const; - [[nodiscard]] bool get_if_atom(PlAtom *a) const - { atom_t v; - if (PL_get_atom(C_, &v) ) - { *a = PlAtom(v); - return true; - } - return false; - } + [[nodiscard]] bool eq_if_atom(PlAtom a) const; /* Compounds */ PlTerm operator [](size_t index) const; size_t arity() const; // throws PlTypeError if not a "compound" or atom PlAtom name() const; // throws PlTypeError if not a "compound" or atom [[nodiscard]] bool name_arity(PlAtom *name, size_t *arity) const; // name and/or arity can be nullptr - PlTerm copy_term_ref() const - { PlTerm t(PL_copy_term_ref(C_)); - t.verify(); - return t; - } + [[nodiscard]] PlTerm copy_term_ref() const; // The assignment operators from version 1 have been removed because // of possible confusion with the standard assignment and copy @@ -427,7 +544,6 @@ class PlTerm : public WrappedC // with implicit or explicit cast from, e.g. PlAtom to PlTerm /* UNIFY */ - // TODO: handle encoding for char*, std::string [[deprecated("use unify_*()")]] [[nodiscard]] bool operator =(const PlTerm& t2) const { return unify_term(t2); } [[deprecated("use unify_*()")]] [[nodiscard]] bool operator =(const PlAtom& a) const { return unify_atom(a); } [[deprecated("use unify_*()")]] [[nodiscard]] bool operator =(const char *v) const { return unify_atom(v); } @@ -438,96 +554,104 @@ class PlTerm : public WrappedC // All the unify_*() methods check for an exception (and throw), so // the return code is whether the unification succeeded or not. - // TODO: replace PL_unify_*() with PL_unify_chars() and flags, where appropriate - // TODO: handle encodings for char*, std::string - [[nodiscard]] bool unify_term(const PlTerm& t2) const { return chkex(PL_unify(C_, t2.C_)); } - [[nodiscard]] bool unify_atom(const PlAtom& a) const { return chkex(PL_unify_atom(C_, a.C_)); } - [[nodiscard]] bool unify_chars(int flags, size_t len, const char *s) const { return chkex(PL_unify_chars(C_, flags, len, s)); } - [[nodiscard]] bool unify_chars(int flags, const std::string& s) const { return chkex(PL_unify_chars(C_, flags, s.size(), s.data())); } - [[nodiscard]] bool unify_atom(const char* v) const { return chkex(PL_unify_atom_chars(C_, v)); } - [[nodiscard]] bool unify_atom(const wchar_t* v) const { return chkex(PL_unify_wchars(C_, PL_ATOM, static_cast(-1), v)); } - [[nodiscard]] bool unify_atom(const std::string& v) const { return chkex(PL_unify_atom_nchars(C_, v.size(), v.data())); } - [[nodiscard]] bool unify_atom(const std::wstring& v) const { return chkex(PL_unify_wchars(C_, PL_ATOM, v.size(), v.data())); } - [[nodiscard]] bool unify_list_codes(const char* v) const { return chkex(PL_unify_list_codes(C_, v)); } // TODO: [[deprecated]] - [[nodiscard]] bool unify_list_chars(const char* v) const { return chkex(PL_unify_list_chars(C_, v)); } // TODO: [[deprecated]] + // TODO: replace PL_unify_*() with PL_unify_string() and flags, where appropriate + // TODO: encodings for char*, std::string + [[nodiscard]] bool unify_term(const PlTerm& t2) const { return Plx_unify(C_, t2.C_); } + [[nodiscard]] bool unify_atom(const PlAtom& a) const { return Plx_unify_atom(C_, a.C_); } + [[nodiscard]] bool unify_chars(int flags, size_t len, const char *s) const { return Plx_unify_chars(C_, flags, len, s); } + [[nodiscard]] bool unify_chars(int flags, const std::string& s) const { return Plx_unify_chars(C_, flags, s.size(), s.data()); } + [[nodiscard]] bool unify_atom(const char* v) const { return Plx_unify_atom_chars(C_, v); } + [[nodiscard]] bool unify_atom(const wchar_t* v) const { return Plx_unify_wchars(C_, PL_ATOM, static_cast(-1), v); } + [[nodiscard]] bool unify_atom(const std::string& v) const { return Plx_unify_atom_nchars(C_, v.size(), v.data()); } + [[nodiscard]] bool unify_atom(const std::wstring& v) const { return Plx_unify_wchars(C_, PL_ATOM, v.size(), v.data()); } + [[nodiscard]] bool unify_list_codes(const char* v) const { return Plx_unify_list_codes(C_, v); } // TODO: [[deprecated]] + [[nodiscard]] bool unify_list_chars(const char* v) const { return Plx_unify_list_chars(C_, v); } // TODO: [[deprecated]] // See comment with PlTerm::integer() about the overloading. - [[nodiscard]] bool unify_integer(bool v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(char v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(int v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(long v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(long long v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(short v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(signed char v) const { return chkex(PL_unify_int64(C_, v)); } - [[nodiscard]] bool unify_integer(unsigned char v) const { return chkex(PL_unify_uint64(C_, v)); } - [[nodiscard]] bool unify_integer(unsigned int v) const { return chkex(PL_unify_uint64(C_, v)); } - [[nodiscard]] bool unify_integer(unsigned long v) const { return chkex(PL_unify_uint64(C_, v)); } - [[nodiscard]] bool unify_integer(unsigned long long v) const { return chkex(PL_unify_uint64(C_, v)); } - [[nodiscard]] bool unify_integer(unsigned short v) const { return chkex(PL_unify_uint64(C_, v)); } - [[nodiscard]] bool unify_float(double v) const { return chkex(PL_unify_float(C_, v)); } - [[nodiscard]] bool unify_string(const std::string& v) const { return chkex(PL_unify_string_nchars(C_, v.size(), v.data())); } - [[nodiscard]] bool unify_string(const std::wstring& v) const { return chkex(PL_unify_wchars(C_, PL_STRING, v.size(), v.data())); } - [[nodiscard]] bool unify_functor(const PlFunctor& f) const { return chkex(PL_unify_functor(C_, f.C_)); } - [[nodiscard]] bool unify_pointer(void *ptr) const { return chkex(PL_unify_pointer(C_, ptr)); } // TODO: replace with C++ interface to blobs - [[nodiscard]] bool unify_nil() const { return chkex(PL_unify_nil(C_)); } - [[nodiscard]] bool unify_nil_ex() const { return chkex(PL_unify_nil_ex(C_)); } - [[nodiscard]] bool unify_list(PlTerm h, PlTerm t) const { return chkex(PL_unify_list(C_, h.C_, t.C_)); } - [[nodiscard]] bool unify_list_ex(PlTerm h, PlTerm t) const { return chkex(PL_unify_list_ex(C_, h.C_, t.C_)); } - [[nodiscard]] bool unify_bool(bool val) const { return chkex(PL_unify_bool(C_, val)); } - [[nodiscard]] bool unify_bool_ex(bool val) const { return chkex(PL_unify_bool_ex(C_, val)); } - [[nodiscard]] bool unify_blob(void *blob, size_t len, PL_blob_t *type) const { return chkex(PL_unify_blob(C_, blob, len, type)); } - - // TODO: handle PL_unify_mpz(), PL_unify_mpq() + [[nodiscard]] bool unify_integer(bool v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(char v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(int v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(long v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(long long v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(short v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(signed char v) const { return Plx_unify_int64(C_, v); } + [[nodiscard]] bool unify_integer(unsigned char v) const { return Plx_unify_uint64(C_, v); } + [[nodiscard]] bool unify_integer(unsigned int v) const { return Plx_unify_uint64(C_, v); } + [[nodiscard]] bool unify_integer(unsigned long v) const { return Plx_unify_uint64(C_, v); } + [[nodiscard]] bool unify_integer(unsigned long long v) const { return Plx_unify_uint64(C_, v); } + [[nodiscard]] bool unify_integer(unsigned short v) const { return Plx_unify_uint64(C_, v); } + [[nodiscard]] bool unify_float(double v) const { return Plx_unify_float(C_, v); } + [[nodiscard]] bool unify_string(const std::string& v) const { return Plx_unify_string_nchars(C_, v.size(), v.data()); } + [[nodiscard]] bool unify_string(const std::wstring& v) const { return Plx_unify_wchars(C_, PL_STRING, v.size(), v.data()); } + [[nodiscard]] bool unify_functor(const PlFunctor& f) const { return Plx_unify_functor(C_, f.C_); } + [[nodiscard]] bool unify_pointer(void *ptr) const { return Plx_unify_pointer(C_, ptr); } // TODO: replace with C++ interface to blobs + [[nodiscard]] bool unify_nil() const { return Plx_unify_nil(C_); } + [[nodiscard]] bool unify_list(PlTerm h, PlTerm t) const { return Plx_unify_list(C_, h.C_, t.C_); } + [[nodiscard]] bool unify_bool(bool val) const { return Plx_unify_bool(C_, val); } + [[nodiscard]] bool unify_blob(void *blob, size_t len, PL_blob_t *type) const { return Plx_unify_blob(C_, blob, len, type); } + + // TODO: PL_unify_mpz(), PL_unify_mpq() /* Comparison standard order terms */ - [[nodiscard]] int compare(const PlTerm& t2) const { return PL_compare(C_, t2.C_); } - bool operator == (const PlTerm& t2) const { return compare(t2) == 0; } - bool operator != (const PlTerm& t2) const { return compare(t2) != 0; } - bool operator < (const PlTerm& t2) const { return compare(t2) < 0; } - bool operator > (const PlTerm& t2) const { return compare(t2) > 0; } - bool operator <= (const PlTerm& t2) const { return compare(t2) <= 0; } - bool operator >= (const PlTerm& t2) const { return compare(t2) >= 0; } + [[nodiscard]] int compare(const PlTerm& t2) const { return Plx_compare(C_, t2.C_); } + // TODO: operator == should be `override` + bool operator ==(const PlTerm& t2) const /*override*/ { return compare(t2) == 0; } + bool operator !=(const PlTerm& t2) const /*override*/ { return compare(t2) != 0; } + bool operator < (const PlTerm& t2) const { return compare(t2) < 0; } + bool operator > (const PlTerm& t2) const { return compare(t2) > 0; } + bool operator <=(const PlTerm& t2) const { return compare(t2) <= 0; } + bool operator >=(const PlTerm& t2) const { return compare(t2) >= 0; } /* comparison (long) */ /* TODO: uint64_t; but that requires adding a lot of overloaded methods */ - bool operator == (int64_t v) const; - bool operator != (int64_t v) const; - bool operator < (int64_t v) const; - bool operator > (int64_t v) const; - bool operator <= (int64_t v) const; - bool operator >= (int64_t v) const; + bool operator ==(int64_t v) const; + bool operator !=(int64_t v) const; + bool operator < (int64_t v) const; + bool operator > (int64_t v) const; + bool operator <=(int64_t v) const; + bool operator >=(int64_t v) const; /* comparison (atom, string) */ - // TODO: deprecate comparison with char*s, std::string, etc. and instead - // make a new method that includes the encoding. For now, these - // are safe only with ASCII (EncLatin1): - bool operator ==(const char *s) const; - bool operator ==(const wchar_t *s) const; - bool operator ==(const std::string& s) const; - bool operator ==(const std::wstring& s) const; - bool operator ==(const PlAtom& a) const; - - bool operator !=(const char *s) const { return !(*this == s); } - bool operator !=(const wchar_t *s) const { return !(*this == s); } - bool operator !=(const std::string& s) const { return !(*this == s); } - bool operator !=(const std::wstring& s) const { return !(*this == s); } - bool operator !=(const PlAtom& a) const { return !(*this == a); } + [[deprecated("use as_string()")]] bool operator ==(const char *s) const { return eq(s); } + [[deprecated("use as_string()")]] bool operator ==(const wchar_t *s) const { return eq(s); } + [[deprecated("use as_string()")]] bool operator ==(const std::string& s) const { return eq(s); } + bool operator ==(const std::wstring& s) const { return eq(s); } + bool operator ==(const PlAtom& a) const { return eq(a); } + + [[deprecated("use as_string()")]] bool operator !=(const char *s) const { return !eq(s); } + bool operator !=(const wchar_t *s) const { return !(eq(s)); } + [[deprecated("use as_string()")]] bool operator !=(const std::string& s) const { return !eq(s); } + bool operator !=(const std::wstring& s) const { return !eq(s); } + bool operator !=(const PlAtom& a) const { return !eq(a); } // E.g.: t.write(Serror, 1200, PL_WRT_NEWLINE|PL_WRT_QUOTED); - void write(IOSTREAM *s, int precedence, int flags) const { PlCheck(PL_write_term(s, C_, precedence, flags)); } + void write(IOSTREAM *s, int precedence, int flags) const { Plx_write_term(s, C_, precedence, flags); } + + void reset_term_refs() { Plx_reset_term_refs(C_); } + +protected: + explicit PlTerm(term_t t) // See PlTerm_term_t for a better constructor + : WrappedC(t) + { } + +private: + bool eq(const char *s) const; + bool eq(const wchar_t *s) const; + bool eq(const std::string& s) const; + bool eq(const std::wstring& s) const; + bool eq(const PlAtom& a) const; }; class PlTerm_atom : public PlTerm { public: - // TODO: Use the fact that PL_put_atom() always returns true // TODO: Add encoding for char*, std::string. - // For now, these are safe only with ASCII (EncLatin1): - explicit PlTerm_atom(atom_t a) { PlCheck(PL_put_atom(C_, a)); } - explicit PlTerm_atom(const PlAtom& a) { PlCheck(PL_put_atom(C_, a.C_)); } - explicit PlTerm_atom(const char *text) { PlCheck(PL_put_atom_chars(C_, text)); } // TODO: add encoding - explicit PlTerm_atom(const wchar_t *text) { PlCheck(PL_unify_wchars(C_, PL_ATOM, static_cast(-1), text)); } - explicit PlTerm_atom(const std::string& text) { PlCheck(PL_put_atom_nchars(C_, text.size(), text.data())); } // TODO: add encoding - explicit PlTerm_atom(const std::wstring& text) { PlCheck(PL_unify_wchars(C_, PL_ATOM, text.size(), text.data())); } + // For now, these are safe only with ASCII (PlEncoding::Latin1): + explicit PlTerm_atom(atom_t a) { Plx_put_atom(C_, a); } + explicit PlTerm_atom(const PlAtom& a) { Plx_put_atom(C_, a.C_); } + explicit PlTerm_atom(const char *text) { Plx_put_atom_chars(C_, text); } // TODO: add encoding + explicit PlTerm_atom(const wchar_t *text) { PlEx(Plx_unify_wchars(C_, PL_ATOM, static_cast(-1), text)); } + explicit PlTerm_atom(const std::string& text) { Plx_put_atom_nchars(C_, text.size(), text.data()); } // TODO: add encoding + explicit PlTerm_atom(const std::wstring& text) { PlEx(Plx_unify_wchars(C_, PL_ATOM, text.size(), text.data())); } }; class PlTerm_var : public PlTerm @@ -547,23 +671,23 @@ class PlTerm_integer : public PlTerm { public: // See comment with PlTerm::integer() about the overloading. - explicit PlTerm_integer(char v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(int v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(long v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(long long v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(short v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(signed char v) { PlCheck(PL_put_int64(C_, v)); } - explicit PlTerm_integer(unsigned char v) { PlCheck(PL_put_uint64(C_, v)); } - explicit PlTerm_integer(unsigned int v) { PlCheck(PL_put_uint64(C_, v)); } - explicit PlTerm_integer(unsigned long v) { PlCheck(PL_put_uint64(C_, v)); } - explicit PlTerm_integer(unsigned long long v) { PlCheck(PL_put_uint64(C_, v)); } - explicit PlTerm_integer(unsigned short v) { PlCheck(PL_put_uint64(C_, v)); } + explicit PlTerm_integer(char v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(int v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(long v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(long long v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(short v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(signed char v) { Plx_put_int64(C_, v); } + explicit PlTerm_integer(unsigned char v) { Plx_put_uint64(C_, v); } + explicit PlTerm_integer(unsigned int v) { Plx_put_uint64(C_, v); } + explicit PlTerm_integer(unsigned long v) { Plx_put_uint64(C_, v); } + explicit PlTerm_integer(unsigned long long v) { Plx_put_uint64(C_, v); } + explicit PlTerm_integer(unsigned short v) { Plx_put_uint64(C_, v); } }; class PlTerm_float : public PlTerm { public: - explicit PlTerm_float(double v) { PlCheck(PL_put_float(C_, v)); } + explicit PlTerm_float(double v) { Plx_put_float(C_, v); } }; // TODO: deprecate PlTerm_pointer and replace by C++ interface to blobs @@ -571,29 +695,11 @@ class PlTerm_float : public PlTerm class PlTerm_pointer : public PlTerm { public: - explicit PlTerm_pointer(void * ptr) { PlCheck(PL_put_pointer(C_, ptr)); } + explicit PlTerm_pointer(void * ptr) { Plx_put_pointer(C_, ptr); } }; -class PlTerm_recorded : public PlTerm -{ -public: - explicit PlTerm_recorded(record_t r) { PlCheck(PL_recorded(r, C_)); } -}; +inline PlModule PlContext(); -class PlModule : public WrappedC -{ -public: - explicit PlModule(module_t m) - : WrappedC(m) { } - explicit PlModule(const std::string& name) - : WrappedC(PL_new_module(PlAtom(name).C_)) - { verify(); - } - explicit PlModule(PlAtom name) - : WrappedC(PL_new_module(name.C_)) - { verify(); - } -}; class PlPredicate : public WrappedC { @@ -601,12 +707,20 @@ class PlPredicate : public WrappedC explicit PlPredicate(predicate_t p) : WrappedC(p) { } explicit PlPredicate(PlFunctor f) - : WrappedC(PL_pred(f.C_, static_cast(PlModule::null))) - { verify(); - } + : WrappedC(Plx_pred(f.C_, static_cast(PlModule::null))) + { } explicit PlPredicate(PlFunctor f, PlModule m) - : WrappedC(PL_pred(f.C_, m.C_)) - { verify(); + : WrappedC(Plx_pred(f.C_, m.C_)) + { } + explicit PlPredicate(const char *name, int arity, const char *module) + : WrappedC(Plx_predicate(name, arity, module)) + { } + void predicate_info(PlAtom *name, size_t *arity, PlModule *module) + { atom_t n; + module_t m; + Plx_predicate_info(C_, &n, arity, &m); + *name = PlAtom(n); + *module = PlModule(m); } }; @@ -624,17 +738,24 @@ class PlTermv public: explicit PlTermv(size_t n = 0) : size_(n), - a0_(n ? PL_new_term_refs(static_cast(n)) : PlTerm::null) - { if ( size_ && a0_ == PlTerm::null ) - throw PlFail(); + a0_(n ? Plx_new_term_refs(static_cast(n)) : PlTerm::null) + { if ( size_ ) + PlEx(a0_ != (term_t)0); } explicit PlTermv(size_t n, const PlTerm& t0) : size_(n), a0_(t0.C_) - { if ( size_ && a0_ == PlTerm::null ) - throw PlFail(); + { // Assume that t0 is valid - it can be if 0 if PREDICATE_NONDET is + // called for PL_PRUNED } + PlTermv(const PlTermv&) = default; + PlTermv(PlTermv&&) = default; + PlTermv& operator =(const PlTermv&) = default; + PlTermv& operator =(PlTermv&&) = default; + ~PlTermv() = default; + + term_t termv() const { // Note that a0_ can be PlTerm::null if size_ == 0 return a0_; @@ -644,6 +765,8 @@ class PlTermv { return size_; } + // TODO: PlTermv copy_term_ref() const + /* create from args */ explicit PlTermv(const PlAtom& a); explicit PlTermv(const PlTerm& m0); @@ -664,7 +787,6 @@ class PlCompound : public PlTerm public: explicit PlCompound(const wchar_t *text); explicit PlCompound(const std::string& text, PlEncoding enc=ENC_INPUT); - // TODO: add PlCompound(const char*), which is slightly more efficient than implicitly converting to std::string first explicit PlCompound(const std::wstring& text); PlCompound(const char *functor, const PlTermv& args); // TODO: PlEncoding PlCompound(const wchar_t *functor, const PlTermv& args); @@ -677,12 +799,12 @@ class PlTerm_string : public PlTerm { public: // TODO: PlEncoding - PlTerm_string(const char *text) { PlCheck(PL_put_string_chars(C_, text)); } - PlTerm_string(const char *text, size_t len) { PlCheck(PL_put_string_nchars(C_, len, text)); } - PlTerm_string(const wchar_t *text) { PlCheck(PL_unify_wchars(C_, PL_STRING, static_cast(-1), text)); } - PlTerm_string(const wchar_t *text, size_t len) { PlCheck(PL_unify_wchars(C_, PL_STRING, len, text));} - PlTerm_string(const std::string& text) { PlCheck(PL_put_string_nchars(C_, text.size(), text.data())); } - PlTerm_string(const std::wstring& text) { PlCheck(PL_unify_wchars(C_, PL_STRING, text.size(), text.data())); } + PlTerm_string(const char *text) { Plx_put_string_chars(C_, text); } + PlTerm_string(const char *text, size_t len) { Plx_put_string_nchars(C_, len, text); } + PlTerm_string(const wchar_t *text) { PlEx(Plx_unify_wchars(C_, PL_STRING, static_cast(-1), text)); } + PlTerm_string(const wchar_t *text, size_t len) { PlEx(Plx_unify_wchars(C_, PL_STRING, len, text));} + PlTerm_string(const std::string& text) { Plx_put_string_nchars(C_, text.size(), text.data()); } + PlTerm_string(const std::wstring& text) { PlEx(Plx_unify_wchars(C_, PL_STRING, text.size(), text.data())); } }; @@ -690,8 +812,8 @@ class PlTerm_list_codes : public PlTerm { public: // TODO: PlEncoding + deprecate this interface - PlTerm_list_codes(const char *text) { PlCheck(PL_put_list_codes(C_, text)); } - PlTerm_list_codes(const wchar_t *text) { PlCheck(PL_unify_wchars(C_, PL_CODE_LIST, static_cast(-1), text)); } + PlTerm_list_codes(const char *text) { Plx_put_list_codes(C_, text); } + PlTerm_list_codes(const wchar_t *text) { PlEx(Plx_unify_wchars(C_, PL_CODE_LIST, static_cast(-1), text)); } }; @@ -699,261 +821,243 @@ class PlTerm_list_chars : public PlTerm { public: // TODO: PlEncoding + deprecate this interface - PlTerm_list_chars(const char *text) { PlCheck(PL_put_list_chars(C_, text)); } - PlTerm_list_chars(const wchar_t *text) { PlCheck(PL_unify_wchars(C_, PL_CHAR_LIST, static_cast(-1), text)); } + PlTerm_list_chars(const char *text) { Plx_put_list_chars(C_, text); } + PlTerm_list_chars(const wchar_t *text) { PlEx(Plx_unify_wchars(C_, PL_CHAR_LIST, static_cast(-1), text)); } }; - /******************************* - * EXCEPTIONS * - *******************************/ - -class PlException : public PlTerm +class PlRecordRaw : public WrappedC { public: - explicit PlException(const PlAtom& a) - : PlTerm(PlTerm_atom(a).C_) - { verify(); + PlRecordRaw(PlTerm t) + : WrappedC(Plx_record(t.C_)) + { } + + PlRecordRaw(const PlRecordRaw& r) + : WrappedC(r) // TODO: r.duplicate(); + { } + PlRecordRaw& operator =(const PlRecordRaw& r) = delete; // TODO: implement + PlRecordRaw& operator =(PlRecordRaw&&) = delete; // TODO: implement + + PlRecordRaw(PlRecordRaw&& r) + : WrappedC(r) // TODO: r.duplicate; r.erase(); + { if ( this != &r ) + r.C_ = null; } - explicit PlException(const PlTerm& t) - : PlTerm(t) - { verify(); + + PlTerm term() const + { PlTerm_var t; + Plx_recorded(C_, t.C_); + return t; } - // The following methods override PlTerm, but do not use the - // "override" keyword because the method isn't virtual. Because - // the API has PlTerm as a thin wrapper on term_t, with minimal - // overhead, there are no virtual methods. - const std::string as_string(PlEncoding enc=ENC_OUTPUT) const { return string_term().as_string(enc); } - const std::wstring as_wstring() const { return string_term().as_wstring(); } + void erase() + { if ( C_ != null ) + Plx_erase(C_); + C_ = null; + } - // plThrow() is for the try-catch in PREDICATE - returns the result - // of PL_raise_exception(), which is always `false`, as a foreign_t. - foreign_t plThrow() - { return static_cast(PL_raise_exception(C_)); + PlRecordRaw duplicate() const + { return PlRecordRaw(Plx_duplicate_record(C_)); } -protected: - explicit PlException(term_t ex) - : PlTerm(ex) {} + ~PlRecordRaw() + { // TODO: erase(); + } private: - PlTerm string_term() const; + // Used by PlRecordRaw::duplicate: + explicit PlRecordRaw(record_t r) + : WrappedC(r) + { } }; -class PlException_qid : public PlException + +class PlRecordExternalCopy { public: - explicit PlException_qid(qid_t qid = 0) - : PlException(PL_exception(qid)) { } -}; + PlRecordExternalCopy(PlTerm t) + : C_(init(t)) + { } + + PlRecordExternalCopy(const PlRecordExternalCopy& r) = default; + PlRecordExternalCopy(PlRecordExternalCopy&& r) = default; + PlRecordExternalCopy& operator =(const PlRecordExternalCopy&) = delete; + PlRecordExternalCopy& operator =(PlRecordExternalCopy&&) = default; + ~PlRecordExternalCopy() = default; + + PlTerm term() const + { PlTerm_var t; + Plx_recorded_external(C_.data(), t.C_); + return t; + } +private: + std::string C_; -class PlTypeError : public PlException -{ -public: - explicit PlTypeError(const char *expected, const PlTerm& actual) : - // TODO: use PL_type_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(actual.is_variable() ? - static_cast(PlTerm_atom("instantiation_error")) : - static_cast(PlCompound("type_error", - PlTermv(PlTerm_atom(expected), actual))), - PlTerm_var()))) - { + std::string init(PlTerm t) + { size_t len; + char *s = Plx_record_external(t.C_, &len); + std::string result(s, len); + Plx_erase_external(s); + return result; } -}; -class PlDomainError : public PlException -{ -public: - explicit PlDomainError(const char *expected, const PlTerm& actual) : - // TODO: Use PL_domain_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(PlCompound("domain_error", - PlTermv(PlTerm_atom(expected), actual)), - PlTerm_var()))) - { + void verify() const + { // PlCheckFail(C_ != nullptr); + PlCheckFail(!C_.empty()); } }; -class PlTermvDomainError : public PlException -{ -public: - explicit PlTermvDomainError(size_t size, size_t n) : - // TODO: Use PL_domain_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(PlCompound("domain_error", - PlTermv(PlCompound("argv", - PlTermv(PlTerm_integer(size))), - PlTerm_integer(n))), - PlTerm_var()))) - { - } -}; + /******************************* + * EXCEPTIONS * + *******************************/ + +// Note: PlException, because it implements std::exception::what(), +// isn't just a simple wrapper; it has the full virutal methods +// overhead and also contains a std::string for the message the +// what() generates. If you want something lightweight, you +// should create the PlException object only if you need to do a +// "throw". +// TODO: PlException should be pure virtual, with 2 implementations: +// - the same as below +// - PlExceptionFailImpl - for error(resource_error(_)) -class PlInstantiationError : public PlException +class PlException : public std::exception { public: - explicit PlInstantiationError(const PlTerm& t) : - // TODO: Use PL_instantiation_error() or lazy PlTerm_atom() - PlException(t.is_variable() ? - PlCompound("error", - PlTermv(PlTerm_atom("instantiation_error"), t)) - : t) {} -}; + explicit PlException(const PlTerm& t) + : term_rec_(t) { } + explicit PlException(const PlAtom& a) + : term_rec_(PlTerm_atom(a)) { } -class PlExistenceError : public PlException -{ -public: - explicit PlExistenceError(const PlTerm& t) - : PlException(t) {} + PlException(const PlException& e) + : term_rec_(e.term_rec_.duplicate()), + what_str_(e.what_str_) + { } + PlException(PlException&& e) + : term_rec_(e.term_rec_.duplicate()), + what_str_(e.what_str_) + { e.term_rec_.erase(); + // Don't need to do anything with e.what_str_ + } + PlException& operator =(const PlException&) = delete; // TODO: implement + PlException& operator =(PlException&&) = delete; // TODO: implement - explicit PlExistenceError(const char *type, PlTerm actual) : - // TODO: Use PL_existence_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(PlCompound("existence_error", - PlTermv(PlTerm_atom(type), actual)), - PlTerm_var()))) - { + virtual bool is_null() + { return term_rec_.is_null() || term().is_null(); + } + virtual bool not_null() + { return term_rec_.not_null() && term().not_null(); } -}; + virtual ~PlException() + { erase(); + } -class PlPermissionError : public PlException -{ -public: - explicit PlPermissionError(const PlTerm& t) - : PlException(t) {} + virtual const char* what() const throw() override + { const_cast(this)->set_what_str(); + return what_str_.c_str(); + } - explicit PlPermissionError(const char *op, const char *type, const PlTerm& obj) : - // TODO: Use PL_permission_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(PlCompound("permission_error", - PlTermv(PlTerm_atom(op), PlTerm_atom(type), obj)), - PlTerm_var()))) - { + virtual PlTerm term() const + { return term_rec_.term(); } -}; + virtual const std::string as_string(PlEncoding enc=ENC_OUTPUT) const + { // Use what_str_ to hold the string so that c_str() doesn't return + // a pointer into the stack. Note that as_string() can cause an + // exception (out of memory, either in generating the string or in + // allocating the std::string) even though we specify "throw()" - + // telling the truth "noexcept(false)" results in a compilation + // error. + const_cast(this)->set_what_str(); + return what_str_; + } -class PlResourceError : public PlException -{ -public: - explicit PlResourceError(const char *resource) : - // TODO: Use PL_resource_error() or lazy PlTerm_atom() - PlException(PlCompound("error", - PlTermv(PlCompound("resource_error", - PlTermv(PlTerm_atom(resource))), - PlTerm_var()))) - { + // plThrow() is for the try-catch in PREDICATE - returns the result + // of Plx_raise_exception(), which is always `false`, as a foreign_t. + virtual foreign_t plThrow() + { foreign_t rc = static_cast(Plx_raise_exception(term().C_)); + return rc; } -}; + // The following method needs to be used with care (e.g., not when there's a resource + // error), which is why it isn't currently used to implement what(): + PlTerm string_term() const; - /******************************* - * PLFUNCTOR IMPLEMENTATION * - *******************************/ +protected: + explicit PlException(term_t ex) + : term_rec_(PlTerm_term_t(ex)) { } -template inline void -WrappedC::verify() const -{ if ( is_null() ) // For PlFunctor, no need to check name().is_null() - throw PlFail(); // Gets fatal error or PlResourceError("memory") -} + void set_what_str() + { if ( what_str_.empty() ) + { // Doing a query inside a query is ... problematic: + // TODO: const_cast(this)->what_str_ = string_term().as_string(); + what_str_ = term().as_string(); + } + } -inline -PlFunctor::PlFunctor(const std::string& name, size_t arity) - : WrappedC(null) -{ PlAtom a(name); - C_ = PL_new_functor(a.C_, arity); - PL_unregister_atom(a.C_); - verify(); -} + void erase() + { if ( term_rec_.not_null() ) + term_rec_.erase(); + term_rec_.set_null(); + } -inline -PlFunctor::PlFunctor(const std::wstring& name, size_t arity) - : WrappedC(null) -{ PlAtom a(name); - C_ = PL_new_functor(a.C_, arity); - PL_unregister_atom(a.C_); - verify(); -} + PlRecordRaw term_rec_; + std::string what_str_; // keeps copy of what() so that c_str() works -inline PlAtom -PlFunctor::name() const -{ return PlAtom(PL_functor_name(C_)); -} + // PlTerm string_term() const; // TODO: revive this +}; - /******************************* - * ATOM IMPLEMENTATION * - *******************************/ +PlException PlGeneralError(PlTerm inside); -inline const std::wstring -PlAtom::as_wstring() const -{ PlStringBuffers _string_buffers; - size_t len; - const wchar_t *s = PL_atom_wchars(C_, &len); - return std::wstring(s, len); - } +PlException PlTypeError(const char *expected, const PlTerm& actual); +PlException PlDomainError(const char *expected, const PlTerm& actual); - /******************************* - * TERM (BODY) * - *******************************/ +PlException PlDomainError(const PlTerm& expected, const PlTerm& actual); - /* PlTerm --> C */ +PlException PlInstantiationError(const PlTerm& t); -inline std::string -PlTerm::as_string(PlEncoding enc) const -{ return get_nchars(CVT_ALL|CVT_WRITEQ|BUF_STACK|static_cast(enc)); -} +PlException PlUninstantiationError(const PlTerm& t); -inline std::wstring -PlTerm::as_wstring() const -{ wchar_t *s; - size_t len; - PlStringBuffers _string_buffers; - if ( PL_get_wchars(C_, &len, &s, CVT_ALL|CVT_WRITEQ|BUF_STACK|CVT_EXCEPTION) ) - return std::wstring(s, len); - throw PlFail(); -} +PlException PlRepresentationError(const char *resource); -inline void -PlTerm::as_nil() const -{ PlCheck(PL_get_nil_ex(C_)); -} +PlException PlExistenceError(const char *type, PlTerm actual); -inline double -PlTerm::as_float() const -{ double v; - PlCheck(PL_get_float_ex(C_, &v)); - return v; -} +PlException PlPermissionError(const char *op, const char *type, const PlTerm& obj); + +PlException PlResourceError(const char *resource); + +PlException PlUnknownError(const char *description); -inline PlAtom -PlTerm::as_atom() const -{ atom_t v; - PlCheck(PL_get_atom_ex(C_, &v)); - return PlAtom(v); +void PlWrap_impl(qid_t qid); + +template C_t +PlWrap(C_t rc, qid_t qid) +{ if ( rc == static_cast(0) ) + PlWrap_impl(qid); + return rc; } -inline void * -PlTerm::as_pointer() const -{ void *ptr; - PlCheck(PL_get_pointer_ex(C_, &ptr)); - return ptr; +void PlEx_impl(qid_t qid); + +template void +PlEx(C_t rc, qid_t qid) +{ if ( rc == static_cast(0) ) + PlEx_impl(qid); } -inline record_t -PlTerm::record() const -{ record_t rec = PL_record(C_); - if ( rec ) - return rec; - throw PlFail(); + +inline void +PlCheckFail(bool rc) +{ if ( !rc ) + throw PlFail(); } /******************************* @@ -963,43 +1067,17 @@ PlTerm::record() const class PlTerm_tail : public PlTerm { public: - explicit PlTerm_tail(const PlTerm& l) - { if ( l.is_variable() || l.is_list() ) - { C_ = l.copy_term_ref().C_; - if ( is_null() ) - throw PlFail(); // Raises resource exception - } else - throw PlTypeError("list", l); - } + explicit PlTerm_tail(const PlTerm& l); /* building */ - [[nodiscard]] bool append(const PlTerm& e) - { // TODO: PlTerm_var tmp, ex; replace PL_unify_*() with unify_*() methods - term_t tmp; - if ( (tmp = PL_new_term_ref()) && - PL_unify_list(C_, tmp, C_) && - PL_unify(tmp, e.C_) ) - { PL_reset_term_refs(tmp); - return true; - } - - return false; - } + [[nodiscard]] bool append(PlTerm e); [[nodiscard]] bool close() { return unify_nil(); } /* enumerating */ - [[nodiscard]] bool next(PlTerm& t) - { if ( PL_get_list(C_, t.C_, C_) ) - return true; - - if ( PL_get_nil(C_) ) - return false; - - throw PlTypeError("list", *this); - } + [[nodiscard]] bool next(PlTerm& t); }; @@ -1008,34 +1086,56 @@ class PlTerm_tail : public PlTerm *******************************/ +class PlControl : public WrappedC +{ +public: + explicit PlControl(control_t c) + : WrappedC(c) { } + + [[nodiscard]] int foreign_control() const { return Plx_foreign_control(C_); } + + [[nodiscard]] intptr_t foreign_context() const { return Plx_foreign_context(C_); } + + [[nodiscard]] void *foreign_context_address() const { return Plx_foreign_context_address(C_); } + + [[nodiscard]] PlPredicate foreign_context_predicate() const { return PlPredicate(Plx_foreign_context_predicate(C_)); } +}; + + class PlRegister { public: PlRegister(const char *module, const char *name, int arity, foreign_t (f)(term_t t0, int a, control_t ctx)) - { PlCheck(PL_register_foreign_in_module(module, name, arity, reinterpret_cast(f), PL_FA_VARARGS)); + { PlEx(PL_register_foreign_in_module(module, name, arity, reinterpret_cast(f), PL_FA_VARARGS)); } PlRegister(const char *module, const char *name, foreign_t (*f)(PlTerm a0)) - { PlCheck(PL_register_foreign_in_module(module, name, 1, reinterpret_cast(f), 0)); + { PlEx(PL_register_foreign_in_module(module, name, 1, reinterpret_cast(f), 0)); } PlRegister(const char *module, const char *name, foreign_t (*f)(PlTerm a0, PlTerm a1)) - { PlCheck(PL_register_foreign_in_module(module, name, 2, reinterpret_cast(f), 0)); + { PlEx(PL_register_foreign_in_module(module, name, 2, reinterpret_cast(f), 0)); } PlRegister(const char *module, const char *name, foreign_t (*f)(PlTerm a0, PlTerm a1, PlTerm a2)) - { PlCheck(PL_register_foreign_in_module(module, name, 3, reinterpret_cast(f), 0)); + { PlEx(PL_register_foreign_in_module(module, name, 3, reinterpret_cast(f), 0)); } // For C-style calls - needed to support a test case PlRegister(const char *module, const char *name, foreign_t (*f)(term_t a0)) - { PlCheck(PL_register_foreign_in_module(module, name, 1, reinterpret_cast(f), 0)); + { PlEx(PL_register_foreign_in_module(module, name, 1, reinterpret_cast(f), 0)); } // for non-deterministic calls PlRegister(const char *module, const char *name, int arity, foreign_t (f)(term_t t0, int a, control_t ctx), short flags) - { PlCheck(PL_register_foreign_in_module(module, name, arity, reinterpret_cast(f), flags)); + { PlEx(PL_register_foreign_in_module(module, name, arity, reinterpret_cast(f), flags)); } + + PlRegister(const PlRegister&) = delete; + PlRegister(PlRegister&&) = delete; + PlRegister& operator =(const PlRegister&) = delete; + PlRegister& operator =(PlRegister&&) = delete; + ~PlRegister() = default; }; @@ -1043,68 +1143,66 @@ class PlRegister * CALLING PROLOG * *******************************/ -class PlFrame +class PlFrame : WrappedC { -private: - fid_t fid_; - public: PlFrame() - : fid_(PL_open_foreign_frame()) - { verify(); + : WrappedC(Plx_open_foreign_frame()) + { } + + void discard() + { if ( not_null() ) + Plx_discard_foreign_frame(C_); + set_null(); } - ~PlFrame() - { PL_close_foreign_frame(fid_); + void close() + { if ( not_null() ) + Plx_close_foreign_frame(C_); + set_null(); } - void rewind() - { PL_rewind_foreign_frame(fid_); + ~PlFrame() noexcept(false) + { // See comment about exception in PlQuery::~PlQuery() + close(); } -private: - void verify() - { if ( fid_ == static_cast(0) ) - throw PlFail(); + void rewind() + { Plx_rewind_foreign_frame(C_); } }; -[[nodiscard]] inline bool PlRewindOnFail(std::function f) -{ PlFrame frame; - bool rc = f(); - if ( !rc ) - frame.rewind(); - return rc; -} +[[nodiscard]] bool PlRewindOnFail(std::function f); -class PlQuery -{ -private: - qid_t qid_; +class PlQuery : WrappedC +{ public: PlQuery(PlPredicate pred, const PlTermv& av, int flags = PL_Q_PASS_EXCEPTION) - : qid_(PL_open_query(static_cast(0), flags, pred.C_, av.termv())) - { verify(); - } + : WrappedC(Plx_open_query(static_cast(0), flags, pred.C_, av.termv())), + flags_(flags) + { } // TODO: PlQuery(const wstring& ...) // TODO: PlQuery({PlAtom,PlFunctor,PlPredicate} ...) PlQuery(const std::string& name, const PlTermv& av, int flags = PL_Q_PASS_EXCEPTION) - : qid_(PL_open_query(static_cast(0), - flags, - PlPredicate(PlFunctor(name, av.size())).C_, - av.termv())) - { verify(); - } + : WrappedC(Plx_open_query(static_cast(0), + flags, + PlPredicate(PlFunctor(name, av.size())).C_, + av.termv())), + flags_(flags) + { } // TODO; Should resolve module only once. PlQuery(const std::string& module, const std::string& name, const PlTermv& av, int flags = PL_Q_PASS_EXCEPTION) - : qid_(PL_open_query(PlModule(module).C_, - flags, - PlPredicate(PlFunctor(name, av.size()), - PlModule(module)).C_, - av.termv())) - { verify(); - } + : WrappedC(Plx_open_query(PlModule(module).C_, + flags, + PlPredicate(PlFunctor(name, av.size()), + PlModule(module)).C_, + av.termv())), + flags_(flags) + { } + PlQuery(qid_t qid) + : WrappedC(qid) + { } // The return code from next_solution can be (if called with PL_Q_EXT_STATUS): // TRUE @@ -1116,411 +1214,70 @@ class PlQuery // Because of this, you shouldn't use PlCheck(q.next_solution()) [[nodiscard]] int next_solution(); + PlTerm exception() const + { verify(); // Not meaningful if cut() or close_destroy() has been done + return PlTerm_term_t(Plx_exception(exception_qid())); + } + + qid_t exception_qid() const + { return flags_&PL_Q_CATCH_EXCEPTION ? C_ : 0; + } + + PlTerm yielded() const + { return PlTerm_term_t(Plx_yielded(C_)); + } + void cut() - { qid_t qid_orig = qid_; - qid_ = 0; - if ( qid_orig ) - PlCheck(PL_cut_query(qid_orig)); // rc: exception occurred in a cleanup handler + { if ( not_null() ) + Plx_cut_query(C_); + set_null(); } void close_destroy() - { qid_t qid_orig = qid_; - qid_ = 0; - if ( qid_orig ) - PlCheck(PL_close_query(qid_orig)); // rc: exception occurred in a cleanup handler + { if ( not_null() ) + Plx_close_query(C_); + set_null(); } ~PlQuery() noexcept(false) { // cut() can throw a C++ exception - throwing an exception from a // destructor is "potentially dangerous" but it's necessary to // ensure proper behaviour in Prolog. - cut(); // *not* close() - which destroys data&bindings from query + cut(); // *not* close_destroy() - which destroys data&bindings from query } private: - void verify() - { if ( qid_ == static_cast(0) ) - throw PlFail(); + int flags_; + + void verify() const + { // PL_open_query() can return 0 if there isn't enough space on the + // environment stack - the error is in PL_exception(0). + PlEx(C_ != static_cast(0)); + int ex_flags = flags_ & (PL_Q_NORMAL | PL_Q_CATCH_EXCEPTION | PL_Q_PASS_EXCEPTION); + // Ensure that only one of the exception-handling flags is set: + if ( ex_flags != 0 && + ex_flags != PL_Q_NORMAL && + ex_flags != PL_Q_CATCH_EXCEPTION && + ex_flags != PL_Q_PASS_EXCEPTION ) + throw PlDomainError("PlQuery_flags", PlTerm_integer(flags_)); } }; +PlQuery PlCurrentQuery(); -// See comment about possible return values from -// PlQuery::next_solution(), which is used by PlCall(). -inline int -PlCall(const std::string& predicate, const PlTermv& args, int flags = PL_Q_PASS_EXCEPTION) -{ PlQuery q(predicate, args, flags); - return q.next_solution(); -} - -inline int -PlCall(const std::string& module, const std::string& predicate, const PlTermv& args, int flags = PL_Q_PASS_EXCEPTION) -{ PlQuery q(module, predicate, args, flags); - return q.next_solution(); -} - -inline int -PlCall(const std::string& goal, int flags = PL_Q_PASS_EXCEPTION) -{ PlQuery q("call", PlTermv(PlCompound(goal)), flags); - return q.next_solution(); -} - -inline int -PlCall(const std::wstring& goal, int flags = PL_Q_PASS_EXCEPTION) -{ PlQuery q("call", PlTermv(PlCompound(goal)), flags); - return q.next_solution(); -} - -inline int -PlCall(PlTerm goal, int flags = PL_Q_PASS_EXCEPTION) -{ PlQuery q("call", PlTermv(goal), flags); - return q.next_solution(); -} - - - - /* compounds */ - -inline PlTerm -PlTerm::operator [](size_t index) const -{ PlTerm t; - if ( PL_get_arg(index, C_, t.C_) ) - return t; - - if ( !PL_is_compound(C_) ) - throw PlTypeError("compound", *this); - - /* Construct error term and throw it */ - PlCheck(PL_put_uint64(t.C_, index)); - if ( index < 1 ) - throw PlDomainError("not_less_than_zero", t); - else - throw PlDomainError("arity", t); /* TODO: proper exception */ -} - - -inline size_t -PlTerm::arity() const -{ atom_t name; - size_t arity; - if ( PL_get_name_arity(C_, &name, &arity) ) - return arity; - throw PlTypeError("compound", *this); -} - - -inline PlAtom -PlTerm::name() const -{ atom_t name; - size_t arity; - if ( PL_get_name_arity(C_, &name, &arity) ) - return PlAtom(name); - throw PlTypeError("compound", *this); -} - -inline bool -PlTerm::name_arity(PlAtom *name, size_t *arity) const -{ atom_t name_a; - if ( PL_get_name_arity(C_, &name_a, arity) ) - { if ( name ) - *name = PlAtom(name_a); - return true; - } - return false; -} - -inline bool -PlTerm::chkex(int rc) -{ if ( rc ) - return rc; - throw PlFail(); -} - - - /* comparison */ - - -inline bool PlTerm::operator ==(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 == v; - - throw PlTypeError("integer", *this); -} - -inline bool PlTerm::operator !=(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 != v; - - throw PlTypeError("integer", *this); -} +// TODO: PlQueryEngine() from Plx_query_engine9) -inline bool PlTerm::operator <(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 < v; - - throw PlTypeError("integer", *this); -} - -inline bool PlTerm::operator >(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 > v; - - throw PlTypeError("integer", *this); -} - -inline bool PlTerm::operator <=(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 <= v; - - throw PlTypeError("integer", *this); -} - -inline bool PlTerm::operator >=(int64_t v) const -{ int64_t v0; - - if ( PL_get_int64(C_, &v0) ) - return v0 >= v; - - throw PlTypeError("integer", *this); -} - - /* comparison (string) */ - -inline bool PlTerm::operator ==(const char *s) const -{ char *s0; - - if ( PL_get_chars(C_, &s0, CVT_ALL) ) - return strcmp(s0, s) == 0; - - throw PlTypeError("text", *this); -} - -inline bool PlTerm::operator ==(const wchar_t *s) const -{ wchar_t *s0; - - if ( PL_get_wchars(C_, nullptr, &s0, CVT_ALL) ) - return wcscmp(s0, s) == 0; - - throw PlTypeError("text", *this); -} - -inline bool PlTerm::operator ==(const std::string& s) const -{ char *s0; - - if ( PL_get_chars(C_, &s0, CVT_ALL) ) - return s.compare(s0) == 0; // TODO: handle non-NUL terminated - - throw PlTypeError("text", *this); -} - -inline bool PlTerm::operator ==(const PlAtom& a) const -{ atom_t v; - - if ( PL_get_atom(C_, &v) ) - return v == a.C_; - - throw PlTypeError("atom", *this); -} - - - /******************************* - * COMPOUND (BODY) * - *******************************/ - -inline void -PlPutTerm(term_t to, term_t from) -{ PlCheck(PL_put_term(to, from)); -} - -inline -PlCompound::PlCompound(const wchar_t *text) -{ term_t t = PL_new_term_ref(); - - PlCheck(PL_wchars_to_term(text, t)); - - PlPutTerm(C_, t); -} - -inline -PlCompound::PlCompound(const std::string& text, PlEncoding enc) -{ term_t t = PL_new_term_ref(); - if ( t == PlTerm::null ) - throw PlFail(); - - // TODO: PL_put_term_from_chars() should take an unsigned int flags - PlCheck(PL_put_term_from_chars(t, enc, text.size(), text.data())); - - PlPutTerm(C_, t); -} - -inline -PlCompound::PlCompound(const std::wstring& text) -{ term_t t = PL_new_term_ref(); - if ( ! t ) - throw PlFail(); - - // TODO: what is wchar_t equivalent of PL_put_term_from_chars()? - PlCheck(PL_wchars_to_term(text.c_str(), t)); // TODO: use text.size() - - PlPutTerm(C_, t); -} - -inline -PlCompound::PlCompound(const char *functor, const PlTermv& args) -{ PlCheck(PL_cons_functor_v(C_, - // TODO: throw if PL_new_functor() returns 0 - PL_new_functor(PL_new_atom(functor), args.size()), - args.termv())); -} - -inline -PlCompound::PlCompound(const wchar_t *functor, const PlTermv& args) -{ PlCheck(PL_cons_functor_v( - C_, - // TODO: throw if PL_new_functor() returns 0 - PL_new_functor(PL_new_atom_wchars(wcslen(functor), functor), - args.size()), - args.termv())); -} - -inline -PlCompound::PlCompound(const std::string& functor, const PlTermv& args) -{ PlCheck(PL_cons_functor_v(C_, - // TODO: throw if PL_new_functor() returns 0 - PL_new_functor(PL_new_atom_nchars(functor.size(), functor.data()), args.size()), - args.termv())); -} - -inline -PlCompound::PlCompound(const std::wstring& functor, const PlTermv& args) -{ PlCheck(PL_cons_functor_v(C_, - // TODO: throw if PL_new_functor() returns 0 - PL_new_functor(PL_new_atom_wchars(functor.size(), functor.data()), args.size()), - args.termv())); -} - - /******************************* - * TERMV (BODY) * - *******************************/ - - -inline PlTermv::PlTermv(const PlAtom& a) - : size_(1), - a0_(PlTerm_atom(a).C_) -{ if ( !a0_ ) - throw PlFail(); -} - -inline PlTermv::PlTermv(const PlTerm& m0) - : size_(1), - a0_(m0.C_) -{ if ( !a0_ ) - throw PlFail(); -} - -inline PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1) - : size_(2), - a0_(PL_new_term_refs(2)) -{ if ( !a0_ ) - throw PlFail(); - PlPutTerm(a0_+0, m0.C_); - PlPutTerm(a0_+1, m1.C_); -} - -inline PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2) - : size_(3), - a0_(PL_new_term_refs(3)) -{ if ( !a0_ ) - throw PlFail(); - PlPutTerm(a0_+0, m0.C_); - PlPutTerm(a0_+1, m1.C_); - PlPutTerm(a0_+2, m2.C_); -} - -inline PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2, const PlTerm& m3) - : size_(4), - a0_(PL_new_term_refs(4)) -{ if ( !a0_ ) - throw PlFail(); - PlPutTerm(a0_+0, m0.C_); - PlPutTerm(a0_+1, m1.C_); - PlPutTerm(a0_+2, m2.C_); - PlPutTerm(a0_+3, m3.C_); -} - -inline PlTermv::PlTermv(const PlTerm& m0, const PlTerm& m1, const PlTerm& m2, - const PlTerm& m3, const PlTerm& m4) - : size_(5), - a0_(PL_new_term_refs(5)) -{ if ( !a0_ ) - throw PlFail(); - PlPutTerm(a0_+0, m0.C_); - PlPutTerm(a0_+1, m1.C_); - PlPutTerm(a0_+2, m2.C_); - PlPutTerm(a0_+3, m3.C_); - PlPutTerm(a0_+4, m4.C_); -} - -inline PlTerm -PlTermv::operator [](size_t n) const -{ if ( n >= size_ ) - throw PlTermvDomainError(size_, n); - - return PlTerm_term_t(a0_+n); -} - - - /******************************* - * EXCEPTIONS (BODY) * - *******************************/ - -inline PlTerm -PlException::string_term() const -{ PlFrame fr; -#ifdef USE_PRINT_MESSAGE - PlTermv av(2); - - PlCheck(av[0].unify_term(PlCompound("print_message", - PlTermv("error", *this)))); - PlQuery q("$write_on_string", av); - if ( q.next_solution() ) - return av[1]; -#else - PlTermv av(2); - PlCheck(av[0].unify_term(*this)); - PlQuery q("$messages", "message_to_string", av); - if ( q.next_solution() ) - return av[1]; -#endif - return PlTerm_string("[ERROR: Failed to generate message. Internal error]"); -} - - - /******************************* - * QUERY (BODY) * - *******************************/ - -inline int -PlQuery::next_solution() -{ int rval = PL_next_solution(qid_); - - if ( !rval ) - (void)close_destroy(); // TODO: what if this creates an exception? - return rval; -} +// TODO: PlAssert(PlTerm, PlModule, flags) from Plx_assert() +// See comment about possible return values from +// PlQuery::next_solution(), which is used by PlCall(). +int PlCall(const std::string& predicate, const PlTermv& args, int flags = PL_Q_PASS_EXCEPTION); +int PlCall(const std::string& module, const std::string& predicate, const PlTermv& args, int flags = PL_Q_PASS_EXCEPTION); +int PlCall(const std::string& goal, int flags = PL_Q_PASS_EXCEPTION); +int PlCall(const std::wstring& goal, int flags = PL_Q_PASS_EXCEPTION); +int PlCall(PlTerm goal, int flags = PL_Q_PASS_EXCEPTION); /******************************* * ENGINE * *******************************/ @@ -1529,28 +1286,34 @@ class PlEngine { public: PlEngine(int argc, char **argv) - { PlCheck(PL_initialise(argc, argv)); + { Plx_initialise(argc, argv); } PlEngine(int argc, wchar_t **argv) - { PlCheck(PL_winitialise(argc, argv)); + { Plx_winitialise(argc, argv); } PlEngine(char *av0) { av[0] = av0; av[1] = nullptr; - PlCheck(PL_initialise(1, av)); + Plx_initialise(1, av); } PlEngine(wchar_t *av0) { w_av[0] = av0; w_av[1] = nullptr; - PlCheck(PL_winitialise(1, w_av)); + Plx_winitialise(1, w_av); } + // TODO: figure out copy/move semantics and implement + PlEngine(const PlEngine&) = delete; + PlEngine(PlEngine&&) = delete; + PlEngine& operator =(const PlEngine&) = delete; + PlEngine& operator =(PlEngine&&) = delete; + void cleanup(int status_and_flags = 0) { - PlCheck(PL_cleanup(status_and_flags)); + Plx_cleanup(status_and_flags); } ~PlEngine() noexcept(false) @@ -1566,6 +1329,34 @@ class PlEngine }; + /******************************* + * PL_{get,release}_stream * + *******************************/ + + +class PlStream +{ +private: + IOSTREAM* stream_; + +public: + explicit PlStream(PlTerm& stream, int flags) + : stream_(nullptr) + { Plx_get_stream(stream.C_, &stream_, flags); + } + + PlStream(const PlStream&) = default; + PlStream(PlStream&&) = default; + PlStream& operator =(const PlStream&) = default; + PlStream& operator =(PlStream&&) = default; + + ~PlStream() + { if (stream_ != nullptr) + Plx_release_stream(stream_); + } +}; + + /******************************* * REGISTER PREDICATES * *******************************/ @@ -1583,12 +1374,14 @@ class PlEngine try \ { \ return pl_ ## name ## __ ## arity(PlTermv(arity, PlTerm_term_t(t0))); \ - } catch ( std::bad_alloc& ) \ - { return PlResourceError("memory").plThrow(); \ - } catch ( PlFail& ) \ - { return false; \ + } catch ( const std::bad_alloc& ) \ + { return static_cast(Plx_resource_error("memory")); \ + } catch ( const PlFail& ) \ + { return false; \ + } catch ( const PlExceptionFail& ) \ + { return false; \ } catch ( PlException& ex ) \ - { return ex.plThrow(); \ + { return ex.plThrow(); \ } \ } \ static PlRegister _x ## name ## __ ## arity(PROLOG_MODULE, plname, arity, \ @@ -1605,9 +1398,11 @@ class PlEngine { \ return pl_ ## name ## __0(); \ } catch ( std::bad_alloc& ) \ - { return PlResourceError("memory").plThrow(); \ + { return static_cast(Plx_resource_error("memory")); \ } catch ( PlFail& ) \ { return false; \ + } catch ( const PlExceptionFail& ) \ + { return false; \ } catch ( PlException& ex ) \ { return ex.plThrow(); \ } \ @@ -1618,17 +1413,20 @@ class PlEngine #define NAMED_PREDICATE_NONDET(plname, name, arity) \ static foreign_t \ - pl_ ## name ## __ ## arity(PlTermv PL_av, control_t handle); \ + pl_ ## name ## __ ## arity(PlTermv PL_av, PlControl handle); \ static foreign_t \ _pl_ ## name ## __ ## arity(term_t t0, int a, control_t c) \ { (void)a; \ try \ { \ - return pl_ ## name ## __ ## arity(PlTermv(arity, PlTerm_term_t(t0)), c); \ + /* t0.C_ is 0 if handle.foreign_control()==PL_PRUNED */ \ + return pl_ ## name ## __ ## arity(PlTermv(arity, PlTerm_term_t(t0)), PlControl(c)); \ } catch ( std::bad_alloc& ) \ - { return PlResourceError("memory").plThrow(); \ + { return static_cast(Plx_resource_error("memory")); \ } catch ( PlFail& ) \ { return false; \ + } catch ( const PlExceptionFail& ) \ + { return false; \ } catch ( PlException& ex ) \ { return ex.plThrow(); \ } \ @@ -1636,7 +1434,7 @@ class PlEngine static PlRegister _x ## name ## __ ## arity(PROLOG_MODULE, plname, arity, \ _pl_ ## name ## __ ## arity, \ PL_FA_NONDETERMINISTIC | PL_FA_VARARGS); \ - static foreign_t pl_ ## name ## __ ## arity(PlTermv PL_av, control_t handle) + static foreign_t pl_ ## name ## __ ## arity(PlTermv PL_av, PlControl handle) #define PREDICATE0(name) NAMED_PREDICATE0(#name, name) #define PREDICATE(name, arity) NAMED_PREDICATE(#name, name, arity) @@ -1687,13 +1485,16 @@ class PlEngine template class PlForeignContextPtr { - ContextType *ptr_; - bool deferred_free_; - public: - explicit PlForeignContextPtr(control_t handle) - : ptr_(static_cast(PL_foreign_context_address(handle))), - deferred_free_(true) { } + explicit PlForeignContextPtr(PlControl handle) + : ptr_(static_cast(handle.foreign_context_address())), + deferred_free_(true) + { } + + PlForeignContextPtr(const PlForeignContextPtr&) = delete; + PlForeignContextPtr(PlForeignContextPtr&&) = delete; + PlForeignContextPtr& operator =(const PlForeignContextPtr&) = delete; + PlForeignContextPtr& operator =(PlForeignContextPtr&&) = delete; ContextType& operator*() const { return *ptr_; } ContextType* operator->() const { return ptr_; } @@ -1708,6 +1509,10 @@ template class PlForeignContextPtr { if ( deferred_free_ ) delete ptr_; // it's safe to delete nullptr } + +private: + ContextType *ptr_; + bool deferred_free_; }; -#endif /*_SWI_CPP_H*/ +#endif /*_SWI_CPP2_H*/ diff --git a/pl2cpp.doc b/pl2cpp.doc index 2f3f587..8a93bf0 100644 --- a/pl2cpp.doc +++ b/pl2cpp.doc @@ -27,7 +27,7 @@ \begin{abstract} This document describes a C++ interface to SWI-Prolog. SWI-Prolog could be used with C++ for a very long time, but only by calling the extern -"C" functions of the C-interface. The interface described herein +"C" functions of the C-interface. The interface described here provides a true C++ layer around the C-interface for much more concise and natural programming from C++. The interface deals with automatic type-conversion to and from native C data-types, transparent mapping of @@ -42,12 +42,13 @@ At this moment there are \textbf{two} versions of the C++ interface. does not support character encoding issues, which implies \ctype{char*} can only be used to exchange text in ISO-Latin-1 encoding. We hope to deprecate this interface soon. - \item Version 2 is implemented by \file{SWI-cpp2.h} and described + \item Version 2 is implemented by \file{SWI-cpp2.h} and \file{SWI-cpp2.cpp} + and described in \chapref{cpp2}. This is a much more mature C++ interface has been designed and implemented by Peter Ludemann. We plan to make this the preferred interface soon. There are still - several issues that need to be resolved before this can - happen, notably related to handling text encoding. + several issues that need to be fully resolved and implemented + before this can happen, mostly related to handling text encoding. \end{itemize} \end{abstract} diff --git a/pl2cpp2.doc b/pl2cpp2.doc index 05a8341..c58a34e 100644 --- a/pl2cpp2.doc +++ b/pl2cpp2.doc @@ -4,39 +4,87 @@ \section{Summary of changes between Versions 1 and 2} \label{sec:summary-cpp2-changes} -Version 1 is in \file{SWI-cpp.h}; version 2 is in \file{SWI-cpp2.h}. - -The overall structure of the API has been retained - that is, -it is a thin layer on top of the interface provided by -\file{SWI-Prolog.h}. Based on experience with the API, -most of the conversion operators have been removed or deprecated, -and replaced by "getter" methods. The overloaded constructors have -been replaced by subclasses for the various types. Some changes -were also made to ensure that the \const{[]} operator for \ctype{PlTerm} -and \ctype{PlTermv} doesn't cause unexpected implicit conversions. - \footnote{If there is an implicit conversion operator from +Version 1 is in \file{SWI-cpp.h}; version 2 is in \file{SWI-cpp2.h}, +\file{SWI-cpp2.cpp}, and \file{SWI-cpp2-plx.h}. + +The overall structure of the API has been retained - that is, it is a +thin layer on top of the interface provided by +\file{SWI-Prolog.h}. Based on experience with the API, most of the +conversion operators and some of the comparison operators have been +removed or deprecated, and replaced by "getter" methods. The +overloaded constructors have been replaced by subclasses for the +various types. Some changes were also made to ensure that the +\const{[]} operator for \ctype{PlTerm} and \ctype{PlTermv} doesn't +cause unexpected implicit conversions. + \footnote{If there is an implicit conversion operator from \ctype{PlTerm} to \ctype{term_t} and also to \ctype{char*}, then - the \const{[]} operator is ambiguous in - \exam{PlTerm t=...; f(t[0])} - if \exam{f} is overloaded to accept a \ctype{term_t} or \ctype{char*}. + the \const{[]} operator is ambiguous + if \exam{f} is overloaded to accept a \ctype{term_t} or \ctype{char*} + in the code \exam{PlTerm t=...; f(t[0])} } +Prolog exceptions are now converted to C++ exceptions (which contain +the exception term rather being a subclass of \ctype{PlTerm} as in +version 1), where they can be caught and thrown using the usual C++ +mechanisms; and the subclasses that create exceptions have been +changed to functions. In addition, a \ctype{PlFail} has been added, +to allow "short circuit" return to Prolog on failure. + More specifically: \begin{itemize} + \item \file{SWI-cpp2.cpp} has been added, containing the implementation + of some functions that are too long to inline. The user must + either \exam{#include } or compile it separately and + link it with the other foreign function code. \item - The constructor \cfuncref{PlTerm}{} is not available - instead, - you should use the appropriate subclass' constructor - (\cfuncref{PlTerm_var}{}, \cfuncref{PlTerm_atom}{a}, - \cfuncref{PlTerm_term_t}{t}, \cfuncref{PlTerm_integer}{i}, - \cfuncref{PlTerm_int64}{i}, \cfuncref{PlTerm_uint64}{i}, - \cfuncref{PlTerm_size_t}{i}, - \cfuncref{PlTerm_float}{v}, or \cfuncref{PlTerm_pointer}{p}). - \item - Instead of returning \const{false} from a predicate to indicate - failure, you can use \exam{throw PlFail()}. The convenience - function \cfuncref{PlCheck}{rc} can be used to throw \exam{PlFail()}, - if a \const{false} is returned from a function in \file{SWI-Prolog.h} + The constructor \cfuncref{PlTerm}{} is restricted to a few + unambiguous cases - instead, you should use the appropriate + subclass' constructors (\cfuncref{PlTerm_var}{}, + \cfuncref{PlTerm_atom}{a}, \cfuncref{PlTerm_term_t}{t}, + \cfuncref{PlTerm_integer}{i}, \cfuncref{PlTerm_int64}{i}, + \cfuncref{PlTerm_uint64}{i}, \cfuncref{PlTerm_size_t}{i}, + \cfuncref{PlTerm_float}{v}, or \cfuncref{PlTerm_pointer}{p}). +\item + Wrapper functions have been provided for almost all the PL_*() + functions in \file{SWI-Prolog.h}, and have the same names with + the ``PL'' replaced by ``Plx''.\footnote{``Pl'' is used + throughout the \file{SWI-cpp2.h} interface, and the ``x'' is + for ``eXtended with eXception handling.''} + Where appropriate, these check return codes and throw a C++ + exception (created from the Prolog error). + See \secref{cpp2-wrapper-functions} + Many of these wrapper functions have been added to the \ctype{PlAtom} + and \ctype{PlTerm} classes, with the arguments changed from + \ctype{atom_t} and \ctype{term_t} to \ctype{PlAtom} and \ctype{PlTerm}. + These wrappers are available if you include \file{SWI-cpp2.h} + (they are in a separate \file{SWI-cpp2-plx.h} file for ease + of maintenance). \item + Instead of returning \const{false} from a foreign predicate to + indicate failure, you can use \exam{throw PlFail()}. The + convenience function \cfuncref{PlCheckFail}{rc} can be used to + throw PlFail() if \const{false} is returned from a function in + \file{SWI-Prolog.h}. If the wrapper functions or class methods + are used, Prolog errors result in a C++ \ctype{PlException} + exception.\footnote{If a ``Plx_'' wrapper is used to call a + \file{SWI-Prolog.h} function, a Prolog error will have already + resulted in throwing \ctype{PlException}; + `cfuncref{PlCheckFail}{rc} is used to additionally throw + \ctype{PlFail}, similar to returning \const{false} from the + top-level of a foreign predicate.} +\item + The \ctype{PlException} class is a subclass of \ctype{std::excxeption} + and encapsulates a Prolog error. + Prolog errors are converted into \exam{throw PlException(...)}. + If the user code does not catch the \ctype{PlException}, the PREDICATE() + macro converts the error to a Prolog error upon return to the + Prolog caller. +\item + The C++ constructors, functions, and methods use the wrapper + functions to a C++ exception on error (and the C++ exception is + converted to a Prolog exception when control returns to + Prolog). + \item The "cast" operators (e.g., \exam{(char*)t}, \exam{(int64_t)t}) have been deprecated, replaced by "getters" (e.g., \exam{t.as_string()}, \exam{t.as_int64_t()}).\footnote{The form @@ -44,28 +92,43 @@ More specifically: more verbose: \exam{static_cast(t)}.} \item The overloaded assignment operator for unification is deprecated; - replaced by \cfuncref{unify_term}{}, \cfuncref{unify_atom}{}, etc., and the helper - \cfuncref{PlCheck}{}. + replaced by \cfuncref{unify_term}{}, \cfuncref{unify_atom}{}, + etc., and the helper \cfuncref{PlCheckFail}{}. \item + Many of the equality and inequality operators are deprecated; + replaced by the as_string() method and the associated + \ctype{std::string}, comparison operators. The as_string() method + allows specifying the encoding to use whereas the \exam{==} and + similar operators do not allow for this. +\item Methods that return \ctype{char*} have been replaced by methods that return \ctype{std::string} to ensure that lifetime issues don't cause subtle bugs.\footnote{If you want to return a \ctype{char*} from a function, you should not do \exam{return t.as_string().c_str()} because that will return - a pointer to local or stack memory. Instead, you will need to + a pointer to local or stack memory. Instead, you should change your interface to return a \ctype{std::string} and apply - the \exam{c_str()} method to it. These errors can \emph{sometimes} be caught by - specifying the Gnu C++ or Clang options \exam{-Wreturn-stack-address} - or \exam{-Wreturn-local-addr} - Clang seems to do a better - analysis.} + the \exam{c_str()} method to it. These lifetime errors can + \emph{sometimes} be caught by specifying the Gnu C++ or Clang + options \exam{-Wreturn-stack-address} or + \exam{-Wreturn-local-addr} - as of 2023-04, Clang seems to do a + better analysis.} +\item + Most constructors, methods, and functions that accept \ctype{char*} + arguments also accept \ctype{std::string} or \ctype{std::wstring} + arguments. Where possible, encoding information can also be + specified. \item - Type-checking methods have been added: \cfuncref{type}{}, \cfuncref{is_variable}{}, - \cfuncref{is_atom}{}, etc. + Type-checking methods have been added: \cfuncref{type}{}, + \cfuncref{is_variable}{}, \cfuncref{is_atom}{}, etc. \item \ctype{PlString} has been renamed to \ctype{PlTerm_string} to make it clear that it's a term that contains a Prolog string. \item - More \exam{PL_...(term_t, ...)} methods have been added to \ctype{PlTerm}. + More \exam{PL_...(term_t, ...)} methods have been added to \ctype{PlTerm}, + and \exam{PL_...(atom_t, ...)} methods have been added to \ctype{PlAtom}. + Where appopriate, the arguments use \ctype{PlTerm}, \ctype{PlAtom}, etc. + instead of \ctype{term_t}, \ctype{atom_t}, etc. \item \ctype{std::string} and \ctype{std::wstring} are now supported in most places where \ctype{char*} or \ctype{wchar_t*} are allowed. @@ -91,6 +154,13 @@ More specifically: \item \ctype{PlStringBuffers} provides a simpler interface for allocating strings on the stack than PL_STRINGS_MARK() and PL_STRINGS_RELEASE(). + \item + Wrapper classes for \ctype{record_t} have been added. The + \ctype{PlRecordExternalCopy} class contains the opaque handle, + as a convenience. + \item + Wrapper class for \ctype{control_t} has been added and the + PREDICATE_NONDET() has been modified to use it. \end{itemize} More details are given in \secref{cpp2-rationale} and @@ -102,20 +172,26 @@ More details are given in \secref{cpp2-rationale} and C++ provides a number of features that make it possible to define a more natural and concise interface to dynamically typed languages than plain C does. Using programmable type-conversion (\jargon{casting}) -and overloading, -native data-types can be translated automatically into appropriate -Prolog types, automatic destructors can be used to deal with most of the -cleanup required and C++ exception handling can be used to map Prolog -exceptions and interface conversion errors to C++ exceptions, which are -automatically mapped to Prolog exceptions as control is turned back to -Prolog. +and overloading, native data-types can be easily translated into +appropriate Prolog types, automatic destructors can be used to deal +with most of the cleanup required and C++ exception handling can be +used to map Prolog exceptions and interface conversion errors to C++ +exceptions, which are automatically mapped to Prolog exceptions as +control is turned back to Prolog. + +However, there are subtle differences between Prolog and C++ that can +lead to confusion; in particular, the lifetime of terms do not fit +well with the C++ notion of constructor/destructor. It might be +possible to handle this with "smart pointers", but that would lead to +other complications, so the decision was made to provide a thin layer +between the underlying C functions and the C++ classes/methods/functions. More information on the SWI-Prolog native types is given in \href{https://www.swi-prolog.org/pldoc/man?section=foreigntypes}{Interface Data Types}. -It would be tempting to use C++ conversion operators and method -overloading to automatically convert between C++ types such as +It would be tempting to use C++ implicit conversion operators and +method overloading to automatically convert between C++ types such as \ctype{std::string} and \ctype{int64_t} and Prolog foreign language interface types such as \ctype{term_t} and \ctype{atom_t}. However, types such as \ctype{term_t} are unsigned integers, so many of the @@ -139,36 +215,37 @@ some convenience functions (see \secref{summary-cpp2-changes}). \label{sec:cpp2-life-of-a-predicate} A foreign predicate is defined using the \cfuncref{PREDICATE}{} -macro.\footnote{Plus a few variations on this, such as +macro, pPlus a few variations on this, such as \cfuncref{PREDICATE_NONDET}{}, \cfuncref{NAMED_PREDICATE}{}, and -\cfuncref{NAMED_PREDICATE_NONDET}{}.} This defines an internal name for +\cfuncref{NAMED_PREDICATE_NONDET}{}. This defines an internal name for the function, registers it with the SWI-Prolog runtime (where it will be picked up by the use_foreign_library/1 directive), and defines the names \exam{A1}, \exam{A2}, etc. for the arguments.\footnote{You can define your own names for the arguments, for example: \exam{auto x=A1, y=A2, result=A3;}.} If a non-deterministic predicate is being defined, an additional parameter \exam{handle} is defined (of type -\ctype{control_t}). +\ctype{PlControl}). -The foreign predicate returns a value of \exam{true} or \exam{false} +The foreign predicate returns a value of \const{true} or \const{false} to indicate whether it succeeded or failed.\footnote{Non-deterministic predicates can also return a "retry" value.} If a predicate fails, it -could be simple failure (the equivalent of calling the builtin fail/0) -or an error (the equivalent of calling throw/1). When an exception is -raised, it is important that a return be made to the calling -environment as soon as possible. In C code, this requires checking -every call to check for failure, which can become cumbersome. C++ has -exceptions, so instead the code can wrap calls to \cfuncref{PL_*}{} functions with -\cfuncref{PlCheck}{}, which will do \exam{throw PlFail()} to exit from the top -level of the foreign predicate, and handle the failure or exception -appropriately. +could be simple failure (the equivalent of calling the builtin fail/0 +predicate) or an error (the equivalent of calling the throw/1 +predicate). When a Prolog exception is raised, it is important that a +return be made to the calling environment as soon as possible. In C +code, this requires checking every call for failure, which can become +cumbersome. C++ has exceptions, so instead the code can wrap calls to +\cfuncref{PL_*}{} functions with \cfuncref{PlCheck_PL}{} or +\cfuncref{PlCheckEx}{}, which will throw a PlException() to exit from +the top level of the foreign predicate, and handle the failure or +exception appropriately. The following three snippets do the same thing (for implementing the equivalent of =/2): \begin{code} PREDICATE(eq, 2) -{ PlCheck(A1.unify_term(A2)); +{ PlCheckFail(A1.unify_term(A2)); return true; } \end{code} @@ -181,8 +258,7 @@ PREDICATE(eq, 2) \begin{code} PREDICATE(eq, 2) -{ PlCheck(PL_unify(A1.C_, A2.C_)); - return true; +{ return PlWrap(PL_unify(A1.C_, A2.C_)); } \end{code} @@ -212,20 +288,24 @@ Prolog exceptions interrelate, see \secref{cpp2-exceptions}.) The various classes (\ctype{PlAtom}, \ctype{PlTerm}, etc.) are thin wrappers around the C interface's types (\ctype{atom_t}, -\ctype{term_t}, etc.). As such they inherit the concept of "null" from -these types (which is abstracted as \ctype{PlAtom::null}, +\ctype{term_t}, etc.). As such, they inherit the concept of "null" +from these types (which is abstracted as \ctype{PlAtom::null}, \ctype{PlTerm::null}, etc., which typically is equivalent to -\const{0}). You can check whether the object is "fully created" by -using the \cfuncref{verify}{} method - it will throw an exception if the -object is \const{null}. +\const{0}). Normally, you shouldn't need to check whether the object +is "fully created", but if you do, you can use the methods is_null() +or not_null(). -However, most of the classes have constructors that create a +Most of the classes have constructors that create a "complete" object. For example, \begin{code} PlAtom foo("foo"); \end{code} will ensure that the object \exam{foo} is useable and will throw an -exception if the atom can't be created. +exception if the atom can't be created. However, if you choose +to create an \ctype{PlAtom} object from a \ctype{atom_t} value, +no checking is done (similarly, no checking is done if you +create a \ctype{PlTerm} object using the \ctype{PlTerm_term_t} +constructor). To help avoid programming errors, most of the classes do not have a default "empty" constructor. For example, if you with to create a @@ -238,14 +318,26 @@ predicates, or modules. For these, it's often a good idea to define them as \ctype{static} variables that get created at load time, so that a lookup for each use isn't needed (atoms are unique, so \exam{PlAtom("foo")} requires a lookup for an atom \exam{foo} and -creates one if it isn't found). Sometimes, it's desirable to create -them "lazily", such as: +creates one if it isn't found). +C code sometimes creates objects "lazily" on first use: \begin{code} -static PlAtom foo(PlAtom::null}; +void my_function(...) +{ static atom_t ATOM_foo = 0; ... -if ( foo.is_null() ) - foo = PlAtom("foo"); + if ( ! foo ) + foo = PL_new_atom("foo"); + ... +} +\end{code} + +For C++, this can be done in a simpler way, because C++ +will call a local ``\ctype{static}'' constructor on +first use. +\begin{code} +void my_function(...) +{ static PlAtom ATOM_foo("foo"); +} \end{code} The class \ctype{PlTerm} (which wraps \ctype{term_t}) is the most @@ -258,8 +350,45 @@ various constructors are described in is not public; to create a "variable" term, you should use the subclass constructor \cfuncref{PlTerm_var}{}. +\subsection{Summary of files} +\label{sec:cpp2-files-summary} + +The following files are provided: +\begin{itemize} +\item + \file{SWI-cpp2.h} + Include this file to get the C++ API. It automatically includes + \file{SWI-cpp2-plx.h} but does not include \file{SWI-cpp2.cpp}. + +\item + \file{SWI-cpp2.cpp} + Contains the implementations of some methods and functions. + It must be compiled as-is or included in the foreign + predicate's source file. + Alternatively, it can be included with each include of + \file{SWI-cpp2.h} with this macro definition: + \begin{code} + #define _SWI_CPP2_CPP_inline inline + \end{code} + +\item + \file{SWI-cpp2-plx.h} + Contains the wrapper functions for the most of the functions in + \file{SWI-Prolog.h}. This file is not intended to be used by + itself, but is \exam{#include}d by \file{SWI-cpp2.h}. + +\item + \file{test_cpp.cpp}, \file{test_cpp.pl} + Contains various tests, including some longer sequences of + code that can help in understanding how the C++ API + is intended to be used. + In addition, there are \file{test_ffi.cpp}, \file{test_ffi.pl}, which + often have the same tests written in C, without the C++ API. + +\end{itemize} + \subsection{Summary of classes} -\label{sec:class-summary} +\label{sec:cpp2-class-summary} The list below summarises the classes defined in the C++ interface. @@ -332,21 +461,24 @@ a functor and the second is a \ctype{PlTermv} with the arguments. Vector of Prolog terms. See PL_new_term_refs(). The \const{[]} operator is overloaded to access elements in this vector. \ctype{PlTermv} is used to build complex terms and provide argument-lists to Prolog goals. +\end{description} + \classitem{PlException} -Subclass of \ctype{PlTerm} representing a Prolog exception. Provides -methods for the Prolog communication and mapping to human-readable text -representation. - \classitem{PlTypeError} -Subclass of \ctype{PlException} for representing a Prolog +Subclass of \ctype{std::exception}, representing a Prolog exception. +Provides methods for the Prolog communication and mapping to +human-readable text representation. +\begin{description} + \cfunction{PlTerm}{PlTypeError}{} +Creates a \ctype{PlException} object for representing a Prolog \except{type_error} exception. - \classitem{PlDomainError} -Subclass of \ctype{PlException} for representing a Prolog + \cfunction{PlTerm}{PlDomainError}{} +Creates a \ctype{PlException} object for representing a Prolog \except{domain_error} exception. - \classitem{PlExistenceError} -Subclass of \ctype{PlException} for representing a Prolog + \cfunction{PlTerm}{PlExistenceError}{} +Creates a \ctype{PlException} object for representing a Prolog \except{existence_error} exception. - \classitem{PlPermissionError} -Subclass of \ctype{PlException} for representing a Prolog + \cfunction{PlTerm}{PlPermissionError}{} +Creates a \ctype{PlException}object for representing a Prolog \except{permission_error} exception. \end{description} @@ -356,21 +488,35 @@ representation for fast comparison. (For more details on \ctype{atom_t}, see \href{https://www.swi-prolog.org/pldoc/man?section=foreigntypes}{Interface Data Types}). -\classitem{PlFunctor} + \classitem{PlFunctor} A wrapper for \ctype{functor_t}, which maps to the internal representation of a name/arity pair. -\classitem{PlPredicate} + \classitem{PlPredicate} A wrapper for \ctype{predicate_t}, which maps to the internal representation of a Prolog predicate. -\classitem{PlModule} + \classitem{PlModule} A wrapper for \ctype{module_t}, which maps to the internal representation of a Prolog module. \classitem{PlQuery} Represents opening and enumerating the solutions to a Prolog query. \classitem{PlFail} -Can be thrown to short-circuit processing and return failure to Prolog. -Performance-critical code should use \exam{return false} instead if -failure is expected. +Can be thrown to short-circuit processing and return failure to +Prolog. Performance-critical code should use \exam{return false} +instead if failure is expected. An error can be signaled by calling +Plx_raise_exception() or one of the PL_*_error() functions and then +throwing \ctype{PlFail}; but it's better style to create the error +throwing one of the subclasses of \ctype{PlException} e.g., +\exam{throw PlTypeError("int", t)}. + \classitem{PlException} +If a call to Prolog results in an error, the C++ interface converts +the error into a \ctype{PlException} object and throws it. If the +enclosing code doesn't intercept the exception, the \ctype{PlException} +object is turned back into a Prolog error. + \classitem{PlExceptionFail} +In some situations, a Prolog error cannot be turned into a +\ctype{PlException} object, so a \ctype{PlExceptionFail} object +is thrown. This is turned into failure by the \cfuncref{PREDICATE}{} +macro, resulting in normal Prolog error handling. \classitem{PlFrame} This utility-class can be used to discard unused term-references as well as to do `\jargon{data-backtracking}'. @@ -386,6 +532,46 @@ use C++ global constructors for registering foreign predicates. The required C++ function header and registration of a predicate is arranged through a macro called \cfuncref{PREDICATE}{}. +\subsection{Wrapper functions} +\label{sec:cpp2-wrapper-functions} + +The various PL_*() functions in \file{SWI-Prolog.h} have corresponding +Plx_*() functions. There are three kinds of wrappers: +\begin{itemize} + \item + "as-is" - the PL_*() function cannot cause an error. If it has a + return value, the caller will want to use it. (These are defined + using the PLX_ASIS() and PLX_VOID() macros.) + + \item + "exception wrapper" - the PL_*() function can return \const{false}, + indicating an error. The Plx*() function checks for this and + throws a \ctype{PlException} object containing the error. The + wrapper uses \exam{template C_t PlExce(C_t rc)}, + where \exam{C_t} is the return type of the PL_*() function. + (These are defined using the PLX_WRAP() macro.) + + \item + "success, failure, or error" - the PL_*() function can return + \const{true} if it succeeds and \const{false} if it fails or has a + runtime error. If it fails, the wrapper checks for a Prolog error + and throws a \ctype{PlException} object containing the error. The + wrapper uses \exam{template C_t PlWrap(C_t rc)}, + where \exam{C_t} is the return type of the PL_*() function. + (These are defined using the PLX_EXCE() macro.) + +\end{itemize} + +A few PL_*() functions do not have a corresponding Plx*() function +because they do not fit into one of these categories. For example, +PL_next_solution() has multiple return values (\const{PL_S_EXCEPTION}, +\const{PL_S_LAST}, etc.) if the query was opened with the +\const{PL_Q_EXT_STATUS} flag. + +Most of the PL_*() functions whose first argument is of type +\ctype{term_t}, \ctype{atom_t}, etc. have corresponding methods +in classes \ctype{PlTerm}, \ctype{PlAtom}, etc. + \subsection{Naming conventions, utility functions and methods (version 2)} \label{sec:cpp2-naming} @@ -395,9 +581,10 @@ The classes all have names starting with "Pl", using CamelCase; this contrasts with the C functions that start with "PL_" and use underscores. -The wrapper classes (\ctype{PlFunctor}, \ctype{PlAtom}, \ctype{PlTerm}) -all contain a field \exam{C_} that contains the wrapped value -(\ctype{functor_t}, \ctype{atom_t}, \ctype{term_t} respectively). +The wrapper classes (\ctype{PlFunctor}, \ctype{PlAtom}, +\ctype{PlTerm}), etc. all contain a field \exam{C_} that contains the +wrapped value (\ctype{functor_t}, \ctype{atom_t}, \ctype{term_t} +respectively). The wrapper classes (which subclass \ctype{WrappedC<\ldots>}) all define the following methods and constants: @@ -412,7 +599,7 @@ all define the following methods and constants: \exam{C_} - the wrapped value. This can be used directly when calling C functions, for example, if \exam{t} and \exam{a} are of type \ctype{PlTerm} - and \ctype{PlAtom}: \verb$Plcheck(PL_put_atom(t.C_,a.C_))$. + and \ctype{PlAtom}: \verb$Plcheck_PL(PL_put_atom(t.C_,a.C_))$. \item \exam{null} - the null value (typically \exam{0}, but code should not rely on this) @@ -423,13 +610,6 @@ all define the following methods and constants: \exam{reset()} - set the wrapped value to \exam{null} \item \exam{reset(new_value)} - set the wrapped value - \item - \exam{verify()} - if the wrapped value (\exam{C_}) - is \exam{null}, throw a \cfuncref{PlFail}{} exception. Typically, this check - is done after an allocation function such as Plnew_term_ref() - returns a null value, so the \cfuncref{PlFail}{} is turned into a a resource - error. However, if there is no pending exception, this results in - simple failure (see \secref{cpp2-exceptions-notes}). \item The \ctype{bool} operator is turned off - you should use not_null() instead.\footnote{The reason: a @@ -449,8 +629,8 @@ PREDICATE(mypred, 2) size_t length = 10; PlTerm_var callback; - PlCheck(PL_scan_options(options, 0, "mypred_options", mypred_options, - "ed, &length, &callback.C_)); + PlCheck_L(PL_scan_options(options, 0, "mypred_options", mypred_options, + "ed, &length, &callback.C_)); callback.record(); // Needed if callback is put in a blob that Prolog doesn't know about. // If it were an atom (OPT_ATOM): register_ref(). @@ -459,14 +639,15 @@ PREDICATE(mypred, 2) \end{code} For functions in \file{SWI-Prolog.h} that don't have a C++ equivalent -in \file{SWI-cpp2.h}, \cfuncref{PlCheck}{} is a convenience function that checks -the return code and throws a \ctype{PlFail} exception on failure. The -\cfuncref{PREDICATE}{} code catches \ctype{PlFail} exceptions and -converts them to the \ctype{foreign_t} return code for failure. If -the failure from the C function was due to an exception (e.g., -unification failed because of an out-of-memory condition), the foreign -function caller will detect that situation and convert the failure to -an exception. +in \file{SWI-cpp2.h}, \cfuncref{PlCheck_PL}{} is a convenience +function that checks the return code and throws a \ctype{PlFail} +exception on failure or \ctype{PlException} if there was an +exception. The \cfuncref{PREDICATE}{} code catches \ctype{PlFail} +exceptions and converts them to the \ctype{foreign_t} return code for +failure. If the failure from the C function was due to an exception +(e.g., unification failed because of an out-of-memory condition), the +foreign function caller will detect that situation and convert the +failure to an exception. The "getter" methods for \ctype{PlTerm} all throw an exception if the term isn't of the expected Prolog type. Where possible, the "getters" @@ -501,6 +682,112 @@ them to \ctype{int} but C++ doesn't. In general, this shouldn't cause any problems, but care must be used with the various getters for integers. +\subsection{Limitations of the interface} +\label{sec:cpp2-limitations} + +The C++ API remains a work in progress. + +\subsubsection{Strings} +\label{sec:cpp2-limitations-strings} + +SWI-Prolog string handling has evolved over time. The functions that +create atoms or strings using \ctype{char*} or \ctype{wchar_t*} are +"old school"; similarly with functions that get the string as +\ctype{char*} or \ctype{wchar_t*}. The PL_{get_unify_put}_[nw]chars() +family is more friendly when it comes to different input, output, +encoding and exception handling. + +Roughly, the modern API is PL_get_nchars(), PL_unify_chars() +and PL_put_chars() on terms. There is only half of the API for +atoms as PL_new_atom_mbchars() and PL-atom_mbchars(), which take an encoding, length and +char*. + +However, there is no native "string" type in C++; the \ctype{char*} +strings can be automatically cast to string. If a C++ interface +provides only \ctype{std::string} arguments or return values, that +can introduce some inefficiency; therefore, many of the functions +and constructors allow either a \ctype{char*} or \ctype{std::string} +as a value (also \ctype{wchar_t*} or \ctype{std::wstring}. + +For return values, \ctype{char*} is dangerous because it can point to +local or stack memory. For this reason, wherever possible, the C++ API +returns a \ctype{std::string}, which contains a copy of the the +string. This can be slightly less efficient that returning a +\ctype{char*}, but it avoids some subtle and pervasive bugs that even +address sanitizers can't detect.\footnote{If we wish to minimize the +overhead of passing strings, this can be done by passing in a pointer +to a string rather than returning a string value; but this is more +cumbersome and modern compilers can often optimize the code to avoid +copying the return value.} + +Many of the classes have a as_string() method - this might be changed +in future to to_string(), to be consistent with +\exam{std::to_string()}. However, the method names such as +as_int32_t() were chosen istntead of to_int32_t() because they imply +that the representation is already an \ctype{int32_t}, and not that +the value is converted to a \ctype{int32_t}. That is, if the value is +a float, \ctype{int32_t} will fail with an error rather than (for example) +truncating the floating point value to fit into a 32-bit integer. + +\subsubsection{Object handles} +\label{sec:cpp2-limitations-handles} + +Many of the "opaque object handles", such as \ctype{atom_t}, +\ctype{term_t}, and \ctype{functor_t} are integers.\footnote{Typically +\ctype{uintptr_t} values, which the C standard defines as +``an unsigned integer type with the property that any valid pointer to void can be converted to this type, then converted back to pointer to void, and the result will compare equal to the original pointer.''} +As such, there is no compile-time detection of passing the +wrong handle to a function. + +This leads to a problem with classes such as \ctype{PlTerm} - +C++ overloading cannot be used to distinguish, for example, creating +a term from an atom versus creating a term from an integer. +There are number of possible solutions, including: +\begin{itemize} +\item A subclass for each kind of initializer; +\item A tag for each kind of intializer; +\item Change the the C code to use a \ctype{struct} + instead of an integer. +\end{itemize} + +It is impractical to change the C code, both because of the +amount of edits that would be required and also because of +the possibility that the changes would inhibit some optimizations. + +There isn't much difference between subclasses versus tags; but +as a matter of design, it's better to specify things as constants +than as (theoretically) variables, so the decision was to use +subclasses. + +\subsection{Linking embedded applications using swipl-ld} \label{sec:cpp2-plld} + +The utility program \program{swipl-ld} (Win32: swipl-ld.exe) works with +both C and C++ programs. See +\href{https://www.swi-prolog.org/pldoc/man?section=plld}{Linking embedded applications using swipl-ld} +for more details. + +Your C++ compiler should support at least C++-17. + +To avoid incompatibilities amongst the various C++ compilers' ABIs, +the object file from compiling \file{SWI-cpp2.cpp} is not included +in the shared object \file{libswipl}; instead, it must be compiled +along with any foreign predicate files. You can do this in three ways: +\begin{itemize} +\item + Compile \file{SWI-cpp2.cpp} separately. +\item + Add \exam{#include SWI-cpp2.cpp} to one of the foreign predicate files. +\item + Wherever you have \exam{#include SWI-cpp2.h}, add + \begin{code} + #define _SWI_CPP2_CPP_inline inline + #include + \end{code} + This will cause the compiler to attempt to inline all the functions + and methods, even those that are rarely used, resulting in some + code bloat. +\end{itemize} + \section{Examples (version 2)} \label{sec:cpp2-examples} @@ -704,7 +991,7 @@ auto t = PlTerm_atom("someName"); the result of unification should always be checked (e.g., an "always succeed" unification could fail due to an out-of-memory error); the \cfuncref{unify_XXX}{} methods return - a \ctype{bool} and they can be wrapped inside a \cfuncref{PlCheck}{} + a \ctype{bool} and they can be wrapped inside a \cfuncref{PlCheckFail}{} to raise an exception on unification failure. \end{itemize} @@ -744,19 +1031,29 @@ functions can still be used. There still remains the problems of Unicode and encodings. \ctype{std::wstring} is one way of dealing with this. And for interfaces that use \ctype{std::string}, an encoding can be -specified.\footnote{As of 2022-11, this had only been partially +specified.\footnote{As of 2023-04, this had only been partially implemented}. Some of the details for this - such as the default encoding - may change slightly in the future. \section{Porting from version 1 to version 2} \label{sec:cpp2-porting-1-2} +\file{SWI-cpp2.h} is not complete; it needs `file{SWI-cpp2.cpp} to implement +some functions. The easiest way of taking care of this is to add +\exam{#include } in your "main" file; alternatively, you can +create another source file that contains the "include" statement. + The easiest way of porting from \file{SWI-cpp.h} to \file{SWI-cpp2.h} is to change the \exam{\#include "SWI-cpp.h"} to \exam{\#include "SWI-cpp2.h"} and look at the warning and error messages. Where possible, version 2 keeps old interfaces with a "deprecated" flag if there is a better way of doing things with version 2. +For convenience when calling PL_*() functions, the Plx_*() wrapper +functions add error checking. Also, most of the PL_*() functions that +work with \ctype{term_t}, \ctype{atom_t}, etc. have corresponding +methods in \ctype{PlTerm}, \ctype{PlAtom}, etc. + Here is a list of typical changes: \begin{itemize} \item @@ -777,15 +1074,15 @@ Here is a list of typical changes: \item Instead of returning \const{false} from a predicate for failure, you can do \exam{throw \cfuncref{PlFail}{}}. This mechanism is also used by - \cfuncref{PlCheck}{rc}. Note that throwing an exception is + \cfuncref{PlCheckFail}{rc}. Note that throwing an exception is significantly slower than returning \const{false}, so - performance-critical code should avoid \cfuncref{PlCheck}{rc}. + performance-critical code should avoid \cfuncref{PlCheckFail}{rc}. \item - You can use the \cfuncref{PlCheck}{rc} to check the return code - from a function in \file{SWI-Prolog} and throw a \cfuncref{PlFail}{} + You can use the \cfuncref{PlCheck_PL}{rc} to check the return code + from a function in \file{SWI-Prolog} and throw a \ctype{PlFail} exception to short-circuit execution and return failure (\const{false}) - to Prolog. + to Prolog (or throw a \ctype{PlException} if there was a Prolog error. \item \exam{PlAtom::handle} has been replaced by \exam{PlAtom::C_}. @@ -844,14 +1141,14 @@ PREDICATE(unify_zero, 1) or: \begin{code} PREDICATE(unify_zero, 1) -{ PlCheck(PL_unify_integer(t.C_, 0)); +{ PlCheck_PL(PL_unify_integer(t.C_, 0)); return true; } \end{code} or: \begin{code} PREDICATE(unify_zero, 1) -{ PlCheck(A1.unify_integer(0)); +{ PlCheckFail(A1.unify_integer(0)); return true; } \end{code} @@ -879,22 +1176,28 @@ unify_zero(term_t a1) } \end{code} -\subsection{\cfuncref{PlCheck}{} convenience function} +\subsection{\cfuncref{PlCheckFail}{}, \cfuncref{PlCheckEx}{}, and \cfuncref{PlCheck_PL}{} convenience functions} \label{sec:cpp2-plcheck} -In general, wherever there is a method that wraps a C "PL_" -function, \cfuncref{PlCheck}{} can be used to return failure -to Prolog from the "PL_" function. +If one of the C "PL_" functions in \file{SWI-Prolog.h} returns +failure, this can be either a Prolog-style failure (e.g. from +PL_unify() or PL_next_solution()) or an error. If the failure is due +to an error, it's usually best to immediately return to Prolog - and +this can be done with the \cfuncref{PlCheckEx}{} function, which turns +a Prolog error into a C++ \ctype{PlException}. \cfuncref{PlCheck}{} +calls PlCheckEx() and additionally throws PlFail() if the failure is +for Prolog failure. -The code for \cfuncref{PlCheck}{} is very simple - it checks the -return code and throws \ctype{PlFail} if the return code isn't -"true". If the return code is from a Prolog function (that is, -a function starting with "PL_"), the return code can be "false" -either because of failure or because an exception happened. -If the cause is an exception, then the only sensible thing is to -return to Prolog immediately; throwing \ctype{PlFail} will do this. -See also \secref{cpp2-exceptions-notes}. +The code for \cfuncref{PlCheck}{} is just +\begin{code} +void PlCheck(int rc) +{ if ( !PlCheckEx(rc) ) throw PlFail(); } +\end{code} +\cfuncref{PlCheckEx}{} calls PL_exception() to see if there is a +Prolog exception; if so, the Prolog exception is converted to a +\ctype{PlException} object, which is then thrown. For more details on +the C++ exceptions, see \secref{cpp2-exceptions}. \section{The class PlTerm (version 2)} \label{sec:cpp2-plterm} @@ -1113,13 +1416,13 @@ PREDICATE(hostname, 1) return false; } \end{code} -An alternative way of writing this would use the \cfuncref{PlCheck}{} +An alternative way of writing this would use the \cfuncref{PlCheckFail}{} to raise an exception if the unification fails. \begin{code} PREDICATE(hostname2, 1) { char buf[256]; - PlCheck(gethostname(buf, sizeof buf) == 0); - PlCheck(A1.unify_atom(buf)); + PlCheckFail(gethostname(buf, sizeof buf) == 0); + PlCheckFail(A1.unify_atom(buf)); return true; } \end{code} @@ -1370,8 +1673,8 @@ main(int argc, char **argv) PlTail l(av[0]); for(int i=0; i +#include #include #include #include "SWI-cpp2.h" -#include -#include #include #include #include @@ -70,14 +70,27 @@ how the various predicates can be called from Prolog. #include using namespace std; +#ifdef O_DEBUG +#define DEBUG(g) g +#else +#define DEBUG(g) (void)0 +#endif + + +PREDICATE(hello, 0) +{ PlQuery q("write", PlTermv(PlTerm_atom("hello hello hello"))); + PlCheckFail(q.next_solution()); + return true; +} PREDICATE(hello, 2) { std::stringstream buffer; + // This will result in an encoding error if A1 isn't Latin-1 buffer << "Hello " << A1.as_string() << endl; buffer << "Hello " << A1.as_string().c_str() << endl; // Same output as previous line - buffer << "Hello " << A1.as_string(EncLatin1).c_str() << endl; // Also same, if it's ASCII - buffer << "Hello " << A1.as_string(EncUTF8).c_str() << endl; - buffer << "Hello " << A1.as_string(EncLocale).c_str() << endl; // Can vary by locale settings + buffer << "Hello " << A1.as_string(PlEncoding::Latin1).c_str() << endl; // Also same, if it's ASCII + buffer << "Hello " << A1.as_string(PlEncoding::UTF8).c_str() << endl; + buffer << "Hello " << A1.as_string(PlEncoding::Locale).c_str() << endl; // Can vary by locale settings return A2.unify_string(buffer.str()); } @@ -88,9 +101,9 @@ PREDICATE(hello2, 2) // The following have the same output as hello/1, if A1 is an atom buffer << "Hello2 " << atom_a1.as_string() << endl; buffer << "Hello2 " << A1.as_string().c_str() << endl; - buffer << "Hello2 " << A1.as_string(EncLatin1).c_str() << endl; - buffer << "Hello2 " << A1.as_string(EncUTF8).c_str() << endl; - buffer << "Hello2 " << A1.as_string(EncLocale).c_str() << endl; + buffer << "Hello2 " << A1.as_string(PlEncoding::Latin1).c_str() << endl; + buffer << "Hello2 " << A1.as_string(PlEncoding::UTF8).c_str() << endl; + buffer << "Hello2 " << A1.as_string(PlEncoding::Locale).c_str() << endl; return A2.unify_string(buffer.str()); } @@ -140,8 +153,8 @@ PREDICATE(name_arity, 3) /* name_arity(+Term, -Name, -Arity) */ PlTerm name(A2); PlTerm arity(A3); - PlCheck(name.unify_atom(term.name())); - PlCheck(arity.unify_integer(term.arity())); + PlCheckFail(name.unify_atom(term.name())); + PlCheckFail(arity.unify_integer(term.arity())); return true; } @@ -175,15 +188,9 @@ PREDICATE(average, 3) /* average(+Templ, :Goal, -Average) */ return A3.unify_float(double(sum) / double(n)); } -PREDICATE(hello, 0) -{ PlQuery q("write", PlTermv(PlTerm_atom("hello world\n"))); - PlCheck(q.next_solution()); - return true; -} - -PREDICATE(hello_query, 2) +PREDICATE(call_cpp, 2) { PlQuery q(A1.as_string(), PlTermv(A2)); - PlCheck(q.next_solution()); + PlCheckFail(q.next_solution()); // There's no need for calling q.cut() - it's done implicitly by the // query's destructor. return true; @@ -191,24 +198,37 @@ PREDICATE(hello_query, 2) PREDICATE(call_cut, 1) { PlQuery q(A1.as_string(), PlTermv()); - PlCheck(q.next_solution()); - q.cut(); + PlCheckFail(q.next_solution()); + q.cut(); // This tests that ~PlQuery() behaves correctly if cut() had been called return true; } -PREDICATE(hello_call, 1) -{ PlCheck(PlCall(A1)); +// TODO: add tests for PlQuery() with PL_Q_EXT_STATUS + +PREDICATE(call_cpp, 1) +{ PlCheckFail(PlCall(A1)); return true; } +PREDICATE(call_cpp_ex, 2) +{ try + { PlCheckFail(PlCall(A1, PL_Q_CATCH_EXCEPTION)); + } catch ( PlException& ex ) + { bool rc = A2.unify_term(ex.term()); + Plx_clear_exception(); + return rc; + } + return A2.unify_string("no exception"); +} + PREDICATE(atom_to_string, 2) { PlAtom a(A1.as_atom()); - PlCheck(A2.unify_string(a.as_string(EncUTF8))); + PlCheckFail(A2.unify_string(a.as_string(PlEncoding::UTF8))); return true; } PREDICATE(term_to_string, 2) -{ PlCheck(A2.unify_string(A1.as_string(EncUTF8))); +{ PlCheckFail(A2.unify_string(A1.as_string(PlEncoding::UTF8))); return true; } @@ -216,10 +236,9 @@ PREDICATE(term, 1) { return A1.unify_term(PlCompound("hello", PlTermv(PlTerm_atom("world")))); } -PlAtom ATOM_atom("atom"); - PREDICATE(term, 2) -{ PlAtom a(A1.as_atom()); +{ static PlAtom ATOM_atom("atom"); + PlAtom a(A1.as_atom()); if ( a.C_ == ATOM_atom.C_ ) return A2.unify_atom("hello world"); // or A2.unify_term(PlAtom("hello world")); @@ -245,7 +264,7 @@ PREDICATE(can_unify, 2) } PREDICATE(eq1, 2) -{ PlCheck(A1.unify_term(A2)); +{ PlCheckFail(A1.unify_term(A2)); return true; } @@ -254,7 +273,7 @@ PREDICATE(eq2, 2) } PREDICATE(eq3, 2) -{ PlCheck(PL_unify(A1.C_, A2.C_)); +{ PlCheckFail(PL_unify(A1.C_, A2.C_)); return true; } @@ -274,7 +293,7 @@ PREDICATE(cappend, 3) PlTerm_var e; while(l1.next(e)) - PlCheck(l3.append(e)); + PlCheckFail(l3.append(e)); return A2.unify_term(l3); } @@ -326,7 +345,7 @@ PREDICATE(cpp_call_, 3) { if ( verbose ) cout << "cpp_call result: rc=" << rc << ": " << A1.as_string() << endl; } else - { PlException_qid ex; + { PlTerm_term_t ex(Plx_exception(0)); if ( ex.is_null() ) { if ( verbose ) cout << "cpp_call failed" << endl; @@ -351,7 +370,7 @@ PREDICATE(cpp_call_, 3) PREDICATE(cpp_atom_codes, 2) { int rc = PlCall("atom_codes", PlTermv(A1, A2)); if ( ! rc ) - { PlException_qid ex; + { PlException ex(PlTerm_term_t(Plx_exception(0))); if ( ex.is_null() ) cout << "atom_codes failed" << endl; else @@ -376,11 +395,33 @@ PREDICATE(square_roots, 2) PlTerm_tail list(A2); for(int i=0; i(malloc(A1.as_size_t())); + return A2.unify_pointer(ptr); +} + +PREDICATE(free_malloc, 1) +{ char *ptr = static_cast(A1.as_pointer()); + free(ptr); + return true; +} + +PREDICATE(malloc_PL_malloc, 2) +{ char *ptr = static_cast(Plx_malloc(A1.as_size_t())); + return A2.unify_pointer(ptr); +} + +PREDICATE(free_PL_malloc, 1) +{ char *ptr = static_cast(A1.as_pointer()); + Plx_free(ptr); + return true; +} + PREDICATE(malloc_new, 2) { char *ptr = new char[A1.as_size_t()]; return A2.unify_pointer(ptr); @@ -434,16 +475,21 @@ PREDICATE(make_functor, 3) // make_functor(foo, x, foo(x)) A3[1].unify_term(A2); } +PREDICATE(cpp_arg, 3) // like arg/3 but Arg must be instantiated +{ auto i = A1.as_uint64_t(); + return A2[i].unify_term(A3); +} + PREDICATE(make_uint64, 2) -{ PlCheck(A2.unify_integer(A1.as_uint64_t())); +{ PlCheckFail(A2.unify_integer(A1.as_uint64_t())); return true; } PREDICATE(make_int64, 2) { int64_t i; - // This function is for testing PlCheck() - PlCheck(PL_get_int64_ex(A1.C_, &i)); - PlCheck(A2.unify_integer(i)); + // This tests PlEx + A1.get_int64_ex(&i); + PlCheckFail(A2.unify_integer(i)); return true; } @@ -482,10 +528,24 @@ PREDICATE(hostname2, 1) { char buf[255+1]; // SYSv2; POSIX.1 has a smaller HOST_NAME_MAX+1 if ( no_gethostname(buf, sizeof buf) != 0 ) throw PlFail(); - PlCheck(A1.unify_atom(buf)); + PlCheckFail(A1.unify_atom(buf)); return true; } +PREDICATE(eq_int64, 2) +{ return A1 == A2.as_int64_t(); +} + +PREDICATE(lt_int64, 2) +{ return A1 < A2.as_int64_t(); +} + +PREDICATE(get_atom_ex, 2) +{ PlAtom a(PlTerm::null); + A1.get_atom_ex(&a); + return A2.unify_atom(a); +} + PREDICATE(ensure_PlTerm_forward_declarations_are_implemented, 0) { /********************************************************************* @@ -498,8 +558,9 @@ PREDICATE(ensure_PlTerm_forward_declarations_are_implemented, 0) PlTerm_atom t_atom3(PlAtom("an atom")); PlTerm_atom p_atom4(std::string("abc")); PlTerm_atom p_atom5(std::wstring(L"世界")); - PlTerm_term_t t_t(PL_new_term_ref()); + PlTerm_term_t t_t(Plx_new_term_ref()); PlTerm_term_t t_null(PlTerm::null); + // The various integer types are also used in IntInfo. PlTerm_integer t_int1(std::numeric_limits::max()); PlTerm_integer t_int1b(std::numeric_limits::min()); PlTerm_integer t_int2(std::numeric_limits::max()); @@ -512,7 +573,9 @@ PREDICATE(ensure_PlTerm_forward_declarations_are_implemented, 0) PlTerm_integer p_size2(std::numeric_limits::max()); PlTerm_float t_float(1.23); PlTerm_pointer t_ptr(&t_var); - PlTerm_recorded t_rec(PlTerm_atom("xyz").record()); + // There's a better test for PlRecordRaw in int_info/2 + PlRecordRaw r_xyz(PlTerm_atom("xyz").record_raw()); + PlTerm t_rec(r_xyz.term()); PlTerm_string t_string1("abc"); PlTerm_string t_string2(L"世界"); const char codes[] = {81,82,83,0}; @@ -544,7 +607,6 @@ PREDICATE(ensure_PlTerm_forward_declarations_are_implemented, 0) t_int1.integer(&v4); t_int1.integer(&v5); } - // TODO: combine this test with t_something.integer(&x04) etc. long x04 = t_atom2.as_long(); int x05 = t_int1.as_int(); uint32_t x06 = t_var.as_uint32_t(); @@ -560,11 +622,8 @@ PREDICATE(ensure_PlTerm_forward_declarations_are_implemented, 0) size_t x21 = t_var.arity(); PlAtom x22 = t_var.name(); - // TODO: add comparisons, etc. - //(void)x01; //(void)x01a; - // TODO: std::string string() const; (void)a5a; (void)x04; (void)x05; @@ -655,15 +714,15 @@ PREDICATE(unify_int_set, 1) int64_t i_int64 = 0; uint64_t i_uint64 = 0; - PlCheck(A1.unify_integer(i_int)); - PlCheck(A1.unify_integer(i_unsigned)); - PlCheck(A1.unify_integer(i_long)); - PlCheck(A1.unify_integer(i_unsigned_long)); - PlCheck(A1.unify_integer(i_size)); - PlCheck(A1.unify_integer(i_int32)); - PlCheck(A1.unify_integer(i_uint32)); - PlCheck(A1.unify_integer(i_int64)); - PlCheck(A1.unify_integer(i_uint64)); + PlCheckFail(A1.unify_integer(i_int)); + PlCheckFail(A1.unify_integer(i_unsigned)); + PlCheckFail(A1.unify_integer(i_long)); + PlCheckFail(A1.unify_integer(i_unsigned_long)); + PlCheckFail(A1.unify_integer(i_size)); + PlCheckFail(A1.unify_integer(i_int32)); + PlCheckFail(A1.unify_integer(i_uint32)); + PlCheckFail(A1.unify_integer(i_int64)); + PlCheckFail(A1.unify_integer(i_uint64)); return true; } @@ -674,15 +733,15 @@ PREDICATE(c_PL_unify_nil, 1) { return static_cast(PL_unify_n PREDICATE(cpp_unify_nil, 1) { return A1.unify_nil(); } -PREDICATE(check_c_PL_unify_nil, 1) { PlCheck(PL_unify_nil(A1.C_)); return true; } +PREDICATE(check_c_PL_unify_nil, 1) { PlEx(PL_unify_nil(A1.C_)); return true; } -// Repeat the above 4, for *_ex(): +// Repeat the above, for *_ex(): PREDICATE(c_PL_unify_nil_ex, 1) { return static_cast(PL_unify_nil_ex(A1.C_)); } -PREDICATE(cpp_unify_nil_ex, 1) { return A1.unify_nil_ex(); } +PREDICATE(cpp_unify_nil_ex, 1) { A1.unify_nil_ex(); return true; } -PREDICATE(check_c_PL_unify_nil_ex, 1) { PlCheck(PL_unify_nil_ex(A1.C_)); return true; } +PREDICATE(check_c_PL_unify_nil_ex, 1) { PlEx(PL_unify_nil_ex(A1.C_)); return true; } @@ -690,32 +749,31 @@ PREDICATE(c_PL_get_nil, 1) { return static_cast(PL_get_nil PREDICATE(cpp_as_nil, 1) { A1.as_nil(); return true; } -PREDICATE(check_c_PL_get_nil, 1) { PlCheck(PL_get_nil(A1.C_)); return true; } +PREDICATE(check_c_PL_get_nil, 1) { PlEx(PL_get_nil(A1.C_)); return true; } -PREDICATE(check_c_PL_get_nil_ex, 1) { PlCheck(PL_get_nil_ex(A1.C_)); return true; } +PREDICATE(check_c_PL_get_nil_ex, 1) { PlEx(PL_get_nil_ex(A1.C_)); return true; } // Functions re-implemented from ffi4pl.c -// range_cpp/3 is equivalent to range_ffialloc/3 +// range_cpp/3 is similar to range_ffialloc/3 -/* range_cpp/3 is used in regression tests +/* range_cpp/3 is used in regression tests: - PL_foreign_context_address() and malloc()-ed context. */ -struct RangeContext +struct RangeCtxt { long i; long high; - explicit RangeContext(long i, long high) + explicit RangeCtxt(long i, long high) : i(i), high(high) { } }; PREDICATE_NONDET(range_cpp, 3) { auto t_low = A1, t_high = A2, t_result = A3; - PlForeignContextPtr ctxt(handle); + PlForeignContextPtr ctxt(handle); - switch( PL_foreign_control(handle) ) + switch( handle.foreign_control() ) { case PL_FIRST_CALL: - ctxt.set(new RangeContext(t_low.as_long(), - t_high.as_long())); + ctxt.set(new RangeCtxt(t_low.as_long(), t_high.as_long())); break; case PL_REDO: break; @@ -732,7 +790,8 @@ PREDICATE_NONDET(range_cpp, 3) ctxt->i += 1; if ( ctxt->i >= ctxt->high ) - return true; // Last result: succeed without a choice point + { return true; // Last result: succeed without a choice point + } ctxt.keep(); PL_retry_address(ctxt.get()); // Succeed with a choice point @@ -741,50 +800,53 @@ PREDICATE_NONDET(range_cpp, 3) // For benchmarking `throw PlThrow()` vs `return false` -// Times are given for 10 million failures -// e.g.: time((between(1,10000000,X), unify_zero_0(X))). -// Baseline: time((between(1,10000000,X), fail)). 0.44 sec +// Times are given for 1 million failures + +// 0.085 sec for ime((between(1,1000000,X), fail)). + +// 0.16 sec for time((between(1,1000000,X), X=0)). -// 0.68 sec - essentially the same for time((... X=0). +// 0.20 sec for time((between(1,1000000,X), unify_zero_0(X))). static foreign_t unify_zero_0(term_t a1) -{ return static_cast(PL_unify_integer(a1, 0)); +{ return static_cast(Plx_unify_integer(a1, 0)); } -// If you wish to use the C-style install_test_cpp() style instead, you -// need to use extern "C" to ensure that names don't get mangled. -// So, it's easier to use the PlRegister class (which might need -// modification to more than one argument). +// unify_zero_0() is C code, not C++, but it's registered using +// PlRegister class (this currently only works for foreign predicates +// with a single argument). If you wish to use the C-style +// install_test_cpp() style instead, you need to use extern "C" to +// ensure that names don't get mangled. static PlRegister _x_unify_zero_4_1(nullptr, "unify_zero_0", unify_zero_0); -// 0.68 sec +// 0.23 sec for time((between(1,1000000,X), unify_zero_1(X))). PREDICATE(unify_zero_1, 1) -{ if ( !PL_unify_integer(A1.C_, 0) ) +{ if ( !Plx_unify_integer(A1.C_, 0) ) return false; return true; } -// 10.9 sec +// 3.3 sec for time((between(1,1000000,X), unify_zero_2(X))). PREDICATE(unify_zero_2, 1) -{ if ( !PL_unify_integer(A1.C_, 0) ) +{ if ( !Plx_unify_integer(A1.C_, 0) ) throw PlFail(); return true; } -// 13.5 sec +// 4.0 sec for time((between(1,1000000,X), unify_zero_3(X))). PREDICATE(unify_zero_3, 1) -{ PlCheck( PL_unify_integer(A1.C_, 0) ); +{ PlCheckFail( Plx_unify_integer(A1.C_, 0) ); return true; } -// 15.1 sec +// 4.0 sec for time((between(1,1000000,X), unify_zero_4(X))). PREDICATE(unify_zero_4, 1) -{ PlCheck(A1.unify_integer(0)); +{ PlCheckFail(A1.unify_integer(0)); return true; } -// 0.71 sec +// 0.23 sec for time((between(1,1000000,X), unify_zero_5(X))). PREDICATE(unify_zero_5, 1) { return A1.unify_integer(0); } @@ -841,7 +903,6 @@ PREDICATE(unify_foo_string_2b, 1) // Predicates for checking native integer handling // See https://en.cppreference.com/w/cpp/types/numeric_limits -// TODO: typeid(ty).name() (needs #include , #include ) #define DECLS_ROW(ty) X(#ty, ty, std::numeric_limits::min(), std::numeric_limits::max()) @@ -866,6 +927,8 @@ PREDICATE(unify_foo_string_2b, 1) DECLS_ROW(long long) \ DECLS_ROW(unsigned long long) \ DECLS_ROW(size_t) \ + DECLS_ROW(int16_t) \ + DECLS_ROW(uint16_t) \ DECLS_ROW(int32_t) \ DECLS_ROW(uint32_t) \ DECLS_ROW(uint64_t) \ @@ -879,48 +942,61 @@ PREDICATE(unify_foo_string_2b, 1) PlTermv(PlTerm_atom(name), \ PlTerm_integer(sizeof (x_type)), \ PlTerm_integer(x_min), \ - PlTerm_integer(x_max))).record() }, - -typedef std::map IntInfo; + PlTerm_integer(x_max))).record_raw() }, + +typedef std::map IntInfo; + +// IntInfoCtxt has a pointer to the static IntInfo to get around a +// memory leak. If int_info_static is at the top level of this file, +// its constructor happens before Prolog has set up the memory +// management for GMP (PlTerm_integer() with a suitably large value +// uses GMP), and therefore the GMP value isn't freed when Prolog +// terminates. However, if `int_info_static` is inside the +// constructor, there's no leak. + +struct IntInfoCtxt +{ IntInfo *int_info; + IntInfo::const_iterator it; + explicit IntInfoCtxt() + { static IntInfo int_info_static = { DECLS }; + int_info = &int_info_static; + it = int_info->cbegin(); + } +}; -static const IntInfo int_info = { DECLS }; #undef X -struct IntInfoContext -{ IntInfo::const_iterator it; - explicit IntInfoContext() - : it(int_info.cbegin()) { } -}; +// int_info_(name, result, ctx) is called from int_info/2 to do a +// lookup of the name in ctx->int_info (see the IntInfoCtxt +// constructor for how this gets initialized). This finds a recored +// term, from which a fresh term is concstructed using +// PlRecordRaw::term(), and the unification is done in the context of +// PlRewindOnFail(). This ensures that if the unification fails, any +// partial bindgins will be removed. static bool -int_info_(const std::string name, PlTerm result) -{ const auto it = int_info.find(name); - if ( it == int_info.cend() ) +int_info_(const std::string name, PlTerm result, IntInfoCtxt *ctxt) +{ const auto it = ctxt->int_info->find(name); + if ( it == ctxt->int_info->cend() ) return false; - PlTerm t = PlTerm_recorded(it->second); - return PlRewindOnFail([result,t]() -> bool { return result.unify_term(t); }); + return PlRewindOnFail([&result,&it]() -> bool + { return result.unify_term(it->second.term()); }); } PREDICATE_NONDET(int_info, 2) -{ PlForeignContextPtr ctxt(handle); - - // When PL_PRUNED is called A1 is not bound; - // therefore, we need to do the switch on PL_foreign_control(handle) - // before checking A1.is_variable(). We can't put the test for - // A1.is_variable outside the PL_foreign_control(handle) switch - // because when PL_PRUNED happens, A1 might not be a variable. That - // is, we can't use A1.is_variable() as a way of checking whether we - // should do backtracking or not. So, we need to do an extra test - // for PL_FIRST_CALL and not allocate ctxt for backtracking if - // !A1.is_variable(). (There are, of course, other ways of - // structuring this code.) - - switch( PL_foreign_control(handle) ) +{ PlForeignContextPtr ctxt(handle); + + // When called with PL_PRUNED, A1 is not bound; therefore, we need + // to do the switch on PL_foreign_control(handle) before checking + // A1.is_variable(). That is, we can't use A1.is_variable() as a way + // of checking whether we should do backtracking or not. + + switch( handle.foreign_control() ) { case PL_FIRST_CALL: if ( !A1.is_variable() ) // int_info is a map, so unique on lookup - return int_info_(A1.as_string(), A2); - ctxt.set(new IntInfoContext()); + return int_info_(A1.as_string(), A2, ctxt.get()); + ctxt.set(new IntInfoCtxt()); break; case PL_REDO: break; @@ -931,13 +1007,15 @@ PREDICATE_NONDET(int_info, 2) return false; } assert(A1.is_variable()); - while ( ctxt->it != int_info.cend() ) - { if ( int_info_(ctxt->it->first, A2 ) ) - { PlCheck(A1.unify_atom(ctxt->it->first)); + while ( ctxt->it != ctxt->int_info->cend() ) + { if ( int_info_(ctxt->it->first, A2, ctxt.get()) ) + { if ( !A1.unify_atom(ctxt->it->first) ) + return false; // Shouldn't happen because A1 is a varaible ctxt->it++; - if ( ctxt->it == int_info.cend() ) - return true; // Last result: no choice point - ctxt.keep(); + if ( ctxt->it == ctxt->int_info->cend() ) + { return true; // Last result: no choice point + } + ctxt.keep(); // Need ctxt for REDO PL_retry_address(ctxt.get()); // Succeed with choice point } ctxt->it++; @@ -948,22 +1026,24 @@ PREDICATE_NONDET(int_info, 2) PREDICATE(type_error_string, 3) { PlException e(PlTypeError("foofoo", A1)); - std::wstring msg(e.as_wstring()); - PlCheck(A2.unify_string(msg)); - PlCheck(A3.unify_term(e)); + // std::wstring msg(e.as_wstring()); // TODO: restore this + std::string msg(e.as_string()); + PlCheckFail(A2.unify_string(msg)); + PlCheckFail(A3.unify_term(e.term())); return true; } -// Re-implementing w_atom_ffi_/2 in ffi4pl.c: +// Re-implementing w_atom_ffi_/2: PREDICATE(w_atom_cpp_, 2) { auto stream = A1, t = A2; IOSTREAM* s; - PlCheck(PL_get_stream(stream.C_, &s, SIO_INPUT)); + Plx_get_stream(stream.C_, &s, SIO_INPUT); { PlStringBuffers _string_buffers; size_t len; - const pl_wchar_t *sa = PL_atom_wchars(t.as_atom().C_, &len); + const pl_wchar_t *sa = Plx_atom_wchars(t.as_atom().C_, &len); + // TODO: Sfprintf() doesn't get format checked in C++ Sfprintf(s, "/%Ws/%zd", sa, len); } return TRUE; @@ -973,17 +1053,10 @@ PREDICATE(w_atom_cpp_, 2) /* TODO: Move the "cpp_options" predicate and the associated tests to somewhere in main SWI-Prolog system. */ -static PL_option_t scan_options[] = -{ PL_OPTION("quoted", OPT_BOOL), - PL_OPTION("length", OPT_SIZE), - PL_OPTION("callback", OPT_TERM), - PL_OPTION("token", OPT_ATOM), - PL_OPTION("descr", OPT_STRING), - PL_OPTIONS_END -}; - // cpp_options(+Options:list, +Opt_all:bool, -Result) // Result is: cpp_options(Quoted,Length,Callback,Token,Descr) +// Reimplementation of ffi_options_(), with an additional opt_all +// parameter PREDICATE(cpp_options, 3) { auto options = A1, opt_all = A2, result = A3; int quoted = false; @@ -994,16 +1067,26 @@ PREDICATE(cpp_options, 3) bool opt_all_v = opt_all.as_bool(); int flags = opt_all_v ? OPT_ALL : 0; + static PL_option_t scan_options[] = + { PL_OPTION("quoted", OPT_BOOL), + PL_OPTION("length", OPT_SIZE), + PL_OPTION("callback", OPT_TERM), + PL_OPTION("token", OPT_ATOM), + PL_OPTION("descr", OPT_STRING), + PL_OPTIONS_END + }; + PlStringBuffers _string_buffers; // for descr's contents - PlCheck(PL_scan_options(options.C_, flags, "cpp_options", scan_options, - "ed, &length, &callback.C_, &token.C_, &descr)); - - PlCheck(result.unify_term(PlCompound("options", - PlTermv(PlTerm_integer(quoted), - PlTerm_integer(length), - callback, - token.not_null() ? PlTerm(token) : PlTerm_var(), - PlTerm_string(descr))))); + PlEx(PL_scan_options(options.C_, flags, "cpp_options", scan_options, + "ed, &length, &callback.C_, &token.C_, &descr)); + + PlCheckFail(result.unify_term( + PlCompound("options", + PlTermv(PlTerm_integer(quoted), + PlTerm_integer(length), + callback, + token.not_null() ? PlTerm(token) : PlTerm_var(), + PlTerm_string(descr))))); // TODO: The following are needed if callback and token aren't used // by a Prolog term (e.g., if they're stored in a "blob"): // callback.record(); @@ -1019,8 +1102,8 @@ PREDICATE(cvt_i_bool, 2) // TODO: add PlEngine tests -PREDICATE(throw_domain_ffi, 1) -{ return PL_domain_error("footype", A1.C_); +PREDICATE(throw_domain_cpp0, 1) +{ return Plx_domain_error("footype", A1.C_); } PREDICATE(throw_domain_cpp1, 1) @@ -1028,15 +1111,50 @@ PREDICATE(throw_domain_cpp1, 1) } PREDICATE(throw_domain_cpp2, 1) -{ PlCheck(PL_domain_error("footype", A1.C_)); +{ PlEx(Plx_domain_error("footype", A1.C_)); return false; // Should never reach here } PREDICATE(throw_domain_cpp3, 1) -{ PL_domain_error("footype", A1.C_); - throw PlFail(); +{ if ( !Plx_domain_error("footype", A1.C_) ) + throw PlFail(); + // Shouldn't fall through to here + Plx_clear_exception(); + return true; // Shouldn't happen } PREDICATE(throw_domain_cpp4, 1) { return PlDomainError("footype", A1).plThrow(); } + +PREDICATE(throw_instantiation_error_cpp, 1) +{ throw PlInstantiationError(A1); +} + +PREDICATE(throw_uninstantiation_error_cpp, 1) +{ throw PlUninstantiationError(A1); +} + +PREDICATE(throw_representation_error_cpp, 1) +{ throw PlRepresentationError(A1.as_string().c_str()); +} + +PREDICATE(throw_type_error_cpp, 2) +{ throw PlTypeError(A1.as_string().c_str(), A2); +} + +PREDICATE(throw_domain_error_cpp, 2) +{ throw PlDomainError(A1.as_string().c_str(), A2); +} + +PREDICATE(throw_existence_error_cpp, 2) +{ throw PlExistenceError(A1.as_string().c_str(), A2); +} + +PREDICATE(throw_permission_error_cpp, 3) +{ throw PlPermissionError(A1.as_string().c_str(), A2.as_string().c_str(), A3); +} + +PREDICATE(throw_resource_error_cpp, 1) +{ throw PlResourceError(A1.as_string().c_str()); +} diff --git a/test_cpp.pl b/test_cpp.pl index 4aeec0c..803826c 100644 --- a/test_cpp.pl +++ b/test_cpp.pl @@ -53,36 +53,54 @@ run_tests([ cpp ]). +% Some of the tests can result in crashes if there's a bug, so the +% `output(on_failure)` option results in nothing being written. +% If so, uncomment the following line +% :- set_test_options([output(always)]). + :- begin_tests(cpp). -test(hello, Out == "Hello world\nHello world\nHello world\nHello world\nHello world\n") :- - hello(world, Out). +test(hello, Out == "hello hello hello") :- + % hello :- write('hello hello hello') + with_output_to(string(Out), hello). + +test(hello, Out == "Hello WORLD\nHello WORLD\nHello WORLD\nHello WORLD\nHello WORLD\n") :- + hello("WORLD", Out). +test(hello, error(representation_error(encoding))) :- + hello("世界", _Out). +% The following might give a different result, depending on locale: test(hello2, Out == "Hello2 world2\nHello2 world2\nHello2 world2\nHello2 world2\nHello2 world2\n") :- hello2(world2, Out). test(hello3, Out == "Hello3 世界弐\n") :- hello3(世界弐, Out). -test(hello_call, Out == "hello(foo)\n") :- - with_output_to(string(Out), hello_call(writeln(hello(foo)))). -test(hello_call, Out == "hello(世界四)\n") :- - with_output_to(string(Out), hello_call(writeln(hello(世界四)))). -test(hello_call, error(existence_error(procedure,writeln_wrong/1))) :- - hello_call(writeln_wrong(hello(世界四))). -test(hello_call, fail) :- - hello_call(atom(hello(foo))). - -test(hello_query, Out == "hello(世界四)\n") :- - with_output_to(string(Out), hello_query(writeln, hello(世界四))). -test(hello_query, error(existence_error(procedure,writeln_wrong/1))) :- - hello_query(writeln_wrong, hello(世界四)). -test(hello_query, fail) :- - hello_query(atom, hello(foo)). +test(call_cpp, Out == "hello(foo)\n") :- + with_output_to(string(Out), call_cpp(writeln(hello(foo)))). +test(call_cpp, Out == "hello(世界四)\n") :- + with_output_to(string(Out), call_cpp(writeln(hello(世界四)))). +test(call_cpp, error(existence_error(procedure,unknown_pred/1))) :- + call_cpp(unknown_pred(hello(世界四))). +test(call_cpp, fail) :- + call_cpp(atom(hello(foo))). + +test(call_cpp, Ex == "no exception") :- + call_cpp_ex(writeln(hello(世界四)), Ex). +test(call_cpp) :- + call_cpp_ex(unknown_pred(hello(世界四)), Ex), + assertion(subsumes_term(error(existence_error(procedure, unknown_pred/1), _), Ex)). + +test(call_cpp, Out == "hello(世界四)\n") :- + with_output_to(string(Out), call_cpp(writeln, hello(世界四))). +test(call_cpp, error(existence_error(procedure,unknown_pred/1))) :- + call_cpp(unknown_pred, hello(世界四)). +test(call_cpp, fail) :- + call_cpp(atom, hello(foo)). test(as_string, S == "foo") :- atom_to_string(foo, S). -test(as_string, S = "foo(bar)") :- +test(as_string, S == "foo(bar)") :- term_to_string(foo(bar), S). % Note: atom_to_string/2 and term_to_string/2 translate the data @@ -91,7 +109,7 @@ % of the UTF8 data. test(as_string, S == "ä¸\u0096ç\u0095\u008Cå\u009B\u009B") :- atom_to_string(世界四, S). -test(as_string, S = "hello(ä¸\u0096ç\u0095\u008Cå\u009B\u009B)") :- +test(as_string, S == "hello(ä¸\u0096ç\u0095\u008Cå\u009B\u009B)") :- term_to_string(hello(世界四), S). test(add_3, Result == 666) :- @@ -101,11 +119,11 @@ test(add_3_err, error(type_error(integer,0.1))) :- add(666, 0.1, _). -test(add_num_3_a, Result == 666) :- +test(add_num_3, Result == 666) :- add_num(555, 111, Result). -test(add_num_3_b, Result == 666.6) :- +test(add_num_3, Result == 666.6) :- add_num(555.2, 111.4, Result). -test(add_num_3_c, error(type_error(float,"abc"))) :- +test(add_num_3, error(type_error(float,"abc"))) :- add_num(123, "abc", _Result). testing:p(1). % For average/3 test @@ -116,9 +134,6 @@ average(X, testing:p(X), Average), Expected is (1+10+20)/3 . -test(hello_0, Out == "hello world\n") :- - with_output_to(string(Out), hello). - call_cut_test :- setup_call_cleanup(true, between(1, 5, _X), @@ -129,80 +144,90 @@ % See discussion: https://github.com/SWI-Prolog/packages-cpp/pull/27 call_cut("call_cut_test"). -test(term_1, Term = hello(world)) :- +test(term_1, Term == hello(world)) :- term(Term). -test(term_2a, Result == 'hello world') :- +test(term_2, Result == 'hello world') :- term(atom, Result). -test(term_2b, Result == "hello world") :- +test(term_2, Result == "hello world") :- term(string, Result). -test(term_2c, Result = [104,101,108,108,111,32,119,111,114,108,100]) :- +test(term_2, Result == [104,101,108,108,111,32,119,111,114,108,100]) :- term(code_list, Result). -test(term_2d, Result = [h,e,l,l,o,' ',w,o,r,l,d]) :- +test(term_2, Result == [h,e,l,l,o,' ',w,o,r,l,d]) :- term(char_list, Result). -test(term_2e, Result = hello(world)) :- +test(term_1, Result == hello(world)) :- term(term, Result). -test(term_2f, error(domain_error(type,foo))) :- +test(term_1, error(domain_error(type,foo))) :- term(foo, _Result). -test(can_unify_2a, [true(X\==Y)]) :- +test(can_unify_2, [true(X\==Y)]) :- can_unify(f(X), f(Y)). -test(can_unify_2b) :- +test(can_unify_2) :- can_unify(a(X), a(1)), assertion(var(X)). % Note: unify_error has additional tests for eq1/2 -test(eq1_2a, X == a) :- +test(eq1_2, X == a) :- eq1(foo(X), foo(a)). -test(eq1_2b, fail) :- +test(eq1_2, fail) :- eq1(foo(_X), bar(a)). -test(make_integer_2a, X == 123) :- +test(make_integer_2, X == 123) :- make_uint64(123, X). -test(make_integer_2b) :- +test(make_integer) :- X = 666, Y = 666, make_uint64(X, 666), make_uint64(666, 666), make_uint64(X, Y). -test(make_integer_2c, fail) :- +test(make_integer_2, fail) :- make_uint64(123, 124). :- if(current_prolog_flag(bounded,false)). -test(make_integer_2d, error(representation_error(uint64_t))) :- +test(make_uint64_2, error(representation_error(uint64_t))) :- Val is 0xffffffffffffffff + 999, % uses extended integers make_uint64(Val, _Y). :- endif. -test(make_integer_2e, error(domain_error(not_less_than_zero,-1))) :- +test(make_uint64_2, error(domain_error(not_less_than_zero,-1))) :- make_uint64(-1, _Y). -test(make_integer_2a, X == 123) :- +test(make_int64_2, X == 123) :- make_int64(123, X). -test(make_integer_2b) :- +test(make_int64_2) :- X = 666, Y = 666, make_int64(X, 666), make_int64(666, 666), make_int64(X, Y). -test(make_integer_2c, fail) :- +test(make_int64_2, fail) :- make_int64(123, 124). +test(make_int64_2, error(type_error(integer,abc))) :- + make_int64(abc, _Y). :- if(current_prolog_flag(bounded,false)). -test(make_integer_2d, error(representation_error(int64_t))) :- +test(make_int64_2, error(representation_error(int64_t))) :- Val is 0xffffffffffffffff + 999, % uses extended integers make_int64(Val, _Y). :- endif. -test(make_integer_2e, Y == -1) :- +test(make_int64_2, Y == -1) :- make_int64(-1, Y). -test(hostname_1, [Host == Host2]) :- +test(hostname, [Host == Host2]) :- hostname(Host), hostname2(Host2). -test(cappend, Result = [a,b,c,d,e]) :- +test(cappend, Result == [a,b,c,d,e]) :- cappend([a,b,c], [d,e], Result). +test(cappend) :- + cappend([a,b,c], [d,e], [a,b,c,d,e]). +test(cappend, fail) :- + cappend([a,b,c], [d,e], [a,b,c,d]). +test(cappend, fail) :- + cappend([a,b,c], [d,e], [a,b,c,d,e,f]). +test(cappend, fail) :- + cappend([a,b,c], [d,e], [a,b,c,d,e|f]). test(cpp_call, Out == "abc\n") :- with_output_to(string(Out), @@ -212,8 +237,7 @@ query_flags(Flags, CombinedFlag), cpp_call_(Goal, CombinedFlag, false). - -test(square_roots_2a, Result == [0.0, 1.0, 1.4142135623730951, 1.7320508075688772, 2.0]) :- +test(square_roots_2, Result == [0.0, 1.0, 1.4142135623730951, 1.7320508075688772, 2.0]) :- square_roots(5, Result). :- meta_predicate with_small_stacks(+, 0). @@ -229,7 +253,7 @@ Goal, set_prolog_flag(stack_limit, Old)). -test(square_roots_2b, error(resource_error(stack))) :- +test(square_roots_2, error(resource_error(stack))) :- with_small_stacks(5 000 000, % 400 000 seems to be about the smallest allowed value square_roots(1000000000, _)). @@ -237,6 +261,14 @@ malloc_new(1000, Result), % smoke test free_delete(Result). +test(malloc) :- + malloc_malloc(1000, Result), % smoke test + free_malloc(Result). + +test(malloc) :- + malloc_PL_malloc(1000, Result), % smoke test + free_PL_malloc(Result). + :- if(\+ current_prolog_flag(asan, true)). too_big_alloc_request(Request) :- current_prolog_flag(address_bits, Bits), @@ -264,7 +296,7 @@ test(malloc, error(resource_error(memory))) :- too_big_alloc_request(Request), - malloc_new(Request, Result). + malloc_new(Request, _Result). :- if(current_prolog_flag(bounded,false)). @@ -274,9 +306,10 @@ free_delete(Result) ), error(E,_), true), - assertion(memberchk(E, [representation_error(uint64_t), + assertion(memberchk(E, [representation_error(_), % representation_error(uint64_t) type_error(integer,_)])). + :- endif. % ASAN has maximum 0x10000000000 @@ -291,7 +324,7 @@ :- if(current_prolog_flag(bounded,false)). -test(new_chars_3) :- +test(new_chars_2) :- too_many_bits_alloc_request(Request), catch( ( new_chars(Request, Result), delete_chars(Result) @@ -303,20 +336,19 @@ :- endif. :- endif. -test(new_chars_1) :- +test(new_chars_2) :- new_chars(1000, Result), % smoke test delete_chars(Result). -test(name_arity_1, Out == "name = foo, arity = 2\n") :- +test(name_arity_2, Out == "name = foo, arity = 2\n") :- name_arity(foo(bar,zot), Out). -test(name_arity_3) :- +test(name_arity_2) :- name_arity(foo(bar,zot), Name, Arity), assertion(Name == foo), assertion(Arity == 2). test(list_modules_0) :- - % TODO: this outputs to cout ... make a version that checks the output? list_modules(Text), split_string(Text, "\n", "", Strings), forall(( member(S, Strings), S \== ""), @@ -328,28 +360,79 @@ my_object_contents(MyObject, Contents), free_my_object(MyObject). -test(make_functor_3a, F == foo(x)) :- +test(make_functor_3, F == foo(x)) :- make_functor(foo, x, F). -test(make_functor_3b, error(type_error(atom,123))) :- +test(make_functor_3, error(type_error(atom,123))) :- make_functor(123, x, _). -test(make_functor_3c) :- +test(make_functor_3) :- make_functor(bar, 123, bar(123)). -test(make_functor_3d, fail) :- +test(make_functor_3, fail) :- make_functor(bar, 123, bar(666)). -test(make_functor_3e, fail) :- +test(make_functor_3, fail) :- make_functor(bar, 123, qqsv(123)). -test(make_functor_3f, Z==6.66) :- +test(make_functor_3, Z==6.66) :- make_functor(bbb, Z, F), F = bbb(6.66). +test(cpp_arg, A == bar) :- + cpp_arg(1, foo(bar,zot), A). +test(cpp_arg, A == zot) :- + cpp_arg(2, foo(bar,zot), A). +test(cpp_arg, error(domain_error(arity,3))) :- + cpp_arg(3, foo(bar,zot), _A). +test(cpp_arg, error(domain_error(not_less_than_zero,0))) :- + cpp_arg(0, foo(bar,zot), _A). +test(cpp_arg, error(domain_error(not_less_than_zero,-2))) :- + cpp_arg(-2, foo(bar,zot), _A). +test(cpp_arg, error(type_error(compound,foo))) :- + cpp_arg(1, foo, _A). + % The following are for verifying some documentation details, and for % ensuring that various mechanisms for reporting failure and % exceptions behave as expected. +test(c_PL_unify_nil, X == []) :- + c_PL_unify_nil(X). +test(c_PL_unify_nil) :- + c_PL_unify_nil([]). +test(c_PL_unify_nil, fail) :- + c_PL_unify_nil(abc). + test(c_PL_unify_nil_ex, X == []) :- c_PL_unify_nil_ex(X). test(c_PL_unify_nil_ex) :- c_PL_unify_nil_ex([]). +test(c_PL_unify_nil_ex, error(type_error(list,abc))) :- + c_PL_unify_nil_ex(abc). + +test(check_c_PL_unify_nil, X == []) :- + check_c_PL_unify_nil(X). +test(check_c_PL_unify_nil) :- + check_c_PL_unify_nil([]). +% The following error is subject to change: +test(check_c_PL_unify_nil, error(unknown_error('Non-zero return code without exception'))) :- + check_c_PL_unify_nil(abc). + +test(check_c_PL_unify_nil_ex, X == []) :- + check_c_PL_unify_nil_ex(X). +test(check_c_PL_unify_nil_ex) :- + check_c_PL_unify_nil_ex([]). +test(check_c_PL_unify_nil_ex, error(type_error(list,abc))) :- + check_c_PL_unify_nil_ex(abc). + +test(cpp_unify_nil, X == []) :- + cpp_unify_nil(X). +test(cpp_unify_nil) :- + cpp_unify_nil([]). +test(cpp_unify_nil, fail) :- + cpp_unify_nil(abc). + +test(cpp_unify_nil_ex, X == []) :- + cpp_unify_nil_ex(X). +test(cpp_unify_nil_ex) :- + cpp_unify_nil_ex([]). +test(cpp_unify_nil_ex, error(type_error(list,abc))) :- + cpp_unify_nil_ex(abc). % The following are for verifying that an exception in % PL_occurs_term() is handled properly - exceptions such as @@ -421,31 +504,41 @@ % Tests from test_ffi.pl, for functions translated from ffi4pl.c: -test(range_cpp1, all(X == [1,2])) :- +test(range_cpp, all(X == [1,2])) :- range_cpp(1, 3, X). -test(range_cpp2, all(X == [-2,-1,0,1,2])) :- +test(range_cpp, all(X == [-2,-1,0,1,2])) :- range_cpp(-2, 3, X). -test(range_cpp3a, all(X == [0])) :- +test(range_cpp, all(X == [0])) :- range_cpp(0, 1, X). -test(range_cpp3b, all(X == [10])) :- +test(range_cpp, all(X == [10])) :- range_cpp(10, 11, X). -test(range_cpp3c, all(X == [-2])) :- +test(range_cpp, all(X == [-2])) :- range_cpp(-2, -1, X). -test(range_cpp4a, fail) :- +test(range_cpp, fail) :- range_cpp(1, 1, _X). -test(range_cpp4a, fail) :- +test(range_cpp, fail) :- range_cpp(0, 0, _X). -test(range_cpp4a, fail) :- +test(range_cpp, fail) :- range_cpp(-1, -1, _X). -test(range_cpp4d, fail) :- +test(range_cpp, fail) :- range_cpp(1, 2, 2). -test(range_cpp5, X == 1) :- % Will produce warning if non-deterministic +test(range_cpp, X == 1) :- % Will produce warning if non-deterministic range_cpp(1, 2, X). -test(range_cpp6b, error(type_error(integer,a))) :- +test(range_cpp, error(type_error(integer,a))) :- range_cpp(a, 10, _). -test(range_cpp6b, error(type_error(integer,foo))) :- +test(range_cpp, error(type_error(integer,foo))) :- range_cpp(1, foo, _). +% TODO: not finished -- use nb_set and friends to preserve +% first 2 results +range_2(From, To, Result) :- + ( range_cpp(From, To, _), + fail + *-> true + ; range_cpp(From, To, Result) + ). + + % This is test wchar_1 in test_ffi.pl: test(wchar_1, all(Result == ["//0", "/ /1", "/abC/3", @@ -464,9 +557,12 @@ % TODO: decouple this test from message hooks % ('$messages':message_to_string/2 or print_message/'$write_on_string'/2): -test(type_error_string, S == "Type error: `foofoo' expected, found `'foo-bar'' (an atom)") :- - type_error_string('foo-bar', S, T), +test(type_error_string) :- + type_error_string('foo-bar', _S, T), assertion(unifiable(T, error(type_error(foofoo,'foo-bar'),A), [A=B])), + % TODO: when PlException::string_term() is revived (using '$messages':message_to_string/2), + % add the following assertion: + % assertion(S == "Type error: `foofoo' expected, found `'foo-bar'' (an atom)"]) assertion(var(A)), assertion(var(B)), assertion(A\==B). @@ -474,6 +570,15 @@ test(int_info) :- findall(Name:Info, int_info(Name, Info), Infos), assertion(memberchk(uint32_t:int_info(uint32_t,4,0,4294967295), Infos)). +test(int_info, [nondet, Name:Info == uint32_t:int_info(uint32_t,4,0,4294967295)]) :- + Info = int_info(_,_,0,_), + int_info(Name, Info), + Info = int_info(uint32_t,_,_,_). +test(int_info) :- + Info = int_info(_,_,0,_), + findall(Name:Info, int_info(Name, Info), Infos), + assertion(memberchk(uint16_t:int_info(uint16_t,2,0,65535), Infos)). + % int_info_cut test checks that PL_PRUNED works as expected: test(int_info_cut, Name:Info == bool:int_info(bool, 1, 0, 1)) :- int_info(Name, Info), !. @@ -495,8 +600,7 @@ test(cvt_i_bool, error(type_error(bool,0.0))) :- cvt_i_bool(0.0, _R). test(cvt_i_bool, error(type_error(bool,"false"))) :- cvt_i_bool("false", _R). -% TODO: the following sometimes causes a crash: -test(scan_options, [R = options(1, 5, foo(bar), _, "")]) :- % Note use of (=)/2 because of uninstantiated variable +test(scan_options, [R =@= options(1, 5, foo(bar), _, "")]) :- % Note use of (=@=)/2 because of uninstantiated variable cpp_options([quoted(true), length(5), callback(foo(bar))], false, R). test(scan_options, [R == options(1, 5, foo(bar), qqsv, "DESCR")]) :- cpp_options([token(qqsv), descr("DESCR"), quoted(true), length(5), callback(foo(bar))], false, R). @@ -519,8 +623,8 @@ test(scan_options, [error(domain_error(cpp_options,unknown_option:blah))]) :- cpp_options(options{token:qqsv, descr:"DESCR", quoted:true, length:5, callback:foo(bar), unknown_option:blah}, true, _). -test(error_term, error(domain_error(footype,qqsv("ABC")),context(throw_domain_ffi/1,_Msg))) :- - throw_domain_ffi(qqsv("ABC")). +test(error_term, error(domain_error(footype,qqsv("ABC")),context(throw_domain_cpp0/1,_Msg))) :- + throw_domain_cpp0(qqsv("ABC")). test(error_term, [error(domain_error(footype,qqsv("ABC")),_)]) :- throw_domain_cpp1(qqsv("ABC")). @@ -534,6 +638,74 @@ test(error_term, [error(domain_error(footype,qqsv("ABC")),_)]) :- throw_domain_cpp4(qqsv("ABC")). +test(throw, error(uninstantiation_error(abc),_)) :- + throw_uninstantiation_error_cpp(abc). + +test(throw, error(representation_error(some_resource))) :- + throw_representation_error_cpp(some_resource). + +test(throw, error(type_error(int,"abc"))) :- + throw_type_error_cpp(int, "abc"). + +test(throw, error(domain_error(positive, -5))) :- + throw_domain_error_cpp(positive, -5). + +test(throw, error(existence_error(something_something, foo:bar/2))) :- + throw_existence_error_cpp(something_something, foo:bar/2). + +test(throw, error(permission_error(operation, type, the(culprit)))) :- + throw_permission_error_cpp(operation, type, the(culprit)). + +test(throw, error(resource_error('NO_RESOURCE'))) :- + throw_resource_error_cpp('NO_RESOURCE'). + +test(compare) :- + eq_int64(1, 1). +test(compare, fail) :- + eq_int64(1, 2). +test(compare, error(type_error(integer,a))) :- + eq_int64(1, a). +test(compare, error(type_error(integer,b))) :- + eq_int64(b, 1). +test(compare) :- + lt_int64(1, 2). +test(compare, fail) :- + lt_int64(2, 1). +test(compare, error(type_error(integer,a))) :- + lt_int64(1, a). +test(compare, error(type_error(integer,b))) :- + lt_int64(b, 1). + +test(get_atom, A == abc) :- + get_atom_ex(abc, A). +test(get_atom) :- + get_atom_ex(abc, abc). +test(get_atom, fail) :- + get_atom_ex(abc, abcd). +test(get_atom, error(type_error(atom,"abc"))) :- + get_atom_ex("abc", _A). +test(get_atom, error(type_error(atom,123))) :- + get_atom_ex(123, _A). +test(get_atom, error(type_error(atom,foo(bar)))) :- + get_atom_ex(foo(bar), _A). + +% TODO: +% test this (https://swi-prolog.discourse.group/t/cpp2-exceptions/6040/61): +% +% Now call this from C(++). The first PL_next_solution() says TRUE, +% but the cleanup is not executed. Now close the query. That runs the +% cleanup handler and should raise error. If the goal in the +% setup_call_cleanup/3 completed (fail, exception, deterministic +% true), the cleanup handler has done its work before control gets +% back to Prolog and thus PL_next_solution() already generates the +% exception. + +test_setup_call_cleanup(X) :- + setup_call_cleanup( + true, + between(1, 5, X), + throw(error)). + :- end_tests(cpp). w_atom_cpp(Atom, String) :- @@ -544,16 +716,35 @@ % Flags for PL_open_query(). Check with SWI-Prolog.h. Same code % appears in test_ffi.pl. This is duplicated to simplify % installation of these tests in the binary version. - -% query_flag(debug, I) => I =0x0001. -% query_flag(deterministic, I) => I =0x0100. -query_flag(normal, I) => I =0x0002. -query_flag(nodebug, I) => I =0x0004. -query_flag(catch_exception, I) => I =0x0008. -query_flag(pass_exception, I) => I =0x0010. -query_flag(allow_yield, I) => I =0x0020. -query_flag(ext_status, I) => I =0x0040. +% +% This code is mainly for debugging. + +query_flag(debug, I) => I = 0x0001. +query_flag(normal, I) => I = 0x0002. +query_flag(nodebug, I) => I = 0x0004. +query_flag(catch_exception, I) => I = 0x0008. +query_flag(pass_exception, I) => I = 0x0010. +query_flag(allow_yield, I) => I = 0x0020. +query_flag(ext_status, I) => I = 0x0040. +query_flag(deterministic, I) => I = 0x0100. +% and pseudo-flags (see XX_Q_* flags in test_ffi.c): +query_flag(clear_return_true, I) => I = 0x01000. +query_flag(close_query, I) => I = 0x02000. +query_flag(exc_term, I) => I = 0x04000. + +% This should give the same result as PlQuery::verify() +check_query_flag(Flags) :- + query_flag(normal, F1), + query_flag(catch_exception, F2), + query_flag(pass_exception, F3), + Mask is F1 \/ F2 \/ F3, + Bits is popcount(Flags /\ Mask), + ( Bits =< 1 + -> true + ; domain_error(query_flags, Flags) + ). query_flags(Flags, CombinedFlag) :- maplist(query_flag, Flags, Ints), - aggregate_all(sum(I), member(I, Ints), CombinedFlag). + aggregate_all(sum(I), member(I, Ints), CombinedFlag), + check_query_flag(CombinedFlag). diff --git a/test_ffi.c b/test_ffi.c index 21a4733..16e13c6 100644 --- a/test_ffi.c +++ b/test_ffi.c @@ -43,6 +43,12 @@ #include #include +#ifdef O_DEBUG +#define DEBUG(g) g +#else +#define DEBUG(g) (void)0 +#endif + /* range_ffi/3 is used in regression tests - PL_foreign_context() passing an int for the context. */ @@ -78,11 +84,12 @@ range_ffi(term_t t_low, term_t t_high, term_t t_result, control_t handle) } } -/* range_ffialloc/3 is used in regression tests +/* range_ffialloc/3 is used in regression tests: - PL_foreign_context_address() and malloc()-ed context. */ struct range_ctxt { long i; + long high; }; static foreign_t @@ -91,12 +98,14 @@ range_ffialloc(term_t t_low, term_t t_high, term_t t_result, control_t handle) switch( PL_foreign_control(handle) ) { case PL_FIRST_CALL: - { long low; - if ( !PL_get_long_ex(t_low, &low) ) + { long low, high; + if ( !PL_get_long_ex(t_low, &low) || + !PL_get_long_ex(t_high, &high) ) PL_fail; if ( !(ctxt = malloc(sizeof *ctxt) ) ) return (foreign_t)PL_resource_error("memory"); ctxt->i = low; + ctxt->high = high; } break; case PL_REDO: @@ -111,22 +120,21 @@ range_ffialloc(term_t t_low, term_t t_high, term_t t_result, control_t handle) PL_fail; } - { long high; - if ( !PL_get_long_ex(t_high, &high) || - ctxt->i >= high || - !PL_unify_integer(t_result, ctxt->i) ) - { free(ctxt); - PL_fail; - } - ctxt->i += 1; - if ( ctxt->i == high ) - { free(ctxt); - PL_succeed; /* Last result: succeed without a choice point */ - } - PL_retry_address(ctxt); /* Succeed with a choice point */ + if ( ctxt->i >= ctxt->high || + !PL_unify_integer(t_result, ctxt->i) ) + { free(ctxt); + PL_fail; } + + ctxt->i += 1; + if ( ctxt->i == ctxt->high ) + { free(ctxt); + PL_succeed; /* Last result: succeed without a choice point */ + } + PL_retry_address(ctxt); /* Succeed with a choice point */ } +// Regression test for https://github.com/SWI-Prolog/packages-pcre/issues/20 static foreign_t w_atom_ffi_(term_t stream, term_t t) { IOSTREAM* s; @@ -142,6 +150,7 @@ w_atom_ffi_(term_t stream, term_t t) return TRUE; } +// Regression test forhttps://github.com/SWI-Prolog/packages-pcre/issues/20 static foreign_t atom_ffi_(term_t stream, term_t t) { IOSTREAM* s; @@ -214,10 +223,14 @@ ffi_term_chars(term_t t) return ""; } -/* Unify A2 with A1.as_string() */ +/* Unify A1 and A2 if use_unify, else + Unify A2 with A1.as_string() */ static int -unify_term_as_string(term_t A1, term_t A2) -{ char buf[1000]; /* TODO: malloc as big as needed */ +unify_term_as_term_or_string(term_t A1, term_t A2, int use_unify) +{ if ( A1 && use_unify ) + return PL_unify(A1, A2); + + char buf[1000]; /* TODO: malloc as big as needed */ int u_rc; PL_STRINGS_MARK(); @@ -247,6 +260,7 @@ unify_term_as_string(term_t A1, term_t A2) #define XX_Q_CLEAR_RETURN_TRUE 0x01000 #define XX_Q_CLOSE_QUERY 0x02000 +#define XX_Q_EXC_TERM 0x04000 /* For debugging: turn the query call flags into human-readable form. This is mainly intended for verifying that query_flags/2 has done @@ -275,6 +289,7 @@ query_flags_str_(term_t flags_t, term_t flags_str_t) if ( flags&PL_Q_EXT_STATUS ) strcat(flags_str, ",ext_status"); if ( flags&XX_Q_CLEAR_RETURN_TRUE ) strcat(flags_str, ",clear_return_true"); if ( flags&XX_Q_CLOSE_QUERY ) strcat(flags_str, ",close_query"); + if ( flags&XX_Q_EXC_TERM ) strcat(flags_str, ",exc_term"); return PL_unify_string_chars(flags_str_t, &flags_str[1]); } @@ -317,6 +332,8 @@ query_rc_status_str_(term_t rc_t, term_t flags_t, term_t rc_bool_t, PL_exception(0), PL_exception(qid) after PL_next_solution() and Exc_0_2 is unified with the string form of PL_exception(0) after PL_cut_query() [in all cases, only if the exception isn't 0]. + - if XX_Q_EXC_ERM, then Exc_0, Exc_qid, Exc_0_2 are unified as a term + or "" The exceptions are returned as strings to get around problems with lifetimes of terms (probably only needed for PL_exception(qid), but done for all, for uniformity). Note the @@ -350,15 +367,15 @@ ffi_call_exc_(term_t goal, term_t flags_t, } { term_t exc_0 = PL_exception(0); term_t exc_qid = PL_exception(qid); - if ( !unify_term_as_string(exc_0, exc_0_t) || - !unify_term_as_string(exc_qid, exc_qid_t) ) + if ( ! unify_term_as_term_or_string(exc_0, exc_0_t, flags&XX_Q_EXC_TERM) || + ! unify_term_as_term_or_string(exc_qid, exc_qid_t, flags&XX_Q_EXC_TERM) ) { PL_close_query(qid); return FALSE; } } - cut_rc = (flags&XX_Q_CLOSE_QUERY) ? PL_close_query(qid) :PL_cut_query(qid); + cut_rc = (flags&XX_Q_CLOSE_QUERY) ? PL_close_query(qid) : PL_cut_query(qid); { term_t exc_0_2 = PL_exception(0); - if ( !unify_term_as_string(exc_0_2, exc_0_2_t) ) + if ( !unify_term_as_term_or_string(exc_0_2, exc_0_2_t, flags&XX_Q_EXC_TERM) ) return FALSE; } if ( flags&XX_Q_CLEAR_RETURN_TRUE ) @@ -371,6 +388,7 @@ ffi_call_exc_(term_t goal, term_t flags_t, /* For debugging: unit tests can swallow debug output when there's a system crash, so use sdprintf_() or sdprintfnl_() instead. */ +/* TODO: is this needed? :- set_test_options([output(always)]). */ static foreign_t sdprintf_(term_t t) { PL_STRINGS_MARK(); @@ -515,6 +533,101 @@ ffi_read_int64_(term_t Stream, term_t i) return PL_release_stream(stream) && rc; } +static foreign_t +throw_instantiation_error_ffi(term_t culprit) +{ return PL_instantiation_error(culprit); +} + +static foreign_t +throw_uninstantiation_error_ffi(term_t culprit) +{ return PL_uninstantiation_error(culprit); +} + +static foreign_t +throw_representation_error_ffi(term_t resource) +{ char *resource_s; + if ( !PL_get_atom_chars(resource, &resource_s) ) + return FALSE; + return PL_representation_error(resource_s); +} + +static foreign_t +throw_type_error_ffi(term_t expected, term_t culprit) +{ char *expected_s; + if ( !PL_get_atom_chars(expected, &expected_s) ) + return FALSE; + return PL_type_error(expected_s, culprit); +} + +static foreign_t +throw_domain_error_ffi(term_t expected, term_t culprit) +{ char *expected_s; + if ( !PL_get_atom_chars(expected, &expected_s) ) + return FALSE; + return PL_domain_error(expected_s, culprit); +} + +static foreign_t +throw_existence_error_ffi(term_t type, term_t culprit) +{ char *type_s; + if ( !PL_get_atom_chars(type, &type_s) ) + return FALSE; + return PL_existence_error(type_s, culprit); +} + +static foreign_t +throw_permission_error_ffi(term_t operation, + term_t type, term_t culprit) +{ char *operation_s, *type_s; + if ( !PL_get_atom_chars(operation, &operation_s) || + !PL_get_atom_chars(type, &type_s) ) + return FALSE; + return PL_permission_error(operation_s, type_s, culprit); +} + +static foreign_t +throw_resource_error_ffi(term_t resource) +{ char *resource_s; + if ( !PL_get_atom_chars(resource, &resource_s) ) + return FALSE; + return PL_resource_error(resource_s); +} + + +/* TODO: remove - this is for debugging int_info/2 in test_cpp.cpp */ +static foreign_t +int_info_ffi(term_t name_a, term_t i1_a, term_t i2_a, term_t i3_a, term_t tv) +{ char *name; + int i1, i2, i3; + if ( !PL_get_atom_chars(name_a, &name) || + !PL_get_integer_ex(i1_a, &i1) || + !PL_get_integer_ex(i2_a, &i2) || + !PL_get_integer_ex(i3_a, &i3) ) + return FALSE; + term_t name_t = PL_new_term_ref(); + term_t i1_t = PL_new_term_ref(); + term_t i2_t = PL_new_term_ref(); + term_t i3_t = PL_new_term_ref(); + if ( !PL_put_atom_chars(name_t, name) || + !PL_put_int64(i1_t, (int64_t)i1) || + !PL_put_int64(i2_t, (int64_t)i2) || + !PL_put_int64(i3_t, (int64_t)i3) ) + return FALSE; + term_t a0 = PL_new_term_refs(4); + if ( !a0 || + !PL_put_term(a0+0, name_t) || + !PL_put_term(a0+1, i1_t) || + !PL_put_term(a0+2, i2_t) || + !PL_put_term(a0+3, i3_t) ) + return FALSE; + functor_t f = PL_new_functor(PL_new_atom("int_info"), 4); + assert(f != 0); + term_t c = PL_new_term_ref(); + if ( !PL_cons_functor_v(c, f, a0) ) + return FALSE; + return PL_unify(c, tv); +} + /* These are used for testing install/uninstall */ static char* range_ffi_str; @@ -530,9 +643,7 @@ install_test_ffi(void) assert(range_ffi_str); strncpy(range_ffi_str, RANGE_FFI_STR_CONTENTS, RANGE_FFI_STR_LEN); assert(0 == strncmp(range_ffi_str, RANGE_FFI_STR_CONTENTS, RANGE_FFI_STR_LEN)); - #ifdef O_DEBUG - Sdprintf("install_range_test_ffi %s\n", range_ffi_str); - #endif + DEBUG(Sdprintf("install_range_test_ffi %s\n", range_ffi_str)); PL_register_foreign("w_atom_ffi_", 2, w_atom_ffi_, 0); PL_register_foreign("atom_ffi_", 2, atom_ffi_, 0); @@ -549,6 +660,15 @@ install_test_ffi(void) PL_register_foreign("ffi_read_int32", 2, ffi_read_int32_, 0); PL_register_foreign("ffi_write_int64", 2, ffi_write_int64_, 0); PL_register_foreign("ffi_read_int64", 2, ffi_read_int64_, 0); + PL_register_foreign("throw_instantiation_error_ffi", 1, throw_instantiation_error_ffi, 0); + PL_register_foreign("throw_uninstantiation_error_ffi", 1, throw_uninstantiation_error_ffi, 0); + PL_register_foreign("throw_representation_error_ffi", 1, throw_representation_error_ffi, 0); + PL_register_foreign("throw_type_error_ffi", 2, throw_type_error_ffi, 0); + PL_register_foreign("throw_domain_error_ffi", 2, throw_domain_error_ffi, 0); + PL_register_foreign("throw_existence_error_ffi", 2, throw_existence_error_ffi, 0); + PL_register_foreign("throw_permission_error_ffi", 3, throw_permission_error_ffi, 0); + PL_register_foreign("throw_resource_error_ffi", 1, throw_resource_error_ffi, 0); + PL_register_foreign("int_info_ffi", 5, int_info_ffi, 0); } install_t diff --git a/test_ffi.pl b/test_ffi.pl index b64a70e..9a27e24 100644 --- a/test_ffi.pl +++ b/test_ffi.pl @@ -44,6 +44,8 @@ :- use_module(library(lists)). :- use_module(library(apply)). :- autoload(library(aggregate)). +:- use_module(library(memfile)). +:- use_module(library(readutil)). :- use_module(library(plunit)). :- use_foreign_library(foreign(test_ffi)). @@ -57,6 +59,10 @@ call ]). +% Some of the tests can result in crashes if there's a bug, so the +% `output(on_failure)` option results in nothing being written. +:- set_test_options([output(always)]). + :- begin_tests(ffi). test(range1, all(X == [1,2])) :- @@ -139,7 +145,10 @@ same_length(L, L2), open(TmpFile, read, InStream, [type(binary)]), maplist(ffi_read_int64(InStream), L2), - close(InStream). + close(InStream), + read_file_to_codes(TmpFile, Codes, [type(binary)]), + % The following should be the same on both little- and big-endian machines. + assertion(Codes == [0x2c,0x82,0x80,0x2b,0x82,0x7e,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x81,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x81]). test(save_load_int32, L == L2) :- L = [-1, 0, 0x010203fe, 0x7fffffff, -0x8000000], tmp_file_stream(TmpFile, OutStream, [encoding(binary)]), @@ -148,7 +157,51 @@ same_length(L, L2), open(TmpFile, read, InStream, [type(binary)]), maplist(ffi_read_int32(InStream), L2), - close(InStream). + close(InStream), + read_file_to_codes(TmpFile, Codes, [type(binary)]), + % The following should be the same on both little- and big-endian machines. + % assertion(Codes == [0xff,0xff,0xff,0xff,0,0,0,0,1,2,3,0xfe,0x7f,0xff,0xff,0xff,0xf8,0,0,0]). + % If int32_t is encoded using zigzag, this is the result: + assertion(Codes == [129,128,124,15,16,144,126,127,127,127,143,127,127,127,255]). + +test(save_load_int64, L == L2) :- + Mx is (1<<63)-1, Mn is -(1<<63), + L = [150, 0, -150, Mx, Mn], + new_memory_file(MemFile), + open_memory_file(MemFile, write, OutStream, [type(octet)]), + maplist(ffi_write_int64(OutStream), L), + close(OutStream), + same_length(L, L2), + open_memory_file(MemFile, read, InStream, [type(octet)]), + maplist(ffi_read_int64(InStream), L2), + close(InStream), + memory_file_to_codes(MemFile, Codes, octet), + % TODO: the following should be the same on both little- and + % big-endian machines. + assertion(Codes == [0x2c,0x82,0x80,0x2b,0x82,0x7e,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x81,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x81]). + +test(throw, error(instantiation_error,context(test_ffi:throw_instantiation_error_ffi/1,_))) :- + throw_instantiation_error_ffi(_X). +test(throw, error(uninstantiation_error(abc),context(test_ffi:throw_uninstantiation_error_ffi/1,_))) :- + throw_uninstantiation_error_ffi(abc). + +test(throw, error(representation_error(some_resource))) :- + throw_representation_error_ffi(some_resource). + +test(throw, error(type_error(int,"abc"))) :- + throw_type_error_ffi(int, "abc"). + +test(throw, error(domain_error(positive, -5))) :- + throw_domain_error_ffi(positive, -5). + +test(throw, error(existence_error(something_something, foo:bar/2))) :- + throw_existence_error_ffi(something_something, foo:bar/2). + +test(throw, error(permission_error(operation, type, the(culprit)))) :- + throw_permission_error_ffi(operation, type, the(culprit)). + +test(throw, error(resource_error('NO_RESOURCE'))) :- + throw_resource_error_ffi('NO_RESOURCE'). :- end_tests(ffi). @@ -158,7 +211,7 @@ % The following "wchar" tests are regression tests related % to https://github.com/SWI-Prolog/packages-pcre/issues/20 -test(wchar_1, all(Result == ["//0", +test(wchar, all(Result == ["//0", "/ /1", "/abC/3", "/Hello World!/12", @@ -174,7 +227,7 @@ ; w_atom_ffi('網目錦へび [àmímé níshíkíhéꜜbì]', Result) ). -test(wchar_2, +test(wchar, [condition(\+ current_prolog_flag(windows, true)), % Windows doesn't like Unicode > 0xffff all(Result == ["/⛰⛱⛲⛾⛿/5","/\U0001FB00/1","/ᢰᢱ\x18FF\/3","/⻰⻱⻲⻳/4"])]) :- ( w_atom_ffi('⛰⛱⛲⛾⛿', Result) @@ -183,7 +236,7 @@ ; w_atom_ffi('⻰⻱⻲⻳', Result) ). -test(wchar_2b, % Same as wchar_2, but uses atom_codes +test(wchar, % Same as wchar_2, but uses atom_codes [condition(\+ current_prolog_flag(windows, true)), % Windows doesn't like Unicode > 0xffff all(Result == [[47, 0x26f0, 0x26f1, 0x26f2, 0x26fe, 0x26ff, 47, 53], [47, 0x1FB00, 47, 49], @@ -261,8 +314,8 @@ Exc_0, Exc_qid, Exc_0_2, NextRc), assertion(NextRc == 0), assertion(Exc_0 == Exc_0_2), - match_existence_error(Exc_0, MatchExc_0), - match_existence_error(Exc_qid, MatchExc_qid), + match_existence_error_string(Exc_0, MatchExc_0), + match_existence_error_string(Exc_qid, MatchExc_qid), % The terms from Exc_0 and Exc_qid are different assertion(MatchExc_0.1 \== MatchExc_qid.1). test(ffi_call) :- @@ -272,17 +325,43 @@ assertion(NextRc == 0), assertion(Exc_0 == ""), assertion(Exc_0_2 == ""), - match_existence_error(Exc_qid, _MatchExc_qid). + match_existence_error_string(Exc_qid, _MatchExc_qid). -match_existence_error(Str, Matches) :- - % Match 1: the term_t value - % Match 2: the contents of context(...) +test(ffi_call) :- + ffi_call(unknown_pred(foo), [nodebug,pass_exception,clear_return_true,exc_term], + "nodebug,pass_exception,clear_return_true,exc_term", + Exc_0, Exc_qid, Exc_0_2, NextRc), + assertion(NextRc == 0), + assertion(Exc_0 == Exc_0_2), + match_existence_error_term(Exc_0), + match_existence_error_term(Exc_qid). +test(ffi_call) :- + ffi_call(unknown_pred(foo), [nodebug,catch_exception,clear_return_true,exc_term], + "nodebug,catch_exception,clear_return_true,exc_term", + Exc_0, Exc_qid, Exc_0_2, NextRc), + assertion(NextRc == 0), + assertion(Exc_0 == ""), + assertion(Exc_0_2 == ""), + match_existence_error_term(Exc_qid). + +%! match_existence_error_string(+Str, -Matches). +% Utility predicate for checking that a term, when turned into a string, +% matches a particular existence error. +% Str: the error term, as a string +% Matches: gets a dict with: +% 1: the term_t value as a string +% 2: the contents of context(...) as a string +match_existence_error_string(Str, Matches) :- MatchRE = "^<([0-9]+)>:error\\(existence_error\\(procedure,test_ffi:unknown_pred/1\\),context\\((.*)\\)\\)$", ( re_matchsub(MatchRE, Str, Matches) *-> true ; assertion(re_matchsub(MatchRE, Str, Matches)) ). +match_existence_error_term(Term) :- + assertion(subsumes_term(error(existence_error(procedure, test_ffi:unknown_pred/1), + context(_,_)), Term)). + test(ffi_call_no_options, blocked('Activates trace/debug mode')) :- ffi_call(non_existant_pred(foo), [], ""). test(ffi_call_normal, blocked('Invokes debugger')) :- @@ -323,8 +402,8 @@ % and pseudo-flags (see XX_Q_* flags in test_ffi.c): query_flag(clear_return_true, I) => I = 0x01000. query_flag(close_query, I) => I = 0x02000. +query_flag(exc_term, I) => I = 0x04000. -% TODO: are there any other mutually exclusive flags? check_query_flag(Flags) :- query_flag(normal, F1), query_flag(catch_exception, F2),