aboutsummaryrefslogtreecommitdiff
path: root/exts
diff options
context:
space:
mode:
Diffstat (limited to 'exts')
-rw-r--r--exts/Makefile31
-rw-r--r--exts/dict.c (renamed from exts/dict/main.c)41
-rw-r--r--exts/dict/Makefile0
-rw-r--r--exts/dict/test.lisp0
-rw-r--r--exts/io.c295
-rw-r--r--exts/io/main.c0
-rw-r--r--exts/test_input.txt3
-rw-r--r--exts/tests/test_dict.lisp17
-rw-r--r--exts/tests/test_io.lisp15
-rw-r--r--exts/vector.c (renamed from exts/vector/main.c)32
-rw-r--r--exts/vector/Makefile0
-rw-r--r--exts/vector/test.lisp0
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