Reference

{% collapse title=”functions.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. /* Forward Declarations */
  25. struct lval;
  26. struct lenv;
  27. typedef struct lval lval;
  28. typedef struct lenv lenv;
  30. /* Lisp Value */
  32. enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_FUN, LVAL_SEXPR, LVAL_QEXPR };
  34. typedef lval*(*lbuiltin)(lenv*, lval*);
  36. struct lval {
  37.   int type;
  39.   /* Basic */
  40.   long num;
  41.   char* err;
  42.   char* sym;
  44.   /* Function */
  45.   lbuiltin builtin;
  46.   lenv* env;
  47.   lval* formals;
  48.   lval* body;
  50.   /* Expression */
  51.   int count;
  52.   lval** cell;
  53. };
  55. lval* lval_num(long x) {
  56.   lval* v = malloc(sizeof(lval));
  57.   v->type = LVAL_NUM;
  58.   v->num = x;
  59.   return v;
  60. }
  62. lval* lval_err(char* fmt, ...) {
  63.   lval* v = malloc(sizeof(lval));
  64.   v->type = LVAL_ERR;  
  65.   va_list va;
  66.   va_start(va, fmt);  
  67.   v->err = malloc(512);  
  68.   vsnprintf(v->err, 511, fmt, va);  
  69.   v->err = realloc(v->err, strlen(v->err)+1);
  70.   va_end(va);  
  71.   return v;
  72. }
  74. lval* lval_sym(char* s) {
  75.   lval* v = malloc(sizeof(lval));
  76.   v->type = LVAL_SYM;
  77.   v->sym = malloc(strlen(s) + 1);
  78.   strcpy(v->sym, s);
  79.   return v;
  80. }
  82. lval* lval_builtin(lbuiltin func) {
  83.   lval* v = malloc(sizeof(lval));
  84.   v->type = LVAL_FUN;
  85.   v->builtin = func;
  86.   return v;
  87. }
  89. lenv* lenv_new(void);
  91. lval* lval_lambda(lval* formals, lval* body) {
  92.   lval* v = malloc(sizeof(lval));
  93.   v->type = LVAL_FUN;
  95.   /* Set Builtin to Null */
  96.   v->builtin = NULL;
  98.   /* Build new environment */
  99.   v->env = lenv_new();
  101.   /* Set Formals and Body */
  102.   v->formals = formals;
  103.   v->body = body;
  104.   return v;  
  105. }
  107. lval* lval_sexpr(void) {
  108.   lval* v = malloc(sizeof(lval));
  109.   v->type = LVAL_SEXPR;
  110.   v->count = 0;
  111.   v->cell = NULL;
  112.   return v;
  113. }
  115. lval* lval_qexpr(void) {
  116.   lval* v = malloc(sizeof(lval));
  117.   v->type = LVAL_QEXPR;
  118.   v->count = 0;
  119.   v->cell = NULL;
  120.   return v;
  121. }
  123. void lenv_del(lenv* e);
  125. void lval_del(lval* v) {
  127.   switch (v->type) {
  128.     case LVAL_NUM: break;
  129.     case LVAL_FUN: 
  130.       if (!v->builtin) {
  131.         lenv_del(v->env);
  132.         lval_del(v->formals);
  133.         lval_del(v->body);
  134.       }
  135.     break;
  136.     case LVAL_ERR: free(v->err); break;
  137.     case LVAL_SYM: free(v->sym); break;
  138.     case LVAL_QEXPR:
  139.     case LVAL_SEXPR:
  140.       for (int i = 0; i < v->count; i++) {
  141.         lval_del(v->cell[i]);
  142.       }
  143.       free(v->cell);
  144.     break;
  145.   }
  147.   free(v);
  148. }
  150. lenv* lenv_copy(lenv* e);
  152. lval* lval_copy(lval* v) {
  153.   lval* x = malloc(sizeof(lval));
  154.   x->type = v->type;
  155.   switch (v->type) {
  156.     case LVAL_FUN:
  157.       if (v->builtin) {
  158.         x->builtin = v->builtin;
  159.       } else {
  160.         x->builtin = NULL;
  161.         x->env = lenv_copy(v->env);
  162.         x->formals = lval_copy(v->formals);
  163.         x->body = lval_copy(v->body);
  164.       }
  165.     break;
  166.     case LVAL_NUM: x->num = v->num; break;
  167.     case LVAL_ERR: x->err = malloc(strlen(v->err) + 1);
  168.       strcpy(x->err, v->err);
  169.     break;
  170.     case LVAL_SYM: x->sym = malloc(strlen(v->sym) + 1);
  171.       strcpy(x->sym, v->sym);
  172.     break;
  173.     case LVAL_SEXPR:
  174.     case LVAL_QEXPR:
  175.       x->count = v->count;
  176.       x->cell = malloc(sizeof(lval*) * x->count);
  177.       for (int i = 0; i < x->count; i++) {
  178.         x->cell[i] = lval_copy(v->cell[i]);
  179.       }
  180.     break;
  181.   }
  182.   return x;
  183. }
  185. lval* lval_add(lval* v, lval* x) {
  186.   v->count++;
  187.   v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  188.   v->cell[v->count-1] = x;
  189.   return v;
  190. }
  192. lval* lval_join(lval* x, lval* y) {  
  193.   for (int i = 0; i < y->count; i++) {
  194.     x = lval_add(x, y->cell[i]);
  195.   }
  196.   free(y->cell);
  197.   free(y);  
  198.   return x;
  199. }
  201. lval* lval_pop(lval* v, int i) {
  202.   lval* x = v->cell[i];  
  203.   memmove(&v->cell[i],
  204.     &v->cell[i+1], sizeof(lval*) * (v->count-i-1));  
  205.   v->count--;  
  206.   v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  207.   return x;
  208. }
  210. lval* lval_take(lval* v, int i) {
  211.   lval* x = lval_pop(v, i);
  212.   lval_del(v);
  213.   return x;
  214. }
  216. void lval_print(lval* v);
  218. void lval_print_expr(lval* v, char open, char close) {
  219.   putchar(open);
  220.   for (int i = 0; i < v->count; i++) {
  221.     lval_print(v->cell[i]);    
  222.     if (i != (v->count-1)) {
  223.       putchar(' ');
  224.     }
  225.   }
  226.   putchar(close);
  227. }
  229. void lval_print(lval* v) {
  230.   switch (v->type) {
  231.     case LVAL_FUN:
  232.       if (v->builtin) {
  233.         printf("<builtin>");
  234.       } else {
  235.         printf("(\\ "); lval_print(v->formals);
  236.         putchar(' '); lval_print(v->body); putchar(')');
  237.       }
  238.     break;
  239.     case LVAL_NUM:   printf("%li", v->num); break;
  240.     case LVAL_ERR:   printf("Error: %s", v->err); break;
  241.     case LVAL_SYM:   printf("%s", v->sym); break;
  242.     case LVAL_SEXPR: lval_print_expr(v, '(', ')'); break;
  243.     case LVAL_QEXPR: lval_print_expr(v, '{', '}'); break;
  244.   }
  245. }
  247. void lval_println(lval* v) { lval_print(v); putchar('\n'); }
  249. char* ltype_name(int t) {
  250.   switch(t) {
  251.     case LVAL_FUN: return "Function";
  252.     case LVAL_NUM: return "Number";
  253.     case LVAL_ERR: return "Error";
  254.     case LVAL_SYM: return "Symbol";
  255.     case LVAL_SEXPR: return "S-Expression";
  256.     case LVAL_QEXPR: return "Q-Expression";
  257.     default: return "Unknown";
  258.   }
  259. }
  261. /* Lisp Environment */
  263. struct lenv {
  264.   lenv* par;
  265.   int count;
  266.   char** syms;
  267.   lval** vals;
  268. };
  270. lenv* lenv_new(void) {
  271.   lenv* e = malloc(sizeof(lenv));
  272.   e->par = NULL;
  273.   e->count = 0;
  274.   e->syms = NULL;
  275.   e->vals = NULL;
  276.   return e;
  277. }
  279. void lenv_del(lenv* e) {
  280.   for (int i = 0; i < e->count; i++) {
  281.     free(e->syms[i]);
  282.     lval_del(e->vals[i]);
  283.   }  
  284.   free(e->syms);
  285.   free(e->vals);
  286.   free(e);
  287. }
  289. lenv* lenv_copy(lenv* e) {
  290.   lenv* n = malloc(sizeof(lenv));
  291.   n->par = e->par;
  292.   n->count = e->count;
  293.   n->syms = malloc(sizeof(char*) * n->count);
  294.   n->vals = malloc(sizeof(lval*) * n->count);
  295.   for (int i = 0; i < e->count; i++) {
  296.     n->syms[i] = malloc(strlen(e->syms[i]) + 1);
  297.     strcpy(n->syms[i], e->syms[i]);
  298.     n->vals[i] = lval_copy(e->vals[i]);
  299.   }
  300.   return n;
  301. }
  303. lval* lenv_get(lenv* e, lval* k) {
  305.   for (int i = 0; i < e->count; i++) {
  306.     if (strcmp(e->syms[i], k->sym) == 0) {
  307.       return lval_copy(e->vals[i]);
  308.     }
  309.   }
  311.   /* If no symbol check in parent otherwise error */
  312.   if (e->par) {
  313.     return lenv_get(e->par, k);
  314.   } else {
  315.     return lval_err("Unbound Symbol '%s'", k->sym);
  316.   }
  317. }
  319. void lenv_put(lenv* e, lval* k, lval* v) {
  321.   for (int i = 0; i < e->count; i++) {
  322.     if (strcmp(e->syms[i], k->sym) == 0) {
  323.       lval_del(e->vals[i]);
  324.       e->vals[i] = lval_copy(v);
  325.       return;
  326.     }
  327.   }
  330.   e->count++;
  331.   e->vals = realloc(e->vals, sizeof(lval*) * e->count);
  332.   e->syms = realloc(e->syms, sizeof(char*) * e->count);  
  333.   e->vals[e->count-1] = lval_copy(v);
  334.   e->syms[e->count-1] = malloc(strlen(k->sym)+1);
  335.   strcpy(e->syms[e->count-1], k->sym);
  336. }
  338. void lenv_def(lenv* e, lval* k, lval* v) {
  339.   /* Iterate till e has no parent */
  340.   while (e->par) { e = e->par; }
  341.   /* Put value in e */
  342.   lenv_put(e, k, v);
  343. }
  345. /* Builtins */
  347. #define LASSERT(args, cond, fmt, ...) \
  348.   if (!(cond)) { lval* err = lval_err(fmt, ##__VA_ARGS__); lval_del(args); return err; }
  350. #define LASSERT_TYPE(func, args, index, expect) \
  351.   LASSERT(args, args->cell[index]->type == expect, \
  352.     "Function '%s' passed incorrect type for argument %i. " \
  353.     "Got %s, Expected %s.", \
  354.     func, index, ltype_name(args->cell[index]->type), ltype_name(expect))
  356. #define LASSERT_NUM(func, args, num) \
  357.   LASSERT(args, args->count == num, \
  358.     "Function '%s' passed incorrect number of arguments. " \
  359.     "Got %i, Expected %i.", \
  360.     func, args->count, num)
  362. #define LASSERT_NOT_EMPTY(func, args, index) \
  363.   LASSERT(args, args->cell[index]->count != 0, \
  364.     "Function '%s' passed {} for argument %i.", func, index);
  366. lval* lval_eval(lenv* e, lval* v);
  368. lval* builtin_lambda(lenv* e, lval* a) {
  369.   /* Check Two arguments, each of which are Q-Expressions */
  370.   LASSERT_NUM("\\", a, 2);
  371.   LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
  372.   LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);
  374.   /* Check first Q-Expression contains only Symbols */
  375.   for (int i = 0; i < a->cell[0]->count; i++) {
  376.     LASSERT(a, (a->cell[0]->cell[i]->type == LVAL_SYM),
  377.       "Cannot define non-symbol. Got %s, Expected %s.",
  378.       ltype_name(a->cell[0]->cell[i]->type),ltype_name(LVAL_SYM));
  379.   }
  381.   /* Pop first two arguments and pass them to lval_lambda */
  382.   lval* formals = lval_pop(a, 0);
  383.   lval* body = lval_pop(a, 0);
  384.   lval_del(a);
  386.   return lval_lambda(formals, body);
  387. }
  389. lval* builtin_list(lenv* e, lval* a) {
  390.   a->type = LVAL_QEXPR;
  391.   return a;
  392. }
  394. lval* builtin_head(lenv* e, lval* a) {
  395.   LASSERT_NUM("head", a, 1);
  396.   LASSERT_TYPE("head", a, 0, LVAL_QEXPR);
  397.   LASSERT_NOT_EMPTY("head", a, 0);
  399.   lval* v = lval_take(a, 0);  
  400.   while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  401.   return v;
  402. }
  404. lval* builtin_tail(lenv* e, lval* a) {
  405.   LASSERT_NUM("tail", a, 1);
  406.   LASSERT_TYPE("tail", a, 0, LVAL_QEXPR);
  407.   LASSERT_NOT_EMPTY("tail", a, 0);
  409.   lval* v = lval_take(a, 0);  
  410.   lval_del(lval_pop(v, 0));
  411.   return v;
  412. }
  414. lval* builtin_eval(lenv* e, lval* a) {
  415.   LASSERT_NUM("eval", a, 1);
  416.   LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);
  418.   lval* x = lval_take(a, 0);
  419.   x->type = LVAL_SEXPR;
  420.   return lval_eval(e, x);
  421. }
  423. lval* builtin_join(lenv* e, lval* a) {
  425.   for (int i = 0; i < a->count; i++) {
  426.     LASSERT_TYPE("join", a, i, LVAL_QEXPR);
  427.   }
  429.   lval* x = lval_pop(a, 0);
  431.   while (a->count) {
  432.     lval* y = lval_pop(a, 0);
  433.     x = lval_join(x, y);
  434.   }
  436.   lval_del(a);
  437.   return x;
  438. }
  440. lval* builtin_op(lenv* e, lval* a, char* op) {
  442.   for (int i = 0; i < a->count; i++) {
  443.     LASSERT_TYPE(op, a, i, LVAL_NUM);
  444.   }
  446.   lval* x = lval_pop(a, 0);
  448.   if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
  450.   while (a->count > 0) {  
  451.     lval* y = lval_pop(a, 0);
  453.     if (strcmp(op, "+") == 0) { x->num += y->num; }
  454.     if (strcmp(op, "-") == 0) { x->num -= y->num; }
  455.     if (strcmp(op, "*") == 0) { x->num *= y->num; }
  456.     if (strcmp(op, "/") == 0) {
  457.       if (y->num == 0) {
  458.         lval_del(x); lval_del(y);
  459.         x = lval_err("Division By Zero.");
  460.         break;
  461.       }
  462.       x->num /= y->num;
  463.     }
  465.     lval_del(y);
  466.   }
  468.   lval_del(a);
  469.   return x;
  470. }
  472. lval* builtin_add(lenv* e, lval* a) { return builtin_op(e, a, "+"); }
  473. lval* builtin_sub(lenv* e, lval* a) { return builtin_op(e, a, "-"); }
  474. lval* builtin_mul(lenv* e, lval* a) { return builtin_op(e, a, "*"); }
  475. lval* builtin_div(lenv* e, lval* a) { return builtin_op(e, a, "/"); }
  477. lval* builtin_var(lenv* e, lval* a, char* func) {
  478.   LASSERT_TYPE(func, a, 0, LVAL_QEXPR);
  480.   lval* syms = a->cell[0];
  481.   for (int i = 0; i < syms->count; i++) {
  482.     LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
  483.       "Function '%s' cannot define non-symbol. "
  484.       "Got %s, Expected %s.", func, 
  485.       ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
  486.   }
  488.   LASSERT(a, (syms->count == a->count-1),
  489.     "Function '%s' passed too many arguments for symbols. "
  490.     "Got %i, Expected %i.", func, syms->count, a->count-1);
  492.   for (int i = 0; i < syms->count; i++) {
  493.     /* If 'def' define in globally. If 'put' define in locally */
  494.     if (strcmp(func, "def") == 0) {
  495.       lenv_def(e, syms->cell[i], a->cell[i+1]);
  496.     }
  498.     if (strcmp(func, "=")   == 0) {
  499.       lenv_put(e, syms->cell[i], a->cell[i+1]);
  500.     } 
  501.   }
  503.   lval_del(a);
  504.   return lval_sexpr();
  505. }
  507. lval* builtin_def(lenv* e, lval* a) {
  508.   return builtin_var(e, a, "def");
  509. }
  511. lval* builtin_put(lenv* e, lval* a) {
  512.   return builtin_var(e, a, "=");
  513. }
  515. void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
  516.   lval* k = lval_sym(name);
  517.   lval* v = lval_builtin(func);
  518.   lenv_put(e, k, v);
  519.   lval_del(k); lval_del(v);
  520. }
  522. void lenv_add_builtins(lenv* e) {
  523.   /* Variable Functions */
  524.   lenv_add_builtin(e, "\\",  builtin_lambda); 
  525.   lenv_add_builtin(e, "def", builtin_def);
  526.   lenv_add_builtin(e, "=",   builtin_put);
  528.   /* List Functions */
  529.   lenv_add_builtin(e, "list", builtin_list);
  530.   lenv_add_builtin(e, "head", builtin_head);
  531.   lenv_add_builtin(e, "tail", builtin_tail);
  532.   lenv_add_builtin(e, "eval", builtin_eval);
  533.   lenv_add_builtin(e, "join", builtin_join);
  535.   /* Mathematical Functions */
  536.   lenv_add_builtin(e, "+", builtin_add);
  537.   lenv_add_builtin(e, "-", builtin_sub);
  538.   lenv_add_builtin(e, "*", builtin_mul);
  539.   lenv_add_builtin(e, "/", builtin_div);
  540. }
  542. /* Evaluation */
  544. lval* lval_call(lenv* e, lval* f, lval* a) {
  546.   /* If Builtin then simply apply that */
  547.   if (f->builtin) { return f->builtin(e, a); }
  549.   /* Record Argument Counts */
  550.   int given = a->count;
  551.   int total = f->formals->count;
  553.   /* While arguments still remain to be processed */
  554.   while (a->count) {
  556.     /* If we've ran out of formal arguments to bind */
  557.     if (f->formals->count == 0) {
  558.       lval_del(a);
  559.       return lval_err("Function passed too many arguments. "
  560.         "Got %i, Expected %i.", given, total); 
  561.     }
  563.     /* Pop the first symbol from the formals */
  564.     lval* sym = lval_pop(f->formals, 0);
  566.     /* Special Case to deal with '&' */
  567.     if (strcmp(sym->sym, "&") == 0) {
  569.       /* Ensure '&' is followed by another symbol */
  570.       if (f->formals->count != 1) {
  571.         lval_del(a);
  572.         return lval_err("Function format invalid. "
  573.           "Symbol '&' not followed by single symbol.");
  574.       }
  576.       /* Next formal should be bound to remaining arguments */
  577.       lval* nsym = lval_pop(f->formals, 0);
  578.       lenv_put(f->env, nsym, builtin_list(e, a));
  579.       lval_del(sym); lval_del(nsym);
  580.       break;
  581.     }
  583.     /* Pop the next argument from the list */
  584.     lval* val = lval_pop(a, 0);
  586.     /* Bind a copy into the function's environment */
  587.     lenv_put(f->env, sym, val);
  589.     /* Delete symbol and value */
  590.     lval_del(sym); lval_del(val);
  591.   }
  593.   /* Argument list is now bound so can be cleaned up */
  594.   lval_del(a);
  596.   /* If '&' remains in formal list bind to empty list */
  597.   if (f->formals->count > 0 &&
  598.     strcmp(f->formals->cell[0]->sym, "&") == 0) {
  600.     /* Check to ensure that & is not passed invalidly. */
  601.     if (f->formals->count != 2) {
  602.       return lval_err("Function format invalid. "
  603.         "Symbol '&' not followed by single symbol.");
  604.     }
  606.     /* Pop and delete '&' symbol */
  607.     lval_del(lval_pop(f->formals, 0));
  609.     /* Pop next symbol and create empty list */
  610.     lval* sym = lval_pop(f->formals, 0);
  611.     lval* val = lval_qexpr();
  613.     /* Bind to environment and delete */
  614.     lenv_put(f->env, sym, val);
  615.     lval_del(sym); lval_del(val);
  616.   }
  618.   /* If all formals have been bound evaluate */
  619.   if (f->formals->count == 0) {
  621.     /* Set environment parent to evaluation environment */
  622.     f->env->par = e;
  624.     /* Evaluate and return */
  625.     return builtin_eval(f->env, 
  626.       lval_add(lval_sexpr(), lval_copy(f->body)));
  627.   } else {
  628.     /* Otherwise return partially evaluated function */
  629.     return lval_copy(f);
  630.   }
  632. }
  634. lval* lval_eval_sexpr(lenv* e, lval* v) {
  636.   for (int i = 0; i < v->count; i++) {
  637.     v->cell[i] = lval_eval(e, v->cell[i]);
  638.   }
  640.   for (int i = 0; i < v->count; i++) {
  641.     if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
  642.   }
  644.   if (v->count == 0) { return v; }  
  645.   if (v->count == 1) { return lval_eval(e, lval_take(v, 0)); }
  647.   lval* f = lval_pop(v, 0);
  648.   if (f->type != LVAL_FUN) {
  649.     lval* err = lval_err(
  650.       "S-Expression starts with incorrect type. "
  651.       "Got %s, Expected %s.",
  652.       ltype_name(f->type), ltype_name(LVAL_FUN));
  653.     lval_del(f); lval_del(v);
  654.     return err;
  655.   }
  657.   lval* result = lval_call(e, f, v);
  658.   lval_del(f);
  659.   return result;
  660. }
  662. lval* lval_eval(lenv* e, lval* v) {
  663.   if (v->type == LVAL_SYM) {
  664.     lval* x = lenv_get(e, v);
  665.     lval_del(v);
  666.     return x;
  667.   }
  668.   if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(e, v); }
  669.   return v;
  670. }
  672. /* Reading */
  674. lval* lval_read_num(mpc_ast_t* t) {
  675.   errno = 0;
  676.   long x = strtol(t->contents, NULL, 10);
  677.   return errno != ERANGE ? lval_num(x) : lval_err("Invalid Number.");
  678. }
  680. lval* lval_read(mpc_ast_t* t) {
  682.   if (strstr(t->tag, "number")) { return lval_read_num(t); }
  683.   if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
  685.   lval* x = NULL;
  686.   if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } 
  687.   if (strstr(t->tag, "sexpr"))  { x = lval_sexpr(); }
  688.   if (strstr(t->tag, "qexpr"))  { x = lval_qexpr(); }
  690.   for (int i = 0; i < t->children_num; i++) {
  691.     if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
  692.     if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
  693.     if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
  694.     if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
  695.     if (strcmp(t->children[i]->tag,  "regex") == 0) { continue; }
  696.     x = lval_add(x, lval_read(t->children[i]));
  697.   }
  699.   return x;
  700. }
  702. /* Main */
  704. int main(int argc, char** argv) {
  706.   mpc_parser_t* Number = mpc_new("number");
  707.   mpc_parser_t* Symbol = mpc_new("symbol");
  708.   mpc_parser_t* Sexpr  = mpc_new("sexpr");
  709.   mpc_parser_t* Qexpr  = mpc_new("qexpr");
  710.   mpc_parser_t* Expr   = mpc_new("expr");
  711.   mpc_parser_t* Lispy  = mpc_new("lispy");
  713.   mpca_lang(MPCA_LANG_DEFAULT,
  714.     "                                                     \
  715.       number : /-?[0-9]+/ ;                               \
  716.       symbol  : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;        \
  717.       sexpr  : '(' <expr>* ')' ;                          \
  718.       qexpr  : '{' <expr>* '}' ;                          \
  719.       expr   : <number> | <symbol> | <sexpr> | <qexpr> ;  \
  720.       lispy  : /^/ <expr>* /$/ ;                          \
  721.     ",
  722.     Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  724.   puts("Lispy Version 0.0.0.0.8");
  725.   puts("Press Ctrl+c to Exit\n");
  727.   lenv* e = lenv_new();
  728.   lenv_add_builtins(e);
  730.   while (1) {
  732.     char* input = readline("lispy> ");
  733.     add_history(input);
  735.     mpc_result_t r;
  736.     if (mpc_parse("<stdin>", input, Lispy, &r)) {
  737.       lval* x = lval_eval(e, lval_read(r.output));
  738.       lval_println(x);
  739.       lval_del(x);
  740.       mpc_ast_delete(r.output);
  741.     } else {    
  742.       mpc_err_print(r.error);
  743.       mpc_err_delete(r.error);
  744.     }
  746.     free(input);
  748.   }
  750.   lenv_del(e);
  752.   mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  754.   return 0;
  755. }

{% endcollapse %}