aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/builtins.c102
-rw-r--r--src/builtins.h11
-rw-r--r--src/interp.c11
-rw-r--r--tests/eq.lisp4
-rw-r--r--tests/list.lisp30
-rw-r--r--tests/test.lisp3
-rw-r--r--tests/type.lisp32
7 files changed, 191 insertions, 2 deletions
diff --git a/src/builtins.c b/src/builtins.c
index 68330d8..9ab38d5 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -6,6 +6,108 @@
#include <float.h>
#include <math.h>
+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)));
+}
+
+SExpRef builtin_consp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "cons?: arg num error.\n");
+ return new_boolean(interp, REF(CAR(args))->type == kPairSExp);
+}
+
+SExpRef builtin_atomp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "atom?: arg num error.\n");
+ bool ret = false;
+ SExpType type = REF(CAR(args))->type;
+ if (type == kRealSExp) ret = true;
+ if (type == kIntegerSExp) ret = true;
+ if (type == kStringSExp) ret = true;
+ if (type == kSymbolSExp) ret = true;
+ if (type == kCharSExp) ret = true;
+ if (type == kBooleanSExp) ret = true;
+ if (type == kNilSExp) ret = true;
+ if (type == kFuncSExp) ret = true;
+ if (type == kUserFuncSExp) ret = true;
+ return new_boolean(interp, ret);
+}
+SExpRef builtin_nullp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "null?: arg num error.\n");
+ return new_boolean(interp, REF(CAR(args))->type == kNilSExp);
+}
+
+SExpRef builtin_numberp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "number?: arg num error.\n");
+ return new_boolean(interp, REF(CAR(args))->type == kIntegerSExp
+ || REF(CAR(args))->type == kRealSExp);
+}
+
+SExpRef builtin_integerp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "integer?: arg num error.\n");
+ return new_boolean(interp, REF(CAR(args))->type == kNilSExp);
+}
+
+SExpRef builtin_floatp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "float?: arg num error.\n");
+ return new_boolean(interp, REF(CAR(args))->type == kRealSExp);
+}
+
+SExpRef builtin_nreverse(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "number?: arg num error.\n");
+ SExpRef lst = CAR(args);
+ if (lisp_check_list(interp, lst)) {
+ return lisp_nreverse(interp, lst);
+ }
+ return new_error(interp, "nreverse: type error.\n");
+}
+
+SExpRef builtin_reverse(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "number?: arg num error.\n");
+ SExpRef lst = CAR(args);
+ if (lisp_check_list(interp, lst)) {
+ return lisp_reverse(interp, lst);
+ }
+ return new_error(interp, "nreverse: type error.\n");
+}
+
+SExpRef builtin_last(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) {
+ return new_error(interp, "last: arg num error.\n");
+ }
+ SExpRef lst = CAR(args);
+ if (NILP(lst)) {
+ return new_error(interp, "last: empty list.\n");
+ }
+ if (!lisp_check_list(interp, lst)) {
+ return new_error(interp, "last: type error.\n");
+ }
+ for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+ if (NILP(CDR(i))) {
+ return CAR(i);
+ }
+ }
+ return NIL;
+}
+
+static bool equal_impl(Interp *interp, SExpRef x, SExpRef y);
+
+SExpRef builtin_memberp(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) {
+ return new_error(interp, "member?: arg num error.\n");
+ }
+ SExpRef elem = CAR(args), lst = CADR(args);
+ if (!lisp_check_list(interp, lst)) {
+ return new_error(interp, "member?: type error.\n");
+ }
+ for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
+ SExpRef x = CAR(i);
+ if (equal_impl(interp, x, elem)) {
+ return interp->t;
+ }
+ }
+ return interp->f;
+}
+
SExpRef builtin_map(Interp *interp, SExpRef args) {
if (LENGTH(args) != 2) return new_error(interp, "map: wrong arg num.\n");
SExpRef fn = CAR(args), lst = CADR(args);
diff --git a/src/builtins.h b/src/builtins.h
index e7712d4..bf97086 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,17 @@
#include "interp.h"
+SExpRef builtin_listp(Interp *interp, SExpRef args);
+SExpRef builtin_consp(Interp *interp, SExpRef args);
+SExpRef builtin_atomp(Interp *interp, SExpRef args);
+SExpRef builtin_nullp(Interp *interp, SExpRef args);
+SExpRef builtin_memberp(Interp *interp, SExpRef args);
+SExpRef builtin_numberp(Interp *interp, SExpRef args);
+SExpRef builtin_integerp(Interp *interp, SExpRef args);
+SExpRef builtin_floatp(Interp *interp, SExpRef args);
+SExpRef builtin_nreverse(Interp *interp, SExpRef args);
+SExpRef builtin_reverse(Interp *interp, SExpRef args);
+SExpRef builtin_last(Interp *interp, SExpRef args);
SExpRef builtin_map(Interp *interp, SExpRef args);
SExpRef builtin_filter(Interp *interp, SExpRef args);
SExpRef builtin_remove(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index 44800c8..6f2bb8a 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -157,6 +157,17 @@ void Interp_init(Interp *self) {
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, "list?", builtin_listp);
+ Interp_add_userfunc(self, "cons?", builtin_consp);
+ Interp_add_userfunc(self, "atom?", builtin_atomp);
+ Interp_add_userfunc(self, "null?", builtin_nullp);
+ Interp_add_userfunc(self, "member?", builtin_memberp);
+ Interp_add_userfunc(self, "number?", builtin_numberp);
+ Interp_add_userfunc(self, "integer?", builtin_integerp);
+ Interp_add_userfunc(self, "float?", builtin_floatp);
+ 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, "_gcstat", builtin_gcstat);
Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc);
diff --git a/tests/eq.lisp b/tests/eq.lisp
index a7758bb..27e9aee 100644
--- a/tests/eq.lisp
+++ b/tests/eq.lisp
@@ -1,5 +1,5 @@
-(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))
diff --git a/tests/list.lisp b/tests/list.lisp
index e154458..07fd08c 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -25,3 +25,33 @@
(assert (equal? (list 1 2 3 4)
(map (lambda (x) (+ 1 x)) (list 0 1 2 3))))
+
+(assert-error (reverse 1))
+(assert-error (reverse (cons 1 2)))
+
+(assert (equal? (list 1 2 3) (reverse (list 3 2 1))))
+(assert (equal? (list 1 2) (reverse (list 2 1))))
+(assert (equal? (list 1) (reverse (list 1))))
+(assert (equal? nil (reverse nil)))
+
+(assert-error (nreverse 1))
+(assert-error (nreverse (cons 1 2)))
+
+(assert (equal? (list 1 2 3) (nreverse (list 3 2 1))))
+(assert (equal? (list 1 2) (nreverse (list 2 1))))
+(assert (equal? (list 1) (nreverse (list 1))))
+(assert (equal? nil (nreverse nil)))
+
+(assert-error (last '()))
+(assert-error (last 1))
+
+(assert (equal? 3 (last (list 1 2 3))))
+(assert (equal? 3 (last (list 2 3))))
+(assert (equal? 3 (last (list 3))))
+
+(assert (member? nil (list 1 2 nil)))
+(assert (member? 1 (list 1 2 nil)))
+(assert (member? 2 (list 1 2 nil)))
+(assert (not (member? nil (list 1 2))))
+(assert (not (member? 3 (list 1 2))))
+
diff --git a/tests/test.lisp b/tests/test.lisp
index 59f91fb..8969a5b 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -19,6 +19,7 @@
(test-module let-binding)
(test-module string)
(test-module list)
+(test-module type)
(princ "\n\nTest with intensive GC:\n\n")
(_alwaysgc #t)
@@ -36,5 +37,7 @@
(test-module macro)
(test-module let-binding)
(test-module string)
+(test-module list)
+(test-module type)
(exit)
diff --git a/tests/type.lisp b/tests/type.lisp
new file mode 100644
index 0000000..d22913f
--- /dev/null
+++ b/tests/type.lisp
@@ -0,0 +1,32 @@
+(assert (list? (list 12 2 3)))
+(assert (list? nil))
+(assert (list? (list 1)))
+(assert (not (list? 1)))
+(assert (not (list? (cons 1 2))))
+(assert (not (list? '(1 2 . 3))))
+
+(assert (cons? (list 1 2 3)))
+(assert (cons? '(1 2 . 3)))
+(assert (not (cons? '())))
+
+(assert (null? nil))
+(assert (null? '()))
+(assert (not (null? #f)))
+
+(assert (number? 1))
+(assert (number? 1))
+(assert (number? 1.1))
+(assert (float? 1.1))
+(assert (float? (float 1)))
+(assert (not (float? 1)))
+(assert (not (integer? 1.1)))
+
+(assert (atom? nil))
+(assert (atom? #t))
+(assert (atom? 'a))
+(assert (atom? 1))
+(assert (atom? 1.1))
+(assert (atom? #\c))
+(assert (atom? "hello"))
+(assert (not (atom? (cons 1 2))))
+(assert (lambda () 1))
generated by cgit v1.0 at 2025-12-29 16:10:16 +0000