make: allow make to be used to create assocs.

diff --git a/core/make/make-docs.factor b/core/make/make-docs.factor
index 2a74af7049bbe4be9ac69a9503d3c8c16d028234..dfe23e0d1507fc3114ba7ebe73fa3030b99f2509 100644 (file)
--- a/core/make/make-docs.factor
+++ b/core/make/make-docs.factor
@@ -1,6 +1,6 @@
 IN: make
-USING: help.markup help.syntax quotations sequences math.parser
-kernel ;
+USING: assocs help.markup help.syntax kernel math.parser
+quotations sequences ;
 
 ARTICLE: "make-philosophy" "Make philosophy"
 { $heading "When to use make" }
@@ -73,3 +73,11 @@ HELP: ,
 HELP: %
 { $values { "seq" sequence } }
 { $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ;
+
+HELP: ,,
+{ $values { "value" object } { "key" object } }
+{ $description "Stores the key/value pair into the assoc being constructed by " { $link make } "." } ;
+
+HELP: %%
+{ $values { "assoc" assoc } }
+{ $description "Adds all entries from " { $snippet "assoc" } " to the assoc being constructed by " { $link make } "." } ;

diff --git a/core/make/make-tests.factor b/core/make/make-tests.factor
new file mode 100644 (file)
index 0000000..cb05afe
--- /dev/null
+++ b/core/make/make-tests.factor
@@ -0,0 +1,10 @@
+
+USING: make sequences tools.test ;
+IN: make
+
+{ "ABCD" } [ [ "ABCD" [ , ] each ] "" make ] unit-test
+
+{ H{ { "key" "value" } } }
+[ [ "value" "key" ,, ] H{ } make ] unit-test
+
+{ { { 1 2 } } } [ [ 2 1 ,, ] { } make ] unit-test

diff --git a/core/make/make.factor b/core/make/make.factor
index 02c96bf3cf43b90c36f33b8b11d3f6712eedddb0..4bccf0d7ab32f5540aaf74db25768d1717d5ff7d 100644 (file)
--- a/core/make/make.factor
+++ b/core/make/make.factor
@@ -1,11 +1,13 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces ;
+USING: assocs kernel sequences namespaces ;
 IN: make
 
 SYMBOL: building
 
-: make ( quot exemplar -- seq )
+<PRIVATE
+
+: make-sequence ( quot exemplar -- seq )
     [
         [
             32 swap new-resizable [
@@ -14,6 +16,22 @@ SYMBOL: building
         ] keep like
     ] with-scope ; inline
 
+: make-assoc ( quot exemplar -- assoc )
+    [
+        20 swap new-assoc [
+            building set call
+        ] keep
+    ] with-scope ; inline
+
+PRIVATE>
+
+: make ( quot exemplar -- seq )
+    dup sequence? [ make-sequence ] [ make-assoc ] if ; inline
+
 : , ( elt -- ) building get push ;
 
 : % ( seq -- ) building get push-all ;
+
+: ,, ( value key -- ) building get set-at ;
+
+: %% ( assoc -- ) building get swap assoc-union! drop ;