git » jacl.git » commit 37091b8

first tagbody test, more numeric functions and tests

author Alan Dipert
2020-04-03 06:17:57 UTC
committer Alan Dipert
2020-04-03 06:17:57 UTC
parent 7f4134a6cc5312f7b1647aebf255f15696c5154c

first tagbody test, more numeric functions and tests

boot.lisp +31 -2
jacl-tests.lisp +36 -17
jacl.js +5 -2

diff --git a/boot.lisp b/boot.lisp
index 44d17c4..85d1a41 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -146,10 +146,14 @@
 
 (%export '1+)
 (defun 1+ (x)
-  (when (not (numberp x))
-    (%type-error "number"))
+  (when (not (numberp x)) (%type-error "number"))
   (jacl:%js "~{}+1" x))
 
+(%export '1-)
+(defun 1- (x)
+  (when (not (numberp x)) (%type-error "number"))
+  (jacl:%js "~{}-1" x))
+
 (%export 'gensym)
 (defun gensym (&optional (x nil x?))
   (cond ((and x? (stringp x))
@@ -234,6 +238,31 @@
 (defmacro setq (&rest pairs)
   `(cl:progn
     ,@(%map-pairs (lambda (x y) `(jacl:%setq ,x ,y)) pairs)))
+
+(%export 'zerop)
+(defun zerop (x)
+  (when (not (numberp x)) (%type-error "number"))
+  (jacl:%js "~{}===0?true:null" x))
+  
+(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)
+  (let ((ret t))
+    (tagbody
+     start
+     (when (not more-numbers) (go end))
+     (when (not (%> number (car more-numbers)))
+       (setq ret nil)
+       (go end))
+     (setq number (car more-numbers)
+           more-numbers (cdr more-numbers))
+     (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 0d77d2e..80b872b 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -13,13 +13,17 @@
                      (let ((*is* ,is))
                        ,@body))))))
 
-(defun assert= (x y label)
+(defun assert= (x y &optional (label ""))
   (\. *is* (|strictEqual| x y (\. label (|toString|)))))
 
 (defun read1 (s)
   (let ((s (\. s (|toString|))))
     (\. (%new @|Reader| (%new @|StringStream| s)) (|read|))))
 
+(defun log (&rest objects)
+  (declare (jacl:rest-array))
+  (\. (jacl:%js "console") |log| (|apply| nil objects)))
+
 (\. @|QUnit| (|module| @"Reader"))
 
 (deftest "Integers"
@@ -29,22 +33,37 @@
   (assert= (await (read1 "-32 "))   -32  "negative number")
   (assert= (await (read1 "1. "))    1.   "number with trailing dot"))
 
-(deftest "Symbols"
-  (let ((sym nil))
-    (setq sym (await (read1 @"somesym ")))
+(deftest "Basic Symbols"
+  (let ((sym (await (read1 @"somesym "))))
     (assert= (\. sym |name|) @"SOMESYM" "simple symbol name")
-    (assert= (\. sym |packageName|) @"COMMON-LISP-USER" "simple symbol package")
-
-    (setq sym (await (read1 @"|Alan| ")))
-    (assert= (\. sym |name|) @"Alan" "simple symbol name")
-    ))
-
-(let ()
-  1
-  2
-  ; This comment should be fine
-  3
-  ; This comment should be fine
-  )
+    (assert= (\. sym |packageName|) @"COMMON-LISP-USER" "simple symbol package"))
+  (let ((sym (await (read1 @"|Alan| "))))
+    (assert= (\. sym |name|) @"Alan" "simple symbol name"))
+  ;; TODO Support escape syntax in the JavaScript String reader macro.
+  (let ((sym (await (read1 @"\\\\alan "))))
+    (assert= (\. sym |name|) @"aLAN" "simple symbol with escape")))
+
+(deftest "Numeric functions"
+  (assert= (zerop 1) nil)
+  (assert= (zerop 0) t)
+  (assert= (1+ 2) 3)
+  (assert= (1- 10) 9)
+  (assert= (> 3 2 1) t)
+  (assert= (> 1) t)
+  (assert= (> 1 3) nil))
+
+(deftest "Local TAGBODY"
+  (let ((x 10)
+        (y 0))
+    (tagbody
+     begin
+     (when (> x 0)
+       (setq x (1- x) y (1+ y))
+       (go begin))
+     end)
+    (assert= x 0)
+    (assert= y 10)))
+;
+;(deftest "Dynamic TAGBODY")
 
 (\. @|QUnit| (|start|))
diff --git a/jacl.js b/jacl.js
index f96c86d..41a778b 100644
--- a/jacl.js
+++ b/jacl.js
@@ -1284,8 +1284,11 @@ const analyzeSpecials = new Map([
     });
     node.locals = [];
     node.specials = [];
-    for (const [name, expr] of List.toArray(bindings)) {
-      const val = analyze(env.withContext('expr'), node, expr)
+    for (const binding of List.toArray(bindings)) {
+      if (!List.isProperList(binding) || List.length(binding) !== 2)
+        throw new Error(`Improper %LET binding`);
+      const [name, expr] = binding,
+            val = analyze(env.withContext('expr'), node, expr);
       if (name.isSpecial) {
         node.specials.push([name, val]);
       } else {