diff --git a/src/Makefile b/src/Makefile index 1f4c808..4cb2839 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,14 +1,19 @@ 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 str.o sym.o parse.o list.o eval.o \ - symtable.o fn.o dlist.o primitive.o comment.o +LAKE_OBJS = env.o int.o str.o sym.o parse.o list.o eval.o \ + symtable.o fn.o dlist.o primitive.o comment.o lake.o +OBJS = $(LAKE_OBJS) repl.o all: lake lake: $(OBJS) $(CC) $(CFLAGS) $(LFLAGS) $^ -o $@ +lake.a: $(LAKE_OBJS) + rm -f $@ + ar cq $@ $(LAKE_OBJS) + # use touch to prevent errors in case files do not exist clean: @touch dummy.o lake diff --git a/src/lake.c b/src/lake.c index 21a8164..a9378fa 100644 --- a/src/lake.c +++ b/src/lake.c @@ -10,87 +10,16 @@ * */ -#include #include -#include -#include -#include #include "comment.h" #include "env.h" #include "eval.h" #include "lake.h" #include "list.h" -#include "parse.h" #include "primitive.h" #include "str.h" #include "symtable.h" -char *type_name(LakeVal *expr) -{ - static char *type_names[9] = { "nil", "symbol", "boolean", "integer", "string", "list", - "dotted-list", "primitive", "function" - }; - - return type_names[expr->type]; -} - -void print(LakeVal *expr) -{ - printf("%s\n", repr(expr)); -} - -static char first_char(char *s) -{ - char c; - while ((c = *s++) && (c == ' ' || c == '\n' || c == '\t')); - return c; -} - -static LakeVal *prompt_read(LakeCtx *ctx, Env *env, char *prompt) -{ - static int n = 1024; - printf("%s", prompt); - char buf[n]; - if (!fgets(buf, n, stdin)) { - if (ferror(stdin)) { - printf("error: cannot read from stdin"); - } - if (feof(stdin)) { - return VAL(EOF); - } - return NULL; - } - /* trim the newline if any */ - buf[strcspn(buf, "\n")] = '\0'; - - /* parse list expressions */ - if (first_char(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(ctx, buf, strlen(buf)); - if (!list || LIST_N(list) == 0) return NULL; - - LakeVal *result; - - /* naked call */ - LakeVal *head; - if (is_special_form(ctx, list) || - (LIST_N(list) > 1 && (head = eval(ctx, env, LIST_VAL(list, 0))) && CALLABLE(head))) { - result = VAL(list); - } - - /* probably not function calls, just give the first expr - (maybe do an implicit progn thing here) */ - else { - result = LIST_VAL(list, 0); - } - - return result; -} - char *lake_repr(LakeVal *expr) { if (expr == NULL) return g_strdup("(null)"); @@ -155,6 +84,15 @@ gboolean lake_is(LakeVal *a, LakeVal *b) return a == b; } +static char *type_name(LakeVal *expr) +{ + static char *type_names[9] = { "nil", "symbol", "boolean", "integer", "string", "list", + "dotted-list", "primitive", "function" + }; + + return type_names[expr->type]; +} + gboolean lake_equal(LakeVal *a, LakeVal *b) { if (a->type != b->type) return FALSE; @@ -188,61 +126,7 @@ gboolean lake_equal(LakeVal *a, LakeVal *b) } } -static void run_repl(LakeCtx *ctx, Env *env) -{ - puts("Lake Scheme v" LAKE_VERSION); - LakeVal *expr; - LakeVal *result; - for (;;) { - expr = prompt_read(ctx, env, "> "); - if (expr == VAL(EOF)) break; - if (expr == VAL(PARSE_ERR)) { - ERR("parse error"); - continue; - } - if (expr) { - result = eval(ctx, 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 { - ERR("cannot open file %s: %s", filename, strerror(errno)); - return NULL; - } -} - -LakeBool *bool_make(gboolean val) +static LakeBool *bool_make(gboolean val) { LakeBool *b = g_malloc(sizeof(LakeBool)); VAL(b)->type = TYPE_BOOL; @@ -259,39 +143,7 @@ LakeCtx *lake_init(void) 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 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 *)); - 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(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(ctx, text, strlen(text)); - if (exprs) { - eval_exprs(ctx, ctx->toplevel, exprs); - } - } - } - - /* run the repl */ - run_repl(ctx, ctx->toplevel); - - return 0; + return ctx; } diff --git a/src/lake.h b/src/lake.h index 150ac14..b35b1ee 100644 --- a/src/lake.h +++ b/src/lake.h @@ -160,6 +160,7 @@ typedef struct lake_comment LakeComment; #define COMM_TEXT(x) (x->text) +LakeCtx *lake_init(void); gboolean lake_is(LakeVal *a, LakeVal *b); gboolean lake_equal(LakeVal *a, LakeVal *b); char *lake_repr(LakeVal *val); diff --git a/src/repl.c b/src/repl.c new file mode 100644 index 0000000..b9ab99a --- /dev/null +++ b/src/repl.c @@ -0,0 +1,166 @@ +/** + * repl.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * A quick and dirty scheme written in C, for fun and to use while + * reading The Little Schemer. + * + */ + +#include +#include +#include +#include +#include +#include "env.h" +#include "eval.h" +#include "lake.h" +#include "list.h" +#include "parse.h" +#include "str.h" + +void print(LakeVal *expr) +{ + printf("%s\n", lake_repr(expr)); +} + +static char first_char(char *s) +{ + char c; + while ((c = *s++) && (c == ' ' || c == '\n' || c == '\t')); + return c; +} + +static LakeVal *prompt_read(LakeCtx *ctx, Env *env, char *prompt) +{ + static int n = 1024; + printf("%s", prompt); + char buf[n]; + if (!fgets(buf, n, stdin)) { + if (ferror(stdin)) { + printf("error: cannot read from stdin"); + } + if (feof(stdin)) { + return VAL(EOF); + } + return NULL; + } + /* trim the newline if any */ + buf[strcspn(buf, "\n")] = '\0'; + + /* parse list expressions */ + if (first_char(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(ctx, buf, strlen(buf)); + if (!list || LIST_N(list) == 0) return NULL; + + LakeVal *result; + + /* naked call */ + LakeVal *head; + if (is_special_form(ctx, list) || + (LIST_N(list) > 1 && (head = eval(ctx, env, LIST_VAL(list, 0))) && CALLABLE(head))) { + result = VAL(list); + } + + /* probably not function calls, just give the first expr + (maybe do an implicit progn thing here) */ + else { + result = LIST_VAL(list, 0); + } + + return result; +} + +static void run_repl(LakeCtx *ctx, Env *env) +{ + puts("Lake Scheme v" LAKE_VERSION); + LakeVal *expr; + LakeVal *result; + for (;;) { + expr = prompt_read(ctx, env, "> "); + if (expr == VAL(EOF)) break; + if (expr == VAL(PARSE_ERR)) { + ERR("parse error"); + continue; + } + if (expr) { + result = eval(ctx, env, expr); + if (result) print(result); + } + } +} + +static 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 { + ERR("cannot open file %s: %s", filename, strerror(errno)); + return NULL; + } +} + +int main (int argc, char const *argv[]) +{ + /* create an execution context */ + LakeCtx *ctx = lake_init(); + + /* 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(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(ctx, text, strlen(text)); + if (exprs) { + eval_exprs(ctx, ctx->toplevel, exprs); + } + } + } + + /* run the repl */ + run_repl(ctx, ctx->toplevel); + + return 0; +}