readline, let binding, setq

7 files changed, 179 insertions, 6 deletions

diff --git a/3rdparty/algds b/3rdparty/algds
-Subproject 111a1c8b9f4bafb627dd3911857943ae9a65f29
+Subproject 8db6e93d49aed1e4dac3e5090babb29ddcf0bea
diff --git a/Makefile b/Makefile
index 148ff37..8ebb82d 100644
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,7 @@ mode ?= debug
 cc = gcc
 includes = -I3rdparty/algds/build/include/
 3rdlibs = 3rdparty/algds/build/lib/libalgds.a
-ldflags = # -L3rdparty/algds/build/lib/ -lalgds
+ldflags = -lreadline
 ifeq ($(mode), debug)
 	cflags = $(includes) \
 		-g \
@@ -20,7 +20,7 @@ tests_bin=$(tests:.c=.bin)
 all: bamboo-lisp
 
 bamboo-lisp:  $(obj) src/main.c 3rdparty/algds/build/lib/libalgds.a
-	gcc $(ldflags) $(cflags) -o $@ $^
+	gcc $(cflags) -o $@ $^ $(ldflags)
 
 3rdparty/algds/build/lib/libalgds.a:
 	cd 3rdparty/algds && \
@@ -37,7 +37,7 @@ $(obj):%.o:%.c
 $(obj):%.o:$(3rdlibs)
 
 $(tests_bin):%.bin:%.c $(obj) $(3rdlibs)
-	$(cc) $(ldflags) $(cflags) -Isrc/ $< $(obj) $(3rdlibs) -MD -MF $@.d -o $@
+	$(cc) $(cflags) -Isrc/ $< $(obj) $(3rdlibs) -MD -MF $@.d -o $@ $(ldflags)
 
 clean:
 	-rm $(shell find tests/ -name '*.bin')
diff --git a/src/interp.c b/src/interp.c
index 2ccc08b..d4e0373 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -56,6 +56,8 @@ void Interp_init(Interp *self) {
     self->stack = lisp_cons(self, self->top_level, self->nil);
     self->reg = self->nil;
 
+    Interp_add_primitive(self, "setq", primitive_setq);
+    Interp_add_primitive(self, "let", primitive_let);
     Interp_add_primitive(self, "car", primitive_car);
     Interp_add_primitive(self, "cdr", primitive_cdr);
     Interp_add_primitive(self, "cons", primitive_cons);
@@ -189,6 +191,7 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
     }
 }
 
+
 const char* lisp_to_string(Interp *interp, SExpRef val) {
     str_builder_t sb;
     Int2IntHashTable visited;
@@ -397,6 +400,92 @@ SExpRef primitive_sub(Interp *interp, SExpRef args) {
     return new_error(interp, "-: wrong argument number.\n");
 }
 
+// TODO:
+// - setq
+// - cond
+// - if
+// - while
+// - lambda
+// - defun
+// - funcall
+// - apply
+// - defvar
+// - defmacro
+// - macroexpand-1
+
+SExpRef primitive_setq(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 2) goto error;
+    SExpRef name = CAR(args);
+    SExpRef exp = CADR(args);
+    if (REF(name)->type != kSymbolSExp) goto error;
+    SExpRef value = lisp_eval(interp, exp);
+    if (ERRORP(value)) return value;
+    lisp_setq(interp, REF(name)->str, value);
+    return NIL;
+error:
+    return new_error(interp, "setq: syntax error.\n");
+}
+
+static const char *binding_name(Interp *interp, SExpRef binding) {
+    SExpRef namesym = REF(binding)->binding.name;
+    return REF(namesym)->str;
+}
+
+static bool is_binding_repeat(Interp *interp, SExpRef sym, SExpRef env) {
+    SExpRef binding = REF(env)->env.bindings;
+    while (!NILP(binding)) {
+        if (strcmp(REF(sym)->str, binding_name(interp, binding)) == 0) return true;
+        binding = REF(binding)->binding.next;
+    }
+    return false;
+}
+
+SExpRef primitive_let(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) goto error;
+    SExpRef bindings = CAR(args);
+    SExpRef env = new_env(interp);
+    REF(env)->env.parent = CAR(interp->stack);
+
+    SExpRef iter = bindings;
+    while (!NILP(iter)) {
+        SExpRef x = CAR(iter);
+        if (!lisp_check_list(interp, x)) goto error;
+        if (lisp_length(interp, x) != 2) goto error;
+        if (REF(CAR(x))->type != kSymbolSExp) goto error;
+        if (is_binding_repeat(interp, CAR(x), env)) goto error;
+        SExpRef binding = new_binding(interp, CAR(x), NIL);
+        REF(binding)->binding.next = REF(env)->env.bindings;
+        REF(env)->env.bindings = binding;
+        iter = CDR(iter);
+    }
+    interp->stack = CONS(env, interp->stack);
+
+    iter = bindings;
+    while (!NILP(iter)) {
+        SExpRef x = CAR(iter);
+        SExpRef val = lisp_eval(interp, CADR(x));
+        if (REF(val)->type == kErrSExp) goto end;
+        lisp_setq(interp, REF(CAR(x))->str, val);
+        iter = CDR(iter);
+    }
+
+    SExpRef body = CDR(args);
+    SExpRef ret = NIL;
+    iter = body;
+    while (!NILP(iter)) {
+        SExpRef exp = CAR(iter);
+        ret = lisp_eval(interp, exp);
+        if (REF(ret)->type == kErrSExp) goto end;
+        iter = CDR(iter);
+    }
+end:
+    interp->stack = CDR(interp->stack);
+    return ret;
+
+error:
+    return new_error(interp, "let: syntax error. \n");
+}
+
 SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
     SExpRef ret;
     SExpType type;
@@ -459,6 +548,22 @@ SExpRef new_sexp(Interp *interp) {
     return (SExpRef){idx};
 }
 
+SExpRef new_env(Interp *interp) {
+    SExpRef ret = new_sexp(interp);
+    REF(ret)->type = kEnvSExp;
+    REF(ret)->env.parent = NIL;
+    REF(ret)->env.bindings = NIL;
+    return ret;
+}
+
+SExpRef new_binding(Interp *interp, SExpRef sym, SExpRef val) {
+    SExpRef ret = new_sexp(interp);
+    REF(ret)->type = kBindingSExp;
+    REF(ret)->binding.name = sym;
+    REF(ret)->binding.value = val;
+    return ret;
+}
+
 SExpRef new_boolean(Interp *interp, bool val) {
     SExpRef ret = new_sexp(interp);
     REF(ret)->type = kBooleanSExp;
diff --git a/src/interp.h b/src/interp.h
index 03cdf7f..3b3004d 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -40,6 +40,8 @@ SExp* Interp_ref(Interp *self, SExpRef ref);
 void Interp_gc(Interp *self, SExpRef tmp_root);
 void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
 
+SExpRef primitive_setq(Interp *interp, SExpRef sexp);
+SExpRef primitive_let(Interp *interp, SExpRef sexp);
 SExpRef primitive_car(Interp *interp, SExpRef sexp);
 SExpRef primitive_cdr(Interp *interp, SExpRef sexp);
 SExpRef primitive_cons(Interp *interp, SExpRef sexp);
@@ -69,6 +71,8 @@ SExpRef new_integer(Interp *ctx, int64_t val);
 SExpRef new_real(Interp *ctx, double val);
 SExpRef new_string(Interp *ctx, const char *val);
 SExpRef new_symbol(Interp *ctx, const char *val);
+SExpRef new_env(Interp *ctx);
+SExpRef new_binding(Interp *ctx, SExpRef name, SExpRef val);
 SExpRef new_list1(Interp *ctx, SExpRef e1);
 SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2);
 SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3);
diff --git a/src/main.c b/src/main.c
index ecbc2f4..9c05ee5 100644
--- a/src/main.c
+++ b/src/main.c
@@ -10,11 +10,10 @@ int main() {
     Parser_init(&parser);
     parser.ctx = &interp;
 
-    Parser_set_file(&parser, stdin);
+    Parser_set_readline(&parser);
     SExpRef sexp, res;
     ParseResult parse_result;
     while (1) {
-        printf("> ");
         parse_result = parse_sexp(&parser);
         if (parse_result.errmsg != NULL) {
             if (Parser_peek(&parser) == EOF) goto end;
diff --git a/src/parser.c b/src/parser.c
index 2130b01..9ed583d 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -1,10 +1,13 @@
 #include "parser.h"
-#include "sexp.h"
 
 #include <ctype.h>
 #include <stdlib.h>
 #include <stdarg.h>
 
+#include <readline/readline.h>
+
+#include "sexp.h"
+
 #define BUFSIZE 1024
 
 static void skip_spaces(Parser *parser) {
@@ -36,6 +39,7 @@ void Parser_init(Parser *parser) {
 }
 
 void Parser_free(Parser *parser) {
+    if (parser->parse_type == kParseReadline) free((void*)parser->string);
     free(parser->token_buf);
     free(parser->errmsg_buf);
 }
@@ -51,6 +55,13 @@ void Parser_set_file(Parser *parser, FILE *fp) {
     parser->fp = fp;
 }
 
+void Parser_set_readline(Parser *parser) {
+    parser->parse_type = kParseReadline;
+    parser->string = NULL;
+    parser->str_cursor = NULL;
+    parser->readline_eof = false;
+}
+
 int Parser_getchar(Parser *ctx) {
     if (ctx->parse_type == kParseString) {
         if (*ctx->str_cursor == '\0') return EOF;
@@ -59,6 +70,31 @@ int Parser_getchar(Parser *ctx) {
         return ret;
     } else if (ctx->parse_type == kParseFile) {
         return fgetc(ctx->fp);
+    } else if (ctx->parse_type == kParseReadline) {
+        if (ctx->readline_eof) return EOF;
+        if (ctx->string == NULL) {
+            char *s = readline(">>> ");
+            if (s == NULL) {
+                ctx->readline_eof = true;
+                return EOF;
+            }
+            ctx->string = s;
+            ctx->str_cursor = s;
+        }
+        if (*ctx->str_cursor == '\0') {
+            char *s = readline(">>> ");
+            if (s == NULL) {
+                ctx->readline_eof = true;
+                return EOF;
+            }
+            free((void*)ctx->string);
+            ctx->string = s;
+            ctx->str_cursor = s;
+            return '\n';
+        }
+        int c = *ctx->str_cursor;
+        ctx->str_cursor++;
+        return c;
     }
     return EOF;
 }
@@ -73,6 +109,22 @@ int Parser_peek(Parser *ctx) {
         if (ret == EOF) return EOF;
         ungetc(ret, ctx->fp);
         return ret;
+    } else if (ctx->parse_type == kParseReadline) {
+        if (ctx->readline_eof) return EOF;
+        if (ctx->string == NULL) {
+            char *s = readline(">>> ");
+            if (s == NULL) {
+                ctx->readline_eof = true;
+                return EOF;
+            }
+            ctx->string = s;
+            ctx->str_cursor = s;
+        }
+        if (*ctx->str_cursor == '\0') {
+            return '\n';
+        }
+        int c = *ctx->str_cursor;
+        return c;
     }
     return EOF;
 }
@@ -243,6 +295,16 @@ static ParseResult parse_token(Parser *parser, const char *token) {
     }
     if (token[0] == '#') {
         if (len < 2) return ParseErr(parser, "Expect boolean or character.\n");
+        if (token[1] == '\'') {
+            if (len < 3) return ParseErr(parser, "Expect a symbol.\n");
+            if (!is_symbol_init(token[2])) return ParseErr(parser, "Expect a symbol.\n");
+            for (int i = 3; i < len; i++) {
+                if (!is_symbol_subsequent(token[i])) return ParseErr(parser, "Expect a symbol.\n");
+            }
+            SExpRef funcsym = new_symbol(parser->ctx, "function");
+            SExpRef sym = new_symbol(parser->ctx, token+2);
+            return ParseOk(lisp_cons(parser->ctx, funcsym, lisp_cons(parser->ctx, sym, parser->ctx->nil)));
+        }
         if (token[1] == 't') return ParseOk(new_boolean(parser->ctx, true));
         if (token[1] == 'f') return ParseOk(new_boolean(parser->ctx, false));
         if (token[1] == '\\') {
diff --git a/src/parser.h b/src/parser.h
index cefc946..ff55f90 100644
--- a/src/parser.h
+++ b/src/parser.h
@@ -9,6 +9,7 @@
 typedef enum {
     kParseString,
     kParseFile,
+    kParseReadline,
 } ParseType;
 
 typedef struct {
@@ -21,6 +22,7 @@ typedef struct {
         struct {
             const char *string;
             const char *str_cursor;
+            bool readline_eof;
         };
         FILE *fp;
     };
@@ -32,6 +34,7 @@ int Parser_getchar(Parser *self);
 int Parser_peek(Parser *self);
 void Parser_set_string(Parser *parser, const char *str);
 void Parser_set_file(Parser *parser, FILE *fp);
+void Parser_set_readline(Parser *parser);
 
 typedef struct {
     SExpRef val;