]> gitweb.factorcode.org Git - factor.git/commitdiff
assocs: move a lot of *-of words to assocs.extas
authorDoug Coleman <doug.coleman@gmail.com>
Tue, 21 Feb 2023 01:41:32 +0000 (19:41 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 26 Feb 2023 23:11:04 +0000 (17:11 -0600)
core/assocs/assocs.factor
extra/assocs/extras/extras.factor

index c112f54004010828b6375cdc6ecfdf3a96839fae..d44e22d912e714c56b1e5b61838028968c9b2cdf 100644 (file)
@@ -24,10 +24,6 @@ M: assoc assoc-like drop ; inline
 
 : key? ( key assoc -- ? ) at* nip ; inline
 
-: delete-of ( assoc key -- assoc ) over delete-at ; inline
-
-: of* ( assoc key -- value/f ? ) swap at* ; inline
-
 : ?at ( key assoc -- value/key ? )
     2dup at* [ 2nip t ] [ 2drop f ] if ; inline
 
@@ -49,9 +45,6 @@ M: assoc assoc-like drop ; inline
 : assoc-operator ( assoc quot -- alist quot' )
     [ >alist ] dip [ first2 ] prepose ; inline
 
-: assoc-operator* ( assoc quot -- alist quot' )
-    [ >alist ] dip [ first2 swap ] prepose ; inline
-
 : assoc-stack-from ( key i seq -- value/f )
     over 0 < [
         3drop f
@@ -74,9 +67,6 @@ PRIVATE>
 : assoc-each ( ... assoc quot: ( ... key value -- ... ) -- ... )
     assoc-operator each ; inline
 
-: assoc-each* ( ... assoc quot: ( ... value key -- ... ) -- ... )
-    assoc-operator* each ; inline
-
 : assoc>map ( ... assoc quot: ( ... key value -- ... elt ) exemplar -- ... seq )
     [ assoc-operator ] dip map-as ; inline
 
@@ -152,14 +142,6 @@ M: assoc values [ nip ] { } assoc>map ;
 : ?delete-at ( key assoc -- value/key ? )
     [ ?at ] [ delete-at ] 2bi ;
 
-: delete-of* ( assoc key -- assoc value/f ? )
-    [ of* ] [ delete-of -rot ] 2bi ;
-
-: ?delete-of ( assoc key -- assoc value/key ? )
-    [ ?of ] [ delete-of -rot ] 2bi ;
-
-: rename-of ( assoc key newkey -- assoc )
-    [ delete-of* ] dip swap [ set-of ] [ 2drop ] if ;
 
 : rename-at ( newkey key assoc -- )
     [ delete-at* ] keep [ set-at ] with-assoc [ 2drop ] if ;
@@ -239,14 +221,6 @@ M: assoc values [ nip ] { } assoc>map ;
 
 : inc-at* ( key assoc -- old new ) [ 1 ] 2dip at+* ; inline
 
-: 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
-
-: inc-of ( assoc key -- assoc ) 1 of+ ; inline
-
-: inc-of* ( assoc key -- assoc old new ) 1 of+* ; inline
-
 : map>assoc ( ... seq quot: ( ... elt -- ... key value ) exemplar -- ... assoc )
     dup sequence? [
         [ [ 2array ] compose ] dip map-as
index 58659c5d5a13aa780719e36ef4462ad5420bf528..b49983def20e2f97b4e6146fc4ea9c918d408370 100644 (file)
@@ -4,6 +4,27 @@ USING: arrays assocs assocs.private kernel math math.statistics
 sequences sequences.extras sets ;
 IN: assocs.extras
 
+: of* ( assoc key -- value/f ? ) swap at* ; inline
+
+: 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
+
+: delete-of ( assoc key -- assoc ) over delete-at ; inline
+
+: delete-of* ( assoc key -- assoc value/f ? )
+    [ of* ] [ delete-of -rot ] 2bi ;
+
+: ?delete-of ( assoc key -- assoc value/key ? )
+    [ ?of ] [ delete-of -rot ] 2bi ;
+
+: rename-of ( assoc key newkey -- assoc )
+    [ delete-of* ] dip swap [ set-of ] [ 2drop ] if ;
+
+: inc-of ( assoc key -- assoc ) 1 of+ ; inline
+
+: inc-of* ( assoc key -- assoc old new ) 1 of+* ; inline
+
 : push-at-each ( value keys assoc -- )
     '[ _ push-at ] with each ; inline
 
@@ -297,3 +318,9 @@ PRIVATE>
 
 : collect-value-by-multi ( ... assoc quot: ( ... value -- ... new-keys ) -- ... assoc )
     [ H{ } clone ] 2dip collect-value-by-multi! ; inline
+
+: assoc-operator* ( assoc quot -- alist quot' )
+    [ >alist ] dip [ first2 swap ] prepose ; inline
+
+: assoc-each* ( ... assoc quot: ( ... value key -- ... ) -- ... )
+    assoc-operator* each ; inline