add io ext

12 files changed, 406 insertions, 28 deletions

diff --git a/exts/Makefile b/exts/Makefile
index e69de29..c80de69 100644
--- a/exts/Makefile
+++ b/exts/Makefile
@@ -0,0 +1,31 @@
+mode ?= debug
+cc = gcc
+
+cflags = -DWITHREADLINE -fPIC
+
+ldflags = -lm -lalgds -lbamboo-lisp
+ifeq ($(mode), debug)
+	cflags += -g
+else 
+	cflags += -O2
+endif
+
+objs = \
+	vector.so \
+	dict.so \
+	io.so
+
+all: $(objs)
+
+vector.so: vector.c
+	gcc -shared $(cflags) -o $@ $^ $(ldflags)
+
+dict.so: dict.c
+	gcc -shared $(cflags) -o $@ $^ $(ldflags)
+
+io.so: io.c
+	gcc -shared $(cflags) -o $@ $^ $(ldflags)
+
+install:
+	mkdir -p /usr/local/share/bamboo-lisp/exts/
+	cp $(objs) /usr/local/share/bamboo-lisp/exts/
\ No newline at end of file
diff --git a/exts/dict/main.c b/exts/dict.c
index 30eceb6..772e48f 100644
--- a/exts/dict/main.c
+++ b/exts/dict.c
@@ -59,13 +59,13 @@ static void dict_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
 }
 
 
-static SExpRef lisp_is_dict(Interp* interp, SExpRef args) {
+static SExpRef ext_is_dict(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 1) return new_error(interp, "dict?: wrongs args num.\n");
     return new_boolean(interp, is_dict_impl(interp, CAR(args)));
 }
 
 // (make-dict)
-static SExpRef lisp_make_dict(Interp* interp, SExpRef args) {
+static SExpRef ext_make_dict(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 0) return new_error(interp, "make-dict: expects no args.\n");
 
     SExpRef ret = new_sexp(interp);
@@ -82,7 +82,7 @@ static SExpRef lisp_make_dict(Interp* interp, SExpRef args) {
 }
 
 // (dict-set dict key value)
-static SExpRef lisp_dict_set(Interp* interp, SExpRef args) {
+static SExpRef ext_dict_set(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 3) return new_error(interp, "dict-set: wrong args num.\n");
     
     SExpRef r_dict = CAR(args);
@@ -107,7 +107,7 @@ static SExpRef lisp_dict_set(Interp* interp, SExpRef args) {
 }
 
 // (dict-get dict key) -> value or nil
-static SExpRef lisp_dict_get(Interp* interp, SExpRef args) {
+static SExpRef ext_dict_get(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 2) return new_error(interp, "dict-get: wrong args num.\n");
 
     SExpRef r_dict = CAR(args);
@@ -127,7 +127,7 @@ static SExpRef lisp_dict_get(Interp* interp, SExpRef args) {
 }
 
 // (dict-remove dict key)
-static SExpRef lisp_dict_remove(Interp* interp, SExpRef args) {
+static SExpRef ext_dict_remove(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 2) return new_error(interp, "dict-remove: wrong args num.\n");
 
     SExpRef r_dict = CAR(args);
@@ -150,16 +150,33 @@ static SExpRef lisp_dict_remove(Interp* interp, SExpRef args) {
     return NIL;
 }
 
-int bamboo_lisp_dict_ext_init(Interp *interp) {
+static SExpRef ext_dict_keys(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "dict-keys: wrong args num.\n");
+    SExpRef dict = CAR(args);
+    if (!is_dict_impl(interp, dict)) return new_error(interp, "dict-keys: first arg not a dict.\n");
+    DictMap *map = REF(dict)->userdata;
+    DictIter it = String2SExpRefTreeMap_min(map);
+    SExpRef lst = NIL;
+    while (it != NULL) {
+        const char* key_str = it->key;
+        SExpRef keyobj = new_string(interp, key_str);
+        lst = CONS(keyobj, lst);
+        it = String2SExpRefTreeMap_next(map, it);
+    }
+    lst = lisp_nreverse(interp, lst);
+    return lst;
+}
+
+int bamboo_lisp_ext_init(Interp *interp) {
     bamboo_lisp_dict_meta.type = DICT_TYPEID;
     bamboo_lisp_dict_meta.free = &dict_free;
     bamboo_lisp_dict_meta.gcmark = &dict_gcmark;
 
-    Interp_add_userfunc(interp, "dict?", &lisp_is_dict);
-    Interp_add_userfunc(interp, "make-dict", &lisp_make_dict);
-    Interp_add_userfunc(interp, "dict-get", &lisp_dict_get);
-    Interp_add_userfunc(interp, "dict-set", &lisp_dict_set);
-    Interp_add_userfunc(interp, "dict-remove", &lisp_dict_remove);
-    // TODO dict-keys
+    Interp_add_userfunc(interp, "dict?", &ext_is_dict);
+    Interp_add_userfunc(interp, "make-dict", &ext_make_dict);
+    Interp_add_userfunc(interp, "dict-get", &ext_dict_get);
+    Interp_add_userfunc(interp, "dict-set", &ext_dict_set);
+    Interp_add_userfunc(interp, "dict-remove", &ext_dict_remove);
+    Interp_add_userfunc(interp, "dict-keys", &ext_dict_keys);
     return 1;
 }
\ No newline at end of file
diff --git a/exts/dict/Makefile b/exts/dict/Makefile
deleted file mode 100644
index e69de29..0000000
--- a/exts/dict/Makefile
+++ /dev/null
diff --git a/exts/dict/test.lisp b/exts/dict/test.lisp
deleted file mode 100644
index e69de29..0000000
--- a/exts/dict/test.lisp
+++ /dev/null
diff --git a/exts/io.c b/exts/io.c
new file mode 100644
index 0000000..76c1520
--- /dev/null
+++ b/exts/io.c
@@ -0,0 +1,295 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+#include <bamboo_lisp/interp.h>
+#include <bamboo_lisp/sexp.h>
+
+#define STREAM_TYPEID "ext.core.stream"
+
+typedef struct {
+    FILE *fp;
+    bool should_close;
+} LispStream;
+
+LispUserdataMeta bamboo_lisp_stream_meta;
+
+static bool is_stream_impl(Interp *interp, SExpRef obj) {
+    if (VALTYPE(obj) == kUserDataSExp && 
+        strcmp(STREAM_TYPEID, REF(obj)->userdata_meta->type) == 0) {
+        return true;
+    }
+    return false;
+}
+
+static SExpRef make_stream(Interp* interp, FILE *fp, bool should_close) {
+    SExpRef ret = new_sexp(interp);
+    REF(ret)->type = kUserDataSExp;
+    REF(ret)->userdata_meta = &bamboo_lisp_stream_meta;
+    
+    LispStream *s = malloc(sizeof(LispStream));
+    s->fp = fp;
+    s->should_close = should_close;
+    
+    REF(ret)->userdata = s;
+    return ret;
+}
+
+static FILE* get_input_stream(Interp* interp, SExpRef args, const char* func_name) {
+    if (NILP(args)) return stdin;
+    
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        new_error(interp, "%s: argument is not a stream.\n", func_name);
+        return NULL;
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    return s->fp;
+}
+
+static FILE* get_output_stream(Interp* interp, SExpRef args, const char* func_name) {
+    if (NILP(args)) return stdout;
+    
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        new_error(interp, "%s: argument is not a stream.\n", func_name);
+        return NULL;
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    return s->fp;
+}
+
+// (stream? obj)
+static SExpRef ext_is_stream(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "stream?: wrong args num.\n");
+    return new_boolean(interp, is_stream_impl(interp, CAR(args)));
+}
+
+// (open-file filename mode) -> stream
+static SExpRef ext_open_file(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "open-file: wrong args num.\n");
+    
+    SExpRef arg_fname = CAR(args);
+    SExpRef arg_mode = CADR(args);
+
+    if (VALTYPE(arg_fname) != kStringSExp || VALTYPE(arg_mode) != kStringSExp) {
+        return new_error(interp, "open-file: filename and mode must be strings.\n");
+    }
+
+    const char *fname = REF(arg_fname)->str;
+    const char *mode = REF(arg_mode)->str;
+
+    FILE *fp = fopen(fname, mode);
+    if (!fp) {
+        return new_error(interp, "open-file: failed to open file '%s'.\n", fname);
+    }
+
+    return make_stream(interp, fp, true);
+}
+
+// (read-char [stream])
+static SExpRef ext_read_char(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-char: too many args.\n");
+    
+    FILE *fp = get_input_stream(interp, args, "read-char");
+    if (!fp) return NIL; // Error handled in get_input_stream but returns NULL
+
+    int c = fgetc(fp);
+    if (c == EOF) return NIL; // End of file returns NIL
+
+    return new_char(interp, (char)c);
+}
+
+// (read-integer [stream])
+static SExpRef ext_read_integer(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-integer: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-integer");
+    if (!fp) return NIL;
+
+    long long val;
+
+    int c;
+    while(isspace(c = fgetc(fp)));
+    ungetc(c, fp);
+
+    if (fscanf(fp, "%lld", &val) == 1) {
+        return new_integer(interp, val);
+    }
+    return NIL;
+}
+
+static SExpRef ext_read_number(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-number: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-number");
+    if (!fp) return NIL;
+
+    char buffer[64];
+    int idx = 0;
+    int c;
+
+    while ((c = fgetc(fp)) != EOF && isspace(c));
+    
+    if (c == EOF) return NIL;
+
+    do {
+        if (idx < 63) buffer[idx++] = (char)c;
+        c = fgetc(fp);
+    } while (c != EOF && !isspace(c) && c != ')' && c != '(');
+    
+    if (c != EOF) ungetc(c, fp);
+    buffer[idx] = '\0';
+
+    if (strchr(buffer, '.') != NULL) {
+        char *end;
+        double d = strtod(buffer, &end);
+        if (end != buffer) return new_real(interp, d);
+    } else {
+        char *end;
+        long long i = strtoll(buffer, &end, 10);
+        if (end != buffer) return new_integer(interp, i);
+    }
+
+    return NIL;
+}
+
+static char* internal_read_line(FILE *fp) {
+    size_t cap = 128;
+    size_t len = 0;
+    char *buf = malloc(cap);
+    if (!buf) return NULL;
+
+    int c = fgetc(fp);
+    if (c == EOF) {
+        free(buf);
+        return NULL; 
+    }
+
+    while (c != EOF && c != '\n') {
+        if (len + 1 >= cap) {
+            cap *= 2;
+            char *new_buf = realloc(buf, cap);
+            if (!new_buf) { free(buf); return NULL; }
+            buf = new_buf;
+        }
+        buf[len++] = (char)c;
+        c = fgetc(fp);
+    }
+    buf[len] = '\0';
+    return buf;
+}
+
+// (read-line [stream])
+static SExpRef ext_read_line(Interp* interp, SExpRef args) {
+    if (LENGTH(args) > 1) return new_error(interp, "read-line: too many args.\n");
+
+    FILE *fp = get_input_stream(interp, args, "read-line");
+    if (!fp) return NIL;
+
+    char *line = internal_read_line(fp);
+    if (line) {
+        SExpRef ret = new_string(interp, line);
+        free(line);
+        return ret;
+    }
+    return NIL;
+}
+
+// (lines stream) -> list of strings
+static SExpRef ext_lines(Interp* interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "lines: wrong args num.\n");
+    
+    FILE *fp = get_input_stream(interp, args, "lines");
+    if (!fp) return NIL;
+
+    SExpRef list_head = NIL;
+
+    char *line_str;
+    while ((line_str = internal_read_line(fp)) != NULL) {
+        SExpRef s = new_string(interp, line_str);
+        free(line_str);
+        list_head = CONS(s, list_head);
+    }
+
+    return lisp_nreverse(interp, list_head);
+}
+
+static SExpRef ext_stream_close(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "stream-close: wrong args num.\n");
+    SExpRef first = CAR(args);
+    if (!is_stream_impl(interp, first)) {
+        return new_error(interp, "stream-close: argument is not a stream.\n");
+    }
+    LispStream *s = (LispStream*)REF(first)->userdata;
+    if (s->should_close && s->fp != NULL) {
+        fclose(s->fp);
+        s->fp = NULL;
+        s->should_close = false;
+    }
+    return NIL;
+}
+
+// (write-char c [stream])
+static SExpRef ext_write_char(Interp* interp, SExpRef args) {
+    int len = LENGTH(args);
+    if (len < 1 || len > 2) return new_error(interp, "write-char: wrong args num.\n");
+
+    if (VALTYPE(CAR(args)) != kCharSExp) 
+        return new_error(interp, "write-char: first arg must be char.\n");
+    
+    char c = REF(CAR(args))->character;
+    
+    FILE *fp = get_output_stream(interp, CDR(args), "write-char"); // CDR is the rest of args
+    if (!fp) return NIL;
+
+    fputc(c, fp);
+    return NIL;
+}
+
+// (write-obj obj [stream])
+static SExpRef ext_write_obj(Interp* interp, SExpRef args) {
+    int len = LENGTH(args);
+    if (len < 1 || len > 2) return new_error(interp, "write-obj: wrong args num.\n");
+
+    SExpRef obj = CAR(args);
+    FILE *fp = get_output_stream(interp, CDR(args), "write-obj");
+    if (!fp) return NIL;
+
+    lisp_print(interp, obj, fp);
+    return NIL;
+}
+
+static void stream_free(void *vself) {
+    LispStream *self = (LispStream*)vself;
+    if (self->should_close && self->fp) {
+        fclose(self->fp);
+    }
+    free(self);
+}
+
+static void stream_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
+    (void)interp;
+    (void)gcstack;
+    (void)vself;
+}
+
+int bamboo_lisp_ext_init(Interp *interp) {
+    bamboo_lisp_stream_meta.type = STREAM_TYPEID;
+    bamboo_lisp_stream_meta.free = &stream_free;
+    bamboo_lisp_stream_meta.gcmark = &stream_gcmark;
+
+    Interp_add_userfunc(interp, "stream?", &ext_is_stream);
+    Interp_add_userfunc(interp, "open-file", &ext_open_file);
+    Interp_add_userfunc(interp, "stream-close", &ext_stream_close);
+    Interp_add_userfunc(interp, "read-char", &ext_read_char);
+    Interp_add_userfunc(interp, "read-integer", &ext_read_integer);
+    Interp_add_userfunc(interp, "read-number", &ext_read_number);
+    Interp_add_userfunc(interp, "read-line", &ext_read_line);
+    Interp_add_userfunc(interp, "lines", &ext_lines);
+    Interp_add_userfunc(interp, "write-char", &ext_write_char);
+    Interp_add_userfunc(interp, "write-obj", &ext_write_obj);
+    
+    return 1;
+}
\ No newline at end of file
diff --git a/exts/io/main.c b/exts/io/main.c
deleted file mode 100644
index e69de29..0000000
--- a/exts/io/main.c
+++ /dev/null
diff --git a/exts/test_input.txt b/exts/test_input.txt
new file mode 100644
index 0000000..c5b2a08
--- /dev/null
+++ b/exts/test_input.txt
@@ -0,0 +1,3 @@
+abc123
+ascx
+asc
\ No newline at end of file
diff --git a/exts/tests/test_dict.lisp b/exts/tests/test_dict.lisp
new file mode 100644
index 0000000..501faba
--- /dev/null
+++ b/exts/tests/test_dict.lisp
@@ -0,0 +1,17 @@
+(loadext "./dict.so")
+
+(defvar d (make-dict))
+
+(dict-set d "a" 1)
+(dict-set d "b" 2)
+(dict-set d "c" 3)
+
+(assert (equal? (dict-keys d) (list "a" "b" "c")))
+(assert (equal? (dict-get d "a") 1))
+(assert (equal? (dict-get d "b") 2))
+(dict-set d "a" 5)
+(assert (equal? (dict-get d "a") 5))
+
+(dict-remove d "b")
+
+(assert (equal? (dict-keys d) (list "a" "c")))
\ No newline at end of file
diff --git a/exts/tests/test_io.lisp b/exts/tests/test_io.lisp
new file mode 100644
index 0000000..76b91ce
--- /dev/null
+++ b/exts/tests/test_io.lisp
@@ -0,0 +1,15 @@
+(loadext "io.so")
+
+(defvar fp (open-file "./test_input.txt" "r"))
+(read-char fp)
+(read-char fp)
+(read-char fp)
+(stream-close fp)
+
+(defvar fp (open-file "./test_input.txt" "r"))
+(read-line fp)
+(stream-close fp)
+
+(defvar fp (open-file "./test_input.txt" "r"))
+(lines fp) 
+(stream-close fp)
\ No newline at end of file
diff --git a/exts/vector/main.c b/exts/vector.c
index 3261fed..960cf5d 100644
--- a/exts/vector/main.c
+++ b/exts/vector.c
@@ -27,7 +27,7 @@ static SExpRef make_vector(Interp* interp, SExpRef args) {
     return ret;
 }
 
-static SExpRef vector_ref(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_ref(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 2) return new_error(interp, "vector-ref: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args))
             || REF(CADR(args))->type != kIntegerSExp) {
@@ -40,7 +40,7 @@ static SExpRef vector_ref(Interp* interp, SExpRef args) {
     return *SExpRefVector_ref(vec, n);
 }
 
-static SExpRef vector_append(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_append(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 2) return new_error(interp, "vector-append: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-append: first arg not a vector.\n");
 
@@ -50,7 +50,7 @@ static SExpRef vector_append(Interp* interp, SExpRef args) {
     return NIL;
 }
 
-static SExpRef vector_insert(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_insert(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 3) return new_error(interp, "vector-insert: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp)
         return new_error(interp, "vector-insert: wrong types.\n");
@@ -62,7 +62,7 @@ static SExpRef vector_insert(Interp* interp, SExpRef args) {
     return NIL;
 }
 
-static SExpRef vector_delete(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_delete(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 2) return new_error(interp, "vector-remove: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp)
         return new_error(interp, "vector-remove: wrong types.\n");
@@ -74,7 +74,7 @@ static SExpRef vector_delete(Interp* interp, SExpRef args) {
     return NIL;
 }
 
-static SExpRef vector_length(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_length(Interp* interp, SExpRef args) {
    if (LENGTH(args) != 1) return new_error(interp, "vector-length: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-length: not a vector.\n");
 
@@ -82,7 +82,7 @@ static SExpRef vector_length(Interp* interp, SExpRef args) {
     return new_integer(interp, SExpRefVector_len(vec));
 }
 
-static SExpRef vector_set(Interp* interp, SExpRef args) {
+static SExpRef ext_vector_set(Interp* interp, SExpRef args) {
     if (LENGTH(args) != 3) return new_error(interp, "vector-set: wrong args num.\n");
     if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp)
         return new_error(interp, "vector-set: wrong types.\n");
@@ -95,13 +95,13 @@ static SExpRef vector_set(Interp* interp, SExpRef args) {
     return NIL;
 }
 
-static void vector_free(void *vself) {
+static void ext_vector_free(void *vself) {
     SExpRefVector *self = vself;
     SExpRefVector_free(self);
     free(self);
 }
 
-static void vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
+static void ext_vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
     SExpRefVector *vec = (SExpRefVector *)vself;
     int vecsize = SExpRefVector_len(vec);
     for (int i = 0; i < vecsize; ++i) {
@@ -114,16 +114,16 @@ static void vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) {
 
 int bamboo_lisp_ext_init(Interp *interp) {
     bamboo_lisp_array_meta.type = VECTOR_TYPEID;
-    bamboo_lisp_array_meta.free = &vector_free;
-    bamboo_lisp_array_meta.gcmark = &vector_gcmark;
+    bamboo_lisp_array_meta.free = &ext_vector_free;
+    bamboo_lisp_array_meta.gcmark = &ext_vector_gcmark;
 
     Interp_add_userfunc(interp, "vector?", &is_vector);
     Interp_add_userfunc(interp, "make-vector", &make_vector);
-    Interp_add_userfunc(interp, "vector-ref", &vector_ref);
-    Interp_add_userfunc(interp, "vector-append", &vector_append);
-    Interp_add_userfunc(interp, "vector-insert", &vector_insert);
-    Interp_add_userfunc(interp, "vector-remove", &vector_delete);
-    Interp_add_userfunc(interp, "vector-length", &vector_length);
-    Interp_add_userfunc(interp, "vector-set", &vector_set);
+    Interp_add_userfunc(interp, "vector-ref", &ext_vector_ref);
+    Interp_add_userfunc(interp, "vector-append", &ext_vector_append);
+    Interp_add_userfunc(interp, "vector-insert", &ext_vector_insert);
+    Interp_add_userfunc(interp, "vector-remove", &ext_vector_delete);
+    Interp_add_userfunc(interp, "vector-length", &ext_vector_length);
+    Interp_add_userfunc(interp, "vector-set", &ext_vector_set);
     return 1;
 }
diff --git a/exts/vector/Makefile b/exts/vector/Makefile
deleted file mode 100644
index e69de29..0000000
--- a/exts/vector/Makefile
+++ /dev/null
diff --git a/exts/vector/test.lisp b/exts/vector/test.lisp
deleted file mode 100644
index e69de29..0000000
--- a/exts/vector/test.lisp
+++ /dev/null