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