assocs: Make map-index-as support seq or assoc exemplars and move map-index, map-index-as to assocs because they need to use new-assoc. Make zip-index-as support assoc exemplars. Fix up docs and tests.

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

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 ;

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

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 ;

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

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
 

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

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

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

core/assocs/assocs.factor

@@ -198,12 +198,29 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
 : push-at ( value key assoc -- )
     [ ?push ] change-at ;
 
-: zip-as ( keys values exemplar -- obj )
+: zip-as ( keys values exemplar -- assoc )
-    [ [ 2array ] ] dip 2map-as ; inline
+    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
+
+: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
+    { } map-index-as ; inline
+
 : zip-index-as ( values exemplar -- obj )
     [ [ 2array ] ] dip map-index-as ; inline
 

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." }

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
 

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

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! ;
 

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

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

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 ;
 

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
 

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
 

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
+USING: ascii assocs io.encodings.ascii io.files kernel math
-    sequences sorting splitting ;
+project-euler.common sequences sorting splitting ;
 IN: project-euler.022
 
 ! http://projecteuler.net/index.php?section=problems&id=22

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

unmaintained/adsoda/combinators/combinators.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Jeff Bigot
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays sequences fry math combinators ;
+USING: kernel arrays assocs sequences fry math combinators ;
 
 IN: adsoda.combinators