diff options
| -rw-r--r-- | gnu/packages.scm | 8 | ||||
| -rw-r--r-- | guix/utils.scm | 29 | ||||
| -rw-r--r-- | 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 |