X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=2febb3ab643217836c2a54b0328485b59428ac09;hb=bde4a4bf8433a91cfe6f0996af8b53bc1b778903;hp=b8cc906ccbd0bcb1441219cab30df72ad4788085;hpb=399f7409d326005321b88b2d973c35fb733dfe5d;p=jscl.git diff --git a/lispstrack.lisp b/lispstrack.lisp index b8cc906..2febb3a 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -112,8 +112,8 @@ (let (ch) (skip-whitespaces stream) (setq ch (%peek-char stream)) - (while (and ch (eql ch #\;)) - (read-until stream (lambda (x) (eql x #\newline))) + (while (and ch (char= ch #\;)) + (read-until stream (lambda (x) (char= x #\newline))) (skip-whitespaces stream) (setq ch (%peek-char stream))))) @@ -164,7 +164,9 @@ (#\' (list 'function (ls-read stream))) (#\\ - (let ((cname (read-until stream #'terminalp))) + (let ((cname + (concat (string (%read-char stream)) + (read-until stream #'terminalp)))) (cond ((string= cname "space") (char-code #\space)) ((string= cname "newline") (char-code #\newline)) @@ -297,7 +299,7 @@ (defun literal->js (sexp) (cond - ((null sexp) "undefined") + ((null sexp) "false") ((integerp sexp) (integer-to-string sexp)) ((stringp sexp) (concat "\"" sexp "\"")) ((symbolp sexp) (concat "{name: \"" (symbol-name sexp) "\"}")) @@ -417,7 +419,7 @@ (concat "(Math.floor(" (ls-compile x env fenv) "))")) (define-compilation null (x) - (concat "(" (ls-compile x env fenv) "== undefined)")) + (concat "(" (ls-compile x env fenv) "== false)")) (define-compilation cons (x y) (concat "{car: " (ls-compile x env fenv) ", cdr: " (ls-compile y env fenv) "}")) @@ -471,6 +473,10 @@ ", ") ")")) +(define-compilation error (string) + (concat "console.error(" (ls-compile string env fenv) ")")) + + (define-compilation new () "{}") @@ -526,21 +532,6 @@ ((integerp sexp) (integer-to-string sexp)) ((stringp sexp) (concat "\"" sexp "\"")) ((listp sexp) - (let ((sexp (ls-macroexpand-1 sexp env fenv))) - (if (listp sexp) - (let ((compiler-func (second (assoc (car sexp) *compilations*)))) - (if compiler-func - (apply compiler-func env fenv (cdr sexp)) - (compile-funcall (car sexp) (cdr sexp) env fenv))) - (ls-compile sexp env fenv)))))) - - -(defun ls-compile (sexp &optional env fenv) - (cond - ((symbolp sexp) (lookup-variable sexp env)) - ((integerp sexp) (integer-to-string sexp)) - ((stringp sexp) (concat "\"" sexp "\"")) - ((listp sexp) (if (assoc (car sexp) *compilations*) (let ((comp (second (assoc (car sexp) *compilations*)))) (apply comp env fenv (cdr sexp)))