diff options
Diffstat (limited to 'lib/util.sld')
-rw-r--r-- | lib/util.sld | 50 |
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 | )) | ||