assocs: fix at+* to return old,new and change* to change-by*

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 2ace53d834547037fd324e24fc10b3b9b88284bc..b22c299e6be9cd17610ba8ca74fa0efbf347d10b 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -355,23 +355,23 @@ unit-test
 ] unit-test
 
 { H{ { 123 556 } } } [
-    H{ { 123 456 } } 123 [ 100 + ] change-of
+    H{ { 123 456 } } dup 123 [ 100 + ] change-of
 ] unit-test
 
 { H{ { 123 556 } } } [
-    H{ { 123 456 } } 123 [ 100 + ] ?change-of
+    H{ { 123 456 } } dup 123 [ 100 + ] ?change-of
 ] unit-test
 
 { H{ { 123 456 } } } [
-    H{ { 123 456 } } 1234 [ 100 + ] ?change-of
+    H{ { 123 456 } } dup 1234 [ 100 + ] ?change-of
 ] unit-test
 
 { H{ { 10 2 } } } [
-    H{ { 10 1 } } 10 inc-of
+    H{ { 10 1 } } dup 10 inc-of
 ] unit-test
 
 { H{ { 10 1001 } } } [
-    H{ { 10 1 } } 10 1000 of+
+    H{ { 10 1 } } dup 10 1000 of+
 ] unit-test
 
 { H{ { 1 100 } } f } [

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 4d168127a95b201d1738e71eeec530d8517d7ccd..2ae679cba2c084171070264ffe802af9093684cd 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -203,23 +203,27 @@ 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 )
+    [ [ of ] dip call ] 2keepd rot set-of drop ; inline
 
-: ?change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b assoc )
-    [ set-of ] compose [ 2dup ?of ] dip [ 2drop ] if ; inline
+: ?change-of ( ..a assoc key quot: ( ..a value -- ..b newvalue ) -- ..b )
+    [ set-of drop ] compose [ 2dup ?of ] dip [ 3drop ] if ; inline
 
 : at+ ( n key assoc -- ) [ 0 or + ] change-at ; inline
 
-: at+* ( n key assoc -- old ) [ 0 or [ + ] keep swap ] 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
 
-: of+ ( assoc key n -- assoc ) '[ 0 or _ + ] change-of ; inline
+: inc-at* ( key assoc -- old new ) [ 1 ] 2dip at+* ; inline
 
-: inc-of ( assoc key -- assoc ) 1 of+ ; inline
+: of+ ( assoc key n -- ) '[ 0 or _ + ] change-of ; inline
 
-: inc-at* ( key assoc -- old ) [ 1 ] 2dip at+* ; inline
+: of+* ( assoc key n -- old new ) '[ [ 0 or _ + ] keep swap dup ] change-of ; inline
+
+: inc-of ( assoc key -- ) 1 of+ ; inline
+
+: inc-of* ( assoc key -- old new ) 1 of+* ; inline
 
 : map>assoc ( ... seq quot: ( ... elt -- ... key value ) exemplar -- ... assoc )
     dup sequence? [

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
index f20e99505b95c9edb3812a626aec7dc8e1136ee7..6f8a5e3c9e73869b03b2253db5f1db36cbbda7e3 100644 (file)
--- a/extra/sequences/extras/extras-docs.factor
+++ b/extra/sequences/extras/extras-docs.factor
@@ -69,13 +69,13 @@ HELP: 2map-index
 { $description "Calls the quotation with each pair of elements of the two sequences and their index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them into a new sequence of the same type as the first sequence." }
 { $see-also 2map map-index } ;
 
-HELP: count*
+HELP: count-by*
 { $values
     { "seq" sequence }
     { "quot" { $quotation ( ... elt -- ... ? ) } }
     { "%" rational } }
 { $description "Outputs the fraction of elements in the sequence for which the predicate quotation matches." }
-{ $examples { $example "USING: math ranges prettyprint sequences.extras ;" "100 [1..b] [ even? ] count* ." "1/2" } } ;
+{ $examples { $example "USING: math ranges prettyprint sequences.extras ;" "100 [1..b] [ even? ] count-by* ." "1/2" } } ;
 
 HELP: collapse
 { $values

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index b144ca6c4cd6028898e9cbc89c2b516b62488408..72cc57939801e5c48d0a79fb8e809689d594a9a0 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -282,7 +282,7 @@ strings tools.test ;
 { 1 } [ { 1 f 3 2 } ?infimum ] unit-test
 { 1 } [ { 1 3 2 } ?infimum ] unit-test
 
-{ 3/10 } [ 10 <iota> [ 3 < ] count* ] unit-test
+{ 3/10 } [ 10 <iota> [ 3 < ] count-by* ] unit-test
 
 { { 0 } } [ "ABABA" "ABA" start-all ] unit-test
 { { 0 2 } } [ "ABABA" "ABA" start-all* ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index f94e748286287d67f18870d0e8b3b7ba1e4d55e9..a04dced8f48869d2b79ab4882b931584bd5c0632 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -296,7 +296,7 @@ PRIVATE>
     over 0accumulate-as ; inline
 
 : occurrence-count-by ( seq quot: ( elt -- elt' ) -- hash seq' )
-    '[ nip @ over inc-at* ] [ H{ } clone ] 2dip 0accumulate ; inline
+    '[ nip @ over inc-at* drop ] [ H{ } clone ] 2dip 0accumulate ; inline
 
 : occurrence-count ( seq -- hash seq' )
     [ ] occurrence-count-by ; inline
@@ -307,7 +307,7 @@ PRIVATE>
 : progressive-index-by-as ( seq1 seq2 quot exemplar -- hash seq' )
     [
         pick length '[
-            tuck [ @ over inc-at* ] 2dip swap nth-index _ or
+            tuck [ @ over inc-at* drop ] 2dip swap nth-index _ or
         ] [ H{ } clone ] 3dip with
     ] dip map-as ; inline
 
@@ -842,8 +842,8 @@ PRIVATE>
 : replicate-into ( ... seq quot: ( ... -- ... newelt ) -- ... )
     over [ length ] 2dip '[ _ dip _ set-nth-unsafe ] each-integer ; inline
 
-: count* ( ... seq quot: ( ... elt -- ... ? ) -- ... % )
-    over [ count ] [ length ] bi* / ; inline
+: count-by* ( ... seq quot: ( ... elt -- ... ? ) -- ... % )
+    over [ count-by ] [ length ] bi* / ; inline
 
 : sequence-index-operator-last ( n seq quot -- n quot' )
     [ [ nth-unsafe ] curry [ keep ] curry ] dip compose ; inline