Skip to content

Commit

Permalink
Merge pull request #939 from raviqqe/bug/write-char
Browse files Browse the repository at this point in the history
Handle basic special characters in `write`
  • Loading branch information
ashinn authored Sep 29, 2023
2 parents f9908f1 + 4a4a155 commit fe93067
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 1 deletion.
18 changes: 17 additions & 1 deletion lib/srfi/38.scm
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,17 @@
;; This code was written by Alex Shinn in 2009 and placed in the
;; Public Domain. All warranties are disclaimed.

(define escaped-chars
'((#\alarm . "alarm")
(#\backspace . "backspace")
(#\delete . "delete")
(#\escape . "escape")
(#\newline . "newline")
(#\null . "null")
(#\return . "return")
(#\space . "space")
(#\tab . "tab")))

(define (raise-typed-error type)
(lambda (msg . args) (raise (make-exception type msg args #f #f))))
(define read-error (raise-typed-error 'read))
Expand Down Expand Up @@ -111,7 +122,12 @@
(and (type? type) (type-printer type)))
=> (lambda (printer) (printer x wr out)))
((null? x) (display "()" out))
((char? x) (display "#\\" out) (write-char x out))
((char? x)
(display "#\\" out)
(let ((pair (assv x escaped-chars)))
(if pair
(display (cdr pair) out)
(write-char x out))))
((symbol? x) (write x out))
((number? x) (display (number->string x) out))
((eq? x #t) (display "#t" out))
Expand Down
2 changes: 2 additions & 0 deletions lib/srfi/38/test.sld
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@
(vector-set! x 2 x)
x))

(test-io "#\\newline" #\newline)

(test '+.! (read-from-string "+.!"))

(test 255 (read-from-string "#xff"))
Expand Down

0 comments on commit fe93067

Please sign in to comment.