aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Readme.md2
-rw-r--r--src/builtins.c98
-rw-r--r--src/builtins.h12
-rw-r--r--src/interp.c12
-rw-r--r--src/prelude.c2
-rw-r--r--src/prelude.lisp14
-rw-r--r--src/primitives.c2
-rw-r--r--tests/char.lisp34
-rw-r--r--tests/test.lisp2
9 files changed, 175 insertions, 3 deletions
diff --git a/Readme.md b/Readme.md
index 9ccb647..85ae42e 100644
--- a/Readme.md
+++ b/Readme.md
@@ -20,7 +20,7 @@ Embeddable & Hackable Lisp-2 Interpreter
## 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 Python.
+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
diff --git a/src/builtins.c b/src/builtins.c
index 9ab38d5..950c2c7 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -2,10 +2,108 @@
#include "interp.h"
#include "sexp.h"
#include <algds/str.h>
+#include <ctype.h>
#include <stdint.h>
#include <float.h>
#include <math.h>
+SExpRef builtin_charp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "char?: arg num error.");
+ return new_boolean(interp, VALTYPE(CAR(args)) == kCharSExp);
+}
+
+SExpRef builtin_char_eq(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char=: arg num error.");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char=: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a == b);
+}
+
+SExpRef builtin_char_gt(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char>: arg num error.");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char>: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a > b);
+}
+
+SExpRef builtin_char_lt(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char<: arg num error.");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char<: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a < b);
+}
+#undef FUNC
+
+SExpRef builtin_char_ge(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char>=: arg num error.");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char>=: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a >= b);
+}
+
+SExpRef builtin_char_le(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char<=: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char<=: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a <= b);
+}
+#undef FUNC
+
+SExpRef builtin_char_neq(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "char/=: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp || VALTYPE(CADR(args)) != kCharSExp) {
+ return new_error(interp, "char/=: type error.\n");
+ }
+ char a = REF(CAR(args))->character;
+ char b = REF(CADR(args))->character;
+ return new_boolean(interp, a != b);
+}
+
+SExpRef builtin_char2int(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "char->int: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp) return new_error(interp, "char->int: type error.\n");
+ return new_integer(interp, REF(CAR(args))->character);
+}
+
+SExpRef builtin_int2char(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "int->char: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kIntegerSExp) return new_error(interp, "int->char: type error.\n");
+ return new_char(interp, REF(CAR(args))->integer);
+}
+
+SExpRef builtin_alphabeticp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "alphabetic?: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp) return new_error(interp, "alphabetic?: type error.\n");
+ return new_boolean(interp, isalpha(REF(CAR(args))->character));
+}
+
+SExpRef builtin_numericp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "numeric?: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp) return new_error(interp, "numeric?: type error.\n");
+ return new_boolean(interp, isdigit(REF(CAR(args))->character));
+}
+
+SExpRef builtin_alphanump(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "alphanum?: arg num error.\n");
+ if (VALTYPE(CAR(args)) != kCharSExp) return new_error(interp, "alphanum?: type error.\n");
+ return new_boolean(interp, isalnum(REF(CAR(args))->character));
+}
+
SExpRef builtin_listp(Interp *interp, SExpRef args) {
if (LENGTH(args) != 1) return new_error(interp, "list?: arg num error.\n");
return new_boolean(interp, lisp_check_list(interp, CAR(args)));
diff --git a/src/builtins.h b/src/builtins.h
index bf97086..673db23 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,18 @@
#include "interp.h"
+SExpRef builtin_charp(Interp *interp, SExpRef args);
+SExpRef builtin_char_eq(Interp *interp, SExpRef args);
+SExpRef builtin_char_gt(Interp *interp, SExpRef args);
+SExpRef builtin_char_lt(Interp *interp, SExpRef args);
+SExpRef builtin_char_ge(Interp *interp, SExpRef args);
+SExpRef builtin_char_le(Interp *interp, SExpRef args);
+SExpRef builtin_char_neq(Interp *interp, SExpRef args);
+SExpRef builtin_int2char(Interp *interp, SExpRef args);
+SExpRef builtin_char2int(Interp *interp, SExpRef args);
+SExpRef builtin_alphabeticp(Interp *interp, SExpRef args);
+SExpRef builtin_numericp(Interp *interp, SExpRef args);
+SExpRef builtin_alphanump(Interp *interp, SExpRef args);
SExpRef builtin_listp(Interp *interp, SExpRef args);
SExpRef builtin_consp(Interp *interp, SExpRef args);
SExpRef builtin_atomp(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index 6f2bb8a..116636e 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -168,6 +168,18 @@ void Interp_init(Interp *self) {
Interp_add_userfunc(self, "nreverse", builtin_nreverse);
Interp_add_userfunc(self, "reverse", builtin_reverse);
Interp_add_userfunc(self, "last", builtin_last);
+ Interp_add_userfunc(self, "char?", builtin_charp);
+ Interp_add_userfunc(self, "char=", builtin_char_eq);
+ Interp_add_userfunc(self, "char>", builtin_char_gt);
+ Interp_add_userfunc(self, "char<", builtin_char_lt);
+ Interp_add_userfunc(self, "char>=", builtin_char_ge);
+ Interp_add_userfunc(self, "char<=", builtin_char_le);
+ Interp_add_userfunc(self, "char/=", builtin_char_neq);
+ Interp_add_userfunc(self, "int->char", builtin_int2char);
+ Interp_add_userfunc(self, "char->int", builtin_char2int);
+ Interp_add_userfunc(self, "alphabetic?", builtin_alphabeticp);
+ Interp_add_userfunc(self, "numeric?", builtin_numericp);
+ Interp_add_userfunc(self, "alphanum?", builtin_alphanump);
Interp_add_userfunc(self, "_gcstat", builtin_gcstat);
Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc);
diff --git a/src/prelude.c b/src/prelude.c
index 8baca6b..e827718 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 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";
+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\n(defun caar (x) (car (car x)))\n(defun cadr (x) (car (cdr x)))\n(defun cddr (x) (cdr (cdr x)))\n(defun cdar (x) (cdr (car x)))\n\n(defun caaar (x) (car (caar x)))\n(defun cadar (x) (car (cdar x)))\n(defun cddar (x) (cdr (cdar x)))\n(defun cdaar (x) (cdr (caar x)))\n(defun caadr (x) (car (cadr x)))\n(defun caddr (x) (car (cddr x)))\n(defun cdddr (x) (cdr (cddr x)))\n(defun cdadr (x) (cdr (cadr x)))\n";
diff --git a/src/prelude.lisp b/src/prelude.lisp
index c65380a..b102e1b 100644
--- a/src/prelude.lisp
+++ b/src/prelude.lisp
@@ -22,3 +22,17 @@
`(if ,pred
nil
(progn ,@body)))
+
+(defun caar (x) (car (car x)))
+(defun cadr (x) (car (cdr x)))
+(defun cddr (x) (cdr (cdr x)))
+(defun cdar (x) (cdr (car x)))
+
+(defun caaar (x) (car (caar x)))
+(defun cadar (x) (car (cdar x)))
+(defun cddar (x) (cdr (cdar x)))
+(defun cdaar (x) (cdr (caar x)))
+(defun caadr (x) (car (cadr x)))
+(defun caddr (x) (car (cddr x)))
+(defun cdddr (x) (cdr (cddr x)))
+(defun cdadr (x) (cdr (cadr x)))
diff --git a/src/primitives.c b/src/primitives.c
index 8e56bf9..a8bb62a 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -207,7 +207,7 @@ SExpRef primitive_let(Interp *interp, SExpRef args, bool istail) {
while (!NILP(iter)) {
exp = CAR(iter);
if (NILP(CDR(iter))) {
- ret = lisp_eval(interp, exp, istail);
+ ret = lisp_eval(interp, exp, true);
goto end;
} else {
ret = EVAL(exp);
diff --git a/tests/char.lisp b/tests/char.lisp
new file mode 100644
index 0000000..2218671
--- /dev/null
+++ b/tests/char.lisp
@@ -0,0 +1,34 @@
+(assert (char? #\a))
+(assert (not (char? 1)))
+(assert (not (char? (cons 1 2))))
+(assert (not (char? "a")))
+
+(assert (char= #\a #\a))
+(assert (char>= #\a #\a))
+(assert (char<= #\a #\a))
+(assert (char< #\a #\b))
+(assert (char> #\b #\a))
+(assert (char<= #\a #\b))
+(assert (char>= #\b #\a))
+(assert (char/= #\b #\a))
+
+(assert (not (char/= #\a #\a)))
+(assert (not (char< #\a #\a)))
+(assert (not (char> #\a #\a)))
+(assert (not (char>= #\a #\b)))
+(assert (not (char<= #\b #\a)))
+(assert (not (char> #\a #\b)))
+(assert (not (char< #\b #\a)))
+(assert (not (char= #\b #\a)))
+
+(assert (= 97 (char->int #\a)))
+(assert (char= #\a (int->char 97)))
+
+(assert (alphabetic? #\a))
+(assert (alphanum? #\a))
+(assert (alphanum? #\1))
+(assert (numeric? #\1))
+(assert (not (numeric? #\a)))
+(assert (not (alphabetic? #\1)))
+(assert (not (alphanum? #\,)))
+
diff --git a/tests/test.lisp b/tests/test.lisp
index 8969a5b..5d5d807 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -20,6 +20,7 @@
(test-module string)
(test-module list)
(test-module type)
+(test-module char)
(princ "\n\nTest with intensive GC:\n\n")
(_alwaysgc #t)
@@ -39,5 +40,6 @@
(test-module string)
(test-module list)
(test-module type)
+(test-module char)
(exit)
generated by cgit v1.0 at 2025-12-29 15:40:48 +0000