From 63a514cad5e93d6942be028af700e3c3650637e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 2 Apr 2019 10:27:37 +0100 Subject: [PATCH] yap4r --- packages/real/CMakeLists.txt | 32 ++++--- packages/real/real.c | 56 ++---------- packages/real/real.h | 114 ++++++++++++------------ packages/real/yap4r/NAMESPACE | 6 +- packages/real/yap4r/R/RcppExports.R | 19 ---- packages/real/yap4r/R/zzz.R | 15 ++++ packages/real/yap4r/src/Makevars.in | 8 +- packages/real/yap4r/src/RcppExports.cpp | 48 ---------- packages/real/yap4r/src/yap4r.cpp | 75 ++++++++-------- 9 files changed, 143 insertions(+), 230 deletions(-) delete mode 100644 packages/real/yap4r/R/RcppExports.R create mode 100644 packages/real/yap4r/R/zzz.R diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index 342510d4d..20c2641e6 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -1,6 +1,15 @@ # PROJECT ( YAP_REAL C ) + set(YAP4R_SOURCES + yap4r/man/yap4r-package.Rd +yap4r/R/zzz.R +yap4r/NAMESPACE +yap4r/DESCRIPTION +yap4r/src/yap4r.cpp +yap4r/src/RcppExports.cpp +) + set(REAL_SOURCES real.c) # LIBR_FOUND @@ -16,10 +25,10 @@ set_package_properties(R PROPERTIES URL "https://www.r-project.org/") -foreach(f ${FILES}) +foreach(f ${YAP4R_SOURCES}) add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${f} COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/${f} ${CMAKE_CURRENT_BINARY_DIR}/${f} - DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${f} + DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/${f} ) list(APPEND OUTS ${CMAKE_CURRENT_BINARY_DIR}/${f} ) endforeach() @@ -28,12 +37,14 @@ add_custom_target(YAP4R WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} DEPENDS ${OUTS} ) + add_library(real ${REAL_SOURCES}) target_link_libraries (real ${LIBR_LIBRARIES} libYap) include_directories ( ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/include + ${CMAKE_CURRENT_SOURCE_DIR} ${LIBR_INCLUDE_DIRS} ) @@ -51,21 +62,8 @@ include_directories ( configure_file ("yap4r/src/Makevars.in" "yap4r/src/Makevars" ) - set(YAP4R_SOURCES - yap4r/man/yap4r-package.Rd -yap4r/R -yap4r/R/RcppExports.R -yap4r/NAMESPACE -yap4r/DESCRIPTION -yap4r/src -yap4r/src/Makevars.in -yap4r/src/yap4r.cpp -yap4r/src/RcppExports.cpp -) - - - - + add_dependencies(real YAP4R) + install(TARGETS real RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/packages/real/real.c b/packages/real/real.c index 5a08e092d..d0d4706ae 100644 --- a/packages/real/real.c +++ b/packages/real/real.c @@ -16,59 +16,24 @@ */ #define CSTACK_DEFNS #include "rconfig.h" -#if HAVE_R_H || !defined(_YAP_NOT_INSTALLED_) + #include #undef ERROR #if HAVE_R_EMBEDDED_H #include #endif -#include -#include #if HAVE_R_INTERFACE_H #include #define R_SIGNAL_HANDLERS 1 #endif -#include +#include + #include #include #include +#include -bool R_isNull(SEXP sexp); - -#if DEBUG_MEMORY -#define PROTECT_AND_COUNT(EXP) \ - { \ - extern int R_PPStackTop; \ - PROTECT(EXP); \ - nprotect++; \ - printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \ - } -#define Ureturn \ - { \ - extern int R_PPStackTop; \ - printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \ - R_PPStackTop - nprotect); \ - } \ - unprotect(nprotect); \ - return -#else -#define PROTECT_AND_COUNT(EXP) \ - { \ - PROTECT(EXP); \ - nprotect++; \ - } -#define Ureturn \ - unprotect(nprotect); \ - return -#endif - -// #define PL_free(v) - -static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) { - SEXP o; - o = R_tryEval(expr, env, errp); - return o ? o : expr; -} +#include "real.h" static atom_t ATOM_break; static atom_t ATOM_false; @@ -106,9 +71,6 @@ static functor_t FUNCTOR_while2; X_API install_t install_real(void); -static SEXP term_to_sexp(term_t t, bool eval); -static int sexp_to_pl(term_t t, SEXP s); - #define PL_R_BOOL (1) /* const char * */ #define PL_R_CHARS (2) /* const char * */ #define PL_R_INTEGER (3) /* int */ @@ -491,7 +453,7 @@ static int merge_dots(term_t t) { } // put t in ans[index]; and stores elements of type objtype -static int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) { +int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) { switch (objtype) { case PL_R_CHARS: case PL_R_PLUS: { @@ -1226,7 +1188,7 @@ static int pl_to_binary(const char *s, term_t t, term_t tmp, SEXP *ansP) { * * @return whether it succeeds or fails. */ -static SEXP(term_to_sexp(term_t t, bool eval)) { +SEXP term_to_sexp(term_t t, bool eval) { int nprotect = 0; SEXP ans = R_NilValue; int objtype; @@ -1671,8 +1633,7 @@ static int bind_sexp(term_t t, SEXP sexp) { /******************************* * SEXP --> Prolog * *******************************/ - -static int sexp_to_pl(term_t t, SEXP s) { +bool sexp_to_pl(term_t t, SEXP s) { int rank = sexp_rank(s); size_t shape[256]; @@ -2225,6 +2186,5 @@ install_real(void) { /* FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2); */ PL_register_foreign("is_R_variable", 1, is_R_variable, 0); } -#endif /* R_H */ /// @} diff --git a/packages/real/real.h b/packages/real/real.h index 8b0984e89..c3792110a 100644 --- a/packages/real/real.h +++ b/packages/real/real.h @@ -1,68 +1,64 @@ -#include -#include -#include -#include -#include + +/** + * @file real.h + * @date Sat May 19 13:44:04 2018 + * + * @brief Prolog to R interface + * + * + */ -#include -#include +#ifdef __cplusplus +extern "C"{ +#endif + +bool R_isNull(SEXP sexp); -#define BUFSIZE 256 +#if DEBUG_MEMORY +#define PROTECT_AND_COUNT(EXP) \ + { \ + extern int R_PPStackTop; \ + PROTECT(EXP); \ + nprotect++; \ + printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \ + } +#define Ureturn \ + { \ + extern int R_PPStackTop; \ + printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \ + R_PPStackTop - nprotect); \ + } \ + unprotect(nprotect); \ + return +#else +#define PROTECT_AND_COUNT(EXP) \ + { \ + PROTECT(EXP); \ + nprotect++; \ + } +#define Ureturn \ + unprotect(nprotect); \ + return +#endif -typedef unsigned int PL_Type; +// #define PL_free(v) -#define PL_Nil 0 -#define PL_Var 1 -#define PL_Atom 2 -#define PL_Appl 3 -#define PL_Pair 4 -#define PL_Int 5 -#define PL_Float 6 -#define PL_DbRef 7 -#define PL_Unknown 8 +static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) { + SEXP o; + o = R_tryEval(expr, env, errp); + return o ? o : expr; +} + #ifndef term_t +#define term_t YAP_Int + #endif -typedef enum { - r_undefined, - r_double, - r_int, - r_character -} r_basic_types; + +extern bool sexp_to_pl(term_t t, SEXP s); +extern SEXP term_to_sexp(term_t t, bool eval); -typedef struct -{ - r_basic_types type; - union { - int int_val; - double double_val; - char *char_val; - } real_u; -} list_cell; +#ifdef __cplusplus +} +#endif -typedef struct -{ - int size; - int nDims; - int dims[BUFSIZE]; - list_cell values[BUFSIZE]; -} list; - -#define real_Int 1 -#define real_Float 2 -#define real_Char 3 -#define real_Bool 4 - -#define real_ty_Vector 1 -#define real_ty_Matrix 2 -#define real_ty_List 3 -#define real_ty_Array 4 //not used, yet - -extern void init_R(void); -extern void end_R(void); -extern void send_command(char * expression); -extern int set_list_values(void); -extern int set_vec_values(void); -extern int set_array_values(void); -extern SEXP process_expression(char * expression); -extern YAP_Term sexp_pl(SEXP s); diff --git a/packages/real/yap4r/NAMESPACE b/packages/real/yap4r/NAMESPACE index a97033a02..7e69d01ea 100644 --- a/packages/real/yap4r/NAMESPACE +++ b/packages/real/yap4r/NAMESPACE @@ -1,3 +1,5 @@ -useDynLib(yap4r, .registration=TRUE) exportPattern("^[[:alpha:]]+") -importFrom(Rcpp, evalCpp) +import(Rcpp) +useDynLib(yap4r, .registration=TRUE) + + diff --git a/packages/real/yap4r/R/RcppExports.R b/packages/real/yap4r/R/RcppExports.R deleted file mode 100644 index 1c03a2ce6..000000000 --- a/packages/real/yap4r/R/RcppExports.R +++ /dev/null @@ -1,19 +0,0 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -query <- function(p_name, p_module, sexp) { - .Call(`_yap4r_query`, p_name, p_module, sexp) -} - -next <- function() { - .Call(`_yap4r_next`) -} - -cut <- function() { - .Call(`_yap4r_cut`) -} - -ask <- function(i) { - .Call(`_yap4r_ask`, i) -} - diff --git a/packages/real/yap4r/R/zzz.R b/packages/real/yap4r/R/zzz.R new file mode 100644 index 000000000..2fdc83886 --- /dev/null +++ b/packages/real/yap4r/R/zzz.R @@ -0,0 +1,15 @@ + +## Up until R 2.15.0, the require("methods") is needed but (now) +## triggers an warning from R CMD check +#.onLoad <- function(libname, pkgname){ +# #require("methods") ## needed with R <= 2.15.0 +# loadRcppModules() +#} + + +## For R 2.15.1 and later this also works. Note that calling loadModule() triggers +## a load action, so this does not have to be placed in .onLoad() or evalqOnLoad(). +loadModule("mod_yap4r", TRUE) + + + diff --git a/packages/real/yap4r/src/Makevars.in b/packages/real/yap4r/src/Makevars.in index 709fa07d5..18c55bee1 100644 --- a/packages/real/yap4r/src/Makevars.in +++ b/packages/real/yap4r/src/Makevars.in @@ -1,2 +1,6 @@ -PKG_LIBS=-L${YAP_LIBDIR} -L${YAP_DLLDIR} -L ../../.. -lreal -lYap -PKG_CPPFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR} -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os -I../.. +PKG_LIBS=-Wl,-rpath=${YAP_LIBDIR} -Wl,-rpath=${YAP_DLLDIR} \ + -L${YAP_LIBDIR} -L${YAP_DLLDIR} -lreal -lYAP++ -lYap +PKG_CXXFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR}\ + -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H\ + -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os\ + -I../.. -I${YAP_SOURCE_DIR}/utf8proc -I${YAP_SOURCE_DIR}/packages/real diff --git a/packages/real/yap4r/src/RcppExports.cpp b/packages/real/yap4r/src/RcppExports.cpp index d44a30492..02ffefcff 100644 --- a/packages/real/yap4r/src/RcppExports.cpp +++ b/packages/real/yap4r/src/RcppExports.cpp @@ -5,58 +5,10 @@ using namespace Rcpp; -// query -bool query(std::string p_name, std::string p_module, SEXP sexp); -RcppExport SEXP _yap4r_query(SEXP p_nameSEXP, SEXP p_moduleSEXP, SEXP sexpSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type p_name(p_nameSEXP); - Rcpp::traits::input_parameter< std::string >::type p_module(p_moduleSEXP); - Rcpp::traits::input_parameter< SEXP >::type sexp(sexpSEXP); - rcpp_result_gen = Rcpp::wrap(query(p_name, p_module, sexp)); - return rcpp_result_gen; -END_RCPP -} -// next -bool next(); -RcppExport SEXP _yap4r_next() { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(next()); - return rcpp_result_gen; -END_RCPP -} -// cut -bool cut(); -RcppExport SEXP _yap4r_cut() { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(cut()); - return rcpp_result_gen; -END_RCPP -} -// ask -SEXP ask(int i); -RcppExport SEXP _yap4r_ask(SEXP iSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type i(iSEXP); - rcpp_result_gen = Rcpp::wrap(ask(i)); - return rcpp_result_gen; -END_RCPP -} RcppExport SEXP _rcpp_module_boot_mod_yap4r(); static const R_CallMethodDef CallEntries[] = { - {"_yap4r_query", (DL_FUNC) &_yap4r_query, 3}, - {"_yap4r_next", (DL_FUNC) &_yap4r_next, 0}, - {"_yap4r_cut", (DL_FUNC) &_yap4r_cut, 0}, - {"_yap4r_ask", (DL_FUNC) &_yap4r_ask, 1}, {"_rcpp_module_boot_mod_yap4r", (DL_FUNC) &_rcpp_module_boot_mod_yap4r, 0}, {NULL, NULL, 0} }; diff --git a/packages/real/yap4r/src/yap4r.cpp b/packages/real/yap4r/src/yap4r.cpp index 16ecd9820..26b6cffbd 100644 --- a/packages/real/yap4r/src/yap4r.cpp +++ b/packages/real/yap4r/src/yap4r.cpp @@ -6,13 +6,14 @@ #include #include +#include #include "real.h" using namespace Rcpp; -class YAP4R { +class yap4r { YAPEngine *yap; YAPQuery *q; @@ -20,74 +21,78 @@ class YAP4R { bool failed; public: -//[[Rcpp::export]] + yap4r(); + bool query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps); + bool more(); + bool done(); + SEXP peek(int i); +}; -YAP4R() { + yap4r::yap4r() { YAPEngineArgs *yargs = new YAPEngineArgs(); yap = new YAPEngine(yargs); }; -//[[Rcpp::export]] -bool query(std::string p_name,std::string p_module, SEXP sexp) { + + + bool yap4r::query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps) { - YAPPairTerm tmp; if (q) { q->close(); q = NULL; } - if (!sexp_to_pl(tmp.handle(), sexp)) - return false; - args = tmp.listToVector(); - YAPTerm ts[1], hd; + std::vector args = std::vector(); + yhandle_t sls = Yap_NewHandles(sexps.length()); + for (int i=0; inext(); if (!rc) { failed = true; } return rc; } -//[[Rcpp::export]] - bool cut() { - bool rc = true; + + bool yap4r::done() { + if (failed) return false; if (q) - rc = cut(); + q->cut(); q = NULL; - return rc; - }; + return true; + } -//[[Rcpp::export]] - SEXP ask(int i) { + + SEXP yap4r::peek(int i) { if (failed || q==nullptr) return R_MissingArg; - return term_to_sexp(YAPTerm(Yap_XREGS[i]).handle(), false); - }; + return term_to_sexp(Yap_InitSlot(Yap_XREGS[i]), false); + } - -}; - RCPP_MODULE(mod_yap4r) { - Rcpp::class_( "YAP4R" ) - .constructor("documentation for default constructor") - .method( "query", &YAP4R::query ) -.method( "next", &YAP4R::next ) -.method( "ask", &YAP4R::ask ) -.method( "cut", &YAP4R::cut ) - ; -; + class_( "yap4r" ) + .constructor("create an object encapsulating a Prolog engine") + .method( "query", &yap4r::query, "create an active query within the engine") + .method( "more", &yap4r::more, "ask for an extra solution") + .method( "done", &yap4r::done, "terminate the query") + .method( "peek", &yap4r::peek, "load arg[i] into R") + ; }