From 2f9fa1976a2e7b451a673c84d8d7e5b54b965d6c Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Fri, 13 Aug 2010 21:07:29 -0400 Subject: [PATCH] Fixed compilation of LET forms without bodies (thanks to Maciej Katafiasz for the bug report). Simplified implicit-return code, generalized expressionizing of statements (should be possible to use this for things like loops inside expressions etc. without too much work now). --- src/macros.lisp | 39 +++++++------ src/special-forms.lisp | 149 +++++++++++++++++++++---------------------------- t/ps-tests.lisp | 26 ++++++++- t/reference-tests.lisp | 8 +-- 4 files changed, 110 insertions(+), 112 deletions(-) diff --git a/src/macros.lisp b/src/macros.lisp index 2014330..8f760c0 100644 --- a/src/macros.lisp +++ b/src/macros.lisp @@ -147,26 +147,22 @@ main))) (defpsmacro multiple-value-bind (vars expr &body body) - (let ((expr (ps-macroexpand expr))) - (if (and (consp expr) (implicit-progn-form? expr)) - `(,@(butlast expr) - (multiple-value-bind ,vars - ,@(last expr) - ,@body)) - (with-ps-gensyms (mv prev-mv) - `(let ((,prev-mv (@ arguments :callee :mv))) - (try - (progn - (setf (@ arguments :callee :mv) t) - (let ((,(car vars) ,expr) - (,mv (if (objectp (@ arguments :callee :mv)) - (@ arguments :callee :mv) - (make-array ,(1- (length vars)))))) - (destructuring-bind ,(cdr vars) ,mv - ,@body))) - (:finally (if (undefined ,prev-mv) - (delete (@ arguments :callee :mv)) - (setf (@ arguments :callee :mv) ,prev-mv))))))))) + (expressionize expr + (lambda (expr) + (with-ps-gensyms (mv prev-mv) + `(let ((,prev-mv (@ arguments :callee :mv))) + (try + (progn + (setf (@ arguments :callee :mv) t) + (let ((,(car vars) ,expr) + (,mv (if (objectp (@ arguments :callee :mv)) + (@ arguments :callee :mv) + (make-array ,(1- (length vars)))))) + (destructuring-bind ,(cdr vars) ,mv + ,@body))) + (:finally (if (undefined ,prev-mv) + (delete (@ arguments :callee :mv)) + (setf (@ arguments :callee :mv) ,prev-mv))))))))) ;;; conditionals @@ -464,6 +460,9 @@ lambda-list::= ;;; Control structures +(defpsmacro return (&optional form) + (expressionize form (lambda (x) `(return-exp ,x)))) + (defpsmacro ignore-errors (&body body) `(try (progn ,@body) (:catch (e)))) diff --git a/src/special-forms.lisp b/src/special-forms.lisp index 8b25cb4..61898f4 100644 --- a/src/special-forms.lisp +++ b/src/special-forms.lisp @@ -90,75 +90,63 @@ (string x) (vector `(array ,@(loop :for el :across x :collect (quote% el)))))))) -(defun ps-statement? (exp) - (and (consp exp) - (member (car exp) - '(throw - for - for-in - while)))) - -(defun implicit-progn-form? (form) - (member (car form) '(with progn label let flet labels macrolet symbol-macrolet))) - -(define-ps-special-form return (&optional value force-conditional?) - (let ((value (ps-macroexpand value))) - (if (ps-statement? value) - (compile-statement value) - (if (consp value) - (if (implicit-progn-form? value) - (ps-compile (append (butlast value) - `((return ,@(last value) - ,force-conditional?)))) - (case (car value) - (return - (ps-compile value)) - (switch - (ps-compile - `(switch ,(second value) - ,@(loop for (cvalue . cbody) in (cddr value) - for remaining on (cddr value) collect - (let ((last-n - (cond ((or (eq 'default cvalue) - (not (cdr remaining))) - 1) - ((eq 'break - (car (last cbody))) - 2)))) - (if last-n - `(,cvalue - ,@(butlast cbody last-n) - (return - ,(car (last cbody last-n)) - t)) - (cons cvalue cbody))))))) - (try - (ps-compile - `(try (return ,(second value) t) - ,@(let ((catch (cdr (assoc :catch (cdr value)))) - (finally (assoc :finally (cdr value)))) - (list (when catch - `(:catch ,(car catch) - ,@(butlast (cdr catch)) - (return ,@(last (cdr catch)) t))) - finally))))) - (if - (ps-compile `(if ,(second value) - (return ,(third value) ,force-conditional?) - ,@(acond ((fourth value) - `((return ,it - ,force-conditional?))) - (force-conditional? - '((return nil))))))) - (cond - (ps-compile `(cond - ,@(loop for clause in (cdr value) collect - `(,@(butlast clause) - (return ,@(last clause) - ,force-conditional?)))))) - (otherwise - `(js:return ,(compile-expression value))))) - `(js:return ,(compile-expression value)))))) +(defvar return-null-else? t) + +(defun expressionize (form func) + (let ((form (ps-macroexpand form))) + (if (consp form) + (case (car form) + (progn + `(,@(butlast form) ,(expressionize (car (last form)) func))) + (switch + `(switch ,(second form) + ,@(loop for (cvalue . cbody) in (cddr form) + for remaining on (cddr form) collect + (let ((last-n + (cond ((or (eq 'default cvalue) + (not (cdr remaining))) + 1) + ((eq 'break + (car (last cbody))) + 2)))) + (if last-n + `(,cvalue + ,@(butlast cbody last-n) + ,(expressionize (car (last cbody last-n)) func)) + (cons cvalue cbody)))))) + (try + `(try ,(expressionize (second form) func) + ,@(let ((catch (cdr (assoc :catch (cdr form)))) + (finally (assoc :finally (cdr form)))) + (list (when catch + `(:catch ,(car catch) + ,@(butlast (cdr catch)) + ,(expressionize (car (last (cdr catch))) + func))) + finally)))) + (if + `(if ,(second form) + ,(let ((return-null-else? nil)) + (expressionize (third form) func)) + ,@(when (or (fourth form) return-null-else?) + (list (expressionize (fourth form) func))))) + (cond + `(cond ,@(loop for clause in (cdr form) collect + `(,@(butlast clause) + ,(expressionize (car (last clause)) func))))) + (otherwise + (cond ((find (car form) + '(with label let flet labels macrolet symbol-macrolet)) + `(,(first form) ,(second form) + ,@(butlast (cddr form)) + ,(expressionize (car (last (cddr form))) func))) + ((find (car form) '(for for-in return-exp throw while)) + form) + (t (funcall func form))))) + (funcall func form)))) + +(define-ps-special-form return-exp (&optional form) + `(js:return ,(compile-expression form))) (define-ps-special-form incf (x &optional (delta 1)) (let ((delta (ps-macroexpand delta))) @@ -257,13 +245,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; function definition -(defun add-implicit-return (fbody) - (let ((last-thing (car (last fbody)))) - (if (ps-statement? last-thing) - fbody - (append (butlast fbody) - `((return ,last-thing)))))) - (defmacro with-declaration-effects (body-var &body body) `(let* ((local-specials (when (and (listp (car ,body-var)) (eq (caar ,body-var) 'declare)) @@ -279,17 +260,15 @@ (with-declaration-effects body (list args (let* ((*enclosing-lexical-block-declarations* ()) - (*ps-enclosing-lexicals* - (append args *ps-enclosing-lexicals*)) - (body - (compile-statement `(progn - ,@(add-implicit-return body)))) + (*ps-enclosing-lexicals* (append args *ps-enclosing-lexicals*)) + (body (compile-statement + `(progn ,@(butlast body) + ,(let ((return-null-else? nil)) + (ps-macroexpand `(return ,@(last body))))))) (var-decls (compile-statement - `(progn - ,@(mapcar (lambda (var) - `(var ,var)) - *enclosing-lexical-block-declarations*))))) + `(progn ,@(mapcar (lambda (var) `(var ,var)) + *enclosing-lexical-block-declarations*))))) `(js:block ,@(cdr var-decls) ,@(cdr body)))))) (define-ps-special-form %js-lambda (args &rest body) diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index 87bbae8..9b8cd56 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -455,6 +455,8 @@ __setf_someThing('foo', 1, 2);") (return (if x 1)) "if (x) { return 1; +} else { + return null; };") (test-ps-js progn-expression-single-statement @@ -535,9 +537,9 @@ __setf_someThing('foo', 1, 2);") (is (string= (normalize-js-code (let* ((macroname (gensym))) (ps* `(defmacro ,macroname (x) `(+ ,x 123)) `(defun test1 () - (macrolet ((,macroname (x) `(aref data ,x))) - (when (,macroname x) - (setf (,macroname x) 123))))))) + (macrolet ((,macroname (x) `(aref data ,x))) + (when (,macroname x) + (setf (,macroname x) 123))))))) (normalize-js-code "function test1() { if (data[x]) { @@ -1526,6 +1528,19 @@ __setf_foo(5, x, 1, 2, 3, 4);") }; };") +(test-ps-js return-when-returns + (lambda () + (return (when x 1)) + (+ 2 3)) + "function () { + if (x) { + return 1; + } else { + return null; + }; + return 2 + 3; +};") + (test-ps-js return-case-conditional (return (case foo @@ -1739,3 +1754,8 @@ x();") ((bar)) (t 456))) "x = foo() ? 123 : (bar() ? null : 456);") + +(test-ps-js let-no-body + (return (let ((foo bar)))) + "var foo = bar; +return null;") diff --git a/t/reference-tests.lisp b/t/reference-tests.lisp index f2c583e..ecceca1 100644 --- a/t/reference-tests.lisp +++ b/t/reference-tests.lisp @@ -435,10 +435,10 @@ for (var c = null, _js_idx1 = 0; _js_idx1 < l.length; _js_idx1 += 1) { (test-ps-js iteration-constructs-7 (let ((l '(1 2 4 8 16 32)) - (s 0)) - (alert (+ "Sum of " l " is: " - (dolist (c l s) - (incf s c))))) + (s 0)) + (alert (+ "Sum of " l " is: " + (dolist (c l s) + (incf s c))))) "var l = [1, 2, 4, 8, 16, 32]; var s = 0; alert('Sum of ' + l + ' is: ' + (function () { -- 2.11.4.GIT