]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/assocs/extras/extras.factor
assocs.extras: Move some often-used words to core
[factor.git] / extra / assocs / extras / extras.factor
index 901797305f716ebffb1b2877cf6f4783e4eb0584..03ba4b0ea5b681d3e81753e1b3dbc9489c8050d8 100644 (file)
@@ -11,7 +11,8 @@ IN: assocs.extras
 
 : of+ ( assoc key n -- assoc ) '[ 0 or _ + ] change-of ; inline
 
-: of+* ( assoc key n -- assoc old new ) '[ [ 0 or _ + ] keep swap dup ] change-of ; inline
+: of+* ( assoc key n -- assoc old new )
+    '[ [ 0 or _ + ] keep swap dup ] change-of ; inline
 
 : delete-of ( assoc key -- assoc ) over delete-at ; inline
 
@@ -59,37 +60,6 @@ IN: assocs.extras
 : substitute! ( seq assoc -- seq )
     substituter map! ;
 
-: assoc-reduce ( ... assoc identity quot: ( ... prev key value -- next ) -- ... result )
-    [ >alist ] 2dip [ first2 ] prepose reduce ; inline
-
-: reduce-keys ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
-    [ drop ] prepose assoc-reduce ; inline
-
-: reduce-values ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
-    [ nip ] prepose assoc-reduce ; inline
-
-: sum-keys ( assoc -- n ) 0 [ + ] reduce-keys ; inline
-
-: 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 -- ? ) -- assoc' )
-    '[ drop @ ] assoc-filter ; inline
-
-: filter-values ( assoc quot: ( value -- ? ) -- assoc' )
-    '[ nip @ ] assoc-filter ; inline
-
-: reject-keys ( assoc quot: ( key -- ? ) -- assoc' )
-    '[ drop @ ] assoc-reject ; inline
-
-: reject-values ( assoc quot: ( value -- ? ) -- assoc' )
-    '[ nip @ ] assoc-reject ; inline
-
 : rekey-new-assoc ( assoc keys -- newassoc )
     [ tuck of ] with H{ } map>assoc ; inline
 
@@ -244,23 +214,9 @@ PRIVATE>
 : expand-values-push ( assoc -- sequence )
     V{ } expand-values-push-as ; inline
 
-: assoc-any-key? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
-    [ drop ] prepose assoc-find 2nip ; inline
-
-: assoc-any-value? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
-    [ nip ] prepose assoc-find 2nip ; inline
-
-: assoc-all-key? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
-    [ not ] compose assoc-any-key? not ; inline
-
-: assoc-all-value? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
-    [ not ] compose assoc-any-value? not ; inline
-
-: any-multi-key? ( assoc -- ? )
-    [ sequence? ] assoc-any-key? ;
+: any-multi-key? ( assoc -- ? ) [ sequence? ] any-key? ;
 
-: any-multi-value? ( assoc -- ? )
-    [ sequence? ] assoc-any-value? ;
+: any-multi-value? ( assoc -- ? ) [ sequence? ] any-value? ;
 
 : flatten-keys ( assoc -- assoc' )
     dup any-multi-key? [ expand-keys-set-at flatten-keys ] when ;