assocs: move some -of words to extras

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 2ace53d834547037fd324e24fc10b3b9b88284bc..931da8f2e013b5f2d90bea79deb2fe0f9849c0b8 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -345,43 +345,3 @@ unit-test
 { H{ { 1 4 } } } [ H{ { 1 2 } } 1 over [ sq ] ?change-at ] unit-test
 { H{ { 1 2 } } } [ H{ { 1 2 } } 2 over [ sq ] ?change-at ] unit-test
 { H{ { 1 3 } } } [ H{ { 1 2 } } 3 1 pick [ drop dup ] ?change-at drop ] unit-test
-
-{ H{ { 1 100 } } } [
-    H{ } clone 1 100 set-of
-] unit-test
-
-{ H{ { 1 V{ 100 200 } } } } [
-    H{ } clone 1 100 push-of 1 200 push-of
-] unit-test
-
-{ H{ { 123 556 } } } [
-    H{ { 123 456 } } 123 [ 100 + ] change-of
-] unit-test
-
-{ H{ { 123 556 } } } [
-    H{ { 123 456 } } 123 [ 100 + ] ?change-of
-] unit-test
-
-{ H{ { 123 456 } } } [
-    H{ { 123 456 } } 1234 [ 100 + ] ?change-of
-] unit-test
-
-{ H{ { 10 2 } } } [
-    H{ { 10 1 } } 10 inc-of
-] unit-test
-
-{ H{ { 10 1001 } } } [
-    H{ { 10 1 } } 10 1000 of+
-] unit-test
-
-{ H{ { 1 100 } } f } [
-    H{ { 1 100 } } 1 100 maybe-set-of
-] unit-test
-
-{ H{ { 1 100 } { 2 100 } } t } [
-    H{ { 1 100 } } 2 100 maybe-set-of
-] unit-test
-
-{ H{ { 1 100 } } t } [
-    H{ { 1 100 } } 1 101 maybe-set-of
-] unit-test
\ No newline at end of file

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index d44e22d912e714c56b1e5b61838028968c9b2cdf..7b7018e400d7990716442b98dbbdcdf89c9b6cc2 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -36,10 +36,6 @@ M: assoc assoc-like drop ; inline
 : set-of ( assoc key value -- assoc )
     swap pick set-at ; inline
 
-: maybe-set-of ( assoc key value -- assoc changed? )
-    [ 2dup ?of ] dip swap
-    [ dupd = [ 2drop f ] [ set-of t ] if ] [ nip set-of t ] if ;
-
 <PRIVATE
 
 : assoc-operator ( assoc quot -- alist quot' )
@@ -207,20 +203,10 @@ M: assoc values [ nip ] { } assoc>map ;
 : ?change-at ( ..a key assoc quot: ( ..a value -- ..b newvalue ) -- ..b )
     2over [ set-at ] 2curry compose [ at* ] dip [ drop ] if ; inline
 
-: change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b assoc )
-    [ [ of ] dip call ] 2keepd rot set-of ; inline
-
-: ?change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b assoc )
-    [ set-of ] compose [ 2dup ?of ] dip [ 2drop ] if ; inline
-
 : at+ ( n key assoc -- ) [ 0 or + ] change-at ; inline
 
-: at+* ( n key assoc -- old new ) [ 0 or [ + ] keep swap dup ] change-at ; inline
-
 : inc-at ( key assoc -- ) [ 1 ] 2dip at+ ; inline
 
-: inc-at* ( key assoc -- old new ) [ 1 ] 2dip at+* ; inline
-
 : map>assoc ( ... seq quot: ( ... elt -- ... key value ) exemplar -- ... assoc )
     dup sequence? [
         [ [ 2array ] compose ] dip map-as
@@ -247,9 +233,6 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
 : push-at ( value key assoc -- )
     [ ?push ] change-at ;
 
-: push-of ( assoc key value -- assoc )
-    swap pick push-at ; inline
-
 : zip-as ( keys values exemplar -- assoc )
     dup sequence? [
         [ 2array ] swap 2map-as

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 22e7ec8f1700a55b5360376cbc99192e7515e4c9..2ca1b4cd67bf8132a1fb9b08e8fd0a2efd84b744 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -321,3 +321,44 @@ USING: arrays assocs.extras kernel math math.order sequences tools.test ;
     H{ { 1 2 } { 3 4 } { 5 6 } }
     { 1 3 } { } intersect-keys-as
 ] unit-test
+
+
+{ H{ { 1 100 } } } [
+    H{ } clone 1 100 set-of
+] unit-test
+
+{ H{ { 1 V{ 100 200 } } } } [
+    H{ } clone 1 100 push-of 1 200 push-of
+] unit-test
+
+{ H{ { 123 556 } } } [
+    H{ { 123 456 } } 123 [ 100 + ] change-of
+] unit-test
+
+{ H{ { 123 556 } } } [
+    H{ { 123 456 } } 123 [ 100 + ] ?change-of
+] unit-test
+
+{ H{ { 123 456 } } } [
+    H{ { 123 456 } } 1234 [ 100 + ] ?change-of
+] unit-test
+
+{ H{ { 10 2 } } } [
+    H{ { 10 1 } } 10 inc-of
+] unit-test
+
+{ H{ { 10 1001 } } } [
+    H{ { 10 1 } } 10 1000 of+
+] unit-test
+
+{ H{ { 1 100 } } f } [
+    H{ { 1 100 } } 1 100 maybe-set-of
+] unit-test
+
+{ H{ { 1 100 } { 2 100 } } t } [
+    H{ { 1 100 } } 2 100 maybe-set-of
+] unit-test
+
+{ H{ { 1 100 } } t } [
+    H{ { 1 100 } } 1 101 maybe-set-of
+] unit-test
\ No newline at end of file

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index b49983def20e2f97b4e6146fc4ea9c918d408370..adf8ceb81a445c056c5016008a27696b840f0a3b 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -21,10 +21,27 @@ IN: assocs.extras
 : rename-of ( assoc key newkey -- assoc )
     [ delete-of* ] dip swap [ set-of ] [ 2drop ] if ;
 
+: at+* ( n key assoc -- old new ) [ 0 or [ + ] keep swap dup ] change-at ; inline
+
+: inc-at* ( key assoc -- old new ) [ 1 ] 2dip at+* ; inline
+
 : inc-of ( assoc key -- assoc ) 1 of+ ; inline
 
 : inc-of* ( assoc key -- assoc old new ) 1 of+* ; inline
 
+: change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b assoc )
+    [ [ of ] dip call ] 2keepd rot set-of ; inline
+
+: ?change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b assoc )
+    [ set-of ] compose [ 2dup ?of ] dip [ 2drop ] if ; inline
+
+: maybe-set-of ( assoc key value -- assoc changed? )
+    [ 2dup ?of ] dip swap
+    [ dupd = [ 2drop f ] [ set-of t ] if ] [ nip set-of t ] if ;
+
+: push-of ( assoc key value -- assoc )
+    swap pick push-at ; inline
+
 : push-at-each ( value keys assoc -- )
     '[ _ push-at ] with each ; inline