From 7cfa9d9518552217eeade998385da3565c366321 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 8 Nov 2014 18:14:50 -0800 Subject: [PATCH] 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. --- .../cfg/linearization/linearization.factor | 2 +- .../propagation/transforms/transforms.factor | 2 +- basis/game/input/xinput/xinput.factor | 2 +- basis/interpolate/interpolate.factor | 2 +- basis/sequences/unrolled/unrolled-docs.factor | 2 +- basis/shuffle/shuffle.factor | 9 +----- core/assocs/assocs-docs.factor | 22 ++++++++++++++- core/assocs/assocs-tests.factor | 28 +++++++++++++++++++ core/assocs/assocs.factor | 25 ++++++++++++++--- core/sequences/sequences-docs.factor | 21 +------------- core/sequences/sequences.factor | 6 ---- extra/assocs/extras/extras-tests.factor | 4 --- extra/assocs/extras/extras.factor | 8 ------ extra/classes/struct/vectored/vectored.factor | 2 +- .../cuda/demos/hello-world/hello-world.factor | 2 +- extra/euler/b-rep/b-rep.factor | 2 +- extra/math/matrices/laplace/laplace.factor | 2 +- extra/math/transforms/fft/fft.factor | 2 +- extra/project-euler/022/022.factor | 4 +-- extra/rosetta-code/bitmap/bitmap.factor | 2 +- .../adsoda/combinators/combinators.factor | 2 +- 21 files changed, 86 insertions(+), 65 deletions(-) diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index ee18394498..f7ccdefc12 100644 --- 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 a68e2b574f..7d836f4b59 100644 --- 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 c51ec1e098..bce908edc8 100644 --- 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 bed5b7416c..8a0b437970 100644 --- 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 3d41426f7c..c50cd5c7b6 100644 --- 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 7903924361..769576bb03 100644 --- 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 -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 368f370ec5..37371808f9 100644 --- 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 62218c8bdf..da1deb0d8a 100644 --- 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 7db91548bd..cf458c0700 100644 --- 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 1e85d4efeb..1bb69f422a 100644 --- 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 0cb5345134..8eaa62c43b 100644 --- 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 1b5a67d960..3af484b2b2 100644 --- 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 0b2aec41f0..5b1def17bc 100644 --- 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 53f9fce988..fff479b798 100644 --- 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 8a7adb7b4d..68c3064be1 100644 --- 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 e8d6e0af13..cb9a8ff19a 100644 --- 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 817fa89d9a..dcc6f39a1a 100644 --- 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 b887b55a53..3c76051c99 100644 --- 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 b548591b5e..a20d568c7b 100644 --- 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 3cac8cba12..114249ca38 100644 --- 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 52a5b83c51..8b0ceca0ab 100644 --- a/unmaintained/adsoda/combinators/combinators.factor +++ b/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 -- 2.34.1