From 8d66a7cbd162c7514c4f1b393f633817e5ec7525 Mon Sep 17 00:00:00 2001 From: Sami Samhuri Date: Sat, 23 Apr 2011 14:34:28 -0700 Subject: [PATCH] move all globals into an execution context --- src/Makefile | 2 +- src/bool.c | 38 ----------------- src/bool.h | 22 ---------- src/env.c | 10 ----- src/env.h | 2 - src/eval.c | 109 ++++++++++++++++++++++-------------------------- src/eval.h | 11 ++--- src/int.c | 2 +- src/lake.c | 60 ++++++++++++++++---------- src/lake.h | 31 +++++++++----- src/parse.c | 22 +++++----- src/parse.h | 6 +-- src/primitive.c | 57 +++++++++++++------------ src/primitive.h | 2 +- src/sym.c | 13 +++--- src/sym.h | 4 +- 16 files changed, 168 insertions(+), 223 deletions(-) delete mode 100644 src/bool.c delete mode 100644 src/bool.h diff --git a/src/Makefile b/src/Makefile index 36accb3..8199a6e 100644 --- a/src/Makefile +++ b/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 diff --git a/src/bool.c b/src/bool.c deleted file mode 100644 index 8eeca8e..0000000 --- a/src/bool.c +++ /dev/null @@ -1,38 +0,0 @@ -/** - * bool.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ - -#include -#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; -} diff --git a/src/bool.h b/src/bool.h deleted file mode 100644 index ffb4d49..0000000 --- a/src/bool.h +++ /dev/null @@ -1,22 +0,0 @@ -/** - * bool.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ - -#ifndef _LAKE_BOOL_H -#define _LAKE_BOOL_H 1 - -#include -#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 \ No newline at end of file diff --git a/src/env.c b/src/env.c index db86e88..63a503e 100644 --- a/src/env.c +++ b/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)); diff --git a/src/env.h b/src/env.h index faaff1c..fca5c37 100644 --- a/src/env.h +++ b/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); diff --git a/src/eval.c b/src/eval.c index 2c2d0c4..5c35f21 100644 --- a/src/eval.c +++ b/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); -static GHashTable *special_form_handlers = NULL; -static void init_special_form_handlers(void); +typedef LakeVal *(*special_form_handler)(LakeCtx *ctx, Env *env, LakeList *expr); 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); - while (IS_TRUTHY(result) && LIST_N(expr) > 0) { - result = bool_and(result, eval(env, list_shift(expr))); + LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T); + while (IS_TRUTHY(ctx, result) && LIST_N(expr) > 0) { + 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); - while (IS_FALSY(result) && LIST_N(expr) > 0) { - result = bool_or(result, eval(env, list_shift(expr))); + LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F); + while (IS_FALSY(ctx, result) && LIST_N(expr) > 0) { + 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)); - if (IS_TRUTHY(cond)) { - return eval(env, list_shift(expr)); + LakeVal *cond = eval(ctx, env, list_shift(expr)); + if (IS_TRUTHY(ctx, cond)) { + 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))) { - return eval_exprs1(env, conseq); + if (pred == ELSE || IS_TRUTHY(ctx, eval(ctx, env, pred))) { + 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)); - return IS_TRUTHY(cond) ? eval_exprs1(env, expr) : NULL; + LakeVal *cond = eval(ctx, env, list_shift(expr)); + 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, \ - sym_intern(name), \ + #define HANDLER(name, fn) g_hash_table_insert(ctx->special_form_handlers, \ + 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) { - init_special_form_handlers(); - } - return (special_form_handler)g_hash_table_lookup(special_form_handlers, name); + return (special_form_handler)g_hash_table_lookup(ctx->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)) { - result = eval_special_form(env, list); + if (is_special_form(ctx, 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)); diff --git a/src/eval.h b/src/eval.h index df26c21..ebfc247 100644 --- a/src/eval.h +++ b/src/eval.h @@ -13,10 +13,11 @@ #include "env.h" #include "lake.h" -LakeVal *eval(Env *env, LakeVal *expr); -LakeList *eval_exprs(Env *env, LakeList *exprs); -LakeVal *eval_exprs1(Env *env, LakeList *exprs); -LakeVal *apply(LakeVal *fnVal, LakeList *args); -gboolean is_special_form(LakeList *expr); +LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr); +LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs); +LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs); +LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args); +gboolean is_special_form(LakeCtx *ctx, LakeList *expr); +void init_special_form_handlers(LakeCtx *ctx); #endif \ No newline at end of file diff --git a/src/int.c b/src/int.c index e608a47..9d8623c 100644 --- a/src/int.c +++ b/src/int.c @@ -8,8 +8,8 @@ */ #include -#include "bool.h" #include "int.h" +#include "lake.h" static LakeInt *int_alloc(void) { diff --git a/src/lake.c b/src/lake.c index c5fdf0f..f2de725 100644 --- a/src/lake.c +++ b/src/lake.c @@ -23,11 +23,7 @@ #include "parse.h" #include "primitive.h" #include "string.h" - -static LakeBool _T = { { TYPE_BOOL, sizeof(LakeBool) }, TRUE }; -static LakeBool _F = { { TYPE_BOOL, sizeof(LakeBool) }, FALSE }; -LakeBool *T = &_T; -LakeBool *F = &_F; +#include "symtable.h" 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)); - if (!list) return NULL; + LakeList *list = parse_naked_list(ctx, buf, strlen(buf)); + if (!list || LIST_N(list) == 0) return NULL; LakeVal *result; /* naked call */ LakeVal *head; - if (is_special_form(list) || - (LIST_N(list) > 1 && (head = eval(env, LIST_VAL(list, 0))) && CALLABLE(head))) { + if (is_special_form(ctx, list) || + (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 */ - Env *env = primitive_bindings(); + /* create an execution context */ + 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; } diff --git a/src/lake.h b/src/lake.h index 4ed324b..af6e779 100644 --- a/src/lake.h +++ b/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_FALSE(x) (VAL(x) == VAL(F)) -#define IS_TRUTHY(x) (!IS_FALSE(x)) -#define IS_FALSY(x) (IS_FALSE(x)) +#define IS_TRUE(ctx, x) (VAL(x) == VAL(ctx->T)) +#define IS_FALSE(ctx, x) (VAL(x) == VAL(ctx->F)) +#define IS_TRUTHY(ctx, x) (!IS_FALSE(ctx, 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" diff --git a/src/parse.c b/src/parse.c index 19c8548..43a088a 100644 --- a/src/parse.c +++ b/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); diff --git a/src/parse.h b/src/parse.h index 92b5543..92a84df 100644 --- a/src/parse.h +++ b/src/parse.h @@ -16,8 +16,8 @@ #define PARSE_EOF -1 #define PARSE_ERR -2 -LakeVal *parse_expr(char *s, size_t n); -LakeList *parse_exprs(char *s, size_t n); -LakeList *parse_naked_list(char *s, size_t n); +LakeVal *parse_expr(LakeCtx *ctx, char *s, size_t n); +LakeList *parse_exprs(LakeCtx *ctx, char *s, size_t n); +LakeList *parse_naked_list(LakeCtx *ctx, char *s, size_t n); #endif \ No newline at end of file diff --git a/src/primitive.c b/src/primitive.c index b4ab0f6..2520ebd 100644 --- a/src/primitive.c +++ b/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))) - - Env *env = env_toplevel(); + #define DEFINE(name, fn, arity) env_define(ctx->toplevel, \ + sym_intern(ctx, name), \ + 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; } diff --git a/src/primitive.h b/src/primitive.h index 468073a..5aba665 100644 --- a/src/primitive.h +++ b/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 diff --git a/src/sym.c b/src/sym.c index 4fc7a75..31389fe 100644 --- a/src/sym.c +++ b/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(_symbols, s); + LakeSym *sym = g_hash_table_lookup(ctx->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) diff --git a/src/sym.h b/src/sym.h index 6e0abc3..d46ccc7 100644 --- a/src/sym.h +++ b/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);