renamed to c.2 and rebased onto latest master

.gitignore

@@ -16,7 +16,9 @@ package-lock.json
 */experiments
 node_modules
 */notes
-
+GPATH
+GTAGS
+GRTAGS
 logs
 old
 tmp/

Makefile.impls

@@ -34,7 +34,7 @@ wasm_MODE = wasmtime
 # Implementation specific settings
 #
 
-IMPLS = ada ada.2 awk bash basic bbc-basic c chuck clojure coffee common-lisp cpp crystal cs d dart \
+IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \
 	elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \
 	guile haskell haxe hy io janet java js jq julia kotlin livescript logo lua make mal \
 	matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \
@@ -110,6 +110,7 @@ bash_STEP_TO_PROG =          impls/bash/$($(1)).sh
 basic_STEP_TO_PROG =         $(basic_STEP_TO_PROG_$(basic_MODE))
 bbc-basic_STEP_TO_PROG =     impls/bbc-basic/$($(1)).bas
 c_STEP_TO_PROG =             impls/c/$($(1))
+c.2_STEP_TO_PROG =           impls/c.2/$($(1))
 chuck_STEP_TO_PROG =         impls/chuck/$($(1)).ck
 clojure_STEP_TO_PROG =       $(clojure_STEP_TO_PROG_$(clojure_MODE))
 coffee_STEP_TO_PROG =        impls/coffee/$($(1)).coffee
@@ -192,4 +193,3 @@ wren_STEP_TO_PROG =          impls/wren/$($(1)).wren
 yorick_STEP_TO_PROG =        impls/yorick/$($(1)).i
 xslt_STEP_TO_PROG =          impls/xslt/$($(1))
 zig_STEP_TO_PROG =           impls/zig/$($(1))
-

impls/c.2/Dockerfile

@@ -0,0 +1,28 @@
+FROM ubuntu:bionic
+MAINTAINER Duncan Watts <fungiblecog@gmail.com>
+
+##########################################################
+# General requirements for testing or common across many
+# implementations
+##########################################################
+
+RUN apt-get -y update
+
+# Required for running tests
+RUN apt-get -y install make python
+
+# Some typical implementation and test requirements
+#RUN apt-get -y install curl
+
+RUN mkdir -p /mal
+WORKDIR /mal
+
+##########################################################
+# Specific implementation requirements
+##########################################################
+
+# Install gcc
+RUN apt-get -y install gcc
+
+# Libraries needed for the C impl
+RUN apt-get -y install libffi-dev libgc-dev libedit-dev

impls/c.2/Makefile

@@ -0,0 +1,93 @@
+CC = gcc
+
+CFLAGS = -std=c99 -g -Wall
+
+LIBS = -ledit -lgc
+FFI_LIBS = -ldl -lffi
+
+SRC = reader.c printer.c types.c env.c core.c
+HEADERS = reader.h printer.h types.h env.h core.h
+
+LIB_DIR = ./libs
+LIB_LIST_H = $(LIB_DIR)/linked_list/linked_list.h
+LIB_LIST_SRC = $(LIB_DIR)/linked_list/linked_list.c
+
+LIB_MAP_H = $(LIB_DIR)/hashmap/hashmap.h
+LIB_MAP_SRC = $(LIB_DIR)/hashmap/hashmap.c
+
+LIBS_H = $(LIB_LIST_H) $(LIB_MAP_H)
+LIBS_SRC = $(LIB_LIST_SRC) $(LIB_MAP_SRC)
+
+S0_SRC = step0_repl.c
+S1_SRC = step1_read_print.c reader.c types.c printer.c $(LIB_LIST_SRC)
+S2_SRC = step2_eval.c reader.c types.c printer.c $(LIBS_SRC)
+S3_SRC = step3_env.c reader.c types.c printer.c env.c $(LIBS_SRC)
+S4_SRC = step4_if_fn_do.c $(SRC) $(LIBS_SRC)
+S5_SRC = step5_tco.c $(SRC) $(LIBS_SRC)
+S6_SRC = step6_file.c $(SRC) $(LIBS_SRC)
+S7_SRC = step7_quote.c $(SRC) $(LIBS_SRC)
+S8_SRC = step8_macros.c $(SRC) $(LIBS_SRC)
+S9_SRC = step9_try.c $(SRC) $(LIBS_SRC)
+SA_SRC = stepA_mal.c $(SRC) $(LIBS_SRC)
+
+S0_HEADERS =
+S1_HEADERS = reader.h types.h printer.h $(LIB_LIST_H)
+S2_HEADERS = reader.h types.h printer.h $(LIBS_H)
+S3_HEADERS = reader.h types.h printer.h env.h $(LIBS_H)
+S4_HEADERS = $(HEADERS) $(LIBS_H)
+S5_HEADERS = $(HEADERS) $(LIBS_H)
+S6_HEADERS = $(HEADERS) $(LIBS_H)
+S7_HEADERS = $(HEADERS) $(LIBS_H)
+S8_HEADERS = $(HEADERS) $(LIBS_H)
+S9_HEADERS = $(HEADERS) $(LIBS_H)
+SA_HEADERS = $(HEADERS) $(LIBS_H)
+
+S0 = step0_repl
+S1 = step1_read_print
+S2 = step2_eval
+S3 = step3_env
+S4 = step4_if_fn_do
+S5 = step5_tco
+S6 = step6_file
+S7 = step7_quote
+S8 = step8_macros
+S9 = step9_try
+SA = stepA_mal
+
+.PHONY all: $(S0) $(S1) $(S2) $(S3) $(S4) $(S5) $(S6) $(S7) $(S8) $(S9) $(SA)
+
+$(S0): $(S0_SRC) $(S0_HEADERS)
+	$(CC) $(CFLAGS) $(S0_SRC) $(LIBS) -o $(S0)
+
+$(S1): $(S1_SRC) $(S1_HEADERS)
+	$(CC) $(CFLAGS) $(S1_SRC) $(LIBS) -o $(S1)
+
+$(S2): $(S2_SRC) $(S2_HEADERS)
+	$(CC) $(CFLAGS) $(S2_SRC) $(LIBS) -o $(S2)
+
+$(S3): $(S3_SRC) $(S3_HEADERS)
+	$(CC) $(CFLAGS) $(S3_SRC) $(LIBS) -o $(S3)
+
+$(S4): $(S4_SRC) $(S4_HEADERS)
+	$(CC) $(CFLAGS) $(S4_SRC) $(LIBS) -o $(S4)
+
+$(S5): $(S5_SRC) $(S5_HEADERS)
+	$(CC) $(CFLAGS) $(S5_SRC) $(LIBS) -o $(S5)
+
+$(S6): $(S6_SRC) $(S6_HEADERS)
+	$(CC) $(CFLAGS) $(S6_SRC) $(LIBS) -o $(S6)
+
+$(S7): $(S7_SRC) $(S7_HEADERS)
+	$(CC) $(CFLAGS) $(S7_SRC) $(LIBS) -o $(S7)
+
+$(S8): $(S8_SRC) $(S8_HEADERS)
+	$(CC) $(CFLAGS) $(S8_SRC) $(LIBS) -o $(S8)
+
+$(S9): $(S9_SRC) $(S9_HEADERS)
+	$(CC) $(CFLAGS) $(S9_SRC) $(LIBS) -o $(S9)
+
+$(SA): $(SA_SRC) $(SA_HEADERS)
+	$(CC) $(CFLAGS) $(SA_SRC) $(LIBS) $(FFI_LIBS) -DWITH_FFI -o $(SA)
+
+.PHONY clean:
+	rm -f $(S0) $(S1) $(S2) $(S3) $(S4) $(S5) $(S6) $(S7) $(S8) $(S9) $(SA)

impls/c.2/core.h

@@ -0,0 +1,22 @@
+#ifndef _MAL_CORE_H
+#define _MAL_CORE_H
+
+#include "libs/hashmap/hashmap.h"
+#include "types.h"
+
+typedef struct ns_s ns;
+
+struct ns_s {
+
+  hashmap mappings;
+
+};
+
+ns* ns_make_core();
+MalType* as_str(list args, int readably, char* separator);
+MalType* print(list args, int readably, char* separator);
+char* get_fn(gptr data);
+MalType* equal_lists(MalType* lst1, MalType* lst2);
+MalType* equal_hashmaps(MalType* map1, MalType* map2);
+
+#endif

impls/c.2/env.c

@@ -0,0 +1,67 @@
+#include <stdio.h>
+#include <gc.h>
+
+#include "libs/hashmap/hashmap.h"
+#include "types.h"
+#include "env.h"
+#include "reader.h"
+
+/* Note: caller must make sure enough exprs to match symbols */
+Env* env_make(Env* outer, list symbol_list, list exprs_list, MalType* more_symbol) {
+
+  Env*  env = GC_MALLOC(sizeof(*env));
+  env->outer = outer;
+  env->data = NULL;
+
+  while (symbol_list) {
+
+    env = env_set(env, symbol_list->data, exprs_list->data);
+
+    symbol_list = symbol_list->next;
+    exprs_list = exprs_list->next;
+  }
+
+  /* set the 'more' symbol if there is one */
+  if (more_symbol) {
+    env = env_set(env, more_symbol, make_list(exprs_list));
+  }
+  return env;
+}
+
+Env* env_set(Env* current, MalType* symbol, MalType* value) {
+
+  current->data = hashmap_put(current->data, symbol->value.mal_symbol, value);
+  return current;
+}
+
+Env* env_find(Env* current, MalType* symbol) {
+
+  MalType* val = hashmap_get(current->data, symbol->value.mal_symbol);
+
+  if (val) {
+    return current;
+  }
+  else if (current->outer) {
+    return env_find(current->outer, symbol);
+  }
+  else {
+    return NULL; /* not found */
+  }
+}
+
+MalType* env_get(Env* current, MalType* symbol) {
+
+  Env* env = env_find(current, symbol);
+
+  if (env) {
+    return hashmap_get(env->data, symbol->value.mal_symbol);
+  }
+  else {
+    return make_error_fmt("'%s' not found", symbol->value.mal_symbol);
+  }
+}
+
+Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list)) {
+
+  return env_set(current, make_symbol(symbol_name), make_function(fn));
+}

impls/c.2/env.h

@@ -0,0 +1,23 @@
+#ifndef _MAL_ENV_H
+#define _MAL_ENV_H
+
+#include "libs/linked_list/linked_list.h"
+#include "libs/hashmap/hashmap.h"
+#include "types.h"
+
+typedef struct Env_s Env;
+
+struct Env_s {
+
+  struct Env_s* outer;
+  hashmap data;
+
+};
+
+Env* env_make(Env* outer, list binds, list exprs, MalType* variadic_symbol);
+Env* env_set(Env* current, MalType* symbol, MalType* value);
+Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list));
+MalType* env_get(Env* current, MalType* symbol);
+Env* env_find(Env* current, MalType* symbol);
+
+#endif

impls/c.2/libs/hashmap/hashmap.c

@@ -0,0 +1,93 @@
+#include <stdio.h>
+#include <string.h>
+#include <gc.h>
+
+#include "hashmap.h"
+
+hashmap hashmap_make(char* keystring, gptr data_ptr) {
+
+  list map = list_make(data_ptr);
+  map = list_push(map, keystring);
+
+  return map;
+}
+
+hashmap hashmap_put(hashmap map, char* keystring, gptr data_ptr) {
+
+  map = list_push(map, data_ptr);
+  map = list_push(map, keystring);
+
+  return map;
+}
+
+gptr hashmap_get(hashmap map, char* keystring) {
+
+  /* handle empty case */
+  if (!map) {
+    return NULL;
+  }
+
+  list lst = map;
+
+  while(lst) {
+
+    if (strcmp(keystring, (char*)lst->data) == 0) {
+        return (lst->next)->data; /* return next item in list which is the value */
+      }
+      else {
+        lst = (lst->next)->next; /* skip the next item in the list to get to the next key */
+      }
+  }
+  return NULL; /* not found */
+}
+
+
+gptr hashmap_getf(hashmap map, char* keystring, char*(*fn)(gptr)) {
+
+  /* handle empty case */
+  if (!map) {
+    return NULL;
+  }
+
+  list lst = map;
+
+  while(lst) {
+
+    /* apply fn to the data to get a string */
+    char* item = fn(lst->data);
+
+    if (strcmp(keystring, item) == 0) {
+        return (lst->next)->data; /* return next item in list which is the value */
+      }
+      else {
+        lst = (lst->next)->next; /* skip the next item in the list to get to the next key */
+      }
+  }
+  return NULL; /* not found */
+}
+
+hashmap hashmap_updatef(hashmap map, char* keystring, gptr value, char*(*fn)(gptr)) {
+
+  /* handle empty case */
+  if (!map) {
+    return NULL;
+  }
+
+  list lst = map;
+
+  while(lst) {
+
+    /* apply fn to the data to get a string */
+    char* item = fn(lst->data);
+
+    if (strcmp(keystring, item) == 0) {
+      (lst->next)->data = value; /* update the next item in list which is the value */
+      return map; /* update made */
+    }
+    else {
+      lst = (lst->next)->next; /* skip the next item in the list to get to the next key */
+    }
+  }
+
+  return NULL; /* no update */
+}

impls/c.2/libs/hashmap/hashmap.h

@@ -0,0 +1,15 @@
+#ifndef _MAL_HASHMAP_H
+#define _MAL_HASHMAP_H
+
+#include "../linked_list/linked_list.h"
+
+/* a hashmap is just a list with alternating key/value pairs */
+typedef list hashmap;
+
+hashmap hashmap_make(char* keystring, gptr data_ptr);
+hashmap hashmap_put(hashmap map, char* keystring, gptr data_ptr);
+gptr hashmap_get(hashmap map, char* keystring);
+gptr hashmap_getf(hashmap map, char* keystring, char*(*fn)(gptr));
+hashmap hashmap_updatef(hashmap map, char* keystring, gptr value, char*(*fn)(gptr));
+
+#endif

impls/c.2/libs/linked_list/linked_list.c

@@ -0,0 +1,171 @@
+#include <stdio.h>
+#include <string.h>
+#include <gc.h>
+#include "linked_list.h"
+
+list list_make(gptr data_ptr) {
+
+  return list_push(NULL, data_ptr);
+}
+
+list list_push(list lst, gptr data_ptr) {
+
+  pair* new_head = GC_malloc(sizeof(pair));
+  new_head->data = data_ptr;
+  new_head->next = lst;
+
+  return new_head;
+}
+
+gptr list_peek(list lst) {
+
+  return (lst ? lst->data : NULL);
+}
+
+list list_pop(list lst) {
+  return (lst ? lst->next : NULL);
+}
+
+long list_count(list lst) {
+
+  /* handle empty case */
+  if (!lst) {
+    return 0;
+  }
+
+  long counter = 1;
+
+  while(lst->next) {
+
+    counter++;
+    lst = lst->next;
+  }
+
+  return counter;
+}
+
+list list_reverse(list lst) {
+
+  /* list is not empty and has more than one element */
+  if (lst && lst->next) {
+
+    pair *prev = NULL, *next = NULL, *current = lst;
+
+    while (current) {
+
+      /* stash current value of next pointer --> */
+      next = current->next;
+
+      /* reverse the next pointer on current pair <-- */
+      current->next = prev;
+
+      /* move on to next pair and repeat --> */
+      prev = current;
+      current = next;
+
+    }
+
+    lst = prev; /* head of list is in prev when current = NULL */
+  }
+
+  return lst;
+}
+
+list list_concatenate(list lst1, list lst2) {
+
+  list new_lst = NULL;
+  list iterator = NULL;
+
+  while (lst2) {
+
+    gptr val = lst2->data;
+    new_lst = list_push(new_lst, val);
+    lst2 = lst2->next;
+  }
+  new_lst = list_reverse(new_lst);
+
+  lst1 = list_reverse(lst1);
+
+  iterator = lst1;
+  while (iterator) {
+
+    gptr val = iterator->data;
+    new_lst = list_push(new_lst, val);
+    iterator = iterator->next;
+  }
+
+  lst1 = list_reverse(lst1);
+  return new_lst;
+}
+
+gptr list_nth(list lst, int n) {
+
+  int idx = 0;
+  while (lst) {
+
+    if (n == idx) {
+      return lst->data;
+    }
+    idx++;
+    lst = lst->next;
+  }
+  return NULL;
+}
+
+gptr list_first(list lst) {
+
+  if (lst) {
+    return lst->data;
+  }
+  else {
+    return NULL;
+  }
+}
+
+list list_rest(list lst) {
+
+  if (lst) {
+    return lst->next;
+  }
+  else {
+    return NULL;
+  }
+}
+
+list list_copy(list lst) {
+
+  if(!lst) {
+    return NULL;
+  }
+
+  list new_lst = NULL;
+  while(lst) {
+
+    new_lst = list_push(new_lst, lst->data);
+    lst = lst->next;
+  }
+  return new_lst;
+}
+
+long list_findf(list lst, char* keystring, char*(*fn)(gptr)) {
+
+  /* handle empty case */
+  if (!lst) {
+    return -1;
+  }
+
+  list current = lst;
+  while(current) {
+
+    /* apply fn to the data to get a string */
+    char* item = fn(current->data);
+
+    if (strcmp(keystring, item) == 0) {
+      return (current - lst); /* return the index of the first match */
+    }
+    else {
+      current = current->next; /* skip the next item in the list to*/
+    }
+  }
+  return -1; /* not found */
+}

impls/c.2/libs/linked_list/linked_list.h

@@ -0,0 +1,32 @@
+#ifndef _MAL_LINKED_LIST_H
+#define _MAL_LINKED_LIST_H
+
+/* simplify references to void pointers */
+typedef void* gptr;
+
+/* linked list is constructed of pairs */
+typedef struct pair_s {
+
+  gptr data;
+  struct pair_s *next;
+
+} pair;
+
+/* a list is just a pointer to the pair at the head of the list */
+typedef pair* list;
+
+/* interface */
+list list_make(gptr data_ptr);
+list list_push(list lst, gptr data_ptr);
+gptr list_peek(list lst);
+gptr list_nth(list lst, int n);
+gptr list_first(list lst);
+list list_rest(list lst);
+list list_pop(list lst);
+list list_reverse(list lst);
+long list_count(list lst);
+list list_concatenate(list lst1, list lst2);
+list list_copy(list lst);
+long list_findf(list lst, char* keystring, char*(*fn)(gptr));
+
+#endif

impls/c.2/printer.c

@@ -0,0 +1,255 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include "printer.h"
+
+#define PRINT_NIL "nil"
+#define PRINT_TRUE "true"
+#define PRINT_FALSE "false"
+
+#define INTEGER_BUFFER_SIZE 16
+#define SYMBOL_BUFFER_SIZE 32
+#define FUNCTION_BUFFER_SIZE 256
+#define STRING_BUFFER_SIZE 256
+#define LIST_BUFFER_SIZE 1024
+
+char* pr_str(MalType* val, int readably) {
+
+  if (!val) {
+    return "";
+  }
+
+  switch(val->type) {
+
+  case MALTYPE_SYMBOL:
+
+    return snprintfbuf(SYMBOL_BUFFER_SIZE, "%s", val->value.mal_symbol);
+    break;
+
+  case MALTYPE_KEYWORD:
+
+    return snprintfbuf(SYMBOL_BUFFER_SIZE, ":%s", val->value.mal_keyword);
+    break;
+
+  case MALTYPE_INTEGER:
+
+    return snprintfbuf(SYMBOL_BUFFER_SIZE, "%ld", val->value.mal_integer);
+    break;
+
+  case MALTYPE_FLOAT:
+
+    return snprintfbuf(SYMBOL_BUFFER_SIZE, "%lf", val->value.mal_float);
+    break;
+
+  case MALTYPE_STRING:
+
+    if (readably) {
+      return snprintfbuf(STRING_BUFFER_SIZE, "%s", escape_string(val->value.mal_string));
+    }
+    else {
+      return snprintfbuf(STRING_BUFFER_SIZE, "%s",val->value.mal_string);
+    }
+    break;
+
+  case MALTYPE_TRUE:
+
+    return PRINT_TRUE;
+    break;
+
+  case MALTYPE_FALSE:
+
+    return PRINT_FALSE;
+    break;
+
+  case MALTYPE_NIL:
+
+    return PRINT_NIL;
+    break;
+
+  case MALTYPE_LIST:
+
+    return pr_str_list(val->value.mal_list, readably, "(", ")", " ");
+    break;
+
+  case MALTYPE_VECTOR:
+
+    return pr_str_list(val->value.mal_list, readably, "[", "]", " ");
+    break;
+
+  case MALTYPE_HASHMAP:
+
+    return pr_str_list(val->value.mal_list, readably, "{", "}", " ");
+    break;
+
+  case MALTYPE_FUNCTION:
+
+    return snprintfbuf(FUNCTION_BUFFER_SIZE, "#<function::native@%p>", val->value.mal_function);
+    break;
+
+  case MALTYPE_CLOSURE:
+    {
+      MalType* definition = (val->value.mal_closure)->definition;
+      MalType* parameters = (val->value.mal_closure)->parameters;
+      MalType* more_symbol = (val->value.mal_closure)->more_symbol;
+
+      list lst = parameters->value.mal_list;
+
+      if (more_symbol) {
+        lst = list_reverse(lst);
+        lst = list_push(lst, make_symbol(snprintfbuf(STRING_BUFFER_SIZE, "%s%s", "&", more_symbol->value.mal_symbol)));
+        lst = list_reverse(lst);
+      }
+
+      if (val->is_macro) {
+        return snprintfbuf(FUNCTION_BUFFER_SIZE, "#<function::macro: (fn* %s %s))", \
+                           pr_str(make_list(lst), UNREADABLY), pr_str(definition, UNREADABLY));
+      }
+      else {
+        return snprintfbuf(FUNCTION_BUFFER_SIZE, "#<function::closure: (fn* %s %s))", \
+                           pr_str(make_list(lst), UNREADABLY), pr_str(definition, UNREADABLY));
+      }
+    }
+  break;
+
+  case MALTYPE_ATOM:
+
+    return snprintfbuf(STRING_BUFFER_SIZE, "(atom %s)", pr_str(val->value.mal_atom, readably));
+    break;
+
+  case MALTYPE_ERROR:
+
+    return snprintfbuf(STRING_BUFFER_SIZE, "Uncaught error: %s", pr_str(val->value.mal_error, UNREADABLY));
+    break;
+
+  default:
+    /* can't happen unless a new MalType is added */
+    return "Printer error: unknown type\n";
+    break;
+  }
+}
+
+
+char* pr_str_list(list lst, int readably, char* start_delimiter, char* end_delimiter, char* separator) {
+
+  char* list_buffer = GC_MALLOC(sizeof(*list_buffer) * LIST_BUFFER_SIZE);
+  long buffer_length = LIST_BUFFER_SIZE;
+
+  /* add the start delimiter */
+  list_buffer = strcpy(list_buffer, start_delimiter);
+
+  long len = strlen(start_delimiter);
+  long count = len;
+
+  while (lst) {
+
+    /* concatenate next element */
+    MalType* data = lst->data;
+    char* str = pr_str(data, readably);
+
+    len = strlen(str);
+    count += len;
+
+    if (count >= buffer_length) {
+      buffer_length += (count + 1);
+      list_buffer = GC_REALLOC(list_buffer, buffer_length);
+    }
+
+    strncat(list_buffer, str, len);
+    lst = lst->next;
+
+    if (lst) {
+      len = strlen(separator);
+      count += len;
+
+      if (count >= buffer_length) {
+        buffer_length += (count + 1);
+        list_buffer = GC_REALLOC(list_buffer, buffer_length);
+      }
+      /* add the separator */
+      strncat(list_buffer, separator, len);
+    }
+  }
+
+  if (count >= buffer_length) {
+    len = strlen(end_delimiter);
+    count += len;
+
+    buffer_length += (count + 1);
+    list_buffer = GC_REALLOC(list_buffer, buffer_length);
+  }
+
+  /* add the end delimiter */
+  strncat(list_buffer, end_delimiter, len);
+
+  return list_buffer;
+}
+
+
+char* escape_string(char* str) {
+
+  long buffer_length = 2*(strlen(str) + 1) ; /* allocate a reasonable initial buffer size */
+  char* buffer = GC_MALLOC(sizeof(*buffer) * buffer_length);
+
+  strcpy(buffer,"\"");
+
+  char* curr = str;
+  while(*curr != '\0') {
+
+    switch (*curr) {
+
+    case '"':
+      strcat(buffer, "\\\"");
+      break;
+
+    case '\\':
+      strcat(buffer, "\\\\");
+      break;
+
+    case 0x0A:
+      strcat(buffer, "\\n");
+      break;
+
+    default:
+      strncat(buffer, curr, 1);
+    }
+    curr++;
+
+    /* check for overflow and increase buffer size */
+    if ((curr - str) >= buffer_length) {
+      buffer_length *= 2;
+      buffer = GC_REALLOC(buffer, sizeof(*buffer) * buffer_length);
+    }
+  }
+
+  strcat(buffer, "\"");
+
+  /* trim the buffer to the size of the actual escaped string */
+  buffer_length = strlen(buffer);
+  buffer = GC_REALLOC(buffer, sizeof(*buffer) * buffer_length + 1);
+
+  return buffer;
+}
+
+char* snprintfbuf(long initial_size, char* fmt, ...) {
+  /* this is just a wrapper for the *printf family that ensures the
+     string is long enough to hold the contents */
+
+  va_list argptr;
+  va_start(argptr, fmt);
+
+  char* buffer = GC_MALLOC(sizeof(*buffer) * initial_size);
+  long n = vsnprintf(buffer, initial_size, fmt, argptr);
+  va_end(argptr);
+
+  if (n > initial_size) {
+    va_start(argptr, fmt);
+
+    buffer = GC_REALLOC(buffer, sizeof(*buffer) * n);
+    vsnprintf(buffer, n, fmt, argptr);
+
+    va_end(argptr);
+  }
+  return buffer;
+}

impls/c.2/printer.h

@@ -0,0 +1,15 @@
+#ifndef _PRINTER_H
+#define _PRINTER_H
+
+#include <stdarg.h>
+#include "types.h"
+
+#define UNREADABLY 0
+#define READABLY 1
+
+char* pr_str(MalType* mal_val, int readably);
+char* pr_str_list(list lst, int readably, char* start_delimiter, char* end_delimiter, char* separator);
+char* escape_string(char* str);
+char* snprintfbuf(long initial_size, char* fmt, ...);
+
+#endif

impls/c.2/reader.c

@@ -0,0 +1,663 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <gc.h>
+
+#include "reader.h"
+
+#define TOKEN_SPECIAL_CHARACTER 1
+#define TOKEN_STRING 2
+#define TOKEN_INTEGER 3
+#define TOKEN_FLOAT 4
+#define TOKEN_SYMBOL 5
+#define TOKEN_COMMENT 6
+#define TOKEN_KEYWORD 7
+#define TOKEN_TRUE 8
+#define TOKEN_FALSE 9
+#define TOKEN_NIL 10
+
+#define SYMBOL_NIL "nil"
+#define SYMBOL_TRUE "true"
+#define SYMBOL_FALSE "false"
+#define SYMBOL_QUOTE "quote"
+#define SYMBOL_QUASIQUOTE "quasiquote"
+#define SYMBOL_UNQUOTE  "unquote"
+#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
+#define SYMBOL_DEREF "deref"
+#define SYMBOL_WITH_META "with-meta"
+
+Reader* reader_make(long token_capacity) {
+
+  Reader* reader = GC_MALLOC(sizeof(*reader));
+
+  reader->max_tokens = token_capacity;
+  reader->position = 0;
+  reader->token_count = 0;
+  reader->token_data = GC_MALLOC(sizeof(Token*) * token_capacity);
+  reader->error = NULL;
+
+  return reader;
+}
+
+Reader* reader_append(Reader* reader, Token* token) {
+
+  if (reader->token_count < reader->max_tokens) {
+
+    reader->token_data[reader->token_count] = token;
+    reader->token_count++;
+  }
+  else {
+    /* TODO: expand the storage more intelligently */
+    reader->max_tokens *= 2;
+    reader = GC_REALLOC(reader, sizeof(*reader) * reader->max_tokens);
+    reader->token_data[reader->token_count] = token;
+    reader->token_count++;
+  }
+  return reader;
+}
+
+Token* reader_peek(const Reader* reader) {
+
+  return (reader->token_data[reader->position]);
+}
+
+Token* reader_next(Reader* reader) {
+
+  Token* tok = reader->token_data[reader->position];
+
+  if (reader->position == -1) {
+    return NULL;
+  }
+  else if (reader->position < reader->token_count) {
+    (reader->position)++;
+    return tok;
+  }
+  else {
+    reader->position = -1;
+    return tok;
+  }
+}
+
+void reader_print(Reader* reader) {
+  /* NOTE: needed for debugging the reader only */
+
+  Token* tok;
+
+  for (long i = 0; i < reader->token_count; i++) {
+
+    tok =  reader_next(reader);
+
+    switch (tok->type) {
+    case TOKEN_SPECIAL_CHARACTER:
+      printf("special character: %s", tok->data);
+      break;
+    case TOKEN_STRING:
+      printf("string: %s", tok->data);
+      break;
+    case TOKEN_INTEGER:
+      printf("integer: %s", tok->data);
+      break;
+    case TOKEN_FLOAT:
+      printf("float: %s", tok->data);
+      break;
+    case TOKEN_SYMBOL:
+      printf("symbol: %s", tok->data);
+      break;
+    case TOKEN_COMMENT:
+      printf("comment: \"%s\"", tok->data);
+      break;
+    case TOKEN_KEYWORD:
+      printf("keyword: %s", tok->data);
+      break;
+    case TOKEN_TRUE:
+      printf("true: %s", tok->data);
+      break;
+    case TOKEN_FALSE:
+      printf("false: %s", tok->data);
+      break;
+    case TOKEN_NIL:
+      printf("nil: %s", tok->data);
+      break;
+    }
+    /* print an error for any tokens with an error string */
+    tok->error ? printf(" - %s", tok->error) : 0;
+  }
+}
+
+MalType* read_str(char* token_string) {
+
+  Reader* reader = tokenize(token_string);
+
+  if (reader->error) {
+    return make_error_fmt("Reader error: %s", reader->error);
+  }
+  else if (reader->token_count == 0) {
+    return make_nil();
+  }
+  else {
+    return read_form(reader);
+  }
+}
+
+Reader* tokenize(char* token_string) {
+
+  /* allocate enough space for a Reader */
+  /* TODO: over-allocates space */
+  Reader* reader = reader_make(strlen(token_string));
+
+  for (char* next = token_string; *next != '\0';) {
+
+    Token* token = NULL;
+
+    switch (*next) {
+      /* skip whitespace */
+    case ' ':
+    case ',':
+    case 0x0A: /* newline */
+      next++;
+      token = NULL; /* no token for whitespace */
+      break;
+
+      /* single character token */
+    case '[':
+    case '\\':
+    case ']':
+    case '{':
+    case '}':
+    case '(':
+    case ')':
+    case '\'':
+    case '@':
+    case '`':
+    case '^':
+      next = read_fixed_length_token(next, &token, 1);
+      break;
+
+      /* single or double character token */
+    case '~':
+      if ( *(next + 1) == '@' ) {
+        next = read_fixed_length_token(next, &token, 2);
+      }
+      else {
+        next = read_fixed_length_token(next, &token, 1);
+      }
+      break;
+
+      /* read string of characters within double quotes */
+    case '"':
+      next = read_string_token(next, &token);
+      break;
+
+      /* read a comment - all remaining input until newline */
+    case ';':
+      next = read_comment_token(next, &token);
+      token = NULL; /* skip token for comments */
+      break;
+
+      /* read an integer */
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      next = read_number_token(next, &token);
+      //      next = read_integer_token(next, &token);
+      break;
+
+      /* integer may be prefixed with +/- */
+    case '+':
+    case '-':
+      if (isdigit(next[1])) {
+        next = read_number_token(next, &token);
+        //      next = read_integer_token(next, &token);
+      }
+      else { /* if not digits it is part of a symbol */
+        next = read_symbol_token(next, &token);
+      }
+      break;
+
+      /* read keyword */
+    case ':':
+      next = read_keyword_token(next, &token);
+      break;
+
+      /* read anything else as a symbol */
+    default:
+      next = read_symbol_token(next, &token);
+      break;
+    }
+
+    if (!token) {
+      /* if no token was read (whitespace or comments)
+         continue the loop */
+      continue;
+    }
+    else {
+
+      if (token->error) {
+        /* report any errors with an early return */
+        reader = reader_append(reader, token);
+        reader->error = token->error;
+        return reader;
+      }
+      /* otherwise append the token and continue */
+      reader = reader_append(reader, token);
+    }
+  }
+  return reader;
+}
+
+char* read_fixed_length_token(char* current, Token** ptoken, int n) {
+
+  *ptoken = token_allocate(current, n, TOKEN_SPECIAL_CHARACTER, NULL);
+  return (current + n);
+}
+
+char* read_terminated_token (char* current, Token** ptoken, int token_type) {
+
+  static char* const terminating_characters = " ,[](){};\n";
+
+  /* search for first terminating character */
+  char* end = strpbrk(current, terminating_characters);
+
+  /* if terminating character is not found it implies the end of the string */
+  long token_length = !end ? strlen(current) : (end - current);
+
+  /* next token starts with the terminating character */
+  *ptoken = token_allocate(current, token_length, token_type, NULL);
+  return (current + token_length);
+}
+
+char* read_symbol_token (char* current, Token** ptoken) {
+
+  char* next = read_terminated_token(current, ptoken, TOKEN_SYMBOL);
+
+  /* check for reserved symbols */
+  if (strcmp((*ptoken)->data, SYMBOL_NIL) == 0) {
+    (*ptoken)->type = TOKEN_NIL;
+  }
+  else if (strcmp((*ptoken)->data, SYMBOL_TRUE) == 0) {
+    (*ptoken)->type = TOKEN_TRUE;
+  }
+  else if (strcmp((*ptoken)->data, SYMBOL_FALSE) == 0) {
+    (*ptoken)->type = TOKEN_FALSE;
+  }
+
+  /* TODO: check for invalid characters */
+  return next;
+}
+
+
+char* read_keyword_token (char* current, Token** ptoken) {
+
+  /* TODO: check for invalid characters */
+  return read_terminated_token(current + 1, ptoken, TOKEN_KEYWORD);
+}
+
+char* read_number_token(char* current, Token** ptoken) {
+
+  int has_decimal_point = 0;
+
+  char* next = read_terminated_token(current, ptoken, TOKEN_INTEGER);
+  long token_length = next - current;
+
+  /* first char is either digit or '+' or '-'
+     check the rest consists of valid characters */
+  for (long i = 1; i < token_length; i++) {
+
+    if ((*ptoken)->data[i] == '.' && has_decimal_point) {
+      (*ptoken)->error = "Invalid character reading number";
+      break;
+    }
+    else if ((*ptoken)->data[i] == '.' && !has_decimal_point) {
+      has_decimal_point = 1;
+      (*ptoken)->type = TOKEN_FLOAT;
+      break;
+    }
+    else if (!(isdigit((*ptoken)->data[i]))) {
+      (*ptoken)->error = "Invalid character reading number";
+      break;
+    }
+  }
+  return next;
+}
+
+char* read_string_token(char* current, Token** ptoken) {
+
+  char *start, *end, *error = NULL;
+  long token_length = 0;
+
+  start = current + 1;
+
+  while(1) {
+    end = strchr(start, '"'); /* find the next " character */
+
+    /* handle failure to find closing quotes - implies end of input has been reached */
+    if (!end) {
+      end = current + strlen(current);
+      token_length =  strlen(current);
+
+      error = "EOF reached with unterminated string";
+      break;
+    }
+    /* if the character preceding the " is a '\' character (escape), need to check if it is escaping the " and if it
+       is then keep searching from the next character */
+    else if ( *(end - 1) == '\\') {
+
+      char* back_ptr = end - 1;
+      while (*back_ptr == '\\') {
+        back_ptr--; /* back up to count the escape characters '\' */
+      }
+
+      long escape_chars = (end - 1) - back_ptr;
+
+      if (escape_chars % 2 == 1) { /* odd number of '\' chars means " is not quoted */
+        start = end + 1; /* so keep searching */
+      } else {
+        /* even number of '\' characters means we found the terminating quote mark */
+        token_length =  (end - current - 1); /* quotes are excluded from string token */
+        break;
+      }
+    }
+    else {
+      token_length =  (end - current - 1); /* quotes are excluded from string token */
+      break;
+    }
+  }
+
+  char* unescaped_string = unescape_string(current + 1, token_length);
+  *ptoken = token_allocate(unescaped_string, strlen(unescaped_string), TOKEN_STRING, error);
+
+  return (end + 1);
+}
+
+char* read_comment_token(char* current, Token** ptoken) {
+  /* comment includes all remaining characters to the next newline */
+
+  /* search for newline character */
+  char* end = strchr(current, 0x0A);
+
+  /* if newline is not found it implies the end of string is reached */
+  long token_chars = !end ? strlen(current) : (end - current);
+
+  *ptoken = token_allocate(current, token_chars, TOKEN_COMMENT, NULL);
+
+  return (current + token_chars + 1); /* next token starts with the char after the newline */
+}
+
+MalType* read_form(Reader* reader) {
+
+  if (reader->token_count > 0) {
+
+    Token* tok = reader_peek(reader);
+    if (tok->type == TOKEN_SPECIAL_CHARACTER) {
+
+      switch(tok->data[0]) {
+
+      case '(':
+        return read_list(reader);
+        break;
+
+      case '[':
+        return read_vector(reader);
+        break;
+
+      case '{':
+        return read_hashmap(reader);
+        break;
+
+      case '\'':
+        /* create and return a MalType list (quote read_form) */
+        return make_symbol_list(reader, SYMBOL_QUOTE);
+        break;
+
+      case '`':
+        /* create and return a MalType list (quasiquote read_form) */
+        return make_symbol_list(reader, SYMBOL_QUASIQUOTE);
+        break;
+
+      case '~':
+        if (tok->data[1] == '@') {
+          /* create and return a MalType list (splice-unquote read_form) */
+          return make_symbol_list(reader, SYMBOL_SPLICE_UNQUOTE);
+        }
+        else {
+          /* create and return a MalType list (unquote read_form) */
+          return make_symbol_list(reader, SYMBOL_UNQUOTE);
+        }
+      case '@':
+        /* create and return a MalType list (deref read_form) */
+        return make_symbol_list(reader, SYMBOL_DEREF);
+
+      case '^':
+        /* create and return a MalType list (with-meta <second-form> <first-form>
+           where first form should ne a metadata map and second form is somethingh
+           that can have metadata attached */
+          reader_next(reader);
+
+          /* grab the components of the list */
+          MalType* symbol = make_symbol(SYMBOL_WITH_META);
+          MalType* first_form = read_form(reader);
+          MalType* second_form = read_form(reader);
+
+          /* push the symbol and the following forms onto a list */
+          list lst = NULL;
+          lst = list_push(lst, symbol);
+          lst = list_push(lst, second_form);
+          lst = list_push(lst, first_form);
+          lst = list_reverse(lst);
+
+          return make_list(lst);
+
+      default:
+        /* shouldn't happen */
+        return make_error_fmt("Reader error: Unknown special character '%c'", tok->data[0]);
+      }
+
+    } else { /* Not a special character */
+      return read_atom(reader);
+    }
+  }
+  else { /* no tokens */
+    return NULL;
+  }
+}
+
+MalType* read_list(Reader* reader) {
+
+  MalType* retval = read_matched_delimiters(reader, '(', ')' );
+
+  if (is_error(retval)) {
+    retval = make_error("Reader error: unbalanced parenthesis '()'");
+  }
+  else {
+    retval->type = MALTYPE_LIST;
+  }
+  return retval;
+}
+
+MalType* read_vector(Reader* reader) {
+
+  MalType* retval = read_matched_delimiters(reader, '[', ']' );
+
+  if (is_error(retval)) {
+    retval = make_error("Reader error: unbalanced brackets '[]'");
+  }
+  else {
+    retval->type = MALTYPE_VECTOR;
+  }
+  return retval;
+}
+
+MalType* read_hashmap(Reader* reader) {
+
+  MalType* retval = read_matched_delimiters(reader, '{', '}' );
+
+  if (is_error(retval)) {
+    retval = make_error("Reader error: unbalanced braces '{}'");
+  }
+  else if (list_count(retval->value.mal_list)%2 != 0) {
+    retval = make_error("Reader error: missing value in map literal");
+  }
+  else {
+    retval->type = MALTYPE_HASHMAP;
+  }
+  return retval;
+}
+
+MalType* read_matched_delimiters(Reader* reader, char start_delimiter, char end_delimiter) {
+/* TODO: separate implementation of hashmap and vector */
+
+  Token* tok = reader_next(reader);
+  list lst = NULL;
+
+  if (reader_peek(reader)->data[0] == end_delimiter) {
+    reader_next(reader);
+    return make_list(NULL);
+  }
+  else {
+    while (tok->data[0] != end_delimiter) {
+
+        MalType* val = read_form(reader);
+        lst = list_push(lst, (gptr)val);
+
+        tok = reader_peek(reader);
+
+        if (!tok) {
+          /* unbalanced parentheses */
+          return make_error("");
+        }
+      }
+    reader_next(reader);
+
+    return  make_list(list_reverse(lst));
+  }
+}
+
+MalType* read_atom(Reader* reader) {
+
+  Token* tok = reader_next(reader);
+
+  switch (tok->type) {
+
+  case TOKEN_SPECIAL_CHARACTER:
+    return make_symbol(tok->data);
+    break;
+
+  case TOKEN_COMMENT:
+    return make_error("Error: comment found in token strea");
+    break;
+
+  case TOKEN_STRING:
+    return make_string(tok->data);
+    break;
+
+  case TOKEN_INTEGER:
+    return make_integer(strtol(tok->data, NULL, 10));
+    break;
+
+  case TOKEN_FLOAT:
+    return make_float(atof(tok->data));
+    break;
+
+  case TOKEN_SYMBOL:
+    return make_symbol(tok->data);
+    break;
+
+  case TOKEN_KEYWORD:
+    return make_keyword(tok->data);
+    break;
+
+  case TOKEN_TRUE:
+    return make_true();
+    break;
+
+  case TOKEN_FALSE:
+    return make_false();
+    break;
+
+  case TOKEN_NIL:
+    return make_nil();
+    break;
+  }
+  return make_error("Reader error: Unknown atom type");
+}
+
+MalType* make_symbol_list(Reader* reader, char* symbol_name) {
+
+  reader_next(reader);
+  list lst = NULL;
+
+  /* push the symbol and the following form onto the list */
+  lst = list_push(lst, make_symbol(symbol_name));
+  lst = list_push(lst, read_form(reader));
+
+  return make_list(list_reverse(lst));
+}
+
+Token* token_allocate(char* str, long num_chars, int type, char* error) {
+
+  /* allocate space for the string */
+  char* data = GC_MALLOC(sizeof(*data) * num_chars + 1); /* include space for null byte */
+  strncpy (data, str, num_chars);                        /* copy num_chars characters into data */
+  data[num_chars] = '\0';                                /* manually add the null byte */
+
+  /* allocate space for the token struct */
+  Token* token = GC_MALLOC(sizeof(*token));
+  token->data = data;
+  token->type = type;
+  token->error = error;
+
+  return token;
+}
+
+char* unescape_string(char* str, long length) {
+
+  char* dest = GC_MALLOC(sizeof(*dest)*length + 1);
+
+  long j = 0;
+  for (long i = 0; i < length; i++) {
+
+    /* look for the quoting character */
+    if (str[i] == '\\') {
+
+      switch (str[i+1]) {
+
+        /* replace '\"' with normal '"' */
+      case '"':
+        dest[j++]='"';
+        i++; /* skip extra char */
+        break;
+
+        /* replace '\n' with newline 0x0A */
+      case 'n':
+        dest[j++]= 0x0A;
+        i++; /* skip extra char */
+        break;
+
+        /* replace '\\' with '\' */
+      case '\\':
+        dest[j++]= '\\';
+        i++; /* skip extra char */
+        break;
+
+      default:
+        /* just a '\' symbol so copy it */
+              dest[j++]='\\';
+      }
+    }
+    /* not a quote so copy it */
+    else {
+        dest[j++] = str[i];
+    }
+  }
+  dest[j] = '\0';
+
+  return dest;
+}

impls/c.2/reader.h

@@ -0,0 +1,57 @@
+#ifndef _MAL_READER_H
+#define _MAL_READER_H
+
+#include "types.h"
+
+typedef struct Token_s {
+
+  int type;
+  char* data;
+  char* error;
+
+} Token;
+
+typedef struct Reader_s {
+
+  long position;      // current position in the array
+  long token_count;   // number of tokens in the array
+  long max_tokens;    // maximum number of tokens the array can hold
+  Token** token_data; // pointer to an array of Tokens
+  char* error;        // error message
+
+} Reader;
+
+/* reader object */
+Reader* reader_make(long token_capacity);
+Reader* reader_append(Reader* reader, Token* token);
+Token* reader_peek(const Reader* reader);
+Token* reader_next(Reader* reader);
+Token* reader_get_at(const Reader* reader, long i);
+void reader_print(Reader* reader);
+
+/* tokenizing the input */
+Reader* tokenize(char* token_string);
+char* read_fixed_length_token(char* current, Token** ptoken, int n);
+char* read_string_token(char* current, Token** ptoken);
+char* read_comment_token(char* current, Token** ptoken);
+//char* read_integer_token(char* current, Token** ptoken);
+char* read_number_token(char* current, Token** ptoken);
+char* read_symbol_token(char* current, Token** ptoken);
+char* read_keyword_token(char* current, Token** ptoken);
+
+/* reading the tokens into types */
+MalType* read_str(char* token_string);
+MalType* read_form(Reader* reader);
+MalType* read_atom(Reader* reader);
+MalType* read_list(Reader* reader);
+MalType* read_vector(Reader* reader);
+MalType* read_hashmap(Reader* reader);
+
+/* utility functions */
+char* read_terminated_token (char* current, Token** ptoken, int type);
+MalType* read_matched_delimiters(Reader* reader, char start_delimiter, char end_delimiter);
+MalType* make_symbol_list(Reader* reader, char* symbol_name);
+Token* token_allocate(char* str, long num_chars, int type, char* error);
+char* unescape_string(char* str, long length);
+
+#endif

impls/c.2/run

@@ -0,0 +1,2 @@
+#!/bin/bash
+exec $(dirname $0)/${STEP:-stepA_mal} "${@}"

impls/c.2/step0_repl.c

@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#define PROMPT_STRING "user> "
+
+
+char* READ(char* str) {
+
+  return str;
+}
+
+char* EVAL(char* str) {
+
+  return str;
+}
+
+void PRINT(char* str) {
+
+  printf("%s\n", str);
+}
+
+void rep(char* str) {
+
+  PRINT(EVAL(READ(str)));
+}
+
+
+int main(int argc, char** argv) {
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.1\n");
+  puts("Press Ctrl+d to exit\n");
+
+  while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}

impls/c.2/step1_read_print.c

@@ -0,0 +1,63 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* val) {
+
+  return val;
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str) {
+
+  PRINT(EVAL(READ(str)));
+}
+
+int main(int argc, char** argv) {
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.2\n");
+  puts("Press Ctrl+d to exit\n");
+
+  while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}

impls/c.2/step2_eval.c

@@ -0,0 +1,305 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+
+  /* evaluate the list */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else {
+    return make_error_fmt("Error: first item in list is not callable: %s.", \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+int main(int argc, char** argv) {
+
+  MalType* mal_add(list args);
+  MalType* mal_sub(list args);
+  MalType* mal_mul(list args);
+  MalType* mal_div(list args);
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.2\n");
+  puts("Press Ctrl+d to exit\n");
+
+  MalType* func_add = make_function(&mal_add);
+  MalType* func_sub = make_function(&mal_sub);
+  MalType* func_mul = make_function(&mal_mul);
+  MalType* func_div = make_function(&mal_div);
+
+  hashmap g = hashmap_make("+", func_add);
+  g = hashmap_put(g, "-", func_sub);
+  g = hashmap_put(g, "*", func_mul);
+  g = hashmap_put(g, "/", func_div);
+
+  Env* repl_env = GC_MALLOC(sizeof(*repl_env));
+  repl_env->data = g;
+
+  while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input, repl_env);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = hashmap_get(env->data, ast->value.mal_symbol);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+    /* values are evaluated */
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* mal_add(list args) {
+
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  long sum = 0;
+  while(arg_list) {
+
+    MalType* val = arg_list->data;
+    /* TODO: check argument type */
+
+    sum = sum + val->value.mal_integer;
+
+    arg_list = arg_list->next;
+  }
+
+  result->value.mal_integer = sum;
+  return result;
+}
+
+MalType* mal_sub(list args) {
+
+  long sum;
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+  if (arg_list) {
+
+    MalType* first_val = arg_list->data;
+    arg_list = arg_list->next;
+    /* TODO: check argument type */
+
+    sum = first_val->value.mal_integer;
+    while(arg_list) {
+
+      MalType* val = arg_list->data;
+      /* TODO: check argument type */
+
+      sum = sum - val->value.mal_integer;
+
+      arg_list = arg_list->next;
+    }
+  }
+  else {
+    sum = 0;
+  }
+
+  result->value.mal_integer = sum;
+  return result;
+}
+
+MalType* mal_mul(list args) {
+
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  long product = 1;
+  while(arg_list) {
+
+    MalType* val = arg_list->data;
+    /* TODO: check argument type */
+
+    product *= val->value.mal_integer;
+
+    arg_list = arg_list->next;
+  }
+
+  result->value.mal_integer = product;
+  return result;
+}
+
+MalType* mal_div(list args) {
+
+  long product;
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  if (arg_list) {
+    MalType* first_val = arg_list->data;
+    /* TODO: check argument type */
+    product = first_val->value.mal_integer;
+    arg_list = arg_list->next;
+
+    while(arg_list) {
+
+      MalType* val = arg_list->data;
+      /* TODO: check argument type */
+
+    product /= (val->value.mal_integer);
+    arg_list = arg_list->next;
+    }
+  } else {
+    product = 1;
+  }
+  result->value.mal_integer = product;
+  return result;
+}

impls/c.2/step3_env.c

@@ -0,0 +1,357 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env* env);
+  MalType* eval_letstar(MalType* ast, Env* env);
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+      return eval_letstar(ast, env);
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else {
+    return make_error_fmt("Error: first item in list is not callable: %s.", \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+int main(int argc, char** argv) {
+
+  MalType* mal_add(list args);
+  MalType* mal_sub(list args);
+  MalType* mal_mul(list args);
+  MalType* mal_div(list args);
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.3\n");
+  puts("Press Ctrl+d to exit\n");
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  repl_env = env_set_C_fn(repl_env, "+", mal_add);
+  repl_env = env_set_C_fn(repl_env, "-", mal_sub);
+  repl_env = env_set_C_fn(repl_env, "*", mal_mul);
+  repl_env = env_set_C_fn(repl_env, "/", mal_div);
+
+  while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input, repl_env);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env* env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  /* TODO: Check the number and types of parameters */
+  MalType* defbang_symbol = lst->data;
+  MalType* defbang_value = lst->next->data;
+
+  MalType* result = EVAL(defbang_value, env);
+
+  if (!is_error(result)) {
+    env_set(env, defbang_symbol, result);
+  }
+  return result;
+}
+
+MalType* eval_letstar(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+  lst = lst->next;
+
+  /* TODO: Check the bindings list is valid, has an even number of elements, etc*/
+  Env* letstar_env = env_make(env, NULL, NULL, NULL);
+
+  MalType* letstar_bindings = lst->data;
+  list letstar_bindings_list = letstar_bindings->value.mal_list;
+
+  /* evaluate the bindings */
+  while(letstar_bindings_list) {
+
+    MalType* symbol = letstar_bindings_list->data;
+    MalType* value = letstar_bindings_list->next->data;
+    letstar_env = env_set(letstar_env, symbol, EVAL(value, letstar_env));
+
+    letstar_bindings_list = letstar_bindings_list->next->next; /* pop symbol and value*/
+  }
+
+  /* evaluate the forms in the presence of bindings */
+  MalType* forms = lst->next->data;
+  return EVAL(forms, letstar_env);
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+    /* values are evaluated */
+    evlst = list_push(evlst, EVAL(lst->data, env));
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* mal_add(list args) {
+
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  long sum = 0;
+  while(arg_list) {
+
+    MalType* val = arg_list->data;
+    /* TODO: check argument type */
+
+    sum = sum + val->value.mal_integer;
+
+    arg_list = arg_list->next;
+  }
+
+  result->value.mal_integer = sum;
+  return result;
+}
+
+MalType* mal_sub(list args) {
+
+  long sum;
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+  if (arg_list) {
+
+    MalType* first_val = arg_list->data;
+    arg_list = arg_list->next;
+    /* TODO: check argument type */
+
+    sum = first_val->value.mal_integer;
+    while(arg_list) {
+
+      MalType* val = arg_list->data;
+      /* TODO: check argument type */
+
+      sum = sum - val->value.mal_integer;
+
+      arg_list = arg_list->next;
+    }
+  }
+  else {
+    sum = 0;
+  }
+
+  result->value.mal_integer = sum;
+  return result;
+}
+
+MalType* mal_mul(list args) {
+
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  long product = 1;
+  while(arg_list) {
+
+    MalType* val = arg_list->data;
+    /* TODO: check argument type */
+
+    product *= val->value.mal_integer;
+
+    arg_list = arg_list->next;
+  }
+
+  result->value.mal_integer = product;
+  return result;
+}
+
+MalType* mal_div(list args) {
+
+  long product;
+  MalType* result = GC_MALLOC(sizeof(*result));
+  result->type = MALTYPE_INTEGER;
+
+  list arg_list = args;
+
+  if (arg_list) {
+    MalType* first_val = arg_list->data;
+    /* TODO: check argument type */
+    product = first_val->value.mal_integer;
+    arg_list = arg_list->next;
+
+    while(arg_list) {
+
+      MalType* val = arg_list->data;
+      /* TODO: check argument type */
+
+    product /= (val->value.mal_integer);
+    arg_list = arg_list->next;
+    }
+  } else {
+    product = 1;
+  }
+  result->value.mal_integer = product;
+  return result;
+}

impls/c.2/step4_if_fn_do.c

@@ -0,0 +1,490 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_DO "do"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env* env);
+  MalType* eval_letstar(MalType* ast, Env* env);
+  MalType* eval_if(MalType* ast, Env* env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+      return eval_letstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+      return eval_if(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+      return eval_do(ast, env);
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      Env* new_env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      return EVAL(closure->definition, new_env);
+    }
+  }
+  else {
+    return make_error_fmt("Error: first item in list is not callable: %s.", \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+int main(int argc, char** argv) {
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.4\n");
+  puts("Press Ctrl+d to exit\n");
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  /* add not function */
+  /* not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+
+    while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input, repl_env);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env* env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, env);
+
+  if (!is_error(result)){
+    env = env_set(env, defbang_symbol, result);
+  }
+  return result;
+}
+
+MalType* eval_letstar(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'let*': missing bindings list");
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    return make_error("'let*': first argument is not list or vector");
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    return  make_error("'let*': expected an even number of binding pairs");
+  }
+
+  Env* letstar_env = env_make(env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) { return  value; }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+  return EVAL(forms, letstar_env);
+}
+
+MalType* eval_if(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    return make_error("'if': too few arguments");
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    return make_error("'if': too many arguments");
+  }
+
+  MalType* condition = EVAL(lst->next->data, env);
+
+  if (is_error(condition)) { return condition; }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      return EVAL(lst->next->next->next->data, env);
+    }
+    else {
+      return make_nil();
+    }
+
+  } else {
+    return EVAL(lst->next->next->data, env);
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) { return make_nil(); }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) { return val; }
+    lst = lst->next;
+  }
+  /* return the last value */
+  return EVAL(lst->data, env);
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  MalType* val = data;
+  return (val->value.mal_symbol);
+}
+
+/* silence the compiler after swap!, apply, and map are added to the core */
+MalType* apply(MalType* ast, Env* env) {
+  return make_nil();
+}

impls/c.2/step5_tco.c

@@ -0,0 +1,532 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_DO "do"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+int main(int argc, char** argv) {
+
+  /* Greeting message */
+  puts("Make-a-lisp version 0.0.5\n");
+  puts("Press Ctrl+d to exit\n");
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  /* add not function */
+  /* not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+
+    while (1) {
+
+    /* print prompt and get input*/
+    /* readline allocates memory for input */
+    char* input = readline(PROMPT_STRING);
+
+    /* Check for EOF (Ctrl-D) */
+    if (!input) {
+      printf("\n");
+      return 0;
+    }
+
+    /* add input to history */
+    add_history(input);
+
+    /* call Read-Eval-Print */
+    rep(input, repl_env);
+
+    /* have to release the memory used by readline */
+    free(input);
+  }
+
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  MalType* val = data;
+  return (val->value.mal_symbol);
+}
+
+/* silence the compiler after swap!, apply, and map
+   are added to the core */
+MalType* apply(MalType* ast, Env* env) {
+  return make_nil();
+}

impls/c.2/step6_file.c

@@ -0,0 +1,586 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_DO "do"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+/* declare as global so it can be accessed by mal_eval */
+Env* global_env;
+
+MalType* mal_eval(list args) {
+
+  MalType* ast = args->data;
+  return EVAL(ast, global_env);
+}
+
+int main(int argc, char** argv) {
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  global_env = repl_env;
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  env_set_C_fn(repl_env, "eval", mal_eval);
+
+  /* add functions written in mal - not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+  EVAL(READ("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), repl_env);
+
+
+  /* make command line arguments available in the environment */
+  list lst = NULL;
+  for (int i = 2; i < argc; i++) {
+    lst = list_push(lst, make_string(argv[i]));
+  }
+  env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst)));
+
+  /* run in script mode if a filename is given */
+  if (argc > 1) {
+
+    /* first argument on command line is filename */
+    char* load_command = snprintfbuf(1024, "(load-file \"%s\")", argv[1]);
+    EVAL(READ(load_command), repl_env);
+  }
+  /* run in repl mode when no cmd line args */
+  else {
+
+    /* Greeting message */
+    puts("Make-a-lisp version 0.0.6\n");
+    puts("Press Ctrl+d to exit\n");
+
+    while (1) {
+
+      /* print prompt and get input*/
+      /* readline allocates memory for input */
+      char* input = readline(PROMPT_STRING);
+
+      /* Check for EOF (Ctrl-D) */
+      if (!input) {
+        printf("\n");
+        return 0;
+      }
+
+      /* add input to history */
+      add_history(input);
+
+      /* call Read-Eval-Print */
+      rep(input, repl_env);
+
+      /* have to release the memory used by readline */
+      free(input);
+    }
+  }
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  return (((MalType*)data)->value.mal_symbol);
+}
+
+/* used by core functions but not EVAL as doesn't do TCE */
+MalType* apply(MalType* fn, list args) {
+
+  if (is_function(fn)) {
+
+    MalType* (*fun_ptr)(list) = fn->value.mal_function;
+    return (*fun_ptr)(args);
+  }
+  else { /* is_closure(fn) */
+
+    MalClosure* c = fn->value.mal_closure;
+    list params = (c->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(args);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !c->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+      Env* env = env_make(c->env, params, args, c->more_symbol);
+      return EVAL(fn->value.mal_closure->definition, env);
+    }
+  }
+}

impls/c.2/step7_quote.c

@@ -0,0 +1,788 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_DO "do"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_QUOTE "quote"
+#define SYMBOL_QUASIQUOTE "quasiquote"
+#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
+#define SYMBOL_UNQUOTE "unquote"
+#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+  MalType* eval_quote(MalType* ast);
+  MalType* eval_quasiquote(MalType* ast);
+  MalType* eval_quasiquoteexpand(MalType* ast);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUOTE) == 0) {
+      return eval_quote(ast);
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTE) == 0) {
+
+      ast = eval_quasiquote(ast);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) {
+
+      list lst = ast->value.mal_list;
+      return eval_quasiquote(make_list(lst));
+    }
+  }
+
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+/* declare as global so it can be accessed by mal_eval */
+Env* global_env;
+
+MalType* mal_eval(list args) {
+
+  MalType* ast = args->data;
+  return EVAL(ast, global_env);
+}
+
+int main(int argc, char** argv) {
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  global_env = repl_env;
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  env_set_C_fn(repl_env, "eval", mal_eval);
+
+  /* add functions written in mal - not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+  EVAL(READ("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), repl_env);
+
+
+  /* make command line arguments available in the environment */
+  list lst = NULL;
+  for (long i = 2; i < argc; i++) {
+    lst = list_push(lst, make_string(argv[i]));
+  }
+  env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst)));
+
+  /* run in script mode if a filename is given */
+  if (argc > 1) {
+
+    /* first argument on command line is filename */
+    char* load_command = snprintfbuf(1024, "(load-file \"%s\")", argv[1]);
+    EVAL(READ(load_command), repl_env);
+  }
+  /* run in repl mode when no cmd line args */
+  else {
+
+    /* Greeting message */
+    puts("Make-a-lisp version 0.0.7\n");
+    puts("Press Ctrl+d to exit\n");
+
+    while (1) {
+
+      /* print prompt and get input*/
+      /* readline allocates memory for input */
+      char* input = readline(PROMPT_STRING);
+
+      /* Check for EOF (Ctrl-D) */
+      if (!input) {
+        printf("\n\n");
+        return 0;
+      }
+
+      /* add input to history */
+      add_history(input);
+
+      /* call Read-Eval-Print */
+      rep(input, repl_env);
+
+      /* have to release the memory used by readline */
+      free(input);
+    }
+  }
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+MalType* eval_quote(MalType* ast) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst) {
+    return make_nil();
+  }
+  else if (lst->next) {
+    return make_error("'quote': expected exactly one argument");
+  }
+  else {
+    return lst->data;
+  }
+}
+
+MalType* eval_quasiquote(MalType* ast) {
+
+  /* forward reference */
+  MalType* quasiquote(MalType* ast);
+
+  list lst = ast->value.mal_list;
+
+  /* no arguments (quasiquote) */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* too many arguments */
+  else if (lst->next->next) {
+    return make_error("'quasiquote': expected exactly one argument");
+  }
+  return quasiquote(lst->next->data);
+}
+
+MalType* quasiquote(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+  MalType* quasiquote_vector(MalType* ast);
+
+  /* argument to quasiquote is self-evaluating: (quasiquote val)
+     => val */
+  if (is_self_evaluating(ast)) {
+    return ast;
+  }
+
+  /* argument to quasiquote is a vector: (quasiquote [first rest]) */
+  else if (is_vector(ast)) {
+
+    return quasiquote_vector(ast);
+  }
+
+  /* argument to quasiquote is a list: (quasiquote (first rest)) */
+  else if (is_list(ast)){
+
+    return quasiquote_list(ast);
+  }
+  /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val)
+     => (quote val) */
+  else {
+
+    list lst = list_make(ast);
+    lst = list_push(lst, make_symbol("quote"));
+    return make_list(lst);
+  }
+}
+
+MalType* quasiquote_vector(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+
+  list args = ast->value.mal_list;
+
+  if (args) {
+
+    MalType* first = args->data;
+
+    /* if first element is unquote return quoted */
+    if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0) {
+
+      list lst = list_make(ast);
+      lst = list_push(lst, make_symbol("quote"));
+
+      return make_list(lst);
+    }
+  }
+
+  /* otherwise process like a list */
+
+  list lst = list_make(make_symbol("vec"));
+
+  MalType* result = quasiquote_list(ast);
+
+  if (is_error(result)) {
+    return result;
+  } else {
+    lst = list_push(lst, result);
+  }
+
+  lst = list_reverse(lst);
+  return make_list(lst);
+}
+
+MalType* quasiquote_list(MalType* ast) {
+
+    list args = ast->value.mal_list;
+
+    /* handle empty list: (quasiquote ())
+       => () */
+    if (!args) {
+      return make_list(NULL);
+    }
+
+    MalType* first = args->data;
+
+    /* handle unquote: (quasiquote (unquote second))
+       => second */
+     if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0 && args->next) {
+
+      if (args->next->next) {
+    	return make_error("'quasiquote': unquote expected exactly one argument");
+      }
+      else {
+    	return args->next->data;
+      }
+    }
+
+    /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest))
+       => (concat first-second (quasiquote rest)) */
+    else if (is_list(first) &&
+	     first->value.mal_list != NULL &&
+	     is_symbol(first->value.mal_list->data) &&
+             strcmp(((MalType*)first->value.mal_list->data)->value.mal_symbol, SYMBOL_SPLICE_UNQUOTE) == 0) {
+
+      if (!first->value.mal_list->next) {
+        return make_error("'quasiquote': splice-unquote expected exactly one argument");
+      }
+
+      MalType* first_second = first->value.mal_list->next->data;
+      list lst = list_make(make_symbol("concat"));
+      lst = list_push(lst, first_second);
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      }
+
+      lst = list_push(lst, rest);
+      lst = list_reverse(lst);
+
+      return make_list(lst);
+    }
+    /* handle all other lists recursively: (quasiquote (first rest))
+       => (cons (quasiquote first) (quasiquote rest)) */
+    else {
+
+      list lst = list_make(make_symbol("cons"));
+
+      MalType* first = quasiquote(args->data);
+      if (is_error(first)) {
+        return first;
+      } else {
+        lst = list_push(lst, first);
+      }
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      } else {
+        lst = list_push(lst, rest);
+      }
+
+      lst = list_reverse(lst);
+      return make_list(lst);
+    }
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  return (((MalType*)data)->value.mal_symbol);
+}
+
+/* used by core functions but not EVAL as doesn't do TCE */
+MalType* apply(MalType* fn, list args) {
+
+  if (is_function(fn)) {
+
+    MalType* (*fun_ptr)(list) = fn->value.mal_function;
+    return (*fun_ptr)(args);
+  }
+  else { /* is_closure(fn) */
+
+    MalClosure* c = fn->value.mal_closure;
+    list params = (c->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(args);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !c->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+      Env* env = env_make(c->env, params, args, c->more_symbol);
+      return EVAL(fn->value.mal_closure->definition, env);
+    }
+  }
+}

impls/c.2/step8_macros.c

@@ -0,0 +1,897 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_DO "do"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_QUOTE "quote"
+#define SYMBOL_QUASIQUOTE "quasiquote"
+#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
+#define SYMBOL_UNQUOTE "unquote"
+#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
+#define SYMBOL_DEFMACROBANG "defmacro!"
+#define SYMBOL_MACROEXPAND "macroexpand"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+  MalType* eval_quote(MalType* ast);
+  MalType* eval_quasiquote(MalType* ast);
+  MalType* eval_quasiquoteexpand(MalType* ast);
+  MalType* eval_defmacrobang(MalType*, Env** env);
+  MalType* eval_macroexpand(MalType* ast, Env* env);
+  MalType* macroexpand(MalType* ast, Env* env);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+   /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* macroexpansion */
+  ast = macroexpand(ast, env);
+  if (is_error(ast)) { return ast; }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUOTE) == 0) {
+      return eval_quote(ast);
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTE) == 0) {
+
+      ast = eval_quasiquote(ast);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) {
+
+      list lst = ast->value.mal_list;
+      return eval_quasiquote(make_list(lst));
+    }
+    else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) {
+      return eval_defmacrobang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) {
+      return eval_macroexpand(ast, env);
+    }
+  }
+
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+/* declare as global so it can be accessed by mal_eval */
+Env* global_env;
+
+MalType* mal_eval(list args) {
+
+  MalType* ast = args->data;
+  return EVAL(ast, global_env);
+}
+
+int main(int argc, char** argv) {
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  global_env = repl_env;
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  env_set_C_fn(repl_env, "eval", mal_eval);
+
+  /* add functions written in mal - not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+  EVAL(READ("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), repl_env);
+  EVAL(READ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), repl_env);
+
+  /* make command line arguments available in the environment */
+  list lst = NULL;
+  for (long i = 2; i < argc; i++) {
+    lst = list_push(lst, make_string(argv[i]));
+  }
+  env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst)));
+
+  /* run in script mode if a filename is given */
+  if (argc > 1) {
+
+    /* first argument on command line is filename */
+    char* load_command = snprintfbuf(1024, "(load-file \"%s\")", argv[1]);
+    EVAL(READ(load_command), repl_env);
+  }
+  /* run in repl mode when no cmd line args */
+  else {
+
+    /* Greeting message */
+    puts("Make-a-lisp version 0.0.8\n");
+    puts("Press Ctrl+d to exit\n");
+
+    while (1) {
+
+      /* print prompt and get input*/
+      /* readline allocates memory for input */
+      char* input = readline(PROMPT_STRING);
+
+      /* Check for EOF (Ctrl-D) */
+      if (!input) {
+        printf("\n\n");
+        return 0;
+      }
+
+      /* add input to history */
+      add_history(input);
+
+      /* call Read-Eval-Print */
+      rep(input, repl_env);
+
+      /* have to release the memory used by readline */
+      free(input);
+    }
+  }
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+MalType* eval_quote(MalType* ast) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst) {
+    return make_nil();
+  }
+  else if (lst->next) {
+    return make_error("'quote': expected exactly one argument");
+  }
+  else {
+    return lst->data;
+  }
+}
+
+MalType* eval_quasiquote(MalType* ast) {
+
+  /* forward reference */
+  MalType* quasiquote(MalType* ast);
+
+  list lst = ast->value.mal_list;
+
+  /* no arguments (quasiquote) */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* too many arguments */
+  else if (lst->next->next) {
+    return make_error("'quasiquote': expected exactly one argument");
+  }
+  return quasiquote(lst->next->data);
+}
+
+MalType* quasiquote(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+  MalType* quasiquote_vector(MalType* ast);
+
+  /* argument to quasiquote is self-evaluating: (quasiquote val)
+     => val */
+  if (is_self_evaluating(ast)) {
+    return ast;
+  }
+
+  /* argument to quasiquote is a vector: (quasiquote [first rest]) */
+  else if (is_vector(ast)) {
+
+    return quasiquote_vector(ast);
+  }
+
+  /* argument to quasiquote is a list: (quasiquote (first rest)) */
+  else if (is_list(ast)){
+
+    return quasiquote_list(ast);
+  }
+  /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val)
+     => (quote val) */
+  else {
+
+    list lst = list_make(ast);
+    lst = list_push(lst, make_symbol("quote"));
+    return make_list(lst);
+  }
+}
+
+MalType* quasiquote_vector(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+
+  list args = ast->value.mal_list;
+
+  if (args) {
+
+    MalType* first = args->data;
+
+    /* if first element is unquote return quoted */
+    if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0) {
+
+      list lst = list_make(ast);
+      lst = list_push(lst, make_symbol("quote"));
+
+      return make_list(lst);
+    }
+  }
+
+  /* otherwise process like a list */
+
+  list lst = list_make(make_symbol("vec"));
+
+  MalType* result = quasiquote_list(ast);
+
+  if (is_error(result)) {
+    return result;
+  } else {
+    lst = list_push(lst, result);
+  }
+
+  lst = list_reverse(lst);
+  return make_list(lst);
+}
+
+MalType* quasiquote_list(MalType* ast) {
+
+    list args = ast->value.mal_list;
+
+    /* handle empty list: (quasiquote ())
+       => () */
+    if (!args) {
+      return make_list(NULL);
+    }
+
+    MalType* first = args->data;
+
+    /* handle unquote: (quasiquote (unquote second))
+       => second */
+     if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0 && args->next) {
+
+      if (args->next->next) {
+    	return make_error("'quasiquote': unquote expected exactly one argument");
+      }
+      else {
+    	return args->next->data;
+      }
+    }
+
+    /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest))
+       => (concat first-second (quasiquote rest)) */
+    else if (is_list(first) &&
+	     first->value.mal_list != NULL &&
+	     is_symbol(first->value.mal_list->data) &&
+             strcmp(((MalType*)first->value.mal_list->data)->value.mal_symbol, SYMBOL_SPLICE_UNQUOTE) == 0) {
+
+      if (!first->value.mal_list->next) {
+        return make_error("'quasiquote': splice-unquote expected exactly one argument");
+      }
+
+      MalType* first_second = first->value.mal_list->next->data;
+      list lst = list_make(make_symbol("concat"));
+      lst = list_push(lst, first_second);
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      }
+
+      lst = list_push(lst, rest);
+      lst = list_reverse(lst);
+
+      return make_list(lst);
+    }
+    /* handle all other lists recursively: (quasiquote (first rest))
+       => (cons (quasiquote first) (quasiquote rest)) */
+    else {
+
+      list lst = list_make(make_symbol("cons"));
+
+      MalType* first = quasiquote(args->data);
+      if (is_error(first)) {
+        return first;
+      } else {
+        lst = list_push(lst, first);
+      }
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      } else {
+        lst = list_push(lst, rest);
+      }
+
+      lst = list_reverse(lst);
+      return make_list(lst);
+    }
+}
+
+MalType* eval_defmacrobang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'defmacro!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'defmacro!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)) {
+    result = copy_type(result);
+    result->is_macro = 1;
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+MalType* eval_macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* macroexpand(MalType* ast, Env* env);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_nil();
+  }
+  else if (lst->next->next) {
+    return make_error("'macroexpand': expected exactly one argument");
+  }
+  else {
+    return macroexpand(lst->next->data, env);
+  }
+}
+
+MalType* macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  int is_macro_call(MalType* ast, Env* env);
+
+  while(is_macro_call(ast, env)) {
+
+    list lst = ast->value.mal_list;
+
+    MalType* macro_fn = env_get(env, lst->data);
+    MalClosure* cls = macro_fn->value.mal_closure;
+    MalType* more_symbol = cls->more_symbol;
+
+    list params_list = (cls->parameters)->value.mal_list;
+    list args_list = lst->next;
+
+    env = env_make(cls->env, params_list, args_list, more_symbol);
+    ast = EVAL(cls->definition, env);
+  }
+  return ast;
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  return (((MalType*)data)->value.mal_symbol);
+}
+
+/* used by core functions but not EVAL as doesn't do TCE */
+MalType* apply(MalType* fn, list args) {
+
+  if (is_function(fn)) {
+
+    MalType* (*fun_ptr)(list) = fn->value.mal_function;
+    return (*fun_ptr)(args);
+  }
+  else { /* is_closure(fn) */
+
+    MalClosure* c = fn->value.mal_closure;
+    list params = (c->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(args);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !c->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+      Env* env = env_make(c->env, params, args, c->more_symbol);
+      return EVAL(fn->value.mal_closure->definition, env);
+    }
+  }
+}
+
+int is_macro_call(MalType* ast, Env* env) {
+
+  /* not a list */
+  if (!is_list(ast)) {
+    return 0;
+  }
+
+  /* empty list */
+  list lst = ast->value.mal_list;
+  if (!lst) {
+    return 0;
+  }
+
+  /* first item not a symbol */
+  MalType* first = lst->data;
+  if (!is_symbol(first)) {
+    return 0;
+  }
+
+  /* lookup symbol */
+  MalType* val = env_get(env, first);
+  if (is_error(val)) {
+    return 0;
+  }
+  else {
+    return (val->is_macro);
+  }
+}

impls/c.2/step9_try.c

@@ -0,0 +1,968 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_DO "do"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_QUOTE "quote"
+#define SYMBOL_QUASIQUOTE "quasiquote"
+#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
+#define SYMBOL_UNQUOTE "unquote"
+#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
+#define SYMBOL_DEFMACROBANG "defmacro!"
+#define SYMBOL_MACROEXPAND "macroexpand"
+#define SYMBOL_TRYSTAR "try*"
+#define SYMBOL_CATCHSTAR "catch*"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+  MalType* eval_quote(MalType* ast);
+  MalType* eval_quasiquote(MalType* ast);
+  MalType* eval_quasiquoteexpand(MalType* ast);
+  MalType* eval_defmacrobang(MalType*, Env** env);
+  MalType* eval_macroexpand(MalType* ast, Env* env);
+  MalType* macroexpand(MalType* ast, Env* env);
+  void eval_try(MalType** ast, Env** env);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* macroexpansion */
+  ast = macroexpand(ast, env);
+  if (is_error(ast)) { return ast; }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUOTE) == 0) {
+      return eval_quote(ast);
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTE) == 0) {
+
+      ast = eval_quasiquote(ast);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) {
+
+      list lst = ast->value.mal_list;
+      return eval_quasiquote(make_list(lst));
+    }
+    else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) {
+      return eval_defmacrobang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) {
+      return eval_macroexpand(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_try(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+/* declare as global so it can be accessed by mal_eval */
+Env* global_env;
+
+MalType* mal_eval(list args) {
+
+  MalType* ast = args->data;
+  return EVAL(ast, global_env);
+}
+
+
+int main(int argc, char** argv) {
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  global_env = repl_env;
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  env_set_C_fn(repl_env, "eval", mal_eval);
+
+  /* add functions written in mal - not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+  EVAL(READ("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), repl_env);
+  EVAL(READ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), repl_env);
+
+  /* make command line arguments available in the environment */
+  list lst = NULL;
+  for (long i = 2; i < argc; i++) {
+    lst = list_push(lst, make_string(argv[i]));
+  }
+  env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst)));
+
+  /* run in script mode if a filename is given */
+  if (argc > 1) {
+
+    /* first argument on command line is filename */
+    char* load_command = snprintfbuf(1024, "(load-file \"%s\")", argv[1]);
+    EVAL(READ(load_command), repl_env);
+  }
+  /* run in repl mode when no cmd line args */
+  else {
+
+    /* Greeting message */
+    puts("Make-a-lisp version 0.0.9\n");
+    puts("Press Ctrl+d to exit\n");
+
+    while (1) {
+
+      /* print prompt and get input*/
+      /* readline allocates memory for input */
+      char* input = readline(PROMPT_STRING);
+
+      /* Check for EOF (Ctrl-D) */
+      if (!input) {
+        printf("\n");
+        return 0;
+      }
+
+      /* add input to history */
+      add_history(input);
+
+      /* call Read-Eval-Print */
+      rep(input, repl_env);
+
+      /* have to release the memory used by readline */
+      free(input);
+    }
+  }
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+MalType* eval_quote(MalType* ast) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst) {
+    return make_nil();
+  }
+  else if (lst->next) {
+    return make_error("'quote': expected exactly one argument");
+  }
+  else {
+    return lst->data;
+  }
+}
+
+MalType* eval_quasiquote(MalType* ast) {
+
+  /* forward reference */
+  MalType* quasiquote(MalType* ast);
+
+  list lst = ast->value.mal_list;
+
+  /* no arguments (quasiquote) */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* too many arguments */
+  else if (lst->next->next) {
+    return make_error("'quasiquote': expected exactly one argument");
+  }
+  return quasiquote(lst->next->data);
+}
+
+MalType* quasiquote(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+  MalType* quasiquote_vector(MalType* ast);
+
+  /* argument to quasiquote is self-evaluating: (quasiquote val)
+     => val */
+  if (is_self_evaluating(ast)) {
+    return ast;
+  }
+
+  /* argument to quasiquote is a vector: (quasiquote [first rest]) */
+  else if (is_vector(ast)) {
+
+    return quasiquote_vector(ast);
+  }
+
+  /* argument to quasiquote is a list: (quasiquote (first rest)) */
+  else if (is_list(ast)){
+
+    return quasiquote_list(ast);
+  }
+  /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val)
+     => (quote val) */
+  else {
+
+    list lst = list_make(ast);
+    lst = list_push(lst, make_symbol("quote"));
+    return make_list(lst);
+  }
+}
+
+MalType* quasiquote_vector(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+
+  list args = ast->value.mal_list;
+
+  if (args) {
+
+    MalType* first = args->data;
+
+    /* if first element is unquote return quoted */
+    if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0) {
+
+      list lst = list_make(ast);
+      lst = list_push(lst, make_symbol("quote"));
+
+      return make_list(lst);
+    }
+  }
+
+  /* otherwise process like a list */
+
+  list lst = list_make(make_symbol("vec"));
+
+  MalType* result = quasiquote_list(ast);
+
+  if (is_error(result)) {
+    return result;
+  } else {
+    lst = list_push(lst, result);
+  }
+
+  lst = list_reverse(lst);
+  return make_list(lst);
+}
+
+MalType* quasiquote_list(MalType* ast) {
+
+    list args = ast->value.mal_list;
+
+    /* handle empty list: (quasiquote ())
+       => () */
+    if (!args) {
+      return make_list(NULL);
+    }
+
+    MalType* first = args->data;
+
+    /* handle unquote: (quasiquote (unquote second))
+       => second */
+     if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0 && args->next) {
+
+      if (args->next->next) {
+    	return make_error("'quasiquote': unquote expected exactly one argument");
+      }
+      else {
+    	return args->next->data;
+      }
+    }
+
+    /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest))
+       => (concat first-second (quasiquote rest)) */
+    else if (is_list(first) &&
+	     first->value.mal_list != NULL &&
+	     is_symbol(first->value.mal_list->data) &&
+             strcmp(((MalType*)first->value.mal_list->data)->value.mal_symbol, SYMBOL_SPLICE_UNQUOTE) == 0) {
+
+      if (!first->value.mal_list->next) {
+        return make_error("'quasiquote': splice-unquote expected exactly one argument");
+      }
+
+      MalType* first_second = first->value.mal_list->next->data;
+      list lst = list_make(make_symbol("concat"));
+      lst = list_push(lst, first_second);
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      }
+
+      lst = list_push(lst, rest);
+      lst = list_reverse(lst);
+
+      return make_list(lst);
+    }
+    /* handle all other lists recursively: (quasiquote (first rest))
+       => (cons (quasiquote first) (quasiquote rest)) */
+    else {
+
+      list lst = list_make(make_symbol("cons"));
+
+      MalType* first = quasiquote(args->data);
+      if (is_error(first)) {
+        return first;
+      } else {
+        lst = list_push(lst, first);
+      }
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      } else {
+        lst = list_push(lst, rest);
+      }
+
+      lst = list_reverse(lst);
+      return make_list(lst);
+    }
+}
+
+MalType* eval_defmacrobang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'defmacro!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'defmacro!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)) {
+    result = copy_type(result);
+    result->is_macro = 1;
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+MalType* eval_macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* macroexpand(MalType* ast, Env* env);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_nil();
+  }
+  else if (lst->next->next) {
+    return make_error("'macroexpand': expected exactly one argument");
+  }
+  else {
+    return macroexpand(lst->next->data, env);
+  }
+}
+
+MalType* macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  int is_macro_call(MalType* ast, Env* env);
+
+  while(is_macro_call(ast, env)) {
+
+    list lst = ast->value.mal_list;
+
+    MalType* macro_fn = env_get(env, lst->data);
+    MalClosure* cls = macro_fn->value.mal_closure;
+    MalType* more_symbol = cls->more_symbol;
+
+    list params_list = (cls->parameters)->value.mal_list;
+    list args_list = lst->next;
+
+    env = env_make(cls->env, params_list, args_list, more_symbol);
+    ast = EVAL(cls->definition, env);
+  }
+  return ast;
+}
+
+void eval_try(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_nil();
+    return;
+  }
+
+  if (lst->next->next && lst->next->next->next) {
+    *ast = make_error("'try*': expected maximum of two arguments");
+    return;
+  }
+
+  MalType* try_clause = lst->next->data;
+  MalType* try_result = EVAL(try_clause, *env);
+
+  /* no catch* clause */
+  if (!is_error(try_result) || !lst->next->next) {
+    *ast = try_result;
+    return;
+  }
+
+  /* process catch* clause */
+  MalType* catch_clause = lst->next->next->data;
+  list catch_list = catch_clause->value.mal_list;
+
+  if (!catch_list) {
+    *ast = make_error("'try*': catch* clause is empty");
+    return;
+  }
+
+  MalType* catch_symbol = catch_list->data;
+  if (strcmp(catch_symbol->value.mal_symbol, SYMBOL_CATCHSTAR) != 0) {
+    *ast = make_error("Error: catch clause is missing catch* symbol");
+    return;
+  }
+
+  if (!catch_list->next || !catch_list->next->next) {
+    *ast = make_error("Error: catch* clause expected two arguments");
+    return;
+  }
+
+  if (!is_symbol(catch_list->next->data)) {
+    *ast = make_error("Error: catch* clause expected a symbol");
+    return;
+  }
+
+  /* bind the symbol to the exception */
+  list symbol_list = list_make(catch_list->next->data);
+  list expr_list = list_make(try_result->value.mal_error);
+
+  /* TODO: validate symbols and exprs match before calling env_make */
+  Env* catch_env = env_make(*env, symbol_list, expr_list, NULL);
+  *ast = catch_list->next->next->data;
+  *env = catch_env;
+
+  return;
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        /* TODO: check symbol is no a duplicate of one already on the list */
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  return (((MalType*)data)->value.mal_symbol);
+}
+
+/* used by core functions but not EVAL as doesn't do TCE */
+MalType* apply(MalType* fn, list args) {
+
+  if (is_function(fn)) {
+
+    MalType* (*fun_ptr)(list) = fn->value.mal_function;
+    return (*fun_ptr)(args);
+  }
+  else { /* is_closure(fn) */
+
+    MalClosure* c = fn->value.mal_closure;
+    list params = (c->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(args);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !c->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+      Env* env = env_make(c->env, params, args, c->more_symbol);
+      return EVAL(fn->value.mal_closure->definition, env);
+    }
+  }
+}
+
+int is_macro_call(MalType* ast, Env* env) {
+
+  /* not a list */
+  if (!is_list(ast)) {
+    return 0;
+  }
+
+  /* empty list */
+  list lst = ast->value.mal_list;
+  if (!lst) {
+    return 0;
+  }
+
+  /* first item not a symbol */
+  MalType* first = lst->data;
+  if (!is_symbol(first)) {
+    return 0;
+  }
+
+  /* lookup symbol */
+  MalType* val = env_get(env, first);
+  if (is_error(val)) {
+    return 0;
+  }
+  else {
+    return (val->is_macro);
+  }
+}

impls/c.2/stepA_mal.c

@@ -0,0 +1,992 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <gc.h>
+
+#include <editline/readline.h>
+#include <editline/history.h>
+
+#include "types.h"
+#include "reader.h"
+#include "printer.h"
+#include "env.h"
+#include "core.h"
+
+#define SYMBOL_DEFBANG "def!"
+#define SYMBOL_LETSTAR "let*"
+#define SYMBOL_DO "do"
+#define SYMBOL_IF "if"
+#define SYMBOL_FNSTAR "fn*"
+#define SYMBOL_QUOTE "quote"
+#define SYMBOL_QUASIQUOTE "quasiquote"
+#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
+#define SYMBOL_UNQUOTE "unquote"
+#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
+#define SYMBOL_DEFMACROBANG "defmacro!"
+#define SYMBOL_MACROEXPAND "macroexpand"
+#define SYMBOL_TRYSTAR "try*"
+#define SYMBOL_CATCHSTAR "catch*"
+
+#define PROMPT_STRING "user> "
+
+MalType* READ(char* str) {
+
+  return read_str(str);
+}
+
+MalType* EVAL(MalType* ast, Env* env) {
+
+  /* forward references */
+  MalType* eval_ast(MalType* ast, Env* env);
+  MalType* eval_defbang(MalType* ast, Env** env);
+  void eval_letstar(MalType** ast, Env** env);
+  void eval_if(MalType** ast, Env** env);
+  MalType* eval_fnstar(MalType* ast, Env* env);
+  MalType* eval_do(MalType* ast, Env* env);
+  MalType* eval_quote(MalType* ast);
+  MalType* eval_quasiquote(MalType* ast);
+  MalType* eval_quasiquoteexpand(MalType* ast);
+  MalType* eval_defmacrobang(MalType*, Env** env);
+  MalType* eval_macroexpand(MalType* ast, Env* env);
+  MalType* macroexpand(MalType* ast, Env* env);
+  void eval_try(MalType** ast, Env** env);
+
+  /* Use goto to jump here rather than calling eval for tail-call elimination */
+ TCE_entry_point:
+
+  /* NULL */
+  if (!ast) { return make_nil(); }
+
+  /* macroexpansion */
+  ast = macroexpand(ast, env);
+  if (is_error(ast)) { return ast; }
+
+  /* not a list */
+  if (!is_list(ast)) { return eval_ast(ast, env); }
+
+  /* empty list */
+  if (ast->value.mal_list == NULL) { return ast; }
+
+  /* list */
+  MalType* first = (ast->value.mal_list)->data;
+  char* symbol = first->value.mal_symbol;
+
+  if (is_symbol(first)) {
+
+    /* handle special symbols first */
+    if (strcmp(symbol, SYMBOL_DEFBANG) == 0) {
+      return eval_defbang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_LETSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_letstar(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_IF) == 0) {
+
+      /* TCE - modify ast directly and jump back to eval */
+      eval_if(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_FNSTAR) == 0) {
+      return eval_fnstar(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_DO) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      ast = eval_do(ast, env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUOTE) == 0) {
+      return eval_quote(ast);
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTE) == 0) {
+
+      ast = eval_quasiquote(ast);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+    else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) {
+
+      list lst = ast->value.mal_list;
+      return eval_quasiquote(make_list(lst));
+    }
+    else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) {
+      return eval_defmacrobang(ast, &env);
+    }
+    else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) {
+      return eval_macroexpand(ast, env);
+    }
+    else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      eval_try(&ast, &env);
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  /* first element is not a special symbol */
+  MalType* evaluated_list = eval_ast(ast, env);
+
+  if (is_error(evaluated_list)) { return evaluated_list; }
+
+  /* apply the first element of the list to the arguments */
+  list evlst = evaluated_list->value.mal_list;
+  MalType* func = evlst->data;
+
+  if (is_function(func)) {
+    return (*func->value.mal_function)(evlst->next);
+  }
+  else if (is_closure(func)) {
+
+    MalClosure* closure = func->value.mal_closure;
+    list params = (closure->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(evlst->next);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !closure->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+
+      /* TCE - modify ast and env directly and jump back to eval */
+      env = env_make(closure->env, params, evlst->next, closure->more_symbol);
+      ast = func->value.mal_closure->definition;
+
+      if (is_error(ast)) { return ast; }
+      goto TCE_entry_point;
+    }
+  }
+  else {
+    return make_error_fmt("first item in list is not callable: '%s'",   \
+                          pr_str(func, UNREADABLY));
+  }
+}
+
+void PRINT(MalType* val) {
+
+  char* output = pr_str(val, READABLY);
+  printf("%s\n", output);
+}
+
+void rep(char* str, Env* env) {
+
+  PRINT(EVAL(READ(str), env));
+}
+
+/* declare as global so it can be accessed by mal_eval */
+Env* global_env;
+
+MalType* mal_eval(list args) {
+
+  MalType* ast = args->data;
+  return EVAL(ast, global_env);
+}
+
+MalType* mal_readline(list args) {
+
+  if (!args || args->next) {
+    return make_error("'readline': expected exactly one argument");
+  }
+
+  MalType* prompt = args->data;
+
+  if (!is_string(prompt)) {
+    return make_error_fmt("'readline': argument is not a string '%s'", \
+                          pr_str(prompt, UNREADABLY));
+  }
+
+  char* str = readline(prompt->value.mal_string);
+
+  if (str) {
+    add_history(str);
+    return make_string(str);
+  }
+  else {
+    return make_nil();
+  }
+}
+
+int main(int argc, char** argv) {
+
+  Env* repl_env = env_make(NULL, NULL, NULL, NULL);
+  global_env = repl_env;
+
+  ns* core = ns_make_core();
+  hashmap mappings = core->mappings;
+
+  while (mappings) {
+    char* symbol = mappings->data;
+    MalType*(*function)(list) = mappings->next->data;
+
+    env_set_C_fn(repl_env, symbol, function);
+
+    /* pop symbol and function from hashmap/list */
+    mappings = mappings->next->next;
+  }
+
+  env_set_C_fn(repl_env, "eval", mal_eval);
+  env_set_C_fn(repl_env, "readline", mal_readline);
+
+  /* add functions written in mal - not using rep as it prints the result */
+  EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env);
+  EVAL(READ("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), repl_env);
+  EVAL(READ("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"), repl_env);
+
+  /* make command line arguments available in the environment */
+  list lst = NULL;
+  for (long i = 2; i < argc; i++) {
+    lst = list_push(lst, make_string(argv[i]));
+  }
+  env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst)));
+  env_set(repl_env, make_symbol("*host-language*"), make_string("c.2"));
+
+  /* run in script mode if a filename is given */
+  if (argc > 1) {
+
+    /* first argument on command line is filename */
+    char* load_command = snprintfbuf(1024, "(load-file \"%s\")", argv[1]);
+    EVAL(READ(load_command), repl_env);
+  }
+  /* run in repl mode when no cmd line args */
+  else {
+
+    /* Greeting message */
+    EVAL(READ("(println (str \"Mal [\" *host-language* \"]\"))"), repl_env);
+
+    while (1) {
+
+      /* print prompt and get input*/
+      /* readline allocates memory for input */
+      char* input = readline(PROMPT_STRING);
+
+      /* Check for EOF (Ctrl-D) */
+      if (!input) {
+        printf("\n");
+        return 0;
+      }
+
+      /* add input to history */
+      add_history(input);
+
+      /* call Read-Eval-Print */
+      rep(input, repl_env);
+
+      /* have to release the memory used by readline */
+      free(input);
+    }
+  }
+  return 0;
+}
+
+MalType* eval_ast(MalType* ast, Env* env) {
+
+  /* forward references */
+  list evaluate_list(list lst, Env* env);
+  list evaluate_vector(list lst, Env* env);
+  list evaluate_hashmap(list lst, Env* env);
+
+  if (is_symbol(ast)) {
+
+    MalType* symbol_value = env_get(env, ast);
+
+    if (symbol_value) {
+      return symbol_value;
+    } else {
+      return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY));
+    }
+  }
+  else if (is_list(ast)) {
+
+    list result = evaluate_list(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_list(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_vector(ast)) {
+
+    list result = evaluate_vector(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+        return make_vector(result);
+    } else {
+      return result->data;
+    }
+  }
+  else if (is_hashmap(ast)) {
+
+    list result = evaluate_hashmap(ast->value.mal_list, env);
+
+    if (!result || !is_error(result->data)) {
+      return make_hashmap(result);
+    } else {
+      return result->data;
+    }
+  }
+  else {
+    return ast;
+  }
+}
+
+MalType* eval_defbang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'def!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'def!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)){
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+void eval_letstar(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_error("'let*': missing bindings list");
+    return;
+  }
+
+  MalType* bindings = lst->next->data;
+  MalType* forms = lst->next->next ? lst->next->next->data : make_nil();
+
+  if (!is_sequential(bindings)) {
+    *ast = make_error("'let*': first argument is not list or vector");
+    return;
+  }
+
+  list bindings_list = bindings->value.mal_list;
+  if (list_count(bindings_list) % 2 == 1) {
+    *ast = make_error("'let*': expected an even number of binding pairs");
+    return;
+  }
+
+  Env* letstar_env = env_make(*env, NULL, NULL, NULL);
+
+  /* evaluate the bindings */
+  while(bindings_list) {
+
+    MalType* symbol = bindings_list->data;
+    MalType* value = EVAL(bindings_list->next->data, letstar_env);
+
+    /* early return from error */
+    if (is_error(value)) {
+      *ast = value;
+      return;
+    }
+
+    env_set(letstar_env, symbol, value);
+    bindings_list = bindings_list->next->next;
+  }
+
+  *env = letstar_env;
+  *ast = forms;
+  return;
+}
+
+void eval_if(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next || !lst->next->next) {
+    *ast = make_error("'if': too few arguments");
+    return;
+  }
+
+  if (lst->next->next->next && lst->next->next->next->next) {
+    *ast = make_error("'if': too many arguments");
+    return;
+  }
+
+  MalType* condition = EVAL(lst->next->data, *env);
+
+  if (is_error(condition)) {
+    *ast = condition;
+    return;
+  }
+
+  if (is_false(condition) || is_nil(condition)) {
+
+    /* check whether false branch is present */
+    if (lst->next->next->next) {
+      *ast = lst->next->next->next->data;
+      return;
+    }
+    else {
+      *ast = make_nil();
+      return;
+    }
+
+  } else {
+    *ast = lst->next->next->data;
+    return;
+  }
+}
+
+MalType* eval_fnstar(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* regularise_parameters(list* params, MalType** more);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_error("'fn*': missing argument list");
+  }
+  else if (!lst->next->next) {
+    return make_error("'fn*': missing function body");
+  }
+
+  MalType* params = lst->next->data;
+  list params_list = params->value.mal_list;
+
+  MalType* more_symbol = NULL;
+
+  MalType* result = regularise_parameters(&params_list, &more_symbol);
+  if (is_error(result)) { return result; }
+
+  MalType* definition = lst->next->next->data;
+  MalType* regular_params = make_list(params_list);
+
+  return make_closure(env, regular_params, definition, more_symbol);
+}
+
+MalType* eval_do(MalType* ast, Env* env) {
+
+  list lst = ast->value.mal_list;
+
+  /* handle empty 'do' */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* evaluate all but the last form */
+  lst = lst->next;
+  while (lst->next) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    /* return error early */
+    if (is_error(val)) {
+      return val;
+    }
+    lst = lst->next;
+  }
+  /* return the last form for TCE evaluation */
+  return lst->data;
+}
+
+MalType* eval_quote(MalType* ast) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst) {
+    return make_nil();
+  }
+  else if (lst->next) {
+    return make_error("'quote': expected exactly one argument");
+  }
+  else {
+    return lst->data;
+  }
+}
+
+MalType* eval_quasiquote(MalType* ast) {
+
+  /* forward reference */
+  MalType* quasiquote(MalType* ast);
+
+  list lst = ast->value.mal_list;
+
+  /* no arguments (quasiquote) */
+  if (!lst->next) {
+    return make_nil();
+  }
+
+  /* too many arguments */
+  else if (lst->next->next) {
+    return make_error("'quasiquote': expected exactly one argument");
+  }
+  return quasiquote(lst->next->data);
+}
+
+MalType* quasiquote(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+  MalType* quasiquote_vector(MalType* ast);
+
+  /* argument to quasiquote is self-evaluating: (quasiquote val)
+     => val */
+  if (is_self_evaluating(ast)) {
+    return ast;
+  }
+
+  /* argument to quasiquote is a vector: (quasiquote [first rest]) */
+  else if (is_vector(ast)) {
+
+    return quasiquote_vector(ast);
+  }
+
+  /* argument to quasiquote is a list: (quasiquote (first rest)) */
+  else if (is_list(ast)){
+
+    return quasiquote_list(ast);
+  }
+  /* argument to quasiquote is not self-evaluating and isn't sequential: (quasiquote val)
+     => (quote val) */
+  else {
+
+    list lst = list_make(ast);
+    lst = list_push(lst, make_symbol("quote"));
+    return make_list(lst);
+  }
+}
+
+MalType* quasiquote_vector(MalType* ast) {
+
+  /* forward references */
+  MalType* quasiquote_list(MalType* ast);
+
+  list args = ast->value.mal_list;
+
+  if (args) {
+
+    MalType* first = args->data;
+
+    /* if first element is unquote return quoted */
+    if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0) {
+
+      list lst = list_make(ast);
+      lst = list_push(lst, make_symbol("quote"));
+
+      return make_list(lst);
+    }
+  }
+
+  /* otherwise process like a list */
+
+  list lst = list_make(make_symbol("vec"));
+
+  MalType* result = quasiquote_list(ast);
+
+  if (is_error(result)) {
+    return result;
+  } else {
+    lst = list_push(lst, result);
+  }
+
+  lst = list_reverse(lst);
+  return make_list(lst);
+}
+
+MalType* quasiquote_list(MalType* ast) {
+
+    list args = ast->value.mal_list;
+
+    /* handle empty list: (quasiquote ())
+       => () */
+    if (!args) {
+      return make_list(NULL);
+    }
+
+    MalType* first = args->data;
+
+    /* handle unquote: (quasiquote (unquote second))
+       => second */
+     if (is_symbol(first) && strcmp(first->value.mal_symbol, SYMBOL_UNQUOTE) == 0 && args->next) {
+
+      if (args->next->next) {
+    	return make_error("'quasiquote': unquote expected exactly one argument");
+      }
+      else {
+    	return args->next->data;
+      }
+    }
+
+    /* handle splice-unquote: (quasiquote ((splice-unquote first-second) rest))
+       => (concat first-second (quasiquote rest)) */
+    else if (is_list(first) &&
+	     first->value.mal_list != NULL &&
+	     is_symbol(first->value.mal_list->data) &&
+             strcmp(((MalType*)first->value.mal_list->data)->value.mal_symbol, SYMBOL_SPLICE_UNQUOTE) == 0) {
+
+      if (!first->value.mal_list->next) {
+        return make_error("'quasiquote': splice-unquote expected exactly one argument");
+      }
+
+      MalType* first_second = first->value.mal_list->next->data;
+      list lst = list_make(make_symbol("concat"));
+      lst = list_push(lst, first_second);
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      }
+
+      lst = list_push(lst, rest);
+      lst = list_reverse(lst);
+
+      return make_list(lst);
+    }
+    /* handle all other lists recursively: (quasiquote (first rest))
+       => (cons (quasiquote first) (quasiquote rest)) */
+    else {
+
+      list lst = list_make(make_symbol("cons"));
+
+      MalType* first = quasiquote(args->data);
+      if (is_error(first)) {
+        return first;
+      } else {
+        lst = list_push(lst, first);
+      }
+
+      MalType* rest = quasiquote(make_list(args->next));
+      if (is_error(rest)) {
+        return rest;
+      } else {
+        lst = list_push(lst, rest);
+      }
+
+      lst = list_reverse(lst);
+      return make_list(lst);
+    }
+}
+
+MalType* eval_defmacrobang(MalType* ast, Env** env) {
+
+  list lst = (ast->value.mal_list)->next;
+
+  if (!lst || !lst->next || lst->next->next) {
+    return make_error_fmt("'defmacro!': expected exactly two arguments");
+  }
+
+  MalType* defbang_symbol = lst->data;
+
+  if (!is_symbol(defbang_symbol)) {
+    return make_error_fmt("'defmacro!': expected symbol for first argument");
+  }
+
+  MalType* defbang_value = lst->next->data;
+  MalType* result = EVAL(defbang_value, *env);
+
+  if (!is_error(result)) {
+    result = copy_type(result);
+    result->is_macro = 1;
+    *env = env_set(*env, defbang_symbol, result);
+  }
+  return result;
+}
+
+MalType* eval_macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  MalType* macroexpand(MalType* ast, Env* env);
+
+  list lst = ast->value.mal_list;
+
+  if (!lst->next) {
+    return make_nil();
+  }
+  else if (lst->next->next) {
+    return make_error("'macroexpand': expected exactly one argument");
+  }
+  else {
+    return macroexpand(lst->next->data, env);
+  }
+}
+
+MalType* macroexpand(MalType* ast, Env* env) {
+
+  /* forward reference */
+  int is_macro_call(MalType* ast, Env* env);
+
+  while(is_macro_call(ast, env)) {
+
+    list lst = ast->value.mal_list;
+
+    MalType* macro_fn = env_get(env, lst->data);
+    MalClosure* cls = macro_fn->value.mal_closure;
+    MalType* more_symbol = cls->more_symbol;
+
+    list params_list = (cls->parameters)->value.mal_list;
+    list args_list = lst->next;
+
+    env = env_make(cls->env, params_list, args_list, more_symbol);
+    ast = EVAL(cls->definition, env);
+  }
+  return ast;
+}
+
+void eval_try(MalType** ast, Env** env) {
+
+  list lst = (*ast)->value.mal_list;
+
+  if (!lst->next) {
+    *ast = make_nil();
+    return;
+  }
+
+  if (lst->next->next && lst->next->next->next) {
+    *ast = make_error("'try*': expected maximum of two arguments");
+    return;
+  }
+
+  MalType* try_clause = lst->next->data;
+  MalType* try_result = EVAL(try_clause, *env);
+
+  /* no catch* clause */
+  if (!is_error(try_result) || !lst->next->next) {
+    *ast = try_result;
+    return;
+  }
+
+  /* process catch* clause */
+  MalType* catch_clause = lst->next->next->data;
+  list catch_list = catch_clause->value.mal_list;
+
+  if (!catch_list) {
+    *ast = make_error("'try*': catch* clause is empty");
+    return;
+  }
+
+  MalType* catch_symbol = catch_list->data;
+  if (strcmp(catch_symbol->value.mal_symbol, SYMBOL_CATCHSTAR) != 0) {
+    *ast = make_error("Error: catch clause is missing catch* symbol");
+    return;
+  }
+
+  if (!catch_list->next || !catch_list->next->next) {
+    *ast = make_error("Error: catch* clause expected two arguments");
+    return;
+  }
+
+  if (!is_symbol(catch_list->next->data)) {
+    *ast = make_error("Error: catch* clause expected a symbol");
+    return;
+  }
+
+  /* bind the symbol to the exception */
+  list symbol_list = list_make(catch_list->next->data);
+  list expr_list = list_make(try_result->value.mal_error);
+
+  Env* catch_env = env_make(*env, symbol_list, expr_list, NULL);
+  *ast = catch_list->next->next->data;
+  *env = catch_env;
+
+  return;
+}
+
+list evaluate_list(list lst, Env* env) {
+
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_vector(list lst, Env* env) {
+  /* TODO: implement a real vector */
+  list evlst = NULL;
+  while (lst) {
+
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+list evaluate_hashmap(list lst, Env* env) {
+  /* TODO: implement a real hashmap */
+  list evlst = NULL;
+  while (lst) {
+
+    /* keys are unevaluated */
+    evlst = list_push(evlst, lst->data);
+    lst = lst->next;
+
+    /* values are evaluated */
+    MalType* val = EVAL(lst->data, env);
+
+    if (is_error(val)) {
+      return list_make(val);
+    }
+
+    evlst = list_push(evlst, val);
+    lst = lst->next;
+  }
+  return list_reverse(evlst);
+}
+
+MalType* regularise_parameters(list* args, MalType** more_symbol) {
+
+  /* forward reference */
+  char* symbol_fn(gptr data);
+
+  list regular_args = NULL;
+  while (*args) {
+
+    MalType* val = (*args)->data;
+
+    if (!is_symbol(val)) {
+      return make_error_fmt("non-symbol found in fn argument list '%s'", \
+                            pr_str(val, UNREADABLY));
+    }
+
+    if (val->value.mal_symbol[0] == '&') {
+
+      /* & is found but there is no symbol */
+      if (val->value.mal_symbol[1] == '\0' && !(*args)->next) {
+        return make_error("missing symbol after '&' in argument list");
+      }
+      /* & is found and there is a single symbol after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next &&
+                is_symbol((*args)->next->data) && !(*args)->next->next)) {
+
+        *more_symbol = (*args)->next->data;
+        break;
+      }
+      /* & is found and there extra symbols after */
+      else if ((val->value.mal_symbol[1] == '\0' && (*args)->next && (*args)->next->next)) {
+        return make_error_fmt("unexpected symbol after '& %s' in argument list: '%s'", \
+                              pr_str((*args)->next->data, UNREADABLY),  \
+                              pr_str((*args)->next->next->data, UNREADABLY));
+      }
+      /* & is found as part of the symbol and no other symbols */
+      else if (val->value.mal_symbol[1] != '\0' && !(*args)->next) {
+        *more_symbol = make_symbol((val->value.mal_symbol + 1));
+        break;
+      }
+      /* & is found as part of the symbol but there are other symbols after */
+      else if (val->value.mal_symbol[1] != '\0' && (*args)->next) {
+        return make_error_fmt("unexpected symbol after '%s' in argument list: '%s'", \
+                              pr_str(val, UNREADABLY),  \
+                              pr_str((*args)->next->data, UNREADABLY));
+       }
+    }
+
+    /* & is not found - add the symbol to the regular argument list */
+    else {
+
+      if (list_findf(regular_args, val->value.mal_symbol, symbol_fn) > 0) {
+        return make_error_fmt("duplicate symbol in argument list: '%s'", \
+                              pr_str(val, UNREADABLY));
+      }
+      else {
+        regular_args = list_push(regular_args, val);
+      }
+    }
+    *args = (*args)->next;
+  }
+
+  *args = list_reverse(regular_args);
+  return make_nil();
+}
+
+char* symbol_fn(gptr data) {
+  return (((MalType*)data)->value.mal_symbol);
+}
+
+/* used by core functions but not EVAL as doesn't do TCE */
+MalType* apply(MalType* fn, list args) {
+
+  if (is_function(fn)) {
+
+    MalType* (*fun_ptr)(list) = fn->value.mal_function;
+    return (*fun_ptr)(args);
+  }
+  else { /* is_closure(fn) */
+
+    MalClosure* c = fn->value.mal_closure;
+    list params = (c->parameters)->value.mal_list;
+
+    long param_count = list_count(params);
+    long arg_count = list_count(args);
+
+    if (param_count > arg_count) {
+      return make_error("too few arguments supplied to function");
+    }
+    else if ((param_count < arg_count) && !c->more_symbol) {
+      return make_error("too many arguments supplied to function");
+    }
+    else {
+      Env* env = env_make(c->env, params, args, c->more_symbol);
+      return EVAL(fn->value.mal_closure->definition, env);
+    }
+  }
+}
+
+int is_macro_call(MalType* ast, Env* env) {
+
+  /* not a list */
+  if (!is_list(ast)) {
+    return 0;
+  }
+
+  /* empty list */
+  list lst = ast->value.mal_list;
+  if (!lst) {
+    return 0;
+  }
+
+  /* first item not a symbol */
+  MalType* first = lst->data;
+  if (!is_symbol(first)) {
+    return 0;
+  }
+
+  /* lookup symbol */
+  MalType* val = env_get(env, first);
+  if (is_error(val)) {
+    return 0;
+  }
+  else {
+    return (val->is_macro);
+  }
+}

impls/c.2/tests/stepA_mal.mal

@@ -0,0 +1,22 @@
+;; Testing FFI of "strlen"
+(. nil "int32" "strlen" "string" "abcde")
+;=>5
+(. nil "int32" "strlen" "string" "")
+;=>0
+
+;; Testing FFI of "strcmp"
+
+(. nil "int32" "strcmp" "string" "abc" "string" "abcA")
+;=>-65
+(. nil "int32" "strcmp" "string" "abcA" "string" "abc")
+;=>65
+(. nil "int32" "strcmp" "string" "abc" "string" "abc")
+;=>0
+
+
+;; Testing FFI of "pow" (libm.so)
+
+(. "libm.so.6" "double" "pow" "double" 2.0 "double" 3.0)
+;=>8.000000
+(. "libm.so.6" "double" "pow" "double" 3.0 "double" 2.0)
+;=>9.000000

impls/c.2/types.c

@@ -0,0 +1,283 @@
+#include <stdarg.h>
+#include <stdio.h>
+#include <gc.h>
+#include "types.h"
+
+#define ERROR_BUFFER_SIZE 128
+
+MalType THE_TRUE = {MALTYPE_TRUE, 0, 0, {0}};
+MalType THE_FALSE = {MALTYPE_FALSE, 0, 0, {0}};
+MalType THE_NIL = {MALTYPE_NIL, 0, 0, {0}};
+
+
+inline int is_sequential(MalType* val) {
+  return (val->type == MALTYPE_LIST || val->type == MALTYPE_VECTOR);
+}
+
+inline int is_self_evaluating(MalType* val) {
+  return (val->type == MALTYPE_KEYWORD || val->type == MALTYPE_INTEGER ||
+	  val->type == MALTYPE_FLOAT || val->type == MALTYPE_STRING ||
+	  val->type == MALTYPE_TRUE || val->type == MALTYPE_FALSE ||
+	  val->type == MALTYPE_NIL);
+}
+
+inline int is_list(MalType* val) {
+  return (val->type == MALTYPE_LIST);
+}
+
+inline int is_vector(MalType* val) {
+  return (val->type == MALTYPE_VECTOR);
+}
+
+inline int is_hashmap(MalType* val) {
+  return (val->type == MALTYPE_HASHMAP);
+}
+
+inline int is_nil(MalType* val) {
+  return (val->type == MALTYPE_NIL);
+}
+
+inline int is_string(MalType* val) {
+  return (val->type == MALTYPE_STRING);
+}
+
+inline int is_integer(MalType* val) {
+  return (val->type == MALTYPE_INTEGER);
+}
+
+inline int is_float(MalType* val) {
+  return (val->type == MALTYPE_FLOAT);
+}
+
+inline int is_number(MalType* val) {
+  return (val->type == MALTYPE_INTEGER || val->type == MALTYPE_FLOAT);
+}
+
+inline int is_true(MalType* val) {
+  return (val->type == MALTYPE_TRUE);
+}
+
+inline int is_false(MalType* val) {
+  return (val->type == MALTYPE_FALSE);
+}
+
+inline int is_symbol(MalType* val) {
+  return (val->type == MALTYPE_SYMBOL);
+}
+
+inline int is_keyword(MalType* val) {
+  return (val->type == MALTYPE_KEYWORD);
+}
+
+inline int is_atom(MalType* val) {
+  return (val->type == MALTYPE_ATOM);
+}
+
+inline int is_error(MalType* val) {
+  return (val->type == MALTYPE_ERROR);
+}
+
+inline int is_callable(MalType* val) {
+  return (val->type == MALTYPE_FUNCTION || val->type == MALTYPE_CLOSURE);
+}
+
+inline int is_function(MalType* val) {
+  return (val->type == MALTYPE_FUNCTION);
+}
+
+inline int is_closure(MalType* val) {
+  return (val->type == MALTYPE_CLOSURE);
+}
+
+inline int is_macro(MalType* val) {
+  return (val->is_macro);
+}
+
+
+MalType* make_symbol(char* value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_SYMBOL;
+  mal_val->value.mal_symbol = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_integer(long value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_INTEGER;
+  mal_val->value.mal_integer = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_float(double value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_FLOAT;
+  mal_val->value.mal_float = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_keyword(char* value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_KEYWORD;
+  mal_val->value.mal_keyword = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_string(char* value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_STRING;
+  mal_val->value.mal_string = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_list(list value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_LIST;
+  mal_val->value.mal_list = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_vector(list value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_VECTOR;
+  mal_val->value.mal_list = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_hashmap(list value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_HASHMAP;
+  mal_val->value.mal_list = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_atom(MalType* value) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_ATOM;
+  mal_val->value.mal_atom = value;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_function(MalType*(*fn)(list args)) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_FUNCTION;
+  mal_val->value.mal_function = fn;
+  mal_val->is_macro = 0;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_closure(Env* env, MalType* parameters, MalType* definition, MalType* more_symbol) {
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_CLOSURE;
+  mal_val->metadata = NULL;
+
+  /* Allocate memory for embedded struct */
+  MalClosure* mc = GC_MALLOC(sizeof(*mc));
+  mc->env = env;
+  mc->parameters = parameters;
+  mc->definition = definition;
+  mc->more_symbol = more_symbol;
+
+  mal_val->is_macro = 0;
+  mal_val->value.mal_closure = mc;
+  return mal_val;
+}
+
+inline MalType* make_true() {
+  return &THE_TRUE;
+}
+
+inline MalType* make_false() {
+  return &THE_FALSE;
+}
+
+inline MalType* make_nil() {
+  return &THE_NIL;
+}
+
+MalType* make_error(char* msg) {
+
+  MalType* mal_string = GC_MALLOC(sizeof(*mal_string));
+  mal_string->type = MALTYPE_STRING;
+  mal_string->value.mal_string = msg;
+
+  MalType* mal_val = GC_MALLOC(sizeof(*mal_val));
+  mal_val->type = MALTYPE_ERROR;
+  mal_val->value.mal_error = mal_string;
+  mal_val->metadata = NULL;
+
+  return mal_val;
+}
+
+MalType* make_error_fmt(char* fmt, ...) {
+
+  va_list argptr;
+  va_start(argptr, fmt);
+
+  char* buffer = GC_MALLOC(sizeof(*buffer) * ERROR_BUFFER_SIZE);
+
+  long n = vsnprintf(buffer, ERROR_BUFFER_SIZE, fmt, argptr);
+  va_end(argptr);
+
+  if (n > ERROR_BUFFER_SIZE) {
+    va_start(argptr, fmt);
+
+    buffer = GC_REALLOC(buffer, sizeof(*buffer) * n);
+    vsnprintf(buffer, n, fmt, argptr);
+
+    va_end(argptr);
+  }
+  return make_error(buffer);
+}
+
+MalType* wrap_error(MalType* value) {
+
+  MalType* mal_error = GC_MALLOC(sizeof(*mal_error));
+  mal_error->type = MALTYPE_ERROR;
+  mal_error->metadata = NULL;
+  mal_error->value.mal_error = value;
+
+  return mal_error;
+}
+
+MalType* copy_type(MalType* value) {
+
+  MalType* new_val = GC_MALLOC(sizeof(*new_val));
+
+  new_val->type = value->type;
+  new_val->is_macro = value->is_macro;
+  new_val->value = value->value;
+  new_val->metadata = value->metadata;
+
+  return new_val;
+}

impls/c.2/types.h

@@ -0,0 +1,100 @@
+#ifndef _MAL_TYPES_H
+#define _MAL_TYPES_H
+
+#include "libs/linked_list/linked_list.h"
+#include "libs/hashmap/hashmap.h"
+
+#define MALTYPE_SYMBOL 1
+#define MALTYPE_KEYWORD 2
+#define MALTYPE_INTEGER 3
+#define MALTYPE_FLOAT 4
+#define MALTYPE_STRING 5
+#define MALTYPE_TRUE 6
+#define MALTYPE_FALSE 7
+#define MALTYPE_NIL 8
+#define MALTYPE_LIST 9
+#define MALTYPE_VECTOR 10
+#define MALTYPE_HASHMAP 11
+#define MALTYPE_FUNCTION 12
+#define MALTYPE_CLOSURE 13
+#define MALTYPE_ERROR 14
+#define MALTYPE_ATOM 15
+
+typedef struct MalType_s MalType;
+typedef struct MalClosure_s MalClosure;
+typedef struct Env_s Env;
+
+struct MalType_s {
+
+  int type;
+  int is_macro;
+  MalType* metadata;
+
+  union MalValue {
+
+    long mal_integer;
+    double mal_float;
+    char* mal_symbol;
+    char* mal_string;
+    char* mal_keyword;
+    list mal_list;
+    /* vector mal_vector;  TODO: implement a real vector */
+    /* hashmap mal_hashmap; TODO: implement a real hashmap */
+    MalType* (*mal_function)(list);
+    MalClosure* mal_closure;
+    MalType* mal_atom;
+    MalType* mal_error;
+
+  } value;
+};
+
+struct MalClosure_s {
+
+  Env* env;
+  MalType* parameters;
+  MalType* more_symbol;
+  MalType* definition;
+
+};
+
+MalType* make_symbol(char* value);
+MalType* make_integer(long value);
+MalType* make_float(double value);
+MalType* make_keyword(char* value);
+MalType* make_string(char* value);
+MalType* make_list(list value);
+MalType* make_vector(list value);
+MalType* make_hashmap(list value);
+MalType* make_true();
+MalType* make_false();
+MalType* make_nil();
+MalType* make_atom(MalType* value);
+MalType* make_error(char* msg);
+MalType* make_error_fmt(char* fmt, ...);
+MalType* wrap_error(MalType* value);
+MalType* make_function(MalType*(*fn)(list args));
+MalType* make_closure(Env* env, MalType* parameters, MalType* definition, MalType* more_symbol);
+MalType* copy_type(MalType* value);
+
+int is_sequential(MalType* val);
+int is_self_evaluating(MalType* val);
+int is_list(MalType* val);
+int is_vector(MalType* val);
+int is_hashmap(MalType* val);
+int is_nil(MalType* val);
+int is_string(MalType* val);
+int is_integer(MalType* val);
+int is_float(MalType* val);
+int is_number(MalType* val);
+int is_true(MalType* val);
+int is_false(MalType* val);
+int is_symbol(MalType* val);
+int is_keyword(MalType* val);
+int is_atom(MalType* val);
+int is_error(MalType* val);
+int is_callable(MalType* val);
+int is_function(MalType* val);
+int is_closure(MalType* val);
+int is_macro(MalType* val);
+
+#endif