locals.parser: new word with-lambda-scope to handle lexical variables
better, fixes #1338 By cloning the relevant parts of the manifest, you ensure that the quotation with-lambda-scope runs can't "leak" local names in case of restartable errors.db4
parent
16abe47b03
commit
976961bfbd
|
@ -141,12 +141,6 @@ DEFER: ;FUNCTOR delimiter
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: push-functor-words ( -- )
|
||||
functor-words use-words ;
|
||||
|
||||
: pop-functor-words ( -- )
|
||||
functor-words unuse-words ;
|
||||
|
||||
: (parse-bindings) ( end -- words )
|
||||
[ dup parse-binding dup ]
|
||||
[ first2 [ make-local ] dip 2array ]
|
||||
|
@ -159,16 +153,14 @@ DEFER: ;FUNCTOR delimiter
|
|||
[
|
||||
building get use-words
|
||||
(parse-bindings)
|
||||
building get unuse-words
|
||||
] with-bindings ;
|
||||
|
||||
: parse-functor-body ( -- form )
|
||||
push-functor-words
|
||||
functor-words use-words
|
||||
"WHERE" parse-bindings
|
||||
[ [ swap <def> suffix ] { } assoc>map concat ]
|
||||
[ [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) ] bi*
|
||||
[ ] append-as
|
||||
pop-functor-words ;
|
||||
[ [ \ ;FUNCTOR parse-until >quotation ] with-lambda-scope ] bi*
|
||||
[ ] append-as ;
|
||||
|
||||
: (FUNCTOR:) ( -- word def effect )
|
||||
scan-new-word [ parse-functor-body ] parse-locals-definition ;
|
||||
|
|
|
@ -4,18 +4,6 @@ tools.test vocabs vocabs.parser ;
|
|||
IN: locals.parser.tests
|
||||
|
||||
<<
|
||||
! ((parse-lambda))
|
||||
{
|
||||
"V{ 99 :> kkk kkk }"
|
||||
} [
|
||||
[
|
||||
"locals" use-vocab
|
||||
{ "99 :> kkk kkk ;" } <lexer> [
|
||||
H{ } clone [ \ ; parse-until ] ((parse-lambda))
|
||||
] with-lexer
|
||||
] with-compilation-unit unparse
|
||||
] unit-test
|
||||
|
||||
! (::)
|
||||
{
|
||||
"dobiedoo"
|
||||
|
@ -67,3 +55,25 @@ IN: locals.parser.tests
|
|||
] with-compilation-unit
|
||||
[ locals>> [ name>> ] map ] [ keys ] bi*
|
||||
] unit-test
|
||||
|
||||
<<
|
||||
! with-lambda-scope
|
||||
{ t } [
|
||||
qualified-vocabs length
|
||||
H{ } clone [
|
||||
"hey there!" qualified-vocabs push [ ]
|
||||
] with-lambda-scope drop
|
||||
qualified-vocabs length =
|
||||
] unit-test
|
||||
|
||||
{
|
||||
"V{ 99 :> kkk kkk }"
|
||||
} [
|
||||
[
|
||||
"locals" use-vocab
|
||||
{ "99 :> kkk kkk ;" } <lexer> [
|
||||
H{ } clone [ \ ; parse-until ] with-lambda-scope
|
||||
] with-lexer
|
||||
] with-compilation-unit unparse
|
||||
] unit-test
|
||||
>>
|
||||
|
|
|
@ -31,15 +31,16 @@ ERROR: invalid-local-name name ;
|
|||
|
||||
SINGLETON: lambda-parser
|
||||
|
||||
: ((parse-lambda)) ( assoc reader-quot: ( -- quot ) -- quot )
|
||||
: with-lambda-scope ( assoc reader-quot: ( -- quot ) -- quot )
|
||||
'[
|
||||
in-lambda? on
|
||||
lambda-parser quotation-parser set
|
||||
[ use-words @ ] [ unuse-words ] bi
|
||||
manifest [ clone [ clone ] change-qualified-vocabs ] change
|
||||
use-words @
|
||||
] with-scope ; inline
|
||||
|
||||
: (parse-lambda) ( assoc -- quot )
|
||||
[ \ ] parse-until >quotation ] ((parse-lambda)) ;
|
||||
[ \ ] parse-until >quotation ] with-lambda-scope ;
|
||||
|
||||
: parse-lambda ( -- lambda )
|
||||
parse-local-defs
|
||||
|
@ -76,7 +77,7 @@ M: lambda-parser parse-quotation ( -- quotation )
|
|||
in>> [ dup pair? [ first ] when ] map make-locals ;
|
||||
|
||||
: (parse-locals-definition) ( effect vars assoc reader-quot -- word quot effect )
|
||||
((parse-lambda)) <lambda>
|
||||
with-lambda-scope <lambda>
|
||||
[ nip "lambda" set-word-prop ]
|
||||
[ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ]
|
||||
[ drop nip ] 3tri ; inline
|
||||
|
|
|
@ -155,11 +155,6 @@ HELP: use-words
|
|||
{ $description "Adds an assoc mapping word names to words to the current manifest." }
|
||||
{ $notes "This word is used by " { $link "locals" } " to implement lexically-scoped names." } ;
|
||||
|
||||
HELP: unuse-words
|
||||
{ $values { "assoc" assoc } }
|
||||
{ $description "Removes an assoc mapping word names to words from the current manifest." }
|
||||
{ $notes "This word is used by " { $link "locals" } " to implement lexically-scoped names." } ;
|
||||
|
||||
HELP: ambiguous-use-error
|
||||
{ $error-description "Thrown when a word name referenced in source file is available in more than one vocabulary in the manifest. Such cases must be explicitly disambiguated using " { $link POSTPONE: FROM: } ", " { $link POSTPONE: EXCLUDE: } ", " { $link POSTPONE: QUALIFIED: } ", or " { $link POSTPONE: QUALIFIED-WITH: } "." } ;
|
||||
|
||||
|
|
|
@ -170,9 +170,6 @@ TUPLE: rename word vocab words ;
|
|||
: use-words ( assoc -- )
|
||||
<extra-words> qualified-vocabs push ;
|
||||
|
||||
: unuse-words ( assoc -- )
|
||||
<extra-words> qualified-vocabs remove! drop ;
|
||||
|
||||
TUPLE: ambiguous-use-error words ;
|
||||
|
||||
: <ambiguous-use-error> ( words -- error restarts )
|
||||
|
|
Loading…
Reference in New Issue