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.sld50
1 files changed, 50 insertions, 0 deletions
diff --git a/lib/util.sld b/lib/util.sld new file mode 100644 index 0000000..64c633e --- /dev/null +++ b/lib/util.sld
@@ -0,0 +1,50 @@
1;;; (boudin util) --- utility functions
2
3(define-library (boudin util)
4 (import (scheme base)
5 (scheme case-lambda)
6 (scheme eval))
7
8 (export identity
9 o
10 assoc-ref
11 slurp
12 eval/q)
13
14 (begin
15 (define (identity x) x)
16
17 (define (o . procs) ; stole from chicken core
18 (if (null? procs)
19 identity
20 (let loop ((procs procs))
21 (let ((h (car procs))
22 (t (cdr procs)))
23 (if (null? t)
24 h
25 (lambda (x) (h ((loop t) x))))))))
26
27 (define assoc-ref
28 (case-lambda
29 ((key alist)
30 (assoc-ref alist
31 key
32 (lambda () (error "Unrecognized key." key))))
33 ((key alist failure)
34 (cond ((assoc key alist) => cdr)
35 (else (failure))))))
36
37 (define slurp
38 (case-lambda
39 (() (slurp (current-input-port)))
40 ((port)
41 (let loop ((ch (read-char))
42 (acc '()))
43 (if (eof-object? ch)
44 (list->string (reverse acc))
45 (loop (read-char) (cons ch acc)))))))
46
47 (define (eval/q form env) ; this is probably a bad idea
48 (eval (list 'quasiquote form) env))
49
50 ))