<commit_before>/*
 * RSexp.cpp
 *
 * Copyright (C) 2009-12 by RStudio, Inc.
 *
 * Unless you have received this program directly from RStudio pursuant
 * to the terms of a commercial license agreement with RStudio, then
 * this program is licensed to you under the terms of version 3 of the
 * GNU Affero General Public License. This program is distributed WITHOUT
 * ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT,
 * MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the
 * AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details.
 *
 */

#define R_INTERNAL_FUNCTIONS
#include <r/RSexp.hpp>
#include <r/RInternal.hpp>

#include <algorithm>

#include <boost/bind.hpp>
#include <boost/function.hpp>
#include <boost/foreach.hpp>
#include <boost/numeric/conversion/cast.hpp>

#include <core/Macros.hpp>
#include <core/Log.hpp>
#include <core/DateTime.hpp>

#include <r/RExec.hpp>
#include <r/RErrorCategory.hpp>

// clean out global definitions of TRUE and FALSE so we can
// use the Rboolean variations of them
#undef TRUE
#undef FALSE

using namespace rstudio::core ;

namespace rstudio {
namespace r {
   
using namespace exec ;
   
namespace sexp {
   
std::string asString(SEXP object) 
{
    return std::string(Rf_translateChar(Rf_asChar(object)));
}
   
std::string safeAsString(SEXP object, const std::string& defValue)
{
   if (object != R_NilValue)
      return asString(object);
   else 
      return defValue;
}
    
int asInteger(SEXP object)
{
   return Rf_asInteger(object);
}
   
double asReal(SEXP object)
{
   return Rf_asReal(object);
}
   
bool asLogical(SEXP object)
{
   return Rf_asLogical(object) ? true : false;
}

bool fillVectorString(SEXP object, std::vector<std::string>* pVector)
{
   if (TYPEOF(object) != STRSXP)
      return false;
   
   int n = Rf_length(object);
   pVector->reserve(pVector->size() + n);
   for (int i = 0; i < n; i++)
      pVector->push_back(std::string(CHAR(STRING_ELT(object, i))));
   
   return true;
}

bool fillSetString(SEXP object, std::set<std::string>* pSet)
{
   if (TYPEOF(object) != STRSXP)
      return false;
   
   int n = Rf_length(object);
   for (int i = 0; i < n; i++)
      pSet->insert(std::string(CHAR(STRING_ELT(object, i))));
   
   return true;
}

std::vector<std::string> getLoadedNamespaces()
{
   std::vector<std::string> result;
   
   r::exec::RFunction loadedNamespaces("loadedNamespaces");
   Protect protect;
   SEXP resultSEXP;
   
   Error error = loadedNamespaces.call(&resultSEXP, &protect);
   IF_ERROR(error, return result);
   
   fillVectorString(resultSEXP, &result);
   return result;
}

SEXP findNamespace(const std::string& name)
{
   if (name.empty())
       return R_UnboundValue;
   
   // case 4071: namespace look up executes R code that can trip the debugger
   DisableDebugScope disableStepInto(R_GlobalEnv);

   return R_FindNamespace(Rf_mkString(name.c_str()));
}
   
void listEnvironment(SEXP env, 
                     bool includeAll,
                     Protect* pProtect,
                     std::vector<Variable>* pVariables)
{
   // reset passed vars
   pVariables->clear();
   
   // get the list of environment vars (protect locally because we 
   // we don't acutally return this list to the caller
   SEXP envVarsSEXP;
   Protect rProtect(envVarsSEXP = R_lsInternal(env, includeAll ? TRUE : FALSE));

   // get variables
   std::vector<std::string> vars;
   Error error = r::sexp::extract(envVarsSEXP, &vars);
   if (error)
   {
      LOG_ERROR(error);
      return;
   }

   // populate pVariables
   BOOST_FOREACH(const std::string& var, vars)
   {
      SEXP varSEXP = R_NilValue;
      // Merely calling Rf_findVar on an active binding will fire the binding.
      // Don't try to get the SEXP for the variable in this case; leave the
      // value as nil.
      if (!isActiveBinding(var, env))
         varSEXP = Rf_findVar(Rf_install(var.c_str()), env);

      if (varSEXP != R_UnboundValue) // should never be unbound
      {
         pProtect->add(varSEXP);
         pVariables->push_back(std::make_pair(var, varSEXP));
      }
      else
      {
         LOG_WARNING_MESSAGE(
                  "Unexpected R_UnboundValue returned from R_lsInternal");
      }
   }
}

bool isActiveBinding(const std::string& name, const SEXP env)
{
   return R_BindingIsActive(Rf_install(name.c_str()), env);
}

SEXP findVar(const std::string &name, const SEXP env)
{
   return Rf_findVar(Rf_install(name.c_str()), env);
}

SEXP findVar(const std::string& name, const std::string& ns)
{
   if (name.empty())
      return R_UnboundValue;
   
   SEXP env = ns.empty() ? R_GlobalEnv : findNamespace(ns);
   
   return findVar(name, env);
}
  
SEXP findFunction(const std::string& name, const std::string& ns) 
{
   if (name.empty())
      return R_UnboundValue;
   
   SEXP env = ns.empty() ? R_GlobalEnv : findNamespace(ns);
   
   SEXP functionSEXP;
   Error error = executeSafely<SEXP>(
      boost::bind(Rf_findFun, Rf_install(name.c_str()), env), 
      &functionSEXP
   );
   
   if (error)
      return R_UnboundValue;
   else
      return functionSEXP ;
}   
   
std::string typeAsString(SEXP object)
{
   return Rf_type2char(TYPEOF(object));  
}

std::string classOf(SEXP objectSEXP)
{
   return asString(Rf_getAttrib(objectSEXP, Rf_install("class")));
}
   
int length(SEXP object)
{<commit_msg>safer implementations of findNamespace, findFun<commit_after>/*
 * RSexp.cpp
 *
 * Copyright (C) 2009-12 by RStudio, Inc.
 *
 * Unless you have received this program directly from RStudio pursuant
 * to the terms of a commercial license agreement with RStudio, then
 * this program is licensed to you under the terms of version 3 of the
 * GNU Affero General Public License. This program is distributed WITHOUT
 * ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT,
 * MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the
 * AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details.
 *
 */

#define R_INTERNAL_FUNCTIONS
#include <r/RSexp.hpp>
#include <r/RInternal.hpp>

#include <algorithm>

#include <boost/bind.hpp>
#include <boost/function.hpp>
#include <boost/foreach.hpp>
#include <boost/numeric/conversion/cast.hpp>
#include <boost/container/flat_set.hpp>

#include <core/Macros.hpp>
#include <core/Log.hpp>
#include <core/DateTime.hpp>

#include <r/RExec.hpp>
#include <r/RErrorCategory.hpp>

// clean out global definitions of TRUE and FALSE so we can
// use the Rboolean variations of them
#undef TRUE
#undef FALSE

using namespace rstudio::core ;

namespace rstudio {
namespace r {
   
using namespace exec ;
   
namespace sexp {
   
std::string asString(SEXP object) 
{
    return std::string(Rf_translateChar(Rf_asChar(object)));
}
   
std::string safeAsString(SEXP object, const std::string& defValue)
{
   if (object != R_NilValue)
      return asString(object);
   else 
      return defValue;
}
    
int asInteger(SEXP object)
{
   return Rf_asInteger(object);
}
   
double asReal(SEXP object)
{
   return Rf_asReal(object);
}
   
bool asLogical(SEXP object)
{
   return Rf_asLogical(object) ? true : false;
}

bool fillVectorString(SEXP object, std::vector<std::string>* pVector)
{
   if (TYPEOF(object) != STRSXP)
      return false;
   
   int n = Rf_length(object);
   pVector->reserve(pVector->size() + n);
   for (int i = 0; i < n; i++)
      pVector->push_back(std::string(CHAR(STRING_ELT(object, i))));
   
   return true;
}

bool fillSetString(SEXP object, std::set<std::string>* pSet)
{
   if (TYPEOF(object) != STRSXP)
      return false;
   
   int n = Rf_length(object);
   for (int i = 0; i < n; i++)
      pSet->insert(std::string(CHAR(STRING_ELT(object, i))));
   
   return true;
}

std::vector<std::string> getLoadedNamespaces()
{
   std::vector<std::string> result;
   
   r::exec::RFunction loadedNamespaces("loadedNamespaces");
   Protect protect;
   SEXP resultSEXP;
   
   Error error = loadedNamespaces.call(&resultSEXP, &protect);
   IF_ERROR(error, return result);
   
   fillVectorString(resultSEXP, &result);
   return result;
}

SEXP findNamespace(const std::string& name)
{
   if (name.empty())
       return R_UnboundValue;
   
   // case 4071: namespace look up executes R code that can trip the debugger
   DisableDebugScope disableStepInto(R_GlobalEnv);

   // R_FindNamespace will throw if it fails to find a particular name.
   // Instead, we manually search the namespace registry.
   r::sexp::Protect protect;
   SEXP nameSEXP;
   protect.add(nameSEXP = Rf_install(name.c_str()));
   
   SEXP ns = Rf_findVarInFrame(R_NamespaceRegistry, nameSEXP);
   if (ns == R_UnboundValue)
      return R_EmptyEnv;
   
   return ns;
}
   
void listEnvironment(SEXP env, 
                     bool includeAll,
                     Protect* pProtect,
                     std::vector<Variable>* pVariables)
{
   // reset passed vars
   pVariables->clear();
   
   // get the list of environment vars (protect locally because we 
   // we don't acutally return this list to the caller
   SEXP envVarsSEXP;
   Protect rProtect(envVarsSEXP = R_lsInternal(env, includeAll ? TRUE : FALSE));

   // get variables
   std::vector<std::string> vars;
   Error error = r::sexp::extract(envVarsSEXP, &vars);
   if (error)
   {
      LOG_ERROR(error);
      return;
   }

   // populate pVariables
   BOOST_FOREACH(const std::string& var, vars)
   {
      SEXP varSEXP = R_NilValue;
      // Merely calling Rf_findVar on an active binding will fire the binding.
      // Don't try to get the SEXP for the variable in this case; leave the
      // value as nil.
      if (!isActiveBinding(var, env))
         varSEXP = Rf_findVar(Rf_install(var.c_str()), env);

      if (varSEXP != R_UnboundValue) // should never be unbound
      {
         pProtect->add(varSEXP);
         pVariables->push_back(std::make_pair(var, varSEXP));
      }
      else
      {
         LOG_WARNING_MESSAGE(
                  "Unexpected R_UnboundValue returned from R_lsInternal");
      }
   }
}

bool isActiveBinding(const std::string& name, const SEXP env)
{
   return R_BindingIsActive(Rf_install(name.c_str()), env);
}

SEXP findVar(const std::string &name, const SEXP env)
{
   return Rf_findVar(Rf_install(name.c_str()), env);
}

SEXP findVar(const std::string& name, const std::string& ns)
{
   if (name.empty())
      return R_UnboundValue;
   
   SEXP env = ns.empty() ? R_GlobalEnv : findNamespace(ns);
   
   return findVar(name, env);
}

SEXP getPromiseValue(SEXP promSEXP, SEXP envir, Protect* pProtect)
{
   if (PRVALUE(promSEXP) == R_UnboundValue)
   {
      SEXP evaledSEXP = Rf_eval(promSEXP, envir);
      pProtect->add(evaledSEXP);
      return evaledSEXP;
   }
   else
      return PRVALUE(promSEXP);
}
  
SEXP findFunction(const std::string& name, const std::string& ns) 
{
   r::sexp::Protect protect;
   if (name.empty())
      return R_UnboundValue;
   
   SEXP env = ns.empty() ? R_GlobalEnv : findNamespace(ns);
   if (env == R_UnboundValue) return R_UnboundValue;
   
   // We might want to use `Rf_findFun`, but it calls `Rf_error` on failure.
   // We instead attempt to find the function by manually
   // walking through the environment (and its enclosing environments)
   SEXP nameSEXP;
   protect.add(nameSEXP = Rf_install(name.c_str()));
   
   // Search through frames until we find the global environment.
   // Keep track of what's been visited, to avoid cycles.
   boost::container::flat_set<SEXP> visitedEnvironments;
   while (env != R_EmptyEnv)
   {
      if (visitedEnvironments.count(env)) break;
      visitedEnvironments.insert(env);
      
      SEXP resultSEXP = Rf_findVarInFrame(env, nameSEXP);
      if (resultSEXP != R_UnboundValue)
      {
         if (Rf_isFunction(resultSEXP))
            return resultSEXP;
         else if (TYPEOF(resultSEXP) == PROMSXP)
         {
            SEXP prValueSEXP = getPromiseValue(resultSEXP, env, &protect);
            if (Rf_isFunction(prValueSEXP))
               return prValueSEXP;
         }
      }
      
      env = ENCLOS(env);
   }
   
   return R_UnboundValue;
}   
   
std::string typeAsString(SEXP object)
{
   return Rf_type2char(TYPEOF(object));  
}

std::string classOf(SEXP objectSEXP)
{
   return asString(Rf_getAttrib(objectSEXP, Rf_install("class")));
}
   
int length(SEXP object)
{
{'fraction_non_alphanumeric': 0.11315084071155877, 'fraction_numerical': 0.0025993014377386076, 'mean_word_length': 3.251381215469613, 'pattern_counts': {'":': 0, '<': 46, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '309817', 'n_tokens_mistral': 4252, 'n_tokens_neox': 4079, 'n_words': 1070}