Commit 0ad11fac authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Suppressed printing of JS labels for CL BLOCK expressions when there is no...

Suppressed printing of JS labels for CL BLOCK expressions when there is no explicit returning from those blocks
parent 8b274702
......@@ -154,14 +154,16 @@
(define-statement-operator block (name &rest body)
(if in-function-scope?
(let* ((name (or name 'nilBlock))
(in-loop-scope? (if name in-loop-scope? nil))
(let* ((name (or name 'nilBlock))
(in-loop-scope? (if name in-loop-scope? nil))
(*dynamic-return-tags* (cons (cons name nil) *dynamic-return-tags*))
(*current-block-tag* name)
(compiled-body (compile-statement `(progn ,@body))))
`(ps-js:label ,name
,(wrap-for-dynamic-return
(list name) compiled-body)))
(*current-block-tag* name)
(compiled-body (wrap-for-dynamic-return
(list name)
(compile-statement `(progn ,@body)))))
(if (tree-search `(ps-js:break ,name) compiled-body)
`(ps-js:label ,name ,compiled-body)
compiled-body))
(ps-compile (with-lambda-scope `(block ,name ,@body)))))
(defun return-exp (tag &optional (value nil value?) rest-values)
......@@ -213,7 +215,8 @@
(case (car form)
((continue break throw) ;; non-local exit
form)
((with label let flet labels macrolet symbol-macrolet) ;; implicit progn forms
;; implicit progn forms
((with label let flet labels macrolet symbol-macrolet block)
`(,(first form) ,(second form)
,@(butlast (cddr form))
(return-from ,tag ,(car (last (cddr form))))))
......
......@@ -40,7 +40,8 @@ paren-script becomes parenScript, *some-global* becomes SOMEGLOBAL."
((every #'lower-case-p (remove-if-not #'alpha-char-p identifier)) (string-upcase identifier))
(t identifier))))))
(defun ordered-set-difference (list1 list2 &key (test #'eql)) ; because the CL set-difference may not preserve order
(defun ordered-set-difference (list1 list2 &key (test #'eql))
"CL set-difference may not preserve order."
(reduce (lambda (list el) (remove el list :test test))
(cons list1 list2)))
......@@ -55,3 +56,7 @@ paren-script becomes parenScript, *some-global* becomes SOMEGLOBAL."
(cond ((null x) acc)
((atom x) (cons x acc))
(t (flatten (car x) (flatten (cdr x) acc)))))
(defun tree-search (A tree)
(or (equal A tree)
(and (consp tree) (some (lambda (x) (tree-search A x)) tree))))
......@@ -3631,6 +3631,38 @@ var baz = 2;")
return a.foo123 > 1 ? 2 : null;
});")
(test-ps-js unused-named-block-not-printed1
(block foobar
(+ 1 2 3))
"(function () {
return 1 + 2 + 3;
})();")
(test-ps-js unused-named-block-not-printed2
(block nil
(block nil
(+ 1 2 3)))
"(function () {
return 1 + 2 + 3;
})();")
(test-ps-js unused-named-block-not-printed3
(block foobar
(block nil
(+ 1 2 3)))
"(function () {
return 1 + 2 + 3;
})();")
(test-ps-js unused-named-block-not-printed4
(block nil
(block foobar
(block nil
(+ 1 2 3))))
"(function () {
return 1 + 2 + 3;
})();")
;;; broken
;; (test-ps-js let-defun-toplevel
......
Supports Markdown
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