move all globals into an execution context

src/Makefile

@@ -1,7 +1,7 @@
 CC = gcc
 CFLAGS := -Wall -g $(shell pkg-config --cflags glib-2.0)
 LFLAGS := $(shell pkg-config --libs glib-2.0)
-OBJS = lake.o env.o int.o string.o sym.o parse.o bool.o list.o eval.o \
+OBJS = lake.o env.o int.o string.o sym.o parse.o list.o eval.o \
        symtable.o fn.o dlist.o primitive.o comment.o
 
 all: lake

src/bool.c

@@ -1,38 +0,0 @@
-/** 
-  * bool.c
-  * Lake Scheme
-  *
-  * Copyright 2011 Sami Samhuri
-  * MIT License
-  *
-  */
-
-#include <glib.h>
-#include "bool.h"
-#include "lake.h"
-#include "string.h"
-
-LakeBool *bool_from_int(int n)
-{
-    return n ? T : F;
-}
-
-char *bool_repr(LakeBool *b)
-{
-	return g_strdup(BOOL_VAL(b) ? "#t" : "#f");
-}
-
-LakeStr *bool_to_str(LakeBool *b)
-{
-	return str_from_c(BOOL_VAL(b) ? "#t" : "#f");
-}
-
-LakeVal* bool_and(LakeVal *a, LakeVal *b)
-{
-    return IS_TRUTHY(a) && IS_TRUTHY(b) ? b : a;
-}
-
-LakeVal* bool_or(LakeVal *a, LakeVal *b)
-{
-    return IS_TRUTHY(a) ? a : b;
-}

src/bool.h

@@ -1,22 +0,0 @@
-/** 
-  * bool.h
-  * Lake Scheme
-  *
-  * Copyright 2011 Sami Samhuri
-  * MIT License
-  *
-  */
-
-#ifndef _LAKE_BOOL_H
-#define _LAKE_BOOL_H 1
-
-#include <glib.h>
-#include "lake.h"
-
-LakeBool *bool_from_int(int b);
-LakeStr *bool_to_str(LakeBool *b);
-char *bool_repr(LakeBool *b);
-LakeVal* bool_and(LakeVal *a, LakeVal *b);
-LakeVal* bool_or(LakeVal *a, LakeVal *b);
-
-#endif

src/env.c

@@ -14,16 +14,6 @@
 #include "env.h"
 #include "symtable.h"
 
-static Env *_top = NULL;
-
-Env *env_toplevel(void)
-{
-    if (!_top) {
-        _top = env_make(NULL);
-    }
-    return _top;
-}
-
 Env *env_make(Env *parent)
 {
     Env *env = g_malloc(sizeof(Env));

src/env.h

@@ -20,8 +20,6 @@ typedef struct env Env;
 
 #include "lake.h"
 
-Env *env_toplevel(void);
-
 Env *env_make(Env *parent);
 LakeVal *env_define(Env *env, LakeSym *key, LakeVal *val);
 LakeVal *env_set(Env *env, LakeSym *key, LakeVal *val);

src/eval.c

@@ -14,11 +14,8 @@
 #include "eval.h"
 #include "fn.h"
 #include "lake.h"
-#include "symtable.h"
 
-typedef LakeVal *(*special_form_handler)(Env *env, LakeList *expr);
+typedef LakeVal *(*special_form_handler)(LakeCtx *ctx, Env *env, LakeList *expr);
-static GHashTable *special_form_handlers = NULL;
-static void init_special_form_handlers(void);
 
 static void invalid_special_form(LakeList *expr, char *detail)
 {
@@ -26,7 +23,7 @@ static void invalid_special_form(LakeList *expr, char *detail)
 }
 
 /* expr begins with the symbol "quote" so the quoted value is the 2nd value */
-static LakeVal *_quote(Env *env, LakeList *expr)
+static LakeVal *_quote(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     if (LIST_N(expr) == 2) {
         return list_pop(expr);
@@ -35,33 +32,33 @@ static LakeVal *_quote(Env *env, LakeList *expr)
     return NULL;
 }
 
-static LakeVal *_and(Env *env, LakeList *expr)
+static LakeVal *_and(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* drop the "and" symbol */
     list_shift(expr);
     
     /* (and ...) */
-    LakeVal *result = LIST_N(expr) ? eval(env, list_shift(expr)) : VAL(T);
+    LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T);
-    while (IS_TRUTHY(result) && LIST_N(expr) > 0) {
+    while (IS_TRUTHY(ctx, result) && LIST_N(expr) > 0) {
-        result = bool_and(result, eval(env, list_shift(expr)));
+        result = BOOL_AND(ctx, result, eval(ctx, env, list_shift(expr)));
     }
     return result;
 }
 
-static LakeVal *_or(Env *env, LakeList *expr)
+static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* drop the "or" symbol */
     list_shift(expr);
     
     /* (or ...) */
-    LakeVal *result = LIST_N(expr) ? eval(env, list_shift(expr)) : VAL(F);
+    LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F);
-    while (IS_FALSY(result) && LIST_N(expr) > 0) {
+    while (IS_FALSY(ctx, result) && LIST_N(expr) > 0) {
-        result = bool_or(result, eval(env, list_shift(expr)));
+        result = BOOL_OR(ctx, result, eval(ctx, env, list_shift(expr)));
     }
     return result;
 }
 
-static LakeVal *_setB(Env *env, LakeList *expr)
+static LakeVal *_setB(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* (set! x 42) */
     if (LIST_N(expr) == 3 && IS(TYPE_SYM, LIST_VAL(expr, 1))) {
@@ -78,7 +75,7 @@ static LakeVal *_setB(Env *env, LakeList *expr)
     return NULL;
 }
 
-static LakeVal *_define(Env *env, LakeList *expr)
+static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* TODO: make these more robust, check all expected params */
     
@@ -87,7 +84,7 @@ static LakeVal *_define(Env *env, LakeList *expr)
         list_shift(expr); /* drop the "define" symbol */
         LakeSym *var = SYM(list_shift(expr));
         LakeVal *form = list_shift(expr);
-        env_define(env, var, eval(env, form));
+        env_define(env, var, eval(ctx, env, form));
     }
     
     /* (define (inc x) (+ 1 x)) */
@@ -117,7 +114,7 @@ static LakeVal *_define(Env *env, LakeList *expr)
     return NULL;
 }
 
-static LakeVal *_lambda(Env *env, LakeList *expr)
+static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* (lambda (a b c) ...) */
     if (LIST_N(expr) >= 3 && IS(TYPE_LIST, LIST_VAL(expr, 1))) {
@@ -146,26 +143,26 @@ static LakeVal *_lambda(Env *env, LakeList *expr)
     }
 }
 
-static LakeVal *_if(Env *env, LakeList *expr)
+static LakeVal *_if(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     if (LIST_N(expr) != 3) {
         invalid_special_form(expr, "if requires 3 parameters");
         return NULL;
     }
     list_shift(expr); /* "if" token */
-    LakeVal *cond = eval(env, list_shift(expr));
+    LakeVal *cond = eval(ctx, env, list_shift(expr));
-    if (IS_TRUTHY(cond)) {
+    if (IS_TRUTHY(ctx, cond)) {
-        return eval(env, list_shift(expr));
+        return eval(ctx, env, list_shift(expr));
     }
     else {
-        return eval(env, LIST_VAL(expr, 1));
+        return eval(ctx, env, LIST_VAL(expr, 1));
     }
 }
 
-static LakeVal *_cond(Env *env, LakeList *expr)
+static LakeVal *_cond(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     static LakeVal *ELSE = NULL;
-    if (!ELSE) ELSE = VAL(sym_intern("else"));
+    if (!ELSE) ELSE = VAL(sym_intern(ctx, "else"));
 
     list_shift(expr); /* "cond" token */
     LakeVal *pred;
@@ -177,31 +174,30 @@ static LakeVal *_cond(Env *env, LakeList *expr)
         }
         conseq = LIST(list_shift(expr));
         pred = list_shift(conseq);
-        if (pred == ELSE || IS_TRUTHY(eval(env, pred))) {
+        if (pred == ELSE || IS_TRUTHY(ctx, eval(ctx, env, pred))) {
-            return eval_exprs1(env, conseq);
+            return eval_exprs1(ctx, env, conseq);
         }
     }
     return NULL;
 }
 
-static LakeVal *_when(Env *env, LakeList *expr)
+static LakeVal *_when(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     if (LIST_N(expr) < 2) {
         invalid_special_form(expr, "when requires at least 2 parameters");
         return NULL;
     }
     list_shift(expr); /* "when" token */
-    LakeVal *cond = eval(env, list_shift(expr));
+    LakeVal *cond = eval(ctx, env, list_shift(expr));
-    return IS_TRUTHY(cond) ? eval_exprs1(env, expr) : NULL;
+    return IS_TRUTHY(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL;
 }
 
-static void init_special_form_handlers(void)
+void init_special_form_handlers(LakeCtx *ctx)
 {
-    #define HANDLER(name, fn) g_hash_table_insert(special_form_handlers, \
+    #define HANDLER(name, fn) g_hash_table_insert(ctx->special_form_handlers, \
-                                                  sym_intern(name),      \
+                                                  sym_intern(ctx, name),      \
                                                   (gpointer)fn)
 
-    special_form_handlers = symtable_make();
     /* HANDLER("load", &load_special_form); */
     HANDLER("quote", &_quote);
     HANDLER("and", &_and);
@@ -217,38 +213,31 @@ static void init_special_form_handlers(void)
     /* HANDLER("letrec", &_letrec); */
 }
 
-gboolean is_special_form(LakeList *expr)
+gboolean is_special_form(LakeCtx *ctx, LakeList *expr)
 {
-    if (special_form_handlers == NULL) {
-        init_special_form_handlers();
-    }
-    
     LakeVal *head = LIST_VAL(expr, 0);
     if (!IS(TYPE_SYM, head)) return FALSE;
-    GList *special_form_names = g_hash_table_get_keys(special_form_handlers);
+    GList *special_form_names = g_hash_table_get_keys(ctx->special_form_handlers);
     return !!g_list_find(special_form_names, SYM(head));
 }
 
-static special_form_handler get_special_form_handler(LakeSym *name)
+static special_form_handler get_special_form_handler(LakeCtx *ctx, LakeSym *name)
 {
-    if (special_form_handlers == NULL) {
+    return (special_form_handler)g_hash_table_lookup(ctx->special_form_handlers, name);
-        init_special_form_handlers();
-    }
-    return (special_form_handler)g_hash_table_lookup(special_form_handlers, name);
 }
 
-static LakeVal *eval_special_form(Env *env, LakeList *expr)
+static LakeVal *eval_special_form(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     LakeSym *name = SYM(LIST_VAL(expr, 0));
-    special_form_handler handler = get_special_form_handler(name);
+    special_form_handler handler = get_special_form_handler(ctx, name);
     if (handler) {
-        return handler(env, list_copy(expr));
+        return handler(ctx, env, list_copy(expr));
     }
     ERR("unrecognized special form: %s", SYM_S(name));
     return NULL;
 }
 
-LakeVal *eval(Env *env, LakeVal *expr)
+LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr)
 {
     LakeVal *result;
     LakeList *list;
@@ -282,11 +271,11 @@ LakeVal *eval(Env *env, LakeVal *expr)
             result = expr;
         }
         else {
-            if (is_special_form(list)) {
+            if (is_special_form(ctx, list)) {
-                result = eval_special_form(env, list);
+                result = eval_special_form(ctx, env, list);
             }
             else {
-                LakeVal *fn = eval(env, LIST_VAL(list, 0));
+                LakeVal *fn = eval(ctx, env, LIST_VAL(list, 0));
                 if (!fn) {
                     return NULL;
                 }
@@ -294,7 +283,7 @@ LakeVal *eval(Env *env, LakeVal *expr)
                 int i;
                 LakeVal *v;
                 for (i = 1; i < LIST_N(list); ++i) {
-                    v = eval(env, LIST_VAL(list, i));
+                    v = eval(ctx, env, LIST_VAL(list, i));
                     if (v != NULL) {
                         list_append(args, v);
                     }
@@ -304,7 +293,7 @@ LakeVal *eval(Env *env, LakeVal *expr)
                         goto done;
                     }
                 }
-                result = apply(fn, args);
+                result = apply(ctx, fn, args);
             }
         }
         break;
@@ -317,32 +306,32 @@ LakeVal *eval(Env *env, LakeVal *expr)
     done: return result;
 }
 
-LakeList *eval_exprs(Env *env, LakeList *exprs)
+LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs)
 {
     LakeList *results = list_make_with_capacity(LIST_N(exprs));
     int i;
     for (i = 0; i < LIST_N(exprs); ++i) {
-        list_append(results, eval(env, LIST_VAL(exprs, i)));
+        list_append(results, eval(ctx, env, LIST_VAL(exprs, i)));
     }
     return results;
 }
 
-LakeVal *eval_exprs1(Env *env, LakeList *exprs)
+LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs)
 {
-    LakeList *results = eval_exprs(env, exprs);
+    LakeList *results = eval_exprs(ctx, env, exprs);
     LakeVal *result = list_pop(results);
     list_free(results);
     return result;
 }
 
-LakeVal *apply(LakeVal *fnVal, LakeList *args)
+LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
 {
     LakeVal *result = NULL;
     if (IS(TYPE_PRIM, fnVal)) {
         LakePrimitive *prim = PRIM(fnVal);
         int arity = prim->arity;
         if (arity == ARITY_VARARGS || LIST_N(args) == arity) {
-            result = prim->fn(args);
+            result = prim->fn(ctx, args);
         }
         else {
             ERR("%s expects %d params but got %zu", prim->name, arity, LIST_N(args));
@@ -381,7 +370,7 @@ LakeVal *apply(LakeVal *fnVal, LakeList *args)
         }
 
         /* evaluate body */
-        result = eval_exprs1(env, fn->body);
+        result = eval_exprs1(ctx, env, fn->body);
     }
     else {
         ERR("not a function: %s", repr(fnVal));

src/eval.h

@@ -13,10 +13,11 @@
 #include "env.h"
 #include "lake.h"
 
-LakeVal *eval(Env *env, LakeVal *expr);
+LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr);
-LakeList *eval_exprs(Env *env, LakeList *exprs);
+LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs);
-LakeVal *eval_exprs1(Env *env, LakeList *exprs);
+LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs);
-LakeVal *apply(LakeVal *fnVal, LakeList *args);
+LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args);
-gboolean is_special_form(LakeList *expr);
+gboolean is_special_form(LakeCtx *ctx, LakeList *expr);
+void init_special_form_handlers(LakeCtx *ctx);
 
 #endif

src/int.c

@@ -8,8 +8,8 @@
   */
 
 #include <glib.h>
-#include "bool.h"
 #include "int.h"
+#include "lake.h"
 
 static LakeInt *int_alloc(void)
 {

src/lake.c

@@ -23,11 +23,7 @@
 #include "parse.h"
 #include "primitive.h"
 #include "string.h"
-
+#include "symtable.h"
-static LakeBool _T = { { TYPE_BOOL, sizeof(LakeBool) }, TRUE };
-static LakeBool _F = { { TYPE_BOOL, sizeof(LakeBool) }, FALSE };
-LakeBool *T = &_T;
-LakeBool *F = &_F;
 
 char *type_name(LakeVal *expr)
 {
@@ -50,7 +46,7 @@ static char first_char(char *s)
     return c;
 }
 
-static LakeVal *prompt_read(Env *env, char *prompt)
+static LakeVal *prompt_read(LakeCtx *ctx, Env *env, char *prompt)
 {
     static int n = 1024;
     printf("%s", prompt);
@@ -69,20 +65,20 @@ static LakeVal *prompt_read(Env *env, char *prompt)
 	
 	/* parse list expressions */
 	if (first_char(buf) == '(') {
-        return parse_expr(buf, strlen(buf));
+        return parse_expr(ctx, buf, strlen(buf));
     }
     
     /* try to parse a naked call without parens
        (makes the repl more palatable) */
-    LakeList *list = parse_naked_list(buf, strlen(buf));
+    LakeList *list = parse_naked_list(ctx, buf, strlen(buf));
-    if (!list) return NULL;
+    if (!list || LIST_N(list) == 0) return NULL;
 
     LakeVal *result;
     
     /* naked call */
     LakeVal *head;
-    if (is_special_form(list) ||
+    if (is_special_form(ctx, list) ||
-        (LIST_N(list) > 1 && (head = eval(env, LIST_VAL(list, 0))) && CALLABLE(head))) {
+        (LIST_N(list) > 1 && (head = eval(ctx, env, LIST_VAL(list, 0))) && CALLABLE(head))) {
         result = VAL(list);
     }
 
@@ -109,7 +105,7 @@ char *repr(LakeVal *expr)
         break;
 
     case TYPE_BOOL:
-        s = bool_repr(BOOL(expr));
+        s = BOOL_REPR(BOOL(expr));
         break;
 
     case TYPE_INT:
@@ -192,20 +188,20 @@ gboolean lake_equal(LakeVal *a, LakeVal *b)
     }
 }
 
-static void run_repl(Env *env)
+static void run_repl(LakeCtx *ctx, Env *env)
 {
     puts("Lake Scheme v" LAKE_VERSION);
     LakeVal *expr;
     LakeVal *result;
     for (;;) {
-        expr = prompt_read(env, "> ");
+        expr = prompt_read(ctx, env, "> ");
         if (expr == VAL(EOF)) break;
         if (expr == VAL(PARSE_ERR)) {
             ERR("parse error");
             continue;
         }
         if (expr) {
-            result = eval(env, expr);
+            result = eval(ctx, env, expr);
             if (result) print(result);
         }
     }
@@ -246,10 +242,32 @@ char *read_file(char const *filename)
     }
 }
 
+LakeBool *bool_make(gboolean val)
+{
+    LakeBool *b = g_malloc(sizeof(LakeBool));
+    VAL(b)->type = TYPE_BOOL;
+    VAL(b)->size = sizeof(LakeBool);
+    b->val = val;
+    return b;
+}
+
+LakeCtx *lake_init(void)
+{
+    LakeCtx *ctx = g_malloc(sizeof(LakeCtx));
+    ctx->toplevel = env_make(NULL);
+    ctx->symbols = g_hash_table_new(g_str_hash, g_str_equal);
+    ctx->special_form_handlers = symtable_make();
+    ctx->T = bool_make(TRUE);
+    ctx->F = bool_make(FALSE);
+    return ctx;
+}
+
 int main (int argc, char const *argv[])
 {
-    /* create a top level environment */
+    /* create an execution context */
-    Env *env = primitive_bindings();
+    LakeCtx *ctx = lake_init();
+    bind_primitives(ctx);
+    init_special_form_handlers(ctx);
 
     /* create and bind args */
     LakeVal **argVals = g_malloc(argc * sizeof(LakeVal *));
@@ -259,21 +277,21 @@ int main (int argc, char const *argv[])
     }
     LakeList *args = list_from_array(argc, argVals);
     free(argVals);
-    env_define(env, sym_intern("args"), VAL(args));
+    env_define(ctx->toplevel, sym_intern(ctx, "args"), VAL(args));
     
     /* if a filename is given load the file */
     if (argc > 1) {
         char *text = read_file(argv[1]);
         if (text) {
-            LakeList *exprs = parse_exprs(text, strlen(text));
+            LakeList *exprs = parse_exprs(ctx, text, strlen(text));
             if (exprs) {
-                eval_exprs(env, exprs);
+                eval_exprs(ctx, ctx->toplevel, exprs);
             }
         }
     }
     
     /* run the repl */
-    run_repl(env);
+    run_repl(ctx, ctx->toplevel);
     
     return 0;
 }

src/lake.h

@@ -65,14 +65,15 @@ struct lake_bool {
 };
 typedef struct lake_bool LakeBool;
 
-LakeBool *T;
-LakeBool *F;
-
 #define BOOL_VAL(x) (x->val)
-#define IS_TRUE(x) (VAL(x) == VAL(T))
+#define IS_TRUE(ctx, x) (VAL(x) == VAL(ctx->T))
-#define IS_FALSE(x) (VAL(x) == VAL(F))
+#define IS_FALSE(ctx, x) (VAL(x) == VAL(ctx->F))
-#define IS_TRUTHY(x) (!IS_FALSE(x))
+#define IS_TRUTHY(ctx, x) (!IS_FALSE(ctx, x))
-#define IS_FALSY(x) (IS_FALSE(x))
+#define IS_FALSY(ctx, x) (IS_FALSE(ctx, x))
+#define BOOL_FROM_INT(ctx, n) (n ? ctx->T : ctx->F)
+#define BOOL_REPR(b) (g_strdup(BOOL_VAL(b) ? "#t" : "#f"))
+#define BOOL_AND(ctx, a, b) (IS_TRUTHY(ctx, a) && IS_TRUTHY(ctx, b) ? b : a)
+#define BOOL_OR(ctx, a, b) (IS_TRUTHY(ctx, a) ? a : b)
 
 struct lake_int {
     LakeVal base;
@@ -114,7 +115,19 @@ typedef struct lake_dlist LakeDottedList;
 #define DLIST_HEAD(x) (x->head)
 #define DLIST_TAIL(x) (x->tail)
 
-typedef LakeVal *(*lake_prim)(LakeList *args);
+#include "env.h"
+
+/* Execution context */
+struct lake_ctx {
+    Env *toplevel;
+    GHashTable *symbols;
+    GHashTable *special_form_handlers;
+    LakeBool *T;
+    LakeBool *F;
+};
+typedef struct lake_ctx LakeCtx;
+
+typedef LakeVal *(*lake_prim)(LakeCtx *ctx, LakeList *args);
 
 struct lake_primitive {
 	LakeVal base;
@@ -127,7 +140,6 @@ typedef struct lake_primitive LakePrimitive;
 #define PRIM_ARITY(x) (x->arity)
 #define ARITY_VARARGS -1
 
-#include "env.h"
 
 struct lake_fn {
 	LakeVal base;
@@ -164,7 +176,6 @@ char *repr(LakeVal *val);
 #define OOM() DIE("%s:%d out of memory", __FILE__, __LINE__)
 
 #include "sym.h"
-#include "bool.h"
 #include "int.h"
 #include "string.h"
 #include "list.h"

src/parse.c

@@ -24,6 +24,7 @@ struct context {
     size_t n;
     size_t i;
     size_t mark;
+    LakeCtx *lake_ctx;
 };
 typedef struct context Ctx;
 
@@ -46,17 +47,17 @@ static void warn_trailing(Ctx *ctx)
     }
 }
 
-LakeVal *parse_expr(char *s, size_t n)
+LakeVal *parse_expr(LakeCtx *lake_ctx, char *s, size_t n)
 {
-    Ctx ctx = { s, n, 0, 0 };
+    Ctx ctx = { s, n, 0, 0, lake_ctx };
     LakeVal *result = _parse_expr(&ctx);
     warn_trailing(&ctx);
     return result;
 }
 
-LakeList *parse_exprs(char *s, size_t n)
+LakeList *parse_exprs(LakeCtx *lake_ctx, char *s, size_t n)
 {
-    Ctx ctx = { s, n, 0, 0 };
+    Ctx ctx = { s, n, 0, 0, lake_ctx };
     LakeList *results = list_make();
     LakeVal *result;
     while (ctx.i < ctx.n) {
@@ -73,9 +74,9 @@ LakeList *parse_exprs(char *s, size_t n)
     return results;
 }
 
-LakeList *parse_naked_list(char *s, size_t n)
+LakeList *parse_naked_list(LakeCtx *lake_ctx, char *s, size_t n)
 {
-    Ctx ctx = { s, n, 0, 0 };
+    Ctx ctx = { s, n, 0, 0, lake_ctx };
     LakeList *list = list_make();
     char c;
     maybe_spaces(&ctx);
@@ -224,13 +225,13 @@ static LakeVal *parse_sym(Ctx *ctx)
     }
     s[i] = '\0';
 	if (g_strcmp0(s, "#t") == 0) {
-		val = VAL(T);
+		val = VAL(ctx->lake_ctx->T);
 	}
 	else if (g_strcmp0(s, "#f") == 0) {
-		val = VAL(F);
+		val = VAL(ctx->lake_ctx->F);
 	}
 	else {
-		val = VAL(sym_intern(s));
+		val = VAL(sym_intern(ctx->lake_ctx, s));
 	}
     return val;
 }
@@ -331,7 +332,7 @@ static LakeVal *parse_quoted(Ctx *ctx)
 {
     ch(ctx, '\'');
     LakeList *list = list_make();
-    list_append(list, VAL(sym_intern("quote")));
+    list_append(list, VAL(sym_intern(ctx->lake_ctx, "quote")));
     list_append(list, _parse_expr(ctx));
     return VAL(list);
 }
@@ -384,6 +385,7 @@ static LakeVal *_parse_expr(Ctx *ctx)
         ERR("unexpected char '%c'", c);
         result = VAL(PARSE_ERR);
         ctx->i = ctx->n; /* consume the rest */
+        result = NULL;
     }
     maybe_spaces(ctx);
 

src/parse.h

@@ -16,8 +16,8 @@
 #define PARSE_EOF -1
 #define PARSE_ERR -2
 
-LakeVal *parse_expr(char *s, size_t n);
+LakeVal *parse_expr(LakeCtx *ctx, char *s, size_t n);
-LakeList *parse_exprs(char *s, size_t n);
+LakeList *parse_exprs(LakeCtx *ctx, char *s, size_t n);
-LakeList *parse_naked_list(char *s, size_t n);
+LakeList *parse_naked_list(LakeCtx *ctx, char *s, size_t n);
 
 #endif

src/primitive.c

@@ -41,7 +41,7 @@ char *prim_repr(LakePrimitive *prim)
     return g_strdup_printf("<#primitive:%s(%d)>", prim->name, prim->arity);
 }
 
-static LakeVal *_car(LakeList *args)
+static LakeVal *_car(LakeCtx *ctx, LakeList *args)
 {
     LakeList *list = LIST(LIST_VAL(args, 0));
     if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
@@ -51,7 +51,7 @@ static LakeVal *_car(LakeList *args)
     return NULL;
 }
 
-static LakeVal *_cdr(LakeList *args)
+static LakeVal *_cdr(LakeCtx *ctx, LakeList *args)
 {
     LakeList *list = LIST(LIST_VAL(args, 0));
     if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
@@ -63,45 +63,45 @@ static LakeVal *_cdr(LakeList *args)
     return NULL;
 }
 
-static LakeVal *_cons(LakeList *args)
+static LakeVal *_cons(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *car = LIST_VAL(args, 0);
     LakeVal *cdr = LIST_VAL(args, 1);
     return VAL(list_cons(car, cdr));
 }
 
-static LakeVal *_nullP(LakeList *args)
+static LakeVal *_nullP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *is_null = IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0 ? T : F;
+    LakeBool *is_null = BOOL_FROM_INT(ctx, IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0);
     return VAL(is_null);
 }
 
-static LakeVal *_pairP(LakeList *args)
+static LakeVal *_pairP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *is_pair = IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0 ? T : F;
+    LakeBool *is_pair = BOOL_FROM_INT(ctx, IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0);
     return VAL(is_pair);
 }
 
-static LakeVal *_isP(LakeList *args)
+static LakeVal *_isP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *a = LIST_VAL(args, 0);
     LakeVal *b = LIST_VAL(args, 1);
-    return VAL(bool_from_int(lake_is(a, b)));
+    return VAL(BOOL_FROM_INT(ctx, lake_is(a, b)));
 }
 
-static LakeVal *_equalP(LakeList *args)
+static LakeVal *_equalP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *a = LIST_VAL(args, 0);
     LakeVal *b = LIST_VAL(args, 1);
-    return VAL(bool_from_int(lake_equal(a, b)));
+    return VAL(BOOL_FROM_INT(ctx, lake_equal(a, b)));
 }
 
-static LakeVal *_not(LakeList *args)
+static LakeVal *_not(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *not = IS_FALSE(val) ? T : F;
+    LakeBool *not = BOOL_FROM_INT(ctx, IS_FALSE(ctx, val));
     return VAL(not);
 }
 
@@ -112,7 +112,7 @@ static LakeVal *_not(LakeList *args)
         }                                                          \
     } while (0)
 
-static LakeVal *_add(LakeList *args)
+static LakeVal *_add(LakeCtx *ctx, LakeList *args)
 {
     int result = 0;
     size_t n = LIST_N(args);
@@ -125,7 +125,7 @@ static LakeVal *_add(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *_sub(LakeList *args)
+static LakeVal *_sub(LakeCtx *ctx, LakeList *args)
 {
     size_t n = LIST_N(args);
     
@@ -144,7 +144,7 @@ static LakeVal *_sub(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *_mul(LakeList *args)
+static LakeVal *_mul(LakeCtx *ctx, LakeList *args)
 {
     int result = 1;
     size_t n = LIST_N(args);
@@ -159,7 +159,7 @@ static LakeVal *_mul(LakeList *args)
 
 #define DIVIDE_BY_ZERO() ERR("divide by zero")
 
-static LakeVal *_div(LakeList *args)
+static LakeVal *_div(LakeCtx *ctx, LakeList *args)
 {
     size_t n = LIST_N(args);
     
@@ -195,7 +195,7 @@ static LakeVal *_div(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *_int_eq(LakeList *args)
+static LakeVal *_int_eq(LakeCtx *ctx, LakeList *args)
 {
     gboolean result = TRUE;
     size_t n = LIST_N(args);
@@ -210,10 +210,10 @@ static LakeVal *_int_eq(LakeList *args)
         }
         prev = INT_VAL(INT(v));
     }
-    return VAL(bool_from_int(result));
+    return VAL(BOOL_FROM_INT(ctx, result));
 }
 
-static LakeVal *_int_lt(LakeList *args)
+static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
 {
     gboolean result = TRUE;
     size_t n = LIST_N(args);
@@ -231,10 +231,10 @@ static LakeVal *_int_lt(LakeList *args)
             prev = INT_VAL(INT(v));
         }
     }
-    return VAL(bool_from_int(result));
+    return VAL(BOOL_FROM_INT(ctx, result));
 }
 
-static LakeVal *_int_gt(LakeList *args)
+static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
 {
     gboolean result = TRUE;
     size_t n = LIST_N(args);
@@ -252,14 +252,15 @@ static LakeVal *_int_gt(LakeList *args)
             prev = INT_VAL(INT(v));
         }
     }
-    return VAL(bool_from_int(result));
+    return VAL(BOOL_FROM_INT(ctx, result));
 }
 
-Env *primitive_bindings(void)
+void bind_primitives(LakeCtx *ctx)
 {
-    #define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
+    #define DEFINE(name, fn, arity) env_define(ctx->toplevel,         \
-    
+                                               sym_intern(ctx, name), \
-    Env *env = env_toplevel();
+                                               VAL(prim_make(name, arity, fn)))
+
     DEFINE("car", _car, 1);
     DEFINE("cdr", _cdr, 1);
     DEFINE("cons", _cons, 2);
@@ -291,6 +292,4 @@ Env *primitive_bindings(void)
     /* string> */
     /* string-concatenate */
     /* string-slice */
-    
-    return env;
 }

src/primitive.h

@@ -15,6 +15,6 @@
 
 LakePrimitive *prim_make(char *name, int arity, lake_prim fn);
 char *prim_repr(LakePrimitive *prim);
-Env *primitive_bindings(void);
+void bind_primitives(LakeCtx *ctx);
 
 #endif

src/sym.c

@@ -16,8 +16,6 @@
 #include "string.h"
 #include "sym.h"
 
-static GHashTable *_symbols;
-
 static LakeSym *sym_alloc(void)
 {
     LakeSym *sym = g_malloc(sizeof(LakeSym));
@@ -26,16 +24,15 @@ static LakeSym *sym_alloc(void)
     return sym;
 }
 
-LakeSym *sym_intern(char *s)
+LakeSym *sym_intern(LakeCtx *ctx, char *s)
 {
-    if (!_symbols) _symbols = g_hash_table_new(g_str_hash, g_str_equal);
+    LakeSym *sym = g_hash_table_lookup(ctx->symbols, s);
-    LakeSym *sym = g_hash_table_lookup(_symbols, s);
     if (!sym) {
         sym = sym_alloc();
         sym->n = strlen(s);
         sym->s = g_strdup(s);
         sym->hash = g_str_hash(s);
-        g_hash_table_insert(_symbols, sym->s, sym);
+        g_hash_table_insert(ctx->symbols, sym->s, sym);
 	}
     return sym;
 }
@@ -45,9 +42,9 @@ LakeStr *sym_to_str(LakeSym *sym)
     return str_from_c(sym->s);
 }
 
-LakeSym *sym_from_str(LakeStr *str)
+LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str)
 {
-    return sym_intern(str->s);
+    return sym_intern(ctx, str->s);
 }
 
 char *sym_repr(LakeSym *sym)

src/sym.h

@@ -12,9 +12,9 @@
 
 #include "lake.h"
 
-LakeSym *sym_intern(char *s);
+LakeSym *sym_intern(LakeCtx *ctx, char *s);
 LakeStr *sym_to_str(LakeSym *sym);
-LakeSym *sym_from_str(LakeStr *str);
+LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str);
 char *sym_repr(LakeSym *sym);
 unsigned long sym_val(LakeSym *sym);