diff --git a/eval.c b/eval.c index 8d81e4b..2dfdced 100644 --- a/eval.c +++ b/eval.c @@ -267,7 +267,7 @@ LakeVal *eval(Env *env, LakeVal *expr) done: return result; } -static LakeList *eval_exprs(Env *env, LakeList *exprs) +LakeList *eval_exprs(Env *env, LakeList *exprs) { LakeList *results = list_make_with_capacity(LIST_N(exprs)); int i; diff --git a/eval.h b/eval.h index 0d2da1e..46d29a2 100644 --- a/eval.h +++ b/eval.h @@ -14,6 +14,7 @@ #include "lake.h" LakeVal *eval(Env *env, LakeVal *expr); +LakeList *eval_exprs(Env *env, LakeList *exprs); LakeVal *apply(LakeVal *fnVal, LakeList *args); #endif \ No newline at end of file diff --git a/lake.c b/lake.c index f8510ea..3575691 100644 --- a/lake.c +++ b/lake.c @@ -10,6 +10,7 @@ * */ +#include #include #include #include @@ -62,46 +63,6 @@ static LakeVal *prompt_read(char *prompt) return parse_expr(buf, strlen(buf)); } -static void run_repl_with_env(Env *env) -{ - puts("Lake Scheme v" LAKE_VERSION); - LakeVal *expr; - LakeVal *result; - for (;;) { - expr = prompt_read("> "); - if (expr == VAL(EOF)) break; - if (expr == VAL(PARSE_ERR)) { - ERR("parse error"); - continue; - } - if (expr) { - result = eval(env, expr); - if (result) print(result); - } - } -} - -static void run_repl(void) -{ - run_repl_with_env(primitive_bindings()); -} - -static void run_one_then_repl(int argc, char const *args[]) -{ - /* create a top level environment */ - Env *env = primitive_bindings(); - - /* bind args */ - /* - LakeList *lakeArgs = list_of_strings_from_array(argc, args); - env_bind(env, "args", lakeArgs); - */ - - /* eval (load args[0]) in env */ - - run_repl_with_env(env); -} - char *repr(LakeVal *expr) { if (expr == NULL) return g_strdup("(null)"); @@ -157,13 +118,88 @@ char *repr(LakeVal *expr) return s; } -int main (int argc, char const *argv[]) +static void run_repl(Env *env) { - if (argc == 1) { - run_repl(); + puts("Lake Scheme v" LAKE_VERSION); + LakeVal *expr; + LakeVal *result; + for (;;) { + expr = prompt_read("> "); + if (expr == VAL(EOF)) break; + if (expr == VAL(PARSE_ERR)) { + ERR("parse error"); + continue; + } + if (expr) { + result = eval(env, expr); + if (result) print(result); + } + } +} + +char *read_file(char const *filename) +{ + FILE *fp = fopen(filename, "r"); + if (fp) { + size_t size = 4096; + char buf[size]; + size_t n = size; + size_t i = 0; + size_t read; + char *s = g_malloc(n); + + while (!feof(fp) && !ferror(fp)) { + read = fread(buf, 1, size, fp); + if (i + read > n) { + n += size; + if (!(s = g_realloc(s, n))) OOM(); + } + memcpy(s + i, buf, read); + i += read; + } + s[i] = '\0'; + if (ferror(fp)) { + ERR("failed to read file %s: %s", filename, strerror(errno)); + return NULL; + } + fclose(fp); + + return s; } else { - run_one_then_repl(argc, argv); + ERR("cannot open file %s: %s", filename, strerror(errno)); + return NULL; } +} + +int main (int argc, char const *argv[]) +{ + /* create a top level environment */ + Env *env = primitive_bindings(); + + /* create and bind args */ + LakeVal **argVals = g_malloc(argc * sizeof(LakeVal *)); + int i; + for (i = 0; i < argc; ++i) { + argVals[i] = VAL(str_from_c((char *)argv[i])); + } + LakeList *args = list_from_array(argc, argVals); + free(argVals); + env_define(env, sym_intern("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)); + if (exprs) { + eval_exprs(env, exprs); + } + } + } + + /* run the repl */ + run_repl(env); + return 0; } diff --git a/list.c b/list.c index b289d56..0386657 100644 --- a/list.c +++ b/list.c @@ -74,6 +74,7 @@ static void list_grow(LakeList *list) { list->cap *= 2; list->vals = g_realloc(list->vals, list->cap * sizeof(LakeVal *)); + if (!list->vals) OOM(); } LakeVal *list_set(LakeList *list, size_t i, LakeVal *val) diff --git a/parse.c b/parse.c index d910ec8..d0b1855 100644 --- a/parse.c +++ b/parse.c @@ -27,19 +27,43 @@ struct context { }; typedef struct context Ctx; +static void warn_trailing(Ctx *ctx) +{ + if (ctx->i < ctx->n) { + char *trailing = ctx->s + ctx->i; + printf("warning: ignoring %d trailing chars: %s\n", (int)(ctx->n - ctx->i), trailing); + } +} + static LakeVal *_parse_expr(Ctx *ctx); LakeVal *parse_expr(char *s, size_t n) { Ctx ctx = { s, n, 0, 0 }; LakeVal *result = _parse_expr(&ctx); - if (ctx.i < ctx.n) { - char *trailing = ctx.s + ctx.i; - printf("warning: ignoring %d trailing chars: %s\n", (int)(ctx.n - ctx.i), trailing); - } + warn_trailing(&ctx); return result; } +LakeList *parse_exprs(char *s, size_t n) +{ + Ctx ctx = { s, n, 0, 0 }; + LakeList *results = list_make(); + LakeVal *result; + while (ctx.i < ctx.n) { + result = _parse_expr(&ctx); + if (result && result != VAL(PARSE_ERR)) { + list_append(results, result); + } + else { + list_free(results); + return NULL; + } + } + warn_trailing(&ctx); + return results; +} + static char peek(Ctx *ctx) { if (ctx->i < ctx->n) return ctx->s[ctx->i]; @@ -81,7 +105,7 @@ static void backtrack(Ctx *ctx) ctx->i = ctx->mark; } -static gboolean is_space(c) +static gboolean is_space(char c) { return strchr(" \r\n\t", c) != NULL; } @@ -123,9 +147,7 @@ static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char)) /* grow if necessary */ if (i >= n) { n *= 2; - char *t = g_realloc(s, n); - if (!t) OOM(); - s = t; + if (!(s = g_realloc(s, n))) OOM(); } } s[i] = '\0'; @@ -234,9 +256,7 @@ static LakeVal *parse_str(Ctx *ctx) /* grow if necessary */ if (i >= n) { n *= 2; - char *t = g_realloc(s, n); - if (!t) OOM(); - s = t; + if (!(s = g_realloc(s, n))) OOM(); } } s[i] = '\0'; @@ -344,5 +364,10 @@ static LakeVal *_parse_expr(Ctx *ctx) ctx->i = ctx->n; /* consume the rest */ } maybe_spaces(ctx); + + if (IS(TYPE_SYM, result)) { + /* TODO: try to parse a naked list */ + } + return result; } diff --git a/parse.h b/parse.h index ad6ccbc..1efdbf8 100644 --- a/parse.h +++ b/parse.h @@ -17,5 +17,6 @@ #define PARSE_ERR -2 LakeVal *parse_expr(char *s, size_t n); +LakeList *parse_exprs(char *s, size_t n); #endif \ No newline at end of file