From 04fd96cac33fa7557e574e54575252564ba27111 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 14 Apr 2013 16:56:08 +0200
Subject: utils: Add `fold2'.

* gnu/packages.scm (fold2): Remove.
* guix/utils.scm (fold2): New procedure.  Generalization of the above to
  one and two lists.
* tests/utils.scm ("fold2, 1 list", "fold2, 2 lists"): New tests.
---
 gnu/packages.scm |  8 --------
 guix/utils.scm   | 29 ++++++++++++++++++++++++++++-
 tests/utils.scm  | 25 +++++++++++++++++++++++++
 3 files changed, 53 insertions(+), 9 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index b639541788..f4d93a789d 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -110,14 +110,6 @@
                   (false-if-exception (resolve-interface name))))
               (package-files)))
 
-(define (fold2 f seed1 seed2 lst)
-  (if (null? lst)
-      (values seed1 seed2)
-      (call-with-values
-          (lambda () (f (car lst) seed1 seed2))
-        (lambda (seed1 seed2)
-          (fold2 f seed1 seed2 (cdr lst))))))
-
 (define (fold-packages proc init)
   "Call (PROC PACKAGE RESULT) for each available package, using INIT as
 the initial value of RESULT.  It is guaranteed to never traverse the
diff --git a/guix/utils.scm b/guix/utils.scm
index d7c37e37d1..f13e585e2b 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -59,7 +59,8 @@
             %current-system
             version-compare
             version>?
-            package-name->name+version))
+            package-name->name+version
+            fold2))
 
 
 ;;;
@@ -463,6 +464,32 @@ introduce the version part."
       ((head tail ...)
        (loop tail (cons head prefix))))))
 
+(define fold2
+  (case-lambda
+    ((proc seed1 seed2 lst)
+     "Like `fold', but with a single list and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst     lst))
+       (if (null? lst)
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst) result1 result2))
+             (lambda (result1 result2)
+               (loop result1 result2 (cdr lst)))))))
+    ((proc seed1 seed2 lst1 lst2)
+     "Like `fold', but with a two lists and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst1    lst1)
+                (lst2    lst2))
+       (if (or (null? lst1) (null? lst2))
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst1) (car lst2) result1 result2))
+             (lambda (result1 result2)
+               (fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
+
 
 ;;;
 ;;; Source location.
diff --git a/tests/utils.scm b/tests/utils.scm
index bcdd120a74..fa7d7b03fd 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -64,6 +64,31 @@
            ("nixpkgs" "1.0pre22125_a28fe19")
            ("gtk2" "2.38.0"))))
 
+(test-equal "fold2, 1 list"
+    (list (reverse (iota 5))
+          (map - (reverse (iota 5))))
+  (call-with-values
+      (lambda ()
+        (fold2 (lambda (i r1 r2)
+                 (values (cons i r1)
+                         (cons (- i) r2)))
+               '() '()
+               (iota 5)))
+    list))
+
+(test-equal "fold2, 2 lists"
+    (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3)))
+          (reverse '((a . 0) (b . -1) (c . -2) (d . -3))))
+  (call-with-values
+      (lambda ()
+        (fold2 (lambda (k v r1 r2)
+                 (values (alist-cons k v r1)
+                         (alist-cons k (- v) r2)))
+               '() '()
+               '(a b c d)
+               '(0 1 2 3)))
+    list))
+
 (test-assert "define-record-type*"
   (begin
     (define-record-type* <foo> foo make-foo
-- 
cgit v1.2.3