factor out repl & build static lib

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 \
+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
+            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

src/lake.c

@@ -10,87 +10,16 @@
   *
   */
 
-#include <errno.h>
 #include <glib.h>
-#include <stdio.h>
-#include <string.h>
-#include <sys/select.h>
 #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)
+static LakeBool *bool_make(gboolean val)
-{
-    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)
 {
     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);
-
+    return 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;
 }

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);

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 <errno.h>
+#include <glib.h>
+#include <stdio.h>
+#include <string.h>
+#include <sys/select.h>
+#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;
+}