参考

{% collapse title=”s_expressions.c” %}

  1. #include "mpc.h"
  3. #ifdef _WIN32
  5. static char buffer[2048];
  7. char* readline(char* prompt) {
  8.   fputs(prompt, stdout);
  9.   fgets(buffer, 2048, stdin);
  10.   char* cpy = malloc(strlen(buffer)+1);
  11.   strcpy(cpy, buffer);
  12.   cpy[strlen(cpy)-1] = '\0';
  13.   return cpy;
  14. }
  16. void add_history(char* unused) {}
  18. #else
  19. #include <editline/readline.h>
  20. #include <editline/history.h>
  21. #endif
  23. /* Add SYM and SEXPR as possible lval types */
  24. enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_SEXPR };
  26. typedef struct lval {
  27.   int type;
  28.   long num;
  29.   /* Error and Symbol types have some string data */
  30.   char* err;
  31.   char* sym;
  32.   /* Count and Pointer to a list of "lval*"; */
  33.   int count;
  34.   struct lval** cell;
  35. } lval;
  37. /* Construct a pointer to a new Number lval */ 
  38. lval* lval_num(long x) {
  39.   lval* v = malloc(sizeof(lval));
  40.   v->type = LVAL_NUM;
  41.   v->num = x;
  42.   return v;
  43. }
  45. /* Construct a pointer to a new Error lval */ 
  46. lval* lval_err(char* m) {
  47.   lval* v = malloc(sizeof(lval));
  48.   v->type = LVAL_ERR;
  49.   v->err = malloc(strlen(m) + 1);
  50.   strcpy(v->err, m);
  51.   return v;
  52. }
  54. /* Construct a pointer to a new Symbol lval */ 
  55. lval* lval_sym(char* s) {
  56.   lval* v = malloc(sizeof(lval));
  57.   v->type = LVAL_SYM;
  58.   v->sym = malloc(strlen(s) + 1);
  59.   strcpy(v->sym, s);
  60.   return v;
  61. }
  63. /* A pointer to a new empty Sexpr lval */
  64. lval* lval_sexpr(void) {
  65.   lval* v = malloc(sizeof(lval));
  66.   v->type = LVAL_SEXPR;
  67.   v->count = 0;
  68.   v->cell = NULL;
  69.   return v;
  70. }
  72. void lval_del(lval* v) {
  74.   switch (v->type) {
  75.     /* Do nothing special for number type */
  76.     case LVAL_NUM: break;
  78.     /* For Err or Sym free the string data */
  79.     case LVAL_ERR: free(v->err); break;
  80.     case LVAL_SYM: free(v->sym); break;
  82.     /* If Sexpr then delete all elements inside */
  83.     case LVAL_SEXPR:
  84.       for (int i = 0; i < v->count; i++) {
  85.         lval_del(v->cell[i]);
  86.       }
  87.       /* Also free the memory allocated to contain the pointers */
  88.       free(v->cell);
  89.     break;
  90.   }
  92.   /* Free the memory allocated for the "lval" struct itself */
  93.   free(v);
  94. }
  96. lval* lval_add(lval* v, lval* x) {
  97.   v->count++;
  98.   v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  99.   v->cell[v->count-1] = x;
  100.   return v;
  101. }
  103. lval* lval_pop(lval* v, int i) {
  104.   /* Find the item at "i" */
  105.   lval* x = v->cell[i];
  107.   /* Shift memory after the item at "i" over the top */
  108.   memmove(&v->cell[i], &v->cell[i+1],
  109.     sizeof(lval*) * (v->count-i-1));
  111.   /* Decrease the count of items in the list */
  112.   v->count--;
  114.   /* Reallocate the memory used */
  115.   v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  116.   return x;
  117. }
  119. lval* lval_take(lval* v, int i) {
  120.   lval* x = lval_pop(v, i);
  121.   lval_del(v);
  122.   return x;
  123. }
  125. void lval_print(lval* v);
  127. void lval_expr_print(lval* v, char open, char close) {
  128.   putchar(open);
  129.   for (int i = 0; i < v->count; i++) {
  131.     /* Print Value contained within */
  132.     lval_print(v->cell[i]);
  134.     /* Don't print trailing space if last element */
  135.     if (i != (v->count-1)) {
  136.       putchar(' ');
  137.     }
  138.   }
  139.   putchar(close);
  140. }
  142. void lval_print(lval* v) {
  143.   switch (v->type) {
  144.     case LVAL_NUM:   printf("%li", v->num); break;
  145.     case LVAL_ERR:   printf("Error: %s", v->err); break;
  146.     case LVAL_SYM:   printf("%s", v->sym); break;
  147.     case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;
  148.   }
  149. }
  151. void lval_println(lval* v) { lval_print(v); putchar('\n'); }
  153. lval* builtin_op(lval* a, char* op) {
  155.   /* Ensure all arguments are numbers */
  156.   for (int i = 0; i < a->count; i++) {
  157.     if (a->cell[i]->type != LVAL_NUM) {
  158.       lval_del(a);
  159.       return lval_err("Cannot operate on non-number!");
  160.     }
  161.   }
  163.   /* Pop the first element */
  164.   lval* x = lval_pop(a, 0);
  166.   /* If no arguments and sub then perform unary negation */
  167.   if ((strcmp(op, "-") == 0) && a->count == 0) {
  168.     x->num = -x->num;
  169.   }
  171.   /* While there are still elements remaining */
  172.   while (a->count > 0) {
  174.     /* Pop the next element */
  175.     lval* y = lval_pop(a, 0);
  177.     /* Perform operation */
  178.     if (strcmp(op, "+") == 0) { x->num += y->num; }
  179.     if (strcmp(op, "-") == 0) { x->num -= y->num; }
  180.     if (strcmp(op, "*") == 0) { x->num *= y->num; }
  181.     if (strcmp(op, "/") == 0) {
  182.       if (y->num == 0) {
  183.         lval_del(x); lval_del(y);
  184.         x = lval_err("Division By Zero.");
  185.         break;
  186.       }
  187.       x->num /= y->num;
  188.     }
  190.     /* Delete element now finished with */
  191.     lval_del(y);
  192.   }
  194.   /* Delete input expression and return result */
  195.   lval_del(a);
  196.   return x;
  197. }
  199. lval* lval_eval(lval* v);
  201. lval* lval_eval_sexpr(lval* v) {
  203.   /* Evaluate Children */
  204.   for (int i = 0; i < v->count; i++) {
  205.     v->cell[i] = lval_eval(v->cell[i]);
  206.   }
  208.   /* Error Checking */
  209.   for (int i = 0; i < v->count; i++) {
  210.     if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
  211.   }
  213.   /* Empty Expression */
  214.   if (v->count == 0) { return v; }
  216.   /* Single Expression */
  217.   if (v->count == 1) { return lval_take(v, 0); }
  219.   /* Ensure First Element is Symbol */
  220.   lval* f = lval_pop(v, 0);
  221.   if (f->type != LVAL_SYM) {
  222.     lval_del(f); lval_del(v);
  223.     return lval_err("S-expression Does not start with symbol.");
  224.   }
  226.   /* Call builtin with operator */
  227.   lval* result = builtin_op(v, f->sym);
  228.   lval_del(f);
  229.   return result;
  230. }
  232. lval* lval_eval(lval* v) {
  233.   /* Evaluate Sexpressions */
  234.   if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(v); }
  235.   /* All other lval types remain the same */
  236.   return v;
  237. }
  239. lval* lval_read_num(mpc_ast_t* t) {
  240.   errno = 0;
  241.   long x = strtol(t->contents, NULL, 10);
  242.   return errno != ERANGE ?
  243.     lval_num(x) : lval_err("invalid number");
  244. }
  246. lval* lval_read(mpc_ast_t* t) {
  248.   /* If Symbol or Number return conversion to that type */
  249.   if (strstr(t->tag, "number")) { return lval_read_num(t); }
  250.   if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
  252.   /* If root (>) or sexpr then create empty list */
  253.   lval* x = NULL;
  254.   if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } 
  255.   if (strstr(t->tag, "sexpr"))  { x = lval_sexpr(); }
  257.   /* Fill this list with any valid expression contained within */
  258.   for (int i = 0; i < t->children_num; i++) {
  259.     if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
  260.     if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
  261.     if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
  262.     if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
  263.     if (strcmp(t->children[i]->tag,  "regex") == 0) { continue; }
  264.     x = lval_add(x, lval_read(t->children[i]));
  265.   }
  267.   return x;
  268. }
  270. int main(int argc, char** argv) {
  272.   mpc_parser_t* Number = mpc_new("number");
  273.   mpc_parser_t* Symbol = mpc_new("symbol");
  274.   mpc_parser_t* Sexpr  = mpc_new("sexpr");
  275.   mpc_parser_t* Expr   = mpc_new("expr");
  276.   mpc_parser_t* Lispy  = mpc_new("lispy");
  278.   mpca_lang(MPCA_LANG_DEFAULT,
  279.     "                                          \
  280.       number : /-?[0-9]+/ ;                    \
  281.       symbol : '+' | '-' | '*' | '/' ;         \
  282.       sexpr  : '(' <expr>* ')' ;               \
  283.       expr   : <number> | <symbol> | <sexpr> ; \
  284.       lispy  : /^/ <expr>* /$/ ;               \
  285.     ",
  286.     Number, Symbol, Sexpr, Expr, Lispy);
  288.   puts("Lispy Version 0.0.0.0.5");
  289.   puts("Press Ctrl+c to Exit\n");
  291.   while (1) {
  293.     char* input = readline("lispy> ");
  294.     add_history(input);
  296.     mpc_result_t r;
  297.     if (mpc_parse("<stdin>", input, Lispy, &r)) {
  298.       lval* x = lval_eval(lval_read(r.output));
  299.       lval_println(x);
  300.       lval_del(x);
  301.       mpc_ast_delete(r.output);
  302.     } else {    
  303.       mpc_err_print(r.error);
  304.       mpc_err_delete(r.error);
  305.     }
  307.     free(input);
  309.   }
  311.   mpc_cleanup(5, Number, Symbol, Sexpr, Expr, Lispy);
  313.   return 0;
  314. }

{% endcollapse %}