diff options
author | Case Duckworth | 2023-08-29 21:54:21 -0500 |
---|---|---|
committer | Case Duckworth | 2023-08-29 21:54:21 -0500 |
commit | 9af3b2b445dfb7d03376bd01d52491175c20515e (patch) | |
tree | f56fcd725fb8d3d1e9a871f0b95e95e8848038a6 /extras.scm | |
parent | Return to the good old working days (diff) | |
download | chicanery-9af3b2b445dfb7d03376bd01d52491175c20515e.tar.gz chicanery-9af3b2b445dfb7d03376bd01d52491175c20515e.zip |
Move chicanery.extras.scm -> extras.scm
Diffstat (limited to 'extras.scm')
-rw-r--r-- | extras.scm | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/extras.scm b/extras.scm new file mode 100644 index 0000000..423c78f --- /dev/null +++ b/extras.scm | |||
@@ -0,0 +1,50 @@ | |||
1 | ;;; Chicanery extras | ||
2 | |||
3 | (export slurp) | ||
4 | |||
5 | (define slurp | ||
6 | (case-lambda | ||
7 | (() (slurp (current-input-port))) | ||
8 | ((port) | ||
9 | (let loop ((ch (read-char port)) | ||
10 | (acc '())) | ||
11 | (if (eof-object? ch) | ||
12 | (list->string (reverse acc)) | ||
13 | (loop (read-char port) | ||
14 | (cons ch acc))))))) | ||
15 | |||
16 | |||
17 | (export with-output-to-string | ||
18 | with-input-from-string) | ||
19 | |||
20 | (define (with-output-to-string thunk) | ||
21 | (call-with-port (open-output-string) | ||
22 | (lambda (port) | ||
23 | (parameterize ((current-output-port port)) | ||
24 | (thunk)) | ||
25 | (get-output-string port)))) | ||
26 | |||
27 | (define (with-input-from-string s thunk) | ||
28 | (call-with-port (open-input-string s) | ||
29 | (lambda (port) | ||
30 | (parameterize ((current-input-port port)) | ||
31 | (thunk))))) | ||
32 | |||
33 | |||
34 | (export displayed ->string | ||
35 | written | ||
36 | print) | ||
37 | |||
38 | (define (displayed x) | ||
39 | (with-output-to-string | ||
40 | (lambda () (display x)))) | ||
41 | |||
42 | (define ->string displayed) | ||
43 | |||
44 | (define (written x) | ||
45 | (with-output-to-string | ||
46 | (lambda () (write x)))) | ||
47 | |||
48 | (define (print . xs) | ||
49 | (for-each display xs) | ||
50 | (newline)) | ||