From 976961bfbdf3581ebb2b825de9b643108bd043f0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 22 Jun 2015 10:53:03 +0200
Subject: [PATCH] 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          | 14 +++-------
 basis/locals/parser/parser-tests.factor | 34 ++++++++++++++++---------
 basis/locals/parser/parser.factor       |  9 ++++---
 core/vocabs/parser/parser-docs.factor   |  5 ----
 core/vocabs/parser/parser.factor        |  3 ---
 5 files changed, 30 insertions(+), 35 deletions(-)

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 5f7eabe040..104e4666ec 100644
--- a/basis/functors/functors.factor
+++ b/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*
-    [ ] 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 ;
diff --git a/basis/locals/parser/parser-tests.factor b/basis/locals/parser/parser-tests.factor
index 316715f926..dca8a9bff7 100644
--- a/basis/locals/parser/parser-tests.factor
+++ b/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
+>>
diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index ba7c89110d..84ca8da4c6 100644
--- a/basis/locals/parser/parser.factor
+++ b/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
diff --git a/core/vocabs/parser/parser-docs.factor b/core/vocabs/parser/parser-docs.factor
index 9f60f79047..95e1c81095 100644
--- a/core/vocabs/parser/parser-docs.factor
+++ b/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: } "." } ;
 
diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index 3751db3fba..a4f59bdc61 100644
--- a/core/vocabs/parser/parser.factor
+++ b/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 )