ALTREP now supports \code{VECSXP} vectors.

Contributed by Gabor Csardi in PR17620.


git-svn-id: https://svn.r-project.org/R/trunk@83914 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: luke

Diff for: doc/NEWS.Rd

@@ -424,6 +424,9 @@
 
       \item New macro \code{CAD5R()} is provided in \file{Rinternals.h}
       and used in a few places in the \R sources.
+
+      \item ALTREP now supports \code{VECSXP} vectors. Contributed by
+      Gabor Csardi in \PR{17620}.
     }
   }
 

Diff for: src/include/Defn.h

@@ -404,7 +404,6 @@ typedef union { VECTOR_SEXPREC s; double align; } SEXPREC_ALIGN;
 #define RAW(x)		((Rbyte *) DATAPTR(x))
 #define COMPLEX(x)	((Rcomplex *) DATAPTR(x))
 #define REAL(x)		((double *) DATAPTR(x))
-#define VECTOR_ELT(x,i)	((SEXP *) DATAPTR(x))[i]
 #define STRING_PTR(x)	((SEXP *) DATAPTR(x))
 #define VECTOR_PTR(x)	((SEXP *) DATAPTR(x))
 #define LOGICAL_RO(x)	((const int *) DATAPTR_RO(x))
@@ -678,6 +677,8 @@ Rcomplex ALTCOMPLEX_ELT(SEXP x, R_xlen_t i);
 void ALTCOMPLEX_SET_ELT(SEXP x, R_xlen_t i, Rcomplex v);
 Rbyte ALTRAW_ELT(SEXP x, R_xlen_t i);
 void ALTRAW_SET_ELT(SEXP x, R_xlen_t i, Rbyte v);
+SEXP ALTLIST_ELT(SEXP, R_xlen_t);
+void ALTLIST_SET_ELT(SEXP, R_xlen_t, SEXP);
 
 /* invoking ALTREP class methods */
 SEXP ALTINTEGER_SUM(SEXP x, Rboolean narm);

Diff for: src/include/R_ext/Altrep.h

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2016  The R Core Team.
+ *  Copyright (C) 2016-2023  The R Core Team.
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU Lesser General Public License as published by
@@ -50,6 +50,8 @@ R_altrep_class_t
 R_make_altraw_class(const char *cname, const char *pname, DllInfo *info);
 R_altrep_class_t
 R_make_altcomplex_class(const char *cname, const char *pname, DllInfo *info);
+R_altrep_class_t
+R_make_altlist_class(const char *cname, const char *pname, DllInfo *info);
 
 Rboolean R_altrep_inherits(SEXP x, R_altrep_class_t);
 
@@ -105,6 +107,9 @@ typedef void (*R_altstring_Set_elt_method_t)(SEXP, R_xlen_t, SEXP);
 typedef int (*R_altstring_Is_sorted_method_t)(SEXP);
 typedef int (*R_altstring_No_NA_method_t)(SEXP);
 
+typedef SEXP (*R_altlist_Elt_method_t)(SEXP, R_xlen_t);
+typedef void (*R_altlist_Set_elt_method_t)(SEXP, R_xlen_t, SEXP);
+
 #define DECLARE_METHOD_SETTER(CNAME, MNAME)				\
     void								\
     R_set_##CNAME##_##MNAME##_method(R_altrep_class_t cls,		\
@@ -156,6 +161,9 @@ DECLARE_METHOD_SETTER(altstring, Set_elt)
 DECLARE_METHOD_SETTER(altstring, Is_sorted)
 DECLARE_METHOD_SETTER(altstring, No_NA)
 
+DECLARE_METHOD_SETTER(altlist, Elt)
+DECLARE_METHOD_SETTER(altlist, Set_elt)
+
 #ifdef  __cplusplus
 }
 #endif

Diff for: src/main/altclasses.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2016--2021   The R Core Team
+ *  Copyright (C) 2016--2023   The R Core Team
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
@@ -1418,6 +1418,7 @@ static R_altrep_class_t wrap_real_class;
 static R_altrep_class_t wrap_complex_class;
 static R_altrep_class_t wrap_raw_class;
 static R_altrep_class_t wrap_string_class;
+static R_altrep_class_t wrap_list_class;
 
 /* Wrapper objects are ALTREP objects designed to hold the attributes
    of a potentially large object and/or meta data for the object. */
@@ -1711,6 +1712,20 @@ static int wrapper_string_no_NA(SEXP x)
 }
 
 
+/*
+ * ALTLIST Methods
+ */
+
+static SEXP wrapper_list_Elt(SEXP x, R_xlen_t i)
+{
+    return VECTOR_ELT(WRAPPER_WRAPPED(x), i);
+}
+
+static void wrapper_list_Set_elt(SEXP x, R_xlen_t i, SEXP v)
+{
+    SET_VECTOR_ELT(WRAPPER_WRAPPED_RW(x), i, v);
+}
+
 /*
  * Class Objects and Method Tables
  */
@@ -1863,6 +1878,24 @@ static void InitWrapStringClass(DllInfo *dll)
     R_set_altstring_No_NA_method(cls, wrapper_string_no_NA);
 }
 
+static void InitWrapListClass(DllInfo *dll)
+{
+    R_altrep_class_t cls =
+	R_make_altlist_class("wrap_list", WRAPPKG, dll);
+    wrap_list_class = cls;
+
+    /* override ALTREP methods */
+    R_set_altrep_Unserialize_method(cls, wrapper_Unserialize);
+    R_set_altrep_Serialized_state_method(cls, wrapper_Serialized_state);
+    R_set_altrep_Duplicate_method(cls, wrapper_Duplicate);
+    R_set_altrep_Inspect_method(cls, wrapper_Inspect);
+    R_set_altrep_Length_method(cls, wrapper_Length);
+
+    /* override ALTLIST methods */
+    R_set_altlist_Elt_method(cls, wrapper_list_Elt);
+    R_set_altlist_Set_elt_method(cls, wrapper_list_Set_elt);
+}
+
 
 /*
  * Constructor
@@ -1879,6 +1912,7 @@ static SEXP make_wrapper(SEXP x, SEXP meta)
     case CPLXSXP: cls = wrap_complex_class; break;
     case RAWSXP: cls = wrap_raw_class; break;
     case STRSXP: cls = wrap_string_class; break;
+    case VECSXP: cls = wrap_list_class; break;
     default: error("unsupported type");
     }
 
@@ -1915,6 +1949,7 @@ static R_INLINE int is_wrapper(SEXP x)
 	case CPLXSXP: return R_altrep_inherits(x, wrap_complex_class);
 	case RAWSXP: return R_altrep_inherits(x, wrap_raw_class);
 	case STRSXP: return R_altrep_inherits(x, wrap_string_class);
+	case VECSXP: return R_altrep_inherits(x, wrap_list_class);
 	default: return FALSE;
 	}
     else return FALSE;
@@ -2039,4 +2074,5 @@ attribute_hidden void R_init_altrep(void)
     InitWrapComplexClass(NULL);
     InitWrapRawClass(NULL);
     InitWrapStringClass(NULL);
+    InitWrapListClass(NULL);
 }

Diff for: src/main/altrep.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 2016--2017   The R Core Team
+ *  Copyright (C) 2016--2023   The R Core Team
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
@@ -134,6 +134,7 @@ static void SET_ALTREP_CLASS(SEXP x, SEXP class)
 #define ALTRAW_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altraw)
 #define ALTCOMPLEX_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altcomplex)
 #define ALTSTRING_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altstring)
+#define ALTLIST_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altlist)
 
 #define ALTREP_METHODS						\
     R_altrep_UnserializeEX_method_t UnserializeEX;		\
@@ -196,6 +197,11 @@ static void SET_ALTREP_CLASS(SEXP x, SEXP class)
     R_altstring_Is_sorted_method_t Is_sorted;	\
     R_altstring_No_NA_method_t No_NA
 
+#define ALTLIST_METHODS                         \
+    ALTVEC_METHODS;                             \
+    R_altlist_Elt_method_t Elt;                 \
+    R_altlist_Set_elt_method_t Set_elt
+
 typedef struct { ALTREP_METHODS; } altrep_methods_t;
 typedef struct { ALTVEC_METHODS; } altvec_methods_t;
 typedef struct { ALTINTEGER_METHODS; } altinteger_methods_t;
@@ -204,6 +210,7 @@ typedef struct { ALTLOGICAL_METHODS; } altlogical_methods_t;
 typedef struct { ALTRAW_METHODS; } altraw_methods_t;
 typedef struct { ALTCOMPLEX_METHODS; } altcomplex_methods_t;
 typedef struct { ALTSTRING_METHODS; } altstring_methods_t;
+typedef struct { ALTLIST_METHODS; } altlist_methods_t;
 
 /* Macro to extract first element from ... macro argument.
    From Richard Hansen's answer in
@@ -223,6 +230,7 @@ typedef struct { ALTSTRING_METHODS; } altstring_methods_t;
 #define ALTRAW_DISPATCH(fun, ...) DO_DISPATCH(ALTRAW, fun, __VA_ARGS__)
 #define ALTCOMPLEX_DISPATCH(fun, ...) DO_DISPATCH(ALTCOMPLEX, fun, __VA_ARGS__)
 #define ALTSTRING_DISPATCH(fun, ...) DO_DISPATCH(ALTSTRING, fun, __VA_ARGS__)
+#define ALTLIST_DISPATCH(fun, ...) DO_DISPATCH(ALTLIST, fun, __VA_ARGS__)
 
 
 /*
@@ -541,6 +549,37 @@ int STRING_NO_NA(SEXP x)
     return ALTREP(x) ? ALTSTRING_DISPATCH(No_NA, x) : 0;
 }
 
+SEXP /*attribute_hidden*/ ALTLIST_ELT(SEXP x, R_xlen_t i)
+{
+    SEXP val = NULL;
+
+    /**** move GC disabling into method? */
+    if (R_in_gc)
+	error("cannot get ALTLIST_ELT during GC");
+    R_CHECK_THREAD;
+    int enabled = R_GCEnabled;
+    R_GCEnabled = FALSE;
+
+    val = ALTLIST_DISPATCH(Elt, x, i);
+
+    R_GCEnabled = enabled;
+    return val;
+}
+
+void attribute_hidden ALTLIST_SET_ELT(SEXP x, R_xlen_t i, SEXP v)
+{
+    /**** move GC disabling into method? */
+    if (R_in_gc)
+	error("cannot set ALTLIST_ELT during GC");
+    R_CHECK_THREAD;
+    int enabled = R_GCEnabled;
+    R_GCEnabled = FALSE;
+
+    ALTLIST_DISPATCH(Set_elt, x, i, v);
+
+    R_GCEnabled = enabled;
+}
+
 SEXP ALTINTEGER_SUM(SEXP x, Rboolean narm)
 {
     return ALTINTEGER_DISPATCH(Sum, x, narm);
@@ -801,6 +840,25 @@ static void altstring_Set_elt_default(SEXP x, R_xlen_t i, SEXP v)
 static int altstring_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }
 static int altstring_No_NA_default(SEXP x) { return 0; }
 
+static SEXP altlist_Elt_default(SEXP x, R_xlen_t i)
+{
+    error("ALTLIST classes must provide an Elt method");
+}
+
+static void altlist_Set_elt_default(SEXP x, R_xlen_t i, SEXP v)
+{
+    error("ALTLIST classes must provide a Set_elt method");
+}
+
+static void *altlist_Dataptr_default(SEXP x, Rboolean writeable)
+{
+    error("ALTLIST classes do not have a Dataptr method");
+}
+
+static const void *altlist_Dataptr_or_null_default(SEXP x)
+{
+    error("ALTLIST classes do not have a Dataptr_or_null method");
+}
 
 /**
  ** ALTREP Initial Method Tables
@@ -925,6 +983,24 @@ static altstring_methods_t altstring_default_methods = {
 };
 
 
+
+static altlist_methods_t altlist_default_methods = {
+    .UnserializeEX = altrep_UnserializeEX_default,
+    .Unserialize = altrep_Unserialize_default,
+    .Serialized_state = altrep_Serialized_state_default,
+    .DuplicateEX = altrep_DuplicateEX_default,
+    .Duplicate = altrep_Duplicate_default,
+    .Coerce = altrep_Coerce_default,
+    .Inspect = altrep_Inspect_default,
+    .Length = altrep_Length_default,
+    .Dataptr = altlist_Dataptr_default,
+    .Dataptr_or_null = altlist_Dataptr_or_null_default,
+    .Extract_subset = altvec_Extract_subset_default,
+    .Elt = altlist_Elt_default,
+    .Set_elt = altlist_Set_elt_default
+};
+
+
 /**
  ** Class Constructors
  **/
@@ -958,6 +1034,7 @@ make_altrep_class(int type, const char *cname, const char *pname, DllInfo *dll)
     case RAWSXP:  MAKE_CLASS(class, altraw);     break;
     case CPLXSXP: MAKE_CLASS(class, altcomplex); break;
     case STRSXP:  MAKE_CLASS(class, altstring);  break;
+    case VECSXP:  MAKE_CLASS(class, altlist);    break;
     default: error("unsupported ALTREP class");
     }
     RegisterClass(class, type, cname, pname, dll);
@@ -976,6 +1053,7 @@ make_altrep_class(int type, const char *cname, const char *pname, DllInfo *dll)
     }
 
 DEFINE_CLASS_CONSTRUCTOR(altstring, STRSXP)
+DEFINE_CLASS_CONSTRUCTOR(altlist, VECSXP)
 DEFINE_CLASS_CONSTRUCTOR(altinteger, INTSXP)
 DEFINE_CLASS_CONSTRUCTOR(altreal, REALSXP)
 DEFINE_CLASS_CONSTRUCTOR(altlogical, LGLSXP)
@@ -991,6 +1069,7 @@ static void reinit_altrep_class(SEXP class)
     case LGLSXP: INIT_CLASS(class, altlogical); break;
     case RAWSXP: INIT_CLASS(class, altraw); break;
     case CPLXSXP: INIT_CLASS(class, altcomplex); break;
+    case VECSXP: INIT_CLASS(class, altlist); break;
     default: error("unsupported ALTREP class");
     }
 }
@@ -1008,6 +1087,18 @@ static void reinit_altrep_class(SEXP class)
 	m->MNAME = fun;							\
     }
 
+#define DEFINE_METHOD_SETTER_NOLIST(CNAME, MNAME)                       \
+    void R_set_##CNAME##_##MNAME##_method(R_altrep_class_t cls,         \
+                                          R_##CNAME##_##MNAME##_method_t fun) \
+    {                                                                   \
+        CNAME##_methods_t *m = CLASS_METHODS_TABLE(R_SEXP(cls));        \
+        if (m->MNAME == altlist_##MNAME##_default) {                    \
+            error("ALTLIST classes do not have a ##MNAME## method");    \
+        } else {                                                        \
+            m->MNAME = fun;                                             \
+        }                                                               \
+    }
+
 DEFINE_METHOD_SETTER(altrep, UnserializeEX)
 DEFINE_METHOD_SETTER(altrep, Unserialize)
 DEFINE_METHOD_SETTER(altrep, Serialized_state)
@@ -1017,8 +1108,8 @@ DEFINE_METHOD_SETTER(altrep, Coerce)
 DEFINE_METHOD_SETTER(altrep, Inspect)
 DEFINE_METHOD_SETTER(altrep, Length)
 
-DEFINE_METHOD_SETTER(altvec, Dataptr)
-DEFINE_METHOD_SETTER(altvec, Dataptr_or_null)
+DEFINE_METHOD_SETTER_NOLIST(altvec, Dataptr)
+DEFINE_METHOD_SETTER_NOLIST(altvec, Dataptr_or_null)
 DEFINE_METHOD_SETTER(altvec, Extract_subset)
 
 DEFINE_METHOD_SETTER(altinteger, Elt)
@@ -1054,6 +1145,8 @@ DEFINE_METHOD_SETTER(altstring, Set_elt)
 DEFINE_METHOD_SETTER(altstring, Is_sorted)
 DEFINE_METHOD_SETTER(altstring, No_NA)
 
+DEFINE_METHOD_SETTER(altlist, Elt)
+DEFINE_METHOD_SETTER(altlist, Set_elt)
 
 /**
  ** ALTREP Object Constructor and Utility Functions

Diff for: src/main/dotcode.c

@@ -2025,14 +2025,19 @@ attribute_hidden SEXP do_dotCode(SEXP call, SEXP op, SEXP args, SEXP env)
 			    type2char(t), na + 1);
 	    /* Used read-only, so this is safe */
 #ifdef USE_RINTERNALS
-	    cargs[na] = (void*) DATAPTR(s);
+            if (!ALTREP(s))
+                cargs[na] = (void*) DATAPTR(s);
+            else {
 #else
-	    n = XLENGTH(s);
-	    SEXP *lptr = (SEXP *) R_alloc(n, sizeof(SEXP));
-	    for (R_xlen_t i = 0 ; i < n ; i++) lptr[i] = VECTOR_ELT(s, i);
-	    cargs[na] = (void*) lptr;
+                n = XLENGTH(s);
+                SEXP *lptr = (SEXP *) R_alloc(n, sizeof(SEXP));
+                for (R_xlen_t i = 0 ; i < n ; i++) lptr[i] = VECTOR_ELT(s, i);
+                cargs[na] = (void*) lptr;
 #endif
-	    break;
+#ifdef USE_RINTERNALS
+            }
+#endif
+            break;
 	case CLOSXP:
 	case BUILTINSXP:
 	case SPECIALSXP: