diff options
| -rw-r--r-- | guix/utils.scm | 19 | ||||
| -rw-r--r-- | tests/utils.scm | 14 |
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 | ||
| 691 | appear before the first occurence of the object E and a list containing the | ||
| 692 | elements 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) |
