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

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

on bf64471 help sign in

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

241 lines 8.1 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 (*static_cast<const Closure*>(POINTER_FROM_MEMBER(variant.p)))(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 (*static_cast<const EffClosure*>(POINTER_FROM_MEMBER(variant.p)))();

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 char32_t() const {

64 RETURN_VALUE(Tag::Character, c,)

65}

67any::operator char() const {

68 const auto val = static_cast<decltype(c)>(*this);

69 assert(val <= std::numeric_limits<char>::max());

70 return static_cast<char>(val);

71}

73any::operator size_t() const {

74 const auto val = static_cast<decltype(i)>(*this);

75 assert(val >= 0);

76 return static_cast<size_t>(val);

77}

79any::operator const string&() const {

80 return *static_cast<const string*>(extractPointer(IF_DEBUG(Tag::String)));

81}

83any::operator const char *() const {

84 return static_cast<const string*>(extractPointer(IF_DEBUG(Tag::String)))->c_str();

85}

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

88 return *static_cast<const array*>(extractPointer(IF_DEBUG(Tag::Array)));

89}

91any::operator const record&() const {

92 return *static_cast<const record*>(extractPointer(IF_DEBUG(Tag::Record)));

93}

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

96 RETURN_VALUE(t, POINTER_FROM_MEMBER(p),)

97}

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

100 const any * variant = &a;

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

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

103 }

104 return *variant;

105}

106

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

108 assert(rhs >= 0);

109 const auto& xs = static_cast<const array&>(*this);

110 return xs[rhs];

111}

112

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

114 return static_cast<const array&>(*this).size();

115}

116

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

118 return static_cast<const array&>(*this).empty();

119}

120

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

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

123 const auto& m =

124 *static_cast<const any::dict<unknown_size>*>(this->extractPointer(IF_DEBUG(any::Tag::Dictionary)));

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

126 do {

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

128 return true;

129 }

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

131 return false;

132}

133

134auto any::cstr_cmp::operator ()(const char * a, const char * b) const -> bool {

135 return a == b ? false : std::strcmp(a, b) < 0;

136}

137

138auto any::at(const char * key) const -> const any& {

139 return static_cast<const record&>(*this).at(key);

140}

141

142//-----------------------------------------------------------------------------

143// Operator helper macros

144//-----------------------------------------------------------------------------

145

146#define DEFINE_COMPARISON_OPERATOR(op) \

147 auto operator op (const any& lhs_, const any& rhs) -> bool { \

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

149 switch (lhs.tag) { \

150 case any::Tag::Integer: return lhs.i op static_cast<decltype(any::i)>(rhs); \

151 case any::Tag::Double: return lhs.d op static_cast<decltype(any::d)>(rhs); \

152 case any::Tag::Character: return lhs.c op static_cast<decltype(any::c)>(rhs); \

153 case any::Tag::Boolean: return lhs.b op static_cast<decltype(any::b)>(rhs); \

154 case any::Tag::String: return *static_cast<const string*>(POINTER_FROM_MEMBER(lhs.p)) \

155 op static_cast<const string&>(rhs); \

156 case any::Tag::RawPointer: return lhs.v op static_cast<decltype(any::v)>(rhs); \

157 case any::Tag::Pointer: return lhs.p op any::unthunkVariant(rhs).p; \

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

159 } \

160 return false; \

161 }

162

163//-----------------------------------------------------------------------------

164// Operator definitions

165//-----------------------------------------------------------------------------

166

167DEFINE_COMPARISON_OPERATOR(==)

168DEFINE_COMPARISON_OPERATOR(!=)

169DEFINE_COMPARISON_OPERATOR(<)

170DEFINE_COMPARISON_OPERATOR(<=)

171DEFINE_COMPARISON_OPERATOR(>)

172DEFINE_COMPARISON_OPERATOR(>=)

173

174auto operator+(const any& lhs_, const any& rhs) -> any {

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

176 switch (lhs.tag) {

177 case any::Tag::Integer: return lhs.i + static_cast<decltype(any::i)>(rhs);

178 case any::Tag::Double: return lhs.d + static_cast<decltype(any::d)>(rhs);

179 case any::Tag::Character: return decltype(any::c){lhs.c + static_cast<decltype(any::c)>(rhs)};

180 case any::Tag::String: return *static_cast<const string*>(POINTER_FROM_MEMBER(lhs.p))

181 + static_cast<const string&>(rhs);

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

183 }

184 return nullptr;

185}

186

187auto operator-(const any& lhs_, const any& rhs) -> any {

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

189 switch (lhs.tag) {

190 case any::Tag::Integer: return lhs.i - static_cast<decltype(any::i)>(rhs);

191 case any::Tag::Double: return lhs.d - static_cast<decltype(any::d)>(rhs);

192 case any::Tag::Character: return decltype(any::c){lhs.c - static_cast<decltype(any::c)>(rhs)};

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

194 }

195 return nullptr;

196}

197

198auto operator*(const any& lhs_, const any& rhs) -> any {

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

200 switch (lhs.tag) {

201 case any::Tag::Integer: return lhs.i * static_cast<decltype(any::i)>(rhs);

202 case any::Tag::Double: return lhs.d * static_cast<decltype(any::d)>(rhs);

203 case any::Tag::Character: return decltype(lhs.c){lhs.c - static_cast<decltype(any::c)>(rhs)};

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

205 }

206 return nullptr;

207}

208

209auto operator/(const any& lhs_, const any& rhs) -> any {

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

211 switch (lhs.tag) {

212 case any::Tag::Integer: return lhs.i / static_cast<decltype(any::i)>(rhs);

213 case any::Tag::Double: return lhs.d / static_cast<decltype(any::d)>(rhs);

214 case any::Tag::Character: return decltype(any::c){lhs.c / static_cast<decltype(any::c)>(rhs)};

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

216 }

217 return nullptr;

218}

219

220auto operator%(const any& lhs_, const any& rhs) -> any {

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

222 switch (lhs.tag) {

223 case any::Tag::Integer: return lhs.i % static_cast<decltype(any::i)>(rhs);

224 case any::Tag::Character: return decltype(any::c){lhs.c % static_cast<decltype(any::c)>(rhs)};

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

226 }

227 return nullptr;

228}

229

230// unary negate

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

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

233 switch (rhs.tag) {

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

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

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

237 }

238 return nullptr;

239}

240

241} // namespace PureScript