growable-api.patch

Index: src/include/Internal.h
===================================================================
--- src/include/Internal.h	(revision 88869)
+++ src/include/Internal.h	(working copy)
@@ -545,6 +545,13 @@
 SEXP do_retracemem(SEXP, SEXP, SEXP, SEXP);
 SEXP do_untracemem(SEXP, SEXP, SEXP, SEXP);
 
+SEXP do_growvec_alloc(SEXP, SEXP, SEXP, SEXP);
+SEXP do_growvec_max_size(SEXP, SEXP, SEXP, SEXP);
+SEXP do_growvec_resize(SEXP, SEXP, SEXP, SEXP);
+SEXP do_growvec_is_growable(SEXP, SEXP, SEXP, SEXP);
+SEXP do_growvec_make_growable(SEXP, SEXP, SEXP, SEXP);
+SEXP do_growvec_trim(SEXP, SEXP, SEXP, SEXP);
+
 /* ALTREP-related */
 
 SEXP do_sorted_fpass(SEXP, SEXP, SEXP, SEXP);
Index: src/include/Makefile.in
===================================================================
--- src/include/Makefile.in	(revision 88869)
+++ src/include/Makefile.in	(working copy)
@@ -13,7 +13,7 @@
 distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
 
 ## API(1): for .C() and .Call() writers _or_ for alternative front ends.
-SRC_HEADERS = R.h Rdefines.h Rembedded.h Rinternals.h Rinterface.h
+SRC_HEADERS = R.h Rdefines.h Rembedded.h Rinternals.h Rinterface.h Rgrowable.h
 ## API(2) {these are built, system-dependently}:
 OBJ_HEADERS = Rconfig.h Rmath.h Rversion.h
 ## Non-API internal ones:
Index: src/include/Rgrowable.h
===================================================================
--- src/include/Rgrowable.h	(nonexistent)
+++ src/include/Rgrowable.h	(working copy)
@@ -0,0 +1,14 @@
+#ifndef R_GROWABLE_H_
+#define R_GROWABLE_H_
+
+#include <Rinternals.h>
+
+/* Minimal internal API for growable vectors. */
+SEXP      growable_allocate(SEXPTYPE type, R_xlen_t size, R_xlen_t max_size);
+R_xlen_t  growable_capacity(SEXP x);
+void      growable_resize(SEXP x, R_xlen_t newsize);
+Rboolean  is_growable(SEXP x);
+SEXP      make_growable(SEXP x);
+SEXP      growable_trim(SEXP x);
+
+#endif

Index: src/main/Makefile.in
===================================================================
--- src/main/Makefile.in	(revision 88869)
+++ src/main/Makefile.in	(working copy)
@@ -23,7 +23,7 @@
 	dotcode.c dounzip.c dstruct.c duplicate.c \
 	edit.c engine.c envir.c errors.c eval.c \
 	flexiblas.c format.c \
-	gevents.c gram.c gram-ex.c graphics.c grep.c \
+	gevents.c gram.c gram-ex.c graphics.c grep.c growable.c \
 	identical.c inlined.c inspect.c internet.c iosupport.c \
 	lapack.c list.c localecharset.c logic.c \
 	machine.c main.c mapply.c mask.c match.c memory.c \
Index: src/main/growable.c
===================================================================
--- src/main/growable.c	(nonexistent)
+++ src/main/growable.c	(working copy)
@@ -0,0 +1,147 @@
+#include <R.h>
+#include <Rinternals.h>
+#include <string.h>
+#include <Rgrowable.h>
+
+static SEXP ensure_materialized(SEXP x) {
+    if (!ALTREP(x)) return x;
+    if (!isVector(x))
+        Rf_error("make_growable: not a vector");
+
+    SEXPTYPE t = TYPEOF(x);
+    R_xlen_t len = XLENGTH(x);
+    SEXP y = PROTECT(Rf_allocVector(t, len));
+    SETLENGTH(y, len);
+    SET_TRUELENGTH(y, len);
+    SET_GROWABLE_BIT(y);
+    /* Copy using safe element accessors */
+    switch (t) {
+        case LGLSXP: 
+        case INTSXP: {
+            int *yp = INTEGER(y);
+            for (R_xlen_t i = 0; i < len; ++i) yp[i] = INTEGER_ELT(x, i);
+            break;
+        }
+        case REALSXP: {
+            double *yp = REAL(y);
+            for (R_xlen_t i = 0; i < len; ++i) yp[i] = REAL_ELT(x, i);
+            break;
+        }
+        case CPLXSXP: {
+            Rcomplex *yp = COMPLEX(y);
+            for (R_xlen_t i = 0; i < len; ++i) yp[i] = COMPLEX_ELT(x, i);
+            break;
+        }
+        case RAWSXP: {
+            Rbyte *yp = RAW(y);
+            for (R_xlen_t i = 0; i < len; ++i) yp[i] = RAW_ELT(x, i);
+            break;
+        }
+        case STRSXP: {
+            for (R_xlen_t i = 0; i < len; ++i) SET_STRING_ELT(y, i, STRING_ELT(x, i));
+            break;
+        }
+        case VECSXP: 
+        case EXPRSXP: {
+            for (R_xlen_t i = 0; i < len; ++i) SET_VECTOR_ELT(y, i, VECTOR_ELT(x, i));
+            break;
+        }
+        default:
+            Rf_error("make_growable: unsupported type %d", (int)t);
+    }
+    DUPLICATE_ATTRIB(y, x);
+    UNPROTECT(1);
+    return y;
+}
+
+SEXP growable_allocate(SEXPTYPE type, R_xlen_t size, R_xlen_t max_size) {
+    if (!(type == LGLSXP || type == INTSXP || type == REALSXP || type == CPLXSXP || type == STRSXP || type == RAWSXP || type == VECSXP))
+        Rf_error("growable_allocate: unsupported type %d", (int)type);
+    if (size < 0 || max_size < 0)
+        Rf_error("growable_allocate: negative size/capacity");
+    if (size > max_size)
+        Rf_error("growable_allocate: size (%lld) > max_size (%lld)",
+                 (long long)size, (long long)max_size);
+
+    SEXP ret = PROTECT(Rf_allocVector(type, max_size));
+    SET_TRUELENGTH(ret, max_size);
+    SET_GROWABLE_BIT(ret);
+    SETLENGTH(ret, size);
+    UNPROTECT(1);
+    return ret;
+}
+
+R_xlen_t growable_capacity(SEXP x) {
+    return TRUELENGTH(x);
+}
+
+void growable_resize(SEXP x, R_xlen_t newsize) {
+    if (!isVector(x))
+        Rf_error("growable_resize: 'x' must be a vector");
+    if (newsize < 0)
+        Rf_error("growable_resize: negative size");
+    if (ALTREP(x))
+        Rf_error("growable_resize: ALTREP must be materialized first (use make_growable())");
+
+    R_xlen_t cap = TRUELENGTH(x);
+    if (newsize > cap) {
+        Rf_error("growable_resize: newsize (%lld) > max_size (%lld)",
+                 (long long)newsize, (long long)cap);
+    }
+
+    R_xlen_t oldsize = XLENGTH(x);
+    // remove potential stale pointers
+    if (newsize < oldsize) {
+        SEXPTYPE type = TYPEOF(x);
+        if (type == VECSXP || type == EXPRSXP) {
+            for (R_xlen_t i = newsize; i < oldsize; i++) {
+                SET_VECTOR_ELT(x, i, R_NilValue);
+            }
+        } else if (type == STRSXP) {
+            for (R_xlen_t i = newsize; i < oldsize; i++) {
+                SET_STRING_ELT(x, i, NA_STRING);
+            }
+        }
+    }
+
+    SETLENGTH(x, newsize);
+}
+
+Rboolean is_growable(SEXP x) {
+    if (!isVector(x)) return FALSE;
+    if (ALTREP(x)) return FALSE;  // conservative, could be supported
+    if (TRUELENGTH(x) < XLENGTH(x)) return FALSE;
+    if (!IS_GROWABLE(x)) return FALSE;
+    return TRUE;
+}
+
+SEXP make_growable(SEXP x) {
+    if (!isVector(x))
+        Rf_error("make_growable: not a vector");
+    if (ALTREP(x)) {
+        return ensure_materialized(x);
+    }
+    if (TRUELENGTH(x) < XLENGTH(x)) {
+        SET_TRUELENGTH(x, XLENGTH(x));
+    }
+    SET_GROWABLE_BIT(x);
+    return x;
+}
+
+SEXP growable_trim(SEXP x) {
+    R_xlen_t len = XLENGTH(x);
+    R_xlen_t max_len = TRUELENGTH(x);
+    if (len == max_len) {
+        return x;
+    }
+
+    if (!is_growable(x)) {
+        Rf_error("growable_trim: object is not growable");
+    }
+
+    growable_resize(x, max_len); // set length to max_len to force reallocation
+    SEXP ans = PROTECT(Rf_xlengthgets(x, len));
+    SETLENGTH(x, len);
+    UNPROTECT(1);
+    return ans;
+}

Index: src/main/names.c
===================================================================
--- src/main/names.c	(revision 88869)
+++ src/main/names.c	(working copy)
@@ -230,6 +230,12 @@
 /* .Internals */
 
 {"vector",	do_makevector,	0,	11,	2,	{PP_FUNCALL, PREC_FN,	0}},
+{"growvec_alloc", do_growvec_alloc, 0,	11,	3,	{PP_FUNCALL, PREC_FN,	0}},
+{"growvec_max_size", do_growvec_max_size, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
+{"growvec_resize", do_growvec_resize, 0, 11, 2, {PP_FUNCALL, PREC_FN, 0}},
+{"growvec_is_growable", do_growvec_is_growable, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
+{"growvec_make_growable", do_growvec_make_growable, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
+{"growvec_trim", do_growvec_trim, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
 {"complex",	do_complex,	0,	11,	3,	{PP_FUNCALL, PREC_FN,	0}},
 {"matrix",	do_matrix,	0,	11,	7,	{PP_FUNCALL, PREC_FN,	0}},
 {"array",	do_array,	0,	11,	3,	{PP_FUNCALL, PREC_FN,	0}},
@@ -1451,3 +1457,50 @@
 {
     return PRIMNAME(object);
 }
+
+/* Growable vector wrapper functions */
+extern SEXP growable_allocate(SEXPTYPE, R_xlen_t, R_xlen_t);
+extern R_xlen_t growable_capacity(SEXP);
+extern void growable_resize(SEXP, R_xlen_t);
+extern Rboolean is_growable(SEXP);
+extern SEXP make_growable(SEXP);
+extern SEXP growable_trim(SEXP);
+
+SEXP do_growvec_alloc(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP typeS = CAR(args); args = CDR(args);
+    SEXP sizeS = CAR(args); args = CDR(args);
+    SEXP capS  = CAR(args);
+    return growable_allocate(asInteger(typeS),
+                             (R_xlen_t)asReal(sizeS),
+                             (R_xlen_t)asReal(capS));
+}
+
+SEXP do_growvec_max_size(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP x = CAR(args);
+    R_xlen_t max_size = growable_capacity(x);
+    return ScalarReal((double)max_size);
+}
+
+SEXP do_growvec_resize(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP x = CAR(args); args = CDR(args);
+    SEXP newsizeS = CAR(args);
+    growable_resize(x, (R_xlen_t)asReal(newsizeS));
+    return R_NilValue;
+}
+
+SEXP do_growvec_is_growable(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP x = CAR(args);
+    Rboolean result = is_growable(x);
+    return ScalarLogical(result);
+}
+
+SEXP do_growvec_make_growable(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP x = CAR(args);
+    return make_growable(x);
+}
+
+SEXP do_growvec_trim(SEXP call, SEXP op, SEXP args, SEXP env) {
+    SEXP x = CAR(args);
+    SEXP result = growable_trim(x);
+    return result;
+}