use 'lgrow' helper for growing langsxps

Author: kevinushey

ChangeLog

@@ -1,3 +1,11 @@
+2025-06-02  Kevin Ushey  <[email protected]>
+
+	* inst/include/Rcpp.h: Avoid copy when creating Language objects
+	* inst/include/Rcpp/Language.h: Idem
+	* inst/tinytest/cpp/language.cpp: Idem
+	* inst/tinytest/test_language.R: Idem
+	* inst/include/Rcpp/lgrow.h: Idem
+
 2025-05-27  Dirk Eddelbuettel  <[email protected]>
 
 	* DESCRIPTION (Version, Date): Roll micro version and date

inst/include/Rcpp.h

@@ -32,6 +32,7 @@
 #include <Rcpp/Reference.h>
 #include <Rcpp/clone.h>
 #include <Rcpp/grow.h>
+#include <Rcpp/lgrow.h>
 #include <Rcpp/Dimension.h>
 
 #include <Rcpp/Symbol.h>

inst/include/Rcpp/Language.h

@@ -104,12 +104,12 @@ namespace Rcpp{
          */
         template <typename... T>
         Language_Impl(const std::string& symbol, const T&... t) {
-            Storage::set__(pairlist(Rf_install(symbol.c_str()), t...) );
+            Storage::set__(langlist(Rf_install(symbol.c_str()), t...) );
         }
 
         template <typename... T>
         Language_Impl(const Function& function, const T&... t) {
-            Storage::set__(pairlist(function, t...));
+            Storage::set__(langlist(function, t...));
         }
 
         /**

inst/include/Rcpp/lgrow.h

@@ -0,0 +1,77 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// lgrow.h: Rcpp R/C++ interface class library -- grow a (LANGSXP) pairlist
+//
+// Copyright (C) 2010 - 2025 Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_lgrow_h
+#define Rcpp_lgrow_h
+
+#include <RcppCommon.h>
+#include <Rcpp/Named.h>
+
+namespace Rcpp {
+
+inline SEXP lgrow(SEXP head, SEXP tail) {
+    return LCONS(head, tail);
+}
+
+namespace internal {
+
+// for Named objects
+template <typename T>
+inline SEXP lgrow__dispatch(Rcpp::traits::true_type, const T& head, SEXP tail) {
+    Shield<SEXP> y(wrap(head.object));
+    Shield<SEXP> x(Rf_lcons(y, tail));
+    SEXP headNameSym = Rf_install(head.name.c_str());
+    SET_TAG(x, headNameSym);
+    return x;
+}
+
+// for all other objects
+template <typename T>
+inline SEXP lgrow__dispatch(Rcpp::traits::false_type, const T& head, SEXP tail) {
+    return lgrow(wrap(head), tail);
+}
+
+} // internal
+
+template <typename T>
+SEXP lgrow(const T& head, SEXP tail) {
+    Shield<SEXP> y(tail);
+    return internal::lgrow__dispatch(typename traits::is_named<T>::type(), head, y);
+}
+
+inline SEXP lgrow(const char* head, SEXP tail) {
+    Shield<SEXP> y(tail);
+    return lgrow(Rf_mkString(head), y);
+}
+
+template <typename T1>
+SEXP langlist(const T1& t1) {
+    return lgrow(t1, R_NilValue);
+}
+
+template <typename T, typename... TArgs>
+SEXP langlist(const T& t1, const TArgs&... args) {
+    return lgrow(t1, langlist(args...));
+}
+
+} // namespace Rcpp
+
+#endif

inst/tinytest/cpp/language.cpp

@@ -272,3 +272,10 @@ Formula runit_formula_SEXP(SEXP form){
     return f;
 }
 
+// [[Rcpp::export]]
+SEXP runit_language_modify(Function f) {
+    auto v = NumericVector::create(0.0, 1.0);
+    Rcpp::Language call(f, v);
+    v[0] = 999.0;
+    return CADR(call);
+}

inst/tinytest/test_language.R

@@ -139,3 +139,5 @@ expect_equal( runit_formula_SEXP( "x ~ y + z" ), x ~ y + z, info = "Formula( SEX
 expect_equal( runit_formula_SEXP( parse( text = "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = EXPRSXP )" )
 expect_equal( runit_formula_SEXP( list( "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = STRSXP) )" )
 expect_equal( runit_formula_SEXP( list( x ~ y + z) ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = formula) )" )
+
+expect_equal( runit_language_modify(sum), c(999, 1), info = "Language objects don't duplicate their arguments" )