git » jacl.git » commit 9dae452

diff --git a/boot.lisp b/boot.lisp
index 4be5d51..0e35f13 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -49,6 +49,10 @@
 (defun %export (symbol &optional (package *package*))
   (\. package (|exportSymbol| (\. symbol |name|))))
 
+(defun %debug (&rest objs)
+  (declare (jacl:rest-array))
+  (%js "console.debug.apply(null, ~{})" objs))
+
 (%export 'let)
 (defmacro let (bindings &rest body)
   `(jacl:%let ,bindings ,@body))
@@ -186,19 +190,45 @@
 (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 '+)
+(defun + (&rest nums)
+  (declare (jacl:rest-array))
+  (jacl:%js "
+    var nums = ~{}, sum = 0;
+    for(var i = 0; i < nums.length; i++) {
+      var num = nums[i];
+      if (typeof num !== 'number') {
+        throw new TypeError('Not a number: ' + num);
+      }
+      sum += num
+    }
+    return sum" nums)
+  ;; Never returned. Here to force the preceding expression to be
+  ;; analyzed as "statement" context.
+  nil)
+
+(%export '-)
+(defun - (minuend &rest subtrahends)
+  (declare (jacl:rest-array))
+  (when (not (numberp minuend)) (%type-error "number"))
+  (jacl:%js "
+    var minuend = ~{}, subtrahends = ~{};
+    if (subtrahends.length) {
+      for (var i = 0; i < subtrahends.length; i++) {
+        var num = subtrahends[i];
+        if (typeof num !== 'number') {
+            throw new TypeError('Not a number: ' + num);
+        }
+        minuend -= num;
+      }
+      return minuend;
+    } else {
+      return -minuend;
+    }
+  " minuend subtrahends)
+  ;; Never returned. Here to force the preceding expression to be
+  ;; analyzed as "statement" context.
+  nil)
 
 (%export 'gensym)
 (defun gensym (&optional (x nil x?))
@@ -341,26 +371,29 @@
      end)
     ret))
 
+
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
   (let ((var (car binding))
-        (list-form (cadr binding))
+        (list (gensym "list"))
         (result-form (caddr binding))
-        (glist (gensym))
-        (gstart (gensym))
-        (gend (gensym)))
-    `(let* ((,var nil)
-            (,glist ,list-form))
+        (begin (gensym "begin"))
+        (end (gensym "end")))
+    `(let ((,var nil)
+           (,list ,(cadr binding)))
        (tagbody
-        ,gstart
-        (if (null ,glist) (go ,gend))
-        (setq ,var (car ,glist) ,glist (cdr ,glist))
+        ,begin
+        (if (null ,list) (go ,end))
+        (setq ,var (car ,list))
         ,@body
-        (go ,gstart)
-        ,gend)
+        (setq ,list (cdr ,list))
+        (go ,begin)
+        ,end)
        (setq ,var nil)
        ,result-form)))
 
+;; (%debug 1 2 3 "foo" 'bar)
+
 ;;(defun %designated-string (x)
 ;;  (cond ((stringp x) x)
 ;;        ((symbolp x)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index d802c3b..a2f141c 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -90,7 +90,21 @@
   (assert-throws (< "foo" "bar" "baz"))
   (assert= (< 1) t)
   (assert= (< 5 10 421) t)
-  (assert= (< 41 2) nil))
+  (assert= (< 41 2) nil)
+
+  (assert= (+) 0)
+  (assert= (+ 1) 1)
+  (assert= (+ 1 2 3) 6)
+  (assert-throws (+ "haha"))
+  (assert-throws (+ 1 2 'haha))
+
+  (assert= (- 1) -1)
+  (assert= (- 3 4) -1)
+  (assert= (- 100 10 3 1) 86)
+  (assert-throws (-))
+  (assert-throws (- 'foo))
+  (assert-throws (- 1 'bar))
+  )
 
 (\. @|QUnit| (|module| @"Control operators"))
 
@@ -123,12 +137,6 @@
      end)
     (assert= x 0)))
 
-(deftest "CL:DOLIST"
-  (let ((sum 0))
-    (dolist (x '(1 1 1))
-      (setq sum (1+ sum)))
-    (assert= sum 3)))
-
 (defun countdown (from)
   (tagbody
    start
@@ -138,4 +146,26 @@
 
 (countdown 3)
 
+(\. @|QUnit| (|module| @"Iteration operators"))
+
+(deftest "CL:DOLIST"
+  (let ((sum 0)
+        (ones '(1 1 1)))
+    (dolist (x ones)
+      (setq sum (1+ sum)))
+    (assert= sum 3 "without result-form")
+    (setq sum 0)
+    (assert= (dolist (x ones sum)
+               (setq sum (1+ sum)))
+             3
+             "with result-form")
+    (setq sum 0)
+    (dolist (x ones)
+      start
+      (when (< x 2)
+        (setq x (1+ x))
+        (go start))
+      (setq sum (+ sum x)))
+    (assert= sum 6 "with tags in body")))
+
 (\. @|QUnit| (|start|))