chapter13_conditionals.html

<h1>Conditionals <small>&bull; Chapter 13</small></h1>

<h2>Doing it yourself</h2> <hr/>

<p>We've come quite far now. Your knowledge of C should be good enough for you to stand on your own feet a little more. If you're feeling confident, this chapter is a perfect opportunity to stretch your wings out, and attempt something on your own. It is a fairly short chapter and essentially consists of adding a couple of new builtin functions to deal with comparison and ordering.</p>

<div class='pull-right alert alert-warning' style="margin: 15px; text-align: center;">
  <img src="/static/img/pug.png" alt="pug" class="img-responsive" width="219px" height="329px"/>
  <p><small>Pug &bull; <strong>if</strong> pug is asleep <strong>then</strong> pug is cute.</small></p>
</div>

<p>If you're feeling positive, go ahead and try to implement comparison and ordering into your language now. Define some new builtin functions for <em>greater than</em>, <em>less than</em>, <em>equal to</em>, and all the other comparison operators we use in C. Try to define an <code>if</code> function that tests for some condition and then either evaluate some code, or some other code, depending on the result. Once you've finished come back and compare your work to mine. Observe the differences and decide which parts you prefer.</p>

<p>If you still feel uncertain don't worry. Follow along and I'll explain my approach.</p>


<h2>Ordering</h2> <hr/>

<p>For simplicity's sake I'm going to re-use our number data type to represent the result of comparisons. I'll make a rule similar to C, to say that any number that isn't <code>0</code> evaluates to true in an <code>if</code> statement, while <code>0</code> always evaluates to false.</p>

<p>Therefore our ordering functions are a little like a simplified version of our arithmetic functions. They'll only work on numbers, and we only want them to work on two arguments.</p>

<p>If these error conditions are met the maths is simple, we want to return a number <code>lval</code> either <code>0</code> or <code>1</code> depending on the equality comparison between the two input <code>lval</code>. We can use C's comparison operators to do this. Like our arithmetic functions we'll make use of a single function to do all of the comparisons.</p>

<p>First we check the error conditions, then we compare the numbers in each of the arguments to get some result. Finally we return this result as a number value.</p>

<pre><code data-language='c'>lval* builtin_ord(lenv* e, lval* a, char* op) {
  LASSERT_NUM(op, a, 2);
  LASSERT_TYPE(op, a, 0, LVAL_NUM);
  LASSERT_TYPE(op, a, 1, LVAL_NUM);
  
  int r;
  if (strcmp(op, "&gt;")  == 0) { r = (a-&gt;cell[0]-&gt;num &gt;  a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&lt;")  == 0) { r = (a-&gt;cell[0]-&gt;num &lt;  a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&gt;=") == 0) { r = (a-&gt;cell[0]-&gt;num &gt;= a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&lt;=") == 0) { r = (a-&gt;cell[0]-&gt;num &lt;= a-&gt;cell[1]-&gt;num); }
  lval_del(a);
  return lval_num(r);
}

lval* builtin_gt(lenv* e, lval* a) { return builtin_ord(e, a, "&gt;");  }
lval* builtin_lt(lenv* e, lval* a) { return builtin_ord(e, a, "&lt;");  }
lval* builtin_ge(lenv* e, lval* a) { return builtin_ord(e, a, "&gt;="); }
lval* builtin_le(lenv* e, lval* a) { return builtin_ord(e, a, "&lt;="); }
</code></pre>


<h2>Equality</h2> <hr/>

<p>Equality is going to be different to ordering because we want it to work on more than number types. It will be useful to see if an input is equal to an empty list, or to see if two functions passed in are the same. Therefore we need to define a function which can test for equality between two different types of <code>lval</code>.</p>

<p>This function essentially checks that all the fields which make up the data for a particular <code>lval</code> type are equal. If all the fields are equal, the whole thing is considered equal. Otherwise if there are any differences the whole thing is considered unequal.</p>

<pre><code data-language='c'>int lval_eq(lval* x, lval* y) {

  /* Different Types are always unequal */
  if (x-&gt;type != y-&gt;type) { return 0; }

  /* Compare Based upon type */
  switch (x-&gt;type) {
    /* Compare Number Value */
    case LVAL_NUM: return (x-&gt;num == y-&gt;num);

    /* Compare String Values */
    case LVAL_ERR: return (strcmp(x-&gt;err, y-&gt;err) == 0);
    case LVAL_SYM: return (strcmp(x-&gt;sym, y-&gt;sym) == 0);

    /* If Builtin compare functions, otherwise compare formals and body */
    case LVAL_FUN:
      if (x-&gt;builtin || y-&gt;builtin) {
        return x-&gt;builtin == y-&gt;builtin;
      } else {
        return lval_eq(x-&gt;formals, y-&gt;formals) &amp;&amp; lval_eq(x-&gt;body, y-&gt;body);
      }

    /* If list compare every individual element */
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      if (x-&gt;count != y-&gt;count) { return 0; }
      for (int i = 0; i &lt; x-&gt;count; i++) {
        /* If any element not equal then whole list not equal */
        if (!lval_eq(x-&gt;cell[i], y-&gt;cell[i])) { return 0; }
      }
      /* Otherwise lists must be equal */
      return 1;
    break;
  }
  return 0;
}</code></pre>

<p>Using this function the new builtin function for equality comparison is very simple to add. We simply ensure two arguments are input, and that they are equal. We store the result of the comparison into a new <code>lval</code> and return it.</p>

<pre><code data-language='c'>lval* builtin_cmp(lenv* e, lval* a, char* op) {
  LASSERT_NUM(op, a, 2);
  int r;
  if (strcmp(op, "==") == 0) { r =  lval_eq(a-&gt;cell[0], a-&gt;cell[1]); }
  if (strcmp(op, "!=") == 0) { r = !lval_eq(a-&gt;cell[0], a-&gt;cell[1]); }
  lval_del(a);
  return lval_num(r);
}

lval* builtin_eq(lenv* e, lval* a) { return builtin_cmp(e, a, "=="); }
lval* builtin_ne(lenv* e, lval* a) { return builtin_cmp(e, a, "!="); }</code></pre>


<h2>If Function</h2> <hr/>

<p>To make our comparison operators useful well need an <code>if</code> function. This function is a little like the ternary operation in C. Upon some condition being true it evaluates to one thing, otherwise it evaluates to another.</p>

<p>We can again make use of Q-Expressions to encode a computation. First we get the user to pass in the result of a comparison, then we get the user to pass in two Q-Expressions representing the code to be evaluated upon a condition being either true or false.</p>

<pre><code data-language='c'>lval* builtin_if(lenv* e, lval* a) {
  LASSERT_NUM("if", a, 3);
  LASSERT_TYPE("if", a, 0, LVAL_NUM);
  LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
  LASSERT_TYPE("if", a, 2, LVAL_QEXPR);
  
  /* Mark Both Expressions as evaluable */
  lval* x;
  a-&gt;cell[1]-&gt;type = LVAL_SEXPR;
  a-&gt;cell[2]-&gt;type = LVAL_SEXPR;
  
  if (a-&gt;cell[0]-&gt;num) {
    /* If condition is true evaluate first expression */
    x = lval_eval(e, lval_pop(a, 1));
  } else {
    /* Otherwise evaluate second expression */
    x = lval_eval(e, lval_pop(a, 2));
  }
  
  /* Delete argument list and return */
  lval_del(a);
  return x;
}</code></pre>

<p>All that remains is for us to register all of these new builtins and we are again ready to go!</p>

<pre><code data-language='c'>/* 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, "&gt;",    builtin_gt); lenv_add_builtin(e, "&lt;",    builtin_lt);
lenv_add_builtin(e, "&gt;=",   builtin_ge); lenv_add_builtin(e, "&lt;=",   builtin_le);
</code></pre>

<p>Have a quick mess around to check that everything is working correctly.</p>

<pre><code data-language='lispy'>lispy&gt; &gt; 10 5
1
lispy&gt; &lt;= 88 5
0
lispy&gt; == 5 6
0
lispy&gt; == 5 {}
0
lispy&gt; == 1 1
1
lispy&gt; != {} 56
1
lispy&gt; == {1 2 3 {5 6}} {1   2  3   {5 6}}
1
lispy&gt; def {x y} 100 200
()
lispy&gt; if (== x y) {+ x y} {- x y}
-100
</code></pre>


<h2>Recursive Functions</h2> <hr/>

<p>By Introducing conditionals we've actually made our language a lot more powerful. This is because they effectively let us implement recursive functions.</p>

<p>Recursive functions are those which call themselves. We've used these already in C to perform reading in and evaluation of expressions. The reason we require conditionals for these is because they let us test for the situation where we wish to terminate the recursion.</p>

<p>For example we can use conditionals to implement a function <code>len</code> which tells us the number of items in a list. If we encounter the empty list we just return <code>0</code>. Otherwise we return the length of the <code>tail</code> of the input list, plus <code>1</code>. Think about why this works. It repeatedly uses the <code>len</code> function until it reaches the empty list. At this point it returns <code>0</code> and adds all the other partial results together.</p>

<pre><code data-language='lispy'>(fun {len l} {
  if (== l {})
    {0}
    {+ 1 (len (tail l))}
})</code></pre>

<p>Just as in C, there is a pleasant symmetry to this sort of recursive function. First we do something for the empty list (<em>the base case</em>). Then if we get something bigger, we take off a chunk such as the head of the list, and do something to it, before combining it with the rest of the thing to which the function has been already applied.</p>

<p>Here is another function for reversing a list. Like before it checks for the empty list, but this time it returns the empty list back. This makes sense. The reverse of the empty list is just the empty list. But if it gets something bigger than the empty list, it reverses the tail, and stick this in front of the head.</p>

<pre><code data-language='lispy'>(fun {reverse l} {
  if (== l {})
    {{}}
    {join (reverse (tail l)) (head l)}
})</code></pre>

<p>We're going to use this technique to build lots functions like this, this is because it is going to be the primary way to achieve looping in our language.</p>


<h2>Reference</h2> <hr/>

<div class="panel-group alert alert-warning" id="accordion">
  <div class="panel panel-default">
    <div class="panel-heading">
      <h4 class="panel-title">
        <a data-toggle="collapse" data-parent="#accordion" href="#collapseOne">
          conditionals.c
        </a>
      </h4>
    </div>
    <div id="collapseOne" class="panel-collapse collapse">
      <div class="panel-body">
<pre><code data-language='c'>#include "mpc.h"

#ifdef _WIN32

static char buffer[2048];

char* readline(char* prompt) {
  fputs(prompt, stdout);
  fgets(buffer, 2048, stdin); 
  char* cpy = malloc(strlen(buffer)+1);
  strcpy(cpy, buffer);
  cpy[strlen(cpy)-1] = '\0';
  return cpy;
}

void add_history(char* unused) {}

#else

#include &lt;editline/readline.h&gt;
#include &lt;editline/history.h&gt;

#endif

/* Forward Declarations */

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

/* Lisp Value */

enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_FUN, LVAL_SEXPR, LVAL_QEXPR };

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

struct lval {
  int type;

  /* Basic */
  long num;
  char* err;
  char* sym;
  
  /* Function */
  lbuiltin builtin;
  lenv* env;
  lval* formals;
  lval* body;
  
  /* Expression */
  int count;
  lval** cell;
};

lval* lval_num(long x) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_NUM;
  v-&gt;num = x;
  return v;
}

lval* lval_err(char* fmt, ...) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_ERR;  
  va_list va;
  va_start(va, fmt);  
  v-&gt;err = malloc(512);  
  vsnprintf(v-&gt;err, 511, fmt, va);  
  v-&gt;err = realloc(v-&gt;err, strlen(v-&gt;err)+1);
  va_end(va);  
  return v;
}

lval* lval_sym(char* s) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_SYM;
  v-&gt;sym = malloc(strlen(s) + 1);
  strcpy(v-&gt;sym, s);
  return v;
}

lval* lval_builtin(lbuiltin func) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_FUN;
  v-&gt;builtin = func;
  return v;
}

lenv* lenv_new(void);

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

lval* lval_sexpr(void) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_SEXPR;
  v-&gt;count = 0;
  v-&gt;cell = NULL;
  return v;
}

lval* lval_qexpr(void) {
  lval* v = malloc(sizeof(lval));
  v-&gt;type = LVAL_QEXPR;
  v-&gt;count = 0;
  v-&gt;cell = NULL;
  return v;
}

void lenv_del(lenv* e);

void lval_del(lval* v) {

  switch (v-&gt;type) {
    case LVAL_NUM: break;
    case LVAL_FUN: 
      if (!v-&gt;builtin) {
        lenv_del(v-&gt;env);
        lval_del(v-&gt;formals);
        lval_del(v-&gt;body);
      }
    break;
    case LVAL_ERR: free(v-&gt;err); break;
    case LVAL_SYM: free(v-&gt;sym); break;
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      for (int i = 0; i &lt; v-&gt;count; i++) {
        lval_del(v-&gt;cell[i]);
      }
      free(v-&gt;cell);
    break;
  }
  
  free(v);
}

lenv* lenv_copy(lenv* e);

lval* lval_copy(lval* v) {
  lval* x = malloc(sizeof(lval));
  x-&gt;type = v-&gt;type;
  switch (v-&gt;type) {
    case LVAL_FUN:
      if (v-&gt;builtin) {
        x-&gt;builtin = v-&gt;builtin;
      } else {
        x-&gt;builtin = NULL;
        x-&gt;env = lenv_copy(v-&gt;env);
        x-&gt;formals = lval_copy(v-&gt;formals);
        x-&gt;body = lval_copy(v-&gt;body);
      }
    break;
    case LVAL_NUM: x-&gt;num = v-&gt;num; break;
    case LVAL_ERR: x-&gt;err = malloc(strlen(v-&gt;err) + 1); strcpy(x-&gt;err, v-&gt;err); break;
    case LVAL_SYM: x-&gt;sym = malloc(strlen(v-&gt;sym) + 1); strcpy(x-&gt;sym, v-&gt;sym); break;
    case LVAL_SEXPR:
    case LVAL_QEXPR:
      x-&gt;count = v-&gt;count;
      x-&gt;cell = malloc(sizeof(lval*) * x-&gt;count);
      for (int i = 0; i &lt; x-&gt;count; i++) {
        x-&gt;cell[i] = lval_copy(v-&gt;cell[i]);
      }
    break;
  }
  return x;
}

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

lval* lval_join(lval* x, lval* y) {  
  for (int i = 0; i &lt; y-&gt;count; i++) {
    x = lval_add(x, y-&gt;cell[i]);
  }
  free(y-&gt;cell);
  free(y);  
  return x;
}

lval* lval_pop(lval* v, int i) {
  lval* x = v-&gt;cell[i];  
  memmove(&v-&gt;cell[i], &v-&gt;cell[i+1], sizeof(lval*) * (v-&gt;count-i-1));  
  v-&gt;count--;  
  v-&gt;cell = realloc(v-&gt;cell, sizeof(lval*) * v-&gt;count);
  return x;
}

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

void lval_print(lval* v);

void lval_print_expr(lval* v, char open, char close) {
  putchar(open);
  for (int i = 0; i &lt; v-&gt;count; i++) {
    lval_print(v-&gt;cell[i]);    
    if (i != (v-&gt;count-1)) {
      putchar(' ');
    }
  }
  putchar(close);
}

void lval_print(lval* v) {
  switch (v-&gt;type) {
    case LVAL_FUN:
      if (v-&gt;builtin) {
        printf("&lt;builtin&gt;");
      } else {
        printf("(\\ "); lval_print(v-&gt;formals); putchar(' '); lval_print(v-&gt;body); putchar(')');
      }
    break;
    case LVAL_NUM:   printf("%li", v-&gt;num); break;
    case LVAL_ERR:   printf("Error: %s", v-&gt;err); break;
    case LVAL_SYM:   printf("%s", v-&gt;sym); break;
    case LVAL_SEXPR: lval_print_expr(v, '(', ')'); break;
    case LVAL_QEXPR: lval_print_expr(v, '{', '}'); break;
  }
}

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

int lval_eq(lval* x, lval* y) {
  
  /* Different Types are always unequal */
  if (x-&gt;type != y-&gt;type) { return 0; }
  
  /* Compare Based upon type */
  switch (x-&gt;type) {
    /* Compare Number Value */
    case LVAL_NUM: return (x-&gt;num == y-&gt;num);
    
    /* Compare String Values */
    case LVAL_ERR: return (strcmp(x-&gt;err, y-&gt;err) == 0);
    case LVAL_SYM: return (strcmp(x-&gt;sym, y-&gt;sym) == 0);
    
    /* If Builtin compare functions, otherwise compare formals and body */
    case LVAL_FUN:
      if (x-&gt;builtin || y-&gt;builtin) {
        return x-&gt;builtin == y-&gt;builtin;
      } else {
        return lval_eq(x-&gt;formals, y-&gt;formals) && lval_eq(x-&gt;body, y-&gt;body);
      }
    
    /* If list compare every individual element */
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      if (x-&gt;count != y-&gt;count) { return 0; }
      for (int i = 0; i &lt; x-&gt;count; i++) {
        /* If any element not equal then whole list not equal */
        if (!lval_eq(x-&gt;cell[i], y-&gt;cell[i])) { return 0; }
      }
      /* Otherwise lists must be equal */
      return 1;
    break;
  }
  return 0;
}

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";
  }
}

/* Lisp Environment */

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

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

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

lenv* lenv_copy(lenv* e) {
  lenv* n = malloc(sizeof(lenv));
  n-&gt;par = e-&gt;par;
  n-&gt;count = e-&gt;count;
  n-&gt;syms = malloc(sizeof(char*) * n-&gt;count);
  n-&gt;vals = malloc(sizeof(lval*) * n-&gt;count);
  for (int i = 0; i &lt; e-&gt;count; i++) {
    n-&gt;syms[i] = malloc(strlen(e-&gt;syms[i]) + 1);
    strcpy(n-&gt;syms[i], e-&gt;syms[i]);
    n-&gt;vals[i] = lval_copy(e-&gt;vals[i]);
  }
  return n;
}

lval* lenv_get(lenv* e, lval* k) {
  
  for (int i = 0; i &lt; e-&gt;count; i++) {
    if (strcmp(e-&gt;syms[i], k-&gt;sym) == 0) { return lval_copy(e-&gt;vals[i]); }
  }
  
  if (e-&gt;par) {
    return lenv_get(e-&gt;par, k);
  } else {
    return lval_err("Unbound Symbol '%s'", k-&gt;sym);
  }
}

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

void lenv_def(lenv* e, lval* k, lval* v) {
  while (e-&gt;par) { e = e-&gt;par; }
  lenv_put(e, k, v);
}

/* Builtins */

#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-&gt;cell[index]-&gt;type == expect, \
    "Function '%s' passed incorrect type for argument %i. Got %s, Expected %s.", \
    func, index, ltype_name(args-&gt;cell[index]-&gt;type), ltype_name(expect))

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

#define LASSERT_NOT_EMPTY(func, args, index) \
  LASSERT(args, args-&gt;cell[index]-&gt;count != 0, \
    "Function '%s' passed {} for argument %i.", func, index);
    
lval* lval_eval(lenv* e, lval* v);

lval* builtin_lambda(lenv* e, lval* a) {
  LASSERT_NUM("\\", a, 2);
  LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
  LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);
  
  for (int i = 0; i &lt; a-&gt;cell[0]-&gt;count; i++) {
    LASSERT(a, (a-&gt;cell[0]-&gt;cell[i]-&gt;type == LVAL_SYM),
      "Cannot define non-symbol. Got %s, Expected %s.",
      ltype_name(a-&gt;cell[0]-&gt;cell[i]-&gt;type), ltype_name(LVAL_SYM));
  }
  
  lval* formals = lval_pop(a, 0);
  lval* body = lval_pop(a, 0);
  lval_del(a);
  
  return lval_lambda(formals, body);
}

lval* builtin_list(lenv* e, lval* a) {
  a-&gt;type = LVAL_QEXPR;
  return a;
}

lval* builtin_head(lenv* e, lval* a) {
  LASSERT_NUM("head", a, 1);
  LASSERT_TYPE("head", a, 0, LVAL_QEXPR);
  LASSERT_NOT_EMPTY("head", a, 0);
  
  lval* v = lval_take(a, 0);  
  while (v-&gt;count &gt; 1) { lval_del(lval_pop(v, 1)); }
  return v;
}

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

  lval* v = lval_take(a, 0);  
  lval_del(lval_pop(v, 0));
  return v;
}

lval* builtin_eval(lenv* e, lval* a) {
  LASSERT_NUM("eval", a, 1);
  LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);
  
  lval* x = lval_take(a, 0);
  x-&gt;type = LVAL_SEXPR;
  return lval_eval(e, x);
}

lval* builtin_join(lenv* e, lval* a) {
  
  for (int i = 0; i &lt; a-&gt;count; i++) { LASSERT_TYPE("join", a, i, LVAL_QEXPR); }
  
  lval* x = lval_pop(a, 0);
  
  while (a-&gt;count) {
    lval* y = lval_pop(a, 0);
    x = lval_join(x, y);
  }
  
  lval_del(a);
  return x;
}

lval* builtin_op(lenv* e, lval* a, char* op) {
  
  for (int i = 0; i &lt; a-&gt;count; i++) { LASSERT_TYPE(op, a, i, LVAL_NUM); }
  
  lval* x = lval_pop(a, 0);
  
  if ((strcmp(op, "-") == 0) && a-&gt;count == 0) { x-&gt;num = -x-&gt;num; }
  
  while (a-&gt;count &gt; 0) {  
    lval* y = lval_pop(a, 0);
    
    if (strcmp(op, "+") == 0) { x-&gt;num += y-&gt;num; }
    if (strcmp(op, "-") == 0) { x-&gt;num -= y-&gt;num; }
    if (strcmp(op, "*") == 0) { x-&gt;num *= y-&gt;num; }
    if (strcmp(op, "/") == 0) {
      if (y-&gt;num == 0) {
        lval_del(x); lval_del(y);
        x = lval_err("Division By Zero.");
        break;
      }
      x-&gt;num /= y-&gt;num;
    }
    
    lval_del(y);
  }
  
  lval_del(a);
  return x;
}

lval* builtin_add(lenv* e, lval* a) { return builtin_op(e, a, "+"); }
lval* builtin_sub(lenv* e, lval* a) { return builtin_op(e, a, "-"); }
lval* builtin_mul(lenv* e, lval* a) { return builtin_op(e, a, "*"); }
lval* builtin_div(lenv* e, lval* a) { return builtin_op(e, a, "/"); }

lval* builtin_var(lenv* e, lval* a, char* func) {
  LASSERT_TYPE(func, a, 0, LVAL_QEXPR);
  
  lval* syms = a-&gt;cell[0];
  for (int i = 0; i &lt; syms-&gt;count; i++) {
    LASSERT(a, (syms-&gt;cell[i]-&gt;type == LVAL_SYM),
      "Function '%s' cannot define non-symbol. Got %s, Expected %s.",
      func, ltype_name(syms-&gt;cell[i]-&gt;type), ltype_name(LVAL_SYM));
  }
  
  LASSERT(a, (syms-&gt;count == a-&gt;count-1),
    "Function '%s' passed too many arguments for symbols. Got %i, Expected %i.",
    func, syms-&gt;count, a-&gt;count-1);
    
  for (int i = 0; i &lt; syms-&gt;count; i++) {
    if (strcmp(func, "def") == 0) { lenv_def(e, syms-&gt;cell[i], a-&gt;cell[i+1]); }
    if (strcmp(func, "=")   == 0) { lenv_put(e, syms-&gt;cell[i], a-&gt;cell[i+1]); } 
  }
  
  lval_del(a);
  return lval_sexpr();
}

lval* builtin_def(lenv* e, lval* a) { return builtin_var(e, a, "def"); }
lval* builtin_put(lenv* e, lval* a) { return builtin_var(e, a, "="); }

lval* builtin_ord(lenv* e, lval* a, char* op) {
  LASSERT_NUM(op, a, 2);
  LASSERT_TYPE(op, a, 0, LVAL_NUM);
  LASSERT_TYPE(op, a, 1, LVAL_NUM);
  
  int r;
  if (strcmp(op, "&gt;")  == 0) { r = (a-&gt;cell[0]-&gt;num &gt;  a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&lt;")  == 0) { r = (a-&gt;cell[0]-&gt;num &lt;  a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&gt;=") == 0) { r = (a-&gt;cell[0]-&gt;num &gt;= a-&gt;cell[1]-&gt;num); }
  if (strcmp(op, "&lt;=") == 0) { r = (a-&gt;cell[0]-&gt;num &lt;= a-&gt;cell[1]-&gt;num); }
  lval_del(a);
  return lval_num(r);
}

lval* builtin_gt(lenv* e, lval* a) { return builtin_ord(e, a, "&gt;");  }
lval* builtin_lt(lenv* e, lval* a) { return builtin_ord(e, a, "&lt;");  }
lval* builtin_ge(lenv* e, lval* a) { return builtin_ord(e, a, "&gt;="); }
lval* builtin_le(lenv* e, lval* a) { return builtin_ord(e, a, "&lt;="); }

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

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

lval* builtin_if(lenv* e, lval* a) {
  LASSERT_NUM("if", a, 3);
  LASSERT_TYPE("if", a, 0, LVAL_NUM);
  LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
  LASSERT_TYPE("if", a, 2, LVAL_QEXPR);
  
  /* Mark Both Expressions as evaluable */
  lval* x;
  a-&gt;cell[1]-&gt;type = LVAL_SEXPR;
  a-&gt;cell[2]-&gt;type = LVAL_SEXPR;
  
  if (a-&gt;cell[0]-&gt;num) {
    /* If condition is true evaluate first expression */
    x = lval_eval(e, lval_pop(a, 1));
  } else {
    /* Otherwise evaluate second expression */
    x = lval_eval(e, lval_pop(a, 2));
  }
  
  /* Delete argument list and return */
  lval_del(a);
  return x;
}

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

void lenv_add_builtins(lenv* e) {
  /* Variable Functions */
  lenv_add_builtin(e, "\\",  builtin_lambda); 
  lenv_add_builtin(e, "def", builtin_def); lenv_add_builtin(e, "=", builtin_put);
  
  /* 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, "&gt;",    builtin_gt); lenv_add_builtin(e, "&lt;",    builtin_lt);
  lenv_add_builtin(e, "&gt;=",   builtin_ge); lenv_add_builtin(e, "&lt;=",   builtin_le);
}

/* Evaluation */

lval* lval_call(lenv* e, lval* f, lval* a) {
  
  if (f-&gt;builtin) { return f-&gt;builtin(e, a); }
  
  int given = a-&gt;count;
  int total = f-&gt;formals-&gt;count;
  
  while (a-&gt;count) {
    
    if (f-&gt;formals-&gt;count == 0) {
      lval_del(a);
      return lval_err("Function passed too many arguments. Got %i, Expected %i.", given, total); 
    }
    
    lval* sym = lval_pop(f-&gt;formals, 0);
    
    if (strcmp(sym-&gt;sym, "&") == 0) {
      
      if (f-&gt;formals-&gt;count != 1) {
        lval_del(a);
        return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
      }
      
      lval* nsym = lval_pop(f-&gt;formals, 0);
      lenv_put(f-&gt;env, nsym, builtin_list(e, a));
      lval_del(sym); lval_del(nsym);
      break;
    }
    
    lval* val = lval_pop(a, 0);    
    lenv_put(f-&gt;env, sym, val);    
    lval_del(sym); lval_del(val);
  }
  
  lval_del(a);
  
  if (f-&gt;formals-&gt;count &gt; 0 &&
    strcmp(f-&gt;formals-&gt;cell[0]-&gt;sym, "&") == 0) {
    
    if (f-&gt;formals-&gt;count != 2) {
      return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
    }
    
    lval_del(lval_pop(f-&gt;formals, 0));
    
    lval* sym = lval_pop(f-&gt;formals, 0);
    lval* val = lval_qexpr();    
    lenv_put(f-&gt;env, sym, val);
    lval_del(sym); lval_del(val);
  }
  
  if (f-&gt;formals-&gt;count == 0) {  
    f-&gt;env-&gt;par = e;    
    return builtin_eval(f-&gt;env, lval_add(lval_sexpr(), lval_copy(f-&gt;body)));
  } else {
    return lval_copy(f);
  }
  
}

lval* lval_eval_sexpr(lenv* e, lval* v) {
  
  for (int i = 0; i &lt; v-&gt;count; i++) { v-&gt;cell[i] = lval_eval(e, v-&gt;cell[i]); }
  for (int i = 0; i &lt; v-&gt;count; i++) { if (v-&gt;cell[i]-&gt;type == LVAL_ERR) { return lval_take(v, i); } }
  
  if (v-&gt;count == 0) { return v; }  
  if (v-&gt;count == 1) { return lval_eval(e, lval_take(v, 0)); }
  
  lval* f = lval_pop(v, 0);
  if (f-&gt;type != LVAL_FUN) {
    lval* err = lval_err(
      "S-Expression starts with incorrect type. Got %s, Expected %s.",
      ltype_name(f-&gt;type), ltype_name(LVAL_FUN));
    lval_del(f); lval_del(v);
    return err;
  }
  
  lval* result = lval_call(e, f, v);
  lval_del(f);
  return result;
}

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

/* Reading */

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

lval* lval_read(mpc_ast_t* t) {
  
  if (strstr(t-&gt;tag, "number")) { return lval_read_num(t); }
  if (strstr(t-&gt;tag, "symbol")) { return lval_sym(t-&gt;contents); }
  
  lval* x = NULL;
  if (strcmp(t-&gt;tag, "&gt;") == 0) { x = lval_sexpr(); } 
  if (strstr(t-&gt;tag, "sexpr"))  { x = lval_sexpr(); }
  if (strstr(t-&gt;tag, "qexpr"))  { x = lval_qexpr(); }
  
  for (int i = 0; i &lt; t-&gt;children_num; i++) {
    if (strcmp(t-&gt;children[i]-&gt;contents, "(") == 0) { continue; }
    if (strcmp(t-&gt;children[i]-&gt;contents, ")") == 0) { continue; }
    if (strcmp(t-&gt;children[i]-&gt;contents, "}") == 0) { continue; }
    if (strcmp(t-&gt;children[i]-&gt;contents, "{") == 0) { continue; }
    if (strcmp(t-&gt;children[i]-&gt;tag,  "regex") == 0) { continue; }
    x = lval_add(x, lval_read(t-&gt;children[i]));
  }
  
  return x;
}

/* Main */

int main(int argc, char** argv) {
  
  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");
  
  mpca_lang(MPCA_LANG_DEFAULT,
    "                                                     \
      number : /-?[0-9]+/ ;                               \
      symbol : /[a-zA-Z0-9_+\\-*\\/\\\\=&lt;&gt;!&amp;]+/ ;         \
      sexpr  : '(' &lt;expr&gt;* ')' ;                          \
      qexpr  : '{' &lt;expr&gt;* '}' ;                          \
      expr   : &lt;number&gt; | &lt;symbol&gt; | &lt;sexpr&gt; | &lt;qexpr&gt; ;  \
      lispy  : /^/ &lt;expr&gt;* /$/ ;                          \
    ",
    Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  
  puts("Lispy Version 0.0.0.0.9");
  puts("Press Ctrl+c to Exit\n");
  
  lenv* e = lenv_new();
  lenv_add_builtins(e);
  
  while (1) {
  
    char* input = readline("lispy&gt; ");
    add_history(input);
    
    mpc_result_t r;
    if (mpc_parse("&lt;stdin&gt;", input, Lispy, &r)) {
      
      lval* x = lval_eval(e, lval_read(r.output));
      lval_println(x);
      lval_del(x);
      
      mpc_ast_delete(r.output);
    } else {    
      mpc_err_print(r.error);
      mpc_err_delete(r.error);
    }
    
    free(input);
    
  }
  
  lenv_del(e);
  
  mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  
  return 0;
}</code></pre>
      </div>
    </div>
  </div>
</div>

<h2>Bonus Marks</h2> <hr/>

<div class="alert alert-warning">
  <ul class="list-group">
    <li class="list-group-item">&rsaquo; Create builtin logical operators <em>or</em> <code>||</code>, <em>and</em> <code>&&</code> and <em>not</em> <code>!</code> and add them to the language.</li>
    <li class="list-group-item">&rsaquo; Define a recursive Lisp function that returns the <code>nth</code> item of that list.</li>
    <li class="list-group-item">&rsaquo; Define a recursive Lisp function that returns <code>1</code> if an element is a member of a list, otherwise <code>0</code>.</li>
    <li class="list-group-item">&rsaquo; Define a Lisp function that returns the last element of a list.</li>
    <li class="list-group-item">&rsaquo; Define in Lisp logical operator functions such as <code>or</code>, <code>and</code> and <code>not</code>.</li>
    <li class="list-group-item">&rsaquo; Add a specific boolean type to the language with the builtin variables <code>true</code> and <code>false</code>.</li>
  </ul>
</div>


<h2>Navigation</h2>

<table class="table" style='table-layout: fixed;'>
  <tr>
    <td class="text-left"><a href="chapter12_functions"><h4>&lsaquo; Functions</h4></a></td>
    <td class="text-center"><a href="contents"><h4>&bull; Contents &bull;</h4></a></td>
    <td class="text-right"><a href="chapter14_strings"><h4>Strings &rsaquo;</h4></a></td>
  </tr>
</table>