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

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

diff --git a/core/locals/parser/parser-docs.factor b/core/locals/parser/parser-docs.factor
index 9884ae07909a0736a92cddc9c803e2a4af80f80a..7d6d64bae210e32a5e37d6ba44d481d9b0c06d2b 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" "a " { $link def } " or a " { $link multi-def } }
+  { "def" 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 parse-multi-def parse-single-def }
+{ $subsections parse-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 df0466b8bc6877806b6500af942c3a2fd8e8909e..eaf39596fd6ef7a82be050edd70885e18f3be7a6 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
-        local>> name>>
+        locals>> first name>>
         qualified-vocabs last words>> keys "um" swap member?
     ] with-compilation-unit
 ] unit-test
@@ -58,15 +58,24 @@ 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> [ parse-multi-def ] with-lexer
+        { "( tok1 tok2 )" } <lexer> [ scan-token parse-def ] with-lexer
     ] with-compilation-unit
-    [ locals>> [ name>> ] map ] [ keys ] bi*
+    locals>> [ name>> ] map
 ] unit-test
 
 <<

diff --git a/core/locals/parser/parser.factor b/core/locals/parser/parser.factor
index 45dfaa815fdd01f84ba61d2c132149a2ca52e207..d30265dc9baa5ac502926a4bd28fa8d699429804 100644 (file)
--- a/core/locals/parser/parser.factor
+++ b/core/locals/parser/parser.factor
@@ -45,17 +45,12 @@ 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-multi-def ] [ parse-single-def ] if update-locals ;
+    dup "(" = [ drop ")" parse-tokens ] [ 1array ] if
+    make-locals [ <def> ] [ update-locals ] bi* ;
 
 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 71cc8bbf9503f998d2b0d1a19402a83cd98bde4c..7ec98af00f965b6be431437b9cebc7a5924a8050 100644 (file)
--- a/core/locals/rewrite/closures/closures.factor
+++ b/core/locals/rewrite/closures/closures.factor
@@ -20,9 +20,7 @@ GENERIC: defs-vars* ( seq form -- seq' )
 
 : defs-vars ( form -- vars ) { } [ defs-vars* ] reduce members ;
 
-M: def defs-vars* local>> unquote suffix ;
-
-M: multi-def defs-vars* locals>> [ unquote suffix ] each ;
+M: def defs-vars* locals>> [ unquote suffix ] each ;
 
 M: quotation defs-vars* [ defs-vars* ] each ;
 
@@ -50,7 +48,7 @@ M: callable rewrite-closures*
     ! onto the body
     dup free-vars [ <quote> ] map
     [ % ]
-    [ var-defs prepend (rewrite-closures) point-free , ]
+    [ [ <def> prefix ] unless-empty (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 090bc817b4563f9fb51f92aea4b80d61edd25aef..1174c536a8b005bb4b7151a9b48f7c2a8a3d6eac 100644 (file)
--- a/core/locals/rewrite/point-free/point-free.factor
+++ b/core/locals/rewrite/point-free/point-free.factor
@@ -28,16 +28,11 @@ 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 [ load-locals ] curry ] tri append ;
+    [ length dup 1 > [ [ load-locals ] curry ] [ drop [ load-local ] ] if ]
+    tri append ;
 
 M: object localize 1quotation ;
 

diff --git a/core/locals/rewrite/sugar/sugar.factor b/core/locals/rewrite/sugar/sugar.factor
index 5ce22c567f996e241fd00b78bd4c4dd5ce130fa1..60fd2f446ac1dcd1c11023f93a676ce40a4577c8 100644 (file)
--- a/core/locals/rewrite/sugar/sugar.factor
+++ b/core/locals/rewrite/sugar/sugar.factor
@@ -19,15 +19,8 @@ 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>> var-defs ] bi prepend quotation-rewrite ;
+    [ body>> ] [ vars>> [ <def> prefix ] unless-empty ] bi quotation-rewrite ;
 
 M: callable rewrite-sugar* quotation-rewrite , ;
 
@@ -104,8 +97,6 @@ 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 0d9ba3696251872d5ee175916db49245cdc122e8..f6db382ad7664b5166c0263faf6ef7cda4169fe7 100644 (file)
--- a/core/locals/types/types.factor
+++ b/core/locals/types/types.factor
@@ -18,19 +18,15 @@ C: <quote> quote
 
 : unquote ( quote -- local ) dup quote? [ local>> ] when ; inline
 
-TUPLE: def local ;
+TUPLE: def locals ;
 
 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
-    <uninterned-word>
+    f <word>
     dup t "local?" set-word-prop ;
 
 M: local literalize ;
@@ -38,7 +34,7 @@ M: local literalize ;
 PREDICATE: local-reader < word "local-reader?" word-prop ;
 
 : <local-reader> ( name -- word )
-    <uninterned-word>
+    f <word>
     dup t "local-reader?" set-word-prop ;
 
 M: local-reader literalize ;
@@ -46,7 +42,7 @@ M: local-reader literalize ;
 PREDICATE: local-writer < word "local-writer?" word-prop ;
 
 : <local-writer> ( reader -- word )
-    dup name>> "!" append <uninterned-word> {
+    dup name>> "!" append f <word> {
         [ nip t "local-writer?" set-word-prop ]
         [ swap "local-reader" set-word-prop ]
         [ "local-writer" set-word-prop ]