git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge remote-tracking branch 'pure11/pure11' into native
ca19d06Andy Arvanitis
pcc/include/purescript.cc+103−122
compare with golang
unifiedsplit
@@ -17,128 +17,109 @@
17
17
18namespace PureScript {
18namespace PureScript {
19
19
20−#define RETURN_VALUE(TYPE, ACCESSOR, INDIRECTION) \
20+#define RETURN_VALUE(TAG, ACCESSOR, INDIRECTION) \
21 const any& variant = unthunkVariant(*this); \
21 const any& variant = unthunkVariant(*this); \
22− assert(variant.type == TYPE); \
22+ assert(variant.tag == TAG); \
23 return INDIRECTION(variant.ACCESSOR); \
23 return INDIRECTION(variant.ACCESSOR); \
24
24
25auto any::operator()(const any& arg) const -> any {
25auto any::operator()(const any& arg) const -> any {
26 const any& variant = unthunkVariant(*this);
26 const any& variant = unthunkVariant(*this);
27− if (variant.type == Type::Closure) {
27+ if (variant.tag == tag_t::Closure) {
28 return (*variant.l)(arg);
28 return (*variant.l)(arg);
29 }
29 }
30− assert(variant.type == Type::Function);
30+ assert(variant.tag == tag_t::Function);
31 return (*variant.f)(arg);
31 return (*variant.f)(arg);
32}
32}
33
33
34auto any::operator()(const as_thunk) const -> const any& {
34auto any::operator()(const as_thunk) const -> const any& {
35− assert(type == Type::Thunk);
35+ assert(tag == tag_t::Thunk);
36 return (*t)(unthunk);
36 return (*t)(unthunk);
37}
37}
38
38
39auto any::operator()() const -> any {
39auto any::operator()() const -> any {
40 const any& variant = unthunkVariant(*this);
40 const any& variant = unthunkVariant(*this);
41− if (variant.type == Type::EffClosure) {
41+ if (variant.tag == tag_t::EffClosure) {
42 return (*variant.k)();
42 return (*variant.k)();
43 }
43 }
44− assert(variant.type == Type::EffFunction);
44+ assert(variant.tag == tag_t::EffFunction);
45 return (*variant.e)();
45 return (*variant.e)();
46}
46}
47
47
48any::operator int() const {
48any::operator int() const {
49− RETURN_VALUE(Type::Integer, i,)
49+ RETURN_VALUE(tag_t::Integer, i,)
50}
50}
51
51
52any::operator double() const {
52any::operator double() const {
53− RETURN_VALUE(Type::Double, d,)
53+ RETURN_VALUE(tag_t::Double, d,)
54}
54}
55
55
56any::operator bool() const {
56any::operator bool() const {
57− RETURN_VALUE(Type::Boolean, b,)
57+ RETURN_VALUE(tag_t::Boolean, b,)
58}
58}
59
59
60any::operator char() const {
60any::operator char() const {
61− RETURN_VALUE(Type::Character, c,)
61+ RETURN_VALUE(tag_t::Character, c,)
62}
62}
63
63
64any::operator cstring() const {
64any::operator cstring() const {
65 const any& variant = unthunkVariant(*this);
65 const any& variant = unthunkVariant(*this);
66− if (variant.type == Type::StringLiteral) {
66+ if (variant.tag == tag_t::StringLiteral) {
67 return variant.r;
67 return variant.r;
68 }
68 }
69− assert(variant.type == Type::String);
69+ assert(variant.tag == tag_t::String);
70 return variant.s->c_str();
70 return variant.s->c_str();
71}
71}
72
72
73−any::operator const map&() const {
74− RETURN_VALUE(Type::Map, m, *)
75−}
76−
77−any::operator const data&() const {
78− RETURN_VALUE(Type::Data, v, *)
79−}
80−
81any::operator const array&() const {
73any::operator const array&() const {
82− RETURN_VALUE(Type::Array, a, *)
74+ RETURN_VALUE(tag_t::Array, a, *)
83}
75}
84
76
85−auto any::extractPointer() const -> void* {
77+auto any::extractPointer(IF_DEBUG(const any::tag_t t)) const -> void* {
86− RETURN_VALUE(Type::Pointer, POINTER_FROM_MEMBER(p),)
78+ RETURN_VALUE(t, POINTER_FROM_MEMBER(p),)
87}
79}
88
80
89auto any::unthunkVariant(const any& a) -> const any& {
81auto any::unthunkVariant(const any& a) -> const any& {
90 const any * variant = &a;
82 const any * variant = &a;
91− while (variant->type == Type::Thunk) {
83+ while (variant->tag == tag_t::Thunk) {
92 variant = &((*variant->t)(unthunk));
84 variant = &((*variant->t)(unthunk));
93 }
85 }
94 return *variant;
86 return *variant;
95}
87}
96
88
89+static const any invalid_key(nullptr);
90+
97−auto any::operator[](const char rhs[]) const -> const any& {
91+auto any::operator[](const symbol_t key) const -> const any& {
98− const any& variant = unthunkVariant(*this);
92+ // TODO: assumes at least one element -- safe assumption?
99− assert(variant.type == Type::Map);
93+ const auto& m = cast<map<unknown_size>>(*this);
100− const auto begin = variant.m->cbegin();
94+ std::remove_reference<decltype(m)>::type::size_type i = 0;
101− const auto end = variant.m->cend();
95+ do {
102− for (auto it = begin; it != end; ++it) {
96+ if (m[i].first == key) {
103− if (it->first == rhs) {
104− return it->second;
105− }
106− }
107− for (auto it = begin; it != end; ++it) {
108− if (strcmp(it->first, rhs) == 0) {
109− return it->second;
97+ return m[i].second;
110 }
98 }
111− }
99+ } while (m[++i].first != nullptr);
112− throw runtime_error("map key not found");
100+ assert(false && "map key not found");
101+ return invalid_key;
113}
102}
114
103
115auto any::operator[](const size_t rhs) const -> const any& {
104auto any::operator[](const size_t rhs) const -> const any& {
116− const any& variant = unthunkVariant(*this);
105+ const auto& xs = cast<array>(*this);
117− assert(variant.type == Type::Array);
118− return (*variant.a)[rhs];
106+ return xs[rhs];
119}
107}
120
108
121auto any::operator[](const any& rhs) const -> const any& {
109auto any::operator[](const any& rhs) const -> const any& {
122− const any& variant = unthunkVariant(*this);
110+ const auto& xs = cast<array>(*this);
123− assert(variant.type == Type::Array);
124− return (*variant.a)[cast<int>(rhs)];
111+ return xs[cast<int>(rhs)];
125}
112}
126
113
127−auto any::contains(const char key[]) const -> bool {
114+auto any::contains(const symbol_t key) const -> bool {
128− const any& variant = unthunkVariant(*this);
115+ // TODO: assumes at least one element -- safe assumption?
129− assert(variant.type == Type::Map);
116+ const auto& m = cast<map<unknown_size>>(*this);
130− const auto begin = variant.m->cbegin();
117+ std::remove_reference<decltype(m)>::type::size_type i = 0;
131− const auto end = variant.m->cend();
118+ do {
132− for (auto it = begin; it != end; ++it) {
133− if (it->first == key) {
119+ if (m[i].first == key) {
134 return true;
120 return true;
135 }
121 }
136− }
122+ } while (m[++i].first != nullptr);
137− for (auto it = begin; it != end; ++it) {
138− if (strcmp(it->first, key) == 0) {
139− return true;
140− }
141− }
142 return false;
123 return false;
143}
124}
144
125
@@ -149,16 +130,16 @@ auto any::contains(const char key[]) const -> bool {
149#define DEFINE_CSTR_EQUALS_OPERATOR() \
130#define DEFINE_CSTR_EQUALS_OPERATOR() \
150 auto operator==(const any& lhs_, const char * rhs) -> bool { \
131 auto operator==(const any& lhs_, const char * rhs) -> bool { \
151 const any& lhs = any::unthunkVariant(lhs_); \
132 const any& lhs = any::unthunkVariant(lhs_); \
152− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \
133+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \
153− if (lhs.type == any::Type::StringLiteral) { \
134+ if (lhs.tag == any::tag_t::StringLiteral) { \
154 return (lhs.r == rhs) || (strcmp(lhs.r, rhs) == 0); \
135 return (lhs.r == rhs) || (strcmp(lhs.r, rhs) == 0); \
155 } \
136 } \
156 return strcmp(lhs.s->c_str(), rhs) == 0; \
137 return strcmp(lhs.s->c_str(), rhs) == 0; \
157 } \
138 } \
158 auto operator==(const char * lhs, const any& rhs_) -> bool { \
139 auto operator==(const char * lhs, const any& rhs_) -> bool { \
159 const any& rhs = any::unthunkVariant(rhs_); \
140 const any& rhs = any::unthunkVariant(rhs_); \
160− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \
141+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \
161− if (rhs.type == any::Type::StringLiteral) { \
142+ if (rhs.tag == any::tag_t::StringLiteral) { \
162 return (lhs == rhs.r) || (strcmp(lhs, rhs) == 0); \
143 return (lhs == rhs.r) || (strcmp(lhs, rhs) == 0); \
163 } \
144 } \
164 return strcmp(lhs, rhs.s->c_str()) == 0; \
145 return strcmp(lhs, rhs.s->c_str()) == 0; \
@@ -176,21 +157,21 @@ auto any::contains(const char key[]) const -> bool {
176 auto operator op (const any& lhs_, const any& rhs_) -> bool { \
157 auto operator op (const any& lhs_, const any& rhs_) -> bool { \
177 const any& lhs = any::unthunkVariant(lhs_); \
158 const any& lhs = any::unthunkVariant(lhs_); \
178 const any& rhs = any::unthunkVariant(rhs_); \
159 const any& rhs = any::unthunkVariant(rhs_); \
179− switch (lhs.type) { \
160+ switch (lhs.tag) { \
180− case any::Type::Integer: assert(lhs.type == any::Type::Integer); return lhs.i op rhs.i; \
161+ case any::tag_t::Integer: assert(lhs.tag == any::tag_t::Integer); return lhs.i op rhs.i; \
181− case any::Type::Double: assert(lhs.type == any::Type::Double); return lhs.d op rhs.d; \
162+ case any::tag_t::Double: assert(lhs.tag == any::tag_t::Double); return lhs.d op rhs.d; \
182− case any::Type::Character: assert(lhs.type == any::Type::Character); return lhs.c op rhs.c; \
163+ case any::tag_t::Character: assert(lhs.tag == any::tag_t::Character); return lhs.c op rhs.c; \
183− case any::Type::Boolean: assert(lhs.type == any::Type::Boolean); return lhs.b op rhs.b; \
164+ case any::tag_t::Boolean: assert(lhs.tag == any::tag_t::Boolean); return lhs.b op rhs.b; \
184− case any::Type::StringLiteral: \
165+ case any::tag_t::StringLiteral: \
185− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \
166+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \
186− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \
167+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \
187− return strcmp(lhs.r, rhs.type == any::Type::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \
168+ return strcmp(lhs.r, rhs.tag == any::tag_t::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \
188− case any::Type::String: \
169+ case any::tag_t::String: \
189− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \
170+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \
190− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \
171+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \
191− return strcmp(lhs.s->c_str(), rhs.type == any::Type::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \
172+ return strcmp(lhs.s->c_str(), rhs.tag == any::tag_t::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \
192− case any::Type::Pointer: return lhs.p op rhs.p; \
173+ case any::tag_t::Pointer: return lhs.p op rhs.p; \
193− default: assert(false && "Unsupported type for operator " #op); \
174+ default: assert(false && "Unsupported tag for operator " #op); \
194 } \
175 } \
195 return false; \
176 return false; \
196 }
177 }
@@ -216,44 +197,44 @@ DEFINE_CSTR_COMPARISON_OPERATOR(>=)
216auto operator+(const any& lhs_, const any& rhs_) -> any {
197auto operator+(const any& lhs_, const any& rhs_) -> any {
217 const any& lhs = any::unthunkVariant(lhs_);
198 const any& lhs = any::unthunkVariant(lhs_);
218 const any& rhs = any::unthunkVariant(rhs_);
199 const any& rhs = any::unthunkVariant(rhs_);
219− switch (lhs.type) {
200+ switch (lhs.tag) {
220− case any::Type::Integer: assert(lhs.type == any::Type::Integer); return lhs.i + rhs.i;
201+ case any::tag_t::Integer: assert(lhs.tag == any::tag_t::Integer); return lhs.i + rhs.i;
221− case any::Type::Double: assert(lhs.type == any::Type::Double); return lhs.d + rhs.d;
202+ case any::tag_t::Double: assert(lhs.tag == any::tag_t::Double); return lhs.d + rhs.d;
222− case any::Type::Character: assert(lhs.type == any::Type::Character); return any(char(lhs.c + rhs.c));
203+ case any::tag_t::Character: assert(lhs.tag == any::tag_t::Character); return any(char(lhs.c + rhs.c));
223− case any::Type::StringLiteral:
204+ case any::tag_t::StringLiteral:
224− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);
205+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);
225− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);
206+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);
226− return rhs.type == any::Type::StringLiteral ? std::string(lhs.r) + rhs.r : lhs.r + *rhs.s;
207+ return rhs.tag == any::tag_t::StringLiteral ? std::string(lhs.r) + rhs.r : lhs.r + *rhs.s;
227− case any::Type::String:
208+ case any::tag_t::String:
228− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);
209+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);
229− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);
210+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);
230− return rhs.type == any::Type::StringLiteral ? *lhs.s + rhs.r : *lhs.s + *rhs.s;
211+ return rhs.tag == any::tag_t::StringLiteral ? *lhs.s + rhs.r : *lhs.s + *rhs.s;
231− default: assert(false && "Unsupported type for '+' operator");
212+ default: assert(false && "Unsupported tag for '+' operator");
232 }
213 }
233 return nullptr;
214 return nullptr;
234}
215}
235
216
236auto operator+(const any& lhs_, const char * rhs) -> std::string {
217auto operator+(const any& lhs_, const char * rhs) -> std::string {
237 const any& lhs = any::unthunkVariant(lhs_);
218 const any& lhs = any::unthunkVariant(lhs_);
238− assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);
219+ assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);
239− return lhs.type == any::Type::StringLiteral ? std::string(lhs.r) + rhs : *lhs.s + rhs;
220+ return lhs.tag == any::tag_t::StringLiteral ? std::string(lhs.r) + rhs : *lhs.s + rhs;
240}
221}
241
222
242auto operator+(const char * lhs, const any& rhs_) -> std::string {
223auto operator+(const char * lhs, const any& rhs_) -> std::string {
243 const any& rhs = any::unthunkVariant(rhs_);
224 const any& rhs = any::unthunkVariant(rhs_);
244− assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);
225+ assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);
245− return rhs.type == any::Type::StringLiteral ? lhs + std::string(rhs.r) : lhs + *rhs.s;
226+ return rhs.tag == any::tag_t::StringLiteral ? lhs + std::string(rhs.r) : lhs + *rhs.s;
246}
227}
247
228
248auto operator-(const any& lhs_, const any& rhs_) -> any {
229auto operator-(const any& lhs_, const any& rhs_) -> any {
249 const any& lhs = any::unthunkVariant(lhs_);
230 const any& lhs = any::unthunkVariant(lhs_);
250 const any& rhs = any::unthunkVariant(rhs_);
231 const any& rhs = any::unthunkVariant(rhs_);
251− assert(lhs.type == rhs.type);
232+ assert(lhs.tag == rhs.tag);
252− switch (lhs.type) {
233+ switch (lhs.tag) {
253− case any::Type::Integer: return lhs.i - rhs.i;
234+ case any::tag_t::Integer: return lhs.i - rhs.i;
254− case any::Type::Double: return lhs.d - rhs.d;
235+ case any::tag_t::Double: return lhs.d - rhs.d;
255− case any::Type::Character: return any(char(lhs.c - rhs.c));
236+ case any::tag_t::Character: return any(char(lhs.c - rhs.c));
256− default: assert(false && "Unsupported type for '-' operator");
237+ default: assert(false && "Unsupported tag for '-' operator");
257 }
238 }
258 return nullptr;
239 return nullptr;
259}
240}
@@ -261,12 +242,12 @@ auto operator-(const any& lhs_, const any& rhs_) -> any {
261auto operator*(const any& lhs_, const any& rhs_) -> any {
242auto operator*(const any& lhs_, const any& rhs_) -> any {
262 const any& lhs = any::unthunkVariant(lhs_);
243 const any& lhs = any::unthunkVariant(lhs_);
263 const any& rhs = any::unthunkVariant(rhs_);
244 const any& rhs = any::unthunkVariant(rhs_);
264− assert(lhs.type == rhs.type);
245+ assert(lhs.tag == rhs.tag);
265− switch (lhs.type) {
246+ switch (lhs.tag) {
266− case any::Type::Integer: return lhs.i * rhs.i;
247+ case any::tag_t::Integer: return lhs.i * rhs.i;
267− case any::Type::Double: return lhs.d * rhs.d;
248+ case any::tag_t::Double: return lhs.d * rhs.d;
268− case any::Type::Character: return any(char(lhs.c * rhs.c));
249+ case any::tag_t::Character: return any(char(lhs.c * rhs.c));
269− default: assert(false && "Unsupported type for '*' operator");
250+ default: assert(false && "Unsupported tag for '*' operator");
270 }
251 }
271 return nullptr;
252 return nullptr;
272}
253}
@@ -274,12 +255,12 @@ auto operator*(const any& lhs_, const any& rhs_) -> any {
274auto operator/(const any& lhs_, const any& rhs_) -> any {
255auto operator/(const any& lhs_, const any& rhs_) -> any {
275 const any& lhs = any::unthunkVariant(lhs_);
256 const any& lhs = any::unthunkVariant(lhs_);
276 const any& rhs = any::unthunkVariant(rhs_);
257 const any& rhs = any::unthunkVariant(rhs_);
277− assert(lhs.type == rhs.type);
258+ assert(lhs.tag == rhs.tag);
278− switch (lhs.type) {
259+ switch (lhs.tag) {
279− case any::Type::Integer: return lhs.i / rhs.i;
260+ case any::tag_t::Integer: return lhs.i / rhs.i;
280− case any::Type::Double: return lhs.d / rhs.d;
261+ case any::tag_t::Double: return lhs.d / rhs.d;
281− case any::Type::Character: return any(char(lhs.c / rhs.c));
262+ case any::tag_t::Character: return any(char(lhs.c / rhs.c));
282− default: assert(false && "Unsupported type for '/' operator");
263+ default: assert(false && "Unsupported tag for '/' operator");
283 }
264 }
284 return nullptr;
265 return nullptr;
285}
266}
@@ -287,11 +268,11 @@ auto operator/(const any& lhs_, const any& rhs_) -> any {
287auto operator%(const any& lhs_, const any& rhs_) -> any {
268auto operator%(const any& lhs_, const any& rhs_) -> any {
288 const any& lhs = any::unthunkVariant(lhs_);
269 const any& lhs = any::unthunkVariant(lhs_);
289 const any& rhs = any::unthunkVariant(rhs_);
270 const any& rhs = any::unthunkVariant(rhs_);
290− assert(lhs.type == rhs.type);
271+ assert(lhs.tag == rhs.tag);
291− switch (lhs.type) {
272+ switch (lhs.tag) {
292− case any::Type::Integer: return lhs.i % rhs.i;
273+ case any::tag_t::Integer: return lhs.i % rhs.i;
293− case any::Type::Character: return any(char(lhs.c % rhs.c));
274+ case any::tag_t::Character: return any(char(lhs.c % rhs.c));
294− default: assert(false && "Unsupported type for '%' operator");
275+ default: assert(false && "Unsupported tag for '%' operator");
295 }
276 }
296 return nullptr;
277 return nullptr;
297}
278}
@@ -299,10 +280,10 @@ auto operator%(const any& lhs_, const any& rhs_) -> any {
299// unary negate
280// unary negate
300auto operator-(const any& rhs_) -> any {
281auto operator-(const any& rhs_) -> any {
301 const any& rhs = any::unthunkVariant(rhs_);
282 const any& rhs = any::unthunkVariant(rhs_);
302− switch (rhs.type) {
283+ switch (rhs.tag) {
303− case any::Type::Integer: return (- rhs.i);
284+ case any::tag_t::Integer: return (- rhs.i);
304− case any::Type::Double: return (- rhs.d);
285+ case any::tag_t::Double: return (- rhs.d);
305− default: assert(false && "Unsupported type for unary '-' operator");
286+ default: assert(false && "Unsupported tag for unary '-' operator");
306 }
287 }
307 return nullptr;
288 return nullptr;
308}
289}
pcc/include/purescript.hh+114−81
@@ -20,15 +20,17 @@
20#if defined(DEBUG)
20#if defined(DEBUG)
21 #include <cassert>
21 #include <cassert>
22 #include <climits>
22 #include <climits>
23+ #define IF_DEBUG(x) x
23#else
24#else
24 #define NDEBUG
25 #define NDEBUG
25 #undef assert
26 #undef assert
26 #define assert(x)
27 #define assert(x)
28+ #define IF_DEBUG(_)
27#endif
29#endif
28
30
29#include <functional>
31#include <functional>
30#include <string>
32#include <string>
31−#include <vector>
33+#include <array>
32#include <deque>
34#include <deque>
33#include <utility>
35#include <utility>
34#include <stdexcept>
36#include <stdexcept>
@@ -40,21 +42,36 @@ namespace PureScript {
40using cstring = const char *;
42using cstring = const char *;
41using std::nullptr_t;
43using std::nullptr_t;
42
44
45+struct symbol_generator_anchor {};
46+using symbol_t = const symbol_generator_anchor *;
47+
48+template <typename T>
49+struct symbol_generator {
50+ constexpr static symbol_generator_anchor anchor = symbol_generator_anchor{};
51+};
52+template <typename T>
53+constexpr symbol_generator_anchor symbol_generator<T>::anchor;
54+
55+#define SYMBOL(S) &symbol_generator<symbol::S>::anchor
56+
43// Workaround for missing C++11 version in gcc
57// Workaround for missing C++11 version in gcc
44class runtime_error : public std::runtime_error {
58class runtime_error : public std::runtime_error {
45public:
59public:
46 runtime_error(const char message[]) : std::runtime_error(std::string(message)) {}
60 runtime_error(const char message[]) : std::runtime_error(std::string(message)) {}
47};
61};
48
62
49−const bool undefined = false;
63+constexpr bool undefined = false;
50−const size_t constructor = 0;
64+constexpr size_t constructor = 0;
65+
66+// Not a real limit, just used for simpler accessors
67+static constexpr size_t unknown_size = 64;
51
68
52// A variant data class designed to provide some features of dynamic typing.
69// A variant data class designed to provide some features of dynamic typing.
53//
70//
54class any {
71class any {
55
72
56 public:
73 public:
57− enum class Type {
74+ enum class tag_t {
58 Thunk = 0x10,
75 Thunk = 0x10,
59 Integer,
76 Integer,
60 Double,
77 Double,
@@ -74,16 +91,21 @@ class any {
74 };
91 };
75
92
76 private:
93 private:
77− mutable Type type;
94+ mutable tag_t tag;
78
95
79 public:
96 public:
80 struct as_thunk {
97 struct as_thunk {
81 };
98 };
82 static constexpr as_thunk unthunk = as_thunk{};
99 static constexpr as_thunk unthunk = as_thunk{};
83
100
84− using map_pair = std::pair<const char * const, const any>;
101+ using map_pair = std::pair<const symbol_t, const any>;
102+
103+ template <size_t N>
85− using map = std::vector<map_pair WITH_ALLOCATOR(map_pair)>;
104+ using map = std::array<const map_pair, N>;
105+
106+ template <size_t N>
86− using data = std::vector<any WITH_ALLOCATOR(any)>;
107+ using data = std::array<const any, N>;
108+
87 using array = std::deque<any WITH_ALLOCATOR(any)>;
109 using array = std::deque<any WITH_ALLOCATOR(any)>;
88 using fn = auto (*)(const any&) -> any;
110 using fn = auto (*)(const any&) -> any;
89 using eff_fn = auto (*)() -> any;
111 using eff_fn = auto (*)() -> any;
@@ -134,8 +156,6 @@ class any {
134 mutable eff_fn e;
156 mutable eff_fn e;
135 mutable void * u;
157 mutable void * u;
136 mutable managed<std::string> s;
158 mutable managed<std::string> s;
137− mutable managed<map> m;
138− mutable managed<data> v;
139 mutable managed<array> a;
159 mutable managed<array> a;
140 mutable managed<closure> l;
160 mutable managed<closure> l;
141 mutable managed<eff_closure> k;
161 mutable managed<eff_closure> k;
@@ -144,74 +164,74 @@ class any {
144
164
145 public:
165 public:
146
166
147− any(const int val) noexcept : type(Type::Integer), i(val) {}
167+ any(const int val) noexcept : tag(tag_t::Integer), i(val) {}
148− any(const long int_value) noexcept : type(Type::Integer), i(int_value) {
168+ any(const long int_value) noexcept : tag(tag_t::Integer), i(int_value) {
149 assert(int_value >= INT_MIN && int_value <= INT_MAX);
169 assert(int_value >= INT_MIN && int_value <= INT_MAX);
150 }
170 }
151
171
152− any(const double val) noexcept : type(Type::Double), d(val) {}
172+ any(const double val) noexcept : tag(tag_t::Double), d(val) {}
153− any(const char val) noexcept : type(Type::Character), c(val) {}
173+ any(const char val) noexcept : tag(tag_t::Character), c(val) {}
154
174
155 template <typename T, typename = typename std::enable_if<std::is_same<bool,T>::value>::type>
175 template <typename T, typename = typename std::enable_if<std::is_same<bool,T>::value>::type>
156− any(const T val) noexcept : type(Type::Boolean), b(val) {}
176+ any(const T val) noexcept : tag(tag_t::Boolean), b(val) {}
157
177
158 template <size_t N>
178 template <size_t N>
159− any(const char (&val)[N]) noexcept : type(Type::StringLiteral), r(val) {}
179+ any(const char (&val)[N]) noexcept : tag(tag_t::StringLiteral), r(val) {}
160− any(char * val) : type(Type::String), s(make_managed<std::string>(val)) {}
180+ any(char * val) : tag(tag_t::String), s(make_managed<std::string>(val)) {}
161
181
162− any(const std::string& val) : type(Type::String), s(make_managed<std::string>(val)) {}
182+ any(const std::string& val) : tag(tag_t::String), s(make_managed<std::string>(val)) {}
163− any(std::string&& val) noexcept : type(Type::String), s(make_managed<std::string>(std::move(val))) {}
183+ any(std::string&& val) noexcept : tag(tag_t::String), s(make_managed<std::string>(std::move(val))) {}
164
184
165− any(const managed<std::string>& val) noexcept : type(Type::String), s(val) {}
185+ any(const managed<std::string>& val) noexcept : tag(tag_t::String), s(val) {}
166− any(managed<std::string>&& val) noexcept : type(Type::String), s(std::move(val)) {}
186+ any(managed<std::string>&& val) noexcept : tag(tag_t::String), s(std::move(val)) {}
167
187
168− any(const map& val) : type(Type::Map), m(make_managed<map>(val)) {}
188+ template <size_t N>
169− any(map&& val) noexcept : type(Type::Map), m(make_managed<map>(std::move(val))) {}
189+ any(map<N>&& val) noexcept : tag(tag_t::Map), p(make_managed<map<N>>(std::move(val))) {}
170
190
171− any(const data& val) : type(Type::Data), v(make_managed<data>(val)) {}
191+ template <size_t N>
172− any(data&& val) noexcept : type(Type::Data), v(make_managed<data>(std::move(val))) {}
192+ any(data<N>&& val) noexcept : tag(tag_t::Data), p(make_managed<data<N>>(std::move(val))) {}
173
193
174− any(const array& val) : type(Type::Array), a(make_managed<array>(val)) {}
194+ any(const array& val) : tag(tag_t::Array), a(make_managed<array>(val)) {}
175− any(array&& val) noexcept : type(Type::Array), a(make_managed<array>(std::move(val))) {}
195+ any(array&& val) noexcept : tag(tag_t::Array), a(make_managed<array>(std::move(val))) {}
176
196
177 template <typename T>
197 template <typename T>
178 any(const T& val, typename std::enable_if<std::is_convertible<T,fn>::value>::type* = 0) noexcept
198 any(const T& val, typename std::enable_if<std::is_convertible<T,fn>::value>::type* = 0) noexcept
179− : type(Type::Function), f(val) {}
199+ : tag(tag_t::Function), f(val) {}
180
200
181 template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&
201 template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&
182 !std::is_convertible<T,fn>::value>::type>
202 !std::is_convertible<T,fn>::value>::type>
183 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)
203 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)
184− : type(Type::Closure), l(make_managed<_closure<T>>(val)) {}
204+ : tag(tag_t::Closure), l(make_managed<_closure<T>>(val)) {}
185
205
186 template <typename T>
206 template <typename T>
187 any(const T& val, typename std::enable_if<std::is_convertible<T,eff_fn>::value>::type* = 0) noexcept
207 any(const T& val, typename std::enable_if<std::is_convertible<T,eff_fn>::value>::type* = 0) noexcept
188− : type(Type::EffFunction), e(val) {}
208+ : tag(tag_t::EffFunction), e(val) {}
189
209
190 template <typename T,
210 template <typename T,
191 typename = typename std::enable_if<!std::is_same<any,T>::value &&
211 typename = typename std::enable_if<!std::is_same<any,T>::value &&
192 !std::is_convertible<T,eff_fn>::value>::type>
212 !std::is_convertible<T,eff_fn>::value>::type>
193 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)
213 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)
194− : type(Type::EffClosure), k(make_managed<_eff_closure<T>>(val)) {}
214+ : tag(tag_t::EffClosure), k(make_managed<_eff_closure<T>>(val)) {}
195
215
196 template <typename T>
216 template <typename T>
197 any(const T& val, typename std::enable_if<std::is_convertible<T,thunk>::value>::type* = 0) noexcept
217 any(const T& val, typename std::enable_if<std::is_convertible<T,thunk>::value>::type* = 0) noexcept
198− : type(Type::Thunk), t(val) {}
218+ : tag(tag_t::Thunk), t(val) {}
199
219
200 template <typename T,
220 template <typename T,
201 typename = typename std::enable_if<std::is_class<typename std::remove_pointer<T>::type>::value>::type>
221 typename = typename std::enable_if<std::is_class<typename std::remove_pointer<T>::type>::value>::type>
202 any(const T& val, typename std::enable_if<IS_POINTER_TYPE(T)::value>::type* = 0) noexcept
222 any(const T& val, typename std::enable_if<IS_POINTER_TYPE(T)::value>::type* = 0) noexcept
203− : type(Type::Pointer), p(val) {}
223+ : tag(tag_t::Pointer), p(val) {}
204
224
205 template <typename T>
225 template <typename T>
206 any(T&& val, typename std::enable_if<std::is_assignable<managed<void>,T>::value>::type* = 0) noexcept
226 any(T&& val, typename std::enable_if<std::is_assignable<managed<void>,T>::value>::type* = 0) noexcept
207− : type(Type::Pointer), p(std::move(val)) {}
227+ : tag(tag_t::Pointer), p(std::move(val)) {}
208
228
209 // Explicit void* to raw pointer value
229 // Explicit void* to raw pointer value
210 template <typename T>
230 template <typename T>
211 any(const T& val, typename std::enable_if<std::is_same<T,void*>::value>::type* = 0) noexcept
231 any(const T& val, typename std::enable_if<std::is_same<T,void*>::value>::type* = 0) noexcept
212− : type(Type::RawPointer), u(val) {}
232+ : tag(tag_t::RawPointer), u(val) {}
213
233
214− any(std::nullptr_t) noexcept : type(Type::Pointer), p(nullptr) {}
234+ any(nullptr_t) noexcept : tag(tag_t::RawPointer), u(nullptr) {}
215
235
216
236
217#if !defined(USE_GC)
237#if !defined(USE_GC)
@@ -232,62 +252,62 @@ class any {
232
252
233 template <typename T>
253 template <typename T>
234 auto assign(T&& other) const noexcept -> void {
254 auto assign(T&& other) const noexcept -> void {
235− switch (other.type) {
255+ switch (other.tag) {
236− case Type::Thunk: t = other.t; break;
256+ case tag_t::Thunk: t = other.t; break;
237− case Type::Integer: i = other.i; break;
257+ case tag_t::Integer: i = other.i; break;
238− case Type::Double: d = other.d; break;
258+ case tag_t::Double: d = other.d; break;
239− case Type::Character: c = other.c; break;
259+ case tag_t::Character: c = other.c; break;
240− case Type::Boolean: b = other.b; break;
260+ case tag_t::Boolean: b = other.b; break;
241− case Type::StringLiteral: r = other.r; break;
261+ case tag_t::StringLiteral: r = other.r; break;
242− case Type::Function: f = other.f; break;
262+ case tag_t::Function: f = other.f; break;
243− case Type::EffFunction: e = other.e; break;
263+ case tag_t::EffFunction: e = other.e; break;
244− case Type::RawPointer: u = other.u; break;
264+ case tag_t::RawPointer: u = other.u; break;
245−
265+
246− case Type::String: new (&s) managed<std::string>(move_if_rvalue<T>(other.s)); break;
266+ case tag_t::String: new (&s) managed<std::string>(move_if_rvalue<T>(other.s)); break;
247− case Type::Map: new (&m) managed<map>(move_if_rvalue<T>(other.m)); break;
248− case Type::Data: new (&v) managed<data>(move_if_rvalue<T>(other.v)); break;
249− case Type::Array: new (&a) managed<array>(move_if_rvalue<T>(other.a)); break;
267+ case tag_t::Array: new (&a) managed<array>(move_if_rvalue<T>(other.a)); break;
250− case Type::Closure: new (&l) managed<closure>(move_if_rvalue<T>(other.l)); break;
268+ case tag_t::Closure: new (&l) managed<closure>(move_if_rvalue<T>(other.l)); break;
251− case Type::EffClosure: new (&k) managed<eff_closure>(move_if_rvalue<T>(other.k)); break;
269+ case tag_t::EffClosure: new (&k) managed<eff_closure>(move_if_rvalue<T>(other.k)); break;
270+ case tag_t::Map:
271+ case tag_t::Data:
252− case Type::Pointer: new (&p) managed<void>(move_if_rvalue<T>(other.p)); break;
272+ case tag_t::Pointer: new (&p) managed<void>(move_if_rvalue<T>(other.p)); break;
253−
273+
254− default: assert(false && "Bad 'any' type"); break;
274+ default: assert(false && "Bad 'any' tag"); break;
255 }
275 }
256 }
276 }
257
277
258 auto destruct() -> void {
278 auto destruct() -> void {
259− switch (type) {
279+ switch (tag) {
260− case Type::String: s.~managed<std::string>(); break;
280+ case tag_t::String: s.~managed<std::string>(); break;
261− case Type::Map: m.~managed<map>(); break;
262− case Type::Data: v.~managed<data>(); break;
263− case Type::Array: a.~managed<array>(); break;
281+ case tag_t::Array: a.~managed<array>(); break;
264− case Type::Closure: l.~managed<closure>(); break;
282+ case tag_t::Closure: l.~managed<closure>(); break;
265− case Type::EffClosure: k.~managed<eff_closure>(); break;
283+ case tag_t::EffClosure: k.~managed<eff_closure>(); break;
284+ case tag_t::Map:
285+ case tag_t::Data:
266− case Type::Pointer: p.~managed<void>(); break;
286+ case tag_t::Pointer: p.~managed<void>(); break;
267
287
268 default: break;
288 default: break;
269 }
289 }
270 }
290 }
271
291
272 public:
292 public:
273− any(const any& other) noexcept : type(other.type) {
293+ any(const any& other) noexcept : tag(other.tag) {
274 assign(other);
294 assign(other);
275 }
295 }
276
296
277− any(any&& other) noexcept : type(other.type) {
297+ any(any&& other) noexcept : tag(other.tag) {
278 assign(std::move(other));
298 assign(std::move(other));
279 }
299 }
280
300
281 auto operator=(const any& rhs) noexcept -> any& {
301 auto operator=(const any& rhs) noexcept -> any& {
282 destruct();
302 destruct();
283− type = rhs.type;
303+ tag = rhs.tag;
284 assign(rhs);
304 assign(rhs);
285 return *this;
305 return *this;
286 }
306 }
287
307
288 auto operator=(any&& rhs) noexcept -> any& {
308 auto operator=(any&& rhs) noexcept -> any& {
289 destruct();
309 destruct();
290− type = rhs.type;
310+ tag = rhs.tag;
291 assign(std::move(rhs));
311 assign(std::move(rhs));
292 return *this;
312 return *this;
293 }
313 }
@@ -309,21 +329,19 @@ class any {
309 operator bool() const;
329 operator bool() const;
310 operator char() const;
330 operator char() const;
311 operator cstring() const;
331 operator cstring() const;
312− operator const map&() const;
313− operator const data&() const;
314 operator const array&() const;
332 operator const array&() const;
315
333
316− auto operator[](const char[]) const -> const any&;
334+ auto operator[](const symbol_t) const -> const any&;
317 auto operator[](const size_t) const -> const any&;
335 auto operator[](const size_t) const -> const any&;
318 auto operator[](const any&) const -> const any&;
336 auto operator[](const any&) const -> const any&;
319
337
320− auto contains(const char[]) const -> bool;
338+ auto contains(const symbol_t) const -> bool;
321
339
322− auto extractPointer() const -> void*;
340+ auto extractPointer(IF_DEBUG(const tag_t)) const -> void*;
323
341
324 auto rawPointer() const -> void* {
342 auto rawPointer() const -> void* {
325 const any& variant = unthunkVariant(*this);
343 const any& variant = unthunkVariant(*this);
326− assert(type == Type::RawPointer);
344+ assert(tag == tag_t::RawPointer);
327 return variant.u;
345 return variant.u;
328 }
346 }
329
347
@@ -385,6 +403,25 @@ class any {
385 DEFINE_OPERATOR(%, char, char)
403 DEFINE_OPERATOR(%, char, char)
386
404
387 friend auto operator-(const any&) -> any; // unary negate
405 friend auto operator-(const any&) -> any; // unary negate
406+
407+}; // class any
408+
409+template <typename T, typename U=void>
410+struct tag_helper {};
411+
412+template <size_t N>
413+struct tag_helper<any::map<N>> {
414+ static constexpr any::tag_t tag = any::tag_t::Map;
415+};
416+
417+template <size_t N>
418+struct tag_helper<any::data<N>> {
419+ static constexpr any::tag_t tag = any::tag_t::Data;
420+};
421+
422+template <typename T>
423+struct tag_helper<T> {
424+ static constexpr any::tag_t tag = any::tag_t::Pointer;
388};
425};
389
426
390template <typename T>
427template <typename T>
@@ -396,18 +433,14 @@ inline auto cast(const any& a) ->
396
433
397template <typename T>
434template <typename T>
398inline auto cast(const any& a) ->
435inline auto cast(const any& a) ->
399− typename std::enable_if<std::is_same<T, any::map>::value ||
436+ typename std::enable_if<std::is_same<T, any::array>::value, const T&>::type {
400− std::is_same<T, any::data>::value ||
401− std::is_same<T, any::array>::value, const T&>::type {
402 return a;
437 return a;
403}
438}
404
439
405template <typename T, typename = typename std::enable_if<std::is_class<T>::value>::type>
440template <typename T, typename = typename std::enable_if<std::is_class<T>::value>::type>
406inline auto cast(const any& a) ->
441inline auto cast(const any& a) ->
407− typename std::enable_if<!std::is_same<T, any::map>::value &&
442+ typename std::enable_if<!std::is_same<T, any::array>::value, T&>::type {
408− !std::is_same<T, any::data>::value &&
409− !std::is_same<T, any::array>::value, T&>::type {
410− return *static_cast<T*>(a.extractPointer());
443+ return *static_cast<T*>(a.extractPointer(IF_DEBUG(tag_helper<T>::tag)));
411}
444}
412
445
413template <typename T>
446template <typename T>
src/Language/PureScript/CodeGen/Cpp.hs+60−19
@@ -71,16 +71,17 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
71 (snd <$> imps)
71 (snd <$> imps)
72 let cppImports' = "PureScript" : cppImports
72 let cppImports' = "PureScript" : cppImports
73 cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls
73 cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls
74+ let cpps = filterInlineFuncs <$> cppDecls
74− let namesmap = M.toList .
75+ namesmap = M.toList .
75 M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $
76 M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $
76 E.names env
77 E.names env
77 datamap = M.toList .
78 datamap = M.toList .
78 M.mapKeysMonotonic (qualifiedToCpp (Ident . runProperName)) .
79 M.mapKeysMonotonic (qualifiedToCpp (Ident . runProperName)) .
79 M.map (\(_, _, _, fields) -> length fields) $
80 M.map (\(_, _, _, fields) -> length fields) $
80 E.dataConstructors env
81 E.dataConstructors env
81− cppDecls' <- traverse (optimize $ namesmap ++ datamap) cppDecls
82+ cpps' <- traverse (optimize $ namesmap ++ datamap) cpps
82 foreignWrappers <- curriedForeigns
83 foreignWrappers <- curriedForeigns
83− let optimized = cppDecls' ++ foreignWrappers
84+ let optimized = cpps' ++ foreignWrappers
84 let moduleHeader =
85 let moduleHeader =
85 fileBegin mn "HH" ++
86 fileBegin mn "HH" ++
86 P.linebreak ++
87 P.linebreak ++
@@ -99,9 +100,10 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
99 P.linebreak ++
100 P.linebreak ++
100 fileEnd mn "HH"
101 fileEnd mn "HH"
101 let bodyCpps = toBodyDecl optimized ++ toBody optimized
102 let bodyCpps = toBodyDecl optimized ++ toBody optimized
103+ symbols = allSymbols bodyCpps
102 moduleBody =
104 moduleBody =
103 CppInclude (runModuleName mn) (runModuleName mn) :
105 CppInclude (runModuleName mn) (runModuleName mn) :
104− P.linebreak ++
106+ symbolDefs symbols :
105 (if null bodyCpps
107 (if null bodyCpps
106 then []
108 then []
107 else [ CppNamespace (runModuleName mn) $
109 else [ CppNamespace (runModuleName mn) $
@@ -189,7 +191,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
189 isAccessor Accessor{} = True
191 isAccessor Accessor{} = True
190 isAccessor _ = False
192 isAccessor _ = False
191 isIndexer :: Cpp -> Bool
193 isIndexer :: Cpp -> Bool
192− isIndexer (CppIndexer (CppStringLiteral _) (CppVar _)) = True
194+ isIndexer (CppIndexer (CppSymbol _) (CppVar _)) = True
193 isIndexer _ = False
195 isIndexer _ = False
194 classes = qualifiedToCpp (Ident . runProperName) . T.constraintClass <$>
196 classes = qualifiedToCpp (Ident . runProperName) . T.constraintClass <$>
195 maybe [] extractConstraints ty'
197 maybe [] extractConstraints ty'
@@ -368,7 +370,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
368 [dict'])
370 [dict'])
369 where
371 where
370 dict' = CppVar dictname
372 dict' = CppVar dictname
371− dict'' = CppCast dataType dict'
373+ dict'' = CppCast (dataType 1) dict'
372
374
373 accessor :: String -> (String, Cpp) -> Cpp
375 accessor :: String -> (String, Cpp) -> Cpp
374 accessor dictname (name, _) =
376 accessor dictname (name, _) =
@@ -440,18 +442,20 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
440 CppArrayLiteral <$> mapM valueToCpp xs
442 CppArrayLiteral <$> mapM valueToCpp xs
441
443
442 valueToCpp (Literal _ (ObjectLiteral ps)) =
444 valueToCpp (Literal _ (ObjectLiteral ps)) =
443− CppObjectLiteral CppRecord <$> sortBy (compare `on` fst) <$> mapM (sndM valueToCpp) ps
445+ CppObjectLiteral CppRecord <$>
446+ mapM (sndM valueToCpp) ((\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)
444
447
445 valueToCpp (Accessor _ prop val) =
448 valueToCpp (Accessor _ prop val) =
446− CppIndexer <$> pure (CppStringLiteral prop) <*> valueToCpp val
449+ CppIndexer <$> pure (CppSymbol prop) <*> valueToCpp val
447
450
448 -- TODO: use a more efficient way of copying/updating the map?
451 -- TODO: use a more efficient way of copying/updating the map?
449 valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
452 valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
450 obj' <- valueToCpp obj
453 obj' <- valueToCpp obj
451 updatedFields <- mapM (sndM valueToCpp) ps
454 updatedFields <- mapM (sndM valueToCpp) ps
452 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
455 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
453− origFields = (\key -> (key, CppIndexer (CppStringLiteral key) obj')) <$> origKeys
456+ origFields = (\key -> (key, CppIndexer (CppSymbol key) obj')) <$> origKeys
457+ return $ CppObjectLiteral CppRecord $
454− return $ CppObjectLiteral CppRecord . sortBy (compare `on` fst) $ origFields ++ updatedFields
458+ (\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
455 where
459 where
456 allKeys :: T.Type -> [String]
460 allKeys :: T.Type -> [String]
457 allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)
461 allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)
@@ -485,7 +489,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
485 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
489 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
486 return . CppObjectLiteral CppInstance $
490 return . CppObjectLiteral CppInstance $
487 zip
491 zip
488− ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))
492+ (CppSymbol <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))
489 args'
493 args'
490 Var _ (Qualified (Just _) _) -> applied f args' curriedName'
494 Var _ (Qualified (Just _) _) -> applied f args' curriedName'
491 _ -> applied f args' id
495 _ -> applied f args' id
@@ -625,7 +629,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
625 EqualTo
629 EqualTo
626 (CppIndexer
630 (CppIndexer
627 (CppVar ctorKey)
631 (CppVar ctorKey)
628− (CppCast dataType $ CppVar varName))
632+ (CppCast (dataType 1) $ CppVar varName))
629 ctorCpp)
633 ctorCpp)
630 (CppBlock cpps)
634 (CppBlock cpps)
631 Nothing]
635 Nothing]
@@ -641,11 +645,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
641 (argVar, Nothing)
645 (argVar, Nothing)
642 []
646 []
643 (Just $ CppIndexer
647 (Just $ CppIndexer
644− (fieldToIndex field)
648+ (fieldToIndex' field)
645− (CppCast dataType $ CppVar varName))
649+ (CppCast (dataType $ fieldToIndex field + 1) $ CppVar varName))
646 : cpps
650 : cpps
647− fieldToIndex :: Ident -> Cpp
651+ fieldToIndex :: Ident -> Int
648− fieldToIndex = CppNumericLiteral . Left . (+1) . read . dropWhile isLetter . runIdent
652+ fieldToIndex = (+1) . read . dropWhile isLetter . runIdent
653+ fieldToIndex' :: Ident -> Cpp
654+ fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex
649 ctor' :: Cpp
655 ctor' :: Cpp
650 ctor' = CppAccessor (CppVar . identToCpp $ Ident ctor) (CppVar "data")
656 ctor' = CppAccessor (CppVar . identToCpp $ Ident ctor) (CppVar "data")
651 ctorCpp :: Cpp
657 ctorCpp :: Cpp
@@ -712,7 +718,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
712 (propVar, Nothing)
718 (propVar, Nothing)
713 []
719 []
714 (Just $ CppIndexer
720 (Just $ CppIndexer
715− (CppStringLiteral prop)
721+ (CppSymbol prop)
716 (CppVar varName))
722 (CppVar varName))
717 : cpp
723 : cpp
718
724
@@ -868,12 +874,12 @@ extractConstraints = go []
868---------------------------------------------------------------------------------------------------
874---------------------------------------------------------------------------------------------------
869dictIndexerToEnum :: [(Cpp,Cpp)] -> Cpp -> Cpp
875dictIndexerToEnum :: [(Cpp,Cpp)] -> Cpp -> Cpp
870---------------------------------------------------------------------------------------------------
876---------------------------------------------------------------------------------------------------
871−dictIndexerToEnum repls (CppIndexer (CppStringLiteral prop) dict)
877+dictIndexerToEnum repls (CppIndexer (CppSymbol prop) dict)
872 | Just cls <- lookup dict repls =
878 | Just cls <- lookup dict repls =
873 CppBinary Dot
879 CppBinary Dot
874 (CppIndexer
880 (CppIndexer
875 (CppAccessor (CppVar . identToCpp $ Ident prop) cls)
881 (CppAccessor (CppVar . identToCpp $ Ident prop) cls)
876− (CppCast mapType dict))
882+ (CppCast (mapType 0) dict))
877 (CppVar "second")
883 (CppVar "second")
878dictIndexerToEnum _ cpp = cpp
884dictIndexerToEnum _ cpp = cpp
879
885
@@ -914,3 +920,38 @@ convertIfPrimFn (Just ty) (CppFunction name params _ qs body)
914 | (tys', Just rty') <- primFn ty =
920 | (tys', Just rty') <- primFn ty =
915 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body
921 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body
916convertIfPrimFn _ cpp = cpp
922convertIfPrimFn _ cpp = cpp
923+
924+---------------------------------------------------------------------------------------------------
925+allSymbols :: [Cpp] -> [String]
926+---------------------------------------------------------------------------------------------------
927+allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps
928+ where
929+ symbols :: Cpp -> [String]
930+ symbols (CppSymbol s) = [symbolname s]
931+ symbols _ = []
932+
933+---------------------------------------------------------------------------------------------------
934+symbolDefs :: [String] -> Cpp
935+---------------------------------------------------------------------------------------------------
936+symbolDefs [] = CppNoOp
937+symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asFunc <$> syms)]
938+ where
939+ asFunc :: String -> Cpp
940+ asFunc s = CppStruct s []
941+
942+---------------------------------------------------------------------------------------------------
943+filterInlineFuncs :: Cpp -> Cpp
944+---------------------------------------------------------------------------------------------------
945+filterInlineFuncs = everywhereOnCpp convert
946+ where
947+ convert :: Cpp -> Cpp
948+ convert (CppBlock []) = CppBlock []
949+ convert (CppFunction n ps r qs cpp)
950+ | CppInline `elem` qs,
951+ everythingOnCpp (||) shouldRemove cpp = CppFunction n ps r (delete CppInline qs) cpp
952+ where
953+ shouldRemove :: Cpp -> Bool
954+ shouldRemove CppSymbol{} = True
955+ shouldRemove CppLambda{} = True
956+ shouldRemove _ = False
957+ convert cpp = cpp
src/Language/PureScript/CodeGen/Cpp/AST.hs+11−6
@@ -185,7 +185,7 @@ data Cpp
185 -- |
185 -- |
186 -- An object literal
186 -- An object literal
187 --
187 --
188− | CppObjectLiteral CppObjectType [(String, Cpp)]
188+ | CppObjectLiteral CppObjectType [(Cpp, Cpp)]
189 -- |
189 -- |
190 -- An general property accessor expression (property, expr)
190 -- An general property accessor expression (property, expr)
191 --
191 --
@@ -211,6 +211,11 @@ data Cpp
211 --
211 --
212 | CppVar String
212 | CppVar String
213 -- |
213 -- |
214+ -- Unique system-wide name/constant
215+ --
216+ | CppSymbol String
217+ -- |
218+ -- |
214 -- A block of expressions in braces
219 -- A block of expressions in braces
215 --
220 --
216 | CppBlock [Cpp]
221 | CppBlock [Cpp]
@@ -297,7 +302,7 @@ everywhereOnCpp f = go
297 go (CppArrayLiteral cpp) = f (CppArrayLiteral (map go cpp))
302 go (CppArrayLiteral cpp) = f (CppArrayLiteral (map go cpp))
298 go (CppDataLiteral cpp) = f (CppDataLiteral (map go cpp))
303 go (CppDataLiteral cpp) = f (CppDataLiteral (map go cpp))
299 go (CppIndexer j1 j2) = f (CppIndexer (go j1) (go j2))
304 go (CppIndexer j1 j2) = f (CppIndexer (go j1) (go j2))
300− go (CppObjectLiteral t cpp) = f (CppObjectLiteral t (map (fmap go) cpp))
305+ go (CppObjectLiteral t cpps) = f (CppObjectLiteral t (map (fmap go) cpps))
301 go (CppAccessor prop j) = f (CppAccessor (go prop) (go j))
306 go (CppAccessor prop j) = f (CppAccessor (go prop) (go j))
302 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
307 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
303 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
308 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
@@ -328,7 +333,7 @@ everywhereOnCppTopDownM f = f >=> go
328 go (CppArrayLiteral cpp) = CppArrayLiteral <$> traverse f' cpp
333 go (CppArrayLiteral cpp) = CppArrayLiteral <$> traverse f' cpp
329 go (CppDataLiteral cpp) = CppDataLiteral <$> traverse f' cpp
334 go (CppDataLiteral cpp) = CppDataLiteral <$> traverse f' cpp
330 go (CppIndexer j1 j2) = CppIndexer <$> f' j1 <*> f' j2
335 go (CppIndexer j1 j2) = CppIndexer <$> f' j1 <*> f' j2
331− go (CppObjectLiteral t cpp) = CppObjectLiteral t <$> traverse (sndM f') cpp
336+ go (CppObjectLiteral t cpps) = CppObjectLiteral t <$> traverse (pairM f' f') cpps
332 go (CppAccessor prop j) = CppAccessor prop <$> f' j
337 go (CppAccessor prop j) = CppAccessor prop <$> f' j
333 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
338 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
334 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
339 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
@@ -341,7 +346,7 @@ everywhereOnCppTopDownM f = f >=> go
341 go (CppAssignment j1 j2) = CppAssignment <$> f' j1 <*> f' j2
346 go (CppAssignment j1 j2) = CppAssignment <$> f' j1 <*> f' j2
342 go (CppWhile j1 j2) = CppWhile <$> f' j1 <*> f' j2
347 go (CppWhile j1 j2) = CppWhile <$> f' j1 <*> f' j2
343 go (CppIfElse j1 j2 j3) = CppIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
348 go (CppIfElse j1 j2 j3) = CppIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
344− go (CppSwitch cpp cpps) = CppSwitch <$> f' cpp <*> traverse (sndM f') cpps
349+ go (CppSwitch cpp cpps) = CppSwitch <$> f' cpp <*> traverse (pairM f' f') cpps
345 go (CppReturn j) = CppReturn <$> f' j
350 go (CppReturn j) = CppReturn <$> f' j
346 go (CppThrow j) = CppThrow <$> f' j
351 go (CppThrow j) = CppThrow <$> f' j
347 go (CppComment com j) = CppComment com <$> f' j
352 go (CppComment com j) = CppComment com <$> f' j
@@ -355,7 +360,7 @@ everythingOnCpp (<>) f = go
355 go j@(CppArrayLiteral cpp) = foldl (<>) (f j) (map go cpp)
360 go j@(CppArrayLiteral cpp) = foldl (<>) (f j) (map go cpp)
356 go j@(CppDataLiteral cpp) = foldl (<>) (f j) (map go cpp)
361 go j@(CppDataLiteral cpp) = foldl (<>) (f j) (map go cpp)
357 go j@(CppIndexer j1 j2) = f j <> go j1 <> go j2
362 go j@(CppIndexer j1 j2) = f j <> go j1 <> go j2
358− go j@(CppObjectLiteral _ cpp) = foldl (<>) (f j) (map (go . snd) cpp)
363+ go j@(CppObjectLiteral _ cpps) = foldl (<>) (f j) ((map (go . fst) cpps) ++ (map (go . snd) cpps))
359 go j@(CppAccessor j1 j2) = f j <> go j1 <> go j2
364 go j@(CppAccessor j1 j2) = f j <> go j1 <> go j2
360 go j@(CppFunction _ _ _ _ j1) = f j <> go j1
365 go j@(CppFunction _ _ _ _ j1) = f j <> go j1
361 go j@(CppLambda _ _ _ j1) = f j <> go j1
366 go j@(CppLambda _ _ _ j1) = f j <> go j1
@@ -369,7 +374,7 @@ everythingOnCpp (<>) f = go
369 go j@(CppWhile j1 j2) = f j <> go j1 <> go j2
374 go j@(CppWhile j1 j2) = f j <> go j1 <> go j2
370 go j@(CppIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
375 go j@(CppIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
371 go j@(CppIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
376 go j@(CppIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
372− go j@(CppSwitch cpp cpps) = foldl (<>) (f j <> go cpp) (map (go . snd) cpps)
377+ go j@(CppSwitch cpp cpps) = foldl (<>) (f j <> go cpp) ((map (go . fst) cpps) ++ (map (go . snd) cpps))
373 go j@(CppReturn j1) = f j <> go j1
378 go j@(CppReturn j1) = f j <> go j1
374 go j@(CppThrow j1) = f j <> go j1
379 go j@(CppThrow j1) = f j <> go j1
375 go j@(CppComment _ j1) = f j <> go j1
380 go j@(CppComment _ j1) = f j <> go j1
src/Language/PureScript/CodeGen/Cpp/Common.hs+2
@@ -167,6 +167,7 @@ nameIsCppReserved name =
167 , "string"
167 , "string"
168 , "struct"
168 , "struct"
169 , "switch"
169 , "switch"
170+ , "symbol"
170 , "template"
171 , "template"
171 , "this"
172 , "this"
172 , "thread_local"
173 , "thread_local"
@@ -178,6 +179,7 @@ nameIsCppReserved name =
178 , "typename"
179 , "typename"
179 , "typeof"
180 , "typeof"
180 , "union"
181 , "union"
182+ , "unknown_size"
181 , "unsigned"
183 , "unsigned"
182 , "using"
184 , "using"
183 , "virtual"
185 , "virtual"
src/Language/PureScript/CodeGen/Cpp/File.hs+1−1
@@ -141,7 +141,7 @@ toBody = catMaybes . map go
141 addCaptures :: Cpp -> Cpp
141 addCaptures :: Cpp -> Cpp
142 addCaptures (CppObjectLiteral t objs) = CppObjectLiteral t (objlam <$> objs)
142 addCaptures (CppObjectLiteral t objs) = CppObjectLiteral t (objlam <$> objs)
143 where
143 where
144− objlam :: (String, Cpp) -> (String, Cpp)
144+ objlam :: (Cpp, Cpp) -> (Cpp, Cpp)
145 objlam (name', (CppLambda _ args rty body)) = (name' , CppLambda [] args rty $ addCaptures body)
145 objlam (name', (CppLambda _ args rty body)) = (name' , CppLambda [] args rty $ addCaptures body)
146 objlam obj = obj
146 objlam obj = obj
147 addCaptures (CppApp (CppLambda _ [] rty body) []) = CppApp (CppLambda [] [] rty (addCaptures body)) []
147 addCaptures (CppApp (CppLambda _ [] rty body) []) = CppApp (CppLambda [] [] rty (addCaptures body)) []
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+1−1
@@ -128,7 +128,7 @@ inlineST = everywhereOnCpp convertBlock
128 -- or in a more aggressive way, turning wrappers into local variables depending on the
128 -- or in a more aggressive way, turning wrappers into local variables depending on the
129 -- agg(ressive) parameter.
129 -- agg(ressive) parameter.
130 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =
130 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =
131− CppLambda [CppCaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppObjectLiteral CppRecord [(C.stRefValue, arg)]])
131+ CppLambda [CppCaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppObjectLiteral CppRecord [(CppSymbol C.stRefValue, arg)]])
132 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =
132 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =
133 if agg then ref else CppAccessor (CppVar C.stRefValue) ref
133 if agg then ref else CppAccessor (CppVar C.stRefValue) ref
134 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
134 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
src/Language/PureScript/CodeGen/Cpp/Types.hs+14−4
@@ -124,11 +124,18 @@ stringType = CppPrimitive "string"
124charType :: CppType
124charType :: CppType
125charType = CppPrimitive "char"
125charType = CppPrimitive "char"
126
126
127−mapType :: CppType
127+voidType :: CppType
128−mapType = CppPrimitive "any::map"
128+voidType = CppPrimitive "void"
129
129
130+mapType :: Int -> CppType
131+mapType = maptype
132+ where
133+ maptype 0 = mapprim "unknown_size"
134+ maptype n = mapprim $ show n
135+ mapprim s = CppPrimitive $ "any::map<" ++ s ++ ">"
136+
130−dataType :: CppType
137+dataType :: Int -> CppType
131−dataType = CppPrimitive "any::data"
138+dataType n = CppPrimitive $ "any::data<" ++ show n ++ ">"
132
139
133arrayType :: CppType
140arrayType :: CppType
134arrayType = CppPrimitive "any::array"
141arrayType = CppPrimitive "any::array"
@@ -141,3 +148,6 @@ ctorKey = "constructor"
141
148
142constAnyRef :: Maybe CppType
149constAnyRef :: Maybe CppType
143constAnyRef = Just $ CppAny [CppConst, CppRef]
150constAnyRef = Just $ CppAny [CppConst, CppRef]
151+
152+symbolname :: String -> String
153+symbolname = identToCpp . Ident
src/Language/PureScript/Pretty/Cpp.hs+7−6
@@ -40,7 +40,6 @@ import qualified Control.Arrow as A
40import Language.PureScript.CodeGen.Cpp.AST
40import Language.PureScript.CodeGen.Cpp.AST
41import Language.PureScript.CodeGen.Cpp.Types
41import Language.PureScript.CodeGen.Cpp.Types
42import Language.PureScript.Comments
42import Language.PureScript.Comments
43−-- import Language.PureScript.Pretty.Common
44import qualified Language.PureScript.Constants as C
43import qualified Language.PureScript.Constants as C
45import Numeric
44import Numeric
46-- import Debug.Trace
45-- import Debug.Trace
@@ -104,7 +103,7 @@ literals = mkPattern' match
104 , return " }"
103 , return " }"
105 ]
104 ]
106 match (CppDataLiteral xs) = fmap concat $ sequence
105 match (CppDataLiteral xs) = fmap concat $ sequence
107− [ return $ runType dataType
106+ [ return $ runType (dataType $ length xs)
108 , return "{ "
107 , return "{ "
109 , fmap (intercalate ", ") $ forM xs prettyPrintCpp'
108 , fmap (intercalate ", ") $ forM xs prettyPrintCpp'
110 , return " }"
109 , return " }"
@@ -118,17 +117,17 @@ literals = mkPattern' match
118 , return " }"
117 , return " }"
119 ]
118 ]
120 match (CppObjectLiteral _ ps) = fmap concat $ sequence
119 match (CppObjectLiteral _ ps) = fmap concat $ sequence
121− [ return $ runType mapType ++ "{\n"
120+ [ return $ runType (mapType $ length ps + 1) ++ "{{\n"
122 , withIndent $ do
121 , withIndent $ do
123 cpps <- forM ps $ \(key, value) -> do
122 cpps <- forM ps $ \(key, value) -> do
124 value' <- prettyPrintCpp' value
123 value' <- prettyPrintCpp' value
125− key' <- prettyPrintCpp' (CppStringLiteral key)
124+ key' <- prettyPrintCpp' key
126 return $ "{ " ++ key' ++ ", " ++ value' ++ " }"
125 return $ "{ " ++ key' ++ ", " ++ value' ++ " }"
127 indentString <- currentIndent
126 indentString <- currentIndent
128− return $ intercalate ", \n" $ map (indentString ++) cpps
127+ return $ intercalate ", \n" $ map (indentString ++) (cpps ++ ["{ nullptr, nullptr }"])
129 , return "\n"
128 , return "\n"
130 , currentIndent
129 , currentIndent
131− , return "}"
130+ , return "}}"
132 ]
131 ]
133
132
134 match (CppFunction name args rty qs ret) =
133 match (CppFunction name args rty qs ret) =
@@ -196,6 +195,7 @@ literals = mkPattern' match
196 isUseNamespace :: Cpp -> Bool
195 isUseNamespace :: Cpp -> Bool
197 isUseNamespace (CppUseNamespace{}) = True
196 isUseNamespace (CppUseNamespace{}) = True
198 isUseNamespace _ = False
197 isUseNamespace _ = False
198+ match (CppStruct (name) []) = return $ "struct " ++ name ++ " {}"
199 match (CppStruct (name) mems) = fmap concat $ sequence $
199 match (CppStruct (name) mems) = fmap concat $ sequence $
200 [ return "\n"
200 [ return "\n"
201 , currentIndent
201 , currentIndent
@@ -240,6 +240,7 @@ literals = mkPattern' match
240
240
241 match (CppVar ident) | ident == C.__unused = match (CppVar $ '$':ident)
241 match (CppVar ident) | ident == C.__unused = match (CppVar $ '$':ident)
242 match (CppVar ident) = return ident
242 match (CppVar ident) = return ident
243+ match (CppSymbol ident) = return $ "SYMBOL" ++ parens (symbolname ident)
243 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)
244 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)
244 match (CppVariableIntroduction (ident, typ) qs value)
245 match (CppVariableIntroduction (ident, typ) qs value)
245 | ident == C.__unused = match (CppVariableIntroduction ('$':ident, typ) qs value)
246 | ident == C.__unused = match (CppVariableIntroduction ('$':ident, typ) qs value)