Reference

q_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 QEXPR as possible lval type */
  24. enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR };
  26. typedef struct lval {
  27.   int type;
  28.   long num;
  29.   char* err;
  30.   char* sym;
  31.   int count;
  32.   struct lval** cell;
  33. } lval;
  35. lval* lval_num(long x) {
  36.   lval* v = malloc(sizeof(lval));
  37.   v->type = LVAL_NUM;
  38.   v->num = x;
  39.   return v;
  40. }
  42. lval* lval_err(char* m) {
  43.   lval* v = malloc(sizeof(lval));
  44.   v->type = LVAL_ERR;
  45.   v->err = malloc(strlen(m) + 1);
  46.   strcpy(v->err, m);
  47.   return v;
  48. }
  50. lval* lval_sym(char* s) {
  51.   lval* v = malloc(sizeof(lval));
  52.   v->type = LVAL_SYM;
  53.   v->sym = malloc(strlen(s) + 1);
  54.   strcpy(v->sym, s);
  55.   return v;
  56. }
  58. lval* lval_sexpr(void) {
  59.   lval* v = malloc(sizeof(lval));
  60.   v->type = LVAL_SEXPR;
  61.   v->count = 0;
  62.   v->cell = NULL;
  63.   return v;
  64. }
  66. /* A pointer to a new empty Qexpr lval */
  67. lval* lval_qexpr(void) {
  68.   lval* v = malloc(sizeof(lval));
  69.   v->type = LVAL_QEXPR;
  70.   v->count = 0;
  71.   v->cell = NULL;
  72.   return v;
  73. }
  75. void lval_del(lval* v) {
  77.   switch (v->type) {
  78.     case LVAL_NUM: break;
  79.     case LVAL_ERR: free(v->err); break;
  80.     case LVAL_SYM: free(v->sym); break;
  82.     /* If Qexpr or Sexpr then delete all elements inside */
  83.     case LVAL_QEXPR:
  84.     case LVAL_SEXPR:
  85.       for (int i = 0; i < v->count; i++) {
  86.         lval_del(v->cell[i]);
  87.       }
  88.       /* Also free the memory allocated to contain the pointers */
  89.       free(v->cell);
  90.     break;
  91.   }
  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.   lval* x = v->cell[i];
  105.   memmove(&v->cell[i], &v->cell[i+1],
  106.     sizeof(lval*) * (v->count-i-1));
  107.   v->count--;
  108.   v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  109.   return x;
  110. }
  112. lval* lval_join(lval* x, lval* y) {
  114.   while (y->count) {
  115.     x = lval_add(x, lval_pop(y, 0));
  116.   }
  118.   lval_del(y);  
  119.   return x;
  120. }
  122. lval* lval_take(lval* v, int i) {
  123.   lval* x = lval_pop(v, i);
  124.   lval_del(v);
  125.   return x;
  126. }
  128. void lval_print(lval* v);
  130. void lval_expr_print(lval* v, char open, char close) {
  131.   putchar(open);
  132.   for (int i = 0; i < v->count; i++) {
  134.     lval_print(v->cell[i]);
  136.     if (i != (v->count-1)) {
  137.       putchar(' ');
  138.     }
  139.   }
  140.   putchar(close);
  141. }
  143. void lval_print(lval* v) {
  144.   switch (v->type) {
  145.     case LVAL_NUM:   printf("%li", v->num); break;
  146.     case LVAL_ERR:   printf("Error: %s", v->err); break;
  147.     case LVAL_SYM:   printf("%s", v->sym); break;
  148.     case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;
  149.     case LVAL_QEXPR: lval_expr_print(v, '{', '}'); break;
  150.   }
  151. }
  153. void lval_println(lval* v) { lval_print(v); putchar('\n'); }
  155. #define LASSERT(args, cond, err) \
  156.   if (!(cond)) { lval_del(args); return lval_err(err); }
  158. lval* lval_eval(lval* v);
  160. lval* builtin_list(lval* a) {
  161.   a->type = LVAL_QEXPR;
  162.   return a;
  163. }
  165. lval* builtin_head(lval* a) {
  166.   LASSERT(a, a->count == 1,
  167.     "Function 'head' passed too many arguments.");
  168.   LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  169.     "Function 'head' passed incorrect type.");
  170.   LASSERT(a, a->cell[0]->count != 0,
  171.     "Function 'head' passed {}.");
  173.   lval* v = lval_take(a, 0);  
  174.   while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  175.   return v;
  176. }
  178. lval* builtin_tail(lval* a) {
  179.   LASSERT(a, a->count == 1,
  180.     "Function 'tail' passed too many arguments.");
  181.   LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  182.     "Function 'tail' passed incorrect type.");
  183.   LASSERT(a, a->cell[0]->count != 0,
  184.     "Function 'tail' passed {}.");
  186.   lval* v = lval_take(a, 0);  
  187.   lval_del(lval_pop(v, 0));
  188.   return v;
  189. }
  191. lval* builtin_eval(lval* a) {
  192.   LASSERT(a, a->count == 1,
  193.     "Function 'eval' passed too many arguments.");
  194.   LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
  195.     "Function 'eval' passed incorrect type.");
  197.   lval* x = lval_take(a, 0);
  198.   x->type = LVAL_SEXPR;
  199.   return lval_eval(x);
  200. }
  202. lval* builtin_join(lval* a) {
  204.   for (int i = 0; i < a->count; i++) {
  205.     LASSERT(a, a->cell[i]->type == LVAL_QEXPR,
  206.       "Function 'join' passed incorrect type.");
  207.   }
  209.   lval* x = lval_pop(a, 0);
  211.   while (a->count) {
  212.     x = lval_join(x, lval_pop(a, 0));
  213.   }
  215.   lval_del(a);
  216.   return x;
  217. }
  219. lval* builtin_op(lval* a, char* op) {
  221.   for (int i = 0; i < a->count; i++) {
  222.     if (a->cell[i]->type != LVAL_NUM) {
  223.       lval_del(a);
  224.       return lval_err("Cannot operate on non-number!");
  225.     }
  226.   }
  228.   lval* x = lval_pop(a, 0);
  229.   if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
  231.   while (a->count > 0) {
  233.     lval* y = lval_pop(a, 0);
  235.     if (strcmp(op, "+") == 0) { x->num += y->num; }
  236.     if (strcmp(op, "-") == 0) { x->num -= y->num; }
  237.     if (strcmp(op, "*") == 0) { x->num *= y->num; }
  238.     if (strcmp(op, "/") == 0) {
  239.       if (y->num == 0) {
  240.         lval_del(x); lval_del(y);
  241.         x = lval_err("Division By Zero.");
  242.         break;
  243.       }
  244.       x->num /= y->num;
  245.     }
  247.     lval_del(y);
  248.   }
  250.   lval_del(a);
  251.   return x;
  252. }
  254. lval* builtin(lval* a, char* func) {
  255.   if (strcmp("list", func) == 0) { return builtin_list(a); }
  256.   if (strcmp("head", func) == 0) { return builtin_head(a); }
  257.   if (strcmp("tail", func) == 0) { return builtin_tail(a); }
  258.   if (strcmp("join", func) == 0) { return builtin_join(a); }
  259.   if (strcmp("eval", func) == 0) { return builtin_eval(a); }
  260.   if (strstr("+-/*", func)) { return builtin_op(a, func); }
  261.   lval_del(a);
  262.   return lval_err("Unknown Function!");
  263. }
  265. lval* lval_eval_sexpr(lval* v) {
  267.   for (int i = 0; i < v->count; i++) {
  268.     v->cell[i] = lval_eval(v->cell[i]);
  269.   }
  271.   for (int i = 0; i < v->count; i++) {
  272.     if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
  273.   }
  275.   if (v->count == 0) { return v; }
  277.   if (v->count == 1) { return lval_take(v, 0); }
  279.   lval* f = lval_pop(v, 0);
  280.   if (f->type != LVAL_SYM) {
  281.     lval_del(f); lval_del(v);
  282.     return lval_err("S-expression Does not start with symbol.");
  283.   }
  285.   /* Call builtin with operator */
  286.   lval* result = builtin(v, f->sym);
  287.   lval_del(f);
  288.   return result;
  289. }
  291. lval* lval_eval(lval* v) {
  292.   if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(v); }
  293.   return v;
  294. }
  296. lval* lval_read_num(mpc_ast_t* t) {
  297.   errno = 0;
  298.   long x = strtol(t->contents, NULL, 10);
  299.   return errno != ERANGE ? lval_num(x) : lval_err("invalid number");
  300. }
  302. lval* lval_read(mpc_ast_t* t) {
  304.   if (strstr(t->tag, "number")) { return lval_read_num(t); }
  305.   if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
  307.   lval* x = NULL;
  308.   if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } 
  309.   if (strstr(t->tag, "sexpr"))  { x = lval_sexpr(); }
  310.   if (strstr(t->tag, "qexpr"))  { x = lval_qexpr(); }
  312.   for (int i = 0; i < t->children_num; i++) {
  313.     if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
  314.     if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
  315.     if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
  316.     if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
  317.     if (strcmp(t->children[i]->tag,  "regex") == 0) { continue; }
  318.     x = lval_add(x, lval_read(t->children[i]));
  319.   }
  321.   return x;
  322. }
  324. int main(int argc, char** argv) {
  326.   mpc_parser_t* Number = mpc_new("number");
  327.   mpc_parser_t* Symbol = mpc_new("symbol");
  328.   mpc_parser_t* Sexpr  = mpc_new("sexpr");
  329.   mpc_parser_t* Qexpr  = mpc_new("qexpr");
  330.   mpc_parser_t* Expr   = mpc_new("expr");
  331.   mpc_parser_t* Lispy  = mpc_new("lispy");
  333.   mpca_lang(MPCA_LANG_DEFAULT,
  334.     "                                                    \
  335.       number : /-?[0-9]+/ ;                              \
  336.       symbol : \"list\" | \"head\" | \"tail\" | \"eval\" \
  337.              | \"join\" | '+' | '-' | '*' | '/' ;        \
  338.       sexpr  : '(' <expr>* ')' ;                         \
  339.       qexpr  : '{' <expr>* '}' ;                         \
  340.       expr   : <number> | <symbol> | <sexpr> | <qexpr> ; \
  341.       lispy  : /^/ <expr>* /$/ ;                         \
  342.     ",
  343.     Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  345.   puts("Lispy Version 0.0.0.0.6");
  346.   puts("Press Ctrl+c to Exit\n");
  348.   while (1) {
  350.     char* input = readline("lispy> ");
  351.     add_history(input);
  353.     mpc_result_t r;
  354.     if (mpc_parse("<stdin>", input, Lispy, &r)) {
  355.       lval* x = lval_eval(lval_read(r.output));
  356.       lval_println(x);
  357.       lval_del(x);
  358.       mpc_ast_delete(r.output);
  359.     } else {    
  360.       mpc_err_print(r.error);
  361.       mpc_err_delete(r.error);
  362.     }
  364.     free(input);
  366.   }
  368.   mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  370.   return 0;
  371. }