about summary refs log tree commit diff stats
path: root/schmaltz.sls
diff options
context:
space:
mode:
Diffstat (limited to 'schmaltz.sls')
-rw-r--r--schmaltz.sls38
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)