add char funcs

6 files changed, 138 insertions, 2 deletions

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);