Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
parenscript
parenscript
Commits
916da52f
Verified
Commit
916da52f
authored
Oct 24, 2018
by
Vladimir Sedach
Browse files
Fix one bug with bogus lexical block breaks from inner lambdas
parent
e12e1abb
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/function-definition.lisp
View file @
916da52f
...
...
@@ -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*
...
...
src/macros.lisp
View file @
916da52f
...
...
@@ -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
...
...
src/special-operators.lisp
View file @
916da52f
...
...
@@ -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
...
...
tests/eval-tests.lisp
View file @
916da52f
...
...
@@ -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
)
tests/output-tests.lisp
View file @
916da52f
...
...
@@ -3515,10 +3515,10 @@ while (foo()) {
};"
)
(
test-ps-js
block-dynamic-return
(
var
foo
((
lambda
()
(
block
nil
((
lambda
()
(
return
6
)))
(
+
1
2
)))))
(
def
var
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;
});"
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment