diff options
author | David Thompson <dthompson2@worcester.edu> | 2015-10-09 12:10:47 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2015-10-09 12:17:01 -0400 |
commit | bbd00d2012833c6419a62f6490cbef3e896b1e11 (patch) | |
tree | 6a5042c85949122419ff91e38455131eed04336b | |
parent | b94ef11a538e19900c1f570500ac4dee73543844 (diff) | |
download | guix-bbd00d2012833c6419a62f6490cbef3e896b1e11.tar.gz |
utils: Add split procedure.
* guix/utils.scm (split): New procedure. * tests/utils.scm: Add tests.
-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 1d4b2ff9b0..0802a1b67a 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> +;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -79,6 +80,7 @@ fold2 fold-tree fold-tree-leaves + split filtered-port compressed-port @@ -684,6 +686,23 @@ are connected to NODE in the tree, or '() or #f if NODE is a leaf node." (else result))) init children roots)) +(define (split lst e) + "Return two values, a list containing the elements of the list LST that +appear before the first occurence of the object E and a list containing the +elements after E." + (define (same? x) + (equal? e x)) + + (let loop ((rest lst) + (acc '())) + (match rest + (() + (values lst '())) + (((? same?) . tail) + (values (reverse acc) tail)) + ((head . tail) + (loop tail (cons head acc)))))) + ;;; ;;; Source location. diff --git a/tests/utils.scm b/tests/utils.scm index 115868c857..b65d6d20ba 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -121,6 +121,20 @@ '(0 1 2 3))) list)) +(test-equal "split, element is in list" + '((foo) (baz)) + (call-with-values + (lambda () + (split '(foo bar baz) 'bar)) + list)) + +(test-equal "split, element is not in list" + '((foo bar baz) ()) + (call-with-values + (lambda () + (split '(foo bar baz) 'quux)) + list)) + (test-equal "strip-keyword-arguments" '(a #:b b #:c c) (strip-keyword-arguments '(#:foo #:bar #:baz) |