summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/utils.scm19
-rw-r--r--tests/utils.scm14
2 files changed, 33 insertions, 0 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index 1d4b2ff9b07..0802a1b67a4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -3,6 +3,7 @@
3;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> 3;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
4;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> 4;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
5;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> 5;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
6;;; Copyright © 2015 David Thompson <davet@gnu.org>
6;;; 7;;;
7;;; This file is part of GNU Guix. 8;;; This file is part of GNU Guix.
8;;; 9;;;
@@ -79,6 +80,7 @@
79 fold2 80 fold2
80 fold-tree 81 fold-tree
81 fold-tree-leaves 82 fold-tree-leaves
83 split
82 84
83 filtered-port 85 filtered-port
84 compressed-port 86 compressed-port
@@ -684,6 +686,23 @@ are connected to NODE in the tree, or '() or #f if NODE is a leaf node."
684 (else result))) 686 (else result)))
685 init children roots)) 687 init children roots))
686 688
689(define (split lst e)
690 "Return two values, a list containing the elements of the list LST that
691appear before the first occurence of the object E and a list containing the
692elements after E."
693 (define (same? x)
694 (equal? e x))
695
696 (let loop ((rest lst)
697 (acc '()))
698 (match rest
699 (()
700 (values lst '()))
701 (((? same?) . tail)
702 (values (reverse acc) tail))
703 ((head . tail)
704 (loop tail (cons head acc))))))
705
687 706
688;;; 707;;;
689;;; Source location. 708;;; Source location.
diff --git a/tests/utils.scm b/tests/utils.scm
index 115868c857a..b65d6d20ba9 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -121,6 +121,20 @@
121 '(0 1 2 3))) 121 '(0 1 2 3)))
122 list)) 122 list))
123 123
124(test-equal "split, element is in list"
125 '((foo) (baz))
126 (call-with-values
127 (lambda ()
128 (split '(foo bar baz) 'bar))
129 list))
130
131(test-equal "split, element is not in list"
132 '((foo bar baz) ())
133 (call-with-values
134 (lambda ()
135 (split '(foo bar baz) 'quux))
136 list))
137
124(test-equal "strip-keyword-arguments" 138(test-equal "strip-keyword-arguments"
125 '(a #:b b #:c c) 139 '(a #:b b #:c c)
126 (strip-keyword-arguments '(#:foo #:bar #:baz) 140 (strip-keyword-arguments '(#:foo #:bar #:baz)