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

lispy.c 11KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462
  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. /* Free memory of an lval and all its members */
  74. void lval_del(lval* v) {
  75. switch (v->type) {
  76. /* Do nothing special for number / decimal type */
  77. case LVAL_NUM:
  78. case LVAL_DEC:
  79. break;
  80. /* For err or sym free the string data */
  81. case LVAL_ERR:
  82. free(v->err);
  83. break;
  84. case LVAL_SYM:
  85. free(v->sym);
  86. break;
  87. /* If sexpr then delete all elements inside */
  88. case LVAL_SEXPR:
  89. for (size_t i = 0; i < v->count; i++) {
  90. lval_del(v->cell[i]);
  91. }
  92. /* Also free the memory allocated to contain
  93. the pointers */
  94. free(v->cell);
  95. break;
  96. }
  97. /* Free the memory allocated for the lval struct itself */
  98. free(v);
  99. }
  100. lval* lval_read_num(mpc_ast_t* t) {
  101. errno = 0;
  102. if (strstr(t->contents, ".")) {
  103. double x = strtod(t->contents, NULL);
  104. return errno != ERANGE ? lval_dec(x)
  105. : lval_err("Invalid number");
  106. } else {
  107. long x = strtol(t->contents, NULL, 10);
  108. return errno != ERANGE ? lval_num(x)
  109. : lval_err("Invalid number");
  110. }
  111. }
  112. lval* lval_read(mpc_ast_t* t) {
  113. /* If symbol or number return conversion to that type */
  114. if (strstr(t->tag, "number")) {
  115. return lval_read_num(t);
  116. }
  117. if (strstr(t->tag, "symbol")) {
  118. return lval_sym(t->contents);
  119. }
  120. /* If root (>) or sexpr then create empty list */
  121. lval* x = NULL;
  122. if (strcmp(t->tag, ">") == 0 || strstr(t->tag, "sexpr")) {
  123. x = lval_sexpr();
  124. }
  125. /* Fill this list with any valid expression
  126. contained within */
  127. for (size_t i = 0; i < t->children_num; i++) {
  128. if (strcmp(t->children[i]->contents, "(") == 0) {
  129. continue;
  130. }
  131. if (strcmp(t->children[i]->contents, ")") == 0) {
  132. continue;
  133. }
  134. if (strcmp(t->children[i]->contents, "{") == 0) {
  135. continue;
  136. }
  137. if (strcmp(t->children[i]->contents, "}") == 0) {
  138. continue;
  139. }
  140. if (strcmp(t->children[i]->tag, "regex") == 0) {
  141. continue;
  142. }
  143. x = lval_add(x, lval_read(t->children[i]));
  144. }
  145. return x;
  146. }
  147. lval* lval_add(lval* v, lval* x) {
  148. v->count++;
  149. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  150. assert(v->cell != NULL);
  151. v->cell[v->count-1] = x;
  152. return v;
  153. }
  154. void lval_expr_print(lval* v, char open, char close) {
  155. /* Opening char */
  156. putchar(open);
  157. for (size_t i = 0; i < v->count; i++) {
  158. /* Print value contained within */
  159. lval_print(v->cell[i]);
  160. /* Don't print trailing space if last element */
  161. if (i != (v->count-1)) {
  162. putchar(' ');
  163. }
  164. }
  165. /* Opening char */
  166. putchar(close);
  167. }
  168. /* Print an lval */
  169. void lval_print(lval* v) {
  170. switch (v->type) {
  171. /* In the case the type is a number print it
  172. Then break out of the switch */
  173. case LVAL_NUM:
  174. printf("%li", v->num);
  175. break;
  176. case LVAL_DEC:
  177. printf("%.2f", v->dec);
  178. break;
  179. /* In the case the type is an error */
  180. case LVAL_ERR:
  181. printf("Error: %s", v->err);
  182. break;
  183. case LVAL_SYM:
  184. printf("%s", v->sym);
  185. break;
  186. case LVAL_SEXPR:
  187. lval_expr_print(v, '(', ')');
  188. break;
  189. }
  190. }
  191. /* Print an lval followed by a newline */
  192. void lval_println(lval* v) {
  193. lval_print(v);
  194. putchar('\n');
  195. }
  196. lval* lval_eval_sexpr(lval* v) {
  197. /* Evaluate children */
  198. for (size_t i = 0; i < v->count; i++) {
  199. v->cell[i] = lval_eval(v->cell[i]);
  200. }
  201. /* Error checking */
  202. for (size_t i = 0; i < v->count; i++) {
  203. if (v->cell[i]->type == LVAL_ERR) {
  204. return lval_take(v, i);
  205. }
  206. }
  207. /* Empty expression */
  208. if (v->count == 0) {
  209. return v;
  210. }
  211. /* Single expression */
  212. if (v->count == 1) {
  213. return lval_take(v, 0);
  214. }
  215. /* Ensure first element is symbol */
  216. lval* f = lval_pop(v, 0);
  217. if (f->type != LVAL_SYM) {
  218. lval_del(f);
  219. lval_del(v);
  220. return lval_err("S-expression does not start with symbol!");
  221. }
  222. /* Call builtin with operator */
  223. lval* result = builtin_op(v, f->sym);
  224. lval_del(f);
  225. return result;
  226. }
  227. lval* lval_eval(lval* v) {
  228. /* Evaluate sexpressions */
  229. if (v->type == LVAL_SEXPR) {
  230. return lval_eval_sexpr(v);
  231. }
  232. /* All other lval types remain the same */
  233. return v;
  234. }
  235. lval* lval_pop(lval* v, size_t i) {
  236. /* Fine the item at i */
  237. lval* x = v->cell[i];
  238. /* Shift memory after the item at i over the top */
  239. memmove(&v->cell[i], &v->cell[i+1],
  240. sizeof(lval*) * (v->count-i-1));
  241. /* Decrease the count of items in the list */
  242. v->count--;
  243. /* Reallocate the memory used */
  244. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  245. assert(v->cell != NULL);
  246. return x;
  247. }
  248. lval* lval_take(lval* v, size_t i) {
  249. lval* x = lval_pop(v, i);
  250. lval_del(v);
  251. return x;
  252. }
  253. lval* builtin_op(lval* a, char* op) {
  254. /* Ensure all arguments are numbers */
  255. for (size_t i = 0; i < a->count; i++) {
  256. if (a->cell[i]->type != LVAL_NUM && a->cell[i]->type != LVAL_DEC) {
  257. lval_del(a);
  258. return lval_err("Cannot operate on non-number/non-decimal!");
  259. }
  260. }
  261. /* Pop the 1st element */
  262. lval* x = lval_pop(a, 0);
  263. /* If no arguments and sub then perform unary negation */
  264. if (strcmp(op, "-") == 0 && a->count == 0) {
  265. if (x->type == LVAL_NUM) {
  266. x->num = -x->num;
  267. } else {
  268. x->dec = -x->dec;
  269. }
  270. }
  271. /* While there are still elements remaining */
  272. while (a->count > 0) {
  273. /* Pop the next element */
  274. lval* y = lval_pop(a, 0);
  275. if (x->type == LVAL_NUM && y->type == LVAL_NUM) {
  276. if (strcmp(op, "+") == 0) {x->num += y->num;}
  277. if (strcmp(op, "-") == 0) {x->num -= y->num;}
  278. if (strcmp(op, "*") == 0) {x->num *= y->num;}
  279. if (strcmp(op, "/") == 0) {
  280. /* If second operand is zero return error */
  281. if (y->num == 0) {
  282. lval_del(x);
  283. lval_del(y);
  284. x = lval_err("Division by zero!");
  285. break;
  286. }
  287. x->num /= y->num;
  288. }
  289. if (strcmp(op, "%") == 0) {x->num %= y->num;}
  290. if (strcmp(op, "^") == 0) {x->num = (pow(x->num, y->num));}
  291. if (strcmp(op, "min") == 0) {x->num = min(x->num, y->num);}
  292. if (strcmp(op, "max") == 0) {x->num = max(x->num, y->num);}
  293. } else {
  294. /* Cast integer number into double if necessary */
  295. double b = x->type == LVAL_NUM ? (double) x->num : x->dec;
  296. double c = y->type == LVAL_NUM ? (double) y->num : y->dec;
  297. /* Perform all operations on double */
  298. if (strcmp(op, "+") == 0) {b += c;}
  299. if (strcmp(op, "-") == 0) {b -= c;}
  300. if (strcmp(op, "*") == 0) {b *= c;}
  301. if (strcmp(op, "/") == 0) {
  302. /* If second operand is zero return error */
  303. if (c == 0) {
  304. lval_del(x);
  305. lval_del(y);
  306. x = lval_err("Division by zero!");
  307. break;
  308. }
  309. b /= c;
  310. }
  311. if (strcmp(op, "%") == 0) {b = fmod(b, c);}
  312. if (strcmp(op, "^") == 0) {b = (pow(b, c));}
  313. if (strcmp(op, "min") == 0) {b = fmin(b, c);}
  314. if (strcmp(op, "max") == 0) {b = fmax(b, c);}
  315. x->type = LVAL_DEC;
  316. x->dec = b;
  317. }
  318. }
  319. lval_del(a);
  320. return x;
  321. }
  322. long min(long x, long y) {
  323. if (x <= y) {
  324. return x;
  325. } else {
  326. return y;
  327. }
  328. }
  329. long max(long x, long y) {
  330. if (x >= y) {
  331. return x;
  332. } else {
  333. return y;
  334. }
  335. }
  336. int main(int argc, char const *argv[]) {
  337. /* Create some parsers */
  338. mpc_parser_t* Number = mpc_new("number");
  339. mpc_parser_t* Symbol = mpc_new("symbol");
  340. mpc_parser_t* Sexpr = mpc_new("sexpr");
  341. mpc_parser_t* Expr = mpc_new("expr");
  342. mpc_parser_t* Lispy = mpc_new("lispy");
  343. /* Define them with the following language */
  344. mpca_lang(MPCA_LANG_DEFAULT, parser,
  345. Number, Symbol, Sexpr, Expr, Lispy);
  346. /* Print version and exit information */
  347. puts(lispy_version);
  348. puts("Press Ctrl+c to exit\n");
  349. /* In a never ending loop */
  350. while (1) {
  351. /* Output our prompt and get input */
  352. char* input = readline("lispy> ");
  353. /* Add input to history */
  354. add_history(input);
  355. /* Attempt to parse the user input */
  356. mpc_result_t r;
  357. if (mpc_parse("<stdin>", input, Lispy, &r)) {
  358. /* On success evaluate the user input */
  359. lval* x = lval_eval(lval_read(r.output));
  360. lval_println(x);
  361. lval_del(x);
  362. } else {
  363. /* Otherwise print the error */
  364. mpc_err_print(r.error);
  365. mpc_err_delete(r.error);
  366. }
  367. /* Free retrieved input */
  368. free(input);
  369. }
  370. /* Undefine and delete our parsers */
  371. mpc_cleanup(5, Number, Symbol, Sexpr, Expr, Lispy);
  372. return 0;
  373. }