From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 7 Dec 2022 20:34:43 +0000 (-0600)
Subject: assocs: fix at+* to return old,new and change* to change-by*
X-Git-Tag: 0.99~575
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=a2df8151c1b3f46cbaee714571474dec7b315583

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 2ace53d834..b22c299e6b 100644
--- 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 4d168127a9..2ae679cba2 100644
--- 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 f20e99505b..6f8a5e3c9e 100644
--- 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 b144ca6c4c..72cc579398 100644
--- 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 f94e748286..a04dced8f4 100644
--- 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