forked from alex-eg/sex
add couple list utils
list-split and list-join
This commit is contained in:
@@ -9,6 +9,7 @@
|
|||||||
|
|
||||||
(include "basic.scm")
|
(include "basic.scm")
|
||||||
(include "semen.scm")
|
(include "semen.scm")
|
||||||
|
(include "utils.scm")
|
||||||
|
|
||||||
;;; Should be the last in the test suite
|
;;; Should be the last in the test suite
|
||||||
(test-exit)
|
(test-exit)
|
||||||
|
|||||||
22
tests/utils.scm
Normal file
22
tests/utils.scm
Normal 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) '*))
|
||||||
|
)
|
||||||
21
utils.scm
21
utils.scm
@@ -4,7 +4,8 @@
|
|||||||
|
|
||||||
(import
|
(import
|
||||||
(chicken pathname)
|
(chicken pathname)
|
||||||
(chicken process-context))
|
(chicken process-context)
|
||||||
|
srfi-1)
|
||||||
|
|
||||||
(define (get-env-var name)
|
(define (get-env-var name)
|
||||||
(get-environment-variable name))
|
(get-environment-variable name))
|
||||||
@@ -17,3 +18,21 @@
|
|||||||
(make-absolute-pathname
|
(make-absolute-pathname
|
||||||
(current-directory)
|
(current-directory)
|
||||||
(pathname-directory file))))))
|
(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))
|
||||||
|
|||||||
Reference in New Issue
Block a user