From bbd00d2012833c6419a62f6490cbef3e896b1e11 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 9 Oct 2015 12:10:47 -0400
Subject: [PATCH] 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(+)

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 @@
 ;;; 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 @@ (define-module (guix utils)
             fold2
             fold-tree
             fold-tree-leaves
+            split
 
             filtered-port
             compressed-port
@@ -684,6 +686,23 @@ (define (fold-tree-leaves proc init children roots)
        (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 115868c857a..b65d6d20ba9 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -121,6 +121,20 @@ (define temp-file
                '(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)
-- 
GitLab