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

sequences.extras: move some words to assocs.extras.

master
John Benediktsson 2020-07-19 20:18:15 -07:00
parent 2c488736e4
commit 9c60c202e9
2 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/assocs/extras/extras.factor
View File

@ -23,6 +23,24 @@ IN: assocs.extras
: sum-values ( assoc -- n ) 0 [ + ] reduce-values ; inline
: map-keys ( assoc quot: ( key -- key' ) -- assoc )
'[ _ dip ] assoc-map ; inline
: map-values ( assoc quot: ( value -- value' ) -- assoc )
'[ swap _ dip swap ] assoc-map ; inline
: filter-keys ( assoc quot: ( key -- key' ) -- assoc' )
'[ drop @ ] assoc-filter ; inline
: filter-values ( assoc quot: ( value -- value' ) -- assoc' )
'[ nip @ ] assoc-filter ; inline
: reject-keys ( assoc quot: ( key -- key' ) -- assoc' )
'[ drop @ ] assoc-reject ; inline
: reject-values ( assoc quot: ( value -- value' ) -- assoc' )
'[ nip @ ] assoc-reject ; inline
: if-assoc-empty ( ..a assoc quot1: ( ..a -- ..b ) quot2: ( ..a assoc -- ..b ) -- ..b )
[ dup assoc-empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
@ -171,4 +189,4 @@ PRIVATE>
[ of ] with map sift ; inline
: counts ( seq elts -- counts )
[ histogram ] dip intersect-keys ;
[ histogram ] dip intersect-keys ;

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

@ -608,27 +608,9 @@ PRIVATE>
: count-subseq* ( subseq seq -- n )
start-all* length ; inline
: map-zip ( quot: ( x -- y ) -- alist )
: map-zip ( quot: ( key -- value ) -- alist )
'[ _ keep swap ] map>alist ; inline
: map-keys ( assoc quot: ( key -- key' ) -- assoc )
'[ _ dip ] assoc-map ; inline
: map-values ( assoc quot: ( value -- value' ) -- assoc )
'[ swap _ dip swap ] assoc-map ; inline
: filter-keys ( assoc quot: ( key -- key' ) -- assoc' )
'[ drop @ ] assoc-filter ; inline
: filter-values ( assoc quot: ( value -- value' ) -- assoc' )
'[ nip @ ] assoc-filter ; inline
: reject-keys ( assoc quot: ( key -- key' ) -- assoc' )
'[ drop @ ] assoc-reject ; inline
: reject-values ( assoc quot: ( value -- value' ) -- assoc' )
'[ nip @ ] assoc-reject ; inline
: take-while ( ... seq quot: ( ... elt -- ... ? ) -- head-slice )
[ '[ @ not ] find drop ] keepd swap
[ dup length ] unless* head-slice ; inline