git » jacl.git » commit 3456f2b

diff --git a/boot.lisp b/boot.lisp
index 4118cab..018de5c 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -57,6 +57,11 @@
 (defun eq (x y)
   (jacl:%js "~{} === ~{} ? true : null" x y))
 
+;; TODO Real EQL
+(%export 'eql)
+(defun eql (x y)
+  (eq x y))
+
 (%export 'null)
 (defun null (x) (eq x nil))
 
@@ -154,6 +159,23 @@
   (when (not (numberp x)) (%type-error "number"))
   (jacl:%js "~{}-1" x))
 
+(defun %aref (arr i)
+  (jacl:%js "~{}[~{}]" arr i))
+
+;(%export '+)
+;(defun + (&rest nums)
+;  (declare (jacl:rest-array))
+;  (let ((len (\. nums |length|))
+;        (sum 0)
+;        (i 0))
+;    (tagbody
+;     start
+;     (when (< i len)
+;       (setq sum (jacl:%js "~{}+~{}" sum (%aref nums i)))
+;       (setq i (1+ i))
+;       (go start)))
+;    sum))
+
 (%export 'gensym)
 (defun gensym (&optional (x nil x?))
   (cond ((and x? (stringp x))
@@ -242,15 +264,22 @@
 (%export 'zerop)
 (defun zerop (x)
   (when (not (numberp x)) (%type-error "number"))
-  (jacl:%js "~{}===0?true:null" x))
+  (eql x 0))
 
 (defun %> (x y)
   (when (not (numberp x)) (%type-error "number"))
   (when (not (numberp y)) (%type-error "number"))
   (jacl:%js "~{}>~{}?true:null" x y))
 
+(defun %< (x y)
+  (when (not (numberp x)) (%type-error "number"))
+  (when (not (numberp y)) (%type-error "number"))
+  (jacl:%js "~{}<~{}?true:null" x y))
+
 (%export '>)
 (defun > (number &rest more-numbers)
+  (when (not (numberp number))
+    (%type-error "number"))
   (let ((ret t))
     (tagbody
      start
@@ -260,9 +289,34 @@
        (go end))
      (setq number (car more-numbers)
            more-numbers (cdr more-numbers))
+     (when (not (numberp number))
+       (%type-error "number"))
+     (go start)
+     end)
+    ret))
+
+(%export '<)
+(defun < (num &rest nums)
+  (declare (jacl:rest-array))
+  (let ((len (jacl:%dot nums |length|))
+        (ret t)
+        (i 0))
+    (tagbody
+     start
+     (when (not (numberp num))
+       (%type-error "number"))
+     (when (eql i len) 
+       (go end))
+     (let ((x (%aref nums i)))
+       (when (not (%< num x)) 
+         (setq ret nil)
+         (go end))
+       (setq num x
+             i (1+ i)))
      (go start)
      end)
     ret))
+
 ;;(defun %designated-string (x)
 ;;  (cond ((stringp x) x)
 ;;        ((symbolp x)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 842f191..f9f0fc7 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -16,6 +16,9 @@
 (defun assert= (x y &optional (label ""))
   (\. *is* (|strictEqual| x y (\. label (|toString|)))))
 
+(defmacro assert-throws (&rest body)
+  `(\. *is* (|throws| (lambda () ,@body))))
+
 (defun read1 (s)
   (let ((s (\. s (|toString|))))
     (\. (%new @|Reader| (%new @|StringStream| s)) (|read|))))
@@ -48,11 +51,25 @@
 (deftest "Numeric functions"
   (assert= (zerop 1) nil)
   (assert= (zerop 0) t)
+
   (assert= (1+ 2) 3)
   (assert= (1- 10) 9)
+
+  (assert-throws (>))
+  (assert-throws (> "foo"))
+  (assert-throws (> "foo" "bar"))
+  (assert-throws (> "foo" "bar" "baz"))
   (assert= (> 3 2 1) t)
   (assert= (> 1) t)
-  (assert= (> 1 3) nil))
+  (assert= (> 1 3) nil)
+
+  (assert-throws (<))
+  (assert-throws (< "foo"))
+  (assert-throws (< "foo" "bar"))
+  (assert-throws (< "foo" "bar" "baz"))
+  (assert= (< 1) t)
+  (assert= (< 5 10 421) t)
+  (assert= (< 41 2) nil))
 
 (\. @|QUnit| (|module| @"Control operators"))
 
@@ -68,11 +85,19 @@
     (assert= x 0)
     (assert= y 10)))
 
+(deftest "GO in TAGBODY prelude"
+  (let ((x 0))
+    (tagbody
+     (go end)
+     start                              ;skipped
+     (setq x (1+ x))                    ;skipped
+     end)
+    (assert= x 0)))
+
 (defun countdown (from)
   (tagbody
    start
    (when (> from 0)
-     ;; (log @"from=" from)
      (setq from (1- from))
      (go start))))