X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=extra%2Fsequences%2Fextras%2Fextras.factor;h=0d37e3e14d118f96a3c9de09c4258144c6c767b2;hp=78793771b769060a95781730f6d9f3bf12155851;hb=1bf4194271bc619cbeaeda2f60bf11081a95282f;hpb=2d34342bb97f11b6a1e09fa594cc0eeb69771172 diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 78793771b7..0d37e3e14d 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -282,6 +282,9 @@ PRIVATE> : map-from ( ... seq quot: ( ... elt -- ... newelt ) i -- ... newseq ) pick map-from-as ; inline +: map-if ( ... seq if-quot: ( ... elt -- ... ? ) map-quot: ( ... elt -- ... newelt ) -- ... newseq ) + '[ dup @ _ when ] map ; inline + : >string-list ( seq -- seq' ) [ "\"" 1surround ] map "," join ; +: with-string-lines ( str quot -- str' ) + [ string-lines ] dip map "\n" join ; inline + +: prepend-lines-with-spaces ( str -- str' ) + [ " " prepend ] with-string-lines ; + : one? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) [ find ] 2keep rot [ [ 1 + ] 2dip find-from drop not ] [ 3drop f ] if ; inline : map-index! ( ... seq quot: ( ... elt index -- ... newelt ) -- ... seq ) - over [ [ sequence-index-iterator ] dip collect ] keep ; inline + over [ [ sequence-index-operator ] dip collect ] keep ; inline [ length 1 - swap - ] [ nth ] bi ; inline : each-index-from ( ... seq quot: ( ... elt index -- ... ) i -- ... ) - -rot sequence-index-iterator each-integer-from ; inline + -rot sequence-index-operator each-integer-from ; inline ] if-empty ; : change-last ( seq quot -- ) - [ drop length 1 - ] [ change-nth ] 2bi ; inline + [ index-of-last ] [ change-nth ] bi* ; inline : change-last-unsafe ( seq quot -- ) - [ drop length 1 - ] [ change-nth-unsafe ] 2bi ; inline + [ index-of-last ] [ change-nth-unsafe ] bi* ; inline : replicate-into ( ... seq quot: ( ... -- ... newelt ) -- ... ) over [ length ] 2dip '[ _ dip _ set-nth-unsafe ] each-integer ; inline @@ -645,15 +654,24 @@ PRIVATE> : count* ( ... seq quot: ( ... elt -- ... ? ) -- ... % ) over [ count ] [ length ] bi* / ; inline +: sequence-index-operator-last ( n seq quot -- n quot' ) + [ [ nth-unsafe ] curry [ keep ] curry ] dip compose ; inline + +: find-last-index-from ( ... n seq quot: ( ... elt i -- ... ? ) -- ... i elt ) + '[ + _ [ sequence-index-operator-last find-last-integer ] keepd + index/element + ] bounds-check-call ; inline + : find-last-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... i elt ) - [ [ 1 - ] dip find-last-integer ] (find-index) ; inline + [ index-of-last ] dip find-last-index-from ; inline : map-find-last-index ( ... seq quot: ( ... elt index -- ... result/f ) -- ... result i elt ) [ find-last-index ] (map-find-index) ; inline :: (start-all) ( seq subseq increment -- indices ) 0 - [ seq subseq find-subseq-from dup ] + [ seq subseq subseq-index-from dup ] [ [ increment + ] keep ] produce nip ; : start-all ( seq subseq -- indices )