diff options
Diffstat (limited to 'schmaltz.sls')
-rw-r--r-- | schmaltz.sls | 38 |
1 files changed, 19 insertions, 19 deletions
diff --git a/schmaltz.sls b/schmaltz.sls index c47467a..a5becac 100644 --- a/schmaltz.sls +++ b/schmaltz.sls | |||
@@ -6,45 +6,45 @@ | |||
6 | (case-lambda | 6 | (case-lambda |
7 | (() | 7 | (() |
8 | (render (current-input-port) (render-environment))) | 8 | (render (current-input-port) (render-environment))) |
9 | ((port) | 9 | ((in) |
10 | (render port (render-environment))) | 10 | (render in (render-environment))) |
11 | ((port env) | 11 | ((in env) |
12 | (let loop ((ch (read-char port)) | 12 | (let loop ((ch (read-char in)) |
13 | (acc '())) | 13 | (acc '())) |
14 | (cond | 14 | (cond |
15 | ((not ch) ; after an expansion | 15 | ((not ch) ; after an expansion |
16 | (loop (read-char port) acc)) | 16 | (loop (read-char in) acc)) |
17 | ((eof-object? ch) ; end of file | 17 | ((eof-object? ch) ; end of file |
18 | (list->string (reverse acc))) | 18 | (display (list->string (reverse acc)))) |
19 | ((eq? ch #\#) ; expansion | 19 | ((eq? ch #\#) ; expansion |
20 | (let* ((next (peek-char port)) | 20 | (let* ((next (peek-char in)) |
21 | (proc (assq-ref next (render-specials)))) | 21 | (proc (assq-ref next (render-specials)))) |
22 | (cond | 22 | (cond |
23 | ((eq? next #\\) ; escape character -- #\,( => #,( | 23 | ((eq? next #\\) ; escape character -- #\,( => #,( |
24 | (read-char port) ; skip the \ | 24 | (read-char in) ; skip the \ |
25 | (loop (read-char port) ; continue | 25 | (loop (read-char in) ; continue |
26 | (cons ch acc))) | 26 | (cons ch acc))) |
27 | ((not proc) ; this character isn't special | 27 | ((not proc) ; this character isn't special |
28 | (loop (read-char port) ; continue | 28 | (loop (read-char in) ; continue |
29 | (cons ch acc))) | 29 | (cons ch acc))) |
30 | (else ; look up the reader and run it | 30 | (else ; look up the reader and run it |
31 | (read-char port) ; skip the character | 31 | (read-char in) ; skip the character |
32 | (loop #f (append (let* ((ins (displayed (eval (proc port) env))) | 32 | (loop #f (append (let* ((ins (displayed (eval (proc in) env))) |
33 | (out (assoc ins (render-unprintables)))) | 33 | (out (assoc ins (render-unprintables)))) |
34 | (if out | 34 | (if out |
35 | ((cdr out) next) | 35 | ((cdr out) next) |
36 | (reverse (string->list ins)))) | 36 | (reverse (string->list ins)))) |
37 | acc)))))) | 37 | acc)))))) |
38 | (else (loop (read-char port) ; normal character | 38 | (else (loop (read-char in) ; normal character |
39 | (cons ch acc)))))))) | 39 | (cons ch acc)))))))) |
40 | 40 | ||
41 | (define render-string | 41 | (define render-string |
42 | (case-lambda | 42 | (case-lambda |
43 | ((s) (render-string s (interaction-environment))) | 43 | ((str) (render-string str (interaction-environment))) |
44 | ((s env) | 44 | ((str env) |
45 | (call-with-port (open-input-string s) | 45 | (call-with-port (open-input-string str) |
46 | (lambda (port) | 46 | (lambda (in) |
47 | (render env port)))))) | 47 | (render env in)))))) |
48 | 48 | ||
49 | (define (render->string . args) | 49 | (define (render->string . args) |
50 | (call-with-port (open-output-string) | 50 | (call-with-port (open-output-string) |