The R Project SVN
R
(root)/branches/R-defquartz/src/main/altrep.c – Rev 83916
Rev 83466 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
/** R : A Computer Language for Statistical Data Analysis* 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* the Free Software Foundation; either version 2 of the License, or* (at your option) any later version.** This program 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 this program; if not, a copy is available at* https://www.R-project.org/Licenses/*/#ifdef HAVE_CONFIG_H#include <config.h>#endif#include <Defn.h>#include <R_ext/Altrep.h>/****** ALTREP Abstract Class Framework***//**** ALTREP Class Registry for Serialization**//* Use ATTRIB field to hold class info. OK since not visible outside. */#define ALTREP_CLASS_SERIALIZED_CLASS(x) ATTRIB(x)#define SET_ALTREP_CLASS_SERIALIZED_CLASS(x, csym, psym, stype) \SET_ATTRIB(x, list3(csym, psym, stype))#define ALTREP_SERIALIZED_CLASS_CLSSYM(x) CAR(x)#define ALTREP_SERIALIZED_CLASS_PKGSYM(x) CADR(x)#define ALTREP_SERIALIZED_CLASS_TYPE(x) INTEGER0(CADDR(x))[0]#define ALTREP_OBJECT_CLSSYM(x) ALTREP_SERIALIZED_CLASS_CLSSYM( \ALTREP_SERIALIZED_CLASS(x))#define ALTREP_OBJECT_PKGSYM(x) ALTREP_SERIALIZED_CLASS_PKGSYM( \ALTREP_SERIALIZED_CLASS(x))#define ALTREP_CLASS_BASE_TYPE(x) \ALTREP_SERIALIZED_CLASS_TYPE(ALTREP_CLASS_SERIALIZED_CLASS(x))static SEXP Registry = NULL;static SEXP LookupClassEntry(SEXP csym, SEXP psym){for (SEXP chain = CDR(Registry); chain != R_NilValue; chain = CDR(chain))if (TAG(CAR(chain)) == csym && CADR(CAR(chain)) == psym)return CAR(chain);return NULL;}static voidRegisterClass(SEXP class, int type, const char *cname, const char *pname,DllInfo *dll){PROTECT(class);if (Registry == NULL) {Registry = CONS(R_NilValue, R_NilValue);R_PreserveObject(Registry);}SEXP csym = install(cname);SEXP psym = install(pname);SEXP stype = PROTECT(ScalarInteger(type));SEXP iptr = R_MakeExternalPtr(dll, R_NilValue, R_NilValue);SEXP entry = LookupClassEntry(csym, psym);if (entry == NULL) {entry = list4(class, psym, stype, iptr);SET_TAG(entry, csym);SETCDR(Registry, CONS(entry, CDR(Registry)));}else {SETCAR(entry, class);SETCAR(CDR(CDR(entry)), stype);SETCAR(CDR(CDR(CDR(entry))), iptr);}SET_ALTREP_CLASS_SERIALIZED_CLASS(class, csym, psym, stype);UNPROTECT(2); /* class, stype */}static SEXP LookupClass(SEXP csym, SEXP psym){SEXP entry = LookupClassEntry(csym, psym);return entry != NULL ? CAR(entry) : NULL;}static void reinit_altrep_class(SEXP sclass);attribute_hidden void R_reinit_altrep_classes(DllInfo *dll){for (SEXP chain = CDR(Registry); chain != R_NilValue; chain = CDR(chain)) {SEXP entry = CAR(chain);SEXP iptr = CAR(CDR(CDR(CDR(entry))));if (R_ExternalPtrAddr(iptr) == dll)reinit_altrep_class(CAR(entry));}}/**** ALTREP Method Tables and Class Objects**/#define ALTREP_ERROR_IN_CLASS(msg, x) do { \error("%s [class: %s, pkg: %s]", \msg, \CHAR(PRINTNAME(ALTREP_OBJECT_CLSSYM(x))), \CHAR(PRINTNAME(ALTREP_OBJECT_PKGSYM(x)))); \} while(0)static void SET_ALTREP_CLASS(SEXP x, SEXP class){SETALTREP(x, 1);SET_TAG(x, class);}#define CLASS_METHODS_TABLE(class) STDVEC_DATAPTR(class)#define GENERIC_METHODS_TABLE(x, class) \((class##_methods_t *) CLASS_METHODS_TABLE(ALTREP_CLASS(x)))#define ALTREP_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altrep)#define ALTVEC_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altvec)#define ALTINTEGER_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altinteger)#define ALTREAL_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altreal)#define ALTLOGICAL_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altlogical)#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; \R_altrep_Unserialize_method_t Unserialize; \R_altrep_Serialized_state_method_t Serialized_state; \R_altrep_DuplicateEX_method_t DuplicateEX; \R_altrep_Duplicate_method_t Duplicate; \R_altrep_Coerce_method_t Coerce; \R_altrep_Inspect_method_t Inspect; \R_altrep_Length_method_t Length#define ALTVEC_METHODS \ALTREP_METHODS; \R_altvec_Dataptr_method_t Dataptr; \R_altvec_Dataptr_or_null_method_t Dataptr_or_null; \R_altvec_Extract_subset_method_t Extract_subset#define ALTINTEGER_METHODS \ALTVEC_METHODS; \R_altinteger_Elt_method_t Elt; \R_altinteger_Get_region_method_t Get_region; \R_altinteger_Is_sorted_method_t Is_sorted; \R_altinteger_No_NA_method_t No_NA; \R_altinteger_Sum_method_t Sum ; \R_altinteger_Min_method_t Min; \R_altinteger_Max_method_t Max#define ALTREAL_METHODS \ALTVEC_METHODS; \R_altreal_Elt_method_t Elt; \R_altreal_Get_region_method_t Get_region; \R_altreal_Is_sorted_method_t Is_sorted; \R_altreal_No_NA_method_t No_NA; \R_altreal_Sum_method_t Sum; \R_altreal_Min_method_t Min; \R_altreal_Max_method_t Max#define ALTLOGICAL_METHODS \ALTVEC_METHODS; \R_altlogical_Elt_method_t Elt; \R_altlogical_Get_region_method_t Get_region;\R_altlogical_Is_sorted_method_t Is_sorted; \R_altlogical_No_NA_method_t No_NA; \R_altlogical_Sum_method_t Sum#define ALTRAW_METHODS \ALTVEC_METHODS; \R_altraw_Elt_method_t Elt; \R_altraw_Get_region_method_t Get_region#define ALTCOMPLEX_METHODS \ALTVEC_METHODS; \R_altcomplex_Elt_method_t Elt; \R_altcomplex_Get_region_method_t Get_region#define ALTSTRING_METHODS \ALTVEC_METHODS; \R_altstring_Elt_method_t Elt; \R_altstring_Set_elt_method_t Set_elt; \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_elttypedef struct { ALTREP_METHODS; } altrep_methods_t;typedef struct { ALTVEC_METHODS; } altvec_methods_t;typedef struct { ALTINTEGER_METHODS; } altinteger_methods_t;typedef struct { ALTREAL_METHODS; } altreal_methods_t;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 inhttp://stackoverflow.com/questions/5588855/standard-alternative-to-gccs-va-args-trick*/#define DISPATCH_TARGET(...) DISPATCH_TARGET_HELPER(__VA_ARGS__, dummy)#define DISPATCH_TARGET_HELPER(x, ...) x#define DO_DISPATCH(type, fun, ...) \type##_METHODS_TABLE(DISPATCH_TARGET(__VA_ARGS__))->fun(__VA_ARGS__)#define ALTREP_DISPATCH(fun, ...) DO_DISPATCH(ALTREP, fun, __VA_ARGS__)#define ALTVEC_DISPATCH(fun, ...) DO_DISPATCH(ALTVEC, fun, __VA_ARGS__)#define ALTINTEGER_DISPATCH(fun, ...) DO_DISPATCH(ALTINTEGER, fun, __VA_ARGS__)#define ALTREAL_DISPATCH(fun, ...) DO_DISPATCH(ALTREAL, fun, __VA_ARGS__)#define ALTLOGICAL_DISPATCH(fun, ...) DO_DISPATCH(ALTLOGICAL, fun, __VA_ARGS__)#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__)/** Generic ALTREP support*/attribute_hidden SEXP ALTREP_COERCE(SEXP x, int type){return ALTREP_DISPATCH(Coerce, x, type);}static SEXP ALTREP_DUPLICATE(SEXP x, Rboolean deep){return ALTREP_DISPATCH(Duplicate, x, deep);}attribute_hidden SEXP ALTREP_DUPLICATE_EX(SEXP x, Rboolean deep){return ALTREP_DISPATCH(DuplicateEX, x, deep);}attribute_hidden RbooleanALTREP_INSPECT(SEXP x, int pre, int deep, int pvec,void (*inspect_subtree)(SEXP, int, int, int)){return ALTREP_DISPATCH(Inspect, x, pre, deep, pvec, inspect_subtree);}attribute_hidden SEXPALTREP_SERIALIZED_STATE(SEXP x){return ALTREP_DISPATCH(Serialized_state, x);}attribute_hidden SEXPALTREP_SERIALIZED_CLASS(SEXP x){SEXP val = ALTREP_CLASS_SERIALIZED_CLASS(ALTREP_CLASS(x));return val != R_NilValue ? val : NULL;}static SEXP find_namespace(void *data) { return R_FindNamespace((SEXP) data); }static SEXP handle_namespace_error(SEXP cond, void *data) { return R_NilValue; }static SEXP ALTREP_UNSERIALIZE_CLASS(SEXP info){if (TYPEOF(info) == LISTSXP) {SEXP csym = ALTREP_SERIALIZED_CLASS_CLSSYM(info);SEXP psym = ALTREP_SERIALIZED_CLASS_PKGSYM(info);SEXP class = LookupClass(csym, psym);if (class == NULL) {SEXP pname = ScalarString(PRINTNAME(psym));PROTECT(pname);R_tryCatchError(find_namespace, pname,handle_namespace_error, NULL);class = LookupClass(csym, psym);UNPROTECT(1);}return class;}return NULL;}attribute_hidden SEXPALTREP_UNSERIALIZE_EX(SEXP info, SEXP state, SEXP attr, int objf, int levs){SEXP csym = ALTREP_SERIALIZED_CLASS_CLSSYM(info);SEXP psym = ALTREP_SERIALIZED_CLASS_PKGSYM(info);int type = ALTREP_SERIALIZED_CLASS_TYPE(info);/* look up the class in the registry and handle failure */SEXP class = ALTREP_UNSERIALIZE_CLASS(info);if (class == NULL) {switch(type) {case LGLSXP:case INTSXP:case REALSXP:case CPLXSXP:case STRSXP:case RAWSXP:case VECSXP:case EXPRSXP:warning("cannot unserialize ALTVEC object of class '%s' from ""package '%s'; returning length zero vector",CHAR(PRINTNAME(csym)), CHAR(PRINTNAME(psym)));return allocVector(type, 0);default:error("cannot unserialize this ALTREP object");}}/* check the registered and unserialized types match */int rtype = ALTREP_CLASS_BASE_TYPE(class);if (type != rtype)warning("serialized class '%s' from package '%s' has type %s; ""registered class has type %s",CHAR(PRINTNAME(csym)), CHAR(PRINTNAME(psym)),type2char(type), type2char(rtype));/* dispatch to a class method */altrep_methods_t *m = CLASS_METHODS_TABLE(class);SEXP val = m->UnserializeEX(class, state, attr, objf, levs);return val;}R_xlen_t /*attribute_hidden*/ ALTREP_LENGTH(SEXP x){return ALTREP_DISPATCH(Length, x);}R_xlen_t /*attribute_hidden*/ ALTREP_TRUELENGTH(SEXP x) { return 0; }/** Generic ALTVEC support*/static R_INLINE void *ALTVEC_DATAPTR_EX(SEXP x, Rboolean writeable){/**** move GC disabling into methods? */if (R_in_gc)error("cannot get ALTVEC DATAPTR during GC");R_CHECK_THREAD;int enabled = R_GCEnabled;R_GCEnabled = FALSE;void *val = ALTVEC_DISPATCH(Dataptr, x, writeable);R_GCEnabled = enabled;return val;}void /*attribute_hidden*/ *ALTVEC_DATAPTR(SEXP x){return ALTVEC_DATAPTR_EX(x, TRUE);}const void /*attribute_hidden*/ *ALTVEC_DATAPTR_RO(SEXP x){return ALTVEC_DATAPTR_EX(x, FALSE);}const void /*attribute_hidden*/ *ALTVEC_DATAPTR_OR_NULL(SEXP x){return ALTVEC_DISPATCH(Dataptr_or_null, x);}attribute_hidden SEXP ALTVEC_EXTRACT_SUBSET(SEXP x, SEXP indx, SEXP call){return ALTVEC_DISPATCH(Extract_subset, x, indx, call);}/** Typed ALTVEC support*/attribute_hidden int ALTINTEGER_ELT(SEXP x, R_xlen_t i){return ALTINTEGER_DISPATCH(Elt, x, i);}R_xlen_t INTEGER_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf){const int *x = INTEGER_OR_NULL(sx);if (x != NULL) {R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = x[k + i];//memcpy(buf, x + i, ncopy * sizeof(int));return ncopy;}elsereturn ALTINTEGER_DISPATCH(Get_region, sx, i, n, buf);}int INTEGER_IS_SORTED(SEXP x){return ALTREP(x) ? ALTINTEGER_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;}int INTEGER_NO_NA(SEXP x){return ALTREP(x) ? ALTINTEGER_DISPATCH(No_NA, x) : 0;}attribute_hidden double ALTREAL_ELT(SEXP x, R_xlen_t i){return ALTREAL_DISPATCH(Elt, x, i);}R_xlen_t REAL_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, double *buf){const double *x = REAL_OR_NULL(sx);if (x != NULL) {R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = x[k + i];//memcpy(buf, x + i, ncopy * sizeof(double));return ncopy;}elsereturn ALTREAL_DISPATCH(Get_region, sx, i, n, buf);}int REAL_IS_SORTED(SEXP x){return ALTREP(x) ? ALTREAL_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;}int REAL_NO_NA(SEXP x){return ALTREP(x) ? ALTREAL_DISPATCH(No_NA, x) : 0;}R_xlen_t LOGICAL_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf){const int *x = DATAPTR_OR_NULL(sx);if (x != NULL) {R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = x[k + i];//memcpy(buf, x + i, ncopy * sizeof(int));return ncopy;}elsereturn ALTLOGICAL_DISPATCH(Get_region, sx, i, n, buf);}int LOGICAL_IS_SORTED(SEXP x){return ALTREP(x) ? ALTLOGICAL_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;}int LOGICAL_NO_NA(SEXP x){return ALTREP(x) ? ALTLOGICAL_DISPATCH(No_NA, x) : 0;}R_xlen_t RAW_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, Rbyte *buf){const Rbyte *x = DATAPTR_OR_NULL(sx);if (x != NULL) {R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = x[k + i];//memcpy(buf, x + i, ncopy * sizeof(int));return ncopy;}elsereturn ALTRAW_DISPATCH(Get_region, sx, i, n, buf);}R_xlen_t COMPLEX_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, Rcomplex *buf){const Rcomplex *x = DATAPTR_OR_NULL(sx);if (x != NULL) {R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = x[k + i];//memcpy(buf, x + i, ncopy * sizeof(int));return ncopy;}elsereturn ALTCOMPLEX_DISPATCH(Get_region, sx, i, n, buf);}SEXP /*attribute_hidden*/ ALTSTRING_ELT(SEXP x, R_xlen_t i){SEXP val = NULL;/**** move GC disabling into method? */if (R_in_gc)error("cannot get ALTSTRING_ELT during GC");R_CHECK_THREAD;int enabled = R_GCEnabled;R_GCEnabled = FALSE;val = ALTSTRING_DISPATCH(Elt, x, i);R_GCEnabled = enabled;return val;}attribute_hidden void ALTSTRING_SET_ELT(SEXP x, R_xlen_t i, SEXP v){/**** move GC disabling into method? */if (R_in_gc)error("cannot set ALTSTRING_ELT during GC");R_CHECK_THREAD;int enabled = R_GCEnabled;R_GCEnabled = FALSE;ALTSTRING_DISPATCH(Set_elt, x, i, v);R_GCEnabled = enabled;}int STRING_IS_SORTED(SEXP x){return ALTREP(x) ? ALTSTRING_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;}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);}SEXP ALTINTEGER_MIN(SEXP x, Rboolean narm){return ALTINTEGER_DISPATCH(Min, x, narm);}SEXP ALTINTEGER_MAX(SEXP x, Rboolean narm){return ALTINTEGER_DISPATCH(Max, x, narm);}SEXP ALTREAL_SUM(SEXP x, Rboolean narm){return ALTREAL_DISPATCH(Sum, x, narm);}SEXP ALTREAL_MIN(SEXP x, Rboolean narm){return ALTREAL_DISPATCH(Min, x, narm);}SEXP ALTREAL_MAX(SEXP x, Rboolean narm){return ALTREAL_DISPATCH(Max, x, narm);}SEXP ALTLOGICAL_SUM(SEXP x, Rboolean narm){return ALTLOGICAL_DISPATCH(Sum, x, narm);}attribute_hidden int ALTLOGICAL_ELT(SEXP x, R_xlen_t i){return ALTLOGICAL_DISPATCH(Elt, x, i);}attribute_hidden Rcomplex ALTCOMPLEX_ELT(SEXP x, R_xlen_t i){return ALTCOMPLEX_DISPATCH(Elt, x, i);}attribute_hidden Rbyte ALTRAW_ELT(SEXP x, R_xlen_t i){return ALTRAW_DISPATCH(Elt, x, i);}/** Not yet implemented*/void ALTINTEGER_SET_ELT(SEXP x, R_xlen_t i, int v){INTEGER(x)[i] = v; /* dispatch here */}void ALTLOGICAL_SET_ELT(SEXP x, R_xlen_t i, int v){LOGICAL(x)[i] = v; /* dispatch here */}void ALTREAL_SET_ELT(SEXP x, R_xlen_t i, double v){REAL(x)[i] = v; /* dispatch here */}void ALTCOMPLEX_SET_ELT(SEXP x, R_xlen_t i, Rcomplex v){COMPLEX(x)[i] = v; /* dispatch here */}void ALTRAW_SET_ELT(SEXP x, R_xlen_t i, Rbyte v){RAW(x)[i] = v; /* dispatch here */}/**** ALTREP Default Methods**/static SEXP altrep_UnserializeEX_default(SEXP class, SEXP state, SEXP attr,int objf, int levs){altrep_methods_t *m = CLASS_METHODS_TABLE(class);SEXP val = m->Unserialize(class, state);SET_ATTRIB(val, attr);SET_OBJECT(val, objf);SETLEVELS(val, levs);return val;}static SEXP altrep_Serialized_state_default(SEXP x) { return NULL; }static SEXP altrep_Unserialize_default(SEXP class, SEXP state){error("cannot unserialize this ALTREP object yet");}static SEXP altrep_Coerce_default(SEXP x, int type) { return NULL; }static SEXP altrep_Duplicate_default(SEXP x, Rboolean deep){return NULL;}static SEXP altrep_DuplicateEX_default(SEXP x, Rboolean deep){SEXP ans = ALTREP_DUPLICATE(x, deep);if (ans != NULL &&ans != x) { /* leave attributes alone if returning original *//* handle attributes generically */SEXP attr = ATTRIB(x);if (attr != R_NilValue) {PROTECT(ans);SET_ATTRIB(ans, deep ? duplicate(attr) : shallow_duplicate(attr));SET_OBJECT(ans, OBJECT(x));IS_S4_OBJECT(x) ? SET_S4_OBJECT(ans) : UNSET_S4_OBJECT(ans);UNPROTECT(1);}else if (ATTRIB(ans) != R_NilValue) {SET_ATTRIB(ans, R_NilValue);SET_OBJECT(ans, FALSE);UNSET_S4_OBJECT(ans);}}return ans;}staticRboolean altrep_Inspect_default(SEXP x, int pre, int deep, int pvec,void (*inspect_subtree)(SEXP, int, int, int)){return FALSE;}static R_xlen_t altrep_Length_default(SEXP x){ALTREP_ERROR_IN_CLASS("no ALTREP Length method defined", x);}static void *altvec_Dataptr_default(SEXP x, Rboolean writeable){ALTREP_ERROR_IN_CLASS("cannot access data pointer for this ALTVEC object", x);}static const void *altvec_Dataptr_or_null_default(SEXP x){return NULL;}static SEXP altvec_Extract_subset_default(SEXP x, SEXP indx, SEXP call){return NULL;}static int altinteger_Elt_default(SEXP x, R_xlen_t i) { return INTEGER(x)[i]; }static R_xlen_taltinteger_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf){R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = INTEGER_ELT(sx, k + i);return ncopy;}static int altinteger_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }static int altinteger_No_NA_default(SEXP x) { return 0; }static SEXP altinteger_Sum_default(SEXP x, Rboolean narm) { return NULL; }static SEXP altinteger_Min_default(SEXP x, Rboolean narm) { return NULL; }static SEXP altinteger_Max_default(SEXP x, Rboolean narm) { return NULL; }static double altreal_Elt_default(SEXP x, R_xlen_t i) { return REAL(x)[i]; }static R_xlen_taltreal_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, double *buf){R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = REAL_ELT(sx, k + i);return ncopy;}static int altreal_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }static int altreal_No_NA_default(SEXP x) { return 0; }static SEXP altreal_Sum_default(SEXP x, Rboolean narm) { return NULL; }static SEXP altreal_Min_default(SEXP x, Rboolean narm) { return NULL; }static SEXP altreal_Max_default(SEXP x, Rboolean narm) { return NULL; }static int altlogical_Elt_default(SEXP x, R_xlen_t i) { return LOGICAL(x)[i]; }static R_xlen_taltlogical_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf){R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = LOGICAL_ELT(sx, k + i);return ncopy;}static int altlogical_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }static int altlogical_No_NA_default(SEXP x) { return 0; }static SEXP altlogical_Sum_default(SEXP x, Rboolean narm) { return NULL; }static Rbyte altraw_Elt_default(SEXP x, R_xlen_t i) { return RAW(x)[i]; }static R_xlen_taltraw_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, Rbyte *buf){R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = RAW_ELT(sx, k + i);return ncopy;}static Rcomplex altcomplex_Elt_default(SEXP x, R_xlen_t i){return COMPLEX(x)[i];}static R_xlen_taltcomplex_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, Rcomplex *buf){R_xlen_t size = XLENGTH(sx);R_xlen_t ncopy = size - i > n ? n : size - i;for (R_xlen_t k = 0; k < ncopy; k++)buf[k] = COMPLEX_ELT(sx, k + i);return ncopy;}static SEXP altstring_Elt_default(SEXP x, R_xlen_t i){ALTREP_ERROR_IN_CLASS("No Elt method found for ALTSTRING class", x);}static void altstring_Set_elt_default(SEXP x, R_xlen_t i, SEXP v){ALTREP_ERROR_IN_CLASS("No Set_elt found for ALTSTRING class", x);}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**/static altinteger_methods_t altinteger_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altinteger_Elt_default,.Get_region = altinteger_Get_region_default,.Is_sorted = altinteger_Is_sorted_default,.No_NA = altinteger_No_NA_default,.Sum = altinteger_Sum_default,.Min = altinteger_Min_default,.Max = altinteger_Max_default};static altreal_methods_t altreal_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altreal_Elt_default,.Get_region = altreal_Get_region_default,.Is_sorted = altreal_Is_sorted_default,.No_NA = altreal_No_NA_default,.Sum = altreal_Sum_default,.Min = altreal_Min_default,.Max = altreal_Max_default};static altlogical_methods_t altlogical_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altlogical_Elt_default,.Get_region = altlogical_Get_region_default,.Is_sorted = altlogical_Is_sorted_default,.No_NA = altlogical_No_NA_default,.Sum = altlogical_Sum_default};static altraw_methods_t altraw_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altraw_Elt_default,.Get_region = altraw_Get_region_default};static altcomplex_methods_t altcomplex_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altcomplex_Elt_default,.Get_region = altcomplex_Get_region_default};static altstring_methods_t altstring_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 = altvec_Dataptr_default,.Dataptr_or_null = altvec_Dataptr_or_null_default,.Extract_subset = altvec_Extract_subset_default,.Elt = altstring_Elt_default,.Set_elt = altstring_Set_elt_default,.Is_sorted = altstring_Is_sorted_default,.No_NA = altstring_No_NA_default};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**/#define INIT_CLASS(cls, type) do { \*((type##_methods_t *) (CLASS_METHODS_TABLE(cls))) = \type##_default_methods; \} while (FALSE)#define MAKE_CLASS(var, type) do { \var = allocVector(RAWSXP, sizeof(type##_methods_t)); \R_PreserveObject(var); \INIT_CLASS(var, type); \} while (FALSE)static R_INLINE R_altrep_class_t R_cast_altrep_class(SEXP x){/**** some king of optional check? */R_altrep_class_t val = R_SUBTYPE_INIT(x);return val;}static R_altrep_class_tmake_altrep_class(int type, const char *cname, const char *pname, DllInfo *dll){SEXP class;switch(type) {case INTSXP: MAKE_CLASS(class, altinteger); break;case REALSXP: MAKE_CLASS(class, altreal); break;case LGLSXP: MAKE_CLASS(class, altlogical); break;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);return R_cast_altrep_class(class);}/* Using macros like this makes it easier to add new methods, butmakes searching for source harder. Probably a good idea onbalance though. */#define DEFINE_CLASS_CONSTRUCTOR(cls, type) \R_altrep_class_t R_make_##cls##_class(const char *cname, \const char *pname, \DllInfo *dll) \{ \return make_altrep_class(type, cname, pname, 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)DEFINE_CLASS_CONSTRUCTOR(altraw, RAWSXP)DEFINE_CLASS_CONSTRUCTOR(altcomplex, CPLXSXP)static void reinit_altrep_class(SEXP class){switch (ALTREP_CLASS_BASE_TYPE(class)) {case INTSXP: INIT_CLASS(class, altinteger); break;case REALSXP: INIT_CLASS(class, altreal); break;case STRSXP: INIT_CLASS(class, altstring); break;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");}}/**** ALTREP Method Setters**/#define DEFINE_METHOD_SETTER(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)); \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)DEFINE_METHOD_SETTER(altrep, DuplicateEX)DEFINE_METHOD_SETTER(altrep, Duplicate)DEFINE_METHOD_SETTER(altrep, Coerce)DEFINE_METHOD_SETTER(altrep, Inspect)DEFINE_METHOD_SETTER(altrep, Length)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)DEFINE_METHOD_SETTER(altinteger, Get_region)DEFINE_METHOD_SETTER(altinteger, Is_sorted)DEFINE_METHOD_SETTER(altinteger, No_NA)DEFINE_METHOD_SETTER(altinteger, Sum)DEFINE_METHOD_SETTER(altinteger, Min)DEFINE_METHOD_SETTER(altinteger, Max)DEFINE_METHOD_SETTER(altreal, Elt)DEFINE_METHOD_SETTER(altreal, Get_region)DEFINE_METHOD_SETTER(altreal, Is_sorted)DEFINE_METHOD_SETTER(altreal, No_NA)DEFINE_METHOD_SETTER(altreal, Sum)DEFINE_METHOD_SETTER(altreal, Min)DEFINE_METHOD_SETTER(altreal, Max)DEFINE_METHOD_SETTER(altlogical, Elt)DEFINE_METHOD_SETTER(altlogical, Get_region)DEFINE_METHOD_SETTER(altlogical, Is_sorted)DEFINE_METHOD_SETTER(altlogical, No_NA)DEFINE_METHOD_SETTER(altlogical, Sum)DEFINE_METHOD_SETTER(altraw, Elt)DEFINE_METHOD_SETTER(altraw, Get_region)DEFINE_METHOD_SETTER(altcomplex, Elt)DEFINE_METHOD_SETTER(altcomplex, Get_region)DEFINE_METHOD_SETTER(altstring, Elt)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**/SEXP R_new_altrep(R_altrep_class_t aclass, SEXP data1, SEXP data2){SEXP sclass = R_SEXP(aclass);int type = ALTREP_CLASS_BASE_TYPE(sclass);SEXP ans = CONS(data1, data2);SET_TYPEOF(ans, type);SET_ALTREP_CLASS(ans, sclass);return ans;}Rboolean R_altrep_inherits(SEXP x, R_altrep_class_t class){return ALTREP(x) && ALTREP_CLASS(x) == R_SEXP(class);}attribute_hidden SEXP do_altrep_class(SEXP call, SEXP op, SEXP args, SEXP env){checkArity(op, args);SEXP x = CAR(args);if (ALTREP(x)) {SEXP info = ALTREP_SERIALIZED_CLASS(x);SEXP val = allocVector(STRSXP, 2);SET_STRING_ELT(val, 0, PRINTNAME(ALTREP_SERIALIZED_CLASS_CLSSYM(info)));SET_STRING_ELT(val, 1, PRINTNAME(ALTREP_SERIALIZED_CLASS_PKGSYM(info)));return val;}elsereturn R_NilValue;}