[Rcpp-commits] r4077 - in pkg/Rcpp: . R src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Dec 4 20:57:22 CET 2012


Author: jjallaire
Date: 2012-12-04 20:57:22 +0100 (Tue, 04 Dec 2012)
New Revision: 4077

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/R/Attributes.R
   pkg/Rcpp/src/Attributes.cpp
   pkg/Rcpp/src/AttributesGen.cpp
   pkg/Rcpp/src/AttributesGen.h
   pkg/Rcpp/src/AttributesParser.cpp
   pkg/Rcpp/src/AttributesUtil.h
Log:
use simple code generation for sourceCpp

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/ChangeLog	2012-12-04 19:57:22 UTC (rev 4077)
@@ -1,7 +1,10 @@
 2012-12-04  JJ Allaire <jj at rstudio.org>
 
-        * src/Attributes.cpp: move generators into their own source file
-        * src/AttributesGen.cpp: move generators into their own source file
+        * R/Attributes.R: use simple code generation for sourceCpp
+        * src/Attributes.cpp: move generators into their own source file;
+        use simple code generation for sourceCpp
+        * src/AttributesGen.cpp: move generators into their own source file;
+        add C++ default argument parsing
         * src/AttributesGen.h: move generators into their own source file
         * src/AttributesParser.cpp: move generators into their own source file
         * src/AttributesParser.h: move generators into their own source file

Modified: pkg/Rcpp/R/Attributes.R
===================================================================
--- pkg/Rcpp/R/Attributes.R	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/R/Attributes.R	2012-12-04 19:57:22 UTC (rev 4077)
@@ -136,10 +136,9 @@
         removeObjs <- exports[exports %in% ls(envir = env, all.names = T)]
         remove(list = removeObjs, envir = env)
         
-        # load the module and populate the target environment
-        dll <- dyn.load(context$dynlibPath)
-        populate(Module(context$moduleName, PACKAGE = dll, mustStart = TRUE), 
-                 env)
+        # source the R script
+        scriptPath <- file.path(context$buildDirectory, context$rSourceFilename) 
+        source(scriptPath, local = env)
     } else if (getOption("rcpp.warnNoExports", default=TRUE)) {
         warning("No Rcpp::export attributes found in source")
     }
@@ -308,16 +307,21 @@
 # Print verbose output
 .printVerboseOutput <- function(context) {
     
-    cat("\nGenerated Rcpp module declaration:",
-        "\n--------------------------------------------------------\n\n")
+    cat("\nGenerated extern \"C\" functions",
+        "\n--------------------------------------------------------\n")
     cat(context$generatedCpp, sep="")
     
-    cat("\nBuilding shared library", 
+    cat("\nGenerated R .Call bindings",
+        "\n-------------------------------------------------------\n\n")
+    cat(readLines(file.path(context$buildDirectory, 
+                            context$rSourceFilename)), 
+        sep="\n")
+    
+    cat("Building shared library", 
         "\n--------------------------------------------------------\n",
         "\nDIR: ", context$buildDirectory, "\n\n", sep="")
 }
 
-
 # Add LinkingTo dependencies if the sourceFile is in a package
 .getSourceCppDependencies <- function(depends, sourceFile) {
     

Modified: pkg/Rcpp/src/Attributes.cpp
===================================================================
--- pkg/Rcpp/src/Attributes.cpp	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/src/Attributes.cpp	2012-12-04 19:57:22 UTC (rev 4077)
@@ -114,12 +114,207 @@
             *pStr = pStr->substr(1, pStr->length()-2);
     }
     
+    // is the passed string quoted?
+    bool isQuoted(const std::string& str) {
+        if (str.length() < 2)
+            return false;
+        char quote = *(str.begin());
+        return (quote == '\'' || quote == '\"') && (*(str.rbegin()) == quote);
+    }
+    
+    // show a warning message
+    void showWarning(const std::string& msg) {
+        Rcpp::Function warning = Rcpp::Environment::base_env()["warning"];     
+        warning(msg, Rcpp::Named("call.") = false);
+    }
+    
 } // namespace attributes
 } // namespace Rcpp
 
 
 using namespace Rcpp::attributes;
 
+// Generator helpers
+namespace {
+    
+    // Generate the C++ code required to make [[Rcpp::export]] functions
+    // available as C symbols with SEXP parameters and return
+    std::string generateCpp(const SourceFileAttributes& attributes,
+                            bool includePrototype,
+                            const std::string& contextId) {
+      
+        // source code we will build up
+        std::ostringstream ostr;    
+      
+        // process each attribute
+        for(std::vector<Attribute>::const_iterator 
+            it = attributes.begin(); it != attributes.end(); ++it) {
+            
+            // alias the attribute and function (bail if not export)
+            const Attribute& attribute = *it;
+            if (!attribute.isExportedFunction())
+                continue;
+            const Function& function = attribute.function();
+                      
+            // include prototype if requested
+            if (includePrototype) {
+                ostr << "// " << function.name() << std::endl;
+                ostr << function << ";";
+            }
+               
+            // write the SEXP-based function
+            ostr << std::endl << "RcppExport SEXP ";
+            if (!contextId.empty())
+                ostr << contextId << "_";
+            ostr << function.name() << "(";
+            const std::vector<Argument>& arguments = function.arguments();
+            for (size_t i = 0; i<arguments.size(); i++) {
+                const Argument& argument = arguments[i];
+                ostr << "SEXP " << argument.name() << "SEXP";
+                if (i != (arguments.size()-1))
+                    ostr << ", ";
+            }
+            ostr << ") {" << std::endl;
+            ostr << "BEGIN_RCPP" << std::endl;
+            for (size_t i = 0; i<arguments.size(); i++) {
+                const Argument& argument = arguments[i];
+                
+                // Rcpp::as to c++ type
+                ostr << "    " << argument.type().name() << " " << argument.name() 
+                     << " = " << "Rcpp::as<"  << argument.type().name() << " >(" 
+                     << argument.name() << "SEXP);" << std::endl;
+            }
+            
+            ostr << "    ";
+            if (!function.type().isVoid())
+                ostr << function.type() << " result = ";
+            ostr << function.name() << "(";
+            for (size_t i = 0; i<arguments.size(); i++) {
+                const Argument& argument = arguments[i];
+                ostr << argument.name();
+                if (i != (arguments.size()-1))
+                    ostr << ", ";
+            }
+            ostr << ");" << std::endl;
+            
+            std::string res = function.type().isVoid() ? "R_NilValue" : 
+                                                         "Rcpp::wrap(result)";
+            ostr << "    return " << res << ";" << std::endl;
+            ostr << "END_RCPP" << std::endl;
+            ostr << "}" << std::endl;
+        }
+        
+        return ostr.str();
+    }
+        
+    // Generate R functions from the passed attributes
+    std::string generateRFunctions(const SourceFileAttributes& attributes,
+                                   const std::string& contextId,
+                                   const std::string& dllInfo = std::string()) {
+     
+        // source code we will build up
+        std::ostringstream ostr;
+         
+        // process each attribute
+        for(std::vector<Attribute>::const_iterator 
+            it = attributes.begin(); it != attributes.end(); ++it) {
+            
+            // alias the attribute and function (bail if not export)
+            const Attribute& attribute = *it;
+            if (!attribute.isExportedFunction())
+                continue;
+            const Function& function = attribute.function();
+                
+            // print roxygen lines
+            for (size_t i=0; i<attribute.roxygen().size(); i++)
+                ostr << attribute.roxygen()[i] << std::endl;
+                    
+            // build the parameter list 
+            std::ostringstream argsOstr;
+            const std::vector<Argument>& arguments = function.arguments();
+            for (size_t i = 0; i<arguments.size(); i++) {
+                const Argument& argument = arguments[i];
+                argsOstr << argument.name();
+                if (!argument.defaultValue().empty()) {
+                    std::string rArg = cppArgToRArg(argument.type().name(), 
+                                                    argument.defaultValue());
+                    if (!rArg.empty()) {
+                        argsOstr << " = " << rArg;
+                    } else {
+                        showWarning("Unable to parse C++ default value '" +
+                                    argument.defaultValue() + "' for argument "+
+                                    argument.name() + " of function " +
+                                    function.name());
+                    }
+                }
+                   
+                if (i != (arguments.size()-1))
+                    argsOstr << ", ";
+            }
+            std::string args = argsOstr.str();
+            
+            // determine the function name
+            std::string name = attribute.exportedName();
+                
+            // write the function - use contextId to ensure symbol uniqueness
+            ostr << name << " <- function(" << args << ") {" 
+                 << std::endl;
+            ostr << "    ";
+            if (function.type().isVoid())
+                ostr << "invisible(";
+            ostr << ".Call(";
+            
+            // Two .Call styles are suppported -- if dllInfo is provided then
+            // do a direct call to getNativeSymbolInfo; otherwise we assume that
+            // the contextId is a package name and use the PACKAGE argument
+            if (!dllInfo.empty()) {
+                ostr << "getNativeSymbolInfo('"
+                     <<  contextId << "_" << function.name() 
+                     << "', " << dllInfo << ")";
+            } 
+            else {
+                ostr << "'" << contextId << "_" << function.name() << "', "
+                     << "PACKAGE = '" << contextId << "'";
+            }
+            
+            // add arguments
+            if (!args.empty())
+                ostr << ", " << args;
+            ostr << ")";
+            if (function.type().isVoid())
+                ostr << ")";
+            ostr << std::endl;
+        
+            ostr << "}" << std::endl << std::endl;
+        }
+        
+        return ostr.str();                                
+    }
+    
+    // Generate the R code used to .Call the exported C symbols
+    std::string generateR(const SourceFileAttributes& attributes,
+                          const std::string& contextId,
+                          const std::string& dynlibPath) {
+            
+        // source code we will build up
+        std::ostringstream ostr;
+        
+        // DLLInfo - hide using . and ensure uniqueness using contextId
+        std::string dllInfo = "`." + contextId + "_DLLInfo`";
+        ostr << dllInfo << " <- dyn.load('" << dynlibPath << "')" 
+             << std::endl << std::endl;
+        
+        // Generate R functions and return
+        ostr << generateRFunctions(attributes, contextId, dllInfo);
+        return ostr.str();
+    }
+    
+    
+    
+} // anonymous namespace
+
+
+
 // Implementation helpers for sourceCppContext
 namespace {
     
@@ -152,11 +347,11 @@
             Rcpp::Function dircreate = Rcpp::Environment::base_env()["dir.create"];
             dircreate(buildDirectory_);
             
-            // generate a random module name
+            // generate a random context id
             Rcpp::Function sample = Rcpp::Environment::base_env()["sample"];
             std::ostringstream ostr;
             ostr << "sourceCpp_" << Rcpp::as<int>(sample(100000, 1));
-            moduleName_ = ostr.str();
+            contextId_ = ostr.str();
             
             // regenerate the source code
             regenerateSource();
@@ -189,25 +384,25 @@
             // parse attributes
             SourceFileAttributesParser sourceAttributes(cppSourcePath_);
         
-            // generate RCPP module
-            generatedCpp_.clear();
-            if (!sourceAttributes.empty()) {
-                std::ostringstream ostr;
-                ostr << "#include <Rcpp.h>" << std::endl;
-                ostr << "RCPP_MODULE(" << moduleName()  << ") {" << std::endl;
-                generateCppModuleFunctions(ostr, sourceAttributes, false);
-                ostr << "}" << std::endl;
-                generatedCpp_ = ostr.str();
-            }
-            
-            // open source file and append module
+            // generate cpp for attributes and append them 
+            generatedCpp_ = generateCpp(sourceAttributes, false, contextId_);
             std::ofstream cppOfs(generatedCppSourcePath().c_str(), 
                                  std::ofstream::out | std::ofstream::app);
             if (cppOfs.fail())
                 throw Rcpp::file_io_error(generatedCppSourcePath());
-            cppOfs << std::endl;
             cppOfs << generatedCpp_;
             cppOfs.close();
+        
+            // generate R for attributes and write it into the build directory
+            std::string rCode = generateR(sourceAttributes, 
+                                          contextId_, 
+                                          dynlibPath());
+            std::ofstream rOfs(generatedRSourcePath().c_str(), 
+                               std::ofstream::out | std::ofstream::trunc);
+             if (cppOfs.fail())
+                throw Rcpp::file_io_error(generatedRSourcePath());
+            rOfs << rCode;
+            rOfs.close();
                
             // discover exported functions, and dependencies
             exportedFunctions_.clear();
@@ -227,8 +422,8 @@
             embeddedR_ = sourceAttributes.embeddedR();
         }
         
-        const std::string& moduleName() const {
-            return moduleName_;
+        const std::string& contextId() const {
+            return contextId_;
         }
         
         const std::string& cppSourcePath() const {
@@ -246,9 +441,13 @@
         std::string cppSourceFilename() const {
             return cppSourceFilename_;
         }
+        
+        std::string rSourceFilename() const {
+            return cppSourceFilename() + ".R";    
+        }
          
         std::string dynlibFilename() const {
-            return moduleName() + dynlibExt_;
+            return contextId() + dynlibExt_;
         }
         
         std::string dynlibPath() const {
@@ -269,11 +468,15 @@
            return buildDirectory_ + fileSep_ + cppSourceFilename(); 
         }
         
+         std::string generatedRSourcePath() const {
+           return buildDirectory_ + fileSep_ + rSourceFilename(); 
+        }
+        
     private:
         std::string cppSourcePath_;
         std::string generatedCpp_;
         std::string cppSourceFilename_;
-        std::string moduleName_;
+        std::string contextId_;
         std::string buildDirectory_;
         std::string fileSep_;
         std::string dynlibExt_;
@@ -386,13 +589,14 @@
     // return context as a list
     using namespace Rcpp;
     return List::create(
-        _["moduleName"] = pDynlib->moduleName(),
+        _["contextId"] = pDynlib->contextId(),
         _["cppSourcePath"] = pDynlib->cppSourcePath(),
         _["buildRequired"] = buildRequired,
         _["buildDirectory"] = pDynlib->buildDirectory(),
         _["generatedCpp"] = pDynlib->generatedCpp(),
         _["exportedFunctions"] = pDynlib->exportedFunctions(),
         _["cppSourceFilename"] = pDynlib->cppSourceFilename(),
+        _["rSourceFilename"] = pDynlib->rSourceFilename(),
         _["dynlibFilename"] = pDynlib->dynlibFilename(),
         _["dynlibPath"] = pDynlib->dynlibPath(),
         _["depends"] = pDynlib->depends(),

Modified: pkg/Rcpp/src/AttributesGen.cpp
===================================================================
--- pkg/Rcpp/src/AttributesGen.cpp	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/src/AttributesGen.cpp	2012-12-04 19:57:22 UTC (rev 4077)
@@ -593,5 +593,135 @@
         }
     }
     
+    namespace {
+        // convert a C++ numeric argument to an R argument value 
+        // (returns empty string if no conversion is possible)
+        std::string cppNumericArgToRArg(const std::string& type,
+                                        const std::string& cppArg) {
+            // check for a number
+            double num;
+            std::stringstream argStream(cppArg);
+            if ((argStream >> num)) {
+                
+                // L suffix means return the value literally
+                bool isInteger = false;
+                if (!argStream.eof()) {
+                    std::string suffix;
+                    argStream >> suffix;
+                    if (argStream.eof() && suffix == "L")
+                        return cppArg;
+                }
+                
+                // no decimal and the type isn't explicitly double or 
+                // float means integer
+                if (cppArg.find('.') == std::string::npos &&
+                    type != "double" && type != "float")
+                    return cppArg + "L";
+                 
+                // otherwise return arg literally
+                else
+                    return cppArg;
+            }   
+            else {
+                return std::string();
+            }
+        }
+        
+        // convert a C++ ::create style argument value to an R argument
+        // value (returns empty string if no conversion is possible)
+        std::string cppCreateArgToRArg(const std::string& cppArg) {
+            
+            std::string create = "::create";
+            size_t createLoc = cppArg.find(create);
+            if (createLoc == std::string::npos ||
+                ((createLoc + create.length()) >= cppArg.size())) {
+                return std::string();
+            }
+                
+            std::string type = cppArg.substr(0, createLoc);
+            std::string rcppScope = "Rcpp::";
+            size_t rcppLoc = type.find(rcppScope);
+            if (rcppLoc == 0 && type.size() > rcppScope.length())
+                type = type.substr(rcppScope.length());
+            
+            std::string args = cppArg.substr(createLoc + create.length());
+            if (type == "CharacterVector")
+                return "character" + args;
+            else if (type == "IntegerVector")
+                return "integer" + args;
+            else if (type == "NumericVector")
+                return "numeric" + args;
+            else    
+                return std::string();
+        }
+        
+        // convert a C++ Matrix to an R argument (returns emtpy string
+        // if no conversion possible)
+        std::string cppMatrixArgToRArg(const std::string& cppArg) {
+            
+            // look for Matrix
+            std::string matrix = "Matrix";
+            size_t matrixLoc = cppArg.find(matrix);
+            if (matrixLoc == std::string::npos ||
+                ((matrixLoc + matrix.length()) >= cppArg.size())) {
+                return std::string();
+            }
+            
+            std::string args = cppArg.substr(matrixLoc + matrix.length());
+            return "matrix" + args;
+        }
+        
+        // convert a C++ literal to an R argument (returns emtpy string
+        // if no conversion possible)
+        std::string cppLiteralArgToRArg(const std::string& cppArg) {
+            if (cppArg == "true")
+                return "TRUE";
+            else if (cppArg == "false")
+                return "FALSE";
+            else if (cppArg == "R_NilValue")
+                return "NULL";
+            else if (cppArg == "NA_STRING" || cppArg == "NA_INTEGER" ||
+                     cppArg == "NA_LOGICAL" || cppArg == "NA_REAL") {
+                return "NA";
+            }
+            else
+                return std::string();
+        }
+    } // anonymous namespace
+    
+    // convert a C++ argument value to an R argument value (returns empty
+    // string if no conversion is possible)
+    std::string cppArgToRArg(const std::string& type,
+                             const std::string& cppArg) {
+        
+        // try for quoted string
+        if (isQuoted(cppArg))
+            return cppArg;
+        
+        // try for literal
+        std::string rArg = cppLiteralArgToRArg(cppArg);
+        if (!rArg.empty())
+            return rArg;
+        
+        // try for a create arg
+        rArg = cppCreateArgToRArg(cppArg);
+        if (!rArg.empty())
+            return rArg;
+            
+        // try for a matrix arg
+        rArg = cppMatrixArgToRArg(cppArg);
+        if (!rArg.empty())
+            return rArg;
+            
+        // try for a numeric arg
+        rArg = cppNumericArgToRArg(type, cppArg);
+        if (!rArg.empty())
+            return rArg;
+            
+        // couldn't parse the arg
+        return std::string();
+    }
+    
+    
 } // namespace attributes
 } // namespace Rcpp

Modified: pkg/Rcpp/src/AttributesGen.h
===================================================================
--- pkg/Rcpp/src/AttributesGen.h	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/src/AttributesGen.h	2012-12-04 19:57:22 UTC (rev 4077)
@@ -224,7 +224,11 @@
     void generateCppModuleFunctions(std::ostream& ostr,
                                     const SourceFileAttributes& attributes,
                                     bool verbose);
-
+     
+    // Convert a C++ argument to an R argument
+    std::string cppArgToRArg(const std::string& type,
+                             const std::string& cppArg);
+                                    
 } // namespace attributes
 } // namespace Rcpp
 

Modified: pkg/Rcpp/src/AttributesParser.cpp
===================================================================
--- pkg/Rcpp/src/AttributesParser.cpp	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/src/AttributesParser.cpp	2012-12-04 19:57:22 UTC (rev 4077)
@@ -646,8 +646,7 @@
             ostr << " for " << attribute << " attribute"; 
         ostr << " at " << file << ":" << lineNumber;
              
-        Rcpp::Function warning = Rcpp::Environment::base_env()["warning"];     
-        warning(ostr.str(), Rcpp::Named("call.") = false);
+        showWarning(ostr.str());
     }
     
     void SourceFileAttributesParser::attributeWarning(

Modified: pkg/Rcpp/src/AttributesUtil.h
===================================================================
--- pkg/Rcpp/src/AttributesUtil.h	2012-12-04 17:32:46 UTC (rev 4076)
+++ pkg/Rcpp/src/AttributesUtil.h	2012-12-04 19:57:22 UTC (rev 4077)
@@ -62,6 +62,12 @@
     // Strip balanced quotes from around a string (assumes already trimmed)
     void stripQuotes(std::string* pStr); 
     
+    // is the passed string quoted?
+    bool isQuoted(const std::string& str);
+    
+    // show a warning message
+    void showWarning(const std::string& msg);
+    
 } // namespace attributes
 } // namespace Rcpp
 



More information about the Rcpp-commits mailing list