Reference


conditionals.c

  1. #include "mpc.h"
  2. #ifdef _WIN32
  3. static char buffer[2048];
  4. char* readline(char* prompt) {
  5. fputs(prompt, stdout);
  6. fgets(buffer, 2048, stdin);
  7. char* cpy = malloc(strlen(buffer)+1);
  8. strcpy(cpy, buffer);
  9. cpy[strlen(cpy)-1] = '\0';
  10. return cpy;
  11. }
  12. void add_history(char* unused) {}
  13. #else
  14. #include <editline/readline.h>
  15. #include <editline/history.h>
  16. #endif
  17. /* Forward Declarations */
  18. struct lval;
  19. struct lenv;
  20. typedef struct lval lval;
  21. typedef struct lenv lenv;
  22. /* Lisp Value */
  23. enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_FUN, LVAL_SEXPR, LVAL_QEXPR };
  24. typedef lval*(*lbuiltin)(lenv*, lval*);
  25. struct lval {
  26. int type;
  27. /* Basic */
  28. long num;
  29. char* err;
  30. char* sym;
  31. /* Function */
  32. lbuiltin builtin;
  33. lenv* env;
  34. lval* formals;
  35. lval* body;
  36. /* Expression */
  37. int count;
  38. lval** cell;
  39. };
  40. lval* lval_num(long x) {
  41. lval* v = malloc(sizeof(lval));
  42. v->type = LVAL_NUM;
  43. v->num = x;
  44. return v;
  45. }
  46. lval* lval_err(char* fmt, ...) {
  47. lval* v = malloc(sizeof(lval));
  48. v->type = LVAL_ERR;
  49. va_list va;
  50. va_start(va, fmt);
  51. v->err = malloc(512);
  52. vsnprintf(v->err, 511, fmt, va);
  53. v->err = realloc(v->err, strlen(v->err)+1);
  54. va_end(va);
  55. return v;
  56. }
  57. lval* lval_sym(char* s) {
  58. lval* v = malloc(sizeof(lval));
  59. v->type = LVAL_SYM;
  60. v->sym = malloc(strlen(s) + 1);
  61. strcpy(v->sym, s);
  62. return v;
  63. }
  64. lval* lval_builtin(lbuiltin func) {
  65. lval* v = malloc(sizeof(lval));
  66. v->type = LVAL_FUN;
  67. v->builtin = func;
  68. return v;
  69. }
  70. lenv* lenv_new(void);
  71. lval* lval_lambda(lval* formals, lval* body) {
  72. lval* v = malloc(sizeof(lval));
  73. v->type = LVAL_FUN;
  74. v->builtin = NULL;
  75. v->env = lenv_new();
  76. v->formals = formals;
  77. v->body = body;
  78. return v;
  79. }
  80. lval* lval_sexpr(void) {
  81. lval* v = malloc(sizeof(lval));
  82. v->type = LVAL_SEXPR;
  83. v->count = 0;
  84. v->cell = NULL;
  85. return v;
  86. }
  87. lval* lval_qexpr(void) {
  88. lval* v = malloc(sizeof(lval));
  89. v->type = LVAL_QEXPR;
  90. v->count = 0;
  91. v->cell = NULL;
  92. return v;
  93. }
  94. void lenv_del(lenv* e);
  95. void lval_del(lval* v) {
  96. switch (v->type) {
  97. case LVAL_NUM: break;
  98. case LVAL_FUN:
  99. if (!v->builtin) {
  100. lenv_del(v->env);
  101. lval_del(v->formals);
  102. lval_del(v->body);
  103. }
  104. break;
  105. case LVAL_ERR: free(v->err); break;
  106. case LVAL_SYM: free(v->sym); break;
  107. case LVAL_QEXPR:
  108. case LVAL_SEXPR:
  109. for (int i = 0; i < v->count; i++) {
  110. lval_del(v->cell[i]);
  111. }
  112. free(v->cell);
  113. break;
  114. }
  115. free(v);
  116. }
  117. lenv* lenv_copy(lenv* e);
  118. lval* lval_copy(lval* v) {
  119. lval* x = malloc(sizeof(lval));
  120. x->type = v->type;
  121. switch (v->type) {
  122. case LVAL_FUN:
  123. if (v->builtin) {
  124. x->builtin = v->builtin;
  125. } else {
  126. x->builtin = NULL;
  127. x->env = lenv_copy(v->env);
  128. x->formals = lval_copy(v->formals);
  129. x->body = lval_copy(v->body);
  130. }
  131. break;
  132. case LVAL_NUM: x->num = v->num; break;
  133. case LVAL_ERR: x->err = malloc(strlen(v->err) + 1);
  134. strcpy(x->err, v->err);
  135. break;
  136. case LVAL_SYM: x->sym = malloc(strlen(v->sym) + 1);
  137. strcpy(x->sym, v->sym);
  138. break;
  139. case LVAL_SEXPR:
  140. case LVAL_QEXPR:
  141. x->count = v->count;
  142. x->cell = malloc(sizeof(lval*) * x->count);
  143. for (int i = 0; i < x->count; i++) {
  144. x->cell[i] = lval_copy(v->cell[i]);
  145. }
  146. break;
  147. }
  148. return x;
  149. }
  150. lval* lval_add(lval* v, lval* x) {
  151. v->count++;
  152. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  153. v->cell[v->count-1] = x;
  154. return v;
  155. }
  156. lval* lval_join(lval* x, lval* y) {
  157. for (int i = 0; i < y->count; i++) {
  158. x = lval_add(x, y->cell[i]);
  159. }
  160. free(y->cell);
  161. free(y);
  162. return x;
  163. }
  164. lval* lval_pop(lval* v, int i) {
  165. lval* x = v->cell[i];
  166. memmove(&v->cell[i],
  167. &v->cell[i+1], sizeof(lval*) * (v->count-i-1));
  168. v->count--;
  169. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  170. return x;
  171. }
  172. lval* lval_take(lval* v, int i) {
  173. lval* x = lval_pop(v, i);
  174. lval_del(v);
  175. return x;
  176. }
  177. void lval_print(lval* v);
  178. void lval_print_expr(lval* v, char open, char close) {
  179. putchar(open);
  180. for (int i = 0; i < v->count; i++) {
  181. lval_print(v->cell[i]);
  182. if (i != (v->count-1)) {
  183. putchar(' ');
  184. }
  185. }
  186. putchar(close);
  187. }
  188. void lval_print(lval* v) {
  189. switch (v->type) {
  190. case LVAL_FUN:
  191. if (v->builtin) {
  192. printf("<builtin>");
  193. } else {
  194. printf("(\\ ");
  195. lval_print(v->formals);
  196. putchar(' ');
  197. lval_print(v->body);
  198. putchar(')');
  199. }
  200. break;
  201. case LVAL_NUM: printf("%li", v->num); break;
  202. case LVAL_ERR: printf("Error: %s", v->err); break;
  203. case LVAL_SYM: printf("%s", v->sym); break;
  204. case LVAL_SEXPR: lval_print_expr(v, '(', ')'); break;
  205. case LVAL_QEXPR: lval_print_expr(v, '{', '}'); break;
  206. }
  207. }
  208. void lval_println(lval* v) { lval_print(v); putchar('\n'); }
  209. int lval_eq(lval* x, lval* y) {
  210. /* Different Types are always unequal */
  211. if (x->type != y->type) { return 0; }
  212. /* Compare Based upon type */
  213. switch (x->type) {
  214. /* Compare Number Value */
  215. case LVAL_NUM: return (x->num == y->num);
  216. /* Compare String Values */
  217. case LVAL_ERR: return (strcmp(x->err, y->err) == 0);
  218. case LVAL_SYM: return (strcmp(x->sym, y->sym) == 0);
  219. /* If Builtin compare functions, otherwise compare formals and body */
  220. case LVAL_FUN:
  221. if (x->builtin || y->builtin) {
  222. return x->builtin == y->builtin;
  223. } else {
  224. return lval_eq(x->formals, y->formals) && lval_eq(x->body, y->body);
  225. }
  226. /* If list compare every individual element */
  227. case LVAL_QEXPR:
  228. case LVAL_SEXPR:
  229. if (x->count != y->count) { return 0; }
  230. for (int i = 0; i < x->count; i++) {
  231. /* If any element not equal then whole list not equal */
  232. if (!lval_eq(x->cell[i], y->cell[i])) { return 0; }
  233. }
  234. /* Otherwise lists must be equal */
  235. return 1;
  236. break;
  237. }
  238. return 0;
  239. }
  240. char* ltype_name(int t) {
  241. switch(t) {
  242. case LVAL_FUN: return "Function";
  243. case LVAL_NUM: return "Number";
  244. case LVAL_ERR: return "Error";
  245. case LVAL_SYM: return "Symbol";
  246. case LVAL_SEXPR: return "S-Expression";
  247. case LVAL_QEXPR: return "Q-Expression";
  248. default: return "Unknown";
  249. }
  250. }
  251. /* Lisp Environment */
  252. struct lenv {
  253. lenv* par;
  254. int count;
  255. char** syms;
  256. lval** vals;
  257. };
  258. lenv* lenv_new(void) {
  259. lenv* e = malloc(sizeof(lenv));
  260. e->par = NULL;
  261. e->count = 0;
  262. e->syms = NULL;
  263. e->vals = NULL;
  264. return e;
  265. }
  266. void lenv_del(lenv* e) {
  267. for (int i = 0; i < e->count; i++) {
  268. free(e->syms[i]);
  269. lval_del(e->vals[i]);
  270. }
  271. free(e->syms);
  272. free(e->vals);
  273. free(e);
  274. }
  275. lenv* lenv_copy(lenv* e) {
  276. lenv* n = malloc(sizeof(lenv));
  277. n->par = e->par;
  278. n->count = e->count;
  279. n->syms = malloc(sizeof(char*) * n->count);
  280. n->vals = malloc(sizeof(lval*) * n->count);
  281. for (int i = 0; i < e->count; i++) {
  282. n->syms[i] = malloc(strlen(e->syms[i]) + 1);
  283. strcpy(n->syms[i], e->syms[i]);
  284. n->vals[i] = lval_copy(e->vals[i]);
  285. }
  286. return n;
  287. }
  288. lval* lenv_get(lenv* e, lval* k) {
  289. for (int i = 0; i < e->count; i++) {
  290. if (strcmp(e->syms[i], k->sym) == 0) { return lval_copy(e->vals[i]); }
  291. }
  292. if (e->par) {
  293. return lenv_get(e->par, k);
  294. } else {
  295. return lval_err("Unbound Symbol '%s'", k->sym);
  296. }
  297. }
  298. void lenv_put(lenv* e, lval* k, lval* v) {
  299. for (int i = 0; i < e->count; i++) {
  300. if (strcmp(e->syms[i], k->sym) == 0) {
  301. lval_del(e->vals[i]);
  302. e->vals[i] = lval_copy(v);
  303. return;
  304. }
  305. }
  306. e->count++;
  307. e->vals = realloc(e->vals, sizeof(lval*) * e->count);
  308. e->syms = realloc(e->syms, sizeof(char*) * e->count);
  309. e->vals[e->count-1] = lval_copy(v);
  310. e->syms[e->count-1] = malloc(strlen(k->sym)+1);
  311. strcpy(e->syms[e->count-1], k->sym);
  312. }
  313. void lenv_def(lenv* e, lval* k, lval* v) {
  314. while (e->par) { e = e->par; }
  315. lenv_put(e, k, v);
  316. }
  317. /* Builtins */
  318. #define LASSERT(args, cond, fmt, ...) \
  319. if (!(cond)) { lval* err = lval_err(fmt, ##__VA_ARGS__); lval_del(args); return err; }
  320. #define LASSERT_TYPE(func, args, index, expect) \
  321. LASSERT(args, args->cell[index]->type == expect, \
  322. "Function '%s' passed incorrect type for argument %i. Got %s, Expected %s.", \
  323. func, index, ltype_name(args->cell[index]->type), ltype_name(expect))
  324. #define LASSERT_NUM(func, args, num) \
  325. LASSERT(args, args->count == num, \
  326. "Function '%s' passed incorrect number of arguments. Got %i, Expected %i.", \
  327. func, args->count, num)
  328. #define LASSERT_NOT_EMPTY(func, args, index) \
  329. LASSERT(args, args->cell[index]->count != 0, \
  330. "Function '%s' passed {} for argument %i.", func, index);
  331. lval* lval_eval(lenv* e, lval* v);
  332. lval* builtin_lambda(lenv* e, lval* a) {
  333. LASSERT_NUM("\\", a, 2);
  334. LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
  335. LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);
  336. for (int i = 0; i < a->cell[0]->count; i++) {
  337. LASSERT(a, (a->cell[0]->cell[i]->type == LVAL_SYM),
  338. "Cannot define non-symbol. Got %s, Expected %s.",
  339. ltype_name(a->cell[0]->cell[i]->type), ltype_name(LVAL_SYM));
  340. }
  341. lval* formals = lval_pop(a, 0);
  342. lval* body = lval_pop(a, 0);
  343. lval_del(a);
  344. return lval_lambda(formals, body);
  345. }
  346. lval* builtin_list(lenv* e, lval* a) {
  347. a->type = LVAL_QEXPR;
  348. return a;
  349. }
  350. lval* builtin_head(lenv* e, lval* a) {
  351. LASSERT_NUM("head", a, 1);
  352. LASSERT_TYPE("head", a, 0, LVAL_QEXPR);
  353. LASSERT_NOT_EMPTY("head", a, 0);
  354. lval* v = lval_take(a, 0);
  355. while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  356. return v;
  357. }
  358. lval* builtin_tail(lenv* e, lval* a) {
  359. LASSERT_NUM("tail", a, 1);
  360. LASSERT_TYPE("tail", a, 0, LVAL_QEXPR);
  361. LASSERT_NOT_EMPTY("tail", a, 0);
  362. lval* v = lval_take(a, 0);
  363. lval_del(lval_pop(v, 0));
  364. return v;
  365. }
  366. lval* builtin_eval(lenv* e, lval* a) {
  367. LASSERT_NUM("eval", a, 1);
  368. LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);
  369. lval* x = lval_take(a, 0);
  370. x->type = LVAL_SEXPR;
  371. return lval_eval(e, x);
  372. }
  373. lval* builtin_join(lenv* e, lval* a) {
  374. for (int i = 0; i < a->count; i++) {
  375. LASSERT_TYPE("join", a, i, LVAL_QEXPR);
  376. }
  377. lval* x = lval_pop(a, 0);
  378. while (a->count) {
  379. lval* y = lval_pop(a, 0);
  380. x = lval_join(x, y);
  381. }
  382. lval_del(a);
  383. return x;
  384. }
  385. lval* builtin_op(lenv* e, lval* a, char* op) {
  386. for (int i = 0; i < a->count; i++) {
  387. LASSERT_TYPE(op, a, i, LVAL_NUM);
  388. }
  389. lval* x = lval_pop(a, 0);
  390. if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
  391. while (a->count > 0) {
  392. lval* y = lval_pop(a, 0);
  393. if (strcmp(op, "+") == 0) { x->num += y->num; }
  394. if (strcmp(op, "-") == 0) { x->num -= y->num; }
  395. if (strcmp(op, "*") == 0) { x->num *= y->num; }
  396. if (strcmp(op, "/") == 0) {
  397. if (y->num == 0) {
  398. lval_del(x); lval_del(y);
  399. x = lval_err("Division By Zero.");
  400. break;
  401. }
  402. x->num /= y->num;
  403. }
  404. lval_del(y);
  405. }
  406. lval_del(a);
  407. return x;
  408. }
  409. lval* builtin_add(lenv* e, lval* a) { return builtin_op(e, a, "+"); }
  410. lval* builtin_sub(lenv* e, lval* a) { return builtin_op(e, a, "-"); }
  411. lval* builtin_mul(lenv* e, lval* a) { return builtin_op(e, a, "*"); }
  412. lval* builtin_div(lenv* e, lval* a) { return builtin_op(e, a, "/"); }
  413. lval* builtin_var(lenv* e, lval* a, char* func) {
  414. LASSERT_TYPE(func, a, 0, LVAL_QEXPR);
  415. lval* syms = a->cell[0];
  416. for (int i = 0; i < syms->count; i++) {
  417. LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
  418. "Function '%s' cannot define non-symbol. "
  419. "Got %s, Expected %s.",
  420. func, ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
  421. }
  422. LASSERT(a, (syms->count == a->count-1),
  423. "Function '%s' passed too many arguments for symbols. "
  424. "Got %i, Expected %i.",
  425. func, syms->count, a->count-1);
  426. for (int i = 0; i < syms->count; i++) {
  427. if (strcmp(func, "def") == 0) { lenv_def(e, syms->cell[i], a->cell[i+1]); }
  428. if (strcmp(func, "=") == 0) { lenv_put(e, syms->cell[i], a->cell[i+1]); }
  429. }
  430. lval_del(a);
  431. return lval_sexpr();
  432. }
  433. lval* builtin_def(lenv* e, lval* a) { return builtin_var(e, a, "def"); }
  434. lval* builtin_put(lenv* e, lval* a) { return builtin_var(e, a, "="); }
  435. lval* builtin_ord(lenv* e, lval* a, char* op) {
  436. LASSERT_NUM(op, a, 2);
  437. LASSERT_TYPE(op, a, 0, LVAL_NUM);
  438. LASSERT_TYPE(op, a, 1, LVAL_NUM);
  439. int r;
  440. if (strcmp(op, ">") == 0) {
  441. r = (a->cell[0]->num > a->cell[1]->num);
  442. }
  443. if (strcmp(op, "<") == 0) {
  444. r = (a->cell[0]->num < a->cell[1]->num);
  445. }
  446. if (strcmp(op, ">=") == 0) {
  447. r = (a->cell[0]->num >= a->cell[1]->num);
  448. }
  449. if (strcmp(op, "<=") == 0) {
  450. r = (a->cell[0]->num <= a->cell[1]->num);
  451. }
  452. lval_del(a);
  453. return lval_num(r);
  454. }
  455. lval* builtin_gt(lenv* e, lval* a) {
  456. return builtin_ord(e, a, ">");
  457. }
  458. lval* builtin_lt(lenv* e, lval* a) {
  459. return builtin_ord(e, a, "<");
  460. }
  461. lval* builtin_ge(lenv* e, lval* a) {
  462. return builtin_ord(e, a, ">=");
  463. }
  464. lval* builtin_le(lenv* e, lval* a) {
  465. return builtin_ord(e, a, "<=");
  466. }
  467. lval* builtin_cmp(lenv* e, lval* a, char* op) {
  468. LASSERT_NUM(op, a, 2);
  469. int r;
  470. if (strcmp(op, "==") == 0) {
  471. r = lval_eq(a->cell[0], a->cell[1]);
  472. }
  473. if (strcmp(op, "!=") == 0) {
  474. r = !lval_eq(a->cell[0], a->cell[1]);
  475. }
  476. lval_del(a);
  477. return lval_num(r);
  478. }
  479. lval* builtin_eq(lenv* e, lval* a) {
  480. return builtin_cmp(e, a, "==");
  481. }
  482. lval* builtin_ne(lenv* e, lval* a) {
  483. return builtin_cmp(e, a, "!=");
  484. }
  485. lval* builtin_if(lenv* e, lval* a) {
  486. LASSERT_NUM("if", a, 3);
  487. LASSERT_TYPE("if", a, 0, LVAL_NUM);
  488. LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
  489. LASSERT_TYPE("if", a, 2, LVAL_QEXPR);
  490. /* Mark Both Expressions as evaluable */
  491. lval* x;
  492. a->cell[1]->type = LVAL_SEXPR;
  493. a->cell[2]->type = LVAL_SEXPR;
  494. if (a->cell[0]->num) {
  495. /* If condition is true evaluate first expression */
  496. x = lval_eval(e, lval_pop(a, 1));
  497. } else {
  498. /* Otherwise evaluate second expression */
  499. x = lval_eval(e, lval_pop(a, 2));
  500. }
  501. /* Delete argument list and return */
  502. lval_del(a);
  503. return x;
  504. }
  505. void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
  506. lval* k = lval_sym(name);
  507. lval* v = lval_builtin(func);
  508. lenv_put(e, k, v);
  509. lval_del(k); lval_del(v);
  510. }
  511. void lenv_add_builtins(lenv* e) {
  512. /* Variable Functions */
  513. lenv_add_builtin(e, "\\", builtin_lambda);
  514. lenv_add_builtin(e, "def", builtin_def);
  515. lenv_add_builtin(e, "=", builtin_put);
  516. /* List Functions */
  517. lenv_add_builtin(e, "list", builtin_list);
  518. lenv_add_builtin(e, "head", builtin_head);
  519. lenv_add_builtin(e, "tail", builtin_tail);
  520. lenv_add_builtin(e, "eval", builtin_eval);
  521. lenv_add_builtin(e, "join", builtin_join);
  522. /* Mathematical Functions */
  523. lenv_add_builtin(e, "+", builtin_add);
  524. lenv_add_builtin(e, "-", builtin_sub);
  525. lenv_add_builtin(e, "*", builtin_mul);
  526. lenv_add_builtin(e, "/", builtin_div);
  527. /* Comparison Functions */
  528. lenv_add_builtin(e, "if", builtin_if);
  529. lenv_add_builtin(e, "==", builtin_eq);
  530. lenv_add_builtin(e, "!=", builtin_ne);
  531. lenv_add_builtin(e, ">", builtin_gt);
  532. lenv_add_builtin(e, "<", builtin_lt);
  533. lenv_add_builtin(e, ">=", builtin_ge);
  534. lenv_add_builtin(e, "<=", builtin_le);
  535. }
  536. /* Evaluation */
  537. lval* lval_call(lenv* e, lval* f, lval* a) {
  538. if (f->builtin) { return f->builtin(e, a); }
  539. int given = a->count;
  540. int total = f->formals->count;
  541. while (a->count) {
  542. if (f->formals->count == 0) {
  543. lval_del(a);
  544. return lval_err("Function passed too many arguments. "
  545. "Got %i, Expected %i.", given, total);
  546. }
  547. lval* sym = lval_pop(f->formals, 0);
  548. if (strcmp(sym->sym, "&") == 0) {
  549. if (f->formals->count != 1) {
  550. lval_del(a);
  551. return lval_err("Function format invalid. "
  552. "Symbol '&' not followed by single symbol.");
  553. }
  554. lval* nsym = lval_pop(f->formals, 0);
  555. lenv_put(f->env, nsym, builtin_list(e, a));
  556. lval_del(sym); lval_del(nsym);
  557. break;
  558. }
  559. lval* val = lval_pop(a, 0);
  560. lenv_put(f->env, sym, val);
  561. lval_del(sym); lval_del(val);
  562. }
  563. lval_del(a);
  564. if (f->formals->count > 0 &&
  565. strcmp(f->formals->cell[0]->sym, "&") == 0) {
  566. if (f->formals->count != 2) {
  567. return lval_err("Function format invalid. "
  568. "Symbol '&' not followed by single symbol.");
  569. }
  570. lval_del(lval_pop(f->formals, 0));
  571. lval* sym = lval_pop(f->formals, 0);
  572. lval* val = lval_qexpr();
  573. lenv_put(f->env, sym, val);
  574. lval_del(sym); lval_del(val);
  575. }
  576. if (f->formals->count == 0) {
  577. f->env->par = e;
  578. return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
  579. } else {
  580. return lval_copy(f);
  581. }
  582. }
  583. lval* lval_eval_sexpr(lenv* e, lval* v) {
  584. for (int i = 0; i < v->count; i++) { v->cell[i] = lval_eval(e, v->cell[i]); }
  585. for (int i = 0; i < v->count; i++) { if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); } }
  586. if (v->count == 0) { return v; }
  587. if (v->count == 1) { return lval_eval(e, lval_take(v, 0)); }
  588. lval* f = lval_pop(v, 0);
  589. if (f->type != LVAL_FUN) {
  590. lval* err = lval_err(
  591. "S-Expression starts with incorrect type. "
  592. "Got %s, Expected %s.",
  593. ltype_name(f->type), ltype_name(LVAL_FUN));
  594. lval_del(f); lval_del(v);
  595. return err;
  596. }
  597. lval* result = lval_call(e, f, v);
  598. lval_del(f);
  599. return result;
  600. }
  601. lval* lval_eval(lenv* e, lval* v) {
  602. if (v->type == LVAL_SYM) {
  603. lval* x = lenv_get(e, v);
  604. lval_del(v);
  605. return x;
  606. }
  607. if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(e, v); }
  608. return v;
  609. }
  610. /* Reading */
  611. lval* lval_read_num(mpc_ast_t* t) {
  612. errno = 0;
  613. long x = strtol(t->contents, NULL, 10);
  614. return errno != ERANGE ? lval_num(x) : lval_err("Invalid Number.");
  615. }
  616. lval* lval_read(mpc_ast_t* t) {
  617. if (strstr(t->tag, "number")) { return lval_read_num(t); }
  618. if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
  619. lval* x = NULL;
  620. if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
  621. if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
  622. if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
  623. for (int i = 0; i < t->children_num; i++) {
  624. if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
  625. if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
  626. if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
  627. if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
  628. if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
  629. x = lval_add(x, lval_read(t->children[i]));
  630. }
  631. return x;
  632. }
  633. /* Main */
  634. int main(int argc, char** argv) {
  635. mpc_parser_t* Number = mpc_new("number");
  636. mpc_parser_t* Symbol = mpc_new("symbol");
  637. mpc_parser_t* Sexpr = mpc_new("sexpr");
  638. mpc_parser_t* Qexpr = mpc_new("qexpr");
  639. mpc_parser_t* Expr = mpc_new("expr");
  640. mpc_parser_t* Lispy = mpc_new("lispy");
  641. mpca_lang(MPCA_LANG_DEFAULT,
  642. " \
  643. number : /-?[0-9]+/ ; \
  644. symbol : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ; \
  645. sexpr : '(' <expr>* ')' ; \
  646. qexpr : '{' <expr>* '}' ; \
  647. expr : <number> | <symbol> | <sexpr> | <qexpr> ; \
  648. lispy : /^/ <expr>* /$/ ; \
  649. ",
  650. Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  651. puts("Lispy Version 0.0.0.0.9");
  652. puts("Press Ctrl+c to Exit\n");
  653. lenv* e = lenv_new();
  654. lenv_add_builtins(e);
  655. while (1) {
  656. char* input = readline("lispy> ");
  657. add_history(input);
  658. mpc_result_t r;
  659. if (mpc_parse("<stdin>", input, Lispy, &r)) {
  660. lval* x = lval_eval(e, lval_read(r.output));
  661. lval_println(x);
  662. lval_del(x);
  663. mpc_ast_delete(r.output);
  664. } else {
  665. mpc_err_print(r.error);
  666. mpc_err_delete(r.error);
  667. }
  668. free(input);
  669. }
  670. lenv_del(e);
  671. mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  672. return 0;
  673. }