openMSX
TclObject.hh
Go to the documentation of this file.
1 #ifndef TCLOBJECT_HH
2 #define TCLOBJECT_HH
3 
4 #include "string_view.hh"
5 #include "span.hh"
6 #include "vla.hh"
7 #include "xxhash.hh"
8 #include <tcl.h>
9 #include <algorithm>
10 #include <initializer_list>
11 #include <iterator>
12 #include <cassert>
13 #include <cstdint>
14 
15 struct Tcl_Obj;
16 
17 namespace openmsx {
18 
19 class Interpreter;
20 
21 class TclObject
22 {
23  // For STL interface, see below
24  struct iterator {
25  using value_type = string_view;
26  using reference = string_view;
27  using pointer = string_view*;
28  using difference_type = ptrdiff_t;
29  using iterator_category = std::bidirectional_iterator_tag;
30 
31  iterator(const TclObject& obj_, unsigned i_)
32  : obj(&obj_), i(i_) {}
33 
34  bool operator==(const iterator& other) const {
35  assert(obj == other.obj);
36  return i == other.i;
37  }
38  bool operator!=(const iterator& other) const {
39  return !(*this == other);
40  }
41 
42  string_view operator*() const {
43  return obj->getListIndexUnchecked(i).getString();
44  }
45 
46  iterator& operator++() {
47  ++i;
48  return *this;
49  }
50  iterator operator++(int) {
51  iterator result = *this;
52  ++result;
53  return result;
54  }
55  iterator& operator--() {
56  --i;
57  return *this;
58  }
59  iterator operator--(int) {
60  iterator result = *this;
61  --result;
62  return result;
63  }
64  private:
65  const TclObject* obj;
66  unsigned i;
67  };
68 
69 public:
70 
71  TclObject() { init(Tcl_NewObj()); }
72  explicit TclObject(Tcl_Obj* o) { init(o); }
73  template<typename T> explicit TclObject(T t) { init(newObj(t)); }
74  TclObject(const TclObject& o) { init(newObj(o)); }
75  TclObject( TclObject&& o) noexcept { init(newObj(o)); }
76 
77  struct MakeListTag {};
78  template<typename... Args>
79  TclObject(MakeListTag, Args&&... args) {
80  init(newList({newObj(std::forward<Args>(args))...}));
81  }
82 
83  struct MakeDictTag {};
84  template<typename... Args>
85  TclObject(MakeDictTag, Args&&... args) {
86  init(Tcl_NewDictObj());
87  addDictKeyValues(std::forward<Args>(args)...);
88  }
89 
90  ~TclObject() { Tcl_DecrRefCount(obj); }
91 
92  // assignment operators
93  TclObject& operator=(const TclObject& other) {
94  if (&other != this) {
95  Tcl_DecrRefCount(obj);
96  init(other.obj);
97  }
98  return *this;
99  }
100  TclObject& operator=(TclObject&& other) noexcept {
101  std::swap(obj, other.obj);
102  return *this;
103  }
104  template<typename T>
106  if (Tcl_IsShared(obj)) {
107  Tcl_DecrRefCount(obj);
108  obj = newObj(t);
109  Tcl_IncrRefCount(obj);
110  } else {
111  assign(t);
112  }
113  return *this;
114  }
115 
116  // get underlying Tcl_Obj
117  Tcl_Obj* getTclObject() { return obj; }
118  Tcl_Obj* getTclObjectNonConst() const { return const_cast<Tcl_Obj*>(obj); }
119 
120  // add elements to a Tcl list
121  template<typename T> void addListElement(T t) { addListElement(newObj(t)); }
122  template<typename ITER> void addListElements(ITER first, ITER last) {
123  addListElementsImpl(first, last,
124  typename std::iterator_traits<ITER>::iterator_category());
125  }
126  template<typename Range> void addListElements(Range&& range) {
127  addListElements(std::begin(range), std::end(range));
128  }
129  template<typename... Args> void addListElement(Args&&... args) {
130  addListElementsImpl({newObj(std::forward<Args>(args))...});
131  }
132 
133  // add key-value pair(s) to a Tcl dict
134  template<typename Key, typename Value>
135  void addDictKeyValue(const Key& key, const Value& value) {
136  addDictKeyValues({newObj(key), newObj(value)});
137  }
138  template<typename... Args> void addDictKeyValues(Args&&... args) {
139  addDictKeyValues({newObj(std::forward<Args>(args))...});
140  }
141 
142  // value getters
143  string_view getString() const;
144  int getInt (Interpreter& interp) const;
145  bool getBoolean (Interpreter& interp) const;
146  double getDouble(Interpreter& interp) const;
148  unsigned getListLength(Interpreter& interp) const;
149  TclObject getListIndex(Interpreter& interp, unsigned index) const;
150  TclObject getDictValue(Interpreter& interp, const TclObject& key) const;
151  template<typename Key>
152  TclObject getDictValue(Interpreter& interp, const Key& key) const {
153  return getDictValue(interp, TclObject(key));
154  }
155 
156  // STL-like interface when interpreting this TclObject as a list of
157  // strings. Invalid Tcl lists are silently interpreted as empty lists.
158  unsigned size() const { return getListLengthUnchecked(); }
159  bool empty() const { return size() == 0; }
160  auto begin() const { return iterator(*this, 0); }
161  auto end() const { return iterator(*this, size()); }
162 
163  // expressions
164  bool evalBool(Interpreter& interp) const;
165 
173  TclObject executeCommand(Interpreter& interp, bool compile = false);
174 
175  friend bool operator==(const TclObject& x, const TclObject& y) {
176  return x.getString() == y.getString();
177  }
178  friend bool operator==(const TclObject& x, string_view y) {
179  return x.getString() == y;
180  }
181  friend bool operator==(string_view x, const TclObject& y) {
182  return x == y.getString();
183  }
184 
185  friend bool operator!=(const TclObject& x, const TclObject& y) { return !(x == y); }
186  friend bool operator!=(const TclObject& x, string_view y) { return !(x == y); }
187  friend bool operator!=(string_view x, const TclObject& y) { return !(x == y); }
188 
189 private:
190  void init(Tcl_Obj* obj_) noexcept {
191  obj = obj_;
192  Tcl_IncrRefCount(obj);
193  }
194 
195  static Tcl_Obj* newObj(string_view s) {
196  return Tcl_NewStringObj(s.data(), int(s.size()));
197  }
198  static Tcl_Obj* newObj(const char* s) {
199  return Tcl_NewStringObj(s, int(strlen(s)));
200  }
201  static Tcl_Obj* newObj(bool b) {
202  return Tcl_NewBooleanObj(b);
203  }
204  static Tcl_Obj* newObj(int i) {
205  return Tcl_NewIntObj(i);
206  }
207  static Tcl_Obj* newObj(unsigned u) {
208  return Tcl_NewIntObj(u);
209  }
210  static Tcl_Obj* newObj(float f) {
211  return Tcl_NewDoubleObj(double(f));
212  }
213  static Tcl_Obj* newObj(double d) {
214  return Tcl_NewDoubleObj(d);
215  }
216  static Tcl_Obj* newObj(span<const uint8_t> buf) {
217  return Tcl_NewByteArrayObj(buf.data(), int(buf.size()));
218  }
219  static Tcl_Obj* newObj(const TclObject& o) {
220  return o.obj;
221  }
222  static Tcl_Obj* newList(std::initializer_list<Tcl_Obj*> l) {
223  return Tcl_NewListObj(int(l.size()), l.begin());
224  }
225 
226  void assign(string_view s) {
227  Tcl_SetStringObj(obj, s.data(), int(s.size()));
228  }
229  void assign(const char* s) {
230  Tcl_SetStringObj(obj, s, int(strlen(s)));
231  }
232  void assign(bool b) {
233  Tcl_SetBooleanObj(obj, b);
234  }
235  void assign(int i) {
236  Tcl_SetIntObj(obj, i);
237  }
238  void assign(unsigned u) {
239  Tcl_SetIntObj(obj, u);
240  }
241  void assign(float f) {
242  Tcl_SetDoubleObj(obj, double(f));
243  }
244  void assign(double d) {
245  Tcl_SetDoubleObj(obj, d);
246  }
247  void assign(span<const uint8_t> b) {
248  Tcl_SetByteArrayObj(obj, b.data(), int(b.size()));
249  }
250 
251  template<typename ITER>
252  void addListElementsImpl(ITER first, ITER last, std::input_iterator_tag) {
253  for (ITER it = first; it != last; ++it) {
254  addListElement(*it);
255  }
256  }
257  template<typename ITER>
258  void addListElementsImpl(ITER first, ITER last, std::random_access_iterator_tag) {
259  auto objc = last - first;
260  VLA(Tcl_Obj*, objv, objc);
261  std::transform(first, last, objv, [](const auto& t) { return newObj(t); });
262  addListElementsImpl(objc, objv);
263  }
264 
265  void addListElement(Tcl_Obj* element);
266  void addListElementsImpl(int objc, Tcl_Obj* const* objv);
267  void addListElementsImpl(std::initializer_list<Tcl_Obj*> l);
268  void addDictKeyValues(std::initializer_list<Tcl_Obj*> keyValuePairs);
269  unsigned getListLengthUnchecked() const;
270  TclObject getListIndexUnchecked(unsigned index) const;
271 
272 private:
273  Tcl_Obj* obj;
274 };
275 
276 // We want to be able to reinterpret_cast a Tcl_Obj* as a TclObject.
277 static_assert(sizeof(TclObject) == sizeof(Tcl_Obj*), "");
278 
279 template<typename... Args>
280 TclObject makeTclList(Args&&... args)
281 {
282  return TclObject(TclObject::MakeListTag{}, std::forward<Args>(args)...);
283 }
284 
285 template<typename... Args>
286 TclObject makeTclDict(Args&&... args)
287 {
288  return TclObject(TclObject::MakeDictTag{}, std::forward<Args>(args)...);
289 }
290 
291 struct XXTclHasher {
292  uint32_t operator()(string_view str) const {
293  return xxhash(str);
294  }
295  uint32_t operator()(const TclObject& obj) const {
296  return xxhash(obj.getString());
297  }
298 };
299 
300 } // namespace openmsx
301 
302 #endif
const char * data() const
Definition: string_view.hh:57
void addListElements(Range &&range)
Definition: TclObject.hh:126
TclObject & operator=(const TclObject &other)
Definition: TclObject.hh:93
TclObject(Tcl_Obj *o)
Definition: TclObject.hh:72
void swap(optional< T > &x, optional< T > &y) noexcept(noexcept(x.swap(y)))
Definition: optional.hh:816
TclObject & operator=(T t)
Definition: TclObject.hh:105
friend bool operator==(const TclObject &x, const TclObject &y)
Definition: TclObject.hh:175
auto begin() const
Definition: TclObject.hh:160
Definition: span.hh:34
TclObject(MakeListTag, Args &&... args)
Definition: TclObject.hh:79
string_view getString() const
Definition: TclObject.cc:102
unsigned getListLength(Interpreter &interp) const
Definition: TclObject.cc:116
uint32_t xxhash(string_view key)
Definition: xxhash.hh:143
friend bool operator!=(string_view x, const TclObject &y)
Definition: TclObject.hh:187
TclObject makeTclDict(Args &&... args)
Definition: TclObject.hh:286
bool evalBool(Interpreter &interp) const
Definition: TclObject.cc:162
void addListElement(Args &&... args)
Definition: TclObject.hh:129
bool empty() const
Definition: TclObject.hh:159
Tcl_Obj * getTclObject()
Definition: TclObject.hh:117
friend bool operator!=(const TclObject &x, const TclObject &y)
Definition: TclObject.hh:185
auto begin(const string_view &x)
Definition: string_view.hh:151
Tcl_Obj * getTclObjectNonConst() const
Definition: TclObject.hh:118
uint32_t operator()(const TclObject &obj) const
Definition: TclObject.hh:295
unsigned size() const
Definition: TclObject.hh:158
uint128 operator*(const uint128 &a, const uint128 &b)
Definition: uint128.hh:164
constexpr size_t strlen(const char *s) noexcept
Definition: cstd.hh:135
span< const uint8_t > getBinary() const
Definition: TclObject.cc:109
Thanks to enen for testing this on a real cartridge:
Definition: Autofire.cc:5
TclObject getListIndex(Interpreter &interp, unsigned index) const
Definition: TclObject.cc:134
TclObject getDictValue(Interpreter &interp, const TclObject &key) const
Definition: TclObject.cc:152
friend bool operator!=(const TclObject &x, string_view y)
Definition: TclObject.hh:186
TclObject(MakeDictTag, Args &&... args)
Definition: TclObject.hh:85
TclObject & operator=(TclObject &&other) noexcept
Definition: TclObject.hh:100
bool getBoolean(Interpreter &interp) const
Definition: TclObject.cc:82
TclObject(const TclObject &o)
Definition: TclObject.hh:74
double getDouble(Interpreter &interp) const
Definition: TclObject.cc:92
uint32_t operator()(string_view str) const
Definition: TclObject.hh:292
This class implements a (close approximation) of the std::string_view class.
Definition: string_view.hh:16
int getInt(Interpreter &interp) const
Definition: TclObject.cc:72
void addListElement(T t)
Definition: TclObject.hh:121
friend bool operator==(string_view x, const TclObject &y)
Definition: TclObject.hh:181
void addDictKeyValues(Args &&... args)
Definition: TclObject.hh:138
TclObject getDictValue(Interpreter &interp, const Key &key) const
Definition: TclObject.hh:152
auto transform(InputRange &&range, OutputIter out, UnaryOperation op)
Definition: ranges.hh:161
size_type size() const
Definition: string_view.hh:44
void addDictKeyValue(const Key &key, const Value &value)
Definition: TclObject.hh:135
auto end() const
Definition: TclObject.hh:161
void addListElements(ITER first, ITER last)
Definition: TclObject.hh:122
TclObject(TclObject &&o) noexcept
Definition: TclObject.hh:75
TclObject makeTclList(Args &&... args)
Definition: TclObject.hh:280
TclObject executeCommand(Interpreter &interp, bool compile=false)
Interpret this TclObject as a command and execute it.
Definition: TclObject.cc:172
#define VLA(TYPE, NAME, LENGTH)
Definition: vla.hh:10
TclObject t
auto end(const string_view &x)
Definition: string_view.hh:152
friend bool operator==(const TclObject &x, string_view y)
Definition: TclObject.hh:178