add builtin funcs

7 files changed, 230 insertions, 6 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 591dc97..e39dfa4 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -7,6 +7,14 @@
 #include <float.h>
 #include <math.h>
 
+SExpRef builtin_functionp(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) {
+        return new_error(interp, "function?: args num error.\n");
+    }
+    return new_boolean(interp, VALTYPE(CAR(args)) == kFuncSExp
+                                || VALTYPE(CAR(args)) == kUserFuncSExp);
+}
+
 SExpRef builtin_setnth(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 3) {
         return new_error(interp, "set-nth: args num error.\n");
@@ -114,11 +122,11 @@ SExpRef builtin_nconc(Interp *interp, SExpRef args) {
 
 SExpRef builtin_logand(Interp *interp, SExpRef args) {
     if (LENGTH(args) < 1) {
-        return new_error(interp, "nconc: args num error.\n");
+        return new_error(interp, "logand: args num error.\n");
     }
     for (SExpRef l = args; !NILP(l); l = CDR(l)) {
         if (VALTYPE(CAR(l)) != kIntegerSExp) {
-            return new_error(interp, "append: type error.\n");
+            return new_error(interp, "logand: type error.\n");
         }
     }
     uint64_t res = 0xffffffffffffffffULL;
@@ -128,6 +136,83 @@ SExpRef builtin_logand(Interp *interp, SExpRef args) {
     return new_integer(interp, res);
 }
 
+SExpRef builtin_logior(Interp *interp, SExpRef args) {
+    if (LENGTH(args) < 1) {
+        return new_error(interp, "logior: args num error.\n");
+    }
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        if (VALTYPE(CAR(l)) != kIntegerSExp) {
+            return new_error(interp, "logior: type error.\n");
+        }
+    }
+    uint64_t res = 0;
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        res = res | (REF(CAR(l))->integer);
+    }
+    return new_integer(interp, res);
+}
+
+SExpRef builtin_logxor(Interp *interp, SExpRef args) {
+    if (LENGTH(args) < 1) {
+        return new_error(interp, "logxor: args num error.\n");
+    }
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        if (VALTYPE(CAR(l)) != kIntegerSExp) {
+            return new_error(interp, "logxor: type error.\n");
+        }
+    }
+    uint64_t res = 0;
+    for (SExpRef l = args; !NILP(l); l = CDR(l)) {
+        res = res ^ (REF(CAR(l))->integer);
+    }
+    return new_integer(interp, res);
+}
+
+SExpRef builtin_lognot(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) {
+        return new_error(interp, "lognot: args num error.\n");
+    }
+    SExpRef x = CAR(args);
+    if (VALTYPE(x) != kIntegerSExp) {
+        return new_error(interp, "lognot: type error.\n");
+    }
+    uint64_t res = 0;
+    res = ~(REF(x)->integer);
+    return new_integer(interp, res);
+}
+
+SExpRef builtin_lsh(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) {
+        return new_error(interp, "lsh: args num error.\n");
+    }
+    SExpRef x = CAR(args), n = CADR(args);
+    if (VALTYPE(x) != kIntegerSExp) {
+        return new_error(interp, "lsh: type error.\n");
+    }
+    if (VALTYPE(n) != kIntegerSExp) {
+        return new_error(interp, "lsh: type error.\n");
+    }
+    uint64_t res = 0;
+    res = (REF(x)->integer) << (REF(n)->integer);
+    return new_integer(interp, res);
+}
+
+SExpRef builtin_ash(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) {
+        return new_error(interp, "ash: args num error.\n");
+    }
+    SExpRef x = CAR(args), n = CADR(args);
+    if (VALTYPE(x) != kIntegerSExp) {
+        return new_error(interp, "ash: type error.\n");
+    }
+    if (VALTYPE(n) != kIntegerSExp) {
+        return new_error(interp, "ash: type error.\n");
+    }
+    int64_t res = 0;
+    res = (REF(x)->integer) >> (REF(n)->integer);
+    return new_integer(interp, res);
+}
+
 SExpRef builtin_charp(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 1) return new_error(interp, "char?: arg num error.\n");
     return new_boolean(interp, VALTYPE(CAR(args)) == kCharSExp);
@@ -263,7 +348,7 @@ SExpRef builtin_numberp(Interp *interp, SExpRef args) {
 
 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);
+    return new_boolean(interp, REF(CAR(args))->type == kIntegerSExp);
 }
 
 SExpRef builtin_floatp(Interp *interp, SExpRef args) {
diff --git a/src/builtins.h b/src/builtins.h
index 0d3c5cc..1a8e927 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,12 @@
 
 #include "interp.h"
 
+SExpRef builtin_logior(Interp *interp, SExpRef args);
+SExpRef builtin_logxor(Interp *interp, SExpRef args);
+SExpRef builtin_lognot(Interp *interp, SExpRef args);
+SExpRef builtin_lsh(Interp *interp, SExpRef args);
+SExpRef builtin_ash(Interp *interp, SExpRef args);
+SExpRef builtin_functionp(Interp *interp, SExpRef args);
 SExpRef builtin_setnth(Interp *interp, SExpRef args);
 SExpRef builtin_setnthcdr(Interp *interp, SExpRef args);
 SExpRef builtin_foldl(Interp *interp, SExpRef args);
diff --git a/src/interp.c b/src/interp.c
index e6e9f2a..8b5c15f 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -123,6 +123,7 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "assert-error", primitive_assert_error);
     Interp_add_primitive(self, "load", primitive_load);
 
+    Interp_add_userfunc(self, "function?", builtin_functionp);
     Interp_add_userfunc(self, "map", builtin_map);
     Interp_add_userfunc(self, "filter", builtin_filter);
     Interp_add_userfunc(self, "remove", builtin_remove);
@@ -221,6 +222,11 @@ void Interp_init(Interp *self) {
     Interp_add_userfunc(self, "append", builtin_append);
     Interp_add_userfunc(self, "nconc", builtin_nconc);
     Interp_add_userfunc(self, "logand", builtin_logand);
+    Interp_add_userfunc(self, "logior", builtin_logior);
+    Interp_add_userfunc(self, "logxor", builtin_logxor);
+    Interp_add_userfunc(self, "lognot", builtin_lognot);
+    Interp_add_userfunc(self, "lsh", builtin_lsh);
+    Interp_add_userfunc(self, "ash", builtin_ash);
 
     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 e827718..679b418 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\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";
+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 take (n lst)\n  (unless (integer? n)\n    (error \"take: type error.\"))\n  (unless (list? lst)\n    (error \"take: type error.\"))\n  (let ((i 0)\n        (newlst nil))\n    (while (and (< i n)\n                (not (null? lst)))\n      (setq newlst (cons (car lst) newlst))\n      (setq lst (cdr lst))\n      (incq i))\n    (nreverse newlst)))\n\n(defun drop (n lst)\n  (unless (integer? n)\n    (error \"drop type error.\"))\n  (unless (list? lst)\n    (error \"drop: type error.\"))\n  (let ((i 0))\n    (while (and (< i n)\n                (not (null? lst)))\n      (setq lst (cdr lst))\n      (incq i))\n    lst))\n\n(defun take-while (pred lst)\n  (unless (function? pred)\n    (error \"take-while: type error.\"))\n  (unless (list? lst)\n    (error \"take-while: type error.\"))\n  (let ((newlst nil))\n    (while (and (not (null? lst))\n                (funcall pred (car lst)))\n      (setq newlst (cons (car lst) newlst))\n      (setq lst (cdr lst)))\n    (nreverse newlst)))\n\n(defun drop-while (pred lst)\n  (unless (function? pred)\n    (error \"drop-while: type error.\"))\n  (unless (list? lst)\n    (error \"drop-while: type error.\"))\n  (while (and (not (null? lst))\n              (funcall pred (car lst)))\n    (setq lst (cdr lst)))\n  lst)\n\n(defun sublist (start end lst)\n  (unless (integer? start)\n    (error \"sublist: type error.\"))\n  (unless (integer? end)\n    (error \"sublist: type error.\"))\n  (unless (< start end)\n    (error \"sublist: start must less than end.\"))\n  (unless (list? lst)\n    (error \"sublist: type error.\"))\n  (drop start (take end lst)))\n\n(defun find (x lst)\n  (unless (list? lst)\n    (error \"find: type error.\"))\n  (while (not (null? lst))\n    (when (equal? x (car lst))\n      (return lst))\n    (setq lst (cdr lst)))\n  nil)\n\n(defun contains? (x lst)\n  (unless (list? lst)\n    (error \"contains?: type error.\"))\n  (while (not (null? lst))\n    (when (equal? x (car lst))\n      (return #t))\n    (setq lst (cdr lst)))\n  #f)\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\n(defun caaaar (x) (car (caaar x)))\n(defun cadaar (x) (car (cdaar x)))\n(defun cddaar (x) (cdr (cdaar x)))\n(defun cdaaar (x) (cdr (caaar x)))\n(defun caadar (x) (car (cadar x)))\n(defun caddar (x) (car (cddar x)))\n(defun cdddar (x) (cdr (cddar x)))\n(defun cdadar (x) (cdr (cadar x)))\n(defun caaadr (x) (car (caadr x)))\n(defun cadadr (x) (car (cdadr x)))\n(defun cddadr (x) (cdr (cdadr x)))\n(defun cdaadr (x) (cdr (caadr x)))\n(defun caaddr (x) (car (caddr x)))\n(defun cadddr (x) (car (cdddr x)))\n(defun cddddr (x) (cdr (cdddr x)))\n(defun cdaddr (x) (cdr (caddr x)))\n";
 
 
diff --git a/src/prelude.lisp b/src/prelude.lisp
index b102e1b..a1be068 100644
--- a/src/prelude.lisp
+++ b/src/prelude.lisp
@@ -23,6 +23,83 @@
      nil
      (progn ,@body)))
 
+(defun take (n lst)
+  (unless (integer? n)
+    (error "take: type error."))
+  (unless (list? lst)
+    (error "take: type error."))
+  (let ((i 0)
+        (newlst nil))
+    (while (and (< i n)
+                (not (null? lst)))
+      (setq newlst (cons (car lst) newlst))
+      (setq lst (cdr lst))
+      (incq i))
+    (nreverse newlst)))
+
+(defun drop (n lst)
+  (unless (integer? n)
+    (error "drop type error."))
+  (unless (list? lst)
+    (error "drop: type error."))
+  (let ((i 0))
+    (while (and (< i n)
+                (not (null? lst)))
+      (setq lst (cdr lst))
+      (incq i))
+    lst))
+
+(defun take-while (pred lst)
+  (unless (function? pred)
+    (error "take-while: type error."))
+  (unless (list? lst)
+    (error "take-while: type error."))
+  (let ((newlst nil))
+    (while (and (not (null? lst))
+                (funcall pred (car lst)))
+      (setq newlst (cons (car lst) newlst))
+      (setq lst (cdr lst)))
+    (nreverse newlst)))
+
+(defun drop-while (pred lst)
+  (unless (function? pred)
+    (error "drop-while: type error."))
+  (unless (list? lst)
+    (error "drop-while: type error."))
+  (while (and (not (null? lst))
+              (funcall pred (car lst)))
+    (setq lst (cdr lst)))
+  lst)
+
+(defun sublist (start end lst)
+  (unless (integer? start)
+    (error "sublist: type error."))
+  (unless (integer? end)
+    (error "sublist: type error."))
+  (unless (< start end)
+    (error "sublist: start must less than end."))
+  (unless (list? lst)
+    (error "sublist: type error."))
+  (drop start (take end lst)))
+
+(defun find (x lst)
+  (unless (list? lst)
+    (error "find: type error."))
+  (while (not (null? lst))
+    (when (equal? x (car lst))
+      (return lst))
+    (setq lst (cdr lst)))
+  nil)
+
+(defun contains? (x lst)
+  (unless (list? lst)
+    (error "contains?: type error."))
+  (while (not (null? lst))
+    (when (equal? x (car lst))
+      (return #t))
+    (setq lst (cdr lst)))
+  #f)
+
 (defun caar (x) (car (car x)))
 (defun cadr (x) (car (cdr x)))
 (defun cddr (x) (cdr (cdr x)))
@@ -36,3 +113,20 @@
 (defun caddr (x) (car (cddr x)))
 (defun cdddr (x) (cdr (cddr x)))
 (defun cdadr (x) (cdr (cadr x)))
+
+(defun caaaar (x) (car (caaar x)))
+(defun cadaar (x) (car (cdaar x)))
+(defun cddaar (x) (cdr (cdaar x)))
+(defun cdaaar (x) (cdr (caaar x)))
+(defun caadar (x) (car (cadar x)))
+(defun caddar (x) (car (cddar x)))
+(defun cdddar (x) (cdr (cddar x)))
+(defun cdadar (x) (cdr (cadar x)))
+(defun caaadr (x) (car (caadr x)))
+(defun cadadr (x) (car (cdadr x)))
+(defun cddadr (x) (cdr (cdadr x)))
+(defun cdaadr (x) (cdr (caadr x)))
+(defun caaddr (x) (car (caddr x)))
+(defun cadddr (x) (car (cdddr x)))
+(defun cddddr (x) (cdr (cdddr x)))
+(defun cdaddr (x) (cdr (caddr x)))
diff --git a/tests/bitwise.lisp b/tests/bitwise.lisp
index 7371058..4c1ad73 100644
--- a/tests/bitwise.lisp
+++ b/tests/bitwise.lisp
@@ -1,2 +1,18 @@
 (assert (= 16 (logand 31 16)))
 (assert (= 24 (logand 31 25 24)))
+
+(assert (= 25 (logior 24 16 1)))
+(assert (= 25 (logior 8 16 1)))
+
+(assert (= 678 (logxor 123 456 789)))
+
+(assert (= -124 (lognot 123)))
+
+(assert (= 246 (lsh 123 1)))
+
+(assert (= 30 (ash 123 2)))
+(assert (= -31 (ash -123 2)))
+
+(assert (= 30 (ash 123 2)))
+(assert (= -31 (ash -123 2)))
+
diff --git a/tests/list.lisp b/tests/list.lisp
index 7826afb..2b7228e 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -55,8 +55,6 @@
 (assert (not (member? nil (list 1 2))))
 (assert (not (member? 3 (list 1 2))))
 
-    ;;Interp_add_userfunc(self, "nconc", builtin_reverse);
-
 (let ((lst '(1 2 999 4)))
   (set-nth 2 lst 3)
   (assert (equal? '(1 2 3 4) lst)))
@@ -78,3 +76,22 @@
 (let ((a '(1 2 3))
       (b '(4 5 6)))
   (assert (equal? '(1 2 3 4 5 6) (nconc a b))))
+
+(assert (equal? '(1 2 3) (take 3 '(1 2 3 4 5))))
+(assert (equal? '(4 5) (drop 3 '(1 2 3 4 5))))
+
+(assert (equal? '(1 2 3)
+                (take-while (lambda (x) (<= x 3))
+                            '(1 2 3 4 5))))
+
+(assert (equal? '(4 5)
+                (drop-while (lambda (x) (<= x 3))
+                            '(1 2 3 4 5))))
+
+(assert (equal? '(1 2) (sublist 1 3 '(0 1 2 3 4))))
+
+(assert (equal? '(3 4 5) (find 3 '(1 2 3 4 5))))
+(assert (equal? nil (find 99 '(1 2 3 4))))
+
+(assert (contains? 3 '(1 2 3 4)))
+(assert (not (contains? 3 '(1 2 4 5))))