split runtime into several C-files

Makefile

@@ -1,9 +1,10 @@
 CFLAGS=-I/usr/local/opt/libffi/lib/libffi-3.0.13/include
 LDFLAGS=-L/usr/local/opt/libffi/lib/
 LDLIBS=-lffi
+SOURCE_FILES=src/main.c src/obj.c src/gc.c src/obj_string.c src/reader.c src/eval.c src/env.c src/primops.c src/repl.c
 
 all: src/main.o
-	clang ./src/main.c -g -O0 -rdynamic -o ./bin/carp-repl -ldl $(CFLAGS) $(LDFLAGS) $(LDLIBS)
+	clang $(SOURCE_FILES) -g -O0 -rdynamic -o ./bin/carp-repl -ldl $(CFLAGS) $(LDFLAGS) $(LDLIBS)
 
 run:
 	./bin/carp

src/assertions.h

@@ -0,0 +1,19 @@
+#pragma once
+
+#define assert_or_return(assertion, ...) if(!(assertion)) { printf(_VA_ARGS_); printf("\n"); return; }
+#define assert_or_return_nil(assertion, ...) if(!(assertion)) { printf(_VA_ARGS_); printf("\n"); return; }
+
+#define set_error(message, obj) \
+  error = concat_c_strings((message), obj_to_string((obj) ? (obj) : nil)->s); \
+  stack_push(nil); \
+  return;
+
+#define set_error_and_return(message, obj) \
+  error = concat_c_strings((message), obj_to_string((obj) ? (obj) : nil)->s); \
+  return nil;
+
+#define assert_or_set_error(assertion, message, obj)	\
+  if(!(assertion)) {					\
+    set_error(message, obj);				\
+  }
+

src/env.c

@@ -0,0 +1,75 @@
+#include "env.h"
+#include "eval.h"
+#include "obj_string.h"
+#include "assertions.h"
+
+Obj *env_lookup(Obj *env, Obj *symbol) {
+  Obj *p = env->bindings;
+  while(p && p->car) {
+    Obj *pair = p->car;
+    if(obj_eq(pair->car, symbol)) {
+      return pair->cdr;
+    }
+    else {
+      p = p->cdr;
+    }
+  }
+  if(env->parent) {
+    return env_lookup(env->parent, symbol);
+  }
+  else {
+    return NULL;
+  }
+}
+
+Obj *env_lookup_binding(Obj *env, Obj *symbol) {
+  Obj *p = env->bindings;
+  while(p && p->car) {
+    Obj *pair = p->car;
+    if(obj_eq(pair->car, symbol)) {
+      return pair;
+    }
+    else {
+      p = p->cdr;
+    }
+  }
+  if(env->parent) {
+    return env_lookup_binding(env->parent, symbol);
+  }
+  else {
+    return nil;
+  }
+}
+
+void env_extend(Obj *env, Obj *key, Obj *value) {
+  assert(env->tag == 'E');
+  
+  Obj *pair = obj_new_cons(key, value);
+  Obj *cons = obj_new_cons(pair, env->bindings);
+
+  env->bindings = cons;
+}
+
+void env_extend_with_args(Obj *calling_env, Obj *function, int arg_count, Obj **args) {
+  Obj *paramp = function->params;
+  for(int i = 0; i < arg_count; i++) {
+    if(paramp && !paramp->car) {
+      set_error("Too many arguments to function: ", function);
+    }
+    env_extend(calling_env, paramp->car, args[i]);
+    paramp = paramp->cdr;
+  }
+  if(paramp && paramp->cdr) {
+    set_error("Too few arguments to function: ", function);
+  }
+}
+
+void global_env_extend(Obj *key, Obj *val) {
+  assert(global_env);
+  Obj *existing_binding = env_lookup_binding(global_env, key);
+  if(existing_binding->car) {
+    existing_binding->cdr = val;
+  } else {
+    env_extend(global_env, key, val);
+  }
+}

src/env.h

@@ -0,0 +1,9 @@
+#pragma once
+
+#include "obj.h"
+
+Obj *env_lookup(Obj *env, Obj *symbol);
+Obj *env_lookup_binding(Obj *env, Obj *symbol);
+void env_extend(Obj *env, Obj *key, Obj *value);
+void env_extend_with_args(Obj *calling_env, Obj *function, int arg_count, Obj **args);
+void global_env_extend(Obj *key, Obj *val);

src/eval.c

@@ -0,0 +1,572 @@
+#include "eval.h"
+#include "env.h"
+#include "assertions.h"
+#include "reader.h"
+#include "gc.h"
+
+#define LOG_STACK 0
+#define SHOW_MACRO_EXPANSION 0
+#define LOG_FUNC_APPLICATION 0
+
+#define STACK_TRACE_LEN 256
+char function_trace[STACK_SIZE][STACK_TRACE_LEN];
+int function_trace_pos;
+
+void stack_print() {
+  printf("----- STACK -----\n");
+  for(int i = 0; i < stack_pos; i++) {
+    printf("%d\t%s\n", i, obj_to_string(stack[i])->s);
+  }
+  printf("-----  END  -----\n\n");
+}
+
+void stack_push(Obj *o) {
+  if(LOG_STACK) {
+    printf("Pushing %s\n", obj_to_string(o)->s);
+  }
+  if(stack_pos >= STACK_SIZE) {
+    printf("Stack overflow.");
+    exit(1);
+  }
+  stack[stack_pos++] = o;
+  if(LOG_STACK) {
+    stack_print();
+  }
+}
+
+Obj *stack_pop() {
+  if(error) {
+    return nil;
+  }
+  if(stack_pos <= 0) {
+    printf("Stack underflow.");
+    assert(false);
+  }
+  if(LOG_STACK) {
+    printf("Popping %s\n", obj_to_string(stack[stack_pos - 1])->s);
+  }
+  Obj *o = stack[--stack_pos];
+  if(LOG_STACK) {
+    stack_print();
+  }
+  return o;
+}
+
+void function_trace_print() {
+  printf("     -----------------\n");
+  for(int i = function_trace_pos - 1; i >= 0; i--) {
+    printf("%3d  %s\n", i, function_trace[i]);
+  }
+  printf("     -----------------\n");
+}
+
+bool obj_match(Obj *env, Obj *attempt, Obj *value);
+
+bool obj_match_lists(Obj *env, Obj *attempt, Obj *value) {
+  //printf("Matching list %s with %s\n", obj_to_string(attempt)->s, obj_to_string(value)->s);
+  Obj *p1 = attempt;
+  Obj *p2 = value;
+  while(p1 && p1->car) {
+    if(obj_eq(p1->car, ampersand) && p1->cdr && p1->cdr->car) {
+      //printf("Matching & %s against %s\n", obj_to_string(p1->cdr->car)->s, obj_to_string(p2)->s);
+      bool matched_rest = obj_match(env, p1->cdr->car, p2);
+      return matched_rest;
+    }
+    else if(!p2 || !p2->car) {
+      return false;
+    }
+    bool result = obj_match(env, p1->car, p2->car);
+    if(!result) {
+      return false;
+    }
+    p1 = p1->cdr;
+    p2 = p2->cdr;
+  }
+  if(p2 && p2->car) {
+    return false;
+  }
+  else {
+    return true;
+  }
+}
+
+bool obj_match(Obj *env, Obj *attempt, Obj *value) {
+
+  if(attempt->tag == 'C' && obj_eq(attempt->car, lisp_quote) && attempt->cdr && attempt->cdr->car) {
+    // Dubious HACK to enable matching on quoted things...
+    // Don't want to extend environment in this case!
+    Obj *quoted_attempt = attempt->cdr->car;
+    return obj_eq(quoted_attempt, value);
+  }
+  else if(attempt->tag == 'Y') {
+    //printf("Binding %s to value %s in match.\n", obj_to_string(attempt)->s, obj_to_string(value)->s);
+    env_extend(env, attempt, value);
+    return true;
+  }
+  else if(attempt->tag == 'C' && value->tag == 'C') {
+    return obj_match_lists(env, attempt, value);
+  }
+  else if(obj_eq(attempt, value)) {
+    return true;
+  }
+  else {
+    /* printf("attempt %s (%c) is NOT equal to value %s (%c)\n", */
+    /* 	   obj_to_string(attempt)->s, */
+    /* 	   attempt->tag, */
+    /* 	   obj_to_string(value)->s, */
+    /* 	   value->tag); */
+    return false;
+  }
+}
+
+void match(Obj *env, Obj *value, Obj *attempts) {
+  Obj *p = attempts;
+  while(p && p->car) {
+    //printf("\nWill match %s with value %s\n", obj_to_string(p->car)->s, obj_to_string(value)->s);
+    Obj *new_env = obj_new_environment(env);
+    bool result = obj_match(new_env, p->car, value);
+
+    if(result) {
+      //printf("Match found, evaling %s in env\n", obj_to_string(p->cdr->car)->s); //, obj_to_string(new_env)->s);
+      eval_internal(new_env, p->cdr->car); // eval the following form using the new environment
+      return;
+    }
+    
+    if(!p->cdr) {
+      set_error("Uneven nr of forms in match.", attempts);
+    }
+      
+    p = p->cdr->cdr;
+  }
+
+  set_error("Failed to find a suitable match for: ", value);
+}
+
+void eval_text(Obj *env, char *text, bool print) {
+  Obj *forms = read_string(env, text);
+  Obj *form = forms;
+  while(form && form->car) {
+    Obj *result = eval(env, form->car);
+    if(error) {
+      printf("\e[31mERROR: %s\e[0m\n", obj_to_string_not_prn(error)->s);
+      function_trace_print();
+      error = NULL;
+      gc(env, NULL);
+      return;
+    }
+    if(print) {
+      if(result) {
+	obj_print(result);
+      }
+      else {
+	printf("Result was NULL when evaling %s\n", obj_to_string(form->car)->s);
+      }
+      printf("\n");
+    }
+    form = form->cdr;
+    gc(env, forms);
+  }
+}
+
+void apply(Obj *function, Obj **args, int arg_count) {
+  if(function->tag == 'L') {
+    Obj *calling_env = obj_new_environment(function->env);
+    //printf("Calling function that has parameters: %s\n", obj_to_string(function->params)->s);
+    env_extend_with_args(calling_env, function, arg_count, args);
+    //printf("Lambda env: %s\n", obj_to_string(calling_env)->s);
+    eval_internal(calling_env, function->body);
+  }
+  else if(function->tag == 'P') {
+    Obj *result = function->primop(args, arg_count);
+    stack_push(result);
+  }
+  else if(function->tag == 'F') {
+    assert(function);
+
+    if(!function->funptr) {
+      error = obj_new_string("Can't call foregin function, it's funptr is NULL. May be a stub function with just a signature?");
+      return;
+    }
+    
+    assert(function->cif);
+    assert(function->arg_types);
+    assert(function->return_type);
+     
+    void *values[arg_count];
+
+    Obj *p = function->arg_types;
+    for(int i = 0; i < arg_count; i++) {
+      if(p && p->cdr) {
+	assert(p->car);
+	if(obj_eq(p->car, type_int)) {
+	  assert_or_set_error(args[i]->tag == 'I', "Invalid type of arg: ", args[i]);
+	  values[i] = &args[i]->i;
+	}
+	else if(obj_eq(p->car, type_float)) {
+	  assert_or_set_error(args[i]->tag == 'V', "Invalid type of arg: ", args[i]);
+	  values[i] = &args[i]->f32;
+	}
+	else if(obj_eq(p->car, type_string)) {
+	  assert_or_set_error(args[i]->tag == 'S', "Invalid type of arg: ", args[i]);
+	  values[i] = &args[i]->s;
+	}
+	else if(p->car->tag == 'C' && obj_eq(p->car->car, obj_new_keyword("ptr"))) { // TODO: replace with a shared keyword to avoid allocs
+	  assert_or_set_error(args[i]->tag == 'Q', "Invalid type of arg: ", args[i]);
+	  values[i] = &args[i]->void_ptr;
+	}
+	else {
+	  set_error("Can't call foreign function with argument of type ", p->car);
+	}
+	p = p->cdr;
+      }
+      else {
+	set_error("Too many arguments to ", function);
+      }	
+    }
+
+    if(p && p->car) {
+      set_error("Too few arguments to ", function);
+    }
+
+    Obj *obj_result = NULL;
+    
+    if(obj_eq(function->return_type, type_string)) {
+      //printf("Returning string.\n");
+      char *c = NULL;
+      ffi_call(function->cif, function->funptr, &c, values);
+
+      if(c == NULL) {
+	//printf("c is null");
+	obj_result = obj_new_string("");
+      }
+      else {      
+	obj_result = obj_new_string(c);
+      }
+    }
+    else if(obj_eq(function->return_type, type_int)) { 
+      //printf("Returning int.\n");
+      int result;
+      ffi_call(function->cif, function->funptr, &result, values);
+      obj_result = obj_new_int(result);
+    }
+    else if(obj_eq(function->return_type, type_bool)) { 
+      //printf("Returning bool.\n");
+      int result;
+      ffi_call(function->cif, function->funptr, &result, values);
+      obj_result = result ? lisp_true : lisp_false;
+    }
+    else if(obj_eq(function->return_type, type_float)) { 
+      //printf("Returning float.\n");
+      float result;
+      ffi_call(function->cif, function->funptr, &result, values);
+      obj_result = obj_new_float(result);
+    }
+    else if(obj_eq(function->return_type, type_void)) { 
+      //printf("Returning void.\n");
+      int result;
+      ffi_call(function->cif, function->funptr, &result, values);
+      obj_result = nil;
+    }
+    else if(function->return_type->tag == 'C' && obj_eq(function->return_type->car, type_ptr)) {
+      void *result;
+      ffi_call(function->cif, function->funptr, &result, values);
+      //printf("Creating new void* with value: %p\n", result);
+      obj_result = obj_new_ptr(result);
+    }
+    else {
+      set_error("Returning what? ", function->return_type);
+    }
+
+    assert(obj_result);
+    stack_push(obj_result);
+  }
+  else if(function->tag == 'K') {
+    if(arg_count != 1) {
+      error = obj_new_string("Args to keyword lookup must be a single arg.");
+    }
+    else if(args[0]->tag != 'E') {
+      error = obj_new_string("Arg 0 to keyword lookup must be a dictionary: ");
+      obj_string_mut_append(error, obj_to_string(args[0])->s);
+    }
+    else {
+      Obj *value = env_lookup(args[0], function);
+      if(value) {
+	stack_push(value);
+      } else {
+	error = obj_new_string("Failed to lookup keyword '");
+	obj_string_mut_append(error, obj_to_string(function)->s);
+	obj_string_mut_append(error, "'");
+      }
+    }
+  }
+  else {
+    set_error("Can't call non-function: ", function);
+  }
+}
+
+#define HEAD_EQ(str) (o->car->tag == 'Y' && strcmp(o->car->s, (str)) == 0)
+
+void eval_list(Obj *env, Obj *o) {
+  assert(o);
+  //printf("Evaling list %s\n", obj_to_string(o)->s);
+  if(!o->car) {
+    stack_push(o); // nil, empty list
+  }
+  else if(HEAD_EQ("do")) {
+    Obj *p = o->cdr;
+    while(p && p->car) {
+      eval_internal(env, p->car);
+      if(error) { return; }
+      p = p->cdr;
+      if(p && p->car) {
+	stack_pop(); // remove result from form that is not last
+      }
+    }
+  }
+  else if(HEAD_EQ("let")) {
+    Obj *let_env = obj_new_environment(env);
+    Obj *p = o->cdr->car;
+    assert_or_set_error(o->cdr->car, "No bindings in 'let' form.", o);
+    while(p && p->car) {
+      if(!p->cdr) {
+	set_error("Uneven nr of forms in let: ", o);
+      }
+      assert_or_set_error(p->car->tag == 'Y', "Must bind to symbol in let form: ", p->car);
+      eval_internal(let_env, p->cdr->car);
+      if(error) { return; }
+      env_extend(let_env, p->car, stack_pop());
+      p = p->cdr->cdr;
+    }
+    assert_or_set_error(o->cdr->cdr->car, "No body in 'let' form.", o);
+    eval_internal(let_env, o->cdr->cdr->car);
+  }
+  else if(HEAD_EQ("not")) {
+    Obj *p = o->cdr;
+    while(p) {
+      if(p->car) {
+	eval_internal(env, p->car);
+	if(error) { return; }
+	if(is_true(stack_pop())) {
+	  stack_push(lisp_false);
+	  return;
+	}
+      }
+      p = p->cdr;
+    }
+    stack_push(lisp_true);
+  }
+  else if(HEAD_EQ("quote")) {
+    if(o->cdr == nil) {
+      stack_push(nil);
+    } else {
+      stack_push(o->cdr->car);
+    }
+  }
+  else if(HEAD_EQ("while")) {
+    eval_internal(env, o->cdr->car);
+    if(error) {
+      return;
+    }
+    while(is_true(stack_pop())) {
+      eval_internal(env, o->cdr->cdr->car);
+      stack_pop();
+      eval_internal(env, o->cdr->car);
+      if(error) {
+	return;
+      }
+    }
+    stack_push(nil);
+  }
+  else if(HEAD_EQ("if")) {
+    eval_internal(env, o->cdr->car);
+    if(error) {
+      return;
+    }
+    else if(is_true(stack_pop())) {
+      eval_internal(env, o->cdr->cdr->car);
+    }
+    else {
+      eval_internal(env, o->cdr->cdr->cdr->car);
+    }
+  }
+  else if(HEAD_EQ("match")) {
+    eval_internal(env, o->cdr->car);
+    if(error) { return; }
+    Obj *value = stack_pop();
+    Obj *p = o->cdr->cdr;   
+    match(env, value, p);
+  }
+  else if(HEAD_EQ("reset!")) {
+    assert_or_set_error(o->cdr->car->tag == 'Y', "Must use 'reset!' on a symbol.", o->cdr->car);
+    Obj *pair = env_lookup_binding(env, o->cdr->car);
+    if(!pair->car || pair->car->tag != 'Y') {
+      printf("Can't reset! binding '%s', it's '%s'\n", o->cdr->car->s, obj_to_string(pair)->s);
+      stack_push(nil);
+      return;
+    }
+    eval_internal(env, o->cdr->cdr->car);
+    if(error) { return; }
+    pair->cdr = stack_pop();
+    stack_push(pair->cdr);
+  }
+  else if(HEAD_EQ("fn")) {
+    assert_or_set_error(o->cdr, "Lambda form too short (no parameter list or body).", o);
+    assert_or_set_error(o->cdr->car, "No parameter list in lambda.", o);
+    Obj *params = o->cdr->car;
+    assert_or_set_error(o->cdr->cdr, "Lambda form too short (no body).", o);
+    assert_or_set_error(o->cdr->cdr->car, "No body in lambda: ", o);
+    Obj *body = o->cdr->cdr->car;
+    //printf("Creating lambda with env: %s\n", obj_to_string(env)->s);
+    Obj *lambda = obj_new_lambda(params, body, env, o);
+    stack_push(lambda);
+  }
+  else if(HEAD_EQ("macro")) {
+    assert_or_set_error(o->cdr, "Macro form too short (no parameter list or body): ", o);
+    assert_or_set_error(o->cdr->car, "No parameter list in macro: ", o);
+    Obj *params = o->cdr->car;
+    assert_or_set_error(o->cdr->cdr, "Macro form too short (no body): ", o);
+    assert_or_set_error(o->cdr->cdr->car, "No body in macro: ", o);
+    Obj *body = o->cdr->cdr->car;
+    Obj *macro = obj_new_macro(params, body, env, o);
+    stack_push(macro);
+  }
+  else if(HEAD_EQ("def")) {
+    assert_or_set_error(o->cdr, "Too few args to 'def': ", o);
+    assert_or_set_error(o->cdr->car, "Can't assign to nil: ", o);
+    assert_or_set_error(o->cdr->car->tag == 'Y', "Can't assign to non-symbol: ", o);
+    Obj *key = o->cdr->car;
+    eval_internal(env, o->cdr->cdr->car); // eval the second arg to 'def', the value to assign
+    if(error) { return; } // don't define it if there was an error
+    Obj *val = stack_pop();
+    global_env_extend(key, val);
+    //printf("def %s to %s\n", obj_to_string(key)->s, obj_to_string(val)->s);
+    stack_push(val);
+  }
+  else if(HEAD_EQ("def?")) {
+    Obj *key = o->cdr->car;
+    if(obj_eq(nil, env_lookup_binding(env, key))) {
+      stack_push(lisp_false);
+    } else {
+      stack_push(lisp_true);
+    }
+  }
+  else {
+    // Lambda, primop or macro
+    eval_internal(env, o->car);
+    if(error) { return; }
+    
+    Obj *function = stack_pop();
+    assert_or_set_error(function, "Can't call NULL.", o);
+    
+    bool eval_args = function->tag != 'M'; // macros don't eval their args
+    Obj *p = o->cdr;
+    int count = 0;
+    
+    while(p && p->car) {
+      if(error) {
+	return;
+      }
+      
+      if(eval_args) {
+	eval_internal(env, p->car);
+      }
+      else {
+	stack_push(p->car); // push non-evaled
+      }
+      count++;
+      p = p->cdr;
+    }
+
+    if(error) {
+      return;
+    }
+    
+    Obj *args[count];
+    for(int i = 0; i < count; i++) {
+      Obj *arg = stack_pop();
+      args[count - i - 1] = arg;
+    }
+
+    if(function->tag == 'M') {
+      Obj *calling_env = obj_new_environment(function->env);
+      env_extend_with_args(calling_env, function, count, args);
+      eval_internal(calling_env, function->body);
+      if(error) { return; }
+      Obj *expanded = stack_pop();
+      if(SHOW_MACRO_EXPANSION) {
+	printf("Expanded macro: %s\n", obj_to_string(expanded)->s);
+      }
+      eval_internal(env, expanded);
+    }
+    else {
+      if(function_trace_pos > STACK_SIZE - 1) {
+	printf("Out of function trace stack.\n");
+	stack_print();
+	function_trace_print();
+	exit(1);
+      }
+
+      if(LOG_FUNC_APPLICATION) {
+	printf("evaluating form %s\n", obj_to_string(o)->s);
+      }
+      
+      snprintf(function_trace[function_trace_pos], STACK_TRACE_LEN, "%s", obj_to_string(o)->s);
+      function_trace_pos++;
+      
+      apply(function, args, count);
+      if(!error) {
+	function_trace_pos--;
+      }
+    }
+  }
+}
+
+void eval_internal(Obj *env, Obj *o) {
+  if(error) { return; }
+
+  //printf("%s\n", obj_to_string(o)->s);
+  
+  if(!o) {
+    stack_push(nil);
+  }
+  else if(o->tag == 'C') {
+    eval_list(env, o);
+  }
+  else if(o->tag == 'E') {
+    Obj *new_env = obj_copy(o);
+    Obj *p = new_env->bindings;
+    while(p && p->car) {
+      Obj *pair = p->car;
+      eval_internal(env, pair->cdr);
+      //printf("Evaling env-binding %s, setting cdr to %s.\n", obj_to_string(pair)->s, obj_to_string(stack[stack_pos - 1])->s);
+      pair->cdr = stack_pop();
+      p = p->cdr;
+    }
+    stack_push(new_env);
+  }
+  else if(o->tag == 'Y') {
+    Obj *result = env_lookup(env, o);
+    if(!result) {
+      char buffer[256];
+      snprintf(buffer, 256, "Can't find '%s' in environment.", obj_to_string(o)->s);
+      error = obj_new_string(buffer);
+      stack_push(nil);
+    } else {
+      stack_push(result);
+    }
+  }
+  else {
+    stack_push(o);
+  }
+}
+
+Obj *eval(Obj *env, Obj *form) {
+  error = NULL;
+  stack_pos = 0;
+  function_trace_pos = 0;
+  eval_internal(env, form);
+  Obj *result = stack_pop();
+  return result;
+}
+
+

src/eval.h

@@ -0,0 +1,21 @@
+#pragma once
+
+#include "obj.h"
+#include "obj_string.h"
+
+int stack_pos;
+#define STACK_SIZE 512
+Obj *stack[STACK_SIZE];
+int stack_pos;
+
+void function_trace_print();
+
+void stack_push(Obj *o);
+Obj *stack_pop();
+
+void apply(Obj *function, Obj **args, int arg_count);
+Obj *eval(Obj *env, Obj *form);
+void eval_internal(Obj *env, Obj *o);
+void eval_text(Obj *env, char *text, bool print);
+
+

src/gc.c

@@ -0,0 +1,74 @@
+#include "gc.h"
+
+#define LOG_GC_KILLS 0
+
+void obj_mark_alive(Obj *o) {
+  if(!o || o->alive) {
+    return;
+  }
+  
+  o->alive = true;
+  
+  if(o->tag == 'C') {
+    obj_mark_alive(o->car);
+    obj_mark_alive(o->cdr);
+  }
+  else if(o->tag == 'L' || o->tag == 'M') {
+    obj_mark_alive(o->params);
+    obj_mark_alive(o->body);
+    obj_mark_alive(o->env);
+    obj_mark_alive(o->code);
+  }
+  else if(o->tag == 'E') {
+    obj_mark_alive(o->parent);
+    obj_mark_alive(o->bindings);
+  }
+  else if(o->tag == 'F') {
+    obj_mark_alive(o->arg_types);
+    obj_mark_alive(o->return_type);
+  }
+}
+
+void free_internal_data(Obj *dead) {
+  if(dead->tag == 'F') {
+    free(dead->cif);
+  }
+  else if(dead->tag == 'S' || dead->tag == 'Y' || dead->tag == 'K') {
+    free(dead->s);
+  }
+}
+
+void gc_sweep() {
+  int kill_count = 0;
+  Obj **p = &obj_latest;
+  while(*p) {
+    if(!(*p)->alive) {
+      Obj *dead = *p;
+      *p = dead->prev;
+      free_internal_data(dead);
+      //printf("free %p %c\n", dead, dead->tag);
+      free(dead);
+      obj_total--;
+      kill_count++;
+    }
+    else {
+      (*p)->alive = false; // for next gc collect
+      p = &(*p)->prev;
+    }
+  }
+  if(LOG_GC_KILLS) {
+    printf("\e[33mDeleted %d Obj:s.\e[0m\n", kill_count);
+  }
+}
+
+void gc(Obj *env, Obj *forms) {
+  if(forms) {
+    obj_mark_alive(forms);
+  }
+  obj_mark_alive(env);
+  for(int i = 0; i < stack_pos - 1; i++) {
+    obj_mark_alive(stack[i]);
+  }
+  gc_sweep();
+}
+

src/gc.h

@@ -0,0 +1,8 @@
+#pragma once
+
+#include "obj.h"
+#include "eval.h"
+
+void gc_sweep();
+void gc();
+

src/main.c

@@ -1,6 +1,6 @@
-#include <stdio.h>
-#include <string.h>
-#include "mini.h"
+#include "repl.h"
+#include "eval.h"
+#include "../out/shared.h"
 
 int main() {
   env_new_global();

src/obj.c

@@ -0,0 +1,283 @@
+#include "obj.h"
+#include "obj_string.h"
+
+Obj *obj_latest = NULL;
+int obj_total = 0;
+
+Obj *obj_new() {
+  Obj *o = malloc(sizeof(Obj));
+  o->prev = obj_latest;
+  o->alive = false;
+  obj_latest = o;
+  obj_total++;
+  return o;
+}
+
+Obj *obj_new_cons(Obj *car, Obj *cdr) {
+  Obj *o = obj_new();
+  o->tag = 'C';
+  o->car = car;
+  o->cdr = cdr;
+  return o;
+}
+
+Obj *obj_new_int(int i) {
+  Obj *o = obj_new();
+  o->tag = 'I';
+  o->i = i;
+  return o;
+}
+
+Obj *obj_new_float(float x) {
+  Obj *o = obj_new();
+  o->tag = 'V';
+  o->f32 = x;
+  return o;
+}
+
+Obj *obj_new_string(char *s) {
+  Obj *o = obj_new();
+  o->tag = 'S';
+  o->s = strdup(s);
+  return o;
+}
+
+Obj *obj_new_symbol(char *s) {
+  Obj *o = obj_new();
+  o->tag = 'Y';
+  o->s = strdup(s);
+  return o;
+}
+
+Obj *obj_new_keyword(char *s) {
+  Obj *o = obj_new();
+  o->tag = 'K';
+  o->s = strdup(s);
+  return o;
+}
+
+Obj *obj_new_primop(Primop p) {
+  Obj *o = obj_new();
+  o->tag = 'P';
+  o->primop = p;
+  return o;
+}
+
+Obj *obj_new_dylib(void *dylib) {
+  Obj *o = obj_new();
+  o->tag = 'D';
+  o->primop = dylib;
+  return o;
+}
+
+Obj *obj_new_ptr(void *ptr) {
+  Obj *o = obj_new();
+  o->tag = 'Q';
+  o->void_ptr = ptr;
+  return o;
+}
+
+Obj *obj_new_ffi(ffi_cif* cif, VoidFn funptr, Obj *arg_types, Obj *return_type_obj) {
+  assert(cif);
+  assert(arg_types);
+  assert(arg_types->tag == 'C');
+  assert(return_type_obj);
+  Obj *o = obj_new();
+  o->tag = 'F';
+  o->cif = cif;
+  o->funptr = funptr;
+  o->arg_types = arg_types;
+  o->return_type = return_type_obj;
+  return o;
+}
+
+Obj *obj_new_lambda(Obj *params, Obj *body, Obj *env, Obj *code) {
+  assert(params);
+  assert(params->tag == 'C');
+  assert(body);
+  assert(env);
+  assert(env->tag == 'E');
+  assert(code);
+  Obj *o = obj_new();
+  o->params = params;
+  o->body = body;
+  o->env = env;
+  o->tag = 'L';
+  o->code = code;
+  return o;
+}
+
+Obj *obj_new_macro(Obj *params, Obj *body, Obj *env, Obj *code) {
+  assert(params);
+  assert(params->tag == 'C');
+  assert(body);
+  assert(env);
+  assert(env->tag == 'E');
+  Obj *o = obj_new();
+  o->params = params;
+  o->body = body;
+  o->env = env;
+  o->tag = 'M';
+  o->code = code;
+  return o;
+}
+
+Obj *obj_new_environment(Obj *parent) {
+  Obj *o = obj_new();
+  o->parent = parent;
+  o->bindings = NULL;
+  o->tag = 'E';
+  return o;
+}
+
+Obj *obj_copy(Obj *o) {
+  assert(o);
+  if(o->tag == 'C') {
+    //printf("Making a copy of the list: %s\n", obj_to_string(o)->s);
+    Obj *list = obj_new_cons(NULL, NULL);
+    Obj *prev = list;
+    Obj *p = o;
+    while(p && p->car) {
+      Obj *new = obj_new_cons(NULL, NULL);
+      prev->car = obj_copy(p->car);
+      if(p->cdr) {
+	prev->cdr = obj_copy(p->cdr);
+	return list; // early break when copying dotted pairs!
+      } else {
+	prev->cdr = obj_new_cons(NULL, NULL);
+	prev = new;
+	p = p->cdr;
+      }
+    }
+    return list;
+  }
+  else if(o->tag == 'E') {
+    //printf("Making a copy of the env: %s\n", obj_to_string(o)->s);
+    Obj *new_env = obj_new_environment(o->parent);
+    new_env->bindings = obj_copy(o->bindings);
+    return new_env;
+  }
+  else if(o->tag == 'Q') {
+    return obj_new_ptr(o->void_ptr);
+  }
+  else if(o->tag == 'I') {
+    return obj_new_int(o->i);
+  }
+  else if(o->tag == 'V') {
+    return obj_new_float(o->f32);
+  }
+  else if(o->tag == 'S') {
+    return obj_new_string(strdup(o->s));
+  }
+  else if(o->tag == 'Y') {
+    return obj_new_symbol(strdup(o->s));
+  }
+  else if(o->tag == 'K') {
+    return obj_new_keyword(strdup(o->s));
+  }
+  else if(o->tag == 'P') {
+    return obj_new_primop(o->primop);
+  }
+  else if(o->tag == 'D') {
+    return obj_new_dylib(o->dylib);
+  }
+  else if(o->tag == 'F') {
+    return obj_new_ffi(o->cif, o->funptr, obj_copy(o->arg_types), obj_copy(o->return_type));
+  }
+  else if(o->tag == 'L') {
+    return o;
+  }
+  else if(o->tag == 'M') {
+    return o;
+  }
+  else {
+    printf("obj_copy() can't handle type tag %c (%d).\n", o->tag, o->tag);
+    assert(false);
+  }
+}
+
+Obj *obj_list_internal(Obj *objs[]) {
+  Obj *list = obj_new_cons(NULL, NULL);
+  Obj **o = objs;
+  Obj *prev = list;
+  while(*o) {
+    prev->car = *o;
+    Obj *new = obj_new_cons(NULL, NULL);
+    prev->cdr = new;
+    prev = new;
+    o++;
+  }
+  return list;
+}
+
+bool obj_eq(Obj *a, Obj *b) {
+  //printf("Comparing %s with %s.\n", obj_to_string(a)->s, obj_to_string(b)->s);
+
+  if(a == b) {
+    return true;
+  }
+  else if(a == NULL || b == NULL) {
+    return false;
+  }
+  else if(a->tag != b->tag) {
+    return false;
+  }
+  else if(a->tag == 'S' || a->tag == 'Y' || a->tag == 'K') {
+    return (strcmp(a->s, b->s) == 0);
+  }
+  else if(a->tag == 'Q') {
+    return a->void_ptr == b->void_ptr;
+  }
+  else if(a->tag == 'I') {
+    return a->i == b->i;
+  }
+  else if(a->tag == 'V') {
+    return a->f32 == b->f32;
+  }
+  else if(a->tag == 'C') {
+    Obj *pa = a;
+    Obj *pb = b;
+    while(1) {
+      if(obj_eq(pa->car, pb->car)) {
+	if(!pa->cdr && !pb->cdr) {
+	  return true;
+	}
+	else if(pa->cdr && !pb->cdr) {
+	  return false;
+	}
+	else if(!pa->cdr && pb->cdr) {
+	  return false;
+	}
+	else {
+	  pa = pa->cdr;
+	  pb = pb->cdr;
+	}
+      }
+      else {
+	return false;
+      }
+    }
+  }
+  else if(a->tag == 'E') {
+    if(!obj_eq(a->parent, b->parent)) { return false; }
+    printf("Can't compare dicts just yet...\n");
+    return false;
+  }
+  else {
+    char buffer[512];
+    snprintf(buffer, 512, "Can't compare %s with %s.\n", obj_to_string(a)->s, obj_to_string(b)->s);
+    error = obj_new_string(strdup(buffer));
+    return false;
+  }
+}
+
+bool is_true(Obj *o) {
+  //printf("is_true? %s\n", obj_to_string(o)->s);
+  if(o == lisp_false || (o->tag == 'Y' && strcmp(o->s, "false") == 0)) {
+    return false;
+  }
+  else {
+    return true;
+  }
+}
+

src/obj.h

@@ -0,0 +1,128 @@
+#pragma once
+
+#include <ffi.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdbool.h>
+#include <assert.h>
+
+typedef void (*VoidFn)(void);
+
+/* Type tags
+   C = Cons cell
+   I = Integer
+   S = String
+   K = Keyword (:keyword)
+   Y = Symbol
+   L = Lambda
+   E = Environment
+   P = Primop / raw C function pointer
+   M = Macro
+   F = libffi function
+   D = Dylib
+   V = Float
+   W = Double (not implemented yet)
+   A = Array (not implemented yet)
+   Q = Void pointer
+*/
+
+typedef struct Obj {
+  union {
+    // Cons cells
+    struct {
+      struct Obj *car;
+      struct Obj *cdr;      
+    };
+    // Integers
+    int i;
+    // Strings, symbols and keywords
+    char *s;
+    // Lambdas / Macros
+    struct {
+      struct Obj *params;
+      struct Obj *body;
+      struct Obj *env;
+      struct Obj *code;
+    };
+    // Environment
+    struct {
+      struct Obj *parent;
+      struct Obj *bindings;
+    };
+    // Primitive C function pointer f(arglist, argcount)
+    struct Obj* (*primop)(struct Obj**, int);
+    // Libffi function
+    struct {
+      ffi_cif *cif;
+      VoidFn funptr;
+      struct Obj *arg_types;
+      struct Obj *return_type;
+    };
+    // Dylib
+    void *dylib;
+    // Void pointer
+    void *void_ptr;
+    // Float
+    float f32;
+  };
+  // GC
+  struct Obj *prev;
+  char alive;
+  // Type tag (see table above)
+  char tag;
+} Obj;
+
+typedef Obj* (*Primop)(Obj**, int);
+
+Obj *obj_new_cons(Obj *car, Obj *cdr);
+Obj *obj_new_int(int i);
+Obj *obj_new_float(float x);
+Obj *obj_new_string(char *s);
+Obj *obj_new_symbol(char *s);
+Obj *obj_new_keyword(char *s);
+Obj *obj_new_primop(Primop p);
+Obj *obj_new_dylib(void *dylib);
+Obj *obj_new_ptr(void *ptr);
+Obj *obj_new_ffi(ffi_cif* cif, VoidFn funptr, Obj *arg_types, Obj *return_type_obj);
+Obj *obj_new_lambda(Obj *params, Obj *body, Obj *env, Obj *code);
+Obj *obj_new_macro(Obj *params, Obj *body, Obj *env, Obj *code);
+Obj *obj_new_environment(Obj *parent);
+
+Obj *obj_copy(Obj *o);
+Obj *obj_list_internal(Obj *objs[]);
+
+#define obj_list(...) obj_list_internal((Obj*[]){__VA_ARGS__, NULL});
+
+bool obj_eq(Obj *a, Obj *b);
+bool is_true(Obj *o);
+
+Obj *obj_latest;
+int obj_total;
+
+Obj *global_env;
+
+Obj *nil;
+Obj *lisp_false;
+Obj *lisp_true;
+Obj *lisp_quote;
+Obj *error;
+Obj *ampersand;
+Obj *lisp_NULL;
+
+Obj *type_int;
+Obj *type_bool;
+Obj *type_string;
+Obj *type_list;
+Obj *type_lambda;
+Obj *type_primop;
+Obj *type_foreign;
+Obj *type_env;
+Obj *type_keyword;
+Obj *type_symbol;
+Obj *type_macro;
+Obj *type_void;
+Obj *type_float;
+Obj *type_ptr;
+

src/obj_string.c

@@ -0,0 +1,191 @@
+#include "obj_string.h"
+
+bool setting_print_lambda_body = true;
+
+void obj_string_mut_append(Obj *string_obj, const char *s2) {
+  assert(string_obj);
+  assert(string_obj->tag == 'S');
+  int string_obj_len = strlen(string_obj->s);
+  int s2_len = strlen(s2);
+  int total_length = (string_obj_len + s2_len);
+  char *s3 = realloc(string_obj->s, sizeof(char) * (total_length + 1));
+  s3[total_length] = '\0';
+  strncpy(s3 + string_obj_len, s2, s2_len);
+  string_obj->s = s3;
+}
+
+Obj *concat_c_strings(char *a, const char *b) {
+  Obj *s = obj_new_string(a);
+  obj_string_mut_append(s, b);
+  return s;
+}
+
+void add_indentation(Obj *total, int indent) {
+  for(int i = 0; i < indent; i++) {
+    obj_string_mut_append(total, " ");
+  }
+}
+
+void obj_to_string_internal(Obj *total, const Obj *o, bool prn, int indent) {
+  assert(o);
+  int x = indent;
+  if(o->tag == 'C') {
+    obj_string_mut_append(total, "(");
+    x++;
+    int save_x = x;
+    const Obj *p = o;
+    while(p && p->car) {
+      obj_to_string_internal(total, p->car, true, x);
+      if(p->cdr && p->cdr->tag != 'C') {
+      	obj_string_mut_append(total, " . ");
+      	obj_to_string_internal(total, o->cdr, true, x);
+      	break;
+      }
+      else if(p->cdr && p->cdr->car) {
+	if(/* p->car->tag == 'C' ||  */p->car->tag == 'E') {
+	  obj_string_mut_append(total, "\n");
+	  x = save_x;
+	  add_indentation(total, x);
+	}
+	else {
+	  obj_string_mut_append(total, " ");
+	  x++;
+	}
+      }
+      p = p->cdr;
+    }
+    obj_string_mut_append(total, ")");
+    x++;
+  }
+  else if(o->tag == 'E') {
+    obj_string_mut_append(total, "{");
+    x++;
+    Obj *p = o->bindings;
+    while(p && p->car) {
+      char *key_s = obj_to_string(p->car->car)->s;
+      obj_string_mut_append(total, key_s);
+      obj_string_mut_append(total, " ");
+      obj_to_string_internal(total, p->car->cdr, true, x + strlen(key_s) + 1);
+      p = p->cdr;
+      if(p && p->car && p->car->car) {
+	obj_string_mut_append(total, ", \n");
+	add_indentation(total, x);
+      }
+    }
+    obj_string_mut_append(total, "}");
+    if(o->parent) {
+      obj_string_mut_append(total, " -> \n");
+      Obj *parent_printout = obj_to_string(o->parent);
+      obj_string_mut_append(total, parent_printout->s);
+    }
+  }
+  else if(o->tag == 'I') {
+    static char temp[64];
+    snprintf(temp, 64, "%d", o->i);
+    obj_string_mut_append(total, temp);
+  }
+  else if(o->tag == 'V') {
+    static char temp[64];
+    snprintf(temp, 64, "%f", o->f32);
+    obj_string_mut_append(total, temp);
+  }
+  else if(o->tag == 'S') {
+    if(prn) {
+      obj_string_mut_append(total, "\"");
+    }
+    obj_string_mut_append(total, o->s);
+    if(prn) {
+      obj_string_mut_append(total, "\"");
+    }
+  }
+  else if(o->tag == 'Y') {
+    obj_string_mut_append(total, o->s);
+  }
+  else if(o->tag == 'K') {
+    obj_string_mut_append(total, ":");
+    obj_string_mut_append(total, o->s);
+  }
+  else if(o->tag == 'P') {
+    obj_string_mut_append(total, "<primop:");
+    static char temp[256];
+    snprintf(temp, 256, "%p", o->primop);
+    obj_string_mut_append(total, temp);
+    obj_string_mut_append(total, ">");
+  }
+  else if(o->tag == 'D') {
+    obj_string_mut_append(total, "<dylib:");
+    static char temp[256];
+    snprintf(temp, 256, "%p", o->primop);
+    obj_string_mut_append(total, temp);
+    obj_string_mut_append(total, ">");
+  }
+  else if(o->tag == 'Q') {
+    obj_string_mut_append(total, "<ptr:");
+    static char temp[256];
+    snprintf(temp, 256, "%p", o->primop);
+    obj_string_mut_append(total, temp);
+    obj_string_mut_append(total, ">");
+  }
+  else if(o->tag == 'F') {
+    obj_string_mut_append(total, "<ffi:");
+    static char temp[256];
+    snprintf(temp, 256, "%p", o->funptr);
+    obj_string_mut_append(total, temp);
+    obj_string_mut_append(total, ">");
+  }
+  else if(o->tag == 'L') {
+    if(setting_print_lambda_body) {
+      obj_string_mut_append(total, "(fn");
+      obj_string_mut_append(total, " ");
+      obj_string_mut_append(total, obj_to_string(o->params)->s);
+      obj_string_mut_append(total, " ");
+      obj_string_mut_append(total, obj_to_string(o->body)->s);
+      obj_string_mut_append(total, ")");
+    }
+    else {
+      obj_string_mut_append(total, "<lambda>");
+    }
+  }
+  else if(o->tag == 'M') {
+    if(setting_print_lambda_body) {
+      obj_string_mut_append(total, "(macro");
+      obj_string_mut_append(total, " ");
+      obj_string_mut_append(total, obj_to_string(o->params)->s);
+      obj_string_mut_append(total, " ");
+      obj_string_mut_append(total, obj_to_string(o->body)->s);
+      obj_string_mut_append(total, ")");
+    }
+    else {
+      obj_string_mut_append(total, "<macro>");
+    }
+  }
+  else {
+    printf("obj_to_string() can't handle type tag %c (%d).\n", o->tag, o->tag);
+    assert(false);
+  }
+}
+
+Obj *obj_to_string(const Obj *o) {
+  Obj *s = obj_new_string("");
+  obj_to_string_internal(s, o, true, 0);
+  return s;
+}
+
+Obj *obj_to_string_not_prn(const Obj *o) {
+  Obj *s = obj_new_string("");
+  obj_to_string_internal(s, o, false, 0);
+  return s;
+}
+
+void obj_print(Obj *o) {
+  assert(o);
+  Obj *s = obj_to_string(o);
+  printf("%s", s->s);
+}
+
+void obj_print_not_prn(Obj *o) {
+  Obj *s = obj_to_string_not_prn(o);
+  printf("%s", s->s);
+}
+
+

src/obj_string.h

@@ -0,0 +1,14 @@
+#pragma once
+
+#include "obj.h"
+
+void obj_string_mut_append(Obj *string_obj, const char *s2);
+Obj *concat_c_strings(char *a, const char *b);
+Obj *obj_to_string(const Obj *o);
+void obj_to_string_internal(Obj *total, const Obj *o, bool prn, int indent);
+Obj *obj_to_string(const Obj *o);
+Obj *obj_to_string_not_prn(const Obj *o);
+
+void obj_print(Obj *o);
+void obj_print_not_prn(Obj *o);
+

src/primops.h

@@ -0,0 +1,63 @@
+#pragma once
+
+#include "obj.h"
+
+#define define(name, value) env_extend(global_env, obj_new_symbol(name), value);
+#define register_primop(name, primop) env_extend(global_env, obj_new_symbol(name), obj_new_primop(primop));
+
+Obj *p_open_file(Obj** args, int arg_count);
+Obj *p_save_file(Obj** args, int arg_count);
+Obj *p_add(Obj** args, int arg_count);
+Obj *p_sub(Obj** args, int arg_count);
+Obj *p_mul(Obj** args, int arg_count);
+Obj *p_div(Obj** args, int arg_count);
+Obj *p_mod(Obj** args, int arg_count);
+Obj *p_eq(Obj** args, int arg_count);
+Obj *p_list(Obj** args, int arg_count);
+Obj *p_str(Obj** args, int arg_count);
+Obj *p_str_append_bang(Obj** args, int arg_count);
+Obj *p_str_replace(Obj** args, int arg_count);
+Obj *p_copy(Obj** args, int arg_count);
+Obj *p_print(Obj** args, int arg_count);
+Obj *p_prn(Obj** args, int arg_count);
+Obj *p_println(Obj** args, int arg_count);
+Obj *p_system(Obj** args, int arg_count);
+Obj *p_get(Obj** args, int arg_count);
+Obj *p_get_maybe(Obj** args, int arg_count);
+Obj *p_dict_set_bang(Obj** args, int arg_count);
+Obj *p_dict_remove_bang(Obj** args, int arg_count);
+Obj *p_rest(Obj** args, int arg_count);
+Obj *p_cons(Obj** args, int arg_count);
+Obj *p_cons_last(Obj** args, int arg_count);
+Obj *p_concat(Obj** args, int arg_count);
+Obj *p_nth(Obj** args, int arg_count);
+Obj *p_count(Obj** args, int arg_count);
+Obj *p_map(Obj** args, int arg_count);
+Obj *p_map2(Obj** args, int arg_count);
+Obj *p_register(Obj** args, int arg_count);
+Obj *p_register_variable(Obj** args, int arg_count);
+Obj *p_register_builtin(Obj** args, int arg_count);
+Obj *p_first(Obj** args, int arg_count);
+Obj *p_filter(Obj** args, int arg_count);
+Obj *p_reduce(Obj** args, int arg_count);
+Obj *p_apply(Obj** args, int arg_count);
+Obj *p_type(Obj** args, int arg_count);
+Obj *p_lt(Obj** args, int arg_count);
+Obj *p_env(Obj** args, int arg_count);
+Obj *p_load_lisp(Obj** args, int arg_count);
+Obj *p_load_dylib(Obj** args, int arg_count);
+Obj *p_unload_dylib(Obj** args, int arg_count);
+Obj *p_read(Obj** args, int arg_count);
+Obj *p_read_many(Obj** args, int arg_count);
+Obj *p_code(Obj** args, int arg_count);
+Obj *p_now(Obj** args, int arg_count);
+Obj *p_name(Obj** args, int arg_count);
+Obj *p_symbol(Obj** args, int arg_count);
+Obj *p_error(Obj** args, int arg_count);
+Obj *p_keys(Obj** args, int arg_count);
+Obj *p_values(Obj** args, int arg_count);
+Obj *p_signature(Obj** args, int arg_count);
+Obj *p_eval(Obj** args, int arg_count);
+Obj *p_and(Obj** args, int arg_count);
+
+Obj *register_ffi_internal(char *name, VoidFn funptr, Obj *args, Obj *return_type_obj);

src/reader.c

@@ -0,0 +1,254 @@
+#include "reader.h"
+#include <ctype.h>
+
+int read_line_nr;
+int read_line_pos;
+int read_pos = 0;
+#define CURRENT s[read_pos]
+
+bool is_ok_in_symbol(char c, bool initial) {
+  if(isdigit(c) && initial) {
+    return false;
+  }
+  else if(c == '\'' && initial) {
+    return true;
+  }
+  else if(c == '!' || c == '?' || c == '<' || c == '>' || c == '=' || c == '%' || 
+	  c == '+' || c == '*' || c == '/' || c == '-' || c == '_') {
+    return true;
+  }
+  else if(isalpha(c) || isdigit(c)) {
+    return true;
+  }
+  else {
+    return false;
+  }
+}
+
+bool is_whitespace(char c) {
+  return c == ' ' || c == '\t' || c == '\n' || c == ',';
+}
+
+void hit_new_line() {
+  read_line_nr++;
+  read_line_pos = 0;
+}
+
+void skip_whitespace(char *s) {
+  while(is_whitespace(CURRENT)) {
+    if(CURRENT == '\n') {
+      hit_new_line();
+    }
+    read_pos++;
+  }
+  if(CURRENT == ';') {
+    while(CURRENT != '\n' && CURRENT != '\0') {
+      read_pos++;
+    }
+    read_pos++;
+    skip_whitespace(s);
+  }
+}
+
+void print_read_pos() {
+  printf("Line: %d, pos: %d.\n", read_line_nr, read_line_pos);
+}
+
+Obj *read_internal(Obj *env, char *s) {
+  skip_whitespace(s);
+
+  if(CURRENT == ')' || CURRENT == ']') {
+    read_pos++;
+    printf("Too many parenthesis at the end.\n");
+    print_read_pos();
+    return nil;
+  }
+  else if(CURRENT == '(' || CURRENT == '[') {
+    Obj *list = obj_new_cons(NULL, NULL);
+    Obj *prev = list;
+    read_pos++;
+    while(1) {
+      skip_whitespace(s);
+      if(CURRENT == '\0') {
+	printf("Missing parenthesis at the end.\n");
+	print_read_pos();
+	return nil;
+      }
+      if(CURRENT == ')' || CURRENT == ']') {
+	read_pos++;
+	break;
+      }
+      Obj *o = read_internal(env, s);
+      Obj *new = obj_new_cons(NULL, NULL);
+      prev->car = o;
+      prev->cdr = new;
+      prev = new;
+    }
+    return list;
+  }
+  else if(CURRENT == '{') {
+    Obj *list = obj_new_cons(NULL, NULL);
+    Obj *prev = list;
+    read_pos++;
+    while(1) {
+      skip_whitespace(s);
+      if(CURRENT == '\0') {
+	printf("Missing } at the end.\n");
+	print_read_pos();
+	return nil;
+      }
+      if(CURRENT == '}') {
+	read_pos++;
+	break;
+      }
+      Obj *key = read_internal(env, s);
+
+      if(CURRENT == '}') {
+	printf("Uneven number of forms in dictionary.\n");
+	print_read_pos();
+	return nil;
+      }
+      
+      Obj *value = read_internal(env, s);
+      
+      Obj *new = obj_new_cons(NULL, NULL);
+      Obj *pair = obj_new_cons(key, value);
+      prev->car = pair;
+      prev->cdr = new;
+      prev = new;
+    }
+    Obj *dict = obj_new_environment(NULL);
+    dict->bindings = list;
+    return dict;
+  }
+  else if(CURRENT == '&') {
+    read_pos++;
+    return ampersand;
+  }
+  else if(isdigit(CURRENT) || (CURRENT == '-' && isdigit(s[read_pos + 1]))) {
+    int negator = 1;
+    if(CURRENT == '-') {
+      negator = -1;
+      read_pos++;
+    }
+    bool is_floating = false;
+    char scratch[32];
+    int i = 0;
+    while(isdigit(CURRENT)) {
+      scratch[i++] = CURRENT;
+      read_pos++;
+      if(CURRENT == '.' && !is_floating) {
+	scratch[i++] = CURRENT;
+	is_floating = true;
+	read_pos++;
+      }
+      if(CURRENT == 'f') {
+	is_floating = true;
+	read_pos++;
+	break;
+      }
+    }
+    scratch[i] = '\0';
+    if(is_floating) {
+      float x = atof(scratch) * negator;
+      return obj_new_float(x);
+    } else {
+      int num = atoi(scratch) * negator;
+      return obj_new_int(num);
+    }
+  }
+  else if(CURRENT == '\'') {
+    read_pos++;
+    Obj *sym = read_internal(env, s);
+    Obj *cons2 = obj_new_cons(sym, nil);
+    Obj *cons1 = obj_new_cons(lisp_quote, cons2);
+    return cons1;
+  }
+  else if(is_ok_in_symbol(CURRENT, true)) {
+    char name[512];
+    int i = 0;
+    while(is_ok_in_symbol(CURRENT, false)) {
+      name[i++] = CURRENT;
+      read_pos++;
+    }
+    name[i] = '\0';
+    return obj_new_symbol(name);
+  }
+  else if(CURRENT == ':') {
+    read_pos++;
+    char name[512];
+    int i = 0;
+    while(is_ok_in_symbol(CURRENT, true)) {
+      name[i++] = CURRENT;
+      read_pos++;
+    }
+    name[i] = '\0';
+    return obj_new_keyword(name);
+  }
+  else if(CURRENT == '"') {
+    read_pos++;
+    char str[512];
+    int i = 0;
+    while(CURRENT != '"') {
+      if(CURRENT == '\0') {
+	printf("Missing quote in string\n");
+	break;
+      }
+      else if(CURRENT == '\\') {
+	read_pos++;
+	if(CURRENT == 'n') {
+	  str[i++] = '\n';
+	}
+	else if(CURRENT == '"') {
+	  str[i++] = '"';
+	}
+	else if(CURRENT == '\\') {
+	  str[i++] = '\\';
+	}
+	else {
+	  printf("Can't read '%c' after backslash (%d)\n", CURRENT, CURRENT);
+	  read_pos++;
+	  return nil;
+	}
+	read_pos++;
+      }
+      else {
+	str[i++] = CURRENT;
+	read_pos++;
+      }
+    }
+    str[i] = '\0';
+    read_pos++;
+    return obj_new_string(str);
+  }
+  else if(CURRENT == 0) {
+    return nil;
+  }
+  else {
+    printf("Can't read '%c' (%d)\n", CURRENT, CURRENT);
+    read_pos++;
+    return nil;
+  }
+}
+
+Obj *read_string(Obj *env, char *s) {
+  read_line_nr = 1;
+  read_line_pos = 0;
+  read_pos = 0;
+  Obj *top_forms = NULL;
+  Obj *prev = NULL;
+  while(s[read_pos] != '\0') {
+    Obj *o = read_internal(env, s);
+    Obj *cons = obj_new_cons(NULL, NULL);
+    cons->car = o;
+    if(!top_forms) {
+      top_forms = cons;
+    }
+    if(prev) {
+      prev->cdr = cons;
+    }
+    prev = cons;
+    skip_whitespace(s);
+  }
+  return top_forms;
+}

src/reader.h

@@ -0,0 +1,5 @@
+#pragma once
+
+#include "obj.h"
+
+Obj *read_string(Obj *env, char *s);

src/repl.c

@@ -0,0 +1,161 @@
+#include "repl.h"
+#include "eval.h"
+#include "gc.h"
+#include "obj_string.h"
+#include "reader.h"
+#include "eval.h"
+#include "env.h"
+#include "primops.h"
+
+#define MAX_INPUT_BUFFER_SIZE 2048
+char input[MAX_INPUT_BUFFER_SIZE];
+
+void repl(Obj *env) {
+  while(1) {
+    printf("\e[36mλ>\e[0m ");
+    fgets(input, MAX_INPUT_BUFFER_SIZE, stdin);
+    if(strcmp(input, "q\n") == 0) {
+      break;
+    }
+    eval_text(env, input, true);
+    while(stack_pos > 0) {
+      //printf("°"); // Popping extra stack value
+      stack_pop();
+    }
+    printf("\n");
+    //assert(stack_pos == 0);
+    //stack_print();
+  }
+  gc_sweep();
+}
+
+void env_new_global() {
+  global_env = obj_new_environment(NULL);
+
+  nil = obj_new_cons(NULL, NULL);
+  define("nil", nil);
+
+  lisp_false = obj_new_symbol("false");
+  define("false", lisp_false);
+  
+  lisp_true = obj_new_symbol("true");
+  define("true", lisp_true);
+
+  lisp_quote = obj_new_symbol("quote");
+  define("quote", lisp_quote);
+
+  ampersand = obj_new_symbol("&");
+  define("&", ampersand);
+
+  lisp_NULL = obj_new_ptr(NULL);
+  define("NULL", lisp_NULL);
+
+  type_int = obj_new_keyword("int");
+  define("type-int", type_int); // without this it will get GC'd!
+
+  type_bool = obj_new_keyword("bool");
+  define("type-bool", type_bool);
+
+  type_float = obj_new_keyword("float");
+  define("type-float", type_float);
+  
+  type_string = obj_new_keyword("string");
+  define("type-string", type_string);
+
+  type_symbol = obj_new_keyword("symbol");
+  define("type-symbol", type_symbol);
+  
+  type_keyword = obj_new_keyword("keyword");
+  define("type-keyword", type_keyword);
+  
+  type_foreign = obj_new_keyword("foreign");
+  define("type-foreign", type_foreign);
+  
+  type_primop = obj_new_keyword("primop");
+  define("type-primop", type_primop);
+  
+  type_env = obj_new_keyword("env");
+  define("type-env", type_env);
+  
+  type_macro = obj_new_keyword("macro");
+  define("type-macro", type_macro);
+
+  type_lambda = obj_new_keyword("lambda");
+  define("type-lambda", type_lambda);
+  
+  type_list = obj_new_keyword("list");
+  define("type-list", type_list);
+
+  type_void = obj_new_keyword("void");
+  define("type-void", type_void);
+
+  type_ptr = obj_new_keyword("ptr");
+  define("type-ptr", type_ptr);
+
+  register_primop("open", p_open_file);
+  register_primop("save", p_save_file);
+  register_primop("+", p_add);
+  register_primop("-", p_sub);
+  register_primop("*", p_mul);
+  register_primop("/", p_div);
+  register_primop("mod", p_mod);
+  register_primop("=", p_eq);
+  register_primop("list", p_list);
+  register_primop("str", p_str);
+  register_primop("str-append!", p_str_append_bang);
+  register_primop("str-replace", p_str_replace);
+  register_primop("register", p_register);
+  register_primop("register-variable", p_register_variable);
+  register_primop("register-builtin", p_register_builtin);
+  register_primop("print", p_print);
+  register_primop("println", p_println);
+  register_primop("prn", p_prn);
+  register_primop("system", p_system);
+  register_primop("get", p_get);
+  register_primop("get-maybe", p_get_maybe);
+  register_primop("dict-set!", p_dict_set_bang);
+  register_primop("dict-remove!", p_dict_remove_bang);
+  register_primop("first", p_first);
+  register_primop("rest", p_rest);
+  register_primop("cons", p_cons);
+  register_primop("cons-last", p_cons_last);
+  register_primop("concat", p_concat);
+  register_primop("nth", p_nth);
+  register_primop("count", p_count);
+  register_primop("map", p_map);
+  register_primop("map2", p_map2);
+  register_primop("filter", p_filter);
+  register_primop("reduce", p_reduce);
+  register_primop("apply", p_apply);
+  register_primop("type", p_type);
+  register_primop("<", p_lt);
+  register_primop("env", p_env);
+  register_primop("load-lisp", p_load_lisp);
+  register_primop("load-dylib", p_load_dylib);
+  register_primop("unload-dylib", p_unload_dylib);
+  register_primop("read", p_read);
+  register_primop("read-many", p_read_many);
+  register_primop("code", p_code);
+  register_primop("copy", p_copy);
+  register_primop("now", p_now);
+  register_primop("name", p_name);
+  register_primop("symbol", p_symbol);
+  register_primop("error", p_error);
+  register_primop("keys", p_keys);
+  register_primop("values", p_values);
+  register_primop("signature", p_signature);
+  register_primop("eval", p_eval);
+  register_primop("and", p_and);
+  //register_primop("nullp", p_null_predicate);
+  
+  Obj *abs_args = obj_list(type_int);
+  register_ffi_internal("abs", (VoidFn)abs, abs_args, type_int);
+
+  Obj *exit_args = obj_list(type_int);
+  register_ffi_internal("exit", (VoidFn)exit, exit_args, type_void);
+
+  Obj *getenv_args = obj_list(type_string);
+  register_ffi_internal("getenv", (VoidFn)getenv, getenv_args, type_string);
+  
+  //printf("Global env: %s\n", obj_to_string(env)->s);
+}

src/repl.h

@@ -0,0 +1,7 @@
+#pragma once
+
+#include "obj.h"
+
+void repl(Obj *env);
+void env_new_global();
+