This commit is contained in:
Vítor Santos Costa
2019-04-02 10:27:37 +01:00
parent 9156b90b66
commit 63a514cad5
9 changed files with 143 additions and 230 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -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) {
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<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.push_back( Yap_GetFromSlot(sls+i) );
}
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 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>( "YAP4R" )
.constructor("documentation for default constructor")
.method( "query", &YAP4R::query )
.method( "next", &YAP4R::next )
.method( "ask", &YAP4R::ask )
.method( "cut", &YAP4R::cut )
;
;
class_<yap4r>( "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")
;
}