add couple list utils

list-split and list-join
This commit is contained in:
2025-10-21 21:20:33 +03:00
committed by Pavel Kulyov
parent ca7202924e
commit 036f82facf
3 changed files with 43 additions and 1 deletions

View File

@@ -9,6 +9,7 @@
(include "basic.scm")
(include "semen.scm")
(include "utils.scm")
;;; Should be the last in the test suite
(test-exit)

22
tests/utils.scm Normal file
View File

@@ -0,0 +1,22 @@
(test-group "utils"
(test
'((1) (2) (3))
(list-split '(1 * 2 * 3) '*))
(test
'((1 2 3))
(list-split '(1 2 3) '*))
(test
'(() (1) (2) (3) ())
(list-split '(* 1 * 2 * 3 *) '*))
(test
'((const) (const struct something))
(list-split '(const * const struct something) '*))
(test
'(1 * 2 * 3)
(list-join '(1 2 3) '*))
)

View File

@@ -4,7 +4,8 @@
(import
(chicken pathname)
(chicken process-context))
(chicken process-context)
srfi-1)
(define (get-env-var name)
(get-environment-variable name))
@@ -17,3 +18,21 @@
(make-absolute-pathname
(current-directory)
(pathname-directory file))))))
(define (list-split src-list split-elt)
;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6))
(fold (lambda (elt acc)
(if (eq? elt split-elt)
(append acc (list (list)))
(append (drop-right acc 1)
(list (append (last acc) (list elt))))))
(list (list))
src-list))
(define (list-join lists join-by)
(drop-right
(fold (lambda (elt acc)
(append acc (list elt) (list join-by)))
(list)
lists)
1))