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