From 516e3b6f7a57f6b6f378c9174f8c5ffc990df7db Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Sun, 20 Jul 2014 11:22:46 -0500
Subject: guix: utils: Add fold-tree and fold-tree-leaves.

* guix/utils.scm (fold-tree, fold-tree-leaves): New functions.
* tests/utils.scm: Add tests for them.
---
 guix/utils.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'guix/utils.scm')

diff --git a/guix/utils.scm b/guix/utils.scm
index 700a191d71..b61ff2477d 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,6 +73,8 @@ (define-module (guix utils)
             call-with-temporary-output-file
             with-atomic-file-output
             fold2
+            fold-tree
+            fold-tree-leaves
 
             filtered-port
             compressed-port
@@ -649,6 +652,36 @@ (define fold2
              (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))
+
 
 ;;;
 ;;; Source location.
-- 
cgit v1.2.3