summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorEric Bavier <bavier@member.fsf.org>2014-07-20 11:22:46 -0500
committerEric Bavier <bavier@member.fsf.org>2014-07-20 11:36:09 -0500
commit516e3b6f7a57f6b6f378c9174f8c5ffc990df7db (patch)
tree783ba2c086bb4128022732912e7af7963a56506e /guix
parentda891830dac44e531d21c6b3d3b76a14577a8de9 (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/utils.scm33
1 files changed, 33 insertions, 0 deletions
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 @@
call-with-temporary-output-file
with-atomic-file-output
fold2
+ fold-tree
+ fold-tree-leaves
filtered-port
compressed-port
@@ -649,6 +652,36 @@ output port, and PROC's result is returned."
(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.