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.

basis/functors/functors.factor

@@ -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*
+    [ [ \ ;FUNCTOR parse-until >quotation ] with-lambda-scope ] bi*
-    [ ] append-as
+    [ ] append-as ;
-    pop-functor-words ;
 
 : (FUNCTOR:) ( -- word def effect )
     scan-new-word [ parse-functor-body ] parse-locals-definition ;

basis/locals/parser/parser-tests.factor

@@ -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
+>>

basis/locals/parser/parser.factor

@@ -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

core/vocabs/parser/parser-docs.factor

@@ -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: } "." } ;
 

core/vocabs/parser/parser.factor

@@ -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 )