Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

builtins.c 8.3KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360
  1. #include "vm/builtins.h"
  2. #include <stdio.h>
  3. static void print_val(struct l2_vm *vm, struct l2_io_writer *out, struct l2_vm_value *val) {
  4. switch (l2_value_get_type(val)) {
  5. case L2_VAL_TYPE_NONE:
  6. l2_io_printf(out, "(none)");
  7. break;
  8. case L2_VAL_TYPE_ATOM:
  9. if (val->atom == vm->values[vm->ktrue].atom) {
  10. l2_io_printf(out, "(true)");
  11. } else if (val->atom == vm->values[vm->kfalse].atom) {
  12. l2_io_printf(out, "(false)");
  13. } else {
  14. l2_io_printf(out, "(atom %u)", val->atom);
  15. }
  16. break;
  17. case L2_VAL_TYPE_REAL:
  18. l2_io_printf(out, "%g", val->real);
  19. break;
  20. case L2_VAL_TYPE_BUFFER:
  21. if (val->buffer != NULL) {
  22. out->write(out, val->buffer, val->extra.buf_length);
  23. }
  24. break;
  25. case L2_VAL_TYPE_ARRAY:
  26. out->write(out, "[", 1);
  27. for (size_t i = 0; i < val->extra.arr_length; ++i) {
  28. if (i != 0) {
  29. out->write(out, " ", 1);
  30. }
  31. print_val(vm, out, &vm->values[val->array->data[i]]);
  32. }
  33. out->write(out, "]", 1);
  34. break;
  35. case L2_VAL_TYPE_NAMESPACE:
  36. l2_io_printf(out, "(namespace)");
  37. break;
  38. case L2_VAL_TYPE_FUNCTION:
  39. case L2_VAL_TYPE_CFUNCTION:
  40. l2_io_printf(out, "(function)");
  41. break;
  42. case L2_VAL_TYPE_ERROR:
  43. l2_io_printf(out, "(error: %s)", val->error);
  44. break;
  45. case L2_VAL_TYPE_CONTINUATION:
  46. l2_io_printf(out, "(continuation)");
  47. break;
  48. }
  49. }
  50. l2_word l2_builtin_add(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  51. if (argc < 1) {
  52. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  53. vm->values[id].real = 0;
  54. return id;
  55. }
  56. struct l2_vm_value *val = &vm->values[argv[0]];
  57. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  58. return l2_vm_type_error(vm, val);
  59. }
  60. double sum = val->real;
  61. for (l2_word i = 1; i < argc; ++i) {
  62. val = &vm->values[argv[i]];
  63. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  64. return l2_vm_type_error(vm, val);
  65. }
  66. sum += val->real;
  67. }
  68. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  69. vm->values[id].real = sum;
  70. return id;
  71. }
  72. l2_word l2_builtin_sub(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  73. if (argc < 1) {
  74. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  75. vm->values[id].real = 0;
  76. return id;
  77. }
  78. struct l2_vm_value *val = &vm->values[argv[0]];
  79. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  80. return l2_vm_type_error(vm, val);
  81. }
  82. double sum = val->real;
  83. for (l2_word i = 1; i < argc; ++i) {
  84. val = &vm->values[argv[i]];
  85. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  86. return l2_vm_type_error(vm, val);
  87. }
  88. sum -= val->real;
  89. }
  90. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  91. vm->values[id].real = sum;
  92. return id;
  93. }
  94. l2_word l2_builtin_mul(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  95. if (argc < 1) {
  96. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  97. vm->values[id].real = 1;
  98. return id;
  99. }
  100. struct l2_vm_value *val = &vm->values[argv[0]];
  101. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  102. return l2_vm_type_error(vm, val);
  103. }
  104. double sum = val->real;
  105. for (l2_word i = 1; i < argc; ++i) {
  106. val = &vm->values[argv[i]];
  107. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  108. return l2_vm_type_error(vm, val);
  109. }
  110. sum *= val->real;
  111. }
  112. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  113. vm->values[id].real = sum;
  114. return id;
  115. }
  116. l2_word l2_builtin_div(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  117. if (argc < 1) {
  118. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  119. vm->values[id].real = 1;
  120. return id;
  121. }
  122. struct l2_vm_value *val = &vm->values[argv[0]];
  123. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  124. return l2_vm_type_error(vm, val);
  125. }
  126. double sum = val->real;
  127. for (l2_word i = 1; i < argc; ++i) {
  128. val = &vm->values[argv[i]];
  129. if (l2_value_get_type(val) != L2_VAL_TYPE_REAL) {
  130. return l2_vm_type_error(vm, val);
  131. }
  132. sum /= val->real;
  133. }
  134. l2_word id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  135. vm->values[id].real = sum;
  136. return id;
  137. }
  138. l2_word l2_builtin_eq(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  139. if (argc < 2) {
  140. return vm->ktrue;
  141. }
  142. for (l2_word i = 1; i < argc; ++i) {
  143. if (argv[i - 1] == argv[i]) continue;
  144. struct l2_vm_value *a = &vm->values[argv[i - 1]];
  145. struct l2_vm_value *b = &vm->values[argv[i]];
  146. if (a->flags != b->flags) {
  147. return vm->kfalse;
  148. }
  149. enum l2_value_type typ = l2_value_get_type(a);
  150. if (typ == L2_VAL_TYPE_ATOM) {
  151. if (a->atom != b->atom) {
  152. return vm->kfalse;
  153. }
  154. } else if (typ == L2_VAL_TYPE_REAL) {
  155. if (a->real != b->real) {
  156. return vm->kfalse;
  157. }
  158. } else if (typ == L2_VAL_TYPE_BUFFER) {
  159. if (a->buffer == NULL && b->buffer == NULL) continue;
  160. if (a->buffer == NULL || b->buffer == NULL) {
  161. return vm->kfalse;
  162. }
  163. if (a->extra.buf_length != b->extra.buf_length) {
  164. return vm->kfalse;
  165. }
  166. if (memcmp(a->buffer, b->buffer, a->extra.buf_length) != 0) {
  167. return vm->kfalse;
  168. }
  169. } else {
  170. return vm->kfalse;
  171. }
  172. }
  173. return vm->ktrue;
  174. }
  175. l2_word l2_builtin_neq(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  176. l2_word ret_id = l2_builtin_eq(vm, argc, argv);
  177. if (ret_id == vm->ktrue) {
  178. return vm->kfalse;
  179. } else if (ret_id == vm->kfalse) {
  180. return vm->ktrue;
  181. } else {
  182. return ret_id;
  183. }
  184. }
  185. #define X(name, op) \
  186. l2_word name(struct l2_vm *vm, l2_word argc, l2_word *argv) { \
  187. if (argc < 2) { \
  188. return vm->ktrue; \
  189. } \
  190. struct l2_vm_value *lhs = &vm->values[argv[0]]; \
  191. if (l2_value_get_type(lhs) != L2_VAL_TYPE_REAL) { \
  192. return l2_vm_type_error(vm, lhs); \
  193. } \
  194. for (l2_word i = 1; i < argc; ++i) { \
  195. struct l2_vm_value *rhs = &vm->values[argv[i]]; \
  196. if (l2_value_get_type(rhs) != L2_VAL_TYPE_REAL) { \
  197. return l2_vm_type_error(vm, rhs); \
  198. } \
  199. if (!(lhs->real op rhs->real)) { \
  200. return vm->kfalse; \
  201. } \
  202. lhs = rhs; \
  203. } \
  204. return vm->ktrue; \
  205. }
  206. X(l2_builtin_lt, <)
  207. X(l2_builtin_lteq, <=)
  208. X(l2_builtin_gt, >)
  209. X(l2_builtin_gteq, >=)
  210. #undef X
  211. l2_word l2_builtin_print(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  212. for (size_t i = 0; i < argc; ++i) {
  213. if (i != 0) {
  214. vm->std_output->write(vm->std_output, " ", 1);
  215. }
  216. struct l2_vm_value *val = &vm->values[argv[i]];
  217. print_val(vm, vm->std_output, val);
  218. }
  219. vm->std_output->write(vm->std_output, "\n", 1);
  220. return 0;
  221. }
  222. l2_word l2_builtin_len(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  223. if (argc != 1) {
  224. return l2_vm_error(vm, "Expected 1 argument");
  225. }
  226. l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_REAL, 0);
  227. struct l2_vm_value *ret = &vm->values[ret_id];
  228. ret->real = 0;
  229. struct l2_vm_value *val = &vm->values[argv[0]];
  230. switch (l2_value_get_type(val)) {
  231. case L2_VAL_TYPE_NONE:
  232. case L2_VAL_TYPE_ATOM:
  233. case L2_VAL_TYPE_REAL:
  234. case L2_VAL_TYPE_FUNCTION:
  235. case L2_VAL_TYPE_CFUNCTION:
  236. case L2_VAL_TYPE_ERROR:
  237. case L2_VAL_TYPE_CONTINUATION:
  238. break;
  239. case L2_VAL_TYPE_BUFFER:
  240. ret->real = val->extra.buf_length;
  241. break;
  242. case L2_VAL_TYPE_ARRAY:
  243. ret->real = val->extra.arr_length;
  244. break;
  245. case L2_VAL_TYPE_NAMESPACE:
  246. if (val->ns) {
  247. ret->real = val->ns->len;
  248. }
  249. }
  250. return ret_id;
  251. }
  252. l2_word l2_builtin_if(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  253. if (argc != 2 && argc != 3) {
  254. return l2_vm_error(vm, "Expected 2 or 3 arguments");
  255. }
  256. if (l2_vm_val_is_true(vm, argv[0])) {
  257. l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0);
  258. struct l2_vm_value *ret = &vm->values[ret_id];
  259. ret->extra.cont_call = argv[1];
  260. return ret_id;
  261. } else if (argc == 3) {
  262. l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0);
  263. struct l2_vm_value *ret = &vm->values[ret_id];
  264. ret->extra.cont_call = argv[2];
  265. return ret_id;
  266. } else {
  267. return 0;
  268. }
  269. }
  270. struct loop_context {
  271. struct l2_vm_contcontext base;
  272. l2_word cond;
  273. };
  274. static l2_word loop_callback(struct l2_vm *vm, l2_word retval, l2_word cont) {
  275. if (l2_vm_val_is_true(vm, retval)) {
  276. return cont;
  277. }
  278. return retval;
  279. }
  280. static void loop_marker(
  281. struct l2_vm *vm, void *data, void (*mark)(struct l2_vm *vm, l2_word id)) {
  282. struct loop_context *ctx = data;
  283. mark(vm, ctx->cond);
  284. }
  285. l2_word l2_builtin_loop(struct l2_vm *vm, l2_word argc, l2_word *argv) {
  286. if (argc != 1) {
  287. return l2_vm_error(vm, "Expected 1 argument");
  288. }
  289. struct loop_context *ctx = malloc(sizeof(*ctx));
  290. if (ctx == NULL) {
  291. return l2_vm_error(vm, "Allocation failure");
  292. }
  293. ctx->base.callback = loop_callback;
  294. ctx->base.marker = loop_marker;
  295. ctx->cond = argv[0];
  296. l2_word cont_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0);
  297. struct l2_vm_value *cont = &vm->values[cont_id];
  298. cont->extra.cont_call = argv[0];
  299. cont->cont = &ctx->base;
  300. return cont_id;
  301. }