aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/builtins.c104
-rw-r--r--src/builtins.h18
-rw-r--r--src/interp.c13
-rw-r--r--tests/string.lisp29
-rw-r--r--tests/tailcall-big.lisp24
-rw-r--r--tests/tailcall.lisp2
-rw-r--r--tests/test.lisp5
7 files changed, 167 insertions, 28 deletions
diff --git a/src/builtins.c b/src/builtins.c
index fe14b8f..48cb4f0 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -6,6 +6,110 @@
#include <float.h>
#include <math.h>
+SExpRef builtin_string(Interp *interp, SExpRef args) {
+ for (SExpRef i = args; !NILP(i); i = CDR(i)) {
+ SExpRef x = CAR(i);
+ if (VALTYPE(x) != kIntegerSExp && VALTYPE(x) != kCharSExp) {
+ return new_error(interp, "string: type error.\n");
+ }
+ }
+ str_builder_t sb;
+ init_str_builder(&sb);
+ for (SExpRef i = args; !NILP(i); i = CDR(i)) {
+ SExpRef x = CAR(i);
+ if (VALTYPE(x) == kIntegerSExp) {
+ str_builder_append_char(&sb, REF(x)->integer);
+ } else {
+ str_builder_append_char(&sb, REF(x)->character);
+ }
+ }
+ str_builder_append_char(&sb, '\0');
+ SExpRef ret = new_string(interp, sb.buf);
+ free(sb.buf);
+ return ret;
+}
+
+SExpRef builtin_string_eq(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string=: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string=: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) == 0);
+}
+
+SExpRef builtin_string_gt(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string>: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string>: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) > 0);
+
+}
+
+SExpRef builtin_string_lt(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string<: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string<: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) < 0);
+}
+
+SExpRef builtin_string_ge(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string>=: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string>=: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) >= 0);
+}
+
+SExpRef builtin_string_le(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string<=: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string<=: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) <= 0);
+}
+
+SExpRef builtin_string_neq(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "string/=: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kStringSExp) {
+ return new_error(interp, "string/=: type error.\n");
+ }
+ return new_boolean(interp, strcmp(REF(s1)->str, REF(s2)->str) != 0);
+}
+
+SExpRef builtin_split_string(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 2) return new_error(interp, "split-string: arg num error.\n");
+ SExpRef s1 = CAR(args), s2 = CADR(args);
+ if (VALTYPE(s1) != kStringSExp || VALTYPE(s2) != kCharSExp) {
+ return new_error(interp, "split-string: type error.\n");
+ }
+ char **ss;
+ ss = str_split((char*)REF(s1)->str, REF(s2)->character);
+ SExpRef lst = NIL;
+ for (char **i = ss; *i != NULL; i++) {
+ lst = CONS(new_string(interp, *i), lst);
+ }
+ destroy_str_list(ss);
+ return lisp_nreverse(interp, lst);
+}
+
+SExpRef builtin_strip_string(Interp *interp, SExpRef args) {
+ if (LENGTH(args) != 1) return new_error(interp, "strip-string: arg num error.\n");
+ SExpRef s = CAR(args);
+ if (VALTYPE(s) != kStringSExp) return new_error(interp, "strip-string: type error.\n");
+ char *news = str_strip((char*)REF(s)->str);
+ SExpRef ret = new_string(interp, news);
+ free(news);
+ return ret;
+}
+
SExpRef builtin_alwaysgc(Interp *interp, SExpRef args) {
if (LENGTH(args) != 1) return new_error(interp, "_alwaysgc: arg num error.\n");
SExpRef arg = CAR(args);
diff --git a/src/builtins.h b/src/builtins.h
index eb95f2d..608df98 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,24 @@
#include "interp.h"
+// - char=
+// - char>
+// - char<
+// - char>=
+// - char<=
+// - char/=
+// - ord
+// - chr
+
+SExpRef builtin_string(Interp *interp, SExpRef args);
+SExpRef builtin_string_eq(Interp *interp, SExpRef args);
+SExpRef builtin_string_gt(Interp *interp, SExpRef args);
+SExpRef builtin_string_lt(Interp *interp, SExpRef args);
+SExpRef builtin_string_ge(Interp *interp, SExpRef args);
+SExpRef builtin_string_le(Interp *interp, SExpRef args);
+SExpRef builtin_string_neq(Interp *interp, SExpRef args);
+SExpRef builtin_split_string(Interp *interp, SExpRef args);
+SExpRef builtin_strip_string(Interp *interp, SExpRef args);
SExpRef builtin_symbol2string(Interp *interp, SExpRef args);
SExpRef builtin_intern(Interp *interp, SExpRef args);
SExpRef builtin_gensym(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index 7d89641..242b821 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -106,6 +106,15 @@ void Interp_init(Interp *self) {
Interp_add_userfunc(self, "=", builtin_num_equal);
Interp_add_userfunc(self, "/=", builtin_num_neq);
Interp_add_userfunc(self, "concat", builtin_concat);
+ Interp_add_userfunc(self, "string", builtin_string);
+ Interp_add_userfunc(self, "string=", builtin_string_eq);
+ Interp_add_userfunc(self, "string>=", builtin_string_ge);
+ Interp_add_userfunc(self, "string<=", builtin_string_le);
+ Interp_add_userfunc(self, "string>", builtin_string_gt);
+ Interp_add_userfunc(self, "string<", builtin_string_lt);
+ Interp_add_userfunc(self, "string/=", builtin_string_neq);
+ Interp_add_userfunc(self, "split-string", builtin_split_string);
+ Interp_add_userfunc(self, "strip-string", builtin_strip_string);
Interp_add_userfunc(self, "print", builtin_print);
Interp_add_userfunc(self, "format", builtin_format);
Interp_add_userfunc(self, "truncate", builtin_truncate);
@@ -330,11 +339,11 @@ void Interp_gc(Interp *interp, SExpRef tmproot) {
// enlarge heap
heapsize = SExpVector_len(&interp->objs);
int usedsize = heapsize - IntVector_len(&interp->empty_space);
- if (heapsize < usedsize * 2) {
+ if (heapsize < usedsize * 4) {
SExp sexp;
sexp.marked = false;
sexp.type = kEmptySExp;
- while (SExpVector_len(&interp->objs) < usedsize * 2) {
+ while (SExpVector_len(&interp->objs) < usedsize * 4) {
SExpVector_push_back(&interp->objs, sexp);
IntVector_push_back(&interp->empty_space, SExpVector_len(&interp->objs) - 1);
}
diff --git a/tests/string.lisp b/tests/string.lisp
new file mode 100644
index 0000000..a55e558
--- /dev/null
+++ b/tests/string.lisp
@@ -0,0 +1,29 @@
+(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)))
+
+(defvar s1 "a1s")
+(defvar s2 "a2s")
+
+(assert (string= s1 s1))
+(assert (string>= s1 s1))
+(assert (string<= s1 s1))
+(assert (string> s2 s1))
+(assert (string>= s2 s1))
+(assert (string< s1 s2))
+(assert (string<= s1 s2))
+(assert (string/= s1 s2))
+
+(assert (not (string/= s1 s1)))
+(assert (not (string< s1 s1)))
+(assert (not (string> s1 s1)))
+(assert (not (string<= s2 s1)))
+(assert (not (string< s2 s1)))
+(assert (not (string>= s1 s2)))
+(assert (not (string> s1 s2)))
+
+(assert (string= "abc" (strip-string "\n\tabc \t\n")))
+(assert (equal ("a" "b" "c") (split-string "a,b,c" #\,)))
+
diff --git a/tests/tailcall-big.lisp b/tests/tailcall-big.lisp
deleted file mode 100644
index ebf64c6..0000000
--- a/tests/tailcall-big.lisp
+++ /dev/null
@@ -1,24 +0,0 @@
-(assert (is-even 10000))
-(assert (cnt-down 10000))
-
-;; can pass without stack overflow,
-;; but comment out for too time-consuming
-;; (assert (is-even 1000000))
-;; (assert (cnt-down 1000000))
-
-(let ((my-evenp
- (lambda (x)
- (if (= x 0)
- #t
- (funcall my-oddp (- x 1)))))
- (my-oddp
- (lambda (x)
- (if (= x 0)
- #f
- (funcall my-evenp (- x 1))))))
- (assert (funcall my-evenp 10000))
- (assert (funcall my-oddp 10009))
- (assert (not (funcall my-evenp 10009)))
- (assert (not (funcall my-oddp 10000))))
-
-
diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp
index 1aa5e38..1b39fb0 100644
--- a/tests/tailcall.lisp
+++ b/tests/tailcall.lisp
@@ -6,6 +6,7 @@
(defun is-odd (x)
(is-even (- x 1)))
+(assert (is-even 100))
(assert (is-even 10))
(assert (is-even 0))
(assert (is-odd 1))
@@ -17,3 +18,4 @@
(progn
(cnt-down (- x 1)))))
+(cnt-down 100)
diff --git a/tests/test.lisp b/tests/test.lisp
index 614fcec..a303ed3 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -12,12 +12,12 @@
(test-module error)
(test-module logic)
(test-module tailcall)
-(test-module tailcall-big)
(test-module control-flow)
(test-module lambda)
(test-module comment)
(test-module macro)
(test-module let-binding)
+(test-module string)
(princ "\n\nTest with intensive GC:\n\n")
(_alwaysgc #t)
@@ -26,13 +26,14 @@
(test-module symbol)
(test-module eq)
(test-module arithmetic)
-(test-module tailcall)
(test-module error)
(test-module logic)
+(test-module tailcall)
(test-module control-flow)
(test-module lambda)
(test-module comment)
(test-module macro)
(test-module let-binding)
+(test-module string)
(exit)
generated by cgit v1.0 at 2025-12-29 14:03:35 +0000