diff options
| -rw-r--r-- | Makefile | 38 | ||||
| -rw-r--r-- | README.md | 22 | ||||
| -rw-r--r-- | ext_example/vector.c | 129 | ||||
| -rw-r--r-- | exts/dict.c | 4 | ||||
| -rw-r--r-- | exts/exts.h | 10 | ||||
| -rw-r--r-- | exts/io.c | 4 | ||||
| -rw-r--r-- | exts/test_input.txt | 3 | ||||
| -rw-r--r-- | exts/tests/test_io.lisp | 15 | ||||
| -rw-r--r-- | exts/vector.c | 4 | ||||
| -rw-r--r-- | interp.c | 5 | ||||
| -rw-r--r-- | tests/dict.lisp (renamed from exts/tests/test_dict.lisp) | 2 | ||||
| -rw-r--r-- | tests/io-test-input.txt | 3 | ||||
| -rw-r--r-- | tests/io.lisp | 13 | ||||
| -rw-r--r-- | tests/test.lisp | 4 | ||||
| -rw-r--r-- | tests/vector.lisp | 2 |
15 files changed, 64 insertions, 194 deletions
@@ -1,9 +1,9 @@ mode ?= debug cc = gcc -includes = -DWITHREADLINE -fPIC +includes = -DWITHREADLINE -ldflags = -L./ -lm -lreadline -lalgds +ldflags = -L./ -lm -lreadline -lalgds ifeq ($(mode), debug) cflags = $(includes) -g else @@ -13,38 +13,26 @@ endif curdir = ./ installdir = /usr/local/lib/ -src = $(shell find ./ -maxdepth 1 -name '*.c' -not -name 'main.c') +src = $(shell find ./ -maxdepth 1 -name '*.c' -not -name 'main.c') $(shell find ./exts/ -maxdepth 1 -name '*.c') obj = $(src:.c=.o) -extsrc = $(shell find ./ext_example/ -maxdepth 1 -name '*.c') -extobj = $(extsrc:.c=.so) - tests=$(shell ls tests/*.c) tests_bin=$(tests:.c=.bin) -all: bamboo-lisp exts $(tests_bin) - -exts: $(extobj) +all: bamboo-lisp $(tests_bin) -install: bamboo-lisp libbamboo-lisp.so - sudo cp bamboo-lisp /usr/local/bin/bamboo-lisp - sudo cp libbamboo-lisp.so $(installdir) - sudo mkdir -p /usr/local/include/bamboo_lisp - sudo cp *.h /usr/local/include/bamboo_lisp/ +install: bamboo-lisp + cp bamboo-lisp /usr/local/bin/bamboo-lisp + mkdir -p /usr/local/include/bamboo_lisp + cp *.h /usr/local/include/bamboo_lisp/ prelude.c: prelude.lisp cat prelude.lisp | python scripts/genprelude.py > prelude.c -bamboo-lisp: libbamboo-lisp.so main.o - gcc $(cflags) -o $@ $^ $(ldflags) -lbamboo-lisp -Wl,-rpath,$(curdir) -Wl,-rpath,$(installdir) - -libbamboo-lisp.so: $(obj) - gcc -shared -o $@ $^ $(ldflags) - -$(extobj):%.so:%.c libbamboo-lisp.so - gcc -shared $(cflags) -I./ -o $@ $^ $(ldflags) -lbamboo-lisp -Wl,-rpath,$(curdir) -Wl,-rpath,$(installdir) +bamboo-lisp: main.o $(obj) + gcc $(cflags) -o $@ $< $(obj) $(ldflags) -test: bamboo-lisp $(tests_bin) exts +test: bamboo-lisp $(tests_bin) @echo @echo "Run tests:" @scripts/runall.sh $(tests_bin) @@ -57,8 +45,8 @@ main.o:main.c $(obj):%.o:%.c $(cc) -c $(cflags) $< -MD -MF $@.d -o $@ -$(tests_bin):%.bin:%.c libbamboo-lisp.so - $(cc) $(cflags) -I./ $< -MD -MF $@.d -o $@ $(ldflags) -lbamboo-lisp -Wl,-rpath,$(curdir) -Wl,-rpath,$(installdir) +$(tests_bin):%.bin:%.c $(obj) + $(cc) $(cflags) -I./ $< $(obj) -MD -MF $@.d -o $@ $(ldflags) clean: -rm $(shell find tests/ -name '*.bin') @@ -4,11 +4,13 @@ Embeddable & Hackable Lisp-2 Interpreter There is a WebAssembly build, you can [try it online](https://mistivia.github.io/bamboo-lisp/). -## Features +## About + +**Features:** - Lisp-2 (more like Common Lisp or Emacs Lisp) - Lexical scoping -- The interpreter part is ~2500 LOC (excluding built-in functions) +- A small but extensible core - Tail call optimization - Any C99 compiler should work - A simple mark-sweep GC @@ -21,25 +23,21 @@ There is a WebAssembly build, you can [try it online](https://mistivia.github.io - break - continue -## Drawbacks +**Drawbacks:** To keep simplicity, Bamboo Lisp is a VERY SLOW tree-walking interpreter. The performance is similar to other small Lisp interpreters like TinyScheme or very early Emacs Lisp, which is only 1/5 to 1/10 that of modern Python. -## Build - -Install dependency first, see [algds](https://github.com/mistivia/algds) for details. +**Summary:** -Debug: +If you want a TinyScheme-like embeddable lisp intereter but in Lisp-2 flavour, Bamboo Lisp is for you. -```bash -make -``` +## Build -Release: +Install dependency first, see [algds](https://github.com/mistivia/algds) for details. ```bash -make clean make mode=release +sudo make install ``` ## Usage diff --git a/ext_example/vector.c b/ext_example/vector.c deleted file mode 100644 index a67a504..0000000 --- a/ext_example/vector.c +++ /dev/null @@ -1,129 +0,0 @@ -#include "interp.h" -#include "sexp.h" - -#define VECTOR_TYPEID "ext.core.vector" - -LispUserdataMeta bamboo_lisp_array_meta; - -static bool is_vector_impl(Interp *interp, SExpRef vec) { - if (VALTYPE(vec) == kUserDataSExp && strcmp(VECTOR_TYPEID, REF(vec)->userdata_meta->type) == 0) { - return true; - } - return false; -} - -static SExpRef is_vector(Interp* interp, SExpRef args) { - if (LENGTH(args) != 1) return new_error(interp, "vector?: wrongs args num.\n"); - return new_boolean(interp, is_vector_impl(interp, CAR(args))); -} - -static SExpRef make_vector(Interp* interp, SExpRef args) { - SExpRef ret = new_sexp(interp); - REF(ret)->type = kUserDataSExp; - REF(ret)->userdata_meta = &bamboo_lisp_array_meta; - SExpRefVector *data = malloc(sizeof(SExpRefVector)); - SExpRefVector_init(data); - REF(ret)->userdata = data; - return ret; -} - -static SExpRef 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) { - return new_error(interp, "vector-ref: wrong type.\n"); - } - int n = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (n >= SExpRefVector_len(vec)) return new_error(interp, "vector-ref: out of bound.\n"); - SExpRef ret = new_sexp(interp); - return *SExpRefVector_ref(vec, n); -} - -static SExpRef 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"); - - SExpRefVector *vec = REF(CAR(args))->userdata; - SExpRef elem = CADR(args); - SExpRefVector_push_back(vec, elem); - return NIL; -} - -static SExpRef 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"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - SExpRef elem = CADDR(args); - SExpRefVector_insert_before(vec, pos, elem); - return NIL; -} - -static SExpRef 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"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-remove: out of bound.\n"); - SExpRefVector_remove(vec, pos); - return NIL; -} - -static SExpRef 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"); - - SExpRefVector *vec = REF(CAR(args))->userdata; - return new_integer(interp, SExpRefVector_len(vec)); -} - -static SExpRef 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"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-set: out of bound.\n"); - - *SExpRefVector_ref(vec, pos) = CADDR(args); - return NIL; -} - -static void vector_free(void *vself) { - SExpRefVector *self = vself; - SExpRefVector_free(self); - free(self); -} - -static void vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { - SExpRefVector *vec = (SExpRefVector *)vself; - int vecsize = SExpRefVector_len(vec); - for (int i = 0; i < vecsize; ++i) { - SExpPtr child = REF(*SExpRefVector_ref(vec, i)); - if (child && !child->marked) { - SExpPtrVector_push_back(gcstack, child); - } - } -} - -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; - - 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); - return 1; -} diff --git a/exts/dict.c b/exts/dict.c index 772e48f..670949a 100644 --- a/exts/dict.c +++ b/exts/dict.c @@ -15,7 +15,7 @@ typedef String2SExpRefTreeMapNode DictNode; LispUserdataMeta bamboo_lisp_dict_meta; -#define DICT_TYPEID "ext.core.dict" +#define DICT_TYPEID "ext.dict" static bool is_dict_impl(Interp *interp, SExpRef obj) { if (VALTYPE(obj) == kUserDataSExp && strcmp(DICT_TYPEID, REF(obj)->userdata_meta->type) == 0) { @@ -167,7 +167,7 @@ static SExpRef ext_dict_keys(Interp *interp, SExpRef args) { return lst; } -int bamboo_lisp_ext_init(Interp *interp) { +int bamboo_lisp_ext_dict_init(Interp *interp) { bamboo_lisp_dict_meta.type = DICT_TYPEID; bamboo_lisp_dict_meta.free = &dict_free; bamboo_lisp_dict_meta.gcmark = &dict_gcmark; diff --git a/exts/exts.h b/exts/exts.h new file mode 100644 index 0000000..a78fed1 --- /dev/null +++ b/exts/exts.h @@ -0,0 +1,10 @@ +#ifndef BAMBOO_LISP_EXTS_H_ +#define BAMBOO_LISP_EXTS_H_ + +#include <bamboo_lisp/interp.h> + +int bamboo_lisp_ext_vector_init(Interp *interp); +int bamboo_lisp_ext_io_init(Interp *interp); +int bamboo_lisp_ext_dict_init(Interp *interp); + +#endif
\ No newline at end of file @@ -6,7 +6,7 @@ #include <bamboo_lisp/interp.h> #include <bamboo_lisp/sexp.h> -#define STREAM_TYPEID "ext.core.stream" +#define STREAM_TYPEID "ext.stream" typedef struct { FILE *fp; @@ -275,7 +275,7 @@ static void stream_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { (void)vself; } -int bamboo_lisp_ext_init(Interp *interp) { +int bamboo_lisp_ext_io_init(Interp *interp) { bamboo_lisp_stream_meta.type = STREAM_TYPEID; bamboo_lisp_stream_meta.free = &stream_free; bamboo_lisp_stream_meta.gcmark = &stream_gcmark; diff --git a/exts/test_input.txt b/exts/test_input.txt deleted file mode 100644 index c5b2a08..0000000 --- a/exts/test_input.txt +++ /dev/null @@ -1,3 +0,0 @@ -abc123 -ascx -asc
\ No newline at end of file diff --git a/exts/tests/test_io.lisp b/exts/tests/test_io.lisp deleted file mode 100644 index 76b91ce..0000000 --- a/exts/tests/test_io.lisp +++ /dev/null @@ -1,15 +0,0 @@ -(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.c b/exts/vector.c index 960cf5d..45471df 100644 --- a/exts/vector.c +++ b/exts/vector.c @@ -1,7 +1,7 @@ #include <bamboo_lisp/interp.h> #include <bamboo_lisp/sexp.h> -#define VECTOR_TYPEID "ext.core.vector" +#define VECTOR_TYPEID "ext.vector" LispUserdataMeta bamboo_lisp_array_meta; @@ -112,7 +112,7 @@ static void ext_vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vsel } } -int bamboo_lisp_ext_init(Interp *interp) { +int bamboo_lisp_ext_vector_init(Interp *interp) { bamboo_lisp_array_meta.type = VECTOR_TYPEID; bamboo_lisp_array_meta.free = &ext_vector_free; bamboo_lisp_array_meta.gcmark = &ext_vector_gcmark; @@ -11,6 +11,7 @@ #include "primitives.h" #include "parser.h" #include "prelude.h" +#include "exts/exts.h" #define BUFSIZE 1024 @@ -259,6 +260,10 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, "_gcstat", builtin_gcstat); Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc); + bamboo_lisp_ext_vector_init(self); + bamboo_lisp_ext_io_init(self); + bamboo_lisp_ext_dict_init(self); + SExpRef ret = Interp_eval_string(self, bamboo_lisp_prelude); Interp *interp = self; if (VALTYPE(ret) == kErrSignal) { diff --git a/exts/tests/test_dict.lisp b/tests/dict.lisp index 501faba..379863e 100644 --- a/exts/tests/test_dict.lisp +++ b/tests/dict.lisp @@ -1,5 +1,3 @@ -(loadext "./dict.so") - (defvar d (make-dict)) (dict-set d "a" 1) diff --git a/tests/io-test-input.txt b/tests/io-test-input.txt new file mode 100644 index 0000000..9e9f1b9 --- /dev/null +++ b/tests/io-test-input.txt @@ -0,0 +1,3 @@ +abc +1234 +123
\ No newline at end of file diff --git a/tests/io.lisp b/tests/io.lisp new file mode 100644 index 0000000..9a7d3dc --- /dev/null +++ b/tests/io.lisp @@ -0,0 +1,13 @@ +(defvar fp (open-file "./tests/io-test-input.txt" "r")) +(assert (char= #\a (read-char fp))) +(assert (char= #\b (read-char fp))) +(assert (char= #\c (read-char fp))) +(stream-close fp) + +(defvar fp (open-file "./tests/io-test-input.txt" "r")) +(assert (string= "abc" (read-line fp))) +(stream-close fp) + +(defvar fp (open-file "./tests/io-test-input.txt" "r")) +(assert (equal? (list "abc" "1234" "123") (lines fp))) +(stream-close fp)
\ No newline at end of file diff --git a/tests/test.lisp b/tests/test.lisp index 241f69c..f97acba 100644 --- a/tests/test.lisp +++ b/tests/test.lisp @@ -23,6 +23,8 @@ (test-module char) (test-module bitwise) (test-module vector) +(test-module dict) +(test-module io) (princ "\n\nTest with intensive GC:\n\n") (_alwaysgc #t) @@ -45,5 +47,7 @@ (test-module char) (test-module bitwise) (test-module vector) +(test-module dict) +(test-module io) (exit) diff --git a/tests/vector.lisp b/tests/vector.lisp index 10afde4..d4f7231 100644 --- a/tests/vector.lisp +++ b/tests/vector.lisp @@ -1,5 +1,3 @@ -(loadext "ext_example/vector.so") - (assert (vector? (make-vector))) (assert (not (vector? 1))) |