utils: Move combinators to (guix combinators).

* guix/utils.scm (compile-time-value, memoize, fold2)
(fold-tree, fold-tree-leaves): Move to...
* guix/combinators: ... here.  New file.
* tests/utils.scm ("fold2, 1 list", "fold2, 2 lists")
(fold-tree tests): Move to...
* tests/combinators.scm: ... here.  New file.
* Makefile.am (MODULES, SCM_TESTS): Add them.
* gnu/packages.scm, gnu/packages/bootstrap.scm,
gnu/services/herd.scm, guix/build-system/gnu.scm,
guix/build-system/python.scm, guix/derivations.scm,
guix/gnu-maintenance.scm, guix/import/elpa.scm,
guix/scripts/archive.scm, guix/scripts/build.scm,
guix/scripts/graph.scm, guix/scripts/lint.scm,
guix/scripts/size.scm, guix/scripts/substitute.scm,
guix/serialization.scm, guix/store.scm, guix/ui.scm: Adjust imports
accordingly.

1 files changed, 7 insertions, 91 deletions

diff --git a/guix/utils.scm b/guix/utils.scm
index 725f4346c3..f18bbd19ac 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -32,6 +32,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
+  #:use-module (guix combinators)
   #:use-module ((guix build utils) #:select (dump-port))
   #:use-module ((guix build syscalls) #:select (errno mkdtemp!))
   #:use-module (ice-9 vlist)
@@ -46,9 +47,7 @@
   #:export (bytevector->base16-string
             base16-string->bytevector
 
-            compile-time-value
             fcntl-flock
-            memoize
             strip-keyword-arguments
             default-keyword-arguments
             substitute-keyword-arguments
@@ -82,9 +81,6 @@
             call-with-temporary-output-file
             call-with-temporary-directory
             with-atomic-file-output
-            fold2
-            fold-tree
-            fold-tree-leaves
             cache-directory
             readlink*
             edit-expression
@@ -99,22 +95,6 @@
 
 
 ;;;
-;;; Compile-time computations.
-;;;
-
-(define-syntax compile-time-value
-  (syntax-rules ()
-    "Evaluate the given expression at compile time.  The expression must
-evaluate to a simple datum."
-    ((_ exp)
-     (let-syntax ((v (lambda (s)
-                       (let ((val exp))
-                         (syntax-case s ()
-                           (_ #`'#,(datum->syntax s val)))))))
-       v))))
-
-
-;;;
 ;;; Base 16.
 ;;;
 
@@ -432,22 +412,9 @@ exception if it's already taken."
 
 
 ;;;
-;;; Miscellaneous.
+;;; Keyword arguments.
 ;;;
 
-(define (memoize proc)
-  "Return a memoizing version of PROC."
-  (let ((cache (make-hash-table)))
-    (lambda args
-      (let ((results (hash-ref cache args)))
-        (if results
-            (apply values results)
-            (let ((results (call-with-values (lambda ()
-                                               (apply proc args))
-                             list)))
-              (hash-set! cache args results)
-              (apply values results)))))))
-
 (define (strip-keyword-arguments keywords args)
   "Remove all of the keyword arguments listed in KEYWORDS from ARGS."
   (let loop ((args   args)
@@ -533,6 +500,11 @@ For instance:
          (#f
           (loop rest kw/values (cons* value kw result))))))))
 
+
+;;;
+;;; System strings.
+;;;
+
 (define* (nix-system->gnu-triplet
           #:optional (system (%current-system)) (vendor "unknown"))
   "Return a guess of the GNU triplet corresponding to Nix system
@@ -731,62 +703,6 @@ output port, and PROC's result is returned."
       (lambda (key . args)
         (false-if-exception (delete-file template))))))
 
-(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)))))))))
-
-(define (fold-tree proc init children roots)
-  "Call (PROC NODE RESULT) for each node in the tree that is reachable from
-ROOTS, using INIT as the initial value of RESULT.  The order in which nodes
-are traversed is not specified, however, each node is visited only once, based
-on an eq? check.  Children of a node to be visited are generated by
-calling (CHILDREN NODE), the result of which should be a list of nodes that
-are connected to NODE in the tree, or '() or #f if NODE is a leaf node."
-  (let loop ((result init)
-             (seen vlist-null)
-             (lst roots))
-    (match lst
-      (() result)
-      ((head . tail)
-       (if (not (vhash-assq head seen))
-           (loop (proc head result)
-                 (vhash-consq head #t seen)
-                 (match (children head)
-                   ((or () #f) tail)
-                   (children (append tail children))))
-           (loop result seen tail))))))
-
-(define (fold-tree-leaves proc init children roots)
-  "Like fold-tree, but call (PROC NODE RESULT) only for leaf nodes."
-  (fold-tree
-   (lambda (node result)
-     (match (children node)
-       ((or () #f) (proc node result))
-       (else result)))
-   init children roots))
-
 (define (cache-directory)
   "Return the cache directory for Guix, by default ~/.cache/guix."
   (or (getenv "XDG_CONFIG_HOME")