projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
error is an expression now
[jscl.git]
/
lispstrack.lisp
diff --git
a/lispstrack.lisp
b/lispstrack.lisp
index
13b53f3
..
38b6f96
100644
(file)
--- a/
lispstrack.lisp
+++ b/
lispstrack.lisp
@@
-493,9
+493,18
@@
(define-compilation eq (x y)
(concat "(" (ls-compile x env fenv) " === " (ls-compile y env fenv) ")"))
(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 (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)
(define-compilation char (string index)
(concat "("
(ls-compile string env fenv)
@@
-521,7
+530,7
@@
")"))
(define-compilation error (string)
")"))
(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 ()
"{}")
(define-compilation new ()
"{}")
@@
-595,6
+604,7
@@
(defun ls-compile-file (filename output)
(setq *env* nil *fenv* nil)
(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)))
(with-open-file (out output :direction :output :if-exists :supersede)
(let* ((source (read-whole-file filename))
(in (make-string-stream source)))
@@
-605,7
+615,8
@@
when (plusp (length compilation))
do (write-line (concat compilation "; ") out))
(dolist (check *compilation-unit-checks*)
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")))
(defun bootstrap ()
(ls-compile-file "lispstrack.lisp" "lispstrack.js")))