yap4r

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,7 +25,7 @@ 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}
@@ -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,20 +62,7 @@ include_directories (
   configure_file ("yap4r/src/Makevars.in" "yap4r/src/Makevars" )
 
   
-  set(YAP4R_SOURCES
+  add_dependencies(real YAP4R)
-    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
-)
-
-
-
   
  install(TARGETS  real
     RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR}

packages/real/real.c

@@ -16,59 +16,24 @@
  */
 #define CSTACK_DEFNS
 #include "rconfig.h"
-#if HAVE_R_H || !defined(_YAP_NOT_INSTALLED_)
+
 #include <SWI-Prolog.h>
 #undef ERROR
 #if HAVE_R_EMBEDDED_H
 #include <Rembedded.h>
 #endif
-#include <R.h>
-#include <Rinternals.h>
 #if HAVE_R_INTERFACE_H
 #include <Rinterface.h>
 #define R_SIGNAL_HANDLERS 1
 #endif
-#include <R_ext/Parse.h>
+#include <R.h>
+
 #include <Rdefines.h>
 #include <assert.h>
 #include <string.h>
+#include <R_ext/Parse.h>
 
-bool R_isNull(SEXP sexp);
+#include "real.h"
-
-#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;
-}
 
 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	*
  *******************************/
-
+bool  sexp_to_pl(term_t t, SEXP s) {
-static int 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 */
 /// @}
 

packages/real/real.h

@@ -1,68 +1,64 @@
-#include <Rembedded.h>
-#include <R.h>
-#include <Rinternals.h>
-#include <Rdefines.h>
-#include <R_ext/Parse.h>
  
-#include <YapInterface.h>
+/**
-#include <c_interface.h>
+ * @file   real.h
+ * @date   Sat May 19 13:44:04 2018
+ * 
+ * @brief  Prolog  to R interface
+ * 
+ * 
+ */
 
-#define BUFSIZE 256
+#ifdef __cplusplus
+extern "C"{
+#endif
   
-typedef unsigned int PL_Type;
+bool R_isNull(SEXP sexp);
 
-#define PL_Nil       0
+#if DEBUG_MEMORY
-#define PL_Var       1
+#define PROTECT_AND_COUNT(EXP)                                                 \
-#define PL_Atom      2
+  {                                                                            \
-#define PL_Appl      3
+    extern int R_PPStackTop;                                                   \
-#define PL_Pair      4
+    PROTECT(EXP);                                                              \
-#define PL_Int       5
+    nprotect++;                                                                \
-#define PL_Float     6
+    printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop);  \
-#define PL_DbRef     7
+  }
-#define PL_Unknown   8
+#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;
+}
 
 
+  #ifndef term_t
+#define term_t YAP_Int
+  #endif
 
-typedef enum {
-  r_undefined,
-  r_double,
-  r_int,
-  r_character
-} r_basic_types;
   
-typedef struct
+extern bool  sexp_to_pl(term_t t, SEXP s);
-{
+extern SEXP term_to_sexp(term_t t, bool eval);
-  r_basic_types    type;
-  union {
-    int     int_val;
-    double  double_val;
-    char    *char_val;
-  } real_u;
-} list_cell;
 
-typedef struct
+#ifdef __cplusplus
-{
+}
-    int         size;
+#endif
-    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);

packages/real/yap4r/NAMESPACE

@@ -1,3 +1,5 @@
-useDynLib(yap4r, .registration=TRUE)
 exportPattern("^[[:alpha:]]+")
-importFrom(Rcpp, evalCpp)
+import(Rcpp)
+useDynLib(yap4r, .registration=TRUE)
+
+

packages/real/yap4r/R/RcppExports.R

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

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

packages/real/yap4r/src/Makevars.in

@@ -1,2 +1,6 @@
-PKG_LIBS=-L${YAP_LIBDIR} -L${YAP_DLLDIR} -L ../../.. -lreal -lYap
+PKG_LIBS=-Wl,-rpath=${YAP_LIBDIR} -Wl,-rpath=${YAP_DLLDIR} \
-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../..
+         -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

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

packages/real/yap4r/src/yap4r.cpp

@@ -6,13 +6,14 @@
 #include <yapi.hh>
 
 #include <vector>
+#include <string>
 
 #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) {
 
-  YAPPairTerm tmp;
+
+  bool yap4r::query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps) {
+ 
   if (q) {
     q->close();
     q = NULL;
   }
-  if (!sexp_to_pl(tmp.handle(), sexp))
+  std::vector<Term> args = std::vector<Term>();
+  yhandle_t sls = Yap_NewHandles(sexps.length());
+  for (int i=0; i<sexps.length();i++) {
+    if (!sexp_to_pl(sls+i, sexps[i]))
       return false;
-   args = tmp.listToVector();
+    args.push_back( Yap_GetFromSlot(sls+i) );
-  YAPTerm ts[1], hd;
+  }
   YAPTerm qt = YAPApplTerm(p_name,args);
   q = new YAPQuery(qt);
   return true;
-};
+}
 
   
-//[[Rcpp::export]]
+
-  bool next() {
+  bool yap4r::more() {
     bool rc = true;
     if (failed)
       return false;
     if (q)
-      rc = next();
+      rc = q->next();
     if (!rc) {
       failed = true;
     }
     return rc;
   }
 
-//[[Rcpp::export]]
+
-  bool cut() {
+  bool yap4r::done() {
-    bool rc = true;
+
     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>( "YAP4R" )
+    class_<yap4r>( "yap4r" )
-  .constructor("documentation for default constructor")
+      .constructor("create an object encapsulating a Prolog engine")
- .method( "query", &YAP4R::query )
+      .method( "query", &yap4r::query, "create an active query within the engine")
-.method( "next", &YAP4R::next )
+      .method( "more", &yap4r::more, "ask for an extra solution")
-.method( "ask", &YAP4R::ask )
+      .method( "done", &yap4r::done, "terminate the query")
-.method( "cut", &YAP4R::cut )
+      .method( "peek", &yap4r::peek, "load arg[i] into R")
       ;
-;
 }