From 162b28ef6c69dc32c4a7f525d0a0916fe7f6e97d Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Sat, 17 Dec 2011 13:09:32 -0500 Subject: [PATCH] Labels/flet now lambda wrapped as well. --- src/function-definition.lisp | 73 +++++++++++++++++------------------ src/special-operators.lisp | 7 +++- t/output-tests.lisp | 91 ++++++++++++++++++++++++++++---------------- 3 files changed, 101 insertions(+), 70 deletions(-) diff --git a/src/function-definition.lisp b/src/function-definition.lisp index 45e84e0..649e599 100644 --- a/src/function-definition.lisp +++ b/src/function-definition.lisp @@ -186,43 +186,44 @@ Syntax of key spec: (compile-named-function-body name args body) `(ps-js:lambda ,args1 ,body-block))) +(defmacro local-functions (special-op &body bindings) + `(if in-function-scope? + (let* ((fn-renames (collect-function-names fn-defs)) + ,@bindings) + `(,(if compile-expression? 'ps-js:|,| 'ps-js:block) + ,@definitions + ,@(compile-progn body))) + (ps-compile (with-lambda-scope `(,',special-op ,fn-defs ,@body))))) + +(defun compile-local-function-body (fn-defs renames) + (loop for (fn-name . (args . body)) in fn-defs collect + (progn (when compile-expression? + (push (getf renames fn-name) + *vars-needing-to-be-declared*)) + (list (if compile-expression? 'ps-js:= 'ps-js:var) + (getf renames fn-name) + (compile-named-local-function fn-name args body))))) + (define-expression-operator flet (fn-defs &rest body) - (let* ((fn-renames (collect-function-names fn-defs)) - ;; the function definitions need to be compiled with previous lexical bindings - (fn-defs - (loop for (fn-name . (args . body)) in fn-defs collect - (progn (when compile-expression? - (push (getf fn-renames fn-name) - *vars-needing-to-be-declared*)) - (list (if compile-expression? 'ps-js:= 'ps-js:var) - (getf fn-renames fn-name) - (compile-named-local-function fn-name args body))))) - ;; the flet body needs to be compiled with the extended lexical environment - (*enclosing-lexicals* - (append fn-renames *enclosing-lexicals*)) - (*loop-scope-lexicals* - (when in-loop-scope? (append fn-renames *loop-scope-lexicals*))) - (*local-function-names* - (append fn-renames *local-function-names*))) - `(,(if compile-expression? 'ps-js:|,| 'ps-js:block) - ,@fn-defs - ,@(compile-progn body)))) + (local-functions flet + ;; the function definitions need to be compiled with previous + ;; lexical bindings + (definitions (compile-local-function-body fn-defs fn-renames)) + ;; the flet body needs to be compiled with the extended + ;; lexical environment + (*enclosing-lexicals* (append fn-renames *enclosing-lexicals*)) + (*loop-scope-lexicals* (when in-loop-scope? + (append fn-renames *loop-scope-lexicals*))) + (*local-function-names* (append fn-renames *local-function-names*)))) (define-expression-operator labels (fn-defs &rest body) - (let* ((fn-renames (collect-function-names fn-defs)) - (*local-function-names* (append fn-renames *local-function-names*)) - (*enclosing-lexicals* (append fn-renames *enclosing-lexicals*)) - (*loop-scope-lexicals* (when in-loop-scope? - (append fn-renames *loop-scope-lexicals*)))) - `(,(if compile-expression? 'ps-js:|,| 'ps-js:block) - ,@(loop for (fn-name . (args . body)) in fn-defs collect - (progn (when compile-expression? - (push (getf *local-function-names* fn-name) - *vars-needing-to-be-declared*)) - (list (if compile-expression? 'ps-js:= 'ps-js:var) - (getf *local-function-names* fn-name) - (compile-named-local-function fn-name args body)))) - ,@(compile-progn body)))) - -(define-expression-operator function (fn-name) ;; one of the things responsible for function namespace + (local-functions labels + (*local-function-names* (append fn-renames *local-function-names*)) + (*enclosing-lexicals* (append fn-renames *enclosing-lexicals*)) + (*loop-scope-lexicals* (when in-loop-scope? + (append fn-renames *loop-scope-lexicals*))) + (definitions (compile-local-function-body fn-defs *local-function-names*)))) + +(define-expression-operator function (fn-name) + ;; one of the things responsible for function namespace (ps-compile (maybe-rename-local-function fn-name))) diff --git a/src/special-operators.lisp b/src/special-operators.lisp index 5e70459..00cae89 100644 --- a/src/special-operators.lisp +++ b/src/special-operators.lisp @@ -381,6 +381,10 @@ Parenscript doesn't support returning values this way from inside a loop yet!" (member x symbols-in-bindings)) (ps-gensym (symbol-name x)))) +(defun with-lambda-scope (body) + (prog1 `((lambda () ,body)) + (setf *vars-needing-to-be-declared* ()))) + (define-expression-operator let (bindings &body body) (with-declaration-effects (body body) (flet ((rename (x) (first x)) @@ -444,8 +448,7 @@ Parenscript doesn't support returning values this way from inside a loop yet!" renamed-body)))) (ps-compile (if in-function-scope? let-body - (prog1 `((lambda () ,let-body)) - (setf *vars-needing-to-be-declared* ())))))))) + (with-lambda-scope let-body))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; iteration diff --git a/t/output-tests.lisp b/t/output-tests.lisp index f2ddcf8..a4c5ef7 100644 --- a/t/output-tests.lisp +++ b/t/output-tests.lisp @@ -1347,20 +1347,23 @@ __setf_someThing('foo', 1, 2);") (flet ((foo (x) (1+ x)) (bar (y) (+ 2 y))) (bar (foo 1))) -"var foo = function (x) { +"(function () { +var foo = function (x) { return x + 1; }; var bar = function (y) { return 2 + y; }; -bar(foo(1));") +return bar(foo(1)); +})();") (test-ps-js flet3 (flet ((foo (x) (+ 2 x))) (flet ((foo (x) (1+ x)) (bar (y) (+ 2 (foo y)))) (bar (foo 1)))) - "var foo = function (x) { + "(function () { +var foo = function (x) { return 2 + x; }; var foo1 = function (x) { @@ -1369,7 +1372,8 @@ var foo1 = function (x) { var bar = function (y) { return 2 + foo(y); }; -bar(foo1(1));") +return bar(foo1(1)); +})();") (test-ps-js labels1 ((lambda () (labels ((foo (x) @@ -1388,37 +1392,43 @@ bar(foo1(1));") (labels ((foo (x) (1+ (bar x))) (bar (y) (+ 2 (foo y)))) (bar (foo 1))) - "var foo = function (x) { + "(function () { +var foo = function (x) { return bar(x) + 1; }; var bar = function (y) { return 2 + foo(y); }; -bar(foo(1));") +return bar(foo(1)); +})();") (test-ps-js labels3 (labels ((foo (x) (1+ x)) (bar (y) (+ 2 (foo y)))) (bar (foo 1))) - "var foo = function (x) { + "(function () { +var foo = function (x) { return x + 1; }; var bar = function (y) { return 2 + foo(y); }; -bar(foo(1));") +return bar(foo(1)); +})();") (test-ps-js labels-lambda-list (labels ((foo (x &optional (y 0)) (+ x y))) (foo 1)) - "var foo = function (x, y) { + "(function () { +var foo = function (x, y) { if (y === undefined) { y = 0; }; return x + y; }; -foo(1);") +return foo(1); +})();") (test-ps-js for-loop-var-init-exp ((lambda (x) @@ -1700,10 +1710,12 @@ return x + x; (test-ps-js flet-apply (flet ((foo () 'bar)) (apply (function foo) nil)) - "var foo = function () { + "(function () { +var foo = function () { return 'bar'; }; -foo.apply(this, null);") +return foo.apply(this, null); +})();") (test-ps-js let-apply (let ((foo (lambda () 1))) @@ -1723,11 +1735,13 @@ return foo1.apply(this, null); (flet ((x (x) (1+ x))) (let ((x 2)) (x x))) - "var x = function (x) { + "(function () { +var x = function (x) { return x + 1; }; var x1 = 2; -x(x1);") +return x(x1); +})();") (test-ps-js let-flet (let ((x 2)) @@ -1745,11 +1759,13 @@ return x1(x); (labels ((x (x) (1+ x))) (let ((x 2)) (x x))) - "var x = function (x) { + "(function () { +var x = function (x) { return x + 1; }; var x1 = 2; -x(x1);") +return x(x1); +})();") (test-ps-js let-labels (let ((x 2)) @@ -1867,15 +1883,19 @@ return ++x1; (test-ps-js flet-expression (1+ (flet ((foo (x) (1+ x))) (foo 1))) - "(foo = function (x) { - return x + 1; -}, foo(1)) + 1;") + "(function () { + var foo = function (x) { + return x + 1; + }; + return foo(1); +})() + 1;") (test-ps-js flet-lambda-list - (labels ((foo (x &key (y 0)) - (+ x y))) + (flet ((foo (x &key (y 0)) + (+ x y))) (foo 1 :y 2)) - "var foo = function (x) { + "(function () { +var foo = function (x) { var _js2 = arguments.length; for (var n1 = 1; n1 < _js2; n1 += 2) { switch (arguments[n1]) { @@ -1886,7 +1906,8 @@ return ++x1; var y = undefined === y ? 0 : y; return x + y; }; -foo(1, 'y', 2);") +return foo(1, 'y', 2); +})();") (test-ps-js return-case-break-elimination (defun foo () @@ -2352,11 +2373,13 @@ return testSymbolMacro1 + 1; (foo test-symbol-macro1) (test-symbol-macro1)) (bar test-symbol-macro1)) - "var testSymbolMacro1_1 = function () { + "(function () { +var testSymbolMacro1_1 = function () { return 2; }; foo(1); -testSymbolMacro1_1(); +return testSymbolMacro1_1(); +})(); bar(1);") (test compile-stream-nulls @@ -2370,11 +2393,13 @@ bar(1);") (test compile-stream1 (is (string= - "var testSymbolMacro1_1 = function () { - return 2; -}; -foo(1); -testSymbolMacro1_1(); + "(function () { + var testSymbolMacro1_1 = function () { + return 2; + }; + foo(1); + return testSymbolMacro1_1(); +})(); bar(1); " (with-input-from-string (s " @@ -2917,10 +2942,12 @@ foo = 3;") (flet ((foo () (return-from foo 123))) (foo)) - "var foo = function () { + "(function () { +var foo = function () { return 123; }; - foo();") + return foo(); +})();") (test-ps-js lambda-docstring-declarations (lambda (x) -- 2.11.4.GIT