(Somewhat adapted) code and solutions from the book "Build Your Own Lisp" http://www.buildyourownlisp.com
lisp
c

lispy.c 16KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676
  1. #include <stdio.h>
  2. #include <stdlib.h>
  3. #include <assert.h>
  4. #include "../mpc/mpc.h"
  5. /* If we are on Windows compile these functions */
  6. #ifdef _WIN32
  7. #include <string.h>
  8. static char buffer[2048];
  9. /* Fake readline function */
  10. char* readline(char* prompt) {
  11. fputs(prompt, stdout);
  12. fgets(buffer, 2048, stdin);
  13. char* cpy = malloc(strlen(buffer)+1);
  14. assert(cpy != NULL)
  15. strcpy(cpy, buffer);
  16. cpy[strlen(cpy)-1] = '\0';
  17. return cpy;
  18. }
  19. /* Fake add_history function */
  20. void add_history(char* unused) {}
  21. /* Otherwise include the editline headers
  22. could use __APPLE__ for detection of OSX */
  23. #else
  24. #include <editline/readline.h>
  25. #endif
  26. /* Include type and function declarations */
  27. #include "lispy.h"
  28. /* Construct a pointer to a new number lval */
  29. lval* lval_num(long x) {
  30. lval* v = malloc(sizeof(lval));
  31. assert(v != NULL);
  32. v->type = LVAL_NUM;
  33. v->num = x;
  34. return v;
  35. }
  36. /* Construct a pointer to a new decimal lval */
  37. lval* lval_dec(double x) {
  38. lval* v = malloc(sizeof(lval));
  39. assert(v != NULL);
  40. v->type = LVAL_DEC;
  41. v->dec = x;
  42. return v;
  43. }
  44. /* Construct a pointer to a new error lval */
  45. lval* lval_err(char* m) {
  46. lval* v = malloc(sizeof(lval));
  47. assert(v != NULL);
  48. v->type = LVAL_ERR;
  49. v->err = malloc(strlen(m)+1);
  50. assert(v->err != NULL);
  51. strcpy(v->err, m);
  52. return v;
  53. }
  54. /* Construct a pointer to a new symbol lval */
  55. lval* lval_sym(char* s) {
  56. lval* v = malloc(sizeof(lval));
  57. assert(v != NULL);
  58. v->type = LVAL_SYM;
  59. v->sym = malloc(strlen(s)+1);
  60. assert(v->sym != NULL);
  61. strcpy(v->sym, s);
  62. return v;
  63. }
  64. /* Construct a pointer to a new empty sexpr lval */
  65. lval* lval_sexpr(void) {
  66. lval* v = malloc(sizeof(lval));
  67. assert(v != NULL);
  68. v->type = LVAL_SEXPR;
  69. v->count = 0;
  70. v->cell = NULL;
  71. return v;
  72. }
  73. /* Construct a pointer to a new empty qexpr lval */
  74. lval* lval_qexpr(void) {
  75. lval* v = malloc(sizeof(lval));
  76. assert(v != NULL);
  77. v->type = LVAL_QEXPR;
  78. v->count = 0;
  79. v->cell = NULL;
  80. return v;
  81. }
  82. /* Free memory of an lval and all its members */
  83. void lval_del(lval* v) {
  84. switch (v->type) {
  85. /* Do nothing special for number / decimal type */
  86. case LVAL_NUM:
  87. case LVAL_DEC:
  88. break;
  89. /* For err or sym free the string data */
  90. case LVAL_ERR:
  91. free(v->err);
  92. break;
  93. case LVAL_SYM:
  94. free(v->sym);
  95. break;
  96. /* If sexpr then delete all elements inside */
  97. case LVAL_SEXPR:
  98. case LVAL_QEXPR:
  99. for (size_t i = 0; i < v->count; i++) {
  100. lval_del(v->cell[i]);
  101. }
  102. /* Also free the memory allocated to contain
  103. the pointers */
  104. free(v->cell);
  105. break;
  106. }
  107. /* Free the memory allocated for the lval struct itself */
  108. free(v);
  109. }
  110. lval* lval_read_num(mpc_ast_t* t) {
  111. errno = 0;
  112. if (strstr(t->contents, ".")) {
  113. double x = strtod(t->contents, NULL);
  114. return errno != ERANGE ? lval_dec(x)
  115. : lval_err("Invalid number");
  116. } else {
  117. long x = strtol(t->contents, NULL, 10);
  118. return errno != ERANGE ? lval_num(x)
  119. : lval_err("Invalid number");
  120. }
  121. }
  122. lval* lval_read(mpc_ast_t* t) {
  123. /* If symbol or number return conversion to that type */
  124. if (strstr(t->tag, "number")) {
  125. return lval_read_num(t);
  126. }
  127. if (strstr(t->tag, "symbol")) {
  128. return lval_sym(t->contents);
  129. }
  130. /* If root (>) or sexpr then create empty list */
  131. lval* x = NULL;
  132. if (strcmp(t->tag, ">") == 0 || strstr(t->tag, "sexpr")) {
  133. x = lval_sexpr();
  134. }
  135. /* If qexpr create then empty list */
  136. if (strstr(t->tag, "qexpr")) {
  137. x = lval_qexpr();
  138. }
  139. /* Fill this list with any valid expression
  140. contained within */
  141. for (size_t i = 0; i < (size_t) t->children_num; i++) {
  142. if (strcmp(t->children[i]->contents, "(") == 0) {
  143. continue;
  144. }
  145. if (strcmp(t->children[i]->contents, ")") == 0) {
  146. continue;
  147. }
  148. if (strcmp(t->children[i]->contents, "{") == 0) {
  149. continue;
  150. }
  151. if (strcmp(t->children[i]->contents, "}") == 0) {
  152. continue;
  153. }
  154. if (strcmp(t->children[i]->tag, "regex") == 0) {
  155. continue;
  156. }
  157. x = lval_add(x, lval_read(t->children[i]));
  158. }
  159. return x;
  160. }
  161. lval* lval_add(lval* v, lval* x) {
  162. v->count++;
  163. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  164. assert(v->cell != NULL);
  165. v->cell[v->count-1] = x;
  166. return v;
  167. }
  168. void lval_expr_print(lval* v, char open, char close) {
  169. /* Opening char */
  170. putchar(open);
  171. for (size_t i = 0; i < v->count; i++) {
  172. /* Print value contained within */
  173. lval_print(v->cell[i]);
  174. /* Don't print trailing space if last element */
  175. if (i != (v->count-1)) {
  176. putchar(' ');
  177. }
  178. }
  179. /* Opening char */
  180. putchar(close);
  181. }
  182. /* Print an lval */
  183. void lval_print(lval* v) {
  184. switch (v->type) {
  185. /* In the case the type is a number print it
  186. Then break out of the switch */
  187. case LVAL_NUM:
  188. printf("%li", v->num);
  189. break;
  190. case LVAL_DEC:
  191. printf("%.2f", v->dec);
  192. break;
  193. /* In the case the type is an error */
  194. case LVAL_ERR:
  195. printf("Error: %s", v->err);
  196. break;
  197. case LVAL_SYM:
  198. printf("%s", v->sym);
  199. break;
  200. case LVAL_SEXPR:
  201. lval_expr_print(v, '(', ')');
  202. break;
  203. case LVAL_QEXPR:
  204. lval_expr_print(v, '{', '}');
  205. break;
  206. }
  207. }
  208. /* Print an lval followed by a newline */
  209. void lval_println(lval* v) {
  210. lval_print(v);
  211. putchar('\n');
  212. }
  213. lval* lval_eval_sexpr(lval* v) {
  214. /* Evaluate children */
  215. for (size_t i = 0; i < v->count; i++) {
  216. v->cell[i] = lval_eval(v->cell[i]);
  217. }
  218. /* Error checking */
  219. for (size_t i = 0; i < v->count; i++) {
  220. if (v->cell[i]->type == LVAL_ERR) {
  221. return lval_take(v, i);
  222. }
  223. }
  224. /* Empty expression */
  225. if (v->count == 0) {
  226. return v;
  227. }
  228. /* Single expression */
  229. if (v->count == 1) {
  230. return lval_take(v, 0);
  231. }
  232. /* Ensure first element is symbol */
  233. lval* f = lval_pop(v, 0);
  234. if (f->type != LVAL_SYM) {
  235. lval_del(f);
  236. lval_del(v);
  237. return lval_err("S-expression does not start with symbol!");
  238. }
  239. /* Call builtin with operator */
  240. lval* result = builtin(v, f->sym);
  241. lval_del(f);
  242. return result;
  243. }
  244. lval* lval_eval(lval* v) {
  245. /* Evaluate sexpressions */
  246. if (v->type == LVAL_SEXPR) {
  247. return lval_eval_sexpr(v);
  248. }
  249. /* All other lval types remain the same */
  250. return v;
  251. }
  252. lval* lval_pop(lval* v, size_t i) {
  253. /* Fine the item at i */
  254. lval* x = v->cell[i];
  255. /* Shift memory after the item at i over the top */
  256. memmove(&v->cell[i], &v->cell[i+1],
  257. sizeof(lval*) * (v->count-i-1));
  258. /* Decrease the count of items in the list */
  259. v->count--;
  260. /* Reallocate the memory used */
  261. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  262. assert(v->cell != NULL);
  263. return x;
  264. }
  265. lval* lval_take(lval* v, size_t i) {
  266. lval* x = lval_pop(v, i);
  267. lval_del(v);
  268. return x;
  269. }
  270. lval* builtin(lval* a, char* func) {
  271. /* Check for builtin functions */
  272. if (strcmp("list", func) == 0) {return builtin_list(a);}
  273. if (strcmp("head", func) == 0) {return builtin_head(a);}
  274. if (strcmp("tail", func) == 0) {return builtin_tail(a);}
  275. if (strcmp("join", func) == 0) {return builtin_join(a);}
  276. if (strcmp("eval", func) == 0) {return builtin_eval(a);}
  277. if (strcmp("cons", func) == 0) {return builtin_cons(a);}
  278. if (strcmp("len", func) == 0) {return builtin_len(a);}
  279. if (strcmp("init", func) == 0) {return builtin_init(a);}
  280. /* Check for operators */
  281. if (strstr("+-*/%^", func) ||
  282. strcmp("min", func) == 0 || strcmp("max", func) == 0) {
  283. return builtin_op(a, func);
  284. }
  285. lval_del(a);
  286. return lval_err("Unknown function!");
  287. }
  288. lval* builtin_op(lval* a, char* op) {
  289. /* Ensure all arguments are numbers */
  290. for (size_t i = 0; i < a->count; i++) {
  291. if (a->cell[i]->type != LVAL_NUM && a->cell[i]->type != LVAL_DEC) {
  292. lval_del(a);
  293. return lval_err("Cannot operate on non-number/non-decimal!");
  294. }
  295. }
  296. /* Pop the 1st element */
  297. lval* x = lval_pop(a, 0);
  298. /* If no arguments and sub then perform unary negation */
  299. if (strcmp(op, "-") == 0 && a->count == 0) {
  300. if (x->type == LVAL_NUM) {
  301. x->num = -x->num;
  302. } else {
  303. x->dec = -x->dec;
  304. }
  305. }
  306. /* While there are still elements remaining */
  307. while (a->count > 0) {
  308. /* Pop the next element */
  309. lval* y = lval_pop(a, 0);
  310. if (x->type == LVAL_NUM && y->type == LVAL_NUM) {
  311. if (strcmp(op, "+") == 0) {x->num += y->num;}
  312. if (strcmp(op, "-") == 0) {x->num -= y->num;}
  313. if (strcmp(op, "*") == 0) {x->num *= y->num;}
  314. if (strcmp(op, "/") == 0) {
  315. /* If second operand is zero return error */
  316. if (y->num == 0) {
  317. lval_del(x);
  318. lval_del(y);
  319. x = lval_err("Division by zero!");
  320. break;
  321. }
  322. x->num /= y->num;
  323. }
  324. if (strcmp(op, "%") == 0) {x->num %= y->num;}
  325. if (strcmp(op, "^") == 0) {x->num = (pow(x->num, y->num));}
  326. if (strcmp(op, "min") == 0) {x->num = min(x->num, y->num);}
  327. if (strcmp(op, "max") == 0) {x->num = max(x->num, y->num);}
  328. } else {
  329. /* Cast integer number into double if necessary */
  330. double b = x->type == LVAL_NUM ? (double) x->num : x->dec;
  331. double c = y->type == LVAL_NUM ? (double) y->num : y->dec;
  332. /* Perform all operations on double */
  333. if (strcmp(op, "+") == 0) {b += c;}
  334. if (strcmp(op, "-") == 0) {b -= c;}
  335. if (strcmp(op, "*") == 0) {b *= c;}
  336. if (strcmp(op, "/") == 0) {
  337. /* If second operand is zero return error */
  338. if (c == 0) {
  339. lval_del(x);
  340. lval_del(y);
  341. x = lval_err("Division by zero!");
  342. break;
  343. }
  344. b /= c;
  345. }
  346. if (strcmp(op, "%") == 0) {b = fmod(b, c);}
  347. if (strcmp(op, "^") == 0) {b = (pow(b, c));}
  348. if (strcmp(op, "min") == 0) {b = fmin(b, c);}
  349. if (strcmp(op, "max") == 0) {b = fmax(b, c);}
  350. x->type = LVAL_DEC;
  351. x->dec = b;
  352. }
  353. }
  354. lval_del(a);
  355. return x;
  356. }
  357. lval* builtin_head(lval* a) {
  358. /* Check error conditions */
  359. LASSERT(a, a->count == 1,
  360. "Function 'head' passed too many arguments!");
  361. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  362. "Function 'head' passed incorrect type!");
  363. LASSERT(a, a->cell[0]->count != 0,
  364. "Function 'head' passed {}!");
  365. /* Otherwise take first argument */
  366. lval* v = lval_take(a, 0);
  367. /* Delete all elements that are not head and return */
  368. while (v-> count > 1) {
  369. lval_del(lval_pop(v, 1));
  370. }
  371. return v;
  372. }
  373. lval* builtin_tail(lval* a) {
  374. /* Check error conditions */
  375. LASSERT(a, a->count == 1,
  376. "Function 'tail' passed too many arguments!");
  377. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  378. "Function 'tail' passed incorrect type!");
  379. LASSERT(a, a->cell[0]->count != 0,
  380. "Function 'tail' passed {}!");
  381. /* Otherwise take first argument */
  382. lval* v = lval_take(a, 0);
  383. /* Delete first element and return */
  384. lval_del(lval_pop(v, 0));
  385. return v;
  386. }
  387. lval* builtin_list(lval* a) {
  388. a->type = LVAL_QEXPR;
  389. return a;
  390. }
  391. lval* builtin_eval(lval* a) {
  392. /* Check error conditions */
  393. LASSERT(a, a->count == 1,
  394. "Function 'eval' passed too many arguments!");
  395. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  396. "Function 'eval' passed incorrect type!");
  397. lval* x = lval_take(a, 0);
  398. x->type = LVAL_SEXPR;
  399. return lval_eval(x);
  400. }
  401. lval* builtin_join(lval* a) {
  402. /* Check error conditions */
  403. for (size_t i = 0; i < a->count; i++) {
  404. LASSERT(a, a->cell[i]->type == LVAL_QEXPR,
  405. "Function 'join' passed incorrect type!");
  406. }
  407. lval* x = lval_pop(a, 0);
  408. while (a->count) {
  409. x = lval_join(x, lval_pop(a, 0));
  410. }
  411. lval_del(a);
  412. return x;
  413. }
  414. lval* lval_join(lval* x, lval* y) {
  415. /* For each cell in y add it to x */
  416. while (y->count) {
  417. x = lval_add(x, lval_pop(y, 0));
  418. }
  419. /* Delete the empty y and return x */
  420. lval_del(y);
  421. return x;
  422. }
  423. lval* builtin_cons(lval* a) {
  424. /* Check error conditions */
  425. LASSERT(a, a->count == 2 ,
  426. "Function 'cons' takes exactly 2 arguments!");
  427. LASSERT(a, a->cell[1]->type == LVAL_QEXPR,
  428. "Function 'cons' passed incorrect type!");
  429. lval* v = lval_qexpr();
  430. v = lval_add(v, lval_pop(a, 0));
  431. lval* y = lval_pop(a, 0);
  432. while (y->count) {
  433. v = lval_add(v, lval_pop(y, 0));
  434. }
  435. lval_del(a);
  436. lval_del(y);
  437. return v;
  438. }
  439. lval* builtin_len(lval* a) {
  440. /* Check error conditions */
  441. LASSERT(a, a->count == 1,
  442. "Function 'len' passed too many arguments!");
  443. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  444. "Function 'len' passed incorrect type!");
  445. lval* v = lval_num(a->cell[0]->count);
  446. return v;
  447. }
  448. lval* builtin_init(lval* a) {
  449. /* Check error conditions */
  450. LASSERT(a, a->count == 1,
  451. "Function 'init' passed too many arguments!");
  452. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  453. "Function 'init' passed incorrect type!");
  454. LASSERT(a, a->cell[0]->count != 0,
  455. "Function 'init' passed {}!");
  456. /* Otherwise take first argument */
  457. lval* v = lval_take(a, 0);
  458. /* Delete last element and return */
  459. lval_del(lval_pop(v, v->count-1));
  460. return v;
  461. }
  462. long min(long x, long y) {
  463. if (x <= y) {
  464. return x;
  465. } else {
  466. return y;
  467. }
  468. }
  469. long max(long x, long y) {
  470. if (x >= y) {
  471. return x;
  472. } else {
  473. return y;
  474. }
  475. }
  476. int main() {
  477. /* Create some parsers */
  478. mpc_parser_t* Number = mpc_new("number");
  479. mpc_parser_t* Symbol = mpc_new("symbol");
  480. mpc_parser_t* Sexpr = mpc_new("sexpr");
  481. mpc_parser_t* Qexpr = mpc_new("qexpr");
  482. mpc_parser_t* Expr = mpc_new("expr");
  483. mpc_parser_t* Lispy = mpc_new("lispy");
  484. /* Define them with the following language */
  485. mpca_lang(MPCA_LANG_DEFAULT, parser,
  486. Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  487. /* Print version and exit information */
  488. puts(lispy_version);
  489. puts("Press Ctrl+c to exit\n");
  490. /* In a never ending loop */
  491. while (1) {
  492. /* Output our prompt and get input */
  493. char* input = readline("lispy> ");
  494. /* Add input to history */
  495. add_history(input);
  496. /* Attempt to parse the user input */
  497. mpc_result_t r;
  498. if (mpc_parse("<stdin>", input, Lispy, &r)) {
  499. /* On success evaluate the user input */
  500. lval* x = lval_eval(lval_read(r.output));
  501. lval_println(x);
  502. lval_del(x);
  503. } else {
  504. /* Otherwise print the error */
  505. mpc_err_print(r.error);
  506. mpc_err_delete(r.error);
  507. }
  508. /* Free retrieved input */
  509. free(input);
  510. }
  511. /* Undefine and delete our parsers */
  512. mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  513. return 0;
  514. }