The Sol Programming Language!
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

642 lines
16 KiB

  1. #include "sol.h"
  2. #include <stdlib.h>
  3. #include <string.h>
  4. #include <stdio.h>
  5. #include <assert.h>
  6. sol_object_t *sol_cast_int(sol_state_t *state, sol_object_t *obj) {
  7. sol_object_t *res, *ls;
  8. if(sol_is_int(obj)) return obj;
  9. ls = sol_new_list(state);
  10. sol_list_insert(state, ls, 0, obj);
  11. res = obj->ops->toint(state, ls);
  12. sol_obj_free(ls);
  13. sol_obj_free(obj);
  14. return res;
  15. }
  16. sol_object_t *sol_cast_float(sol_state_t *state, sol_object_t *obj) {
  17. sol_object_t *res, *ls;
  18. if(sol_is_float(obj)) return obj;
  19. ls = sol_new_list(state);
  20. sol_list_insert(state, ls, 0, obj);
  21. res = obj->ops->tofloat(state, ls);
  22. sol_obj_free(ls);
  23. sol_obj_free(obj);
  24. return res;
  25. }
  26. sol_object_t *sol_cast_string(sol_state_t *state, sol_object_t *obj) {
  27. sol_object_t *res, *ls;
  28. if(sol_is_string(obj)) return obj;
  29. ls = sol_new_list(state);
  30. sol_list_insert(state, ls, 0, obj);
  31. res = obj->ops->tostring(state, ls);
  32. sol_obj_free(ls);
  33. sol_obj_free(obj);
  34. return res;
  35. }
  36. // This will not fail here; error checking is done in sol_state_init().
  37. sol_object_t *sol_new_singlet(sol_state_t *state) {
  38. sol_object_t *res = malloc(sizeof(sol_object_t));
  39. if(res) {
  40. res->type = SOL_SINGLET;
  41. res->refcnt = 0;
  42. res->ops = &(state->NullOps);
  43. }
  44. return sol_incref(res);
  45. }
  46. // And, now, for the rest of the checked stuff...
  47. sol_object_t *sol_alloc_object(sol_state_t *state) {
  48. sol_object_t *res = malloc(sizeof(sol_object_t));
  49. if(!res) {
  50. sol_set_error(state, state->OutOfMemory);
  51. return sol_incref(state->None);
  52. }
  53. res->refcnt = 0;
  54. res->ops = &(state->NullOps);
  55. return sol_incref(res);
  56. }
  57. void sol_init_object(sol_state_t *state, sol_object_t *obj) {
  58. if(obj->ops->init) obj->ops->init(state, obj);
  59. }
  60. void sol_obj_free(sol_object_t *obj) {
  61. if(!obj) {
  62. printf("WARNING: Attempt to free NULL\n");
  63. return;
  64. }
  65. if(sol_decref(obj) <= 0) {
  66. if(obj->refcnt < 0) {
  67. printf("WARNING: Encountered refcnt < 0!\nObject %p type %d ref %d\n", obj, obj->type, obj->refcnt);
  68. } else {
  69. sol_obj_release(obj);
  70. }
  71. }
  72. }
  73. void sol_obj_release(sol_object_t *obj) {
  74. if(obj->ops->free) obj->ops->free(NULL, obj);
  75. free(obj);
  76. }
  77. sol_object_t *sol_new_int(sol_state_t *state, long i) {
  78. sol_object_t *res = sol_alloc_object(state);
  79. if(sol_has_error(state)) {
  80. sol_obj_free(res);
  81. return sol_incref(state->None);
  82. }
  83. res->type = SOL_INTEGER;
  84. res->ival = i;
  85. res->ops = &(state->IntOps);
  86. sol_init_object(state, res);
  87. return res;
  88. }
  89. sol_object_t *sol_new_float(sol_state_t *state, double f) {
  90. sol_object_t *res = sol_alloc_object(state);
  91. if(sol_has_error(state)) {
  92. sol_obj_free(res);
  93. return sol_incref(state->None);
  94. }
  95. res->type = SOL_FLOAT;
  96. res->fval = f;
  97. res->ops = &(state->FloatOps);
  98. sol_init_object(state, res);
  99. return res;
  100. }
  101. sol_object_t *sol_new_string(sol_state_t *state, const char *s) {
  102. sol_object_t *res = sol_alloc_object(state);
  103. if(sol_has_error(state)) {
  104. sol_obj_free(res);
  105. return sol_incref(state->None);
  106. }
  107. res->type = SOL_STRING;
  108. res->str = strdup(s);
  109. if(!res->str) {
  110. sol_obj_free(res);
  111. sol_set_error(state, state->OutOfMemory);
  112. return sol_incref(state->None);
  113. }
  114. res->ops = &(state->StringOps);
  115. sol_init_object(state, res);
  116. return res;
  117. }
  118. sol_object_t *sol_f_str_free(sol_state_t *state, sol_object_t *obj) {
  119. free(obj->str);
  120. return obj;
  121. }
  122. sol_object_t *sol_new_list(sol_state_t *state) {
  123. sol_object_t *res = sol_alloc_object(state);
  124. if(sol_has_error(state)) {
  125. sol_obj_free(res);
  126. return sol_incref(state->None);
  127. }
  128. res->type = SOL_LIST;
  129. res->lvalue = NULL;
  130. res->lnext = NULL;
  131. res->ops = &(state->ListOps);
  132. sol_init_object(state, res);
  133. return res;
  134. }
  135. int sol_list_len(sol_state_t *state, sol_object_t *list) {
  136. int i = 0;
  137. sol_object_t *cur = list;
  138. if(!sol_is_list(list)) {
  139. sol_obj_free(sol_set_error_string(state, "Compute length of non-list"));
  140. return -1;
  141. }
  142. while(cur) {
  143. if(cur->lvalue) i++;
  144. cur = cur->lnext;
  145. }
  146. return i;
  147. }
  148. sol_object_t *sol_list_sublist(sol_state_t *state, sol_object_t *list, int idx) {
  149. int i = 0;
  150. sol_object_t *cur = list;
  151. sol_object_t *copy, *res;
  152. if(idx < 0) {
  153. return sol_set_error_string(state, "Create sublist at negative index");
  154. }
  155. while(cur && i < idx) {
  156. if(cur->lvalue) i++;
  157. cur = cur->lnext;
  158. }
  159. copy = sol_new_list(state);
  160. res = copy;
  161. while(cur) {
  162. if(cur->lvalue) {
  163. copy->lvalue = sol_incref(cur->lvalue);
  164. if(cur->lnext) {
  165. copy->lnext = sol_alloc_object(state);
  166. copy = copy->lnext;
  167. copy->type = SOL_LCELL;
  168. copy->ops = &(state->LCellOps);
  169. copy->lnext = NULL;
  170. copy->lvalue = NULL;
  171. }
  172. }
  173. cur = cur->lnext;
  174. }
  175. return res;
  176. }
  177. sol_object_t *sol_list_get_index(sol_state_t *state, sol_object_t *list, int idx) {
  178. sol_object_t *cur = list;
  179. int i = 0;
  180. if(!sol_is_list(list)) {
  181. return sol_set_error_string(state, "Get index of non-list");
  182. }
  183. if(idx < 0) {
  184. return sol_set_error_string(state, "Get negative index");
  185. }
  186. while(cur && i < idx) {
  187. if(cur->lvalue) i++;
  188. cur = cur->lnext;
  189. }
  190. while(cur && !cur->lvalue) cur = cur->lnext;
  191. if(cur) {
  192. return sol_incref(cur->lvalue);
  193. } else {
  194. return sol_set_error_string(state, "Get out-of-bounds index");
  195. }
  196. }
  197. void sol_list_set_index(sol_state_t *state, sol_object_t *list, int idx, sol_object_t *obj) {
  198. sol_object_t *cur = list, *temp;
  199. int i = 0;
  200. if(!sol_is_list(list)) {
  201. sol_obj_free(sol_set_error_string(state, "Set index of non-list"));
  202. return;
  203. }
  204. if(idx < 0) {
  205. sol_obj_free(sol_set_error_string(state, "Set negative index"));
  206. return;
  207. }
  208. while(cur && i < idx) {
  209. if(cur->lvalue) i++;
  210. cur = cur->lnext;
  211. }
  212. if(cur) {
  213. temp = cur->lvalue;
  214. cur->lvalue = sol_incref(obj);
  215. sol_obj_free(temp);
  216. } else {
  217. sol_obj_free(sol_set_error_string(state, "Set out-of-bounds index"));
  218. return;
  219. }
  220. }
  221. void sol_list_insert(sol_state_t *state, sol_object_t *list, int idx, sol_object_t *obj) {
  222. sol_object_t *next = list, *prev = NULL, *temp = sol_alloc_object(state);
  223. int i = 0;
  224. if(sol_has_error(state)) return;
  225. if(!sol_is_list(list)) {
  226. sol_obj_free(sol_set_error_string(state, "Insert into non-list"));
  227. return;
  228. }
  229. if(idx < 0) {
  230. sol_obj_free(sol_set_error_string(state, "Insert at negative index"));
  231. return;
  232. }
  233. temp->type = SOL_LCELL;
  234. temp->ops = &(state->LCellOps);
  235. temp->lvalue = sol_incref(obj);
  236. while(next && i < idx) {
  237. if(next->lvalue) i++;
  238. prev = next;
  239. next = next->lnext;
  240. }
  241. if(next) {
  242. if(prev) {
  243. prev->lnext = temp;
  244. temp->lnext = next;
  245. } else {
  246. assert(next == list);
  247. temp->lnext = sol_alloc_object(state);
  248. temp->lnext->type = SOL_LCELL;
  249. temp->lnext->ops = &(state->LCellOps);
  250. temp->lnext->lvalue = list->lvalue;
  251. temp->lnext->lnext = list->lnext;
  252. list->lnext = temp;
  253. list->lvalue = NULL;
  254. }
  255. } else {
  256. if(prev) {
  257. prev->lnext = temp;
  258. temp->lnext = NULL;
  259. } else {
  260. sol_obj_free(temp->lvalue);
  261. sol_obj_free(temp);
  262. sol_obj_free(sol_set_error_string(state, "Out-of-bounds insert"));
  263. return;
  264. }
  265. }
  266. assert(!sol_validate_list(state, list));
  267. }
  268. sol_object_t *sol_list_remove(sol_state_t *state, sol_object_t *list, int idx) {
  269. sol_object_t *next = list, *prev = NULL, *res, *temp;
  270. int i = 0;
  271. if(sol_has_error(state)) return sol_incref(state->None);
  272. if(idx < 0) {
  273. return sol_set_error_string(state, "Remove from negative index");
  274. }
  275. while(next && i < idx) {
  276. if(next->lvalue) i++;
  277. prev = next;
  278. next = next->lnext;
  279. }
  280. if(next) {
  281. if(prev) {
  282. res = next->lvalue;
  283. prev->lnext = next->lnext;
  284. sol_obj_free(next);
  285. } else {
  286. res = list->lvalue;
  287. list->lvalue = NULL;
  288. }
  289. assert(!sol_validate_list(state, list));
  290. return res;
  291. } else {
  292. return sol_set_error_string(state, "Out-of-bounds remove");
  293. }
  294. }
  295. sol_object_t *sol_list_copy(sol_state_t *state, sol_object_t *list) {
  296. sol_object_t *newls = sol_new_list(state), *cur = list;
  297. sol_object_t *res = newls;
  298. while(cur->lvalue) {
  299. newls->lvalue = sol_incref(cur->lvalue);
  300. if(cur->lnext) {
  301. newls->lnext = sol_alloc_object(state);
  302. if(sol_has_error(state)) return sol_incref(state->None);
  303. newls = newls->lnext;
  304. newls->type = SOL_LCELL;
  305. newls->ops = &(state->LCellOps);
  306. }
  307. cur = cur->lnext;
  308. }
  309. return res;
  310. }
  311. void sol_list_append(sol_state_t *state, sol_object_t *dest, sol_object_t *src) {
  312. sol_object_t *curd = dest, *curs = src;
  313. while(curd->lnext) curd = curd->lnext;
  314. while(curs) {
  315. if(curs->lvalue) {
  316. curd->lvalue = sol_incref(curs->lvalue);
  317. curd->lnext = sol_alloc_object(state);
  318. if(sol_has_error(state)) return;
  319. curd = curd->lnext;
  320. curd->type = SOL_LCELL;
  321. curd->ops = &(state->LCellOps);
  322. curd->lnext = NULL;
  323. curd->lvalue = NULL;
  324. }
  325. curs = curs->lnext;
  326. }
  327. }
  328. sol_object_t *sol_f_list_free(sol_state_t *state, sol_object_t *list) {
  329. sol_object_t *cur = list, *prev;
  330. while(cur) {
  331. prev = cur;
  332. cur = cur->lnext;
  333. if(prev!=list) sol_obj_free(prev);
  334. }
  335. return list;
  336. }
  337. sol_object_t *sol_f_lcell_free(sol_state_t *state, sol_object_t *lcell) {
  338. if(lcell->lvalue) sol_obj_free(lcell->lvalue);
  339. return lcell;
  340. }
  341. int sol_test_cycle(sol_state_t *state, sol_object_t *seq) {
  342. sol_object_t *seen[1024]={};
  343. sol_object_t *cur = seq, **item;
  344. while(cur) {
  345. item = seen;
  346. while(*item) {
  347. if(*item == cur) return 1;
  348. item++;
  349. }
  350. *item = cur;
  351. if(sol_is_list(seq)) {
  352. cur = cur->lnext;
  353. } else {
  354. cur = cur->mnext;
  355. }
  356. }
  357. return 0;
  358. }
  359. int sol_validate_list(sol_state_t *state, sol_object_t *list) {
  360. sol_object_t *cur = list;
  361. int i = 0;
  362. char msg[128];
  363. while(cur) {
  364. if(!sol_is_list(cur)) {
  365. snprintf(msg, 128, "Node at index %d not a list node", i);
  366. sol_obj_free(sol_set_error_string(state, msg));
  367. return 1;
  368. }
  369. /*if(cur->lnext && !cur->lvalue) {
  370. snprintf(msg, 128, "Node at index %d has a next node but NULL value", i);
  371. sol_obj_free(sol_set_error_string(state, msg));
  372. return 1;
  373. }*/
  374. cur = cur->lnext;
  375. i++;
  376. }
  377. if(sol_test_cycle(state, list)) {
  378. snprintf(msg, 128, "Cycle detected");
  379. sol_obj_free(sol_set_error_string(state, msg));
  380. return 1;
  381. }
  382. return 0;
  383. }
  384. sol_object_t *sol_new_map(sol_state_t *state) {
  385. sol_object_t *map = sol_alloc_object(state);
  386. if(sol_has_error(state)) return sol_incref(state->None);
  387. map->type = SOL_MAP;
  388. map->ops = &(state->MapOps);
  389. map->mkey = NULL;
  390. map->mval = NULL;
  391. map->mnext = NULL;
  392. }
  393. int sol_map_len(sol_state_t *state, sol_object_t *map) {
  394. int i = 0;
  395. sol_object_t *cur = map;
  396. while(cur) {
  397. if(cur->mkey) i++;
  398. cur = cur->mnext;
  399. }
  400. return i;
  401. }
  402. sol_object_t *sol_map_submap(sol_state_t *state, sol_object_t *map, sol_object_t *key) {
  403. sol_object_t *list = sol_new_list(state), *res = NULL, *cur = map, *cmp;
  404. sol_list_insert(state, list, 0, key);
  405. while(cur) {
  406. if(cur->mkey) {
  407. sol_list_insert(state, list, 1, cur->mkey);
  408. cmp = sol_cast_int(state, key->ops->cmp(state, list));
  409. sol_list_remove(state, list, 1);
  410. if(cmp->ival == 0) {
  411. res = cur;
  412. break;
  413. }
  414. }
  415. cur = cur->mnext;
  416. }
  417. if(res) {
  418. return sol_incref(res);
  419. } else {
  420. return sol_incref(state->None);
  421. }
  422. }
  423. sol_object_t *sol_map_get(sol_state_t *state, sol_object_t *map, sol_object_t *key) {
  424. sol_object_t *submap = sol_map_submap(state, map, key);
  425. sol_object_t *res;
  426. if(sol_is_map(submap)) {
  427. res = sol_incref(submap->mval);
  428. return res;
  429. } else {
  430. return sol_incref(state->None);
  431. }
  432. }
  433. sol_object_t *sol_map_get_name(sol_state_t *state, sol_object_t *map, char *name) {
  434. sol_object_t *key = sol_new_string(state, name);
  435. sol_object_t *res = sol_map_get(state, map, key);
  436. sol_obj_free(key);
  437. return res;
  438. }
  439. void sol_map_set(sol_state_t *state, sol_object_t *map, sol_object_t *key, sol_object_t *val) {
  440. sol_object_t *cur = map, *prev = NULL, *list = sol_new_list(state), *cmp;
  441. sol_list_insert(state, list, 0, key);
  442. while(cur) {
  443. if(cur->mkey) {
  444. sol_list_insert(state, list, 1, cur->mkey);
  445. cmp = sol_cast_int(state, key->ops->cmp(state, list));
  446. sol_list_remove(state, list, 1);
  447. if(cmp->ival == 0) {
  448. if(sol_is_none(state, val)) {
  449. if(prev) {
  450. prev->mnext = cur->mnext;
  451. sol_obj_free(cur);
  452. } else {
  453. sol_obj_free(cur->mkey);
  454. sol_obj_free(cur->mval);
  455. cur->mkey = NULL;
  456. cur->mval = NULL;
  457. }
  458. } else {
  459. cur->mval = sol_incref(val);
  460. }
  461. return;
  462. }
  463. }
  464. prev = cur;
  465. cur = cur->mnext;
  466. }
  467. if(sol_is_none(state, val)) return;
  468. prev->mnext = sol_alloc_object(state);
  469. if(sol_has_error(state)) return;
  470. cur = prev->mnext;
  471. cur->type = SOL_MCELL;
  472. cur->ops = &(state->MCellOps);
  473. cur->mkey = sol_incref(key);
  474. cur->mval = sol_incref(val);
  475. cur->mnext = NULL;
  476. }
  477. void sol_map_set_name(sol_state_t *state, sol_object_t *map, char *name, sol_object_t *val) {
  478. sol_object_t *key = sol_new_string(state, name);
  479. sol_map_set(state, map, key, val);
  480. sol_obj_free(key);
  481. }
  482. void sol_map_set_existing(sol_state_t *state, sol_object_t *map, sol_object_t *key, sol_object_t *val) {
  483. sol_object_t *cur = map, *prev = NULL, *list = sol_new_list(state), *cmp;
  484. sol_list_insert(state, list, 0, key);
  485. while(cur) {
  486. if(cur->mkey) {
  487. sol_list_insert(state, list, 1, cur->mkey);
  488. cmp = sol_cast_int(state, key->ops->cmp(state, list));
  489. sol_obj_free(sol_list_remove(state, list, 1));
  490. if(cmp->ival == 0) {
  491. if(sol_is_none(state, val)) {
  492. if(prev) {
  493. prev->mnext = cur->mnext;
  494. sol_obj_free(cur);
  495. } else {
  496. sol_obj_free(cur->mkey);
  497. sol_obj_free(cur->mval);
  498. cur->mkey = NULL;
  499. cur->mval = NULL;
  500. }
  501. } else {
  502. cur->mval = sol_incref(val);
  503. }
  504. return;
  505. }
  506. }
  507. prev = cur;
  508. cur = cur->mnext;
  509. }
  510. }
  511. sol_object_t *sol_map_copy(sol_state_t *state, sol_object_t *map) {
  512. sol_object_t *newmap = sol_new_map(state), *newcur = newmap, *cur = map;
  513. while(cur) {
  514. if(cur->mkey) {
  515. newcur->mkey = sol_incref(cur->mkey);
  516. newcur->mval = sol_incref(cur->mval);
  517. newcur->mnext = sol_alloc_object(state);
  518. newcur = newcur->mnext;
  519. newcur->type = SOL_MCELL;
  520. newcur->ops = &(state->MCellOps);
  521. newcur->mkey = NULL;
  522. newcur->mval = NULL;
  523. newcur->mnext = NULL;
  524. }
  525. cur = cur->mnext;
  526. }
  527. return newmap;
  528. }
  529. void sol_map_merge(sol_state_t *state, sol_object_t *dest, sol_object_t *src) {
  530. sol_object_t *cur = src;
  531. while(cur) {
  532. if(cur->mkey) {
  533. sol_map_set(state, dest, cur->mkey, cur->mval);
  534. }
  535. cur = cur->mnext;
  536. }
  537. }
  538. void sol_map_merge_existing(sol_state_t *state, sol_object_t *dest, sol_object_t *src) {
  539. sol_object_t *cur = src;
  540. while(cur) {
  541. if(cur->mkey) {
  542. sol_map_set_existing(state, dest, cur->mkey, cur->mval);
  543. }
  544. cur = cur->mnext;
  545. }
  546. }
  547. sol_object_t *sol_f_map_free(sol_state_t *state, sol_object_t *map) {
  548. sol_object_t *cur = map, *prev;
  549. while(cur) {
  550. if(cur->mkey) {
  551. sol_obj_free(cur->mkey);
  552. sol_obj_free(cur->mval);
  553. }
  554. prev = cur;
  555. cur = cur->mnext;
  556. if(prev!=map) free(prev);
  557. }
  558. return map;
  559. }
  560. sol_object_t *sol_f_mcell_free(sol_state_t *state, sol_object_t *mcell) {
  561. if(mcell->mkey) sol_obj_free(mcell->mkey);
  562. if(mcell->mval) sol_obj_free(mcell->mval);
  563. return mcell;
  564. }
  565. int sol_validate_map(sol_state_t *state, sol_object_t *map) {
  566. sol_object_t *cur = map;
  567. int i = 0;
  568. char msg[128];
  569. while(cur) {
  570. if(!sol_is_map(cur)) {
  571. snprintf(msg, 128, "Node at index %d not a map node", i);
  572. sol_obj_free(sol_set_error_string(state, msg));
  573. return 1;
  574. }
  575. if(cur->mnext && (!cur->mkey || !cur->mval)) {
  576. snprintf(msg, 128, "Node at index %d has a next node but NULL key or value", i);
  577. sol_obj_free(sol_set_error_string(state, msg));
  578. return 1;
  579. }
  580. cur = cur->mnext;
  581. i++;
  582. }
  583. return 0;
  584. }
  585. sol_object_t *sol_new_cfunc(sol_state_t *state, sol_cfunc_t cfunc) {
  586. sol_object_t *res = sol_alloc_object(state);
  587. res->type = SOL_CFUNCTION;
  588. res->ops = &(state->CFuncOps);
  589. res->cfunc = cfunc;
  590. return res;
  591. }
  592. sol_object_t *sol_new_cdata(sol_state_t *state, void *cdata, sol_ops_t *ops) {
  593. sol_object_t *res = sol_alloc_object(state);
  594. res->type = SOL_CDATA;
  595. res->ops = ops;
  596. res->cdata = cdata;
  597. return res;
  598. }