1 /*
2 * R : A Computer Language for Statistical Data Analysis
3 * Copyright (C) 2016--2017 The R Core Team
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, a copy is available at
17 * https://www.R-project.org/Licenses/
18 */
19
20 #ifdef HAVE_CONFIG_H
21 #include <config.h>
22 #endif
23
24 #include <Defn.h>
25 #include <R_ext/Altrep.h>
26
27
28 /***
29 *** ALTREP Abstract Class Framework
30 ***/
31
32 /**
33 ** ALTREP Class Registry for Serialization
34 **/
35
36 /* Use ATTRIB field to hold class info. OK since not visible outside. */
37 #define ALTREP_CLASS_SERIALIZED_CLASS(x) ATTRIB(x)
38 #define SET_ALTREP_CLASS_SERIALIZED_CLASS(x, csym, psym, stype) \
39 SET_ATTRIB(x, list3(csym, psym, stype))
40 #define ALTREP_SERIALIZED_CLASS_CLSSYM(x) CAR(x)
41 #define ALTREP_SERIALIZED_CLASS_PKGSYM(x) CADR(x)
42 #define ALTREP_SERIALIZED_CLASS_TYPE(x) INTEGER0(CADDR(x))[0]
43 #define ALTREP_OBJECT_CLSSYM(x) ALTREP_SERIALIZED_CLASS_CLSSYM( \
44 ALTREP_SERIALIZED_CLASS(x))
45 #define ALTREP_OBJECT_PKGSYM(x) ALTREP_SERIALIZED_CLASS_PKGSYM( \
46 ALTREP_SERIALIZED_CLASS(x))
47
48 #define ALTREP_CLASS_BASE_TYPE(x) \
49 ALTREP_SERIALIZED_CLASS_TYPE(ALTREP_CLASS_SERIALIZED_CLASS(x))
50
51 static SEXP Registry = NULL;
52
LookupClassEntry(SEXP csym,SEXP psym)53 static SEXP LookupClassEntry(SEXP csym, SEXP psym)
54 {
55 for (SEXP chain = CDR(Registry); chain != R_NilValue; chain = CDR(chain))
56 if (TAG(CAR(chain)) == csym && CADR(CAR(chain)) == psym)
57 return CAR(chain);
58 return NULL;
59 }
60
61 static void
RegisterClass(SEXP class,int type,const char * cname,const char * pname,DllInfo * dll)62 RegisterClass(SEXP class, int type, const char *cname, const char *pname,
63 DllInfo *dll)
64 {
65 PROTECT(class);
66 if (Registry == NULL) {
67 Registry = CONS(R_NilValue, R_NilValue);
68 R_PreserveObject(Registry);
69 }
70
71 SEXP csym = install(cname);
72 SEXP psym = install(pname);
73 SEXP stype = PROTECT(ScalarInteger(type));
74 SEXP iptr = R_MakeExternalPtr(dll, R_NilValue, R_NilValue);
75 SEXP entry = LookupClassEntry(csym, psym);
76 if (entry == NULL) {
77 entry = list4(class, psym, stype, iptr);
78 SET_TAG(entry, csym);
79 SETCDR(Registry, CONS(entry, CDR(Registry)));
80 }
81 else {
82 SETCAR(entry, class);
83 SETCAR(CDR(CDR(entry)), stype);
84 SETCAR(CDR(CDR(CDR(entry))), iptr);
85 }
86 SET_ALTREP_CLASS_SERIALIZED_CLASS(class, csym, psym, stype);
87 UNPROTECT(2); /* class, stype */
88 }
89
LookupClass(SEXP csym,SEXP psym)90 static SEXP LookupClass(SEXP csym, SEXP psym)
91 {
92 SEXP entry = LookupClassEntry(csym, psym);
93 return entry != NULL ? CAR(entry) : NULL;
94 }
95
96 static void reinit_altrep_class(SEXP sclass);
R_reinit_altrep_classes(DllInfo * dll)97 void attribute_hidden R_reinit_altrep_classes(DllInfo *dll)
98 {
99 for (SEXP chain = CDR(Registry); chain != R_NilValue; chain = CDR(chain)) {
100 SEXP entry = CAR(chain);
101 SEXP iptr = CAR(CDR(CDR(CDR(entry))));
102 if (R_ExternalPtrAddr(iptr) == dll)
103 reinit_altrep_class(CAR(entry));
104 }
105 }
106
107
108 /**
109 ** ALTREP Method Tables and Class Objects
110 **/
111
112 #define ALTREP_ERROR_IN_CLASS(msg, x) do { \
113 error("%s [class: %s, pkg: %s]", \
114 msg, \
115 CHAR(PRINTNAME(ALTREP_OBJECT_CLSSYM(x))), \
116 CHAR(PRINTNAME(ALTREP_OBJECT_PKGSYM(x)))); \
117 } while(0)
118
SET_ALTREP_CLASS(SEXP x,SEXP class)119 static void SET_ALTREP_CLASS(SEXP x, SEXP class)
120 {
121 SETALTREP(x, 1);
122 SET_TAG(x, class);
123 }
124
125 #define CLASS_METHODS_TABLE(class) STDVEC_DATAPTR(class)
126 #define GENERIC_METHODS_TABLE(x, class) \
127 ((class##_methods_t *) CLASS_METHODS_TABLE(ALTREP_CLASS(x)))
128
129 #define ALTREP_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altrep)
130 #define ALTVEC_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altvec)
131 #define ALTINTEGER_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altinteger)
132 #define ALTREAL_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altreal)
133 #define ALTLOGICAL_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altlogical)
134 #define ALTRAW_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altraw)
135 #define ALTCOMPLEX_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altcomplex)
136 #define ALTSTRING_METHODS_TABLE(x) GENERIC_METHODS_TABLE(x, altstring)
137
138 #define ALTREP_METHODS \
139 R_altrep_UnserializeEX_method_t UnserializeEX; \
140 R_altrep_Unserialize_method_t Unserialize; \
141 R_altrep_Serialized_state_method_t Serialized_state; \
142 R_altrep_DuplicateEX_method_t DuplicateEX; \
143 R_altrep_Duplicate_method_t Duplicate; \
144 R_altrep_Coerce_method_t Coerce; \
145 R_altrep_Inspect_method_t Inspect; \
146 R_altrep_Length_method_t Length
147
148 #define ALTVEC_METHODS \
149 ALTREP_METHODS; \
150 R_altvec_Dataptr_method_t Dataptr; \
151 R_altvec_Dataptr_or_null_method_t Dataptr_or_null; \
152 R_altvec_Extract_subset_method_t Extract_subset
153
154 #define ALTINTEGER_METHODS \
155 ALTVEC_METHODS; \
156 R_altinteger_Elt_method_t Elt; \
157 R_altinteger_Get_region_method_t Get_region; \
158 R_altinteger_Is_sorted_method_t Is_sorted; \
159 R_altinteger_No_NA_method_t No_NA; \
160 R_altinteger_Sum_method_t Sum ; \
161 R_altinteger_Min_method_t Min; \
162 R_altinteger_Max_method_t Max
163
164 #define ALTREAL_METHODS \
165 ALTVEC_METHODS; \
166 R_altreal_Elt_method_t Elt; \
167 R_altreal_Get_region_method_t Get_region; \
168 R_altreal_Is_sorted_method_t Is_sorted; \
169 R_altreal_No_NA_method_t No_NA; \
170 R_altreal_Sum_method_t Sum; \
171 R_altreal_Min_method_t Min; \
172 R_altreal_Max_method_t Max
173
174 #define ALTLOGICAL_METHODS \
175 ALTVEC_METHODS; \
176 R_altlogical_Elt_method_t Elt; \
177 R_altlogical_Get_region_method_t Get_region;\
178 R_altlogical_Is_sorted_method_t Is_sorted; \
179 R_altlogical_No_NA_method_t No_NA; \
180 R_altlogical_Sum_method_t Sum
181
182 #define ALTRAW_METHODS \
183 ALTVEC_METHODS; \
184 R_altraw_Elt_method_t Elt; \
185 R_altraw_Get_region_method_t Get_region
186
187 #define ALTCOMPLEX_METHODS \
188 ALTVEC_METHODS; \
189 R_altcomplex_Elt_method_t Elt; \
190 R_altcomplex_Get_region_method_t Get_region
191
192 #define ALTSTRING_METHODS \
193 ALTVEC_METHODS; \
194 R_altstring_Elt_method_t Elt; \
195 R_altstring_Set_elt_method_t Set_elt; \
196 R_altstring_Is_sorted_method_t Is_sorted; \
197 R_altstring_No_NA_method_t No_NA
198
199 typedef struct { ALTREP_METHODS; } altrep_methods_t;
200 typedef struct { ALTVEC_METHODS; } altvec_methods_t;
201 typedef struct { ALTINTEGER_METHODS; } altinteger_methods_t;
202 typedef struct { ALTREAL_METHODS; } altreal_methods_t;
203 typedef struct { ALTLOGICAL_METHODS; } altlogical_methods_t;
204 typedef struct { ALTRAW_METHODS; } altraw_methods_t;
205 typedef struct { ALTCOMPLEX_METHODS; } altcomplex_methods_t;
206 typedef struct { ALTSTRING_METHODS; } altstring_methods_t;
207
208 /* Macro to extract first element from ... macro argument.
209 From Richard Hansen's answer in
210 http://stackoverflow.com/questions/5588855/standard-alternative-to-gccs-va-args-trick
211 */
212 #define DISPATCH_TARGET(...) DISPATCH_TARGET_HELPER(__VA_ARGS__, dummy)
213 #define DISPATCH_TARGET_HELPER(x, ...) x
214
215 #define DO_DISPATCH(type, fun, ...) \
216 type##_METHODS_TABLE(DISPATCH_TARGET(__VA_ARGS__))->fun(__VA_ARGS__)
217
218 #define ALTREP_DISPATCH(fun, ...) DO_DISPATCH(ALTREP, fun, __VA_ARGS__)
219 #define ALTVEC_DISPATCH(fun, ...) DO_DISPATCH(ALTVEC, fun, __VA_ARGS__)
220 #define ALTINTEGER_DISPATCH(fun, ...) DO_DISPATCH(ALTINTEGER, fun, __VA_ARGS__)
221 #define ALTREAL_DISPATCH(fun, ...) DO_DISPATCH(ALTREAL, fun, __VA_ARGS__)
222 #define ALTLOGICAL_DISPATCH(fun, ...) DO_DISPATCH(ALTLOGICAL, fun, __VA_ARGS__)
223 #define ALTRAW_DISPATCH(fun, ...) DO_DISPATCH(ALTRAW, fun, __VA_ARGS__)
224 #define ALTCOMPLEX_DISPATCH(fun, ...) DO_DISPATCH(ALTCOMPLEX, fun, __VA_ARGS__)
225 #define ALTSTRING_DISPATCH(fun, ...) DO_DISPATCH(ALTSTRING, fun, __VA_ARGS__)
226
227
228 /*
229 * Generic ALTREP support
230 */
231
ALTREP_COERCE(SEXP x,int type)232 SEXP attribute_hidden ALTREP_COERCE(SEXP x, int type)
233 {
234 return ALTREP_DISPATCH(Coerce, x, type);
235 }
236
ALTREP_DUPLICATE(SEXP x,Rboolean deep)237 static SEXP ALTREP_DUPLICATE(SEXP x, Rboolean deep)
238 {
239 return ALTREP_DISPATCH(Duplicate, x, deep);
240 }
241
ALTREP_DUPLICATE_EX(SEXP x,Rboolean deep)242 SEXP attribute_hidden ALTREP_DUPLICATE_EX(SEXP x, Rboolean deep)
243 {
244 return ALTREP_DISPATCH(DuplicateEX, x, deep);
245 }
246
247 Rboolean attribute_hidden
ALTREP_INSPECT(SEXP x,int pre,int deep,int pvec,void (* inspect_subtree)(SEXP,int,int,int))248 ALTREP_INSPECT(SEXP x, int pre, int deep, int pvec,
249 void (*inspect_subtree)(SEXP, int, int, int))
250 {
251 return ALTREP_DISPATCH(Inspect, x, pre, deep, pvec, inspect_subtree);
252 }
253
254
255 SEXP attribute_hidden
ALTREP_SERIALIZED_STATE(SEXP x)256 ALTREP_SERIALIZED_STATE(SEXP x)
257 {
258 return ALTREP_DISPATCH(Serialized_state, x);
259 }
260
261 SEXP attribute_hidden
ALTREP_SERIALIZED_CLASS(SEXP x)262 ALTREP_SERIALIZED_CLASS(SEXP x)
263 {
264 SEXP val = ALTREP_CLASS_SERIALIZED_CLASS(ALTREP_CLASS(x));
265 return val != R_NilValue ? val : NULL;
266 }
267
find_namespace(void * data)268 static SEXP find_namespace(void *data) { return R_FindNamespace((SEXP) data); }
handle_namespace_error(SEXP cond,void * data)269 static SEXP handle_namespace_error(SEXP cond, void *data) { return R_NilValue; }
270
ALTREP_UNSERIALIZE_CLASS(SEXP info)271 static SEXP ALTREP_UNSERIALIZE_CLASS(SEXP info)
272 {
273 if (TYPEOF(info) == LISTSXP) {
274 SEXP csym = ALTREP_SERIALIZED_CLASS_CLSSYM(info);
275 SEXP psym = ALTREP_SERIALIZED_CLASS_PKGSYM(info);
276 SEXP class = LookupClass(csym, psym);
277 if (class == NULL) {
278 SEXP pname = ScalarString(PRINTNAME(psym));
279 PROTECT(pname);
280 R_tryCatchError(find_namespace, pname,
281 handle_namespace_error, NULL);
282 class = LookupClass(csym, psym);
283 UNPROTECT(1);
284 }
285 return class;
286 }
287 return NULL;
288 }
289
290 SEXP attribute_hidden
ALTREP_UNSERIALIZE_EX(SEXP info,SEXP state,SEXP attr,int objf,int levs)291 ALTREP_UNSERIALIZE_EX(SEXP info, SEXP state, SEXP attr, int objf, int levs)
292 {
293 SEXP csym = ALTREP_SERIALIZED_CLASS_CLSSYM(info);
294 SEXP psym = ALTREP_SERIALIZED_CLASS_PKGSYM(info);
295 int type = ALTREP_SERIALIZED_CLASS_TYPE(info);
296
297 /* look up the class in the registry and handle failure */
298 SEXP class = ALTREP_UNSERIALIZE_CLASS(info);
299 if (class == NULL) {
300 switch(type) {
301 case LGLSXP:
302 case INTSXP:
303 case REALSXP:
304 case CPLXSXP:
305 case STRSXP:
306 case RAWSXP:
307 case VECSXP:
308 case EXPRSXP:
309 warning("cannot unserialize ALTVEC object of class '%s' from "
310 "package '%s'; returning length zero vector",
311 CHAR(PRINTNAME(csym)), CHAR(PRINTNAME(psym)));
312 return allocVector(type, 0);
313 default:
314 error("cannot unserialize this ALTREP object");
315 }
316 }
317
318 /* check the registered and unserialized types match */
319 int rtype = ALTREP_CLASS_BASE_TYPE(class);
320 if (type != rtype)
321 warning("serialized class '%s' from package '%s' has type %s; "
322 "registered class has type %s",
323 CHAR(PRINTNAME(csym)), CHAR(PRINTNAME(psym)),
324 type2char(type), type2char(rtype));
325
326 /* dispatch to a class method */
327 altrep_methods_t *m = CLASS_METHODS_TABLE(class);
328 SEXP val = m->UnserializeEX(class, state, attr, objf, levs);
329 return val;
330 }
331
ALTREP_LENGTH(SEXP x)332 R_xlen_t /*attribute_hidden*/ ALTREP_LENGTH(SEXP x)
333 {
334 return ALTREP_DISPATCH(Length, x);
335 }
336
ALTREP_TRUELENGTH(SEXP x)337 R_xlen_t /*attribute_hidden*/ ALTREP_TRUELENGTH(SEXP x) { return 0; }
338
339
340 /*
341 * Generic ALTVEC support
342 */
343
ALTVEC_DATAPTR_EX(SEXP x,Rboolean writeable)344 static R_INLINE void *ALTVEC_DATAPTR_EX(SEXP x, Rboolean writeable)
345 {
346 /**** move GC disabling into methods? */
347 if (R_in_gc)
348 error("cannot get ALTVEC DATAPTR during GC");
349 R_CHECK_THREAD;
350 int enabled = R_GCEnabled;
351 R_GCEnabled = FALSE;
352
353 void *val = ALTVEC_DISPATCH(Dataptr, x, writeable);
354
355 R_GCEnabled = enabled;
356 return val;
357 }
358
ALTVEC_DATAPTR(SEXP x)359 void /*attribute_hidden*/ *ALTVEC_DATAPTR(SEXP x)
360 {
361 return ALTVEC_DATAPTR_EX(x, TRUE);
362 }
363
ALTVEC_DATAPTR_RO(SEXP x)364 const void /*attribute_hidden*/ *ALTVEC_DATAPTR_RO(SEXP x)
365 {
366 return ALTVEC_DATAPTR_EX(x, FALSE);
367 }
368
ALTVEC_DATAPTR_OR_NULL(SEXP x)369 const void /*attribute_hidden*/ *ALTVEC_DATAPTR_OR_NULL(SEXP x)
370 {
371 return ALTVEC_DISPATCH(Dataptr_or_null, x);
372 }
373
ALTVEC_EXTRACT_SUBSET(SEXP x,SEXP indx,SEXP call)374 SEXP attribute_hidden ALTVEC_EXTRACT_SUBSET(SEXP x, SEXP indx, SEXP call)
375 {
376 return ALTVEC_DISPATCH(Extract_subset, x, indx, call);
377 }
378
379
380 /*
381 * Typed ALTVEC support
382 */
383
ALTINTEGER_ELT(SEXP x,R_xlen_t i)384 int attribute_hidden ALTINTEGER_ELT(SEXP x, R_xlen_t i)
385 {
386 return ALTINTEGER_DISPATCH(Elt, x, i);
387 }
388
INTEGER_GET_REGION(SEXP sx,R_xlen_t i,R_xlen_t n,int * buf)389 R_xlen_t INTEGER_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
390 {
391 const int *x = INTEGER_OR_NULL(sx);
392 if (x != NULL) {
393 R_xlen_t size = XLENGTH(sx);
394 R_xlen_t ncopy = size - i > n ? n : size - i;
395 for (R_xlen_t k = 0; k < ncopy; k++)
396 buf[k] = x[k + i];
397 //memcpy(buf, x + i, ncopy * sizeof(int));
398 return ncopy;
399 }
400 else
401 return ALTINTEGER_DISPATCH(Get_region, sx, i, n, buf);
402 }
403
INTEGER_IS_SORTED(SEXP x)404 int INTEGER_IS_SORTED(SEXP x)
405 {
406 return ALTREP(x) ? ALTINTEGER_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;
407 }
408
INTEGER_NO_NA(SEXP x)409 int INTEGER_NO_NA(SEXP x)
410 {
411 return ALTREP(x) ? ALTINTEGER_DISPATCH(No_NA, x) : 0;
412 }
413
ALTREAL_ELT(SEXP x,R_xlen_t i)414 double attribute_hidden ALTREAL_ELT(SEXP x, R_xlen_t i)
415 {
416 return ALTREAL_DISPATCH(Elt, x, i);
417 }
418
REAL_GET_REGION(SEXP sx,R_xlen_t i,R_xlen_t n,double * buf)419 R_xlen_t REAL_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, double *buf)
420 {
421 const double *x = REAL_OR_NULL(sx);
422 if (x != NULL) {
423 R_xlen_t size = XLENGTH(sx);
424 R_xlen_t ncopy = size - i > n ? n : size - i;
425 for (R_xlen_t k = 0; k < ncopy; k++)
426 buf[k] = x[k + i];
427 //memcpy(buf, x + i, ncopy * sizeof(double));
428 return ncopy;
429 }
430 else
431 return ALTREAL_DISPATCH(Get_region, sx, i, n, buf);
432 }
433
REAL_IS_SORTED(SEXP x)434 int REAL_IS_SORTED(SEXP x)
435 {
436 return ALTREP(x) ? ALTREAL_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;
437 }
438
REAL_NO_NA(SEXP x)439 int REAL_NO_NA(SEXP x)
440 {
441 return ALTREP(x) ? ALTREAL_DISPATCH(No_NA, x) : 0;
442 }
443
LOGICAL_GET_REGION(SEXP sx,R_xlen_t i,R_xlen_t n,int * buf)444 R_xlen_t LOGICAL_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
445 {
446 const int *x = DATAPTR_OR_NULL(sx);
447 if (x != NULL) {
448 R_xlen_t size = XLENGTH(sx);
449 R_xlen_t ncopy = size - i > n ? n : size - i;
450 for (R_xlen_t k = 0; k < ncopy; k++)
451 buf[k] = x[k + i];
452 //memcpy(buf, x + i, ncopy * sizeof(int));
453 return ncopy;
454 }
455 else
456 return ALTLOGICAL_DISPATCH(Get_region, sx, i, n, buf);
457 }
458
LOGICAL_IS_SORTED(SEXP x)459 int LOGICAL_IS_SORTED(SEXP x)
460 {
461 return ALTREP(x) ? ALTLOGICAL_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;
462 }
463
464
LOGICAL_NO_NA(SEXP x)465 int LOGICAL_NO_NA(SEXP x)
466 {
467 return ALTREP(x) ? ALTLOGICAL_DISPATCH(No_NA, x) : 0;
468 }
469
470
RAW_GET_REGION(SEXP sx,R_xlen_t i,R_xlen_t n,Rbyte * buf)471 R_xlen_t RAW_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, Rbyte *buf)
472 {
473 const Rbyte *x = DATAPTR_OR_NULL(sx);
474 if (x != NULL) {
475 R_xlen_t size = XLENGTH(sx);
476 R_xlen_t ncopy = size - i > n ? n : size - i;
477 for (R_xlen_t k = 0; k < ncopy; k++)
478 buf[k] = x[k + i];
479 //memcpy(buf, x + i, ncopy * sizeof(int));
480 return ncopy;
481 }
482 else
483 return ALTRAW_DISPATCH(Get_region, sx, i, n, buf);
484 }
485
486
COMPLEX_GET_REGION(SEXP sx,R_xlen_t i,R_xlen_t n,Rcomplex * buf)487 R_xlen_t COMPLEX_GET_REGION(SEXP sx, R_xlen_t i, R_xlen_t n, Rcomplex *buf)
488 {
489 const Rcomplex *x = DATAPTR_OR_NULL(sx);
490 if (x != NULL) {
491 R_xlen_t size = XLENGTH(sx);
492 R_xlen_t ncopy = size - i > n ? n : size - i;
493 for (R_xlen_t k = 0; k < ncopy; k++)
494 buf[k] = x[k + i];
495 //memcpy(buf, x + i, ncopy * sizeof(int));
496 return ncopy;
497 }
498 else
499 return ALTCOMPLEX_DISPATCH(Get_region, sx, i, n, buf);
500 }
501
502
ALTSTRING_ELT(SEXP x,R_xlen_t i)503 SEXP /*attribute_hidden*/ ALTSTRING_ELT(SEXP x, R_xlen_t i)
504 {
505 SEXP val = NULL;
506
507 /**** move GC disabling into method? */
508 if (R_in_gc)
509 error("cannot get ALTSTRING_ELT during GC");
510 R_CHECK_THREAD;
511 int enabled = R_GCEnabled;
512 R_GCEnabled = FALSE;
513
514 val = ALTSTRING_DISPATCH(Elt, x, i);
515
516 R_GCEnabled = enabled;
517 return val;
518 }
519
ALTSTRING_SET_ELT(SEXP x,R_xlen_t i,SEXP v)520 void attribute_hidden ALTSTRING_SET_ELT(SEXP x, R_xlen_t i, SEXP v)
521 {
522 /**** move GC disabling into method? */
523 if (R_in_gc)
524 error("cannot set ALTSTRING_ELT during GC");
525 R_CHECK_THREAD;
526 int enabled = R_GCEnabled;
527 R_GCEnabled = FALSE;
528
529 ALTSTRING_DISPATCH(Set_elt, x, i, v);
530
531 R_GCEnabled = enabled;
532 }
533
STRING_IS_SORTED(SEXP x)534 int STRING_IS_SORTED(SEXP x)
535 {
536 return ALTREP(x) ? ALTSTRING_DISPATCH(Is_sorted, x) : UNKNOWN_SORTEDNESS;
537 }
538
STRING_NO_NA(SEXP x)539 int STRING_NO_NA(SEXP x)
540 {
541 return ALTREP(x) ? ALTSTRING_DISPATCH(No_NA, x) : 0;
542 }
543
ALTINTEGER_SUM(SEXP x,Rboolean narm)544 SEXP ALTINTEGER_SUM(SEXP x, Rboolean narm)
545 {
546 return ALTINTEGER_DISPATCH(Sum, x, narm);
547 }
548
ALTINTEGER_MIN(SEXP x,Rboolean narm)549 SEXP ALTINTEGER_MIN(SEXP x, Rboolean narm)
550 {
551 return ALTINTEGER_DISPATCH(Min, x, narm);
552 }
553
ALTINTEGER_MAX(SEXP x,Rboolean narm)554 SEXP ALTINTEGER_MAX(SEXP x, Rboolean narm)
555 {
556 return ALTINTEGER_DISPATCH(Max, x, narm);
557
558 }
559
ALTREAL_SUM(SEXP x,Rboolean narm)560 SEXP ALTREAL_SUM(SEXP x, Rboolean narm)
561 {
562 return ALTREAL_DISPATCH(Sum, x, narm);
563 }
564
ALTREAL_MIN(SEXP x,Rboolean narm)565 SEXP ALTREAL_MIN(SEXP x, Rboolean narm)
566 {
567 return ALTREAL_DISPATCH(Min, x, narm);
568 }
569
ALTREAL_MAX(SEXP x,Rboolean narm)570 SEXP ALTREAL_MAX(SEXP x, Rboolean narm)
571 {
572 return ALTREAL_DISPATCH(Max, x, narm);
573
574 }
575
ALTLOGICAL_SUM(SEXP x,Rboolean narm)576 SEXP ALTLOGICAL_SUM(SEXP x, Rboolean narm)
577 {
578 return ALTLOGICAL_DISPATCH(Sum, x, narm);
579 }
580
ALTLOGICAL_ELT(SEXP x,R_xlen_t i)581 int attribute_hidden ALTLOGICAL_ELT(SEXP x, R_xlen_t i)
582 {
583 return ALTLOGICAL_DISPATCH(Elt, x, i);
584 }
585
ALTCOMPLEX_ELT(SEXP x,R_xlen_t i)586 Rcomplex attribute_hidden ALTCOMPLEX_ELT(SEXP x, R_xlen_t i)
587 {
588 return ALTCOMPLEX_DISPATCH(Elt, x, i);
589 }
590
ALTRAW_ELT(SEXP x,R_xlen_t i)591 Rbyte attribute_hidden ALTRAW_ELT(SEXP x, R_xlen_t i)
592 {
593 return ALTRAW_DISPATCH(Elt, x, i);
594 }
595
596
597 /*
598 * Not yet implemented
599 */
600
ALTINTEGER_SET_ELT(SEXP x,R_xlen_t i,int v)601 void ALTINTEGER_SET_ELT(SEXP x, R_xlen_t i, int v)
602 {
603 INTEGER(x)[i] = v; /* dispatch here */
604 }
605
ALTLOGICAL_SET_ELT(SEXP x,R_xlen_t i,int v)606 void ALTLOGICAL_SET_ELT(SEXP x, R_xlen_t i, int v)
607 {
608 LOGICAL(x)[i] = v; /* dispatch here */
609 }
610
ALTREAL_SET_ELT(SEXP x,R_xlen_t i,double v)611 void ALTREAL_SET_ELT(SEXP x, R_xlen_t i, double v)
612 {
613 REAL(x)[i] = v; /* dispatch here */
614 }
615
ALTCOMPLEX_SET_ELT(SEXP x,R_xlen_t i,Rcomplex v)616 void ALTCOMPLEX_SET_ELT(SEXP x, R_xlen_t i, Rcomplex v)
617 {
618 COMPLEX(x)[i] = v; /* dispatch here */
619 }
620
ALTRAW_SET_ELT(SEXP x,R_xlen_t i,Rbyte v)621 void ALTRAW_SET_ELT(SEXP x, R_xlen_t i, Rbyte v)
622 {
623 RAW(x)[i] = v; /* dispatch here */
624 }
625
626
627 /**
628 ** ALTREP Default Methods
629 **/
630
altrep_UnserializeEX_default(SEXP class,SEXP state,SEXP attr,int objf,int levs)631 static SEXP altrep_UnserializeEX_default(SEXP class, SEXP state, SEXP attr,
632 int objf, int levs)
633 {
634 altrep_methods_t *m = CLASS_METHODS_TABLE(class);
635 SEXP val = m->Unserialize(class, state);
636 SET_ATTRIB(val, attr);
637 SET_OBJECT(val, objf);
638 SETLEVELS(val, levs);
639 return val;
640 }
641
altrep_Serialized_state_default(SEXP x)642 static SEXP altrep_Serialized_state_default(SEXP x) { return NULL; }
643
altrep_Unserialize_default(SEXP class,SEXP state)644 static SEXP altrep_Unserialize_default(SEXP class, SEXP state)
645 {
646 error("cannot unserialize this ALTREP object yet");
647 }
648
altrep_Coerce_default(SEXP x,int type)649 static SEXP altrep_Coerce_default(SEXP x, int type) { return NULL; }
650
altrep_Duplicate_default(SEXP x,Rboolean deep)651 static SEXP altrep_Duplicate_default(SEXP x, Rboolean deep)
652 {
653 return NULL;
654 }
655
altrep_DuplicateEX_default(SEXP x,Rboolean deep)656 static SEXP altrep_DuplicateEX_default(SEXP x, Rboolean deep)
657 {
658 SEXP ans = ALTREP_DUPLICATE(x, deep);
659
660 if (ans != NULL &&
661 ans != x) { /* leave attributes alone if returning original */
662 /* handle attributes generically */
663 SEXP attr = ATTRIB(x);
664 if (attr != R_NilValue) {
665 PROTECT(ans);
666 SET_ATTRIB(ans, deep ? duplicate(attr) : shallow_duplicate(attr));
667 SET_OBJECT(ans, OBJECT(x));
668 IS_S4_OBJECT(x) ? SET_S4_OBJECT(ans) : UNSET_S4_OBJECT(ans);
669 UNPROTECT(1);
670 }
671 else if (ATTRIB(ans) != R_NilValue) {
672 SET_ATTRIB(ans, R_NilValue);
673 SET_OBJECT(ans, FALSE);
674 UNSET_S4_OBJECT(ans);
675 }
676 }
677 return ans;
678 }
679
680 static
altrep_Inspect_default(SEXP x,int pre,int deep,int pvec,void (* inspect_subtree)(SEXP,int,int,int))681 Rboolean altrep_Inspect_default(SEXP x, int pre, int deep, int pvec,
682 void (*inspect_subtree)(SEXP, int, int, int))
683 {
684 return FALSE;
685 }
686
altrep_Length_default(SEXP x)687 static R_xlen_t altrep_Length_default(SEXP x)
688 {
689 ALTREP_ERROR_IN_CLASS("no ALTREP Length method defined", x);
690 }
691
altvec_Dataptr_default(SEXP x,Rboolean writeable)692 static void *altvec_Dataptr_default(SEXP x, Rboolean writeable)
693 {
694 ALTREP_ERROR_IN_CLASS("cannot access data pointer for this ALTVEC object", x);
695 }
696
altvec_Dataptr_or_null_default(SEXP x)697 static const void *altvec_Dataptr_or_null_default(SEXP x)
698 {
699 return NULL;
700 }
701
altvec_Extract_subset_default(SEXP x,SEXP indx,SEXP call)702 static SEXP altvec_Extract_subset_default(SEXP x, SEXP indx, SEXP call)
703 {
704 return NULL;
705 }
706
altinteger_Elt_default(SEXP x,R_xlen_t i)707 static int altinteger_Elt_default(SEXP x, R_xlen_t i) { return INTEGER(x)[i]; }
708
709 static R_xlen_t
altinteger_Get_region_default(SEXP sx,R_xlen_t i,R_xlen_t n,int * buf)710 altinteger_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
711 {
712 R_xlen_t size = XLENGTH(sx);
713 R_xlen_t ncopy = size - i > n ? n : size - i;
714 for (R_xlen_t k = 0; k < ncopy; k++)
715 buf[k] = INTEGER_ELT(sx, k + i);
716 return ncopy;
717 }
718
altinteger_Is_sorted_default(SEXP x)719 static int altinteger_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }
altinteger_No_NA_default(SEXP x)720 static int altinteger_No_NA_default(SEXP x) { return 0; }
721
altinteger_Sum_default(SEXP x,Rboolean narm)722 static SEXP altinteger_Sum_default(SEXP x, Rboolean narm) { return NULL; }
altinteger_Min_default(SEXP x,Rboolean narm)723 static SEXP altinteger_Min_default(SEXP x, Rboolean narm) { return NULL; }
altinteger_Max_default(SEXP x,Rboolean narm)724 static SEXP altinteger_Max_default(SEXP x, Rboolean narm) { return NULL; }
725
altreal_Elt_default(SEXP x,R_xlen_t i)726 static double altreal_Elt_default(SEXP x, R_xlen_t i) { return REAL(x)[i]; }
727
728 static R_xlen_t
altreal_Get_region_default(SEXP sx,R_xlen_t i,R_xlen_t n,double * buf)729 altreal_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, double *buf)
730 {
731 R_xlen_t size = XLENGTH(sx);
732 R_xlen_t ncopy = size - i > n ? n : size - i;
733 for (R_xlen_t k = 0; k < ncopy; k++)
734 buf[k] = REAL_ELT(sx, k + i);
735 return ncopy;
736 }
737
altreal_Is_sorted_default(SEXP x)738 static int altreal_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }
altreal_No_NA_default(SEXP x)739 static int altreal_No_NA_default(SEXP x) { return 0; }
740
altreal_Sum_default(SEXP x,Rboolean narm)741 static SEXP altreal_Sum_default(SEXP x, Rboolean narm) { return NULL; }
altreal_Min_default(SEXP x,Rboolean narm)742 static SEXP altreal_Min_default(SEXP x, Rboolean narm) { return NULL; }
altreal_Max_default(SEXP x,Rboolean narm)743 static SEXP altreal_Max_default(SEXP x, Rboolean narm) { return NULL; }
744
altlogical_Elt_default(SEXP x,R_xlen_t i)745 static int altlogical_Elt_default(SEXP x, R_xlen_t i) { return LOGICAL(x)[i]; }
746
747 static R_xlen_t
altlogical_Get_region_default(SEXP sx,R_xlen_t i,R_xlen_t n,int * buf)748 altlogical_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
749 {
750 R_xlen_t size = XLENGTH(sx);
751 R_xlen_t ncopy = size - i > n ? n : size - i;
752 for (R_xlen_t k = 0; k < ncopy; k++)
753 buf[k] = LOGICAL_ELT(sx, k + i);
754 return ncopy;
755 }
756
altlogical_Is_sorted_default(SEXP x)757 static int altlogical_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }
altlogical_No_NA_default(SEXP x)758 static int altlogical_No_NA_default(SEXP x) { return 0; }
759
altlogical_Sum_default(SEXP x,Rboolean narm)760 static SEXP altlogical_Sum_default(SEXP x, Rboolean narm) { return NULL; }
761
762
altraw_Elt_default(SEXP x,R_xlen_t i)763 static Rbyte altraw_Elt_default(SEXP x, R_xlen_t i) { return RAW(x)[i]; }
764
765 static R_xlen_t
altraw_Get_region_default(SEXP sx,R_xlen_t i,R_xlen_t n,Rbyte * buf)766 altraw_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, Rbyte *buf)
767 {
768 R_xlen_t size = XLENGTH(sx);
769 R_xlen_t ncopy = size - i > n ? n : size - i;
770 for (R_xlen_t k = 0; k < ncopy; k++)
771 buf[k] = RAW_ELT(sx, k + i);
772 return ncopy;
773 }
774
775
altcomplex_Elt_default(SEXP x,R_xlen_t i)776 static Rcomplex altcomplex_Elt_default(SEXP x, R_xlen_t i)
777 {
778 return COMPLEX(x)[i];
779 }
780
781 static R_xlen_t
altcomplex_Get_region_default(SEXP sx,R_xlen_t i,R_xlen_t n,Rcomplex * buf)782 altcomplex_Get_region_default(SEXP sx, R_xlen_t i, R_xlen_t n, Rcomplex *buf)
783 {
784 R_xlen_t size = XLENGTH(sx);
785 R_xlen_t ncopy = size - i > n ? n : size - i;
786 for (R_xlen_t k = 0; k < ncopy; k++)
787 buf[k] = COMPLEX_ELT(sx, k + i);
788 return ncopy;
789 }
790
altstring_Elt_default(SEXP x,R_xlen_t i)791 static SEXP altstring_Elt_default(SEXP x, R_xlen_t i)
792 {
793 ALTREP_ERROR_IN_CLASS("No Elt method found for ALTSTRING class", x);
794 }
795
altstring_Set_elt_default(SEXP x,R_xlen_t i,SEXP v)796 static void altstring_Set_elt_default(SEXP x, R_xlen_t i, SEXP v)
797 {
798 ALTREP_ERROR_IN_CLASS("No Set_elt found for ALTSTRING class", x);
799 }
800
altstring_Is_sorted_default(SEXP x)801 static int altstring_Is_sorted_default(SEXP x) { return UNKNOWN_SORTEDNESS; }
altstring_No_NA_default(SEXP x)802 static int altstring_No_NA_default(SEXP x) { return 0; }
803
804
805 /**
806 ** ALTREP Initial Method Tables
807 **/
808
809 static altinteger_methods_t altinteger_default_methods = {
810 .UnserializeEX = altrep_UnserializeEX_default,
811 .Unserialize = altrep_Unserialize_default,
812 .Serialized_state = altrep_Serialized_state_default,
813 .DuplicateEX = altrep_DuplicateEX_default,
814 .Duplicate = altrep_Duplicate_default,
815 .Coerce = altrep_Coerce_default,
816 .Inspect = altrep_Inspect_default,
817 .Length = altrep_Length_default,
818 .Dataptr = altvec_Dataptr_default,
819 .Dataptr_or_null = altvec_Dataptr_or_null_default,
820 .Extract_subset = altvec_Extract_subset_default,
821 .Elt = altinteger_Elt_default,
822 .Get_region = altinteger_Get_region_default,
823 .Is_sorted = altinteger_Is_sorted_default,
824 .No_NA = altinteger_No_NA_default,
825 .Sum = altinteger_Sum_default,
826 .Min = altinteger_Min_default,
827 .Max = altinteger_Max_default
828 };
829
830 static altreal_methods_t altreal_default_methods = {
831 .UnserializeEX = altrep_UnserializeEX_default,
832 .Unserialize = altrep_Unserialize_default,
833 .Serialized_state = altrep_Serialized_state_default,
834 .DuplicateEX = altrep_DuplicateEX_default,
835 .Duplicate = altrep_Duplicate_default,
836 .Coerce = altrep_Coerce_default,
837 .Inspect = altrep_Inspect_default,
838 .Length = altrep_Length_default,
839 .Dataptr = altvec_Dataptr_default,
840 .Dataptr_or_null = altvec_Dataptr_or_null_default,
841 .Extract_subset = altvec_Extract_subset_default,
842 .Elt = altreal_Elt_default,
843 .Get_region = altreal_Get_region_default,
844 .Is_sorted = altreal_Is_sorted_default,
845 .No_NA = altreal_No_NA_default,
846 .Sum = altreal_Sum_default,
847 .Min = altreal_Min_default,
848 .Max = altreal_Max_default
849 };
850
851
852 static altlogical_methods_t altlogical_default_methods = {
853 .UnserializeEX = altrep_UnserializeEX_default,
854 .Unserialize = altrep_Unserialize_default,
855 .Serialized_state = altrep_Serialized_state_default,
856 .DuplicateEX = altrep_DuplicateEX_default,
857 .Duplicate = altrep_Duplicate_default,
858 .Coerce = altrep_Coerce_default,
859 .Inspect = altrep_Inspect_default,
860 .Length = altrep_Length_default,
861 .Dataptr = altvec_Dataptr_default,
862 .Dataptr_or_null = altvec_Dataptr_or_null_default,
863 .Extract_subset = altvec_Extract_subset_default,
864 .Elt = altlogical_Elt_default,
865 .Get_region = altlogical_Get_region_default,
866 .Is_sorted = altlogical_Is_sorted_default,
867 .No_NA = altlogical_No_NA_default,
868 .Sum = altlogical_Sum_default
869 };
870
871
872 static altraw_methods_t altraw_default_methods = {
873 .UnserializeEX = altrep_UnserializeEX_default,
874 .Unserialize = altrep_Unserialize_default,
875 .Serialized_state = altrep_Serialized_state_default,
876 .DuplicateEX = altrep_DuplicateEX_default,
877 .Duplicate = altrep_Duplicate_default,
878 .Coerce = altrep_Coerce_default,
879 .Inspect = altrep_Inspect_default,
880 .Length = altrep_Length_default,
881 .Dataptr = altvec_Dataptr_default,
882 .Dataptr_or_null = altvec_Dataptr_or_null_default,
883 .Extract_subset = altvec_Extract_subset_default,
884 .Elt = altraw_Elt_default,
885 .Get_region = altraw_Get_region_default
886 };
887
888
889
890
891 static altcomplex_methods_t altcomplex_default_methods = {
892 .UnserializeEX = altrep_UnserializeEX_default,
893 .Unserialize = altrep_Unserialize_default,
894 .Serialized_state = altrep_Serialized_state_default,
895 .DuplicateEX = altrep_DuplicateEX_default,
896 .Duplicate = altrep_Duplicate_default,
897 .Coerce = altrep_Coerce_default,
898 .Inspect = altrep_Inspect_default,
899 .Length = altrep_Length_default,
900 .Dataptr = altvec_Dataptr_default,
901 .Dataptr_or_null = altvec_Dataptr_or_null_default,
902 .Extract_subset = altvec_Extract_subset_default,
903 .Elt = altcomplex_Elt_default,
904 .Get_region = altcomplex_Get_region_default
905 };
906
907
908
909 static altstring_methods_t altstring_default_methods = {
910 .UnserializeEX = altrep_UnserializeEX_default,
911 .Unserialize = altrep_Unserialize_default,
912 .Serialized_state = altrep_Serialized_state_default,
913 .DuplicateEX = altrep_DuplicateEX_default,
914 .Duplicate = altrep_Duplicate_default,
915 .Coerce = altrep_Coerce_default,
916 .Inspect = altrep_Inspect_default,
917 .Length = altrep_Length_default,
918 .Dataptr = altvec_Dataptr_default,
919 .Dataptr_or_null = altvec_Dataptr_or_null_default,
920 .Extract_subset = altvec_Extract_subset_default,
921 .Elt = altstring_Elt_default,
922 .Set_elt = altstring_Set_elt_default,
923 .Is_sorted = altstring_Is_sorted_default,
924 .No_NA = altstring_No_NA_default
925 };
926
927
928 /**
929 ** Class Constructors
930 **/
931
932 #define INIT_CLASS(cls, type) do { \
933 *((type##_methods_t *) (CLASS_METHODS_TABLE(cls))) = \
934 type##_default_methods; \
935 } while (FALSE)
936
937 #define MAKE_CLASS(var, type) do { \
938 var = allocVector(RAWSXP, sizeof(type##_methods_t)); \
939 R_PreserveObject(var); \
940 INIT_CLASS(var, type); \
941 } while (FALSE)
942
R_cast_altrep_class(SEXP x)943 static R_INLINE R_altrep_class_t R_cast_altrep_class(SEXP x)
944 {
945 /**** some king of optional check? */
946 R_altrep_class_t val = R_SUBTYPE_INIT(x);
947 return val;
948 }
949
950 static R_altrep_class_t
make_altrep_class(int type,const char * cname,const char * pname,DllInfo * dll)951 make_altrep_class(int type, const char *cname, const char *pname, DllInfo *dll)
952 {
953 SEXP class;
954 switch(type) {
955 case INTSXP: MAKE_CLASS(class, altinteger); break;
956 case REALSXP: MAKE_CLASS(class, altreal); break;
957 case LGLSXP: MAKE_CLASS(class, altlogical); break;
958 case RAWSXP: MAKE_CLASS(class, altraw); break;
959 case CPLXSXP: MAKE_CLASS(class, altcomplex); break;
960 case STRSXP: MAKE_CLASS(class, altstring); break;
961 default: error("unsupported ALTREP class");
962 }
963 RegisterClass(class, type, cname, pname, dll);
964 return R_cast_altrep_class(class);
965 }
966
967 /* Using macros like this makes it easier to add new methods, but
968 makes searching for source harder. Probably a good idea on
969 balance though. */
970 #define DEFINE_CLASS_CONSTRUCTOR(cls, type) \
971 R_altrep_class_t R_make_##cls##_class(const char *cname, \
972 const char *pname, \
973 DllInfo *dll) \
974 { \
975 return make_altrep_class(type, cname, pname, dll); \
976 }
977
DEFINE_CLASS_CONSTRUCTOR(altstring,STRSXP)978 DEFINE_CLASS_CONSTRUCTOR(altstring, STRSXP)
979 DEFINE_CLASS_CONSTRUCTOR(altinteger, INTSXP)
980 DEFINE_CLASS_CONSTRUCTOR(altreal, REALSXP)
981 DEFINE_CLASS_CONSTRUCTOR(altlogical, LGLSXP)
982 DEFINE_CLASS_CONSTRUCTOR(altraw, RAWSXP)
983 DEFINE_CLASS_CONSTRUCTOR(altcomplex, CPLXSXP)
984
985 static void reinit_altrep_class(SEXP class)
986 {
987 switch (ALTREP_CLASS_BASE_TYPE(class)) {
988 case INTSXP: INIT_CLASS(class, altinteger); break;
989 case REALSXP: INIT_CLASS(class, altreal); break;
990 case STRSXP: INIT_CLASS(class, altstring); break;
991 case LGLSXP: INIT_CLASS(class, altlogical); break;
992 case RAWSXP: INIT_CLASS(class, altraw); break;
993 case CPLXSXP: INIT_CLASS(class, altcomplex); break;
994 default: error("unsupported ALTREP class");
995 }
996 }
997
998
999 /**
1000 ** ALTREP Method Setters
1001 **/
1002
1003 #define DEFINE_METHOD_SETTER(CNAME, MNAME) \
1004 void R_set_##CNAME##_##MNAME##_method(R_altrep_class_t cls, \
1005 R_##CNAME##_##MNAME##_method_t fun) \
1006 { \
1007 CNAME##_methods_t *m = CLASS_METHODS_TABLE(R_SEXP(cls)); \
1008 m->MNAME = fun; \
1009 }
1010
DEFINE_METHOD_SETTER(altrep,UnserializeEX)1011 DEFINE_METHOD_SETTER(altrep, UnserializeEX)
1012 DEFINE_METHOD_SETTER(altrep, Unserialize)
1013 DEFINE_METHOD_SETTER(altrep, Serialized_state)
1014 DEFINE_METHOD_SETTER(altrep, DuplicateEX)
1015 DEFINE_METHOD_SETTER(altrep, Duplicate)
1016 DEFINE_METHOD_SETTER(altrep, Coerce)
1017 DEFINE_METHOD_SETTER(altrep, Inspect)
1018 DEFINE_METHOD_SETTER(altrep, Length)
1019
1020 DEFINE_METHOD_SETTER(altvec, Dataptr)
1021 DEFINE_METHOD_SETTER(altvec, Dataptr_or_null)
1022 DEFINE_METHOD_SETTER(altvec, Extract_subset)
1023
1024 DEFINE_METHOD_SETTER(altinteger, Elt)
1025 DEFINE_METHOD_SETTER(altinteger, Get_region)
1026 DEFINE_METHOD_SETTER(altinteger, Is_sorted)
1027 DEFINE_METHOD_SETTER(altinteger, No_NA)
1028 DEFINE_METHOD_SETTER(altinteger, Sum)
1029 DEFINE_METHOD_SETTER(altinteger, Min)
1030 DEFINE_METHOD_SETTER(altinteger, Max)
1031
1032 DEFINE_METHOD_SETTER(altreal, Elt)
1033 DEFINE_METHOD_SETTER(altreal, Get_region)
1034 DEFINE_METHOD_SETTER(altreal, Is_sorted)
1035 DEFINE_METHOD_SETTER(altreal, No_NA)
1036 DEFINE_METHOD_SETTER(altreal, Sum)
1037 DEFINE_METHOD_SETTER(altreal, Min)
1038 DEFINE_METHOD_SETTER(altreal, Max)
1039
1040 DEFINE_METHOD_SETTER(altlogical, Elt)
1041 DEFINE_METHOD_SETTER(altlogical, Get_region)
1042 DEFINE_METHOD_SETTER(altlogical, Is_sorted)
1043 DEFINE_METHOD_SETTER(altlogical, No_NA)
1044 DEFINE_METHOD_SETTER(altlogical, Sum)
1045
1046 DEFINE_METHOD_SETTER(altraw, Elt)
1047 DEFINE_METHOD_SETTER(altraw, Get_region)
1048
1049 DEFINE_METHOD_SETTER(altcomplex, Elt)
1050 DEFINE_METHOD_SETTER(altcomplex, Get_region)
1051
1052 DEFINE_METHOD_SETTER(altstring, Elt)
1053 DEFINE_METHOD_SETTER(altstring, Set_elt)
1054 DEFINE_METHOD_SETTER(altstring, Is_sorted)
1055 DEFINE_METHOD_SETTER(altstring, No_NA)
1056
1057
1058 /**
1059 ** ALTREP Object Constructor and Utility Functions
1060 **/
1061
1062 SEXP R_new_altrep(R_altrep_class_t aclass, SEXP data1, SEXP data2)
1063 {
1064 SEXP sclass = R_SEXP(aclass);
1065 int type = ALTREP_CLASS_BASE_TYPE(sclass);
1066 SEXP ans = CONS(data1, data2);
1067 SET_TYPEOF(ans, type);
1068 SET_ALTREP_CLASS(ans, sclass);
1069 return ans;
1070 }
1071
R_altrep_inherits(SEXP x,R_altrep_class_t class)1072 Rboolean R_altrep_inherits(SEXP x, R_altrep_class_t class)
1073 {
1074 return ALTREP(x) && ALTREP_CLASS(x) == R_SEXP(class);
1075 }
1076
do_altrep_class(SEXP call,SEXP op,SEXP args,SEXP env)1077 SEXP attribute_hidden do_altrep_class(SEXP call, SEXP op, SEXP args, SEXP env)
1078 {
1079 checkArity(op, args);
1080 SEXP x = CAR(args);
1081 if (ALTREP(x)) {
1082 SEXP info = ALTREP_SERIALIZED_CLASS(x);
1083 SEXP val = allocVector(STRSXP, 2);
1084 SET_STRING_ELT(val, 0, PRINTNAME(ALTREP_SERIALIZED_CLASS_CLSSYM(info)));
1085 SET_STRING_ELT(val, 1, PRINTNAME(ALTREP_SERIALIZED_CLASS_PKGSYM(info)));
1086 return val;
1087 }
1088 else
1089 return R_NilValue;
1090 }
1091
1092