locals.parser: small refactorings and unit tests

basis/locals/parser/parser-tests.factor

@@ -0,0 +1,63 @@
+USING: accessors assocs compiler.units kernel lexer locals.backend
+locals.parser parser prettyprint sequences tools.test ;
+IN: locals.parser.tests
+
+SYMBOL: dobiedoo
+
+! (::)
+{
+    dobiedoo
+    [ 1 load-locals 1 drop-locals ]
+    ( x -- y )
+} [
+    [
+        { "dobiedoo ( x -- y ) ;" } <lexer> [ (::) ] with-lexer
+    ] with-compilation-unit
+] unit-test
+
+! ((parse-lambda))
+{
+    "V{ 99 :> kkk kkk }"
+} [
+    [ { "99 :> kkk kkk ;" } <lexer> [
+        H{ } clone [ \ ; parse-until ] ((parse-lambda)) ] with-lexer
+    ] with-compilation-unit unparse
+] unit-test
+
+! check-local-name
+{ "hello" } [
+    "hello" check-local-name
+] unit-test
+
+! make-locals
+{ { "a" "b" "c" } } [
+    [ { "a" "b" "c" } make-locals ] with-compilation-unit
+    nip values [ name>> ] map
+] unit-test
+
+! parse-def
+{ "um" { "um" } } [
+    [ "um" H{ } clone [ parse-def ] keep ] with-compilation-unit
+    [ local>> name>> ] [ keys ] bi*
+] unit-test
+
+! parse-local-defs
+{ { "tok1" "tok2" } } [
+    [
+        { "tok1 tok2 |" } <lexer> [ parse-local-defs ] with-lexer
+    ] with-compilation-unit
+    nip values [ name>> ] map
+] unit-test
+
+! parse-multi-def
+{
+    { "v1" "tok1" "tok2" }
+    { "tok1" "tok2" }
+} [
+    [
+        { "tok1 tok2 )" } <lexer> [
+            H{ { "v1" t } } clone dup parse-multi-def
+        ] with-lexer
+    ] with-compilation-unit
+    [ keys ] [ locals>> [ name>> ] map ] bi*
+] unit-test

basis/locals/parser/parser.factor

@@ -27,13 +27,13 @@ ERROR: invalid-local-name name ;
     [ [ make-local ] map ] H{ } make ;
 
 : parse-local-defs ( -- words assoc )
-    [ "|" [ make-local ] map-tokens ] H{ } make ;
+    "|" parse-tokens make-locals ;
 
 SINGLETON: lambda-parser
 
 SYMBOL: locals
 
-: ((parse-lambda)) ( assoc quot -- quot' )
+: ((parse-lambda)) ( assoc reader-quot -- quot )
     '[
         in-lambda? on
         lambda-parser quotation-parser set
@@ -51,14 +51,13 @@ SYMBOL: locals
     ?rewrite-closures ;
 
 : parse-multi-def ( locals -- multi-def )
-    [ [ ")" [ make-local ] map-tokens ] H{ } make ] dip
-    swap assoc-union! drop <multi-def> ;
+    ")" parse-tokens make-locals swapd assoc-union! drop <multi-def> ;
+
+: parse-single-def ( name locals -- def )
+    swap [ make-local ] H{ } make swapd assoc-union! drop <def> ;
 
 : parse-def ( name/paren locals -- def )
-    over "(" =
-    [ nip parse-multi-def ]
-    [ [ [ make-local ] H{ } make ] dip swap assoc-union! drop <def> ]
-    if ;
+    over "(" = [ nip parse-multi-def ] [ parse-single-def ] if ;
 
 M: lambda-parser parse-quotation ( -- quotation )
     H{ } clone (parse-lambda) ;
@@ -77,13 +76,13 @@ M: lambda-parser parse-quotation ( -- quotation )
     dup
     in>> [ dup pair? [ first ] when ] map make-locals ;
 
-: (parse-locals-definition) ( effect vars assoc reader -- word quot effect )
+: (parse-locals-definition) ( effect vars assoc reader-quot -- word quot effect )
     ((parse-lambda)) <lambda>
     [ nip "lambda" set-word-prop ]
     [ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ]
     [ drop nip ] 3tri ; inline
 
-: parse-locals-definition ( word reader -- word quot effect )
+: parse-locals-definition ( word reader-quot -- word quot effect )
     [ parse-locals ] dip (parse-locals-definition) ; inline
 
 : parse-locals-method-definition ( word reader -- word quot effect )