Skip to content

Commit

Permalink
sequences.extras: move some words to assocs.extras.
Browse files Browse the repository at this point in the history
  • Loading branch information
mrjbq7 committed Jul 20, 2020
1 parent 2c48873 commit 9c60c20
Show file tree
Hide file tree
Showing 2 changed files with 20 additions and 20 deletions.
20 changes: 19 additions & 1 deletion extra/assocs/extras/extras.factor
Expand Up @@ -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

Expand Down Expand Up @@ -171,4 +189,4 @@ PRIVATE>
[ of ] with map sift ; inline

: counts ( seq elts -- counts )
[ histogram ] dip intersect-keys ;
[ histogram ] dip intersect-keys ;
20 changes: 1 addition & 19 deletions extra/sequences/extras/extras.factor
Expand Up @@ -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
Expand Down

0 comments on commit 9c60c20

Please sign in to comment.