syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Fix byte string output for control characters

This commit is contained in:
Tony Garnock-Jones 2019-08-18 17:40:31 +01:00
parent 467da29c56
commit 1bb7e1862e
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
implementations/racket/preserves/main.rkt
View File

@ -571,7 +571,7 @@
(define (write-preserve v0 [o (current-output-port)])
(define-syntax-rule (! fmt arg ...) (fprintf o fmt arg ...))
(define (write-stringlike-char c)
(define (write-stringlike-char c [default (lambda (c) (! "~a" c))])
(match c
[#\\ (! "\\\\")]
[#\u08 (! "\\b")]
@ -579,7 +579,7 @@
[#\u0A (! "\\n")]
[#\u0D (! "\\r")]
[#\u09 (! "\\t")]
[_ (! "~a" c)]))
[_ (default c)]))
(define (write-sequence opener comma closer item-writer vs)
(! "~a" opener)
@ -627,12 +627,15 @@
(! "\"")]
[(? bytes?)
(! "#\"")
(for [(c (in-bytes v))]
(match c
(for [(b (in-bytes v))]
(match b
[#x22 (! "\\\"")]
[#x5C (! "\\\\")]
[(? binunescaped?) (! "~a" (integer->char c))]
[_ (! "\\x~a" (~a #:min-width 2 #:align 'right #:left-pad-string "0" (number->string c 16)))]))
[(? binunescaped?) (write-stringlike-char (integer->char b))]
[_ (write-stringlike-char (integer->char b)
(lambda (c) (! "\\x~a" (~a #:min-width 2
#:align 'right
#:left-pad-string "0"
(number->string b 16)))))]))
(! "\"")]
[(? symbol?)
(define s (symbol->string v))