[PATCH v4] Add atomic-box-update! function to (ice-9 atomic)

[Andrew Tropin <andrew@trop.in>]

* module/ice-9/atomic.scm (atomic-box-update!): New variable.
---
Oops, v3 was incomplete, sending a new version.

Changes since v3:
Removed stale proc-args.

 module/ice-9/atomic.scm | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/atomic.scm b/module/ice-9/atomic.scm
index 2a8af901d..c9d49112c 100644
--- a/module/ice-9/atomic.scm
+++ b/module/ice-9/atomic.scm
@@ -25,7 +25,8 @@
             atomic-box-ref
             atomic-box-set!
             atomic-box-swap!
-            atomic-box-compare-and-swap!))
+            atomic-box-compare-and-swap!
+            atomic-box-update!))
 
 (eval-when (expand load eval)
   (load-extension (string-append "libguile-" (effective-version))
@@ -36,3 +37,14 @@
   (add-interesting-primitive! 'atomic-box-set!)
   (add-interesting-primitive! 'atomic-box-swap!)
   (add-interesting-primitive! 'atomic-box-compare-and-swap!))
+
+(define (atomic-box-update! box proc)
+  "Atomically update the value of BOX to (PROC BOX-VALUE) and return the
+new value.  PROC may be called multiple times, and thus PROC should be
+free of side effects."
+  (let loop ((old-value (atomic-box-ref box)))
+    (let* ((new-value (proc old-value))
+           (cas-value (atomic-box-compare-and-swap! box old-value new-value)))
+      (if (eq? old-value cas-value)
+          new-value
+          (loop cas-value)))))
-- 
2.41.0