[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: utils: Add split procedure.
From: |
David Thompson |
Subject: |
01/02: utils: Add split procedure. |
Date: |
Fri, 09 Oct 2015 16:20:36 +0000 |
davexunit pushed a commit to branch master
in repository guix.
commit bbd00d2012833c6419a62f6490cbef3e896b1e11
Author: David Thompson <address@hidden>
Date: Fri Oct 9 12:10:47 2015 -0400
utils: Add split procedure.
* guix/utils.scm (split): New procedure.
* tests/utils.scm: Add tests.
---
guix/utils.scm | 19 +++++++++++++++++++
tests/utils.scm | 14 ++++++++++++++
2 files changed, 33 insertions(+), 0 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 1d4b2ff..0802a1b 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2013, 2014, 2015 Mark H Weaver <address@hidden>
;;; Copyright © 2014 Eric Bavier <address@hidden>
;;; Copyright © 2014 Ian Denhardt <address@hidden>
+;;; Copyright © 2015 David Thompson <address@hidden>
;;;
;;; 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 115868c..b65d6d2 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)