From c33c2a6e857a960846b8fdfd383c498b93766515 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Jul 2022 09:56:48 -0500 Subject: [PATCH] core: Better names for (each) etc --- basis/grouping/grouping.factor | 6 +- basis/math/matrices/matrices.factor | 2 +- core/growable/growable.factor | 2 +- core/io/streams/sequence/sequence.factor | 2 +- core/sequences/sequences.factor | 70 +++++++++++++----------- extra/sequences/extras/extras.factor | 4 +- 6 files changed, 46 insertions(+), 40 deletions(-) diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 43916ab8d9..5da027efd6 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -74,8 +74,10 @@ PRIVATE> 2 = [ [ first2-unsafe ] dip call ] [ - [ [ first-unsafe 1 ] [ setup-each [ + ] 2dip ] bi ] dip - '[ @ _ keep swap ] all-integers-from? nip + [ + [ first-unsafe ] + [ >range-iterator< [ nth-unsafe ] curry [ 1 + ] 2dip ] bi + ] dip '[ @ _ keep swap ] all-integers-from? nip ] if ] if ; inline diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index cfbee2962c..68dbd7c97d 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -122,7 +122,7 @@ ALIAS: transpose flip : unshaped-cols-iota ( matrix -- cols-iota ) [ first-unsafe length ] keep - [ length min ] 1 (each-from) each-integer-from ; inline + [ length min ] 1 sequence-iterator-from each-integer-from ; inline : generic-anti-transpose-unsafe ( cols-iota matrix -- newmatrix ) [ [ nth-end-unsafe ] with { } map-as ] curry { } map-as ; inline diff --git a/core/growable/growable.factor b/core/growable/growable.factor index f2662ddfe7..c248aff208 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -21,7 +21,7 @@ M: growable set-nth-unsafe underlying>> set-nth-unsafe ; inline : push-all-unsafe ( from to src dst -- ) [ over - swap ] 2dip pickd [ length integer>fixnum-strict ] keep - [ [ fixnum+fast ] dip length<< ] 2keep (copy) drop ; inline + [ [ fixnum+fast ] dip length<< ] 2keep (copy) drop ; inline PRIVATE> diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor index 461df22cd9..8326e25a8a 100644 --- a/core/io/streams/sequence/sequence.factor +++ b/core/io/streams/sequence/sequence.factor @@ -21,7 +21,7 @@ SLOT: i [ underlying>> length ] [ i>> ] bi - rot min ; inline : ( dst n src-i src dst-i -- n copy ) - [ ] curry 3curry dip ; inline + [ ] curry 3curry dip ; inline : sequence-copy-unsafe ( n buf stream offset -- count ) [ diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 1891149396..a7b7713379 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -218,6 +218,9 @@ TUPLE: slice { to integer read-only } { seq read-only } ; +: >slice< ( slice -- from to seq ) + [ from>> ] [ to>> ] [ seq>> ] tri ; inline + : collapse-slice ( m n slice -- m' n' seq ) [ from>> ] [ seq>> ] bi [ [ + ] curry bi@ ] dip ; inline @@ -282,13 +285,22 @@ ERROR: integer-length-expected obj ; : check-length ( n -- n ) dup integer? [ integer-length-expected ] unless ; inline -TUPLE: copy-state +: >sequence< ( seq -- i n seq ) + [ drop 0 ] [ length check-length ] [ ] tri ; inline + +: length-sequence ( seq -- n seq ) + [ length check-length ] [ ] bi ; inline + +: >range-iterator< ( slice/seq -- i n slice/seq ) + dup slice? [ >slice< ] [ >sequence< ] if ; inline + +TUPLE: copier { src-i integer read-only } { src read-only } { dst-i integer read-only } { dst read-only } ; -C: copy-state +C: copier : copy-nth-unsafe ( n copy -- ) [ [ src-i>> + ] [ src>> ] bi nth-unsafe ] @@ -301,7 +313,7 @@ C: copy-state : subseq>copy ( from to seq -- n copy ) [ over - check-length swap ] dip - 3dup nip new-sequence 0 swap ; inline + 3dup nip new-sequence 0 swap ; inline : bounds-check-head ( n seq -- n seq ) over 0 < [ bounds-error ] when ; inline @@ -311,7 +323,7 @@ C: copy-state [ swap length + ] dip lengthen ; inline : copy-unsafe ( src i dst -- ) - [ [ length check-length 0 ] keep ] 2dip (copy) drop ; inline + [ [ length check-length 0 ] keep ] 2dip (copy) drop ; inline : subseq-unsafe-as ( from to seq exemplar -- subseq ) [ subseq>copy (copy) ] dip like ; inline @@ -397,36 +409,28 @@ PRIVATE> > ] [ to>> ] [ seq>> ] tri - ] [ - [ length check-length 0 swap ] keep - ] if [ nth-unsafe ] curry ; inline +: sequence-iterator ( seq quot -- i n quot' ) + [ >range-iterator< [ nth-unsafe ] curry ] dip compose ; inline -: (each) ( seq quot -- i n quot' ) - [ setup-each ] dip compose ; inline +! setup-1each +: length-iterator ( seq quot -- n quot' ) + length-sequence [ nth-unsafe ] curry ; inline -: (each-from) ( seq quot i -- i n quot' ) - [ (each) ] dip [ + ] curry 2dip ; inline +! (1each) +: length-operator ( seq quot -- n quot' ) + [ length-iterator ] dip compose ; inline -: (collect) ( quot into -- quot' ) - [ [ keep ] dip set-nth-unsafe ] 2curry ; inline +: sequence-iterator-from ( seq quot i -- i n quot' ) + -rot length-operator ; inline : collect ( n quot into -- ) - (collect) each-integer ; inline - -: setup-1each ( seq -- n quot ) - [ length check-length ] keep [ nth-unsafe ] curry ; inline - -: (1each) ( seq quot -- n quot' ) - [ setup-1each ] dip compose ; inline + [ [ keep ] dip set-nth-unsafe ] 2curry each-integer ; inline -: (each-index) ( seq quot -- n quot' ) - [ setup-1each [ keep ] curry ] dip compose ; inline +: sequence-index-iterator ( seq quot -- n quot' ) + [ length-iterator [ keep ] curry ] dip compose ; inline : map-into ( seq quot into -- ) - [ (1each) ] dip collect ; inline + [ length-operator ] dip collect ; inline : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 ) [ nth-unsafe ] bi-curry@ bi ; inline @@ -451,14 +455,14 @@ PRIVATE> over [ dupd nth-unsafe ] [ drop f ] if ; inline : (find) ( seq quot quot' -- i elt ) - pick [ [ (1each) ] dip call ] dip finish-find ; inline + pick [ [ length-operator ] dip call ] dip finish-find ; inline : (find-from) ( n seq quot quot' -- i elt ) [ 2dup bounds-check? ] 2dip '[ _ _ (find) ] [ 2drop f f ] if ; inline : (find-index) ( seq quot quot' -- i elt ) - pick [ [ (each-index) ] dip call ] dip finish-find ; inline + pick [ [ sequence-index-iterator ] dip call ] dip finish-find ; inline : (find-index-from) ( n seq quot quot' -- i elt ) [ 2dup bounds-check? ] 2dip @@ -473,10 +477,10 @@ PRIVATE> PRIVATE> : each ( ... seq quot: ( ... x -- ... ) -- ... ) - (each) each-integer-from ; inline + sequence-iterator each-integer-from ; inline : each-from ( ... seq quot: ( ... x -- ... ) i -- ... ) - (each-from) each-integer-from ; inline + sequence-iterator-from each-integer-from ; inline : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result ) swapd each ; inline @@ -485,7 +489,7 @@ PRIVATE> overd [ [ collect ] keep ] new-like ; inline : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq ) - [ (1each) ] dip map-integers ; inline + [ length-operator ] dip map-integers ; inline : map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq ) over map-as ; inline @@ -566,7 +570,7 @@ PRIVATE> [ find-integer ] (find-index) ; inline : all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) - (each) all-integers-from? ; inline + sequence-iterator all-integers-from? ; inline : push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b ) [ keep ] dip rot [ push ] [ 2drop ] if ; inline @@ -627,7 +631,7 @@ PRIVATE> [ dup ] swap [ keep ] curry produce nip ; inline : each-index ( ... seq quot: ( ... elt index -- ... ) -- ... ) - (each-index) each-integer ; inline + sequence-index-iterator each-integer ; inline : map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq ) [ dup length ] 2dip 2map-as ; inline diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 334f352638..830dedb997 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -384,7 +384,7 @@ PRIVATE> ] [ 3drop f ] if ; inline : map-index! ( ... seq quot: ( ... elt index -- ... newelt ) -- ... seq ) - over [ [ (each-index) ] dip collect ] keep ; inline + over [ [ sequence-index-iterator ] dip collect ] keep ; inline [ length 1 - swap - ] [ nth ] bi ; inline : each-index-from ( ... seq quot: ( ... elt index -- ... ) i -- ... ) - -rot (each-index) each-integer-from ; inline + -rot sequence-index-iterator each-integer-from ; inline