author | Alan Dipert
<alan@dipert.org> 2020-04-03 06:17:57 UTC |
committer | Alan Dipert
<alan@dipert.org> 2020-04-03 06:17:57 UTC |
parent | 7f4134a6cc5312f7b1647aebf255f15696c5154c |
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 {