X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler-codegen.lisp;h=6a3abc9d4012d1418e4b79f4a3fd24c1dbd82f72;hb=c1243ebc6aaa93fe370ddedbe4bbe1642f0b13e9;hp=50f33af7b7d72d0bf1e78a833a7d9679f9347ddd;hpb=c296885ca974898925b89af066b1b14a6fca0f57;p=jscl.git diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp index 50f33af..6a3abc9 100644 --- a/src/compiler-codegen.lisp +++ b/src/compiler-codegen.lisp @@ -78,7 +78,7 @@ (defun valid-js-identifier (string-designator) (let ((string (typecase string-designator - (symbol (string-downcase (symbol-name string-designator))) + (symbol (symbol-name string-designator)) (string string-designator) (t (return-from valid-js-identifier (values nil nil)))))) @@ -108,10 +108,11 @@ (js-format "~a" (js-escape-string form))) ((symbolp form) (case form - (true (js-format "true")) - (false (js-format "false")) - (null (js-format "null")) - (this (js-format "this")) + (true (js-format "true")) + (false (js-format "false")) + (null (js-format "null")) + (this (js-format "this")) + (undefined (js-format "undefined")) (otherwise (js-identifier form)))) (t @@ -154,13 +155,13 @@ (js-format ",") (js-identifier arg))) (js-format ")") - (js-stmt `(group ,@body))) + (js-stmt `(group ,@body) t)) (defun check-lvalue (x) (unless (or (symbolp x) (nth-value 1 (valid-js-identifier x)) (and (consp x) - (member (car x) '(get =)))) + (member (car x) '(get = property)))) (error "Bad Javascript lvalue ~S" x))) ;;; Process the Javascript AST to reduce some syntax sugar. @@ -221,7 +222,7 @@ (js-expr (car args)) (js-format "(") (when (cdr args) - (with-operator (13 'left) + (with-operator (12 'left) (js-expr (cadr args)) (dolist (operand (cddr args)) (let ((*js-output* t)) @@ -229,6 +230,11 @@ (js-expr operand))))) (js-format ")")) ;; Accessors + (property + (js-expr (car args)) + (js-format "[") + (js-expr (cadr args)) + (js-format "]")) (get (multiple-value-bind (identifier identifierp) (valid-js-identifier (car args)) @@ -362,86 +368,106 @@ ((and (consp form) (eq (car form) 'progn)) (destructuring-bind (&body body) (cdr form) (cond - ((null body) '(empty)) - ((null (cdr body)) (js-expand-stmt (car body))) - (t `(group ,@(cdr form)))))) + ((null body) + nil) + ((null (cdr body)) + (js-expand-stmt (car body))) + (t + `(group ,@(cdr form)))))) (t form))) (defun js-stmt (form &optional parent) (let ((form (js-expand-stmt form))) (flet ((js-stmt (x) (js-stmt x form))) - (if (atom form) - (progn - (js-expr form) - (js-format ";")) - (case (car form) - (code - (js-format "~a" (apply #'code (cdr form)))) - (empty - (unless (and (consp parent) (eq (car parent) 'group)) - (js-format ";"))) - (label - (destructuring-bind (label &body body) (cdr form) - (js-identifier label) - (js-format ":") - (js-stmt `(progn ,@body)))) - (break - (destructuring-bind (label) (cdr form) - (js-format "break ") - (js-identifier label) + (cond + ((null form) + (unless (or (and (consp parent) (eq (car parent) 'group)) + (null parent)) + (js-format ";"))) + ((atom form) + (progn + (js-expr form) + (js-format ";"))) + (t + (case (car form) + (code + (js-format "~a" (apply #'code (cdr form)))) + (label + (destructuring-bind (label &body body) (cdr form) + (js-identifier label) + (js-format ":") + (js-stmt `(progn ,@body)))) + (break + (destructuring-bind (label) (cdr form) + (js-format "break ") + (js-identifier label) + (js-format ";"))) + (return + (destructuring-bind (value) (cdr form) + (js-format "return ") + (js-expr value) (js-format ";"))) - (return - (destructuring-bind (value) (cdr form) - (js-format "return ") - (js-expr value) - (js-format ";"))) - (var - (flet ((js-var (spec) - (destructuring-bind (variable &optional initial) - (ensure-list spec) - (js-identifier variable) - (when initial - (js-format "=") - (js-expr initial))))) - (destructuring-bind (var &rest vars) (cdr form) - (let ((*js-operator-precedence* 12)) - (js-format "var ") - (js-var var) - (dolist (var vars) - (js-format ",") - (js-var var)) - (js-format ";"))))) - (if - (destructuring-bind (condition true &optional false) (cdr form) - (js-format "if (") - (js-expr condition) - (js-format ") ") - (js-stmt true) - (when false - (js-format " else ") - (js-stmt false)))) - (group - (let ((in-group-p - (or (null parent) - (and (consp parent) (eq (car parent) 'group))))) - (unless in-group-p (js-format "{")) - (mapc #'js-stmt (cdr form)) - (unless in-group-p (js-format "}")))) - (while - (destructuring-bind (condition &body body) (cdr form) - (js-format "while (") - (js-expr condition) - (js-format ")") - (js-stmt `(progn ,@body)))) - (throw - (destructuring-bind (object) (cdr form) - (js-format "throw ") - (js-expr object) - (js-format ";"))) - (t - (js-expr form) - (js-format ";"))))))) + (var + (flet ((js-var (spec) + (destructuring-bind (variable &optional initial) + (ensure-list spec) + (js-identifier variable) + (when initial + (js-format "=") + (js-expr initial))))) + (destructuring-bind (var &rest vars) (cdr form) + (let ((*js-operator-precedence* 12)) + (js-format "var ") + (js-var var) + (dolist (var vars) + (js-format ",") + (js-var var)) + (js-format ";"))))) + (if + (destructuring-bind (condition true &optional false) (cdr form) + (js-format "if (") + (js-expr condition) + (js-format ") ") + (js-stmt true) + (when false + (js-format " else ") + (js-stmt false)))) + (group + (let ((in-group-p + (or (null parent) + (and (consp parent) (eq (car parent) 'group))))) + (unless in-group-p (js-format "{")) + (mapc #'js-stmt (cdr form)) + (unless in-group-p (js-format "}")))) + (while + (destructuring-bind (condition &body body) (cdr form) + (js-format "while (") + (js-expr condition) + (js-format ")") + (js-stmt `(progn ,@body)))) + (try + (destructuring-bind (&rest body) (cdr form) + (js-format "try") + (js-stmt `(group ,@body)))) + (catch + (destructuring-bind ((var) &rest body) (cdr form) + (js-format "catch (") + (js-identifier var) + (js-format ")") + (js-stmt `(group ,@body)))) + (finally + (destructuring-bind (&rest body) (cdr form) + (js-format "finally") + (js-stmt `(group ,@body)))) + (throw + (destructuring-bind (object) (cdr form) + (js-format "throw ") + (js-expr object) + (js-format ";"))) + (t + (js-expr form) + (js-format ";")))))))) (defun js (&rest stmts) (mapc #'js-stmt stmts)