From 44642d96eaef834b4bb846d27347ee681f9f5f7b Mon Sep 17 00:00:00 2001 From: Mistivia Date: Tue, 24 Jun 2025 22:32:57 +0800 Subject: add more list funcs --- src/builtins.c | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/builtins.h | 11 ++++++ src/interp.c | 11 ++++++ tests/eq.lisp | 4 +-- tests/list.lisp | 30 +++++++++++++++++ tests/test.lisp | 3 ++ tests/type.lisp | 32 ++++++++++++++++++ 7 files changed, 191 insertions(+), 2 deletions(-) create mode 100644 tests/type.lisp 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 #include +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)) -- cgit v1.0