From 7fda5ce34f6a218675a18efefad5cd87530f7303 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 25 Aug 2022 18:16:49 -0400 Subject: [PATCH] sequences: fix stack orders and move unit test --- core/sequences/sequences-tests.factor | 14 -------------- extra/sequences/extras/extras-tests.factor | 18 ++++++++++++++++-- extra/sequences/extras/extras.factor | 3 +++ 3 files changed, 19 insertions(+), 16 deletions(-) diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 6d0a132139..cb81cc16da 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -29,14 +29,6 @@ IN: sequences.tests [ 1 [ [ * ] [ + ] bi* ] reduce-index ] bi@ ] unit-test -{ 21 } [ - { 1 2 3 } { 4 5 6 } 0 [ + + ] [ 0 ] 4dip 2reduce-from -] unit-test - -{ 16 } [ - { 1 2 3 } { 4 5 6 } 0 [ + + ] [ 1 ] 4dip 2reduce-from -] unit-test - { -541365 } [ { 10 21 32 } { 500 600 700 } [ - sq ] [ - ] 2map-reduce ] unit-test @@ -444,12 +436,6 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ; BV{ 11 23 35 } } [ { 11 22 33 } [ + ] BV{ } map-index-as ] unit-test -{ { 0 400 900 } } -[ { 10 20 30 } [ sq ] 1 map-from ] unit-test - -{ V{ 0 400 900 } } -[ { 10 20 30 } [ sq ] 1 V{ } map-from-as ] unit-test - { t } [ { } { 99 88 } [ <= ] 2all? ] unit-test { f } [ { } { 99 88 } [ <= ] 2any? ] unit-test diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 3cc68c9515..18beca57b3 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -113,6 +113,16 @@ strings tools.test ; { "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test { { 0 4 16 36 64 } } [ 10 [ sq ] [ even? ] { } map-filter-as ] unit-test +{ 120000 } [ { 10 20 30 40 50 60 } 1 [ * ] 3 reduce-from ] unit-test + +{ 21 } [ + { 1 2 3 } { 4 5 6 } 0 [ + + ] 0 2reduce-from +] unit-test + +{ 16 } [ + { 1 2 3 } { 4 5 6 } 0 [ + + ] 1 2reduce-from +] unit-test + { V{ 0 4 16 36 64 } } [ 10 [ even? ] [ sq ] filter-map ] unit-test { { 2 6 10 14 18 } } [ 10 [ odd? ] [ 2 * ] { } filter-map-as ] unit-test @@ -208,6 +218,12 @@ strings tools.test ; { t 3 3 } [ 10 [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test { f f f } [ 10 [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test +{ { 0 400 900 } } +[ { 10 20 30 } [ sq ] 1 map-from ] unit-test + +{ V{ f 400 900 } } +[ { 10 20 30 } [ sq ] 1 V{ } map-from-as ] unit-test + { "abcdef" } [ f f "abcdef" subseq* ] unit-test { "abcdef" } [ 0 f "abcdef" subseq* ] unit-test { "ab" } [ f 2 "abcdef" subseq* ] unit-test @@ -243,8 +259,6 @@ strings tools.test ; { 1 } [ "ABABA" "ABA" count-subseq ] unit-test { 2 } [ "ABABA" "ABA" count-subseq* ] unit-test -{ 120000 } [ { 10 20 30 40 50 60 } 1 [ * ] 3 reduce-from ] unit-test - { 0 } [ { } [ + ] 0reduce ] unit-test { 107 } [ { 100 1 2 4 } [ + ] 0reduce ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index f5a2a81823..71a3beb15a 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -281,6 +281,9 @@ PRIVATE> : reduce-from ( ... seq identity quot: ( ... prev elt -- ... next ) from -- ... result ) [ swap ] 2dip each-from ; inline +: 2reduce-from ( ... seq1 seq2 identity quot: ( ... prev elt1 elt2 -- ... next ) i -- ... result ) + [ -rot ] 2dip 2each-from ; inline + : 0accumulate-as ( ... seq quot: ( ... prev elt -- ... next ) exemplar -- ... newseq ) pick empty? [ 2nip clone -- 2.34.1