Verified Commit 916da52f authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Fix one bug with bogus lexical block breaks from inner lambdas

parent e12e1abb
......@@ -150,14 +150,17 @@ of (declare ...) forms, and the remaining body."
(defun collapse-function-return-blocks (body)
(append (butlast body)
(let ((last (ps-macroexpand (car (last body)))))
(if (and (listp last) (eq 'block (car last))) ; no need for a block at the end of a function body
(progn (push (or (second last) 'nilBlock) *function-block-names*)
(if (and (listp last) (eq 'block (car last)))
;; no need for a block at the end of a function body
(progn (push (or (second last) 'nilBlock)
*function-block-names*)
(cddr last))
(list last)))))
(defun compile-function-body (args body)
(with-declaration-effects (body body)
(let* ((in-function-scope? t)
(*current-block-tag* nil)
(*vars-needing-to-be-declared* ())
(*used-up-names* ())
(*enclosing-function-arguments*
......
......@@ -384,7 +384,8 @@ lambda-list::=
,@(when result? (list result))))
(defpsmacro do (decls (end-test &optional (result nil result?)) &body body)
(multiple-value-bind (do-body declarations) (parse-body body)
(multiple-value-bind (do-body declarations)
(parse-body body)
`(block nil
(let ,(do-make-iteration-bindings decls)
,@declarations
......
......@@ -201,11 +201,13 @@
(if in-function-scope?
(let* ((name (or name 'nilBlock))
(in-loop-scope? (if name in-loop-scope? nil))
(*dynamic-return-tags* (cons (cons name nil) *dynamic-return-tags*))
(*dynamic-return-tags* (cons (cons name nil)
*dynamic-return-tags*))
(*current-block-tag* name)
(compiled-body (wrap-for-dynamic-return
(list name)
(compile-statement `(progn ,@body)))))
;; this probably does not nest correctly
(if (tree-find `(ps-js:break ,name) compiled-body)
`(ps-js:label ,name ,compiled-body)
compiled-body))
......@@ -324,7 +326,8 @@ invocations or not.")
(list (when catch
`(:catch ,(car catch)
,@(butlast (cdr catch))
(return-from ,tag ,(car (last (cdr catch))))))
(return-from ,tag
,(car (last (cdr catch))))))
finally))))
(cond
`(cond
......@@ -346,11 +349,11 @@ invocations or not.")
,@(when (or in-case? (fourth form))
`((return-from ,tag ,(fourth form)))))))
(block
(let ((tag* (or (cadr form) 'nilBlock))
(body* (cddr form)))
(let ((*function-block-names* (cons tag* *function-block-names*)))
(let ((tag¹ (or (cadr form) 'nilBlock))
(body¹ (cddr form)))
(let ((*function-block-names* (cons tag¹ *function-block-names*)))
(return-from expressionize-result
(expressionize-result tag* `(progn ,@body*))))))
(expressionize-result tag¹ `(progn ,@body¹))))))
(return-from ;; this will go away someday
(unless tag
(warn 'simple-style-warning
......
......@@ -866,6 +866,21 @@
(loop for x across A sum (funcall x)))
200)
(test-js-eval loop-variable-capture6
(labels ((make-cl (i) (lambda () (* i 10))))
(let ((closures (loop :for i :from 1 :to 3
:collect (make-cl i))))
(loop :for fn :in closures :collect (funcall fn))))
'(10 20 30))
(test-js-eval loop-variable-capture7
(let ((closures (loop :for i :from 1 :to 3
:collect (let* ((j i)
(cl (lambda () (* j 10))))
cl))))
(loop :for fn :in closures :collect (funcall fn)))
'(10 20 30))
(test-js-eval nested-let
(let ((x (let ((y 94))
y)))
......@@ -937,3 +952,90 @@
(dotimes (i '(1 2 3) (list 9 i))
(list i))
'(9 nil))
(test-js-eval progn-of-block-closure
((lambda ()
(progn
(block nil
((lambda ()
((lambda ()
(return 1)))
2))))))
1)
(test-js-eval progn-of-block-closure1
((lambda ()
(progn
(block X
((lambda ()
((lambda ()
(return-from X 1)))
2))))))
1)
(test-js-eval progn-of-block-closure2
((lambda ()
(1+
(block X
((lambda ()
((lambda ()
(return-from X 1)))
3))))))
2)
(test-js-eval progn-of-block-closure3
((lambda ()
(1+
(block nil
((lambda ()
((lambda ()
(return 1)))
3))))))
2)
(test-js-eval block-closure-no-progn
((lambda ()
(block nil
((lambda ()
((lambda ()
(return 1)))
2)))))
1)
(test-js-eval function-clears-current-block-tag
((lambda ()
(block X
((lambda ()
((lambda ()
(return-from X 1)))
2)))
5))
5)
(test-js-eval defvar-dynamic-return
(progn
(defvar foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2)))))
foo)
6)
(test-js-eval defvar-dynamic-return1
(progn
(defvar foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2))
(+ 4 5))))
foo)
9)
(test-js-eval defvar-dynamic-return-expression
(progn
(defvar foo ((lambda ()
(+ 1 (block nil
((lambda () (return 6)))
(+ 1 2))))))
foo)
7)
......@@ -3515,10 +3515,10 @@ while (foo()) {
};")
(test-ps-js block-dynamic-return
(var foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2)))))
(defvar foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2)))))
"var foo = (function () {
try {
(function () {
......@@ -3535,20 +3535,31 @@ while (foo()) {
};
})();")
(test-ps-js block-dynamic-return1
(var foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2))
(foobar 1 2))))
(test-ps-js block-dynamic-return1-redundant
(defvar foo ((lambda ()
(block nil
((lambda () (return 6)))
(+ 1 2))
(+ 4 5))))
;;; FIXME. Not wrong, but redundant
"var foo = (function () {
nilBlock: {
try {
(function () {
break nilBlock;
throw { '__ps_block_tag' : 'nilBlock', '__ps_value1' : 6 };
})();
1 + 2;
} catch (_ps_err1) {
if (_ps_err1 && 'nilBlock' === _ps_err1['__ps_block_tag']) {
__PS_MV_REG = { 'tag' : arguments.callee, 'values' : _ps_err1['__ps_values'] };
_ps_err1['__ps_value1'];
break nilBlock;
} else {
throw _ps_err1;
};
};
};
return foobar(1, 2);
return 4 + 5;
})();")
(test-ps-js iteration-lambda-capture-no-need
......@@ -4225,3 +4236,33 @@ x = 2 + sideEffect() + x + 5;")
(fun2 () 6))
(A (fun1) (fun2)))
"G + G + 6 + 6;")
(test-ps-js lambda-block-wrap-for-dynamic-return
(lambda ()
(block X
((lambda ()
((lambda ()
(return-from X 1)))
2)))
5)
"(function () {
X: {
try {
(function () {
(function () {
throw { '__ps_block_tag' : 'X', '__ps_value1' : 1 };
})();
return 2;
})();
} catch (_ps_err1) {
if (_ps_err1 && 'X' === _ps_err1['__ps_block_tag']) {
__PS_MV_REG = { 'tag' : arguments.callee, 'values' : _ps_err1['__ps_values'] };
_ps_err1['__ps_value1'];
break X;
} else {
throw _ps_err1;
};
};
};
return 5;
});")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment