From 65cd835954825568a432c2e62d8019269dcafd74 Mon Sep 17 00:00:00 2001 From: Mistivia Date: Tue, 24 Jun 2025 15:44:12 +0800 Subject: add list function --- Readme.md | 7 +++-- src/builtins.c | 78 +++++++++++++++++++++++++++++++++++++++++++++++++ src/builtins.h | 14 ++++----- src/interp.c | 12 +++++--- src/prelude.c | 2 +- src/prelude.lisp | 6 ++-- src/primitives.c | 2 +- tests/arithmetic.lisp | 20 ++++++------- tests/control-flow.lisp | 2 +- tests/eq.lisp | 48 +++++++++++++++--------------- tests/list.lisp | 23 +++++++++++++++ tests/string.lisp | 6 ++-- tests/symbol.lisp | 8 ++--- tests/test.lisp | 1 + 14 files changed, 167 insertions(+), 62 deletions(-) create mode 100644 tests/list.lisp diff --git a/Readme.md b/Readme.md index 7f54db2..beabd47 100644 --- a/Readme.md +++ b/Readme.md @@ -2,7 +2,7 @@ Embeddable & Hackable Lisp-2 Interpreter -## Features & Drawbacks +## Features - Lisp-2 (more like Common Lisp or Emacs Lisp) - Lexical scoping @@ -10,7 +10,6 @@ Embeddable & Hackable Lisp-2 Interpreter - Tail call optimization - Any C99 compiler should work - Depends only on C standard library -- SLOW (trade-off for simplicity) - A simple mark-sweep GC - Writing macro is easy with quasiquote, unquote, and slicing-unquote - No global state, you can run multiple interpreters in multiple threads @@ -19,6 +18,10 @@ Embeddable & Hackable Lisp-2 Interpreter - break - continue +## Drawbacks + +Bamboo Lisp is VERY SLOW tree-walking interpreter. The performance is only 1/5 to 1/10 that of Python, similar to other small interpreters like TinyScheme or very early Emacs Lisp. + ## Build Init submodule: diff --git a/src/builtins.c b/src/builtins.c index 48cb4f0..04afbcb 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -6,6 +6,84 @@ #include #include +SExpRef builtin_set_car(Interp *interp, SExpRef args) { + if (LENGTH(args) != 2) { + return new_error(interp, "set-car: args num error.\n"); + } + SExpRef lst = CAR(args), elem = CADR(args); + if (VALTYPE(lst) != kPairSExp) { + return new_error(interp, "set-car: type error."); + } + REF(lst)->pair.car = elem; + return NIL; +} + +SExpRef builtin_set_cdr(Interp *interp, SExpRef args) { + if (LENGTH(args) != 2) { + return new_error(interp, "set-cdr: args num error.\n"); + } + SExpRef lst = CAR(args), elem = CADR(args); + if (VALTYPE(lst) != kPairSExp) { + return new_error(interp, "set-cdr: type error."); + } + REF(lst)->pair.cdr = elem; + return NIL; +} + +SExpRef builtin_length(Interp *interp, SExpRef args) { + if (LENGTH(args) != 1) { + return new_error(interp, "length: args num error.\n"); + } + int len = LENGTH(CAR(args)); + if (len < 0) { + return new_error(interp, "length: type error.\n"); + } + return new_integer(interp, len); +} + +SExpRef builtin_nth(Interp *interp, SExpRef args) { + if (LENGTH(args) != 2) { + return new_error(interp, "nth: args num error.\n"); + } + SExpRef n = CAR(args), lst = CADR(args); + if (VALTYPE(n) != kIntegerSExp) return new_error(interp, "nth: type error.\n"); + if (VALTYPE(lst) == kPairSExp) { + if (REF(n)->integer >= LENGTH(lst)) { + return new_error(interp, "nth: out of bound.\n"); + } + for (int i = 0; i < REF(n)->integer; i++) { + lst = CDR(lst); + } + return CAR(lst); + } else if (VALTYPE(lst) == kStringSExp) { + if (REF(n)->integer >= strlen(REF(lst)->str)) { + return new_error(interp, "nth: out of bound\n"); + } + return new_char(interp, REF(lst)->str[REF(n)->integer]); + } else { + return new_error(interp, "nth: type error.\n"); + } +} + +SExpRef builtin_nthcdr(Interp *interp, SExpRef args) { + if (LENGTH(args) != 2) { + return new_error(interp, "nth: args num error.\n"); + } + SExpRef n = CAR(args), lst = CADR(args); + if (VALTYPE(n) != kIntegerSExp) return new_error(interp, "nth: type error.\n"); + if (VALTYPE(lst) == kPairSExp) { + if (REF(n)->integer >= LENGTH(lst)) { + return new_error(interp, "nth: out of bound.\n"); + } + for (int i = 0; i < REF(n)->integer; i++) { + lst = CDR(lst); + } + return CDR(lst); + } else { + return new_error(interp, "nth: type error.\n"); + } +} + SExpRef builtin_string(Interp *interp, SExpRef args) { for (SExpRef i = args; !NILP(i); i = CDR(i)) { SExpRef x = CAR(i); diff --git a/src/builtins.h b/src/builtins.h index 608df98..3832afb 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -3,15 +3,11 @@ #include "interp.h" -// - char= -// - char> -// - char< -// - char>= -// - char<= -// - char/= -// - ord -// - chr - +SExpRef builtin_set_car(Interp *interp, SExpRef args); +SExpRef builtin_set_cdr(Interp *interp, SExpRef args); +SExpRef builtin_length(Interp *interp, SExpRef args); +SExpRef builtin_nth(Interp *interp, SExpRef args); +SExpRef builtin_nthcdr(Interp *interp, SExpRef args); SExpRef builtin_string(Interp *interp, SExpRef args); SExpRef builtin_string_eq(Interp *interp, SExpRef args); SExpRef builtin_string_gt(Interp *interp, SExpRef args); diff --git a/src/interp.c b/src/interp.c index 15aabdb..80ddfed 100644 --- a/src/interp.c +++ b/src/interp.c @@ -102,7 +102,7 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, "sqrt", builtin_sqrt); Interp_add_userfunc(self, "cbrt", builtin_cbrt); Interp_add_userfunc(self, "log10", builtin_log10); - Interp_add_userfunc(self, "eq", builtin_eq); + Interp_add_userfunc(self, "eq?", builtin_eq); Interp_add_userfunc(self, "ln", builtin_ln); Interp_add_userfunc(self, "=", builtin_num_equal); Interp_add_userfunc(self, "/=", builtin_num_neq); @@ -138,7 +138,7 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, "not", builtin_not); Interp_add_userfunc(self, "cos", builtin_cos); Interp_add_userfunc(self, "princ", builtin_princ); - Interp_add_userfunc(self, "equal", builtin_equal); + Interp_add_userfunc(self, "equal?", builtin_equal); Interp_add_userfunc(self, "atan", builtin_atan); Interp_add_userfunc(self, "cons", builtin_cons); Interp_add_userfunc(self, "cdr", builtin_cdr); @@ -147,7 +147,11 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, "floor", builtin_floor); Interp_add_userfunc(self, "min", builtin_min); Interp_add_userfunc(self, "error", builtin_error); - + Interp_add_userfunc(self, "set-car", builtin_set_car); + Interp_add_userfunc(self, "set-cdr", builtin_set_cdr); + Interp_add_userfunc(self, "length", builtin_length); + Interp_add_userfunc(self, "nth", builtin_nth); + Interp_add_userfunc(self, "nthcdr", builtin_nthcdr); Interp_add_userfunc(self, "_gcstat", builtin_gcstat); Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc); @@ -399,7 +403,7 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i } else if (pe->type == kRealSExp) { str_builder_append(sb, "%lg", pe->real); } else if (pe->type == kCharSExp) { - str_builder_append(sb, "#\%c", pe->character); + str_builder_append(sb, "#\\%c", pe->character); } else if (pe->type == kBooleanSExp) { if (pe->boolean) str_builder_append(sb, "#t"); else str_builder_append(sb, "#f"); diff --git a/src/prelude.c b/src/prelude.c index ca9109d..8baca6b 100644 --- a/src/prelude.c +++ b/src/prelude.c @@ -1,6 +1,6 @@ #include "prelude.h" -const char *bamboo_lisp_prelude = "(defvar nil \'())\n\n(defvar pi 3.1415926)\n(defvar e 2.718281828)\n\n(defmacro incq (i)\n `(setq ,i (+ ,i 1)))\n\n(defmacro decq (i)\n `(setq ,i (- ,i 1)))\n\n(defun zerop (x) (= x 0))\n(defun plusp (x) (> x 0))\n(defun minusp (x) (< x 0))\n\n(defmacro when (pred . body)\n `(if ,pred\n (progn ,@body)\n nil))\n\n(defmacro unless (pred . body)\n `(if ,pred\n nil\n (progn ,@body)))\n"; +const char *bamboo_lisp_prelude = "(defvar nil \'())\n\n(defvar pi 3.1415926)\n(defvar e 2.718281828)\n\n(defmacro incq (i)\n `(setq ,i (+ ,i 1)))\n\n(defmacro decq (i)\n `(setq ,i (- ,i 1)))\n\n(defun zero? (x) (= x 0))\n(defun plus? (x) (> x 0))\n(defun minus? (x) (< x 0))\n\n(defmacro when (pred . body)\n `(if ,pred\n (progn ,@body)\n nil))\n\n(defmacro unless (pred . body)\n `(if ,pred\n nil\n (progn ,@body)))\n"; diff --git a/src/prelude.lisp b/src/prelude.lisp index 7e9992b..c65380a 100644 --- a/src/prelude.lisp +++ b/src/prelude.lisp @@ -9,9 +9,9 @@ (defmacro decq (i) `(setq ,i (- ,i 1))) -(defun zerop (x) (= x 0)) -(defun plusp (x) (> x 0)) -(defun minusp (x) (< x 0)) +(defun zero? (x) (= x 0)) +(defun plus? (x) (> x 0)) +(defun minus? (x) (< x 0)) (defmacro when (pred . body) `(if ,pred diff --git a/src/primitives.c b/src/primitives.c index 899cbdd..5f70f09 100644 --- a/src/primitives.c +++ b/src/primitives.c @@ -64,7 +64,7 @@ SExpRef primitive_assert(Interp *interp, SExpRef args, bool istail) { if (LENGTH(args) != 1) { return new_error(interp, "assert: expect 1 arg.\n"); } - if (TRUEP(CAR(eargs))) { + if (TRUEP(CAR(eargs)) && !CTL_FL(CAR(eargs))) { return interp->t; } else { const char *expstr = lisp_to_string(interp, CAR(args)); diff --git a/tests/arithmetic.lisp b/tests/arithmetic.lisp index 1942a1d..38b1185 100644 --- a/tests/arithmetic.lisp +++ b/tests/arithmetic.lisp @@ -5,18 +5,18 @@ (assert (= 2 (i/ 11 5))) (assert (= 1 (mod 11 5))) -(assert (zerop 0)) -(assert (not (zerop 1))) -(assert (not (zerop -1))) +(assert (zero? 0)) +(assert (not (zero? 1))) +(assert (not (zero? -1))) -(assert (plusp 1)) -(assert (plusp 1.0)) -(assert (not (plusp 0))) -(assert (not (plusp -1))) +(assert (plus? 1)) +(assert (plus? 1.0)) +(assert (not (plus? 0))) +(assert (not (plus? -1))) -(assert (minusp -1)) -(assert (not (minusp 0))) -(assert (not (minusp 1))) +(assert (minus? -1)) +(assert (not (minus? 0))) +(assert (not (minus? 1))) (assert (< 1 2)) (assert (< 1.0 2)) diff --git a/tests/control-flow.lisp b/tests/control-flow.lisp index 321aae0..965213e 100644 --- a/tests/control-flow.lisp +++ b/tests/control-flow.lisp @@ -1,6 +1,6 @@ (assert-error (if (error "") 1 2)) -(defmacro inmacro x (progn ,@x)) +(defmacro inmacro x `(progn ,@x)) (let ((i 0)) (while #t diff --git a/tests/eq.lisp b/tests/eq.lisp index 4db31ce..a7758bb 100644 --- a/tests/eq.lisp +++ b/tests/eq.lisp @@ -1,27 +1,27 @@ -(assert-error (eq 1 2 3)) -(assert-error (equal 1 2 3)) +(assert-error (eq?1 2 3)) +(assert-error (equal?1 2 3)) -(assert (eq 1 1)) -(assert (eq 'a 'a)) -(assert (eq 1.0 1.0)) -(assert (eq #\a #\a)) -(assert (eq #f #f)) -(assert (eq nil nil)) -(assert (eq #t #t)) -(assert (not (eq 1 2))) -(assert (not (eq "a" "a"))) -(assert (not (eq 'a 'b))) -(assert (not (eq '(1 2) '(1 2)))) +(assert (eq? 1 1)) +(assert (eq? 'a 'a)) +(assert (eq? 1.0 1.0)) +(assert (eq? #\a #\a)) +(assert (eq? #f #f)) +(assert (eq? nil nil)) +(assert (eq? #t #t)) +(assert (not (eq? 1 2))) +(assert (not (eq? "a" "a"))) +(assert (not (eq? 'a 'b))) +(assert (not (eq? '(1 2) '(1 2)))) -(assert (equal 1 1)) -(assert (equal 'a 'a)) -(assert (equal "a" "a")) -(assert (equal 1.0 1.0)) -(assert (equal #\a #\a)) -(assert (equal #f #f)) -(assert (equal '(1 2) '(1 2))) +(assert (equal? 1 1)) +(assert (equal? 'a 'a)) +(assert (equal? "a" "a")) +(assert (equal? 1.0 1.0)) +(assert (equal? #\a #\a)) +(assert (equal? #f #f)) +(assert (equal? '(1 2) '(1 2))) -(assert (not (equal 1 2))) -(assert (not (equal 'a 'b))) -(assert (not (equal "a" "b"))) -(assert (not (equal '(1 2 3) '(1 2)))) +(assert (not (equal? 1 2))) +(assert (not (equal? 'a 'b))) +(assert (not (equal? "a" "b"))) +(assert (not (equal? '(1 2 3) '(1 2)))) diff --git a/tests/list.lisp b/tests/list.lisp new file mode 100644 index 0000000..168ccf2 --- /dev/null +++ b/tests/list.lisp @@ -0,0 +1,23 @@ +(let ((l (list 1 2 3))) + (set-cdr l 4) + (assert (equal? l (cons 1 4)))) + +(let ((l (list 1 2 3))) + (set-car l 4) + (assert (equal? l (list 4 2 3)))) + +(assert-error (set-car 1)) +(assert-error (set-car)) +(assert-error (set-car (list 1) (list 2) (list 3))) +(assert-error (set-car "")) +(assert-error (set-cdr 1)) +(assert-error (set-cdr)) +(assert-error (set-cdr (list 1) (list 2) (list 3))) +(assert-error (set-cdr "")) + +(assert (= 3 (length (list 1 2 3)))) +(assert (= 0 (length nil))) + +(assert (= 3 (nth 2 (list 1 2 3)))) +(assert (equal? nil (nthcdr 2 (list 1 2 3)))) +(assert (equal? (list 3) (nthcdr 1 (list 1 2 3)))) diff --git a/tests/string.lisp b/tests/string.lisp index a55e558..a323c96 100644 --- a/tests/string.lisp +++ b/tests/string.lisp @@ -1,5 +1,5 @@ -(assert (equal "abc" (string #\a #\b #\c))) -(assert (equal "ABC" (string 65 66 67))) +(assert (equal? "abc" (string #\a #\b #\c))) +(assert (equal? "ABC" (string 65 66 67))) (assert (string= "abc" (string #\a #\b #\c))) (assert (string= "ABC" (string 65 66 67))) @@ -25,5 +25,5 @@ (assert (not (string> s1 s2))) (assert (string= "abc" (strip-string "\n\tabc \t\n"))) -(assert (equal ("a" "b" "c") (split-string "a,b,c" #\,))) +(assert (equal? (list "a" "b" "c") (split-string "a,b,c" #\,))) diff --git a/tests/symbol.lisp b/tests/symbol.lisp index f771272..e19c514 100644 --- a/tests/symbol.lisp +++ b/tests/symbol.lisp @@ -1,4 +1,4 @@ -(assert (eq 'a (intern "a"))) -(assert (eq (intern "ab") (intern (concat "a" "b")))) -(assert (equal "abc" (symbol->string 'abc))) -(assert (not (eq (gensym) (gensym)))) +(assert (eq? 'a (intern "a"))) +(assert (eq? (intern "ab") (intern (concat "a" "b")))) +(assert (equal? "abc" (symbol->string 'abc))) +(assert (not (eq? (gensym) (gensym)))) diff --git a/tests/test.lisp b/tests/test.lisp index a303ed3..59f91fb 100644 --- a/tests/test.lisp +++ b/tests/test.lisp @@ -18,6 +18,7 @@ (test-module macro) (test-module let-binding) (test-module string) +(test-module list) (princ "\n\nTest with intensive GC:\n\n") (_alwaysgc #t) -- cgit v1.0