steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequences.extras: adding "map-from".

db4
John Benediktsson 2012-09-07 14:00:04 -07:00
parent 4e46d15bcf
commit ec4aaee505
1 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/sequences/extras/extras.factor
View File

@ -1,4 +1,4 @@
USING: accessors arrays assocs grouping kernel locals math USING: accessors arrays assocs fry grouping kernel locals math
math.order math.ranges sequences sequences.private splitting ; math.order math.ranges sequences sequences.private splitting ;
FROM: sequences => change-nth ; FROM: sequences => change-nth ;
IN: sequences.extras IN: sequences.extras
@ -161,6 +161,22 @@ IN: sequences.extras
<PRIVATE <PRIVATE
: ((each-from)) ( i seq -- n quot )
[ length over - 0 max swap ] keep '[ _ + _ nth-unsafe ] ; inline
: (each-from) ( i seq quot -- n quot' ) [ ((each-from)) ] dip compose ;
inline
PRIVATE>
: map-from-as ( ... seq quot: ( ... elt -- ... newelt ) i exemplar -- ... newseq )
[ -rot (each-from) ] dip map-integers ; inline
: map-from ( ... seq quot: ( ... elt -- ... newelt ) i -- ... newseq )
pick map-from-as ; inline
<PRIVATE
: push-map-if ( ..a elt filter-quot: ( ..a elt -- ..b ? ) map-quot: ( ..a elt -- ..b newelt ) accum -- ..b ) : push-map-if ( ..a elt filter-quot: ( ..a elt -- ..b ? ) map-quot: ( ..a elt -- ..b newelt ) accum -- ..b )
[ keep over ] 2dip [ when ] dip rot [ push ] [ 2drop ] if ; inline [ keep over ] 2dip [ when ] dip rot [ push ] [ 2drop ] if ; inline