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
fa8b3e7b
Verified
Commit
fa8b3e7b
authored
Oct 25, 2018
by
Vladimir Sedach
Browse files
Fixed implicit return of dynamic extent return-from
parent
916da52f
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/special-operators.lisp
View file @
fa8b3e7b
...
...
@@ -206,7 +206,7 @@
(
*current-block-tag*
name
)
(
compiled-body
(
wrap-for-dynamic-return
(
list
name
)
(
compile
-statement
`
(
progn
,@
body
)))))
(
ps-
compile
`
(
progn
,@
body
)))))
;; this probably does not nest correctly
(
if
(
tree-find
`
(
ps-js:break
,
name
)
compiled-body
)
`
(
ps-js:label
,
name
,
compiled-body
)
...
...
@@ -349,11 +349,14 @@ 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*
)))
(
return-from
expressionize-result
(
expressionize-result
tag
¹
`
(
progn
,@
body
¹
))))))
(
let*
((
tag
¹
(
or
(
cadr
form
)
'nilBlock
))
(
*function-block-names*
(
cons
tag
¹
*function-block-names*
))
(
*dynamic-return-tags*
(
cons
(
cons
tag
¹
nil
)
*dynamic-return-tags*
)))
(
return-from
expressionize-result
(
wrap-for-dynamic-return
(
list
tag
¹
)
(
ps-compile
`
(
return-from
,
tag
(
progn
,@
(
cddr
form
))))))))
(
return-from
;; this will go away someday
(
unless
tag
(
warn
'simple-style-warning
...
...
@@ -369,12 +372,11 @@ Parenscript now implements implicit return, update your code! Things like (lambd
(
t
(
compile-statement
form
))))))))
(
define-statement-operator
return-from
(
tag
&optional
result
)
(
if
tag
(
let
((
form
(
ps-macroexpand
result
)))
(
if
(
or
(
atom
form
)
(
eq
'values
(
car
form
)))
(
return-exp
tag
form
)
(
expressionize-result
tag
form
)))
(
ps-compile
`
(
return-from
nilBlock
,
result
))))
(
setq
tag
(
or
tag
'nilBlock
))
(
let
((
form
(
ps-macroexpand
result
)))
(
if
(
or
(
atom
form
)
(
eq
'values
(
car
form
)))
(
return-exp
tag
form
)
(
expressionize-result
tag
form
))))
(
define-expression-operator
values
(
&optional
main
&rest
additional
)
(
when
main
...
...
tests/output-tests.lisp
View file @
fa8b3e7b
...
...
@@ -4266,3 +4266,24 @@ x = 2 + sideEffect() + x + 5;")
};
return 5;
});"
)
(
test-ps-js
lambda-progn-block
(
lambda
()
(
progn
(
block
X
(
lambda
()
(
return-from
X
1
)))))
"(function () {
try {
return function () {
throw { '__ps_block_tag' : 'X', '__ps_value1' : 1 };
};
} catch (_ps_err1) {
if (_ps_err1 && 'X' === _ps_err1['__ps_block_tag']) {
__PS_MV_REG = { 'tag' : arguments.callee, 'values' : _ps_err1['__ps_values'] };
return _ps_err1['__ps_value1'];
} else {
throw _ps_err1;
};
};
});"
)
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