pcc/runtime/purescript.cc · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on de13186 help sign in

rowtype-yoga/purescript-native/pcc/runtime/purescript.cc

288 lines 10.0 kB history raw

1///////////////////////////////////////////////////////////////////////////////

2//

3// Module : purescript.cc

4// Copyright : (c) Andy Arvanitis 2015

5// License : MIT

6//

7// Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>

8// Stability : experimental

9// Portability :

10//

11// Basic types and functions to support purescript-to-C++1x rendering

12//

13///////////////////////////////////////////////////////////////////////////////

14//

15#include <cstring>

16#include "PureScript.hh"

18namespace PureScript {

20any::Closure::~Closure() {}

21any::EffClosure::~EffClosure() {}

23#define RETURN_VALUE(TAG, ACCESSOR, INDIRECTION) \

24 const any& variant = unthunkVariant(*this); \

25 assert(variant.tag == TAG); \

26 return INDIRECTION(variant.ACCESSOR); \

28auto any::operator()(const any& arg) const -> any {

29 const any& variant = unthunkVariant(*this);

30 if (variant.tag == Tag::Closure) {

31 return (*variant.l)(arg);

32 }

33 assert(variant.tag == Tag::Function);

34 return (*variant.f)(arg);

35}

37auto any::operator()(const as_thunk) const -> const any& {

38 assert(tag == Tag::Thunk);

39 return (*t)(unthunk);

40}

42auto any::operator()() const -> any {

43 const any& variant = unthunkVariant(*this);

44 if (variant.tag == Tag::EffClosure) {

45 return (*variant.k)();

46 }

47 assert(variant.tag == Tag::EffFunction);

48 return (*variant.e)();

49}

51any::operator int() const {

52 RETURN_VALUE(Tag::Integer, i,)

53}

55any::operator double() const {

56 RETURN_VALUE(Tag::Double, d,)

57}

59any::operator bool() const {

60 RETURN_VALUE(Tag::Boolean, b,)

61}

63any::operator char() const {

64 RETURN_VALUE(Tag::Character, c,)

65}

67any::operator size_t() const {

68 const auto sz = cast<int>(*this);

69 assert(sz >= 0);

70 return static_cast<size_t>(sz);

71}

73any::operator cstring() const {

74 const any& variant = unthunkVariant(*this);

75 if (variant.tag == Tag::StringLiteral) {

76 return variant.r;

77 }

78 assert(variant.tag == Tag::String);

79 return variant.s->c_str();

80}

82any::operator const array&() const {

83 RETURN_VALUE(Tag::Array, a, *)

84}

86auto any::extractPointer(IF_DEBUG(const any::Tag t)) const -> void* {

87 RETURN_VALUE(t, POINTER_FROM_MEMBER(p),)

88}

90auto any::unthunkVariant(const any& a) -> const any& {

91 const any * variant = &a;

92 while (variant->tag == Tag::Thunk) {

93 variant = &((*variant->t)(unthunk));

94 }

95 return *variant;

96}

98auto any::operator[](const size_t rhs) const -> const any& {

99 const auto& xs = cast<array>(*this);

100 return xs[rhs];

101}

102

103auto any::size() const -> size_t {

104 return cast<array>(*this).size();

105}

106

107auto any::empty() const -> bool {

108 return cast<array>(*this).empty();

109}

110

111auto any::contains(const Private::Symbol key) const -> bool {

112 // TODO: assumes at least one element -- safe assumption?

113 const auto& m = cast<map<unknown_size>>(*this);

114 std::remove_reference<decltype(m)>::type::size_type i = 0;

115 do {

116 if (m[i].first == key) {

117 return true;

118 }

119 } while (m[++i].first != nullptr);

120 return false;

121}

122

123//-----------------------------------------------------------------------------

124// Operator helper macros

125//-----------------------------------------------------------------------------

126

127#define DEFINE_CSTR_EQUALS_OPERATOR() \

128 auto operator==(const any& lhs_, const char * rhs) -> bool { \

129 const any& lhs = any::unthunkVariant(lhs_); \

130 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String); \

131 if (lhs.tag == any::Tag::StringLiteral) { \

132 return (lhs.r == rhs) || (strcmp(lhs.r, rhs) == 0); \

133 } \

134 return strcmp(lhs.s->c_str(), rhs) == 0; \

135 } \

136 auto operator==(const char * lhs, const any& rhs_) -> bool { \

137 const any& rhs = any::unthunkVariant(rhs_); \

138 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String); \

139 if (rhs.tag == any::Tag::StringLiteral) { \

140 return (lhs == rhs.r) || (strcmp(lhs, rhs) == 0); \

141 } \

142 return strcmp(lhs, rhs.s->c_str()) == 0; \

143 }

144

145#define DEFINE_CSTR_COMPARISON_OPERATOR(op) \

146 auto operator op (const any& lhs, const char * rhs) -> bool { \

147 return strcmp(cast<cstring>(lhs), rhs) op 0; \

148 } \

149 auto operator op (const char * lhs, const any& rhs) -> bool { \

150 return strcmp(lhs, cast<cstring>(rhs)) op 0; \

151 }

152

153#define DEFINE_COMPARISON_OPERATOR(op) \

154 auto operator op (const any& lhs_, const any& rhs_) -> bool { \

155 const any& lhs = any::unthunkVariant(lhs_); \

156 const any& rhs = any::unthunkVariant(rhs_); \

157 switch (lhs.tag) { \

158 case any::Tag::Integer: assert(lhs.tag == any::Tag::Integer); return lhs.i op rhs.i; \

159 case any::Tag::Double: assert(lhs.tag == any::Tag::Double); return lhs.d op rhs.d; \

160 case any::Tag::Character: assert(lhs.tag == any::Tag::Character); return lhs.c op rhs.c; \

161 case any::Tag::Boolean: assert(lhs.tag == any::Tag::Boolean); return lhs.b op rhs.b; \

162 case any::Tag::StringLiteral: \

163 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String); \

164 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String); \

165 return strcmp(lhs.r, rhs.tag == any::Tag::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \

166 case any::Tag::String: \

167 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String); \

168 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String); \

169 return strcmp(lhs.s->c_str(), rhs.tag == any::Tag::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \

170 case any::Tag::Pointer: return lhs.p op rhs.p; \

171 default: assert(false && "Unsupported tag for operator " #op); \

172 } \

173 return false; \

174 }

175

176//-----------------------------------------------------------------------------

177// Operator definitions

178//-----------------------------------------------------------------------------

179

180DEFINE_COMPARISON_OPERATOR(==)

181DEFINE_COMPARISON_OPERATOR(!=)

182DEFINE_COMPARISON_OPERATOR(<)

183DEFINE_COMPARISON_OPERATOR(<=)

184DEFINE_COMPARISON_OPERATOR(>)

185DEFINE_COMPARISON_OPERATOR(>=)

186

187DEFINE_CSTR_EQUALS_OPERATOR()

188DEFINE_CSTR_COMPARISON_OPERATOR(!=)

189DEFINE_CSTR_COMPARISON_OPERATOR(<)

190DEFINE_CSTR_COMPARISON_OPERATOR(<=)

191DEFINE_CSTR_COMPARISON_OPERATOR(>)

192DEFINE_CSTR_COMPARISON_OPERATOR(>=)

193

194auto operator+(const any& lhs_, const any& rhs_) -> any {

195 const any& lhs = any::unthunkVariant(lhs_);

196 const any& rhs = any::unthunkVariant(rhs_);

197 switch (lhs.tag) {

198 case any::Tag::Integer: assert(lhs.tag == any::Tag::Integer); return lhs.i + rhs.i;

199 case any::Tag::Double: assert(lhs.tag == any::Tag::Double); return lhs.d + rhs.d;

200 case any::Tag::Character: assert(lhs.tag == any::Tag::Character); return any(char(lhs.c + rhs.c));

201 case any::Tag::StringLiteral:

202 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String);

203 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String);

204 return rhs.tag == any::Tag::StringLiteral ? std::string(lhs.r) + rhs.r : lhs.r + *rhs.s;

205 case any::Tag::String:

206 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String);

207 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String);

208 return rhs.tag == any::Tag::StringLiteral ? *lhs.s + rhs.r : *lhs.s + *rhs.s;

209 default: assert(false && "Unsupported tag for '+' operator");

210 }

211 return nullptr;

212}

213

214auto operator+(const any& lhs_, const char * rhs) -> std::string {

215 const any& lhs = any::unthunkVariant(lhs_);

216 assert(lhs.tag == any::Tag::StringLiteral || lhs.tag == any::Tag::String);

217 return lhs.tag == any::Tag::StringLiteral ? std::string(lhs.r) + rhs : *lhs.s + rhs;

218}

219

220auto operator+(const char * lhs, const any& rhs_) -> std::string {

221 const any& rhs = any::unthunkVariant(rhs_);

222 assert(rhs.tag == any::Tag::StringLiteral || rhs.tag == any::Tag::String);

223 return rhs.tag == any::Tag::StringLiteral ? lhs + std::string(rhs.r) : lhs + *rhs.s;

224}

225

226auto operator-(const any& lhs_, const any& rhs_) -> any {

227 const any& lhs = any::unthunkVariant(lhs_);

228 const any& rhs = any::unthunkVariant(rhs_);

229 assert(lhs.tag == rhs.tag);

230 switch (lhs.tag) {

231 case any::Tag::Integer: return lhs.i - rhs.i;

232 case any::Tag::Double: return lhs.d - rhs.d;

233 case any::Tag::Character: return any(char(lhs.c - rhs.c));

234 default: assert(false && "Unsupported tag for '-' operator");

235 }

236 return nullptr;

237}

238

239auto operator*(const any& lhs_, const any& rhs_) -> any {

240 const any& lhs = any::unthunkVariant(lhs_);

241 const any& rhs = any::unthunkVariant(rhs_);

242 assert(lhs.tag == rhs.tag);

243 switch (lhs.tag) {

244 case any::Tag::Integer: return lhs.i * rhs.i;

245 case any::Tag::Double: return lhs.d * rhs.d;

246 case any::Tag::Character: return any(char(lhs.c * rhs.c));

247 default: assert(false && "Unsupported tag for '*' operator");

248 }

249 return nullptr;

250}

251

252auto operator/(const any& lhs_, const any& rhs_) -> any {

253 const any& lhs = any::unthunkVariant(lhs_);

254 const any& rhs = any::unthunkVariant(rhs_);

255 assert(lhs.tag == rhs.tag);

256 switch (lhs.tag) {

257 case any::Tag::Integer: return lhs.i / rhs.i;

258 case any::Tag::Double: return lhs.d / rhs.d;

259 case any::Tag::Character: return any(char(lhs.c / rhs.c));

260 default: assert(false && "Unsupported tag for '/' operator");

261 }

262 return nullptr;

263}

264

265auto operator%(const any& lhs_, const any& rhs_) -> any {

266 const any& lhs = any::unthunkVariant(lhs_);

267 const any& rhs = any::unthunkVariant(rhs_);

268 assert(lhs.tag == rhs.tag);

269 switch (lhs.tag) {

270 case any::Tag::Integer: return lhs.i % rhs.i;

271 case any::Tag::Character: return any(char(lhs.c % rhs.c));

272 default: assert(false && "Unsupported tag for '%' operator");

273 }

274 return nullptr;

275}

276

277// unary negate

278auto operator-(const any& rhs_) -> any {

279 const any& rhs = any::unthunkVariant(rhs_);

280 switch (rhs.tag) {

281 case any::Tag::Integer: return (- rhs.i);

282 case any::Tag::Double: return (- rhs.d);

283 default: assert(false && "Unsupported tag for unary '-' operator");

284 }

285 return nullptr;

286}

287

288} // namespace PureScript