1 #pragma once
2
3 #include <stddef.h> // for ptrdiff_t, size_t
4
5 #include <algorithm> // for max
6 #include <array> // for array
7 #include <cstdio> // for snprintf
8 #include <exception> // for exception
9 #include <initializer_list> // for initializer_list
10 #include <iterator> // for forward_iterator_tag, random_ac...
11 #include <stdexcept> // for out_of_range
12 #include <string> // for string, basic_string
13 #include <type_traits> // for decay, is_same, enable_if, is_c...
14 #include <utility> // for declval
15
16 #include "cpp11/R.hpp" // for R_xlen_t, SEXP, SEXPREC, Rf_xle...
17 #include "cpp11/attribute_proxy.hpp" // for attribute_proxy
18 #include "cpp11/protect.hpp" // for preserved
19 #include "cpp11/r_string.hpp" // for r_string
20 #include "cpp11/sexp.hpp" // for sexp
21
22 namespace cpp11 {
23
24 using namespace cpp11::literals;
25
26 class type_error : public std::exception {
27 public:
type_error(int expected,int actual)28 type_error(int expected, int actual) : expected_(expected), actual_(actual) {}
what() const29 virtual const char* what() const noexcept override {
30 snprintf(str_, 64, "Invalid input type, expected '%s' actual '%s'",
31 Rf_type2char(expected_), Rf_type2char(actual_));
32 return str_;
33 }
34
35 private:
36 int expected_;
37 int actual_;
38 mutable char str_[64];
39 };
40
41 // Forward Declarations
42 class named_arg;
43
44 namespace writable {
45 template <typename T>
46 class r_vector;
47 } // namespace writable
48
49 // Declarations
50 template <typename T>
51 class r_vector {
52 public:
53 typedef ptrdiff_t difference_type;
54 typedef size_t size_type;
55 typedef T value_type;
56 typedef T* pointer;
57 typedef T& reference;
58
59 r_vector() noexcept = default;
60
61 r_vector(SEXP data);
62
63 r_vector(SEXP data, bool is_altrep);
64
65 #ifdef LONG_VECTOR_SUPPORT
66 T operator[](const int pos) const;
67 T at(const int pos) const;
68 #endif
69 T operator[](const R_xlen_t pos) const;
70 T operator[](const size_type pos) const;
71 T operator[](const r_string& name) const;
72
73 T at(const R_xlen_t pos) const;
74 T at(const size_type pos) const;
75 T at(const r_string& name) const;
76
77 bool contains(const r_string& name) const;
78
operator =(const r_vector & rhs)79 r_vector& operator=(const r_vector& rhs) {
80 SEXP old_protect = protect_;
81
82 data_ = rhs.data_;
83 protect_ = preserved.insert(data_);
84 is_altrep_ = rhs.is_altrep_;
85 data_p_ = rhs.data_p_;
86 length_ = rhs.length_;
87
88 preserved.release(old_protect);
89
90 return *this;
91 };
92
r_vector(const r_vector & rhs)93 r_vector(const r_vector& rhs) {
94 SEXP old_protect = protect_;
95
96 data_ = rhs.data_;
97 protect_ = preserved.insert(data_);
98 is_altrep_ = rhs.is_altrep_;
99 data_p_ = rhs.data_p_;
100 length_ = rhs.length_;
101
102 preserved.release(old_protect);
103 };
104
r_vector(const writable::r_vector<T> & rhs)105 r_vector(const writable::r_vector<T>& rhs) : r_vector(static_cast<SEXP>(rhs)) {}
106 r_vector(named_arg) = delete;
107
108 bool is_altrep() const;
109
110 bool named() const;
111
112 R_xlen_t size() const;
113
114 operator SEXP() const;
115
116 operator sexp() const;
117
118 bool empty() const;
119
120 /// Provide access to the underlying data, mainly for interface
121 /// compatibility with std::vector
122 SEXP data() const;
123
attr(const char * name) const124 const sexp attr(const char* name) const {
125 return SEXP(attribute_proxy<r_vector<T>>(*this, name));
126 }
127
attr(const std::string & name) const128 const sexp attr(const std::string& name) const {
129 return SEXP(attribute_proxy<r_vector<T>>(*this, name.c_str()));
130 }
131
attr(SEXP name) const132 const sexp attr(SEXP name) const {
133 return SEXP(attribute_proxy<r_vector<T>>(*this, name));
134 }
135
names() const136 r_vector<r_string> names() const {
137 SEXP nms = SEXP(Rf_getAttrib(data_, R_NamesSymbol));
138 if (nms == R_NilValue) {
139 return r_vector<r_string>();
140 }
141
142 return r_vector<r_string>(nms);
143 }
144
145 class const_iterator {
146 public:
147 using difference_type = ptrdiff_t;
148 using value_type = T;
149 using pointer = T*;
150 using reference = T&;
151 using iterator_category = std::random_access_iterator_tag;
152
153 const_iterator(const r_vector* data, R_xlen_t pos);
154
155 inline const_iterator operator+(R_xlen_t pos);
156 inline ptrdiff_t operator-(const const_iterator& other) const;
157
158 inline const_iterator& operator++();
159 inline const_iterator& operator--();
160
161 inline const_iterator& operator+=(R_xlen_t pos);
162 inline const_iterator& operator-=(R_xlen_t pos);
163
164 inline bool operator!=(const const_iterator& other) const;
165 inline bool operator==(const const_iterator& other) const;
166
167 inline T operator*() const;
168
169 friend class writable::r_vector<T>::iterator;
170
171 private:
172 const r_vector* data_;
173 void fill_buf(R_xlen_t pos);
174
175 R_xlen_t pos_;
176 std::array<T, 64 * 64> buf_;
177 R_xlen_t block_start_ = 0;
178 R_xlen_t length_ = 0;
179 };
180
181 public:
182 const_iterator begin() const;
183 const_iterator end() const;
184
185 const_iterator cbegin() const;
186 const_iterator cend() const;
187
188 const_iterator find(const r_string& name) const;
189
~r_vector()190 ~r_vector() { preserved.release(protect_); }
191
192 private:
193 SEXP data_ = R_NilValue;
194 SEXP protect_ = R_NilValue;
195 bool is_altrep_ = false;
196 T* data_p_ = nullptr;
197 R_xlen_t length_ = 0;
198
199 static T* get_p(bool is_altrep, SEXP data);
200
201 static SEXP valid_type(SEXP data);
202
203 friend class writable::r_vector<T>;
204 };
205
206 namespace writable {
207
208 template <typename T>
209 using has_begin_fun = std::decay<decltype(*begin(std::declval<T>()))>;
210
211 /// Read/write access to new or copied r_vectors
212 template <typename T>
213 class r_vector : public cpp11::r_vector<T> {
214 private:
215 SEXP protect_ = R_NilValue;
216
217 // These are necessary because type names are not directly accessible in
218 // template inheritance
219 using cpp11::r_vector<T>::data_;
220 using cpp11::r_vector<T>::data_p_;
221 using cpp11::r_vector<T>::is_altrep_;
222 using cpp11::r_vector<T>::length_;
223
224 R_xlen_t capacity_ = 0;
225
226 public:
227 class proxy {
228 private:
229 const SEXP data_;
230 const R_xlen_t index_;
231 T* const p_;
232 bool is_altrep_;
233
234 public:
235 proxy(SEXP data, const R_xlen_t index, T* const p, bool is_altrep);
236
237 proxy& operator=(const T& rhs);
238 proxy& operator+=(const T& rhs);
239 proxy& operator-=(const T& rhs);
240 proxy& operator*=(const T& rhs);
241 proxy& operator/=(const T& rhs);
242 proxy& operator++(int);
243 proxy& operator--(int);
244
245 void operator++();
246 void operator--();
247
248 operator T() const;
249 };
250
251 typedef ptrdiff_t difference_type;
252 typedef size_t size_type;
253 typedef proxy value_type;
254 typedef proxy* pointer;
255 typedef proxy& reference;
256
257 class iterator : public cpp11::r_vector<T>::const_iterator {
258 private:
259 const r_vector& data_;
260 using cpp11::r_vector<T>::const_iterator::block_start_;
261 using cpp11::r_vector<T>::const_iterator::pos_;
262 using cpp11::r_vector<T>::const_iterator::buf_;
263 using cpp11::r_vector<T>::const_iterator::length_;
264 using cpp11::r_vector<T>::const_iterator::fill_buf;
265
266 public:
267 using difference_type = ptrdiff_t;
268 using value_type = proxy;
269 using pointer = proxy*;
270 using reference = proxy&;
271 using iterator_category = std::forward_iterator_tag;
272
273 iterator(const r_vector& data, R_xlen_t pos);
274
275 inline iterator& operator++();
276
277 inline proxy operator*() const;
278
279 using cpp11::r_vector<T>::const_iterator::operator!=;
280
281 inline iterator& operator+=(R_xlen_t rhs);
282 inline iterator operator+(R_xlen_t rhs);
283 };
284
285 r_vector() noexcept = default;
286 r_vector(const SEXP& data);
287 r_vector(SEXP&& data);
288 r_vector(const SEXP& data, bool is_altrep);
289 r_vector(SEXP&& data, bool is_altrep);
290 r_vector(std::initializer_list<T> il);
291 r_vector(std::initializer_list<named_arg> il);
292
293 template <typename Iter>
294 r_vector(Iter first, Iter last);
295
296 template <typename V, typename W = has_begin_fun<V>>
297 r_vector(const V& obj);
298
299 explicit r_vector(const R_xlen_t size);
300
301 ~r_vector();
302
303 r_vector(const r_vector& rhs);
304 r_vector(r_vector&& rhs);
305
306 r_vector(const cpp11::r_vector<T>& rhs);
307
308 r_vector& operator=(const r_vector& rhs);
309 r_vector& operator=(r_vector&& rhs);
310
311 #ifdef LONG_VECTOR_SUPPORT
312 proxy operator[](const int pos) const;
313 proxy at(const int pos) const;
314 #endif
315 proxy operator[](const R_xlen_t pos) const;
316 proxy operator[](const size_type pos) const;
317 proxy operator[](const r_string& name) const;
318
319 proxy at(const R_xlen_t pos) const;
320 proxy at(const size_type pos) const;
321 proxy at(const r_string& name) const;
322
323 void push_back(T value);
324 void push_back(const named_arg& value);
325 void pop_back();
326
327 void resize(R_xlen_t count);
328
329 void reserve(R_xlen_t new_capacity);
330
331 iterator insert(R_xlen_t pos, T value);
332 iterator erase(R_xlen_t pos);
333
334 void clear();
335
336 iterator begin() const;
337 iterator end() const;
338
339 using cpp11::r_vector<T>::cbegin;
340 using cpp11::r_vector<T>::cend;
341 using cpp11::r_vector<T>::size;
342
343 iterator find(const r_string& name) const;
344
attr(const char * name) const345 attribute_proxy<r_vector<T>> attr(const char* name) const {
346 return attribute_proxy<r_vector<T>>(*this, name);
347 }
348
attr(const std::string & name) const349 attribute_proxy<r_vector<T>> attr(const std::string& name) const {
350 return attribute_proxy<r_vector<T>>(*this, name.c_str());
351 }
352
attr(SEXP name) const353 attribute_proxy<r_vector<T>> attr(SEXP name) const {
354 return attribute_proxy<r_vector<T>>(*this, name);
355 }
356
names() const357 attribute_proxy<r_vector<T>> names() const {
358 return attribute_proxy<r_vector<T>>(*this, R_NamesSymbol);
359 }
360
361 operator SEXP() const;
362 };
363 } // namespace writable
364
365 // Implementations below
366
367 template <typename T>
r_vector(const SEXP data)368 inline r_vector<T>::r_vector(const SEXP data)
369 : data_(valid_type(data)),
370 protect_(preserved.insert(data)),
371 is_altrep_(ALTREP(data)),
372 data_p_(get_p(ALTREP(data), data)),
373 length_(Rf_xlength(data)) {}
374
375 template <typename T>
r_vector(const SEXP data,bool is_altrep)376 inline r_vector<T>::r_vector(const SEXP data, bool is_altrep)
377 : data_(valid_type(data)),
378 protect_(preserved.insert(data)),
379 is_altrep_(is_altrep),
380 data_p_(get_p(is_altrep, data)),
381 length_(Rf_xlength(data)) {}
382
383 template <typename T>
is_altrep() const384 inline bool r_vector<T>::is_altrep() const {
385 return is_altrep_;
386 }
387
388 template <typename T>
named() const389 inline bool r_vector<T>::named() const {
390 return Rf_getAttrib(data_, R_NamesSymbol) != R_NilValue;
391 }
392
393 template <typename T>
size() const394 inline R_xlen_t r_vector<T>::size() const {
395 return length_;
396 }
397
398 template <typename T>
operator SEXP() const399 inline r_vector<T>::operator SEXP() const {
400 return data_;
401 }
402
403 template <typename T>
empty() const404 inline bool r_vector<T>::empty() const {
405 return (!(this->size() > 0));
406 }
407
408 template <typename T>
operator sexp() const409 inline r_vector<T>::operator sexp() const {
410 return data_;
411 }
412
413 /// Provide access to the underlying data, mainly for interface
414 /// compatibility with std::vector
415 template <typename T>
data() const416 inline SEXP r_vector<T>::data() const {
417 return data_;
418 }
419
420 template <typename T>
begin() const421 inline typename r_vector<T>::const_iterator r_vector<T>::begin() const {
422 return const_iterator(this, 0);
423 }
424
425 template <typename T>
end() const426 inline typename r_vector<T>::const_iterator r_vector<T>::end() const {
427 return const_iterator(this, length_);
428 }
429
430 template <typename T>
cbegin() const431 inline typename r_vector<T>::const_iterator r_vector<T>::cbegin() const {
432 return const_iterator(this, 0);
433 }
434
435 template <typename T>
cend() const436 inline typename r_vector<T>::const_iterator r_vector<T>::cend() const {
437 return const_iterator(this, length_);
438 }
439
440 template <typename T>
const_iterator(const r_vector * data,R_xlen_t pos)441 r_vector<T>::const_iterator::const_iterator(const r_vector* data, R_xlen_t pos)
442 : data_(data), pos_(pos), buf_() {
443 if (data_->is_altrep()) {
444 fill_buf(pos);
445 }
446 }
447
448 template <typename T>
operator ++()449 inline typename r_vector<T>::const_iterator& r_vector<T>::const_iterator::operator++() {
450 ++pos_;
451 if (data_->is_altrep() && pos_ >= block_start_ + length_) {
452 fill_buf(pos_);
453 }
454 return *this;
455 }
456
457 template <typename T>
operator --()458 inline typename r_vector<T>::const_iterator& r_vector<T>::const_iterator::operator--() {
459 --pos_;
460 if (data_->is_altrep() && pos_ > 0 && pos_ < block_start_) {
461 fill_buf(std::max(0_xl, pos_ - 64));
462 }
463 return *this;
464 }
465
466 template <typename T>
operator +=(R_xlen_t i)467 inline typename r_vector<T>::const_iterator& r_vector<T>::const_iterator::operator+=(
468 R_xlen_t i) {
469 pos_ += i;
470 if (data_->is_altrep() && pos_ >= block_start_ + length_) {
471 fill_buf(pos_);
472 }
473 return *this;
474 }
475
476 template <typename T>
operator -=(R_xlen_t i)477 inline typename r_vector<T>::const_iterator& r_vector<T>::const_iterator::operator-=(
478 R_xlen_t i) {
479 pos_ -= i;
480 if (data_->is_altrep() && pos_ >= block_start_ + length_) {
481 fill_buf(std::max(0_xl, pos_ - 64));
482 }
483 return *this;
484 }
485
486 template <typename T>
operator !=(const r_vector<T>::const_iterator & other) const487 inline bool r_vector<T>::const_iterator::operator!=(
488 const r_vector<T>::const_iterator& other) const {
489 return pos_ != other.pos_;
490 }
491
492 template <typename T>
operator ==(const r_vector<T>::const_iterator & other) const493 inline bool r_vector<T>::const_iterator::operator==(
494 const r_vector<T>::const_iterator& other) const {
495 return pos_ == other.pos_;
496 }
497
498 template <typename T>
operator -(const r_vector<T>::const_iterator & other) const499 inline ptrdiff_t r_vector<T>::const_iterator::operator-(
500 const r_vector<T>::const_iterator& other) const {
501 return pos_ - other.pos_;
502 }
503
504 template <typename T>
operator +(R_xlen_t rhs)505 inline typename r_vector<T>::const_iterator r_vector<T>::const_iterator::operator+(
506 R_xlen_t rhs) {
507 auto it = *this;
508 it += rhs;
509 return it;
510 }
511
512 template <typename T>
at(R_xlen_t pos) const513 inline T cpp11::r_vector<T>::at(R_xlen_t pos) const {
514 if (pos < 0 || pos >= length_) {
515 throw std::out_of_range("r_vector");
516 }
517
518 return operator[](pos);
519 }
520
521 template <typename T>
at(size_type pos) const522 inline T cpp11::r_vector<T>::at(size_type pos) const {
523 return at(static_cast<R_xlen_t>(pos));
524 }
525
526 template <typename T>
operator [](const r_string & name) const527 inline T cpp11::r_vector<T>::operator[](const r_string& name) const {
528 SEXP names = this->names();
529 R_xlen_t size = Rf_xlength(names);
530
531 for (R_xlen_t pos = 0; pos < size; ++pos) {
532 auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
533 if (name == cur) {
534 return operator[](pos);
535 }
536 }
537
538 throw std::out_of_range("r_vector");
539 }
540
541 template <typename T>
contains(const r_string & name) const542 inline bool cpp11::r_vector<T>::contains(const r_string& name) const {
543 SEXP names = this->names();
544 R_xlen_t size = Rf_xlength(names);
545
546 for (R_xlen_t pos = 0; pos < size; ++pos) {
547 auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
548 if (name == cur) {
549 return true;
550 }
551 }
552
553 return false;
554 }
555
556 template <typename T>
find(const r_string & name) const557 inline typename cpp11::r_vector<T>::const_iterator cpp11::r_vector<T>::find(
558 const r_string& name) const {
559 SEXP names = this->names();
560 R_xlen_t size = Rf_xlength(names);
561
562 for (R_xlen_t pos = 0; pos < size; ++pos) {
563 auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
564 if (name == cur) {
565 return begin() + pos;
566 }
567 }
568
569 return end();
570 }
571
572 template <typename T>
operator *() const573 inline T r_vector<T>::const_iterator::operator*() const {
574 if (data_->is_altrep()) {
575 return buf_[pos_ - block_start_];
576 } else {
577 return data_->data_p_[pos_];
578 }
579 }
580
581 #ifdef LONG_VECTOR_SUPPORT
582 template <typename T>
operator [](const int pos) const583 inline T r_vector<T>::operator[](const int pos) const {
584 return operator[](static_cast<R_xlen_t>(pos));
585 }
586
587 template <typename T>
at(const int pos) const588 inline T r_vector<T>::at(const int pos) const {
589 return at(static_cast<R_xlen_t>(pos));
590 }
591 #endif
592
593 template <typename T>
operator [](size_type pos) const594 inline T r_vector<T>::operator[](size_type pos) const {
595 return operator[](static_cast<R_xlen_t>(pos));
596 }
597
598 namespace writable {
599
600 template <typename T>
proxy(SEXP data,const R_xlen_t index,T * const p,bool is_altrep)601 r_vector<T>::proxy::proxy(SEXP data, const R_xlen_t index, T* const p, bool is_altrep)
602 : data_(data), index_(index), p_(p), is_altrep_(is_altrep) {}
603
604 template <typename T>
operator *() const605 inline typename r_vector<T>::proxy r_vector<T>::iterator::operator*() const {
606 if (data_.is_altrep()) {
607 return proxy(data_.data(), pos_, const_cast<T*>(&buf_[pos_ - block_start_]), true);
608 } else {
609 return proxy(data_.data(), pos_,
610 data_.data_p_ != nullptr ? &data_.data_p_[pos_] : nullptr, false);
611 }
612 }
613
614 template <typename T>
iterator(const r_vector & data,R_xlen_t pos)615 r_vector<T>::iterator::iterator(const r_vector& data, R_xlen_t pos)
616 : r_vector<T>::const_iterator(&data, pos), data_(data) {}
617
618 template <typename T>
operator ++()619 inline typename r_vector<T>::iterator& r_vector<T>::iterator::operator++() {
620 ++pos_;
621 if (data_.is_altrep() && pos_ >= block_start_ + length_) {
622 fill_buf(pos_);
623 }
624 return *this;
625 }
626
627 template <typename T>
operator +=(R_xlen_t rhs)628 inline typename r_vector<T>::iterator& r_vector<T>::iterator::operator+=(R_xlen_t rhs) {
629 pos_ += rhs;
630 if (data_.is_altrep() && pos_ >= block_start_ + length_) {
631 fill_buf(pos_);
632 }
633 return *this;
634 }
635
636 template <typename T>
operator +(R_xlen_t rhs)637 inline typename r_vector<T>::iterator r_vector<T>::iterator::operator+(R_xlen_t rhs) {
638 auto it = *this;
639 it += rhs;
640 return it;
641 }
642
643 template <typename T>
begin() const644 inline typename r_vector<T>::iterator r_vector<T>::begin() const {
645 return iterator(*this, 0);
646 }
647
648 template <typename T>
end() const649 inline typename r_vector<T>::iterator r_vector<T>::end() const {
650 return iterator(*this, length_);
651 }
652
653 template <typename T>
r_vector(const SEXP & data)654 inline r_vector<T>::r_vector(const SEXP& data)
655 : cpp11::r_vector<T>(safe[Rf_shallow_duplicate](data)),
656 protect_(preserved.insert(data_)),
657 capacity_(length_) {}
658
659 template <typename T>
r_vector(const SEXP & data,bool is_altrep)660 inline r_vector<T>::r_vector(const SEXP& data, bool is_altrep)
661 : cpp11::r_vector<T>(safe[Rf_shallow_duplicate](data), is_altrep),
662 protect_(preserved.insert(data_)),
663 capacity_(length_) {}
664
665 template <typename T>
r_vector(SEXP && data)666 inline r_vector<T>::r_vector(SEXP&& data)
667 : cpp11::r_vector<T>(data), protect_(preserved.insert(data_)), capacity_(length_) {}
668
669 template <typename T>
r_vector(SEXP && data,bool is_altrep)670 inline r_vector<T>::r_vector(SEXP&& data, bool is_altrep)
671 : cpp11::r_vector<T>(data, is_altrep),
672 protect_(preserved.insert(data_)),
673 capacity_(length_) {}
674
675 template <typename T>
676 template <typename Iter>
r_vector(Iter first,Iter last)677 inline r_vector<T>::r_vector(Iter first, Iter last) : r_vector() {
678 reserve(last - first);
679 while (first != last) {
680 push_back(*first);
681 ++first;
682 }
683 }
684
685 template <typename T>
686 template <typename V, typename W>
r_vector(const V & obj)687 inline r_vector<T>::r_vector(const V& obj) : r_vector() {
688 auto first = obj.begin();
689 auto last = obj.end();
690 reserve(last - first);
691 while (first != last) {
692 push_back(*first);
693 ++first;
694 }
695 }
696
697 template <typename T>
r_vector(const R_xlen_t size)698 inline r_vector<T>::r_vector(const R_xlen_t size) : r_vector() {
699 resize(size);
700 }
701
702 template <typename T>
~r_vector()703 inline r_vector<T>::~r_vector() {
704 preserved.release(protect_);
705 }
706
707 #ifdef LONG_VECTOR_SUPPORT
708 template <typename T>
operator [](const int pos) const709 inline typename r_vector<T>::proxy r_vector<T>::operator[](const int pos) const {
710 return operator[](static_cast<R_xlen_t>(pos));
711 }
712
713 template <typename T>
at(const int pos) const714 inline typename r_vector<T>::proxy r_vector<T>::at(const int pos) const {
715 return at(static_cast<R_xlen_t>(pos));
716 }
717 #endif
718
719 template <typename T>
operator [](const R_xlen_t pos) const720 inline typename r_vector<T>::proxy r_vector<T>::operator[](const R_xlen_t pos) const {
721 if (is_altrep_) {
722 return {data_, pos, nullptr, true};
723 }
724 return {data_, pos, data_p_ != nullptr ? &data_p_[pos] : nullptr, false};
725 }
726
727 template <typename T>
operator [](size_type pos) const728 inline typename r_vector<T>::proxy r_vector<T>::operator[](size_type pos) const {
729 return operator[](static_cast<R_xlen_t>(pos));
730 }
731
732 template <typename T>
at(const R_xlen_t pos) const733 inline typename r_vector<T>::proxy r_vector<T>::at(const R_xlen_t pos) const {
734 if (pos < 0 || pos >= length_) {
735 throw std::out_of_range("r_vector");
736 }
737 return operator[](static_cast<R_xlen_t>(pos));
738 }
739
740 template <typename T>
at(size_type pos) const741 inline typename r_vector<T>::proxy r_vector<T>::at(size_type pos) const {
742 return at(static_cast<R_xlen_t>(pos));
743 }
744
745 template <typename T>
operator [](const r_string & name) const746 inline typename r_vector<T>::proxy r_vector<T>::operator[](const r_string& name) const {
747 SEXP names = PROTECT(this->names());
748 R_xlen_t size = Rf_xlength(names);
749
750 for (R_xlen_t pos = 0; pos < size; ++pos) {
751 auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
752 if (name == cur) {
753 UNPROTECT(1);
754 return operator[](pos);
755 }
756 }
757
758 UNPROTECT(1);
759 throw std::out_of_range("r_vector");
760 }
761
762 template <typename T>
at(const r_string & name) const763 inline typename r_vector<T>::proxy r_vector<T>::at(const r_string& name) const {
764 return operator[](name);
765 }
766
767 template <typename T>
find(const r_string & name) const768 inline typename r_vector<T>::iterator r_vector<T>::find(const r_string& name) const {
769 SEXP names = PROTECT(this->names());
770 R_xlen_t size = Rf_xlength(names);
771
772 for (R_xlen_t pos = 0; pos < size; ++pos) {
773 auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
774 if (name == cur) {
775 UNPROTECT(1);
776 return begin() + pos;
777 }
778 }
779
780 UNPROTECT(1);
781 return end();
782 }
783
784 template <typename T>
r_vector(const r_vector<T> & rhs)785 inline r_vector<T>::r_vector(const r_vector<T>& rhs)
786 : cpp11::r_vector<T>(safe[Rf_shallow_duplicate](rhs)),
787 protect_(preserved.insert(data_)),
788 capacity_(rhs.capacity_) {}
789
790 template <typename T>
r_vector(r_vector<T> && rhs)791 inline r_vector<T>::r_vector(r_vector<T>&& rhs)
792 : cpp11::r_vector<T>(rhs), protect_(rhs.protect_), capacity_(rhs.capacity_) {
793 rhs.data_ = R_NilValue;
794 rhs.protect_ = R_NilValue;
795 }
796
797 template <typename T>
r_vector(const cpp11::r_vector<T> & rhs)798 inline r_vector<T>::r_vector(const cpp11::r_vector<T>& rhs)
799 : cpp11::r_vector<T>(safe[Rf_shallow_duplicate](rhs)),
800 protect_(preserved.insert(data_)),
801 capacity_(rhs.length_) {}
802
803 // We don't release the old object until the end in case we throw an exception
804 // during the duplicate.
805 template <typename T>
operator =(const r_vector<T> & rhs)806 inline r_vector<T>& r_vector<T>::operator=(const r_vector<T>& rhs) {
807 if (data_ == rhs.data_) {
808 return *this;
809 }
810
811 cpp11::r_vector<T>::operator=(rhs);
812
813 auto old_protect = protect_;
814
815 data_ = safe[Rf_shallow_duplicate](rhs.data_);
816 protect_ = preserved.insert(data_);
817
818 preserved.release(old_protect);
819
820 capacity_ = rhs.capacity_;
821
822 return *this;
823 }
824
825 template <typename T>
operator =(r_vector<T> && rhs)826 inline r_vector<T>& r_vector<T>::operator=(r_vector<T>&& rhs) {
827 if (data_ == rhs.data_) {
828 return *this;
829 }
830
831 cpp11::r_vector<T>::operator=(rhs);
832
833 SEXP old_protect = protect_;
834
835 data_ = rhs.data_;
836 protect_ = preserved.insert(data_);
837
838 preserved.release(old_protect);
839
840 capacity_ = rhs.capacity_;
841
842 rhs.data_ = R_NilValue;
843 rhs.protect_ = R_NilValue;
844
845 return *this;
846 }
847
848 template <typename T>
pop_back()849 inline void r_vector<T>::pop_back() {
850 --length_;
851 }
852
853 template <typename T>
resize(R_xlen_t count)854 inline void r_vector<T>::resize(R_xlen_t count) {
855 reserve(count);
856 length_ = count;
857 }
858
859 template <typename T>
insert(R_xlen_t pos,T value)860 inline typename r_vector<T>::iterator r_vector<T>::insert(R_xlen_t pos, T value) {
861 push_back(value);
862
863 R_xlen_t i = length_ - 1;
864 while (i > pos) {
865 operator[](i) = (T) operator[](i - 1);
866 --i;
867 };
868 operator[](pos) = value;
869
870 return begin() + pos;
871 }
872
873 template <typename T>
erase(R_xlen_t pos)874 inline typename r_vector<T>::iterator r_vector<T>::erase(R_xlen_t pos) {
875 R_xlen_t i = pos;
876 while (i < length_ - 1) {
877 operator[](i) = (T) operator[](i + 1);
878 ++i;
879 }
880 pop_back();
881
882 return begin() + pos;
883 }
884
885 template <typename T>
clear()886 inline void r_vector<T>::clear() {
887 length_ = 0;
888 }
889
truncate(SEXP x,R_xlen_t length,R_xlen_t capacity)890 inline SEXP truncate(SEXP x, R_xlen_t length, R_xlen_t capacity) {
891 #if R_VERSION >= R_Version(3, 4, 0)
892 SETLENGTH(x, length);
893 SET_TRUELENGTH(x, capacity);
894 SET_GROWABLE_BIT(x);
895 #else
896 x = safe[Rf_lengthgets](x, length);
897 #endif
898 return x;
899 }
900
901 template <typename T>
operator SEXP() const902 inline r_vector<T>::operator SEXP() const {
903 auto* p = const_cast<r_vector<T>*>(this);
904 if (data_ == R_NilValue) {
905 p->resize(0);
906 return data_;
907 }
908 if (length_ < capacity_) {
909 p->data_ = truncate(p->data_, length_, capacity_);
910 SEXP nms = names();
911 auto nms_size = Rf_xlength(nms);
912 if ((nms_size > 0) && (length_ < nms_size)) {
913 nms = truncate(nms, length_, capacity_);
914 names() = nms;
915 }
916 }
917 return data_;
918 }
919
920 template <typename T>
operator +=(const T & rhs)921 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator+=(const T& rhs) {
922 operator=(static_cast<T>(*this) + rhs);
923 return *this;
924 }
925
926 template <typename T>
operator -=(const T & rhs)927 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator-=(const T& rhs) {
928 operator=(static_cast<T>(*this) - rhs);
929 return *this;
930 }
931
932 template <typename T>
operator *=(const T & rhs)933 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator*=(const T& rhs) {
934 operator=(static_cast<T>(*this) * rhs);
935 return *this;
936 }
937
938 template <typename T>
operator /=(const T & rhs)939 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator/=(const T& rhs) {
940 operator=(static_cast<T>(*this) / rhs);
941 return *this;
942 }
943
944 template <typename T>
operator ++(int)945 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator++(int) {
946 operator=(static_cast<T>(*this) + 1);
947 return *this;
948 }
949
950 template <typename T>
operator --(int)951 inline typename r_vector<T>::proxy& r_vector<T>::proxy::operator--(int) {
952 operator=(static_cast<T>(*this) - 1);
953 return *this;
954 }
955
956 template <typename T>
operator --()957 inline void r_vector<T>::proxy::operator--() {
958 operator=(static_cast<T>(*this) - 1);
959 }
960
961 template <typename T>
operator ++()962 inline void r_vector<T>::proxy::operator++() {
963 operator=(static_cast<T>(*this) + 1);
964 }
965
966 } // namespace writable
967
968 // TODO: is there a better condition we could use, e.g. assert something true
969 // rather than three things false?
970 template <typename C, typename T>
971 using is_container_but_not_sexp_or_string = typename std::enable_if<
972 !std::is_constructible<C, SEXP>::value &&
973 !std::is_same<typename std::decay<C>::type, std::string>::value &&
974 !std::is_same<typename std::decay<T>::type, std::string>::value,
975 typename std::decay<C>::type>::type;
976
977 template <typename C, typename T = typename std::decay<C>::type::value_type>
978 // typename T = typename C::value_type>
as_cpp(SEXP from)979 is_container_but_not_sexp_or_string<C, T> as_cpp(SEXP from) {
980 auto obj = cpp11::r_vector<T>(from);
981 return {obj.begin(), obj.end()};
982 }
983
984 // TODO: could we make this generalize outside of std::string?
985 template <typename C, typename T = C>
986 using is_vector_of_strings = typename std::enable_if<
987 std::is_same<typename std::decay<T>::type, std::string>::value,
988 typename std::decay<C>::type>::type;
989
990 template <typename C, typename T = typename std::decay<C>::type::value_type>
991 // typename T = typename C::value_type>
as_cpp(SEXP from)992 is_vector_of_strings<C, T> as_cpp(SEXP from) {
993 auto obj = cpp11::r_vector<cpp11::r_string>(from);
994 typename std::decay<C>::type res;
995 auto it = obj.begin();
996 while (it != obj.end()) {
997 r_string s = *it;
998 res.emplace_back(static_cast<std::string>(s));
999 ++it;
1000 }
1001 return res;
1002 }
1003
1004 template <typename T>
operator ==(const r_vector<T> & lhs,const r_vector<T> & rhs)1005 bool operator==(const r_vector<T>& lhs, const r_vector<T>& rhs) {
1006 if (lhs.size() != rhs.size()) {
1007 return false;
1008 }
1009
1010 auto lhs_it = lhs.begin();
1011 auto rhs_it = rhs.begin();
1012
1013 auto end = lhs.end();
1014 while (lhs_it != end) {
1015 if (!(*lhs_it == *rhs_it)) {
1016 return false;
1017 }
1018 ++lhs_it;
1019 ++rhs_it;
1020 }
1021 return true;
1022 }
1023
1024 template <typename T>
operator !=(const r_vector<T> & lhs,const r_vector<T> & rhs)1025 bool operator!=(const r_vector<T>& lhs, const r_vector<T>& rhs) {
1026 return !(lhs == rhs);
1027 }
1028
1029 } // namespace cpp11
1030