mirror of
https://github.com/samsonjs/lake.git
synced 2026-03-25 08:55:49 +00:00
move all globals into an execution context
This commit is contained in:
Sami Samhuri
parent
ccdffc87aa
commit
8d66a7cbd1
16 changed files with 168 additions and 223 deletions
|
|
@ -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
|
||||
|
|
|
|||
38
src/bool.c
38
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;
|
||||
}
|
||||
22
src/bool.h
22
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
|
||||
10
src/env.c
10
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));
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
109
src/eval.c
109
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));
|
||||
|
|
|
|||
11
src/eval.h
11
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
|
||||
|
|
@ -8,8 +8,8 @@
|
|||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include "bool.h"
|
||||
#include "int.h"
|
||||
#include "lake.h"
|
||||
|
||||
static LakeInt *int_alloc(void)
|
||||
{
|
||||
|
|
|
|||
60
src/lake.c
60
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;
|
||||
}
|
||||
|
|
|
|||
31
src/lake.h
31
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"
|
||||
|
|
|
|||
22
src/parse.c
22
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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
13
src/sym.c
13
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)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue