参考

{% collapse title=”q_expressions.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. /* Add QEXPR as possible lval type */
  18. enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR };
  19. typedef struct lval {
  20. int type;
  21. long num;
  22. char* err;
  23. char* sym;
  24. int count;
  25. struct lval** cell;
  26. } lval;
  27. lval* lval_num(long x) {
  28. lval* v = malloc(sizeof(lval));
  29. v->type = LVAL_NUM;
  30. v->num = x;
  31. return v;
  32. }
  33. lval* lval_err(char* m) {
  34. lval* v = malloc(sizeof(lval));
  35. v->type = LVAL_ERR;
  36. v->err = malloc(strlen(m) + 1);
  37. strcpy(v->err, m);
  38. return v;
  39. }
  40. lval* lval_sym(char* s) {
  41. lval* v = malloc(sizeof(lval));
  42. v->type = LVAL_SYM;
  43. v->sym = malloc(strlen(s) + 1);
  44. strcpy(v->sym, s);
  45. return v;
  46. }
  47. lval* lval_sexpr(void) {
  48. lval* v = malloc(sizeof(lval));
  49. v->type = LVAL_SEXPR;
  50. v->count = 0;
  51. v->cell = NULL;
  52. return v;
  53. }
  54. /* A pointer to a new empty Qexpr lval */
  55. lval* lval_qexpr(void) {
  56. lval* v = malloc(sizeof(lval));
  57. v->type = LVAL_QEXPR;
  58. v->count = 0;
  59. v->cell = NULL;
  60. return v;
  61. }
  62. void lval_del(lval* v) {
  63. switch (v->type) {
  64. case LVAL_NUM: break;
  65. case LVAL_ERR: free(v->err); break;
  66. case LVAL_SYM: free(v->sym); break;
  67. /* If Qexpr or Sexpr then delete all elements inside */
  68. case LVAL_QEXPR:
  69. case LVAL_SEXPR:
  70. for (int i = 0; i < v->count; i++) {
  71. lval_del(v->cell[i]);
  72. }
  73. /* Also free the memory allocated to contain the pointers */
  74. free(v->cell);
  75. break;
  76. }
  77. free(v);
  78. }
  79. lval* lval_add(lval* v, lval* x) {
  80. v->count++;
  81. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  82. v->cell[v->count-1] = x;
  83. return v;
  84. }
  85. lval* lval_pop(lval* v, int i) {
  86. lval* x = v->cell[i];
  87. memmove(&v->cell[i], &v->cell[i+1],
  88. sizeof(lval*) * (v->count-i-1));
  89. v->count--;
  90. v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  91. return x;
  92. }
  93. lval* lval_join(lval* x, lval* y) {
  94. while (y->count) {
  95. x = lval_add(x, lval_pop(y, 0));
  96. }
  97. lval_del(y);
  98. return x;
  99. }
  100. lval* lval_take(lval* v, int i) {
  101. lval* x = lval_pop(v, i);
  102. lval_del(v);
  103. return x;
  104. }
  105. void lval_print(lval* v);
  106. void lval_expr_print(lval* v, char open, char close) {
  107. putchar(open);
  108. for (int i = 0; i < v->count; i++) {
  109. lval_print(v->cell[i]);
  110. if (i != (v->count-1)) {
  111. putchar(' ');
  112. }
  113. }
  114. putchar(close);
  115. }
  116. void lval_print(lval* v) {
  117. switch (v->type) {
  118. case LVAL_NUM: printf("%li", v->num); break;
  119. case LVAL_ERR: printf("Error: %s", v->err); break;
  120. case LVAL_SYM: printf("%s", v->sym); break;
  121. case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;
  122. case LVAL_QEXPR: lval_expr_print(v, '{', '}'); break;
  123. }
  124. }
  125. void lval_println(lval* v) { lval_print(v); putchar('\n'); }
  126. #define LASSERT(args, cond, err) \
  127. if (!(cond)) { lval_del(args); return lval_err(err); }
  128. lval* lval_eval(lval* v);
  129. lval* builtin_list(lval* a) {
  130. a->type = LVAL_QEXPR;
  131. return a;
  132. }
  133. lval* builtin_head(lval* a) {
  134. LASSERT(a, a->count == 1,
  135. "Function 'head' passed too many arguments.");
  136. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  137. "Function 'head' passed incorrect type.");
  138. LASSERT(a, a->cell[0]->count != 0,
  139. "Function 'head' passed {}.");
  140. lval* v = lval_take(a, 0);
  141. while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  142. return v;
  143. }
  144. lval* builtin_tail(lval* a) {
  145. LASSERT(a, a->count == 1,
  146. "Function 'tail' passed too many arguments.");
  147. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  148. "Function 'tail' passed incorrect type.");
  149. LASSERT(a, a->cell[0]->count != 0,
  150. "Function 'tail' passed {}.");
  151. lval* v = lval_take(a, 0);
  152. lval_del(lval_pop(v, 0));
  153. return v;
  154. }
  155. lval* builtin_eval(lval* a) {
  156. LASSERT(a, a->count == 1,
  157. "Function 'eval' passed too many arguments.");
  158. LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  159. "Function 'eval' passed incorrect type.");
  160. lval* x = lval_take(a, 0);
  161. x->type = LVAL_SEXPR;
  162. return lval_eval(x);
  163. }
  164. lval* builtin_join(lval* a) {
  165. for (int i = 0; i < a->count; i++) {
  166. LASSERT(a, a->cell[i]->type == LVAL_QEXPR,
  167. "Function 'join' passed incorrect type.");
  168. }
  169. lval* x = lval_pop(a, 0);
  170. while (a->count) {
  171. x = lval_join(x, lval_pop(a, 0));
  172. }
  173. lval_del(a);
  174. return x;
  175. }
  176. lval* builtin_op(lval* a, char* op) {
  177. for (int i = 0; i < a->count; i++) {
  178. if (a->cell[i]->type != LVAL_NUM) {
  179. lval_del(a);
  180. return lval_err("Cannot operate on non-number!");
  181. }
  182. }
  183. lval* x = lval_pop(a, 0);
  184. if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
  185. while (a->count > 0) {
  186. lval* y = lval_pop(a, 0);
  187. if (strcmp(op, "+") == 0) { x->num += y->num; }
  188. if (strcmp(op, "-") == 0) { x->num -= y->num; }
  189. if (strcmp(op, "*") == 0) { x->num *= y->num; }
  190. if (strcmp(op, "/") == 0) {
  191. if (y->num == 0) {
  192. lval_del(x); lval_del(y);
  193. x = lval_err("Division By Zero.");
  194. break;
  195. }
  196. x->num /= y->num;
  197. }
  198. lval_del(y);
  199. }
  200. lval_del(a);
  201. return x;
  202. }
  203. lval* builtin(lval* a, char* func) {
  204. if (strcmp("list", func) == 0) { return builtin_list(a); }
  205. if (strcmp("head", func) == 0) { return builtin_head(a); }
  206. if (strcmp("tail", func) == 0) { return builtin_tail(a); }
  207. if (strcmp("join", func) == 0) { return builtin_join(a); }
  208. if (strcmp("eval", func) == 0) { return builtin_eval(a); }
  209. if (strstr("+-/*", func)) { return builtin_op(a, func); }
  210. lval_del(a);
  211. return lval_err("Unknown Function!");
  212. }
  213. lval* lval_eval_sexpr(lval* v) {
  214. for (int i = 0; i < v->count; i++) {
  215. v->cell[i] = lval_eval(v->cell[i]);
  216. }
  217. for (int i = 0; i < v->count; i++) {
  218. if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
  219. }
  220. if (v->count == 0) { return v; }
  221. if (v->count == 1) { return lval_take(v, 0); }
  222. lval* f = lval_pop(v, 0);
  223. if (f->type != LVAL_SYM) {
  224. lval_del(f); lval_del(v);
  225. return lval_err("S-expression Does not start with symbol.");
  226. }
  227. /* Call builtin with operator */
  228. lval* result = builtin(v, f->sym);
  229. lval_del(f);
  230. return result;
  231. }
  232. lval* lval_eval(lval* v) {
  233. if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(v); }
  234. return v;
  235. }
  236. lval* lval_read_num(mpc_ast_t* t) {
  237. errno = 0;
  238. long x = strtol(t->contents, NULL, 10);
  239. return errno != ERANGE ? lval_num(x) : lval_err("invalid number");
  240. }
  241. lval* lval_read(mpc_ast_t* t) {
  242. if (strstr(t->tag, "number")) { return lval_read_num(t); }
  243. if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
  244. lval* x = NULL;
  245. if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
  246. if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
  247. if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
  248. for (int i = 0; i < t->children_num; i++) {
  249. if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
  250. if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
  251. if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
  252. if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
  253. if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
  254. x = lval_add(x, lval_read(t->children[i]));
  255. }
  256. return x;
  257. }
  258. int main(int argc, char** argv) {
  259. mpc_parser_t* Number = mpc_new("number");
  260. mpc_parser_t* Symbol = mpc_new("symbol");
  261. mpc_parser_t* Sexpr = mpc_new("sexpr");
  262. mpc_parser_t* Qexpr = mpc_new("qexpr");
  263. mpc_parser_t* Expr = mpc_new("expr");
  264. mpc_parser_t* Lispy = mpc_new("lispy");
  265. mpca_lang(MPCA_LANG_DEFAULT,
  266. " \
  267. number : /-?[0-9]+/ ; \
  268. symbol : \"list\" | \"head\" | \"tail\" | \"eval\" \
  269. | \"join\" | '+' | '-' | '*' | '/' ; \
  270. sexpr : '(' <expr>* ')' ; \
  271. qexpr : '{' <expr>* '}' ; \
  272. expr : <number> | <symbol> | <sexpr> | <qexpr> ; \
  273. lispy : /^/ <expr>* /$/ ; \
  274. ",
  275. Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  276. puts("Lispy Version 0.0.0.0.6");
  277. puts("Press Ctrl+c to Exit\n");
  278. while (1) {
  279. char* input = readline("lispy> ");
  280. add_history(input);
  281. mpc_result_t r;
  282. if (mpc_parse("<stdin>", input, Lispy, &r)) {
  283. lval* x = lval_eval(lval_read(r.output));
  284. lval_println(x);
  285. lval_del(x);
  286. mpc_ast_delete(r.output);
  287. } else {
  288. mpc_err_print(r.error);
  289. mpc_err_delete(r.error);
  290. }
  291. free(input);
  292. }
  293. mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  294. return 0;
  295. }

{% endcollapse %}