steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make: allow make to be used to create assocs.

db4
John Benediktsson 2012-07-19 09:35:28 -07:00
parent e8c13ebe40
commit 3e19d9d18d
3 changed files with 40 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
core/make/make-docs.factor
View File

@ -1,6 +1,6 @@
IN: make IN: make
USING: help.markup help.syntax quotations sequences math.parser USING: assocs help.markup help.syntax kernel math.parser
kernel ; quotations sequences ;
ARTICLE: "make-philosophy" "Make philosophy" ARTICLE: "make-philosophy" "Make philosophy"
{ $heading "When to use make" } { $heading "When to use make" }
@ -73,3 +73,11 @@ HELP: ,
HELP: % HELP: %
{ $values { "seq" sequence } } { $values { "seq" sequence } }
{ $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ; { $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 } "." } ;

10
core/make/make-tests.factor Normal file
View File

@ -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

22
core/make/make.factor
View File

@ -1,11 +1,13 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences namespaces ; USING: assocs kernel sequences namespaces ;
IN: make IN: make
SYMBOL: building SYMBOL: building
: make ( quot exemplar -- seq ) <PRIVATE
: make-sequence ( quot exemplar -- seq )
[ [
[ [
32 swap new-resizable [ 32 swap new-resizable [
@ -14,6 +16,22 @@ SYMBOL: building
] keep like ] keep like
] with-scope ; inline ] 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 ; : , ( elt -- ) building get push ;
: % ( seq -- ) building get push-all ; : % ( seq -- ) building get push-all ;
: ,, ( value key -- ) building get set-at ;
: %% ( assoc -- ) building get swap assoc-union! drop ;