summary refs log tree commit diff stats
path: root/lib/util.sld
diff options
context:
space:
mode:
Diffstat (limited to 'lib/util.sld')
-rw-r--r--lib/util.sld38
1 files changed, 37 insertions, 1 deletions
diff --git a/lib/util.sld b/lib/util.sld index 64c633e..fe407a2 100644 --- a/lib/util.sld +++ b/lib/util.sld
@@ -7,9 +7,12 @@
7 7
8 (export identity 8 (export identity
9 o 9 o
10 constantly
10 assoc-ref 11 assoc-ref
11 slurp 12 slurp
12 eval/q) 13 eval/q
14 intersperse
15 string-intersperse)
13 16
14 (begin 17 (begin
15 (define (identity x) x) 18 (define (identity x) x)
@@ -24,6 +27,9 @@
24 h 27 h
25 (lambda (x) (h ((loop t) x)))))))) 28 (lambda (x) (h ((loop t) x))))))))
26 29
30 (define (constantly x)
31 (lambda _ x))
32
27 (define assoc-ref 33 (define assoc-ref
28 (case-lambda 34 (case-lambda
29 ((key alist) 35 ((key alist)
@@ -47,4 +53,34 @@
47 (define (eval/q form env) ; this is probably a bad idea 53 (define (eval/q form env) ; this is probably a bad idea
48 (eval (list 'quasiquote form) env)) 54 (eval (list 'quasiquote form) env))
49 55
56 (define (intersperse xs delim)
57 (if (null? xs)
58 '()
59 (let loop ((acc (list (car xs)))
60 (rest (cdr xs)))
61 (if (null? rest)
62 (reverse acc)
63 (loop (cons (car rest) (cons delim acc))
64 (cdr rest))))))
65
66 (define (string-intersperse ss delim)
67 (apply string-append (intersperse ss delim)))
68
69 (define index
70 (case-lambda
71 ((xs needle)
72 (index xs needle eq? (constantly #f)))
73 ((xs needle comparator)
74 (index xs needle comparator (constantly #f)))
75 ((xs needle comparator fail)
76 (let loop ((i 0)
77 (xs xs))
78 (cond
79 ((null? xs) (fail))
80 ((comparator (car xs) needle) i)
81 (else (loop (+ i 1) (cdr xs))))))))
82
83 (define (string-index str ch)
84 (index (string->list str) ch))
85
50 )) 86 ))