Revert "locals: simplify by merging <def> and <multi-def>."

This reverts commit 49f09dee42dcd2b66279d9393add51fd9285a912.

diff --git a/basis/locals/prettyprint/prettyprint.factor b/basis/locals/prettyprint/prettyprint.factor
index 14c12292f183d99fbfc2a441cee05304f3d9513b..ac72801d91fc1cafc197e1a79e3f6a9ef8085d6b 100644 (file)
--- a/basis/locals/prettyprint/prettyprint.factor
+++ b/basis/locals/prettyprint/prettyprint.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel locals locals.types math
-prettyprint.backend prettyprint.custom prettyprint.sections
-sequences words ;
+USING: accessors kernel locals locals.types prettyprint.backend
+prettyprint.custom prettyprint.sections sequences words ;
 IN: locals.prettyprint
 
 : pprint-var ( var -- )
@@ -31,10 +30,11 @@ M: lambda pprint*
 M: let pprint* \ [let pprint-let ;
 
 M: def pprint*
-    dup locals>> [ word? ] all? [
-        <block \ :> pprint-word locals>> {
-            [ length 1 > [ "(" text ] when ]
-            [ [ pprint-var ] each ]
-            [ length 1 > [ ")" text ] when ]
-        } cleave block>
-    ] [ pprint-tuple ] if ;
+    dup local>> word?
+    [ <block \ :> pprint-word local>> pprint-var block> ]
+    [ pprint-tuple ] if ;
+
+M: multi-def pprint*
+    dup locals>> [ word? ] all?
+    [ <block \ :> pprint-word "(" text locals>> [ pprint-var ] each ")" text block> ]
+    [ pprint-tuple ] if ;

diff --git a/core/locals/parser/parser-docs.factor b/core/locals/parser/parser-docs.factor
index 7d6d64bae210e32a5e37d6ba44d481d9b0c06d2b..9884ae07909a0736a92cddc9c803e2a4af80f80a 100644 (file)
--- a/core/locals/parser/parser-docs.factor
+++ b/core/locals/parser/parser-docs.factor
@@ -8,7 +8,7 @@ HELP: in-lambda?
 HELP: parse-def
 { $values
   { "name/paren" string }
-  { "def" def }
+  { "def" "a " { $link def } " or a " { $link multi-def } }
 }
 { $description "Parses the lexical variable bindings following a " { $link POSTPONE: :> } " token." } ;
 
@@ -20,7 +20,7 @@ ARTICLE: "locals.parser" "Utility words used by locals parsing words"
 "Words for parsing local words."
 $nl
 "Words for parsing variable assignments:"
-{ $subsections parse-def }
+{ $subsections parse-def parse-multi-def parse-single-def }
 "Parsers for word and method definitions:"
 { $subsections (::) (M::) } ;
 

diff --git a/core/locals/parser/parser-tests.factor b/core/locals/parser/parser-tests.factor
index eaf39596fd6ef7a82be050edd70885e18f3be7a6..df0466b8bc6877806b6500af942c3a2fd8e8909e 100644 (file)
--- a/core/locals/parser/parser-tests.factor
+++ b/core/locals/parser/parser-tests.factor
@@ -33,7 +33,7 @@ IN: locals.parser.tests
 { "um" t } [
     [
         "um" parse-def
-        locals>> first name>>
+        local>> name>>
         qualified-vocabs last words>> keys "um" swap member?
     ] with-compilation-unit
 ] unit-test
@@ -58,24 +58,15 @@ IN: locals.parser.tests
     nip values [ name>> ] map
 ] unit-test
 
-! parse-single-def
-{
-    { "tok1" }
-} [
-    [
-        { "tok1" } <lexer> [ scan-token parse-def ] with-lexer
-    ] with-compilation-unit
-    locals>> [ name>> ] map
-] unit-test
-
 ! parse-multi-def
 {
     { "tok1" "tok2" }
+    { "tok1" "tok2" }
 } [
     [
-        { "( tok1 tok2 )" } <lexer> [ scan-token parse-def ] with-lexer
+        { "tok1 tok2 )" } <lexer> [ parse-multi-def ] with-lexer
     ] with-compilation-unit
-    locals>> [ name>> ] map
+    [ locals>> [ name>> ] map ] [ keys ] bi*
 ] unit-test
 
 <<

diff --git a/core/locals/parser/parser.factor b/core/locals/parser/parser.factor
index d30265dc9baa5ac502926a4bd28fa8d699429804..45dfaa815fdd01f84ba61d2c132149a2ca52e207 100644 (file)
--- a/core/locals/parser/parser.factor
+++ b/core/locals/parser/parser.factor
@@ -45,12 +45,17 @@ SINGLETON: lambda-parser
     (parse-lambda) <lambda>
     ?rewrite-closures ;
 
+: parse-multi-def ( -- multi-def assoc )
+    ")" parse-tokens make-locals [ <multi-def> ] dip ;
+
+: parse-single-def ( name -- def assoc )
+    [ make-local <def> ] H{ } make ;
+
 : update-locals ( assoc -- )
     qualified-vocabs last words>> swap assoc-union! drop ;
 
 : parse-def ( name/paren -- def )
-    dup "(" = [ drop ")" parse-tokens ] [ 1array ] if
-    make-locals [ <def> ] [ update-locals ] bi* ;
+    dup "(" = [ drop parse-multi-def ] [ parse-single-def ] if update-locals ;
 
 M: lambda-parser parse-quotation
     H{ } clone (parse-lambda) ;

diff --git a/core/locals/rewrite/closures/closures.factor b/core/locals/rewrite/closures/closures.factor
index 7ec98af00f965b6be431437b9cebc7a5924a8050..71cc8bbf9503f998d2b0d1a19402a83cd98bde4c 100644 (file)
--- a/core/locals/rewrite/closures/closures.factor
+++ b/core/locals/rewrite/closures/closures.factor
@@ -20,7 +20,9 @@ GENERIC: defs-vars* ( seq form -- seq' )
 
 : defs-vars ( form -- vars ) { } [ defs-vars* ] reduce members ;
 
-M: def defs-vars* locals>> [ unquote suffix ] each ;
+M: def defs-vars* local>> unquote suffix ;
+
+M: multi-def defs-vars* locals>> [ unquote suffix ] each ;
 
 M: quotation defs-vars* [ defs-vars* ] each ;
 
@@ -48,7 +50,7 @@ M: callable rewrite-closures*
     ! onto the body
     dup free-vars [ <quote> ] map
     [ % ]
-    [ [ <def> prefix ] unless-empty (rewrite-closures) point-free , ]
+    [ var-defs prepend (rewrite-closures) point-free , ]
     [ length \ curry <repetition> % ]
     tri ;
 

diff --git a/core/locals/rewrite/point-free/point-free.factor b/core/locals/rewrite/point-free/point-free.factor
index 1174c536a8b005bb4b7151a9b48f7c2a8a3d6eac..090bc817b4563f9fb51f92aea4b80d61edd25aef 100644 (file)
--- a/core/locals/rewrite/point-free/point-free.factor
+++ b/core/locals/rewrite/point-free/point-free.factor
@@ -28,11 +28,16 @@ M: local-writer localize
     read-local-quot [ set-local-value ] append ;
 
 M: def localize
+    local>>
+    [ prefix ]
+    [ local-reader? [ 1array load-local ] [ load-local ] ? ]
+    bi ;
+
+M: multi-def localize
     locals>> <reversed>
     [ prepend ]
     [ [ [ local-reader? ] dip '[ [ 1array ] _ [ndip] ] [ [ ] ] if ] map-index concat ]
-    [ length dup 1 > [ [ load-locals ] curry ] [ drop [ load-local ] ] if ]
-    tri append ;
+    [ length [ load-locals ] curry ] tri append ;
 
 M: object localize 1quotation ;
 

diff --git a/core/locals/rewrite/sugar/sugar.factor b/core/locals/rewrite/sugar/sugar.factor
index 60fd2f446ac1dcd1c11023f93a676ce40a4577c8..5ce22c567f996e241fd00b78bd4c4dd5ce130fa1 100644 (file)
--- a/core/locals/rewrite/sugar/sugar.factor
+++ b/core/locals/rewrite/sugar/sugar.factor
@@ -19,8 +19,15 @@ GENERIC: quotation-rewrite ( form -- form' )
 
 M: callable quotation-rewrite [ [ rewrite-sugar* ] each ] [ ] make ;
 
+: var-defs ( vars -- defs )
+    dup length 1 > [
+        <multi-def> 1quotation
+    ] [
+        <reversed> [ <def> ] [ ] map-as
+    ] if ;
+
 M: lambda quotation-rewrite
-    [ body>> ] [ vars>> [ <def> prefix ] unless-empty ] bi quotation-rewrite ;
+    [ body>> ] [ vars>> var-defs ] bi prepend quotation-rewrite ;
 
 M: callable rewrite-sugar* quotation-rewrite , ;
 
@@ -97,6 +104,8 @@ M: tuple rewrite-sugar* rewrite-element ;
 
 M: def rewrite-sugar* , ;
 
+M: multi-def rewrite-sugar* , ;
+
 M: hashtable rewrite-sugar* rewrite-element ;
 
 M: wrapper rewrite-sugar*

diff --git a/core/locals/types/types.factor b/core/locals/types/types.factor
index f6db382ad7664b5166c0263faf6ef7cda4169fe7..0d9ba3696251872d5ee175916db49245cdc122e8 100644 (file)
--- a/core/locals/types/types.factor
+++ b/core/locals/types/types.factor
@@ -18,15 +18,19 @@ C: <quote> quote
 
 : unquote ( quote -- local ) dup quote? [ local>> ] when ; inline
 
-TUPLE: def locals ;
+TUPLE: def local ;
 
 C: <def> def
 
+TUPLE: multi-def locals ;
+
+C: <multi-def> multi-def
+
 PREDICATE: local < word "local?" word-prop ;
 
 : <local> ( name -- word )
     ! Create a local variable identifier
-    f <word>
+    <uninterned-word>
     dup t "local?" set-word-prop ;
 
 M: local literalize ;
@@ -34,7 +38,7 @@ M: local literalize ;
 PREDICATE: local-reader < word "local-reader?" word-prop ;
 
 : <local-reader> ( name -- word )
-    f <word>
+    <uninterned-word>
     dup t "local-reader?" set-word-prop ;
 
 M: local-reader literalize ;
@@ -42,7 +46,7 @@ M: local-reader literalize ;
 PREDICATE: local-writer < word "local-writer?" word-prop ;
 
 : <local-writer> ( reader -- word )
-    dup name>> "!" append f <word> {
+    dup name>> "!" append <uninterned-word> {
         [ nip t "local-writer?" set-word-prop ]
         [ swap "local-reader" set-word-prop ]
         [ "local-writer" set-word-prop ]