assocs: Make map-index-as support seq or assoc exemplars and move map-index, map...

assocs.extras: Remove zip-as and move tests to assocs.

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index ee18394498b1837795e713c5ab6e3f60d7c0d7c5..f7ccdefc129c8342d813b249f0c4cad812224ec4 100644 (file)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -87,4 +87,4 @@ SYMBOL: numbers
 : block-number ( bb -- n ) numbers get at ;
 
 : number-blocks ( bbs -- )
-    zip-index >hashtable numbers set ;
+    H{ } zip-index-as numbers set ;

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index a68e2b574fe977a2892ba4f78e437141d0682ca9..7d836f4b598fddeb312d1abe4d4b214e08829afa 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -218,7 +218,7 @@ ERROR: bad-partial-eval quot word ;
 \ index [
     dup sequence? [
         dup length 4 >= [
-            zip-index >hashtable '[ _ at ]
+            H{ } zip-index-as '[ _ at ]
         ] [ drop f ] if
     ] [ drop f ] if
 ] 1 define-partial-eval

diff --git a/basis/game/input/xinput/xinput.factor b/basis/game/input/xinput/xinput.factor
index c51ec1e09812c66863a3d228dd9149f9be235155..bce908edc8efbf307ec4486cc766d7638c24ac61 100644 (file)
--- a/basis/game/input/xinput/xinput.factor
+++ b/basis/game/input/xinput/xinput.factor
@@ -1,4 +1,4 @@
-USING: game.input math math.order kernel macros fry sequences quotations
+USING: assocs game.input math math.order kernel macros fry sequences quotations
 arrays windows.directx.xinput combinators accessors windows.types
 game.input.dinput sequences.private namespaces classes.struct
 windows.errors windows.com.syntax alien.strings ;

diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor
index bed5b7416c9e79586d327a3c48977505641267c8..8a0b43797034063472f25ed902b6b406d9520b01 100644 (file)
--- a/basis/interpolate/interpolate.factor
+++ b/basis/interpolate/interpolate.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays fry hashtables io kernel macros make
+USING: accessors arrays assocs fry hashtables io kernel macros make
 math.parser multiline namespaces present sequences
 sequences.generalizations splitting strings vocabs.parser ;
 IN: interpolate

diff --git a/basis/sequences/unrolled/unrolled-docs.factor b/basis/sequences/unrolled/unrolled-docs.factor
index 3d41426f7c0a63423cc8f5ab812bcc9fd48c289b..c50cd5c7b61c82a16cef8721c66ffa7027c0c600 100644 (file)
--- a/basis/sequences/unrolled/unrolled-docs.factor
+++ b/basis/sequences/unrolled/unrolled-docs.factor
@@ -1,5 +1,5 @@
 ! (c)2010 Joe Groff bsd license
-USING: help.markup help.syntax kernel math quotations sequences
+USING: assocs help.markup help.syntax kernel math quotations sequences
 sequences.private ;
 IN: sequences.unrolled
 

diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor
index 7903924361b906d4a25c77c0dfca8dcdcf6819f0..769576bb039fb73e16a2ea2ef1f06fbad91600bf 100644 (file)
--- a/basis/shuffle/shuffle.factor
+++ b/basis/shuffle/shuffle.factor
@@ -5,15 +5,8 @@ generalizations sequences.generalizations hashtables kernel
 locals locals.backend macros make math parser sequences ;
 IN: shuffle
 
-<PRIVATE
-
-: >index-assoc ( sequence -- assoc )
-    zip-index >hashtable ;
-
-PRIVATE>
-
 MACRO: shuffle-effect ( effect -- )
-    [ out>> ] [ in>> >index-assoc ] bi
+    [ out>> ] [ in>> H{ } zip-index-as ] bi
     [
         [ nip assoc-size , \ narray , ]
         [ [ at \ swap \ nth [ ] 3sequence ] curry map , \ cleave , ] 2bi

diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor
index 368f370ec529cc401b5427e158ebd28c5b3fd602..37371808f96b2139a17b7e1b0719a9599196ecec 100644 (file)
--- a/core/assocs/assocs-docs.factor
+++ b/core/assocs/assocs-docs.factor
@@ -530,7 +530,7 @@ HELP: zip
 HELP: zip-as
 { $values
      { "keys" sequence } { "values" sequence } { "exemplar" sequence }
-     { "obj" "a sequence of key/value pairs of type " { $snippet "exemplar" } } }
+     { "assoc" "a sequence of key/value pairs of type " { $snippet "exemplar" } } }
 { $description "Combines two sequences pairwise into a single sequence of key/value pairs of type " { $snippet "exemplar" } "." }
 { $notes "Exemplar must be a sequence type; hashtables will not work yet." }
 { $examples
@@ -568,4 +568,24 @@ HELP: zip-index-as
 }
 { $description "Zip a sequence with its index and return an associative list of type " { $snippet "exemplar" } " where the input sequence is the keys and the indices are the values." } ;
 
+HELP: map-index
+{ $values
+  { "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "newseq" sequence } }
+{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
+{ $examples { $example "USING: arrays assocs prettyprint ;"
+"{ 10 20 30 } [ 2array ] map-index ."
+"{ { 10 0 } { 20 1 } { 30 2 } }"
+} } ;
+
+HELP: map-index-as
+{ $values
+  { "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "exemplar" sequence } { "obj" object } }
+{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the " { $snippet "exemplar" } "." }
+{ $examples { $example "USING: arrays assocs prettyprint ;"
+"{ 10 20 30 } [ 2array ] V{ } map-index-as ."
+"V{ { 10 0 } { 20 1 } { 30 2 } }"
+} } ;
+{ map-index map-index-as } related-words
+
+
 { unzip zip zip-as zip-index zip-index-as } related-words

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 62218c8bdf6fd65177aa191ee4a2ce8d824d3cc4..da1deb0d8a6834c45273a1c2cc96a923ab90c8f2 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -213,6 +213,23 @@ unit-test
     { { 1 f } { f 2 } } sift-values
 ] unit-test
 
+! map-index, map-index-as
+{
+    { 11 23 35 }
+} [ { 11 22 33 } [ + ] map-index ] unit-test
+
+{
+    V{ 11 23 35 }
+} [ { 11 22 33 } [ + ] V{ } map-index-as ] unit-test
+
+{
+    B{ 11 23 35 }
+} [ { 11 22 33 } [ + ] B{ } map-index-as ] unit-test
+
+{
+    BV{ 11 23 35 }
+} [ { 11 22 33 } [ + ] BV{ } map-index-as ] unit-test
+
 ! zip, zip-as
 {
     { { 1 4 } { 2 5 } { 3 6 } }
@@ -234,6 +251,17 @@ unit-test
     V{ { 1 4 } { 2 5 } { 3 6 } }
 } [ BV{ 1 2 3 } BV{ 4 5 6 } V{ } zip-as ] unit-test
 
+{ { { 1 3 } { 2 4 } }
+} [ { 1 2 } { 3 4 } { } zip-as ] unit-test
+
+{
+    V{ { 1 3 } { 2 4 } }
+} [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
+
+{
+    H{ { 1 3 } { 2 4 } }
+} [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
+
 ! zip-index, zip-index-as
 {
     { { 11 0 } { 22 1 } { 33 2 } }

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 7db91548bdc5f4c533625fe029d9987ef55f0863..cf458c07001e5a43ec1d622215bf31dc4a9f220b 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -198,11 +198,28 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
 : push-at ( value key assoc -- )
     [ ?push ] change-at ;
 
-: zip-as ( keys values exemplar -- obj )
-    [ [ 2array ] ] dip 2map-as ; inline
+: zip-as ( keys values exemplar -- assoc )
+    dup sequence? [
+        [ 2array ] swap 2map-as
+    ] [
+        [ 2dup min-length ] dip new-assoc
+        [ [ set-at ] with-assoc 2each ] keep
+    ] if ; inline
+
+ : zip ( keys values -- alist )
+     { } zip-as ; inline
+
+: map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... obj )
+    dup sequence? [
+        [ dup length iota ] 2dip 2map-as
+    ] [
+        [ dup length iota ] 2dip [ over length ] dip new-assoc
+        ! Need to do 2array/first2 here because of quot's stack effect
+        [ [ [ first2 swap ] dip set-at ] curry compose 2each ] keep
+    ] if ; inline
 
-: zip ( keys values -- alist )
-    { } zip-as ; inline
+: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
+    { } map-index-as ; inline
 
 : zip-index-as ( values exemplar -- obj )
     [ [ 2array ] ] dip map-index-as ; inline

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 1e85d4efeb6fdc3c3c25183977c7db2387395dd4..1bb69f422a65f4707ffa4ffe23a879e46e55def0 100644 (file)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1,4 +1,4 @@
-USING: arrays generic.single help.markup help.syntax kernel
+USING: assocs arrays generic.single help.markup help.syntax kernel
 layouts math math.order quotations sequences.private vectors ;
 IN: sequences
 
@@ -365,25 +365,6 @@ HELP: each-index
 "{ 10 0 }\n{ 20 1 }\n{ 30 2 }"
 } } ;
 
-HELP: map-index
-{ $values
-  { "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "newseq" sequence } }
-{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
-{ $examples { $example "USING: arrays sequences prettyprint ;"
-"{ 10 20 30 } [ 2array ] map-index ."
-"{ { 10 0 } { 20 1 } { 30 2 } }"
-} } ;
-
-HELP: map-index-as
-{ $values
-  { "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "exemplar" sequence } { "newseq" sequence } }
-{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the " { $snippet "exemplar" } " sequence." }
-{ $examples { $example "USING: arrays sequences prettyprint ;"
-"{ 10 20 30 } [ 2array ] V{ } map-index-as ."
-"V{ { 10 0 } { 20 1 } { 30 2 } }"
-} } ;
-{ map-index map-index-as } related-words
-
 HELP: change-nth
 { $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" { $quotation ( ..a elt -- ..b newelt ) } } }
 { $description "Applies the quotation to the " { $snippet "i" } "th element of the sequence, storing the result back into the sequence." }

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 0cb534513414e750649ea8f7299dde0cc92ef041..8eaa62c43b514d2928647682fa815c459fdf4b99 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -578,12 +578,6 @@ PRIVATE>
         3bi
     ] if ; inline
 
-: map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
-    [ dup length iota ] 2dip 2map-as ; inline
-
-: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
-    { } map-index-as ; inline
-
 : reduce-index ( ... seq identity quot: ( ... prev elt index -- ... next ) -- ... result )
     swapd each-index ; inline
 

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 1b5a67d9607b55354d330f184025746ca073f7ea..3af484b2b26ebefb50ba83a3feefda9d6fc679a5 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -10,10 +10,6 @@ IN: assocs.extras
 { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-at ] unit-test
 { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-at ] unit-test
 
-{  { { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 }  { } zip-as ] unit-test
-{ V{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
-{ H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
-
 { H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
 
 [ H{ } ] [ { } assoc-merge ] unit-test

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 0b2aec41f038fffbee0d7b96e2f15789edf16488..5b1def17bc0519d14dd009b6c0616199c1e06b5e 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -14,14 +14,6 @@ IN: assocs.extras
 : deep-at ( assoc seq -- value/f )
     [ of ] each ; inline
 
-: zip-as ( keys values exemplar -- assoc )
-    dup sequence? [
-        [ 2array ] swap 2map-as
-    ] [
-        [ 2dup min-length ] dip new-assoc
-        [ [ set-at ] with-assoc 2each ] keep
-    ] if ; inline
-
 : substitute! ( seq assoc -- seq )
     substituter map! ;
 

diff --git a/extra/classes/struct/vectored/vectored.factor b/extra/classes/struct/vectored/vectored.factor
index 53f9fce988a5e0e18fd6a07027d9e19d9ad65142..fff479b7984305e25f275770903dbd38c6782911 100644 (file)
--- a/extra/classes/struct/vectored/vectored.factor
+++ b/extra/classes/struct/vectored/vectored.factor
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors classes.struct classes.tuple combinators fry
+USING: accessors assocs classes.struct classes.tuple combinators fry
 functors kernel locals macros math parser quotations sequences
 sequences.private slots specialized-arrays words ;
 IN: classes.struct.vectored

diff --git a/extra/cuda/demos/hello-world/hello-world.factor b/extra/cuda/demos/hello-world/hello-world.factor
index 8a7adb7b4deff499d7f8524ab08e30bf53acb2d9..68c3064be13bef654a7e9dd7fcc47e2319bed37e 100644 (file)
--- a/extra/cuda/demos/hello-world/hello-world.factor
+++ b/extra/cuda/demos/hello-world/hello-world.factor
@@ -3,7 +3,7 @@
 USING: accessors alien.c-types alien.strings byte-arrays cuda
 cuda.contexts cuda.devices cuda.libraries cuda.memory cuda.syntax
 destructors io io.encodings.string io.encodings.utf8 kernel locals
-math math.parser namespaces sequences strings ;
+math math.parser namespaces sequences strings assocs ;
 IN: cuda.demos.hello-world
 
 CUDA-LIBRARY: hello cuda32 vocab:cuda/demos/hello-world/hello.ptx

diff --git a/extra/euler/b-rep/b-rep.factor b/extra/euler/b-rep/b-rep.factor
index e8d6e0af13f1397ab824218ddba23ad03cfb6056..cb9a8ff19ad5354356720b4285d9ad135f16b6b6 100644 (file)
--- a/extra/euler/b-rep/b-rep.factor
+++ b/extra/euler/b-rep/b-rep.factor
@@ -5,7 +5,7 @@ math math.vectors math.matrices assocs arrays hashtables ;
 FROM: namespaces => set ;
 IN: euler.b-rep
 
-: >index-hash ( seq -- hash ) zip-index >hashtable ; inline
+: >index-hash ( seq -- hash ) H{ } zip-index-as ; inline
 
 TUPLE: b-edge < edge sharpness macro ;
 

diff --git a/extra/math/matrices/laplace/laplace.factor b/extra/math/matrices/laplace/laplace.factor
index 817fa89d9a9845bc1a2f5949f13aee3691d8c740..dcc6f39a1a9486df902430272c419dda49e9bf23 100644 (file)
--- a/extra/math/matrices/laplace/laplace.factor
+++ b/extra/math/matrices/laplace/laplace.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays fry kernel locals math math.matrices
+USING: accessors arrays assocs fry kernel locals math math.matrices
 math.vectors sequences sequences.private ;
 IN: math.matrices.laplace
 

diff --git a/extra/math/transforms/fft/fft.factor b/extra/math/transforms/fft/fft.factor
index b887b55a5345fe405a7caf2624625721dd96dfe2..3c76051c990153c68117aec419886c40e502fcb8 100644 (file)
--- a/extra/math/transforms/fft/fft.factor
+++ b/extra/math/transforms/fft/fft.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel locals math math.constants math.functions
+USING: arrays assocs kernel locals math math.constants math.functions
 math.vectors sequences sequences.extras sequences.private ;
 IN: math.transforms.fft
 

diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor
index b548591b5e3ba6eff89a05315a6afd883169bfc0..a20d568c7b5aab7d6ac765a43c3a92e6a699f83e 100644 (file)
--- a/extra/project-euler/022/022.factor
+++ b/extra/project-euler/022/022.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ascii io.encodings.ascii io.files kernel math project-euler.common
-    sequences sorting splitting ;
+USING: ascii assocs io.encodings.ascii io.files kernel math
+project-euler.common sequences sorting splitting ;
 IN: project-euler.022
 
 ! http://projecteuler.net/index.php?section=problems&id=22

diff --git a/extra/rosetta-code/bitmap/bitmap.factor b/extra/rosetta-code/bitmap/bitmap.factor
index 3cac8cba12e1e827ac6842b15824ebf08cbe087d..114249ca3807827f11fdaf27de9e24c7c6ae94ed 100644 (file)
--- a/extra/rosetta-code/bitmap/bitmap.factor
+++ b/extra/rosetta-code/bitmap/bitmap.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2012 Anonymous
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays fry kernel math.matrices sequences ;
+USING: arrays assocs fry kernel math.matrices sequences ;
 IN: rosetta-code.bitmap
 
 ! http://rosettacode.org/wiki/Basic_bitmap_storage

diff --git a/unmaintained/adsoda/combinators/combinators.factor b/unmaintained/adsoda/combinators/combinators.factor
index 52a5b83c5180e3dc7a2c2d2dc0ac441fb6163c49..8b0ceca0abbf062831295757a7d4ae41c9f14be1 100644 (file)
--- a/unmaintained/adsoda/combinators/combinators.factor
+++ b/unmaintained/adsoda/combinators/combinators.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Jeff Bigot\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel arrays sequences fry math combinators ;\r
+USING: kernel arrays assocs sequences fry math combinators ;\r
 \r
 IN: adsoda.combinators\r
 \r