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

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

on fc1751c help sign in

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

294 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(TYPE, ACCESSOR, INDIRECTION) \

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

22 assert(variant.type == TYPE); \

23 return INDIRECTION(variant.ACCESSOR); \

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

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

27 if (variant.type == Type::Closure) {

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

29 }

30 assert(variant.type == Type::Function);

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

32}

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

35 assert(type == Type::Thunk);

36 return (*t)(unthunk);

37}

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

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

41 if (variant.type == Type::EffClosure) {

42 return (*variant.k)();

43 }

44 assert(variant.type == Type::EffFunction);

45 return (*variant.e)();

46}

48any::operator int() const {

49 RETURN_VALUE(Type::Integer, i,)

50}

52any::operator double() const {

53 RETURN_VALUE(Type::Double, d,)

54}

56any::operator bool() const {

57 RETURN_VALUE(Type::Boolean, b,)

58}

60any::operator char() const {

61 RETURN_VALUE(Type::Character, c,)

62}

64any::operator cstring() const {

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

66 if (variant.type == Type::StringLiteral) {

67 return variant.r;

68 }

69 assert(variant.type == Type::String);

70 return variant.s->c_str();

71}

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

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

75}

77auto any::extractPointer(IF_DEBUG(const any::Type 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->type == Type::Thunk) {

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

85 }

86 return *variant;

87}

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

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

91 assert(variant.type == Type::Map);

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

93 const auto m = cast<map<1>>(variant);

94 decltype(m)::size_type i = 0;

95 do {

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

97 return m[i].second;

98 }

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

100 throw runtime_error("map key not found");

101}

102

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

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

105 assert(variant.type == Type::Array);

106 return (*variant.a)[rhs];

107}

108

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

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

111 assert(variant.type == Type::Array);

112 return (*variant.a)[cast<int>(rhs)];

113}

114

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

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

117 assert(variant.type == Type::Map);

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

119 const auto m = cast<map<1>>(variant);

120 decltype(m)::size_type i = 0;

121 do {

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

123 return true;

124 }

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

126 return false;

127}

128

129//-----------------------------------------------------------------------------

130// Operator helper macros

131//-----------------------------------------------------------------------------

132

133#define DEFINE_CSTR_EQUALS_OPERATOR() \

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

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

136 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \

137 if (lhs.type == any::Type::StringLiteral) { \

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

139 } \

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

141 } \

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

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

144 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \

145 if (rhs.type == any::Type::StringLiteral) { \

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

147 } \

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

149 }

150

151#define DEFINE_CSTR_COMPARISON_OPERATOR(op) \

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

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

154 } \

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

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

157 }

158

159#define DEFINE_COMPARISON_OPERATOR(op) \

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

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

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

163 switch (lhs.type) { \

164 case any::Type::Integer: assert(lhs.type == any::Type::Integer); return lhs.i op rhs.i; \

165 case any::Type::Double: assert(lhs.type == any::Type::Double); return lhs.d op rhs.d; \

166 case any::Type::Character: assert(lhs.type == any::Type::Character); return lhs.c op rhs.c; \

167 case any::Type::Boolean: assert(lhs.type == any::Type::Boolean); return lhs.b op rhs.b; \

168 case any::Type::StringLiteral: \

169 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \

170 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \

171 return strcmp(lhs.r, rhs.type == any::Type::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \

172 case any::Type::String: \

173 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String); \

174 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String); \

175 return strcmp(lhs.s->c_str(), rhs.type == any::Type::StringLiteral ? rhs.r : rhs.s->c_str()) op 0; \

176 case any::Type::Pointer: return lhs.p op rhs.p; \

177 default: assert(false && "Unsupported type for operator " #op); \

178 } \

179 return false; \

180 }

181

182//-----------------------------------------------------------------------------

183// Operator definitions

184//-----------------------------------------------------------------------------

185

186DEFINE_COMPARISON_OPERATOR(==)

187DEFINE_COMPARISON_OPERATOR(!=)

188DEFINE_COMPARISON_OPERATOR(<)

189DEFINE_COMPARISON_OPERATOR(<=)

190DEFINE_COMPARISON_OPERATOR(>)

191DEFINE_COMPARISON_OPERATOR(>=)

192

193DEFINE_CSTR_EQUALS_OPERATOR()

194DEFINE_CSTR_COMPARISON_OPERATOR(!=)

195DEFINE_CSTR_COMPARISON_OPERATOR(<)

196DEFINE_CSTR_COMPARISON_OPERATOR(<=)

197DEFINE_CSTR_COMPARISON_OPERATOR(>)

198DEFINE_CSTR_COMPARISON_OPERATOR(>=)

199

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

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

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

203 switch (lhs.type) {

204 case any::Type::Integer: assert(lhs.type == any::Type::Integer); return lhs.i + rhs.i;

205 case any::Type::Double: assert(lhs.type == any::Type::Double); return lhs.d + rhs.d;

206 case any::Type::Character: assert(lhs.type == any::Type::Character); return any(char(lhs.c + rhs.c));

207 case any::Type::StringLiteral:

208 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);

209 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);

210 return rhs.type == any::Type::StringLiteral ? std::string(lhs.r) + rhs.r : lhs.r + *rhs.s;

211 case any::Type::String:

212 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);

213 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);

214 return rhs.type == any::Type::StringLiteral ? *lhs.s + rhs.r : *lhs.s + *rhs.s;

215 default: assert(false && "Unsupported type for '+' operator");

216 }

217 return nullptr;

218}

219

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

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

222 assert(lhs.type == any::Type::StringLiteral || lhs.type == any::Type::String);

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

224}

225

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

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

228 assert(rhs.type == any::Type::StringLiteral || rhs.type == any::Type::String);

229 return rhs.type == any::Type::StringLiteral ? lhs + std::string(rhs.r) : lhs + *rhs.s;

230}

231

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

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

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

235 assert(lhs.type == rhs.type);

236 switch (lhs.type) {

237 case any::Type::Integer: return lhs.i - rhs.i;

238 case any::Type::Double: return lhs.d - rhs.d;

239 case any::Type::Character: return any(char(lhs.c - rhs.c));

240 default: assert(false && "Unsupported type for '-' operator");

241 }

242 return nullptr;

243}

244

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

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

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

248 assert(lhs.type == rhs.type);

249 switch (lhs.type) {

250 case any::Type::Integer: return lhs.i * rhs.i;

251 case any::Type::Double: return lhs.d * rhs.d;

252 case any::Type::Character: return any(char(lhs.c * rhs.c));

253 default: assert(false && "Unsupported type for '*' operator");

254 }

255 return nullptr;

256}

257

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

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

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

261 assert(lhs.type == rhs.type);

262 switch (lhs.type) {

263 case any::Type::Integer: return lhs.i / rhs.i;

264 case any::Type::Double: return lhs.d / rhs.d;

265 case any::Type::Character: return any(char(lhs.c / rhs.c));

266 default: assert(false && "Unsupported type for '/' operator");

267 }

268 return nullptr;

269}

270

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

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

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

274 assert(lhs.type == rhs.type);

275 switch (lhs.type) {

276 case any::Type::Integer: return lhs.i % rhs.i;

277 case any::Type::Character: return any(char(lhs.c % rhs.c));

278 default: assert(false && "Unsupported type for '%' operator");

279 }

280 return nullptr;

281}

282

283// unary negate

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

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

286 switch (rhs.type) {

287 case any::Type::Integer: return (- rhs.i);

288 case any::Type::Double: return (- rhs.d);

289 default: assert(false && "Unsupported type for unary '-' operator");

290 }

291 return nullptr;

292}

293

294} // namespace PureScript