1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
// cpp11 version: 0.3.1.1
// vendored on: 2021-08-11
#pragma once
#include <initializer_list> // for initializer_list
#include "cpp11/R.hpp" // for SEXP, SEXPREC, SET_VECTOR_ELT
#include "cpp11/attribute_proxy.hpp" // for attribute_proxy
#include "cpp11/named_arg.hpp" // for named_arg
#include "cpp11/protect.hpp" // for preserved
#include "cpp11/r_string.hpp" // for r_string
#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy
#include "cpp11/sexp.hpp" // for sexp
// Specializations for list
namespace cpp11 {
template <>
inline SEXP r_vector<SEXP>::valid_type(SEXP data) {
if (TYPEOF(data) != VECSXP) {
throw type_error(VECSXP, TYPEOF(data));
}
return data;
}
template <>
inline SEXP r_vector<SEXP>::operator[](const R_xlen_t pos) const {
return VECTOR_ELT(data_, pos);
}
template <>
inline SEXP r_vector<SEXP>::operator[](const r_string& name) const {
SEXP names = this->names();
R_xlen_t size = Rf_xlength(names);
for (R_xlen_t pos = 0; pos < size; ++pos) {
auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
if (name == cur) {
return operator[](pos);
}
}
return R_NilValue;
}
template <>
inline SEXP* r_vector<SEXP>::get_p(bool, SEXP) {
return nullptr;
}
template <>
inline void r_vector<SEXP>::const_iterator::fill_buf(R_xlen_t) {
return;
}
template <>
inline SEXP r_vector<SEXP>::const_iterator::operator*() const {
return VECTOR_ELT(data_->data(), pos_);
}
typedef r_vector<SEXP> list;
namespace writable {
template <>
inline typename r_vector<SEXP>::proxy& r_vector<SEXP>::proxy::operator=(const SEXP& rhs) {
SET_VECTOR_ELT(data_, index_, rhs);
return *this;
}
template <>
inline r_vector<SEXP>::proxy::operator SEXP() const {
return VECTOR_ELT(data_, index_);
}
template <>
inline r_vector<SEXP>::r_vector(std::initializer_list<SEXP> il)
: cpp11::r_vector<SEXP>(safe[Rf_allocVector](VECSXP, il.size())),
capacity_(il.size()) {
protect_ = preserved.insert(data_);
auto it = il.begin();
for (R_xlen_t i = 0; i < capacity_; ++i, ++it) {
SET_VECTOR_ELT(data_, i, *it);
}
}
template <>
inline r_vector<SEXP>::r_vector(std::initializer_list<named_arg> il)
: cpp11::r_vector<SEXP>(safe[Rf_allocVector](VECSXP, il.size())),
capacity_(il.size()) {
protect_ = preserved.insert(data_);
int n_protected = 0;
try {
unwind_protect([&] {
Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_));
SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol));
++n_protected;
auto it = il.begin();
for (R_xlen_t i = 0; i < capacity_; ++i, ++it) {
SET_VECTOR_ELT(data_, i, it->value());
SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8));
}
UNPROTECT(n_protected);
});
} catch (const unwind_exception& e) {
preserved.release(protect_);
UNPROTECT(n_protected);
throw e;
}
}
template <>
inline void r_vector<SEXP>::reserve(R_xlen_t new_capacity) {
data_ = data_ == R_NilValue ? safe[Rf_allocVector](VECSXP, new_capacity)
: safe[Rf_xlengthgets](data_, new_capacity);
SEXP old_protect = protect_;
protect_ = preserved.insert(data_);
preserved.release(old_protect);
capacity_ = new_capacity;
}
template <>
inline void r_vector<SEXP>::push_back(SEXP value) {
while (length_ >= capacity_) {
reserve(capacity_ == 0 ? 1 : capacity_ *= 2);
}
SET_VECTOR_ELT(data_, length_, value);
++length_;
}
typedef r_vector<SEXP> list;
} // namespace writable
} // namespace cpp11
|
