X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler-codegen.lisp;h=6a3abc9d4012d1418e4b79f4a3fd24c1dbd82f72;hb=42137426ae8959291f52dee156ee27c1d13ce90d;hp=5b8d028bc98fc8749496f4491ac67221a21d4e92;hpb=00ba710e3c68fd667499a602bcead98400f1ac55;p=jscl.git diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp index 5b8d028..6a3abc9 100644 --- a/src/compiler-codegen.lisp +++ b/src/compiler-codegen.lisp @@ -22,6 +22,8 @@ ;;; It is intended to be used with the new compiler. However, it is ;;; quite independent so it has been integrated early in JSCL. +(/debug "loading compiler-codegen.lisp!") + (defvar *js-output* t) ;;; Two seperate functions are needed for escaping strings: @@ -76,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)))))) @@ -106,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 @@ -152,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. @@ -211,12 +214,15 @@ (let ((op1 (car args)) (op2 (cadr args))) (case op + ;; Transactional compatible operator + (code + (js-format "~a" (apply #'code args))) ;; Function call (call (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)) @@ -224,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)) @@ -352,78 +363,111 @@ (t (js-operator-expression (car form) (cdr form)))))) -(defun js-stmt (form) - (if (atom form) - (progn - (js-expr form) - (js-format ";")) - (case (car 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) +(defun js-expand-stmt (form) + (cond + ((and (consp form) (eq (car form) 'progn)) + (destructuring-bind (&body body) (cdr form) + (cond + ((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))) + (cond + ((null form) + (unless (or (and (consp parent) (eq (car parent) 'group)) + (null parent)) (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 - (js-format "{") - (mapc #'js-stmt (cdr form)) - (js-format "}")) - (progn - (cond - ((null (cdr form)) - (js-format ";")) - ((null (cddr form)) - (js-stmt (cadr form))) - (t - (js-stmt `(group ,@(cdr form)))))) - (while - (destructuring-bind (condition &body body) (cdr form) - (js-format "while (") + ((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 ";"))) + (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-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)))) - (throw - (destructuring-bind (object) (cdr form) - (js-format "throw ") - (js-expr object) - (js-format ";"))) - (t - (js-expr form) - (js-format ";"))))) + (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)