utils: Add split procedure.

* guix/utils.scm (split): New procedure.
* tests/utils.scm: Add tests.
This commit is contained in:
David Thompson 2015-10-09 12:10:47 -04:00
parent b94ef11a53
commit bbd00d2012
2 changed files with 33 additions and 0 deletions

View file

@ -3,6 +3,7 @@
;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -79,6 +80,7 @@ (define-module (guix utils)
fold2 fold2
fold-tree fold-tree
fold-tree-leaves fold-tree-leaves
split
filtered-port filtered-port
compressed-port compressed-port
@ -684,6 +686,23 @@ (define (fold-tree-leaves proc init children roots)
(else result))) (else result)))
init children roots)) 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. ;;; Source location.

View file

@ -121,6 +121,20 @@ (define temp-file
'(0 1 2 3))) '(0 1 2 3)))
list)) 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" (test-equal "strip-keyword-arguments"
'(a #:b b #:c c) '(a #:b b #:c c)
(strip-keyword-arguments '(#:foo #:bar #:baz) (strip-keyword-arguments '(#:foo #:bar #:baz)