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

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

on 87cb81f help sign in

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

280 lines 10 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 {

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

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

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

23 return INDIRECTION(variant.ACCESSOR); \

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

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

27 if (variant.tag == tag_t::Closure) {

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

29 }

30 assert(variant.tag == tag_t::Function);

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

32}

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

35 assert(tag == tag_t::Thunk);

36 return (*t)(unthunk);

37}

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

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

41 if (variant.tag == tag_t::EffClosure) {

42 return (*variant.k)();

43 }

44 assert(variant.tag == tag_t::EffFunction);

45 return (*variant.e)();

46}

48any::operator int() const {

49 RETURN_VALUE(tag_t::Integer, i,)

50}

52any::operator double() const {

53 RETURN_VALUE(tag_t::Double, d,)

54}

56any::operator bool() const {

57 RETURN_VALUE(tag_t::Boolean, b,)

58}

60any::operator char() const {

61 RETURN_VALUE(tag_t::Character, c,)

62}

64any::operator cstring() const {

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

66 if (variant.tag == tag_t::StringLiteral) {

67 return variant.r;

68 }

69 assert(variant.tag == tag_t::String);

70 return variant.s->c_str();

71}

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

74 RETURN_VALUE(tag_t::Array, a, *)

75}

77auto any::extractPointer(IF_DEBUG(const any::tag_t t)) const -> void* {

78 RETURN_VALUE(t, POINTER_FROM_MEMBER(p),)

79}

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

82 const any * variant = &a;

83 while (variant->tag == tag_t::Thunk) {

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

85 }

86 return *variant;

87}

89auto any::operator[](const symbol_t key) const -> const any& {

90 return get(key, cast<map<unknown_size>>(*this));

91}

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

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

95 return xs[rhs];

96}

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

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

100 return xs[cast<int>(rhs)];

101}

102

103auto any::contains(const symbol_t key) const -> bool {

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

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

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

107 do {

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

109 return true;

110 }

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

112 return false;

113}

114

115//-----------------------------------------------------------------------------

116// Operator helper macros

117//-----------------------------------------------------------------------------

118

119#define DEFINE_CSTR_EQUALS_OPERATOR() \

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

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

122 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \

123 if (lhs.tag == any::tag_t::StringLiteral) { \

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

125 } \

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

127 } \

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

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

130 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \

131 if (rhs.tag == any::tag_t::StringLiteral) { \

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

133 } \

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

135 }

136

137#define DEFINE_CSTR_COMPARISON_OPERATOR(op) \

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

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

140 } \

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

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

143 }

144

145#define DEFINE_COMPARISON_OPERATOR(op) \

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

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

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

149 switch (lhs.tag) { \

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

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

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

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

154 case any::tag_t::StringLiteral: \

155 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \

156 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \

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

158 case any::tag_t::String: \

159 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String); \

160 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String); \

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

162 case any::tag_t::Pointer: return lhs.p op rhs.p; \

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

164 } \

165 return false; \

166 }

167

168//-----------------------------------------------------------------------------

169// Operator definitions

170//-----------------------------------------------------------------------------

171

172DEFINE_COMPARISON_OPERATOR(==)

173DEFINE_COMPARISON_OPERATOR(!=)

174DEFINE_COMPARISON_OPERATOR(<)

175DEFINE_COMPARISON_OPERATOR(<=)

176DEFINE_COMPARISON_OPERATOR(>)

177DEFINE_COMPARISON_OPERATOR(>=)

178

179DEFINE_CSTR_EQUALS_OPERATOR()

180DEFINE_CSTR_COMPARISON_OPERATOR(!=)

181DEFINE_CSTR_COMPARISON_OPERATOR(<)

182DEFINE_CSTR_COMPARISON_OPERATOR(<=)

183DEFINE_CSTR_COMPARISON_OPERATOR(>)

184DEFINE_CSTR_COMPARISON_OPERATOR(>=)

185

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

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

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

189 switch (lhs.tag) {

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

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

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

193 case any::tag_t::StringLiteral:

194 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);

195 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);

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

197 case any::tag_t::String:

198 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);

199 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);

200 return rhs.tag == any::tag_t::StringLiteral ? *lhs.s + rhs.r : *lhs.s + *rhs.s;

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

202 }

203 return nullptr;

204}

205

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

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

208 assert(lhs.tag == any::tag_t::StringLiteral || lhs.tag == any::tag_t::String);

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

210}

211

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

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

214 assert(rhs.tag == any::tag_t::StringLiteral || rhs.tag == any::tag_t::String);

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

216}

217

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

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

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

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

222 switch (lhs.tag) {

223 case any::tag_t::Integer: return lhs.i - rhs.i;

224 case any::tag_t::Double: return lhs.d - rhs.d;

225 case any::tag_t::Character: return any(char(lhs.c - rhs.c));

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

227 }

228 return nullptr;

229}

230

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

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

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

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

235 switch (lhs.tag) {

236 case any::tag_t::Integer: return lhs.i * rhs.i;

237 case any::tag_t::Double: return lhs.d * rhs.d;

238 case any::tag_t::Character: return any(char(lhs.c * rhs.c));

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

240 }

241 return nullptr;

242}

243

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

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

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

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

248 switch (lhs.tag) {

249 case any::tag_t::Integer: return lhs.i / rhs.i;

250 case any::tag_t::Double: return lhs.d / rhs.d;

251 case any::tag_t::Character: return any(char(lhs.c / rhs.c));

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

253 }

254 return nullptr;

255}

256

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

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

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

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

261 switch (lhs.tag) {

262 case any::tag_t::Integer: return lhs.i % rhs.i;

263 case any::tag_t::Character: return any(char(lhs.c % rhs.c));

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

265 }

266 return nullptr;

267}

268

269// unary negate

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

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

272 switch (rhs.tag) {

273 case any::tag_t::Integer: return (- rhs.i);

274 case any::tag_t::Double: return (- rhs.d);

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

276 }

277 return nullptr;

278}

279

280} // namespace PureScript