error is an expression now

[jscl.git] / lispstrack.lisp

diff --git a/lispstrack.lisp b/lispstrack.lisp
index d71f675..38b6f96 100644 (file)
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -493,12 +493,18 @@
 (define-compilation eq (x y)
   (concat "(" (ls-compile x env fenv) " === " (ls-compile y env fenv) ")"))
 
+(define-compilation equal (x y)
+  (concat "(" (ls-compile x env fenv) " == " (ls-compile y env fenv) ")"))
+
 (define-compilation string (x)
   (concat "String.fromCharCode(" (ls-compile x env fenv) ")"))
 
 (define-compilation string-upcase (x)
   (concat "(" (ls-compile x env fenv) ").toUpperCase()"))
 
+(define-compilation string-length (x)
+  (concat "(" (ls-compile x env fenv) ").length"))
+
 (define-compilation char (string index)
   (concat "("
           (ls-compile string env fenv)
@@ -524,7 +530,7 @@
           ")"))
 
 (define-compilation error (string)
-  (concat "console.error(" (ls-compile string env fenv) ")"))
+  (concat "(function (){ throw " (ls-compile string env fenv) ";" "return 0;})()"))
 
 (define-compilation new ()
   "{}")
@@ -598,6 +604,7 @@
 
   (defun ls-compile-file (filename output)
     (setq *env* nil *fenv* nil)
+    (setq *compilation-unit-checks* nil)
     (with-open-file (out output :direction :output :if-exists :supersede)
       (let* ((source (read-whole-file filename))
              (in (make-string-stream source)))
@@ -608,7 +615,8 @@
            when (plusp (length compilation))
            do (write-line (concat compilation "; ") out))
         (dolist (check *compilation-unit-checks*)
-          (funcall check)))))
+          (funcall check))
+        (setq *compilation-unit-checks* nil))))
 
   (defun bootstrap ()
     (ls-compile-file "lispstrack.lisp" "lispstrack.js")))