Skip to content

Commit 1654200

Browse files
kondziukondziu
committed
ALTREP
1 parent 393b131 commit 1654200

File tree

7 files changed

+415
-8
lines changed

7 files changed

+415
-8
lines changed

‎ufoaltrep/NAMESPACE

+3
Original file line numberDiff line numberDiff line change
@@ -14,4 +14,7 @@ export(altrep_ufo_matrix_logical_bin)
1414
export(altrep_ufo_matrix_raw_bin)
1515
export(altrep_ufo_matrix_vector_bin)
1616

17+
export(altrep_numeric_seq)
18+
export(altrep_integer_seq)
19+
1720
export(altrep_ufo_set_debug_mode)

‎ufoaltrep/R/ufoaltrep.R

+9
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,15 @@ altrep_ufo_vector_bin <- function(type, path) {
2525
stop(paste0("Unknown UFO vector type: ", type))
2626
}
2727

28+
altrep_integer_seq <- function(from, to, by=1) {
29+
.Call("altrep_intsxp_seq", as.integer(from), as.integer(to), as.integer(by))
30+
}
31+
32+
altrep_numeric_seq <- function(from, to, by=1) {
33+
.Call("altrep_realsxp_seq", as.integer(from), as.integer(to), as.integer(by))
34+
}
35+
36+
2837
altrep_ufo_integer_bin <- function(path) {
2938
.check_path(path)
3039
.Call("altrep_ufo_vectors_intsxp_bin", path.expand(path))

‎ufoaltrep/src/altrep_seq.c

+369
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,369 @@
1+
#include <stdio.h>
2+
#include <stdlib.h>
3+
#include <stdint.h>
4+
5+
#define USE_RINTERNALS
6+
#include <R.h>
7+
#include <Rinternals.h>
8+
#include <R_ext/Altrep.h>
9+
#include <R_ext/Rallocators.h>
10+
11+
#include "metadata.h"
12+
#include "debug.h"
13+
#include "helpers.h"
14+
15+
#include "altrep_seq.h"
16+
#include "R_ext.h"
17+
18+
static R_altrep_class_t seq_integer_altrep;
19+
static R_altrep_class_t seq_numeric_altrep;
20+
21+
R_altrep_class_t __seq_get_class_from_type(SEXPTYPE type) {
22+
switch (type) {
23+
case INTSXP:
24+
return seq_integer_altrep;
25+
case REALSXP:
26+
return seq_numeric_altrep;
27+
default:
28+
Rf_error("Unrecognized vector type: %d\n", type);
29+
}
30+
}
31+
32+
void seq_finalize(SEXP wrapper) {
33+
//altrep_seq_config_t *cfg = (altrep_seq_config_t *) EXTPTR_PTR(wrapper);
34+
//fclose(cfg->file_handle);
35+
}
36+
37+
SEXP seq_new(SEXPTYPE type, int from, int to, int by) {
38+
39+
altrep_seq_config_t *cfg =
40+
(altrep_seq_config_t *) malloc(sizeof(altrep_seq_config_t));
41+
42+
cfg->to = to;
43+
cfg->from = from;
44+
cfg->by = by;
45+
cfg->type = type;
46+
cfg->size = (to - from) / by + 1;
47+
48+
SEXP wrapper = PROTECT(allocSExp(EXTPTRSXP));
49+
EXTPTR_PTR(wrapper) = (void *) cfg;
50+
EXTPTR_TAG(wrapper) = Rf_install("ALTREP SEQ CFG");
51+
52+
SEXP ans = R_new_altrep(__seq_get_class_from_type(type), wrapper, R_NilValue);
53+
EXTPTR_PROT(wrapper) = ans;
54+
55+
/* Finalizer */
56+
R_MakeWeakRefC(wrapper, R_NilValue, seq_finalize, TRUE);
57+
58+
UNPROTECT(1);
59+
return ans;
60+
}
61+
SEXP/*INTSXP*/ seq_intsxp_new(SEXP/*INTSXP*/ from, SEXP/*INTSXP*/ to, SEXP/*INTSXP*/ by) {
62+
return seq_new(INTSXP, __extract_int_or_die(from), __extract_int_or_die(to), __extract_int_or_die(by));
63+
}
64+
SEXP/*REALSXP*/ seq_realsxp_new(SEXP/*INTSXP*/ from, SEXP/*INTSXP*/ to, SEXP/*INTSXP*/ by) {
65+
return seq_new(REALSXP, __extract_int_or_die(from), __extract_int_or_die(to), __extract_int_or_die(by));
66+
}
67+
68+
// typedef struct {
69+
// SEXPTYPE type;
70+
// size_t /*aka R_len_t*/ size;
71+
// char const *path;
72+
// //size_t *dimensions;
73+
// } altrep_ufo_source_t;
74+
75+
// SEXP seq_new_wrapper(SEXPTYPE mode, R_xlen_t n, void *data) {
76+
// return seq_new(mode, (const char *) data); // TODO ?
77+
// }
78+
79+
static SEXP seq_duplicate(SEXP x, Rboolean deep) {
80+
81+
altrep_seq_config_t *new_cfg =
82+
(altrep_seq_config_t *) malloc(sizeof(altrep_seq_config_t));
83+
84+
altrep_seq_config_t *old_cfg =
85+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
86+
87+
new_cfg->to = old_cfg->to;
88+
new_cfg->from = old_cfg->from;
89+
new_cfg->by = old_cfg->by;
90+
new_cfg->type = old_cfg->type;
91+
new_cfg->size = old_cfg->size;
92+
93+
SEXP wrapper = allocSExp(EXTPTRSXP);
94+
EXTPTR_PTR(wrapper) = (void *) new_cfg;
95+
EXTPTR_TAG(wrapper) = Rf_install("ALTREP SEQ CFG");
96+
97+
if (R_altrep_data2(x) == R_NilValue) {
98+
return R_new_altrep(__seq_get_class_from_type(new_cfg->type), wrapper, R_NilValue);
99+
100+
} else {
101+
SEXP payload = PROTECT(allocVector(INTSXP, XLENGTH(R_altrep_data2(x))));
102+
103+
for (int i = 0; i < XLENGTH(R_altrep_data2(x)); i++) {
104+
INTEGER(payload)[i] = INTEGER(R_altrep_data2(x))[i];
105+
}
106+
107+
SEXP ans = R_new_altrep(__seq_get_class_from_type(new_cfg->type), wrapper, payload);
108+
UNPROTECT(1);
109+
return ans;
110+
}
111+
}
112+
113+
static Rboolean seq_inspect(SEXP x, int pre, int deep, int pvec, void (*inspect_subtree)(SEXP, int, int, int)) {
114+
115+
if (R_altrep_data1(x) == R_NilValue) {
116+
Rprintf(" seq_integer %s\n", type2char(TYPEOF(x)));
117+
} else {
118+
Rprintf(" seq_integer %s (materialized)\n", type2char(TYPEOF(x)));
119+
}
120+
121+
if (R_altrep_data1(x) != R_NilValue) {
122+
inspect_subtree(R_altrep_data1(x), pre, deep, pvec);
123+
}
124+
125+
if (R_altrep_data2(x) != R_NilValue) {
126+
inspect_subtree(R_altrep_data2(x), pre, deep, pvec);
127+
}
128+
129+
return FALSE;
130+
}
131+
132+
static R_xlen_t seq_length(SEXP x) {
133+
if (__get_debug_mode()) {
134+
Rprintf("seq_Length\n");
135+
Rprintf(" SEXP: %p\n", x);
136+
}
137+
if (R_altrep_data2(x) == R_NilValue) {
138+
altrep_seq_config_t *cfg =
139+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
140+
return cfg->size;
141+
} else {
142+
return XLENGTH(R_altrep_data2(x));
143+
}
144+
}
145+
146+
int populate_integer_seq(uint64_t startValueIdx, uint64_t endValueIdx, altrep_seq_config_t* cfg, int* target) {
147+
for (size_t i = 0; i < endValueIdx - startValueIdx; i++) {
148+
target[i] = cfg->from + cfg->by * (i + startValueIdx);
149+
}
150+
return endValueIdx - startValueIdx + 1;
151+
}
152+
153+
int populate_double_seq(uint64_t startValueIdx, uint64_t endValueIdx, altrep_seq_config_t* cfg, double* target) {
154+
for (size_t i = 0; i < endValueIdx - startValueIdx; i++) {
155+
target[i] = cfg->from + cfg->by * (i + startValueIdx);
156+
}
157+
return endValueIdx - startValueIdx + 1;
158+
}
159+
160+
int populate_seq(uint64_t startValueIdx, uint64_t endValueIdx, altrep_seq_config_t* cfg, double* target) {
161+
switch (cfg->type) {
162+
case INTSXP:
163+
return populate_integer_seq(startValueIdx, endValueIdx, cfg, target);
164+
case REALSXP:
165+
return populate_double_seq(startValueIdx, endValueIdx, cfg, target);
166+
default:
167+
Rf_error("Unrecognized vector type: %d\n", cfg->type);
168+
break;
169+
}
170+
}
171+
172+
static void __materialize_integer_data(SEXP x) {
173+
altrep_seq_config_t *cfg =
174+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
175+
SEXP payload = allocVector(INTSXP, cfg->size);
176+
PROTECT(payload);
177+
int *data = INTEGER(payload);
178+
populate_integer_seq(0, cfg->size, cfg, data);
179+
R_set_altrep_data2(x, payload);
180+
UNPROTECT(1);
181+
}
182+
183+
static void __materialize_double_data(SEXP x) {
184+
altrep_seq_config_t *cfg =
185+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
186+
SEXP payload = allocVector(REALSXP, cfg->size);
187+
PROTECT(payload);
188+
double *data = REAL(payload);
189+
populate_double_seq(0, cfg->size, cfg, data);
190+
R_set_altrep_data2(x, payload);
191+
UNPROTECT(1);
192+
}
193+
194+
static void __materialize_data(SEXP x) {
195+
altrep_seq_config_t *cfg =
196+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
197+
switch (cfg->type)
198+
{
199+
case INTSXP:
200+
__materialize_integer_data(x);
201+
break;
202+
case REALSXP:
203+
__materialize_double_data(x);
204+
break;
205+
default:
206+
Rf_error("Unrecognized vector type: %d\n", cfg->type);
207+
break;
208+
}
209+
}
210+
211+
static void *seq_dataptr(SEXP x, Rboolean writeable) {
212+
if (__get_debug_mode()) {
213+
Rprintf("seq_Dataptr\n");
214+
Rprintf(" SEXP: %p\n", x);
215+
Rprintf(" writeable: %i\n", writeable);
216+
}
217+
if (writeable) {
218+
if (R_altrep_data2(x) == R_NilValue)
219+
__materialize_data(x);
220+
return DATAPTR(R_altrep_data2(x));
221+
} else {
222+
if (R_altrep_data2(x) == R_NilValue)
223+
__materialize_data(x);
224+
return DATAPTR(R_altrep_data2(x));
225+
}
226+
}
227+
228+
static const void *seq_dataptr_or_null(SEXP x) {
229+
if (__get_debug_mode()) {
230+
Rprintf("seq_Dataptr_or_null\n");
231+
Rprintf(" SEXP: %p\n", x);
232+
}
233+
if (R_altrep_data2(x) == R_NilValue)
234+
__materialize_data(x);
235+
return DATAPTR_OR_NULL(R_altrep_data2(x));
236+
}
237+
238+
// static void ufo_seq_element(SEXP x, R_xlen_t i, void *target) {
239+
// if (__get_debug_mode()) {
240+
// Rprintf("ufo_seq_element\n");
241+
// Rprintf(" SEXP: %p\n", x);
242+
// Rprintf(" index: %li\n", i);
243+
// Rprintf(" target: %p\n", target);
244+
// }
245+
// altrep_ufo_config_t *cfg =
246+
// (altrep_ufo_config_t *) EXTPTR_PTR(R_altrep_data1(x));
247+
248+
// populate_seq(i, i+1, cfg, (char *) target);
249+
// }
250+
251+
static int seq_integer_element(SEXP x, R_xlen_t i) {
252+
if (R_altrep_data2(x) != R_NilValue)
253+
return INTEGER_ELT(R_altrep_data2(x), i);
254+
altrep_seq_config_t *cfg =
255+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
256+
return cfg->from + cfg->by * i;
257+
}
258+
259+
static double seq_numeric_element(SEXP x, R_xlen_t i) {
260+
if (R_altrep_data2(x) != R_NilValue)
261+
return REAL_ELT(R_altrep_data2(x), i);
262+
altrep_seq_config_t *cfg =
263+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
264+
return cfg->from + cfg->by * i;
265+
}
266+
267+
// static R_xlen_t ufo_seq_get_region(SEXP x, R_xlen_t i, R_xlen_t n, void *buf) {
268+
// if (__get_debug_mode()) {
269+
// Rprintf("ufo_vector_get_region\n");
270+
// Rprintf(" SEXP: %p\n", x);
271+
// Rprintf(" index: %li\n", i);
272+
// Rprintf(" length: %li\n", n);
273+
// Rprintf(" target: %p\n", buf);
274+
// }
275+
// altrep_ufo_config_t *cfg =
276+
// (altrep_ufo_config_t *) EXTPTR_PTR(R_altrep_data1(x));
277+
// Rf_error("Unimplemented!");
278+
// return __load_from_file(__get_debug_mode(), i, i+n, cfg, (char *) buf);
279+
// }
280+
281+
static R_xlen_t seq_integer_get_region(SEXP x, R_xlen_t i, R_xlen_t n, int *buf) {
282+
if (R_altrep_data2(x) == R_NilValue)
283+
return INTEGER_GET_REGION(R_altrep_data2(x), i, n, buf);
284+
285+
if (__get_debug_mode()) {
286+
Rprintf("seq_get_region\n");
287+
Rprintf(" SEXP: %p\n", x);
288+
Rprintf(" index: %li\n", i);
289+
Rprintf(" length: %li\n", n);
290+
Rprintf(" target: %p\n", buf);
291+
}
292+
altrep_seq_config_t *cfg =
293+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
294+
295+
return populate_integer_seq(i, i+n, cfg, (char *) buf);
296+
}
297+
298+
static R_xlen_t seq_numeric_get_region(SEXP x, R_xlen_t i, R_xlen_t n, double *buf) {
299+
if (R_altrep_data2(x) == R_NilValue)
300+
return REAL_GET_REGION(R_altrep_data2(x), i, n, buf);
301+
if (__get_debug_mode()) {
302+
Rprintf("seq_get_region\n");
303+
Rprintf(" SEXP: %p\n", x);
304+
Rprintf(" index: %li\n", i);
305+
Rprintf(" length: %li\n", n);
306+
Rprintf(" target: %p\n", buf);
307+
}
308+
altrep_seq_config_t *cfg =
309+
(altrep_seq_config_t *) EXTPTR_PTR(R_altrep_data1(x));
310+
311+
return populate_double_seq(i, i+n, cfg, (char *) buf);
312+
}
313+
314+
// static SEXP ufo_integer_extract_subset(SEXP x, SEXP indx, SEXP call) {
315+
// return;
316+
// }
317+
318+
319+
// UFO Inits
320+
void init_seq_integer_altrep_class(DllInfo * dll) {
321+
R_altrep_class_t cls = R_make_altinteger_class("seq_integer_altrep",
322+
"seq_altrep", dll);
323+
seq_integer_altrep = cls;
324+
325+
/* Override ALTREP methods */
326+
R_set_altrep_Duplicate_method(cls, seq_duplicate);
327+
R_set_altrep_Inspect_method(cls, seq_inspect);
328+
R_set_altrep_Length_method(cls, seq_length);
329+
330+
/* Override ALTVEC methods */
331+
R_set_altvec_Dataptr_method(cls, seq_dataptr);
332+
R_set_altvec_Dataptr_or_null_method(cls, seq_dataptr_or_null);
333+
334+
/* Override ALTINTEGER methods */
335+
R_set_altinteger_Elt_method(cls, seq_integer_element);
336+
R_set_altinteger_Get_region_method(cls, seq_integer_get_region);
337+
338+
//R_set_altinteger_Sum_method(cls, ufo_integer_sum);
339+
340+
//R_set_altvec_Extract_subset_method(cls, seq_integer_extract_subset);
341+
}
342+
343+
void init_seq_numeric_altrep_class(DllInfo * dll) {
344+
R_altrep_class_t cls = R_make_altreal_class("seq_numeric_altrep",
345+
"seq_altrep", dll);
346+
seq_numeric_altrep = cls;
347+
348+
/* Override ALTREP methods */
349+
R_set_altrep_Duplicate_method(cls, seq_duplicate);
350+
R_set_altrep_Inspect_method(cls, seq_inspect);
351+
R_set_altrep_Length_method(cls, seq_length);
352+
353+
/* Override ALTVEC methods */
354+
R_set_altvec_Dataptr_method(cls, seq_dataptr);
355+
R_set_altvec_Dataptr_or_null_method(cls, seq_dataptr_or_null);
356+
357+
/* Override ALTREAL methods */
358+
R_set_altreal_Elt_method(cls, seq_numeric_element);
359+
R_set_altreal_Get_region_method(cls, seq_numeric_get_region);
360+
361+
//R_set_altreal_Sum_method(cls, ufo_numeric_sum);
362+
}
363+
364+
// SEXP/*INTSXP*/ altrep_intsxp_seq(SEXP/*STRSXP*/ path) {
365+
// return ufo_vector_new_altrep(INTSXP, __extract_int_or_die);
366+
// }
367+
// SEXP/*REALSXP*/ altrep_realsxp_seq(SEXP/*STRSXP*/ path) {
368+
// return ufo_vector_new_altrep(REALSXP, __extract_path_or_die(path));
369+
// }

0 commit comments

Comments
 (0)