Build your own LISP

lispy.c

#include "mpc.h"
#include <editline/readline.h>

#define LASSERT(args, cond, fmt, ...) \
  if (!(cond)) { \
    lval* err = lval_err(fmt, ##__VA_ARGS__); \
    lval_del(args); \
    return err; \
  }

#define LASSERT_TYPE(func, args, index, expect) \
  LASSERT( \
    args, \
    args->cell[index]->type == expect, \
    "Function '%s' passed incorrect type for argument %i. Got %s, expected %s.", \
    func, \
    index, \
    ltype_name(args->cell[index]->type), \
    ltype_name(expect) \
  );

#define LASSERT_NUM(func, args, num) \
  LASSERT( \
    args, \
    args->count == num, \
    "Function '%s' passed incorrect number of arguments. Got %i, expected %i.", \
    func, \
    args->count, \
    num \
  );

#define LASSERT_NOT_EMPTY(func, args, index) \
  LASSERT( \
    args, \
    args->cell[index]->count != 0, \
    "Function '%s' passed {} for argument %i.", \
    func, \
    index \
  );

/* Create enumeration of possible lval types. */
enum {
  LVAL_ERR,
  LVAL_NUM,
  LVAL_SYM,
  LVAL_FUN,
  LVAL_SEXPR,
  LVAL_QEXPR
};

struct lval;
struct lenv;
typedef struct lval lval;
typedef struct lenv lenv;

typedef lval*(*lbuiltin)(lenv*, lval*);

struct lval {
  int type;
  /* Basic fields. */
  long num;
  char* err;
  char* sym;
  /* Function-related fields. */
  lbuiltin builtin;
  lenv* env;
  lval* formals;
  lval* body;
  /* expression-related fields. */
  int count;
  lval** cell;
};

struct lenv {
  lenv* parent;
  int count;
  char** syms;
  lval** vals;
};

lenv* lenv_new(void);
lenv* lenv_copy(lenv* e);
void lenv_del(lenv* e);

/* Create a pointer to a new Number lval. */
lval* lval_num(long x) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_NUM;
  v->num = x;
  return v;
}

/* Create a pointer to a new Error lval. */
lval* lval_err(char* fmt, ...) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_ERR;

  /* Create a va list and initialize it. */
  va_list va;
  va_start(va, fmt);

  /* Allocate 512 bytes of space. */
  v->err = malloc(512);

  /* Printf the error string with a maximum of 511 characters. */
  vsnprintf(v->err, 511, fmt, va);

  /* Reallocate to number of bytes actually used. */
  v->err = realloc(v->err, strlen(v->err) + 1);

  /* Cleanup our va list. */
  va_end(va);

  return v;
}

/* Construct a pointer to a new Symbol lval. */
lval* lval_sym(char* sym) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_SYM;
  v->sym = malloc(strlen(sym) + 1);
  strcpy(v->sym, sym);
  return v;
}

/* Construct a pointer to a new Fun lval. */
lval* lval_fun(lbuiltin func) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_FUN;
  v->builtin = func;
  return v;
}

lval* lval_lambda(lval* formals, lval* body) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_FUN;
  v->builtin = NULL;
  v->env = lenv_new();
  v->formals = formals;
  v->body = body;
  return v;
}

/* Construct a pointer to a new empty Sexpr lval. */
lval* lval_sexpr(void) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_SEXPR;
  v->count = 0;
  v->cell = NULL;
  return v;
}

/* Construct a pointer to a new empty Qexpr lval. */
lval* lval_qexpr(void) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_QEXPR;
  v->count = 0;
  v->cell = NULL;
  return v;
}

lval* lval_copy(lval* v) {
  lval* x = malloc(sizeof(lval));
  x->type = v->type;
  switch (v->type) {
    /* Copy functions and numbers directly. */
    case LVAL_FUN:
      if (v->builtin) {
        x->builtin = v->builtin;
      } else {
        x->builtin = NULL;
        x->env = lenv_copy(v->env);
        x->formals = lval_copy(v->formals);
        x->body = lval_copy(v->body);
      }
      break;
    case LVAL_NUM:
      x->num = v->num;
      break;
    /* Copy strings using malloc and strcpy. */
    case LVAL_ERR:
      x->err = malloc(strlen(v->err) + 1);
      strcpy(x->err, v->err);
      break;
    case LVAL_SYM:
      x->sym = malloc(strlen(v->sym) + 1);
      strcpy(x->sym, v->sym);
      break;
    /* Copy lists by copying each sub-expression. */
    case LVAL_SEXPR:
    case LVAL_QEXPR:
      x->count = v->count;
      x->cell  = malloc(sizeof(lval*) * x->count);
      for (int i = 0; i < x->count; i++) {
        x->cell[i] = lval_copy(v->cell[i]);
      }
    break;
  }
  return x;
}

void lval_del(lval* v) {
  switch(v->type) {
    case LVAL_NUM:
      break;
    /* For Error or Symbol free the string data. */
    case LVAL_ERR:
      free(v->err);
      break;
    case LVAL_SYM:
      free(v->sym);
      break;
    case LVAL_FUN:
      if (!v->builtin) {
        lenv_del(v->env);
        lval_del(v->formals);
        lval_del(v->body);
      }
      break;
    /* If Qexpr or Sexpr, then delete all elements inside. */
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      for (int i = 0; i < v->count; i++) {
        lval_del(v->cell[i]);
      }
      /* Also free the memory allocated to contain the pointers. */
      free(v->cell);
      break;
  }
  /* Free the memory allocated for the "lval" struct itself. */
  free(v);
}

lval* lval_read_num(mpc_ast_t* t) {
  errno = 0;
  long x = strtol(t->contents, NULL, 10);
  return errno != ERANGE
    ? lval_num(x)
    : lval_err("Invalid number.");
}

lval* lval_add(lval* v, lval* x) {
  v->count++;
  v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  v->cell[v->count-1] = x;
  return v;
}

lval* lval_read(mpc_ast_t* t) {
  /* If symbol or number return conversion to that type. */
  if (strstr(t->tag, "number")) {
    return lval_read_num(t);
  }
  if (strstr(t->tag, "symbol")) {
    return lval_sym(t->contents);
  }

  /* If root (>) or sexpr then create an empty list. */
  lval* x = NULL;
  if (strcmp(t->tag, ">") == 0) {
    x = lval_sexpr();
  }
  if (strstr(t->tag, "sexpr")) {
    x = lval_sexpr();
  }
  if (strstr(t->tag, "qexpr")) {
    x = lval_qexpr();
  }

  /* Fill this list with any valid expression contained within. */
  for (int i = 0; i < t->children_num; i++) {
    if (strcmp(t->children[i]->contents, "(") == 0) {
      continue;
    }
    if (strcmp(t->children[i]->contents, ")") == 0) {
      continue;
    }
    if (strcmp(t->children[i]->contents, "{") == 0) {
      continue;
    }
    if (strcmp(t->children[i]->contents, "}") == 0) {
      continue;
    }
    if (strcmp(t->children[i]->tag, "regex") == 0) {
      continue;
    }
    x = lval_add(x, lval_read(t->children[i]));
  }

  return x;
}

void lval_print(lval* v);
lval* lval_eval(lenv* e, lval* v);

void lval_expr_print(lval* v, char open, char close) {
  putchar(open);
  for (int i = 0; i < v->count; i++) {
    /* Print value contained within. */
    lval_print(v->cell[i]);

    /* Don't print trailing space if last element. */
    if (i != (v->count-1)) {
      putchar(' ');
    }
  }
  putchar(close);
}

void lval_print(lval* v) {
  switch (v->type) {
    case LVAL_NUM:
      printf("%li", v->num);
      break;
    case LVAL_ERR:
      printf("Error: %s", v->err);
      break;
    case LVAL_SYM:
      printf("%s", v->sym);
      break;
    case LVAL_FUN:
      if (v->builtin) {
        printf("<function>");
      } else {
        printf("(fn ");
        lval_print(v->formals);
        putchar(' ');
        lval_print(v->body);
        putchar(')');
      }
      break;
    case LVAL_SEXPR:
      lval_expr_print(v, '(', ')');
      break;
    case LVAL_QEXPR:
      lval_expr_print(v, '{', '}');
      break;
  }
}

void lval_println(lval* v) {
   lval_print(v);
   putchar('\n');
}

char* ltype_name(int t) {
  switch(t) {
    case LVAL_FUN:   return "Function";
    case LVAL_NUM:   return "Number";
    case LVAL_ERR:   return "Error";
    case LVAL_SYM:   return "Symbol";
    case LVAL_SEXPR: return "S-Expression";
    case LVAL_QEXPR: return "Q-Expression";
    default:         return "Unknown";
  }
}

lval* lval_pop(lval* v, int i) {
  /* Find the item at "i". */
  lval* x = v->cell[i];
  /* Shift memory after the item at "i" over the top. */
  memmove(&v->cell[i], &v->cell[i+1], sizeof(lval*) * (v->count-i-1));
  v->count--;
  v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  return x;
}

lval* lval_take(lval* v, int i) {
  lval* x = lval_pop(v, i);
  lval_del(v);
  return x;
}

int lval_eq(lval* x, lval* y) {
  /* Different types are always unequal. */
  if (x->type != y->type) {
    return 0;
  }
  /* Compare based upon type. */
  switch (x->type) {
    case LVAL_NUM:
      return (x->num == y->num);

    case LVAL_ERR:
      return (strcmp(x->err, y->err) == 0);
    case LVAL_SYM:
      return (strcmp(x->sym, y->sym) == 0);

    case LVAL_FUN:
      if (x->builtin || y->builtin) {
        return x->builtin == y->builtin;
      } else {
        return lval_eq(x->body, y->body);
      }

    case LVAL_QEXPR:
    case LVAL_SEXPR:
      if (x->count != y->count) {
        return 0;
      }
      for (int i = 0; i < x->count; i++) {
        if (!lval_eq(x->cell[i], y->cell[i])) {
          return 0;
        }
      }
      return 1;
    break;
  }
  return 0;
}

lenv* lenv_new(void) {
  lenv* e = malloc(sizeof(lenv));
  e->parent = NULL;
  e->count = 0;
  e->syms = NULL;
  e->vals = NULL;
  return e;
}

void lenv_del(lenv* e) {
  for (int i = 0; i < e->count; i++) {
    free(e->syms[i]);
    lval_del(e->vals[i]);
  }
  free(e->syms);
  free(e->vals);
  free(e);
}

lval* lenv_get(lenv* e, lval* k) {
  for (int i = 0; i < e->count; i++) {
    if (strcmp(e->syms[i], k->sym) == 0) {
      return lval_copy(e->vals[i]);
    }
  }
  if (e->parent) {
    return lenv_get(e->parent, k);
  }
  return lval_err("Unbound symbol '%s'", k->sym);
}

void lenv_put(lenv* e, lval* k, lval* v) {
  for (int i = 0; i < e->count; i++) {
    if (strcmp(e->syms[i], k->sym) == 0) {
      lval_del(e->vals[i]);
      e->vals[i] = lval_copy(v);
      return;
    }
  }
  e->count++;
  e->vals = realloc(e->vals, sizeof(lval*) * e->count);
  e->syms = realloc(e->syms, sizeof(char*) * e->count);
  e->vals[e->count-1] = lval_copy(v);
  e->syms[e->count-1] = malloc(strlen(k->sym)+1);
  strcpy(e->syms[e->count-1], k->sym);
}

void lenv_def(lenv* e, lval* k, lval* v) {
  /* Iterate till e has no parent. */
  while (e->parent) {
    e = e->parent;
  }
  lenv_put(e, k, v);
}

lenv* lenv_copy(lenv* e) {
  lenv* ne   = malloc(sizeof(lenv));
  ne->parent = e->parent;
  ne->count  = e->count;
  ne->syms   = malloc(sizeof(char*) * e->count);
  ne->vals   = malloc(sizeof(lval*) * e->count);
  for (int i = 0; i < e->count; i++) {
    ne->syms[i] = malloc(strlen(e->syms[i]) + 1);
    strcpy(ne->syms[i], e->syms[i]);
    ne->vals[i] = lval_copy(e->vals[i]);
  }
  return ne;
}

lval* builtin_head(lenv* e, lval* args) {
  LASSERT_NUM("head", args, 1);
  LASSERT_TYPE("head", args, 0, LVAL_QEXPR);
  LASSERT_NOT_EMPTY("head", args, 0);

  lval* v = lval_take(args, 0);

  while (v->count > 1) {
    lval_del(lval_pop(v, 1));
  }
  return v;
}

lval* builtin_tail(lenv* e, lval* args) {
  LASSERT_NUM("tail", args, 1);
  LASSERT_TYPE("tail", args, 0, LVAL_QEXPR);
  LASSERT_NOT_EMPTY("tail", args, 0);

  /* Take first argument. */
  lval* v = lval_take(args, 0);

  /* Delete first element and return. */
  lval_del(lval_pop(v, 0));
  return v;
}

lval* builtin_list(lenv* e, lval* args) {
  args->type = LVAL_QEXPR;
  return args;
}

lval* builtin_eval(lenv* e, lval* args) {
  LASSERT_NUM("eval", args, 1);
  LASSERT_TYPE("eval", args, 0, LVAL_QEXPR);

  lval* x = lval_take(args, 0);
  x->type = LVAL_SEXPR;
  return lval_eval(e, x);
}

lval* lval_join(lval* x, lval* y) {
  while (y->count) {
    x = lval_add(x, lval_pop(y, 0));
  }
  lval_del(y);
  return x;
}

lval* builtin_join(lenv* e, lval* args) {
  for (int i = 0; i < args->count; i++) {
    LASSERT_TYPE("join", args, i, LVAL_QEXPR);
  }

  lval* x = lval_pop(args, 0);

  while (args->count) {
    x = lval_join(x, lval_pop(args, 0));
  }

  lval_del(args);
  return x;
}

lval* builtin_lambda(lenv* e, lval* args) {
  LASSERT_NUM("fn", args, 2);
  LASSERT_TYPE("fn", args, 0, LVAL_QEXPR);
  LASSERT_TYPE("fn", args, 1, LVAL_QEXPR);

  for (int i = 0; i < args->cell[0]->count; i++) {
    LASSERT(
      args,
      (args->cell[0]->cell[i]->type == LVAL_SYM),
      "Cannot define non-symbol. Got %s, expected %s.",
      ltype_name(args->cell[0]->cell[i]->type),
      ltype_name(LVAL_SYM)
    );
  }

  lval* formals = lval_pop(args, 0);
  lval* body = lval_pop(args, 0);
  lval_del(args);

  return lval_lambda(formals, body);
}

lval* builtin_op(lenv* e, char* op, lval* args) {
  /* Ensure all arguments are numbers. */
  for (int i = 0; i < args->count; i++) {
    if (args->cell[i]->type != LVAL_NUM) {
      LASSERT_TYPE(op, args, i, LVAL_NUM);
    }
  }

  /* Pop the first argument. */
  lval* x = lval_pop(args, 0);

  /* If sub and no more arguments, then perform unary negation. */
  if ((strcmp(op, "-") == 0) && args->count == 0) {
    x->num = -x->num;
  }

  /* While there are still elements remaining. */
  while (args->count > 0) {
    lval* y = lval_pop(args, 0);

    if (strcmp(op, "+") == 0) {
      x->num += y->num;
    }
    if (strcmp(op, "-") == 0) {
      x->num -= y->num;
    }
    if (strcmp(op, "*") == 0) {
      x->num *= y->num;
    }
    if (strcmp(op, "/") == 0) {
      if (y->num == 0) {
        lval_del(x);
        lval_del(y);
        x = lval_err("Division by zero!");
        break;
      }
      x->num /= y->num;
    }

    lval_del(y);
  }

  lval_del(args);
  return x;
}

lval* builtin_add(lenv* e, lval* args) {
  return builtin_op(e, "+", args);
}

lval* builtin_sub(lenv* e, lval* args) {
  return builtin_op(e, "-", args);
}

lval* builtin_mul(lenv* e, lval* args) {
  return builtin_op(e, "*", args);
}

lval* builtin_div(lenv* e, lval* args) {
  return builtin_op(e, "/", args);
}

lval* builtin_ord(lenv* e, lval* args, char* op) {
  LASSERT_NUM(op, args, 2);
  LASSERT_TYPE(op, args, 0, LVAL_NUM);
  LASSERT_TYPE(op, args, 2, LVAL_NUM);

  int r;
  if (strcmp(op, ">") == 0) {
    r = (args->cell[0]->num > args->cell[1]->num);
  }
  if (strcmp(op, "<") == 0) {
    r = (args->cell[0]->num < args->cell[1]->num);
  }
  if (strcmp(op, ">=") == 0) {
    r = (args->cell[0]->num >= args->cell[1]->num);
  }
  if (strcmp(op, "<=") == 0) {
    r = (args->cell[0]->num <= args->cell[1]->num);
  }
  lval_del(args);
  return lval_num(r);
}

lval* builtin_gt(lenv* e, lval* args) {
  return builtin_ord(e, args, ">");
}

lval* builtin_lt(lenv* e, lval* args) {
  return builtin_ord(e, args, "<");
}

lval* builtin_ge(lenv* e, lval* args) {
  return builtin_ord(e, args, ">=");
}

lval* builtin_le(lenv* e, lval* args) {
  return builtin_ord(e, args, "<=");
}

lval* builtin_cmp(lenv* e, lval* args, char* op) {
  LASSERT_NUM(op, args, 2);
  int r;
  if (strcmp(op, "==") == 0) {
    r = lval_eq(args->cell[0], args->cell[1]);
  }
  if (strcmp(op, "!=") == 0) {
    r = !lval_eq(args->cell[0], args->cell[1]);
  }
  lval_del(args);
  return lval_num(r);
}

lval* builtin_eq(lenv* e, lval* args) {
  return builtin_cmp(e, args, "==");
}

lval* builtin_ne(lenv* e, lval* args) {
  return builtin_cmp(e, args, "!=");
}

lval* builtin_if(lenv* e, lval* args) {
  LASSERT_NUM("if", args, 3);
  LASSERT_TYPE("if", args, 0, LVAL_NUM);
  LASSERT_TYPE("if", args, 1, LVAL_QEXPR);
  LASSERT_TYPE("if", args, 2, LVAL_QEXPR);

  lval* x;
  args->cell[1]->type = LVAL_SEXPR;
  args->cell[2]->type = LVAL_SEXPR;

  /* Like in C: 0 is False, a 1 and other numbers are True. */
  if (args->cell[0]->num) {
    x = lval_eval(e, lval_pop(args, 1));
  } else {
    x = lval_eval(e, lval_pop(args, 2));
  }

  lval_del(args);
  return x;
}

lval* builtin_var(lenv* e, lval* args, char* func) {
  LASSERT_TYPE(func, args, 0, LVAL_QEXPR);
  /* First argument is symbol list. */
  lval* syms = args->cell[0];
  /* Ensure all elements of first list are symbols. */
  for (int i = 0; i < syms->count; i++) {
    LASSERT(
      args,
      (syms->cell[i]->type == LVAL_SYM),
      "Function 'def' cannot define non-symbol. Got %s, expected %s.",
      ltype_name(syms->cell[i]->type),
      ltype_name(LVAL_SYM)
    );
  }
  /* Check correct number of symbols and values. */
  LASSERT(
    args,
    (syms->count == args->count - 1),
    "Function '%s' passed too many arguments for symbols. Got %i, expected %i.",
    func,
    syms->count,
    args->count - 1
  );
  /* Assign copies of values to symbols. */
  for (int i = 0; i < syms->count; i++) {
    if (strcmp(func, "def") == 0) {
      lenv_def(e, syms->cell[i], args->cell[i+1]);
    }
    if (strcmp(func, "=") == 0) {
      lenv_put(e, syms->cell[i], args->cell[i+1]);
    }
  }
  lval_del(args);
  return lval_sexpr();
}

lval* builtin_def(lenv* e, lval* args) {
  return builtin_var(e, args, "def");
}

lval* builtin_let(lenv* e, lval* args) {
  return builtin_var(e, args, "=");
}

void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
  lval* k = lval_sym(name);
  lval* v = lval_fun(func);
  lenv_put(e, k, v);
  lval_del(k);
  lval_del(v);
}

void lenv_add_builtins(lenv* e) {
  /* Variable functions. */
  lenv_add_builtin(e, "def", builtin_def);
  lenv_add_builtin(e, "=",   builtin_let);
  /* Lambda functions. */
  lenv_add_builtin(e, "fn", builtin_lambda);
  /* List functions. */
  lenv_add_builtin(e, "list", builtin_list);
  lenv_add_builtin(e, "head", builtin_head);
  lenv_add_builtin(e, "tail", builtin_tail);
  lenv_add_builtin(e, "eval", builtin_eval);
  lenv_add_builtin(e, "join", builtin_join);
  /* Mathematical functions. */
  lenv_add_builtin(e, "+", builtin_add);
  lenv_add_builtin(e, "-", builtin_sub);
  lenv_add_builtin(e, "*", builtin_mul);
  lenv_add_builtin(e, "/", builtin_div);
  /* Comparison Functions. */
  lenv_add_builtin(e, "if", builtin_if);
  lenv_add_builtin(e, "==", builtin_eq);
  lenv_add_builtin(e, "!=", builtin_ne);
  lenv_add_builtin(e, ">",  builtin_gt);
  lenv_add_builtin(e, "<",  builtin_lt);
  lenv_add_builtin(e, ">=", builtin_ge);
  lenv_add_builtin(e, "<=", builtin_le);
}

lval* lval_call(lenv* e, lval* f, lval* args) {
  /* If builtin then simply call that. */
  if (f->builtin) {
    return f->builtin(e, args);
  }

  /* Record argument counts. */
  int given = args->count;
  int total = f->formals->count;

  /* While arguments still remain to be processed. */
  while (args->count) {
    /* If we've ran out of formal arguments to bind. */
    if (f->formals->count == 0) {
      lval_del(args);
      return lval_err(
        "Function passed too many arguments. Got %i, excpected %i.",
        given,
        total
      );
    }
    /* Pop the first symbol from the formals. */
    lval* sym = lval_pop(f->formals, 0);

    /* Special case to deal with '&'. */
    if (strcmp(sym->sym, "&") == 0) {
      /* Ensure '&' is followed by another symbol. */
      if (f->formals->count != 1) {
        lval_del(args);
        return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
      }
      /* Next formal should be bound to remaining arguments. */
      lval* nsym = lval_pop(f->formals, 0);
      lenv_put(f->env, nsym, builtin_list(e, args));
      lval_del(sym);
      lval_del(nsym);
      break;
    }

    /* Pop the next argument from the list. */
    lval* val = lval_pop(args, 0);

    /* Bind a copy into the function's environment. */
    lenv_put(f->env, sym, val);

    /* Delete origin symbol and value */
    lval_del(sym);
    lval_del(val);
  }

  /* Argument list is now bound so can be cleaned up. */
  lval_del(args);

  /* If '&' remains in formal list bind to empty list. */
  if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0) {
    /* Check to ensure that & is not passed invalidly. */
    if (f->formals->count != 2) {
      return lval_err("Function format invalid. Symbold '&' not followed by single symbol.");
    }
    /* Pop and delete '&' symbol. */
    lval_del(lval_pop(f->formals, 0));
    /* Pop nex symbol and create empty list. */
    lval* sym = lval_pop(f->formals, 0);
    lval* val = lval_qexpr();
    /* Bind to environment and delete. */
    lenv_put(f->env, sym, val);
    lval_del(sym);
    lval_del(val);
  }

  /* If all formals have been bound evaluate. */
  if (f->formals->count == 0) {
      /* Set the parent environment. */
      f->env->parent = e;
      /* Evaluate the body. */
      return builtin_eval(
        f->env,
        lval_add(lval_sexpr(), lval_copy(f->body))
      );
  } else {
    /* Otherwise return partially evaluated function. */
    return lval_copy(f);
  }
}

lval* lval_eval_sexpr(lenv* e, lval* v) {
  /* Evaluate children. */
  for (int i = 0; i < v->count; i++) {
    v->cell[i] = lval_eval(e, v->cell[i]);
  }

  /* Error checking. */
  for (int i = 0; i < v->count; i++) {
    if (v->cell[i]->type == LVAL_ERR) {
      return lval_take(v, i);
    }
  }

  /* Empty expression. */
  if (v->count == 0) {
    return v;
  }

  /* Single expression. */
  if (v->count == 1) {
    return lval_take(v, 0);
  }

  /* Ensure first element is a function after evaluation. */
  lval* f = lval_pop(v, 0);
  if (f->type != LVAL_FUN) {
    lval* err = lval_err(
      "S-Expression starts with incorrect type. Got %s, expected %s.",
      ltype_name(f->type),
      ltype_name(LVAL_FUN)
    );
    lval_del(f);
    lval_del(v);
    return err;
  }

  /* If so call function to get result. */
  lval* result = lval_call(e, f, v);
  lval_del(f);
  return result;
}

lval* lval_eval(lenv* e, lval* v) {
  if (v->type == LVAL_SYM) {
    lval* x = lenv_get(e, v);
    lval_del(v);
    return x;
  }
  if (v->type == LVAL_SEXPR) {
    return lval_eval_sexpr(e, v);
  }
  return v;
}

int main(int argc, char** argv) {

  /* Create some parsers */
  mpc_parser_t* Number = mpc_new("number");
  mpc_parser_t* Symbol = mpc_new("symbol");
  mpc_parser_t* Sexpr  = mpc_new("sexpr");
  mpc_parser_t* Qexpr  = mpc_new("qexpr");
  mpc_parser_t* Expr   = mpc_new("expr");
  mpc_parser_t* Lispy  = mpc_new("lispy");

  /* Define them with the following language */
  mpca_lang(
    MPCA_LANG_DEFAULT,
    "                                                         \
      number  : /-?[0-9]+/ ;                                  \
      symbol  : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&]+/ ;            \
      sexpr   : '(' <expr>* ')' ;                             \
      qexpr   : '{' <expr>* '}' ;                             \
      expr    : <number> | <symbol> | <sexpr> | <qexpr>;      \
      lispy   : /^/ <expr>* /$/ ;                             \
    ",
    Number,
    Symbol,
    Sexpr,
    Qexpr,
    Expr,
    Lispy
  );

  /* Print Version and Exit Information */
  puts("Lispy Version 0.0.9");
  puts("Press Ctrl+C to exit\n");

  lenv* e = lenv_new();
  lenv_add_builtins(e);

  /* In a never ending loop */
  while (1) {

    /* Output our prompt and get input */
    char* input = readline("lispy> ");

    /* Add input to history */
    add_history(input);

    /* Attempt to parse the user input */
    mpc_result_t r;
    if (mpc_parse("<stdin>", input, Lispy, &r)) {
      lval* x = lval_eval(e, lval_read(r.output));
      lval_println(x);
      lval_del(x);
      mpc_ast_delete(r.output);
    } else {
      /* Otherwise print the error */
      mpc_err_print(r.error);
      mpc_err_delete(r.error);
    }

    /* Free retrived input */
    free(input);
  }

  lenv_del(e);

  /* Undefine and delete our parsers */
  mpc_cleanup(4, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);

  return 0;
}

prompt.c

#include <stdio.h>
#include <stdlib.h>

#include <editline/readline.h>

int main(int argc, char** argv) {

  /* Print Version and Exit Information */
  puts("Lispy Version 0.0.1");
  puts("Press Ctrl+C to exit\n");

  /* In a never ending loop */
  while (1) {

    /* Output our prompt and get input */
    char* input = readline("lispy> ");

    /* Add input to history */
    add_history(input);

    /* Echo input back to user */
    printf("No you're a %s\n", input);

    /* Free retrived input */
    free(input);
  }

  return 0;
}