aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/builtins.c78
-rw-r--r--src/builtins.h14
-rw-r--r--src/interp.c12
-rw-r--r--src/prelude.c2
-rw-r--r--src/prelude.lisp6
-rw-r--r--src/primitives.c2
6 files changed, 96 insertions, 18 deletions
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 <float.h>
#include <math.h>
+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));
generated by cgit v1.0 at 2025-12-29 19:19:38 +0000