From 7ebcd38c12f989cb849abfad0b5acc13ba51f202 Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Wed, 30 Dec 2020 01:35:42 +0000 Subject: [PATCH 1/3] Fix string printing --- printer.dylan | 46 +++++++++++++++++++++++++++++++++++++-- tests/printer-tests.dylan | 9 ++++---- 2 files changed, 49 insertions(+), 6 deletions(-) diff --git a/printer.dylan b/printer.dylan index 4181f07..2050cfa 100644 --- a/printer.dylan +++ b/printer.dylan @@ -75,8 +75,50 @@ define method print-json (object :: , stream :: ) end method; define method print-json (object :: , stream :: ) - // TODO: check whether Dylan escaped string printing is compatible with json. - format(stream, "%=", object); + write-element(stream, '"'); + let zero :: = as(, '0'); + let a :: = as(, 'a') - 10; + local + method write-hex-digit (code :: ) + write-element(stream, as(, + if (code < 10) zero + code else a + code end)); + end, + method write-unicode-escape (code :: ) + write(stream, "\\u"); + write-hex-digit(ash(logand(code, #xf000), -12)); + write-hex-digit(ash(logand(code, #x0f00), -8)); + write-hex-digit(ash(logand(code, #x00f0), -4)); + write-hex-digit(logand(code, #x000f)); + end; + for (char in object) + let code = as(, char); + case + code <= #x1f => + let escape-char = select (char) + '\b' => 'b'; + '\f' => 'f'; + '\n' => 'n'; + '\r' => 'r'; + '\t' => 't'; + otherwise => #f; + end; + if (escape-char) + write-element(stream, '\\'); + write-element(stream, escape-char); + else + write-unicode-escape(code); + end; + char == '"' => + write(stream, "\\\""); + char == '\\' => + write(stream, "\\\\"); + code < 127 => // omits DEL + write-element(stream, char); + otherwise => + write-unicode-escape(code); + end case; + end for; + write-element(stream, '"'); end method; define method print-json (object :: , stream :: ) diff --git a/tests/printer-tests.dylan b/tests/printer-tests.dylan index 6f0b63e..f81e2f6 100644 --- a/tests/printer-tests.dylan +++ b/tests/printer-tests.dylan @@ -28,10 +28,11 @@ end test; define test test-print-string () assert-equal(jprint(""), #:raw:{""}); assert-equal(jprint("a"), #:raw:{"a"}); - assert-equal(jprint("a\nb"), #:raw:{"a\nb"}); - assert-equal(jprint("a\tb"), #:raw:{"a\tb"}); - assert-equal(jprint(#:raw:{a\b}), #:raw:{"a\\b"}); - assert-equal(jprint(#:raw:{a\\c}), #:raw:{"a\\\\c"}); + assert-equal(jprint("a\\b"), #:raw:{"a\\b"}); + assert-equal(jprint("\0"), #:raw:{"\u0000"}); + assert-equal(jprint("\b\f\n\r\t"), #:raw:{"\b\f\n\r\t"}); + assert-equal(jprint("\<1f>"), #:raw:{"\u001f"}); + assert-equal(jprint("a b"), #:raw:{"a b"}); end test; define test test-print-sequence () From 556371653cd7107a509a968d61474c2a7e8cb98b Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Wed, 30 Dec 2020 01:56:41 +0000 Subject: [PATCH 2/3] Export --- library.dylan | 1 + 1 file changed, 1 insertion(+) diff --git a/library.dylan b/library.dylan index 888b34b..06f31fd 100644 --- a/library.dylan +++ b/library.dylan @@ -11,6 +11,7 @@ end; define module json create , + , parse-json, From 329ff5d738d80e0f169a5253bb6444f6bc39d03b Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Wed, 30 Dec 2020 05:04:24 +0000 Subject: [PATCH 3/3] Rename print to print-json, print-json to do-print-json Undo my previous drain-bramage. print would conflict with print:print:io. I need to stop struggling with dylan being a LISP-1 and embrace the long names, I guess. --- library.dylan | 4 ++-- printer.dylan | 60 ++++++++++++++++++++++++++++----------------------- 2 files changed, 35 insertions(+), 29 deletions(-) diff --git a/library.dylan b/library.dylan index 06f31fd..10f2375 100644 --- a/library.dylan +++ b/library.dylan @@ -15,8 +15,8 @@ define module json parse-json, - print, // call this - print-json, // implement this + print-json, // call this + do-print-json, // implement this $null; end; diff --git a/printer.dylan b/printer.dylan index 2050cfa..b76ed34 100644 --- a/printer.dylan +++ b/printer.dylan @@ -29,23 +29,29 @@ Notes on pretty printing: define thread variable *indent* :: false-or() = #f; define thread variable *sort-keys?* :: = #f; -// Call this to print an object on `stream` in json format. If `indent` is -// false `object` is printed with minimal whitespace. If `indent` is an integer -// then use pretty printing and output `indent` spaces for each indent level. -// If `sort-keys?` is true then output object keys in lexicographical order. -define function print +// Print an object in json format. +// +// Parameters: +// object: The object to print. +// stream: Stream on which to do output. +// indent: If false, `object` is printed with minimal whitespace. If an integer, +// then use pretty printing and output `indent` spaces for each indent level. +// sort-keys?: If true, output object keys in lexicographical order. +define function print-json (object :: , stream :: , - #key indent :: false-or(), sort-keys? :: ); - if (indent) - dynamic-bind (*indent* = make(, size: indent, fill: ' '), - *sort-keys?* = sort-keys?, - *print-pretty?* = #t) // bug: shouldn't be required. - io/printing-logical-block(stream) - print-json(object, stream); - end; - end - else - print-json(object, stream); + #key indent :: false-or(), + sort-keys? :: ) + dynamic-bind (*sort-keys?* = sort-keys?) + if (indent) + dynamic-bind (*indent* = make(, size: indent, fill: ' '), + *print-pretty?* = #t) // bug: shouldn't be required. + io/printing-logical-block(stream) + do-print-json(object, stream); + end; + end + else + do-print-json(object, stream); + end; end; end function; @@ -56,25 +62,25 @@ end function; // // If `indent:` was passed to `print` then `stream` will be a pretty printing // stream and the io:pprint module may be used to implement pretty printing. -define open generic print-json (object :: , stream :: ); +define open generic do-print-json (object :: , stream :: ); -define method print-json (object == $null, stream :: ) +define method do-print-json (object == $null, stream :: ) write(stream, "null"); end method; -define method print-json (object :: , stream :: ) +define method do-print-json (object :: , stream :: ) write(stream, integer-to-string(object)); end method; -define method print-json (object :: , stream :: ) +define method do-print-json (object :: , stream :: ) write(stream, float-to-string(object)); end method; -define method print-json (object :: , stream :: ) +define method do-print-json (object :: , stream :: ) write(stream, if (object) "true" else "false" end); end method; -define method print-json (object :: , stream :: ) +define method do-print-json (object :: , stream :: ) write-element(stream, '"'); let zero :: = as(, '0'); let a :: = as(, 'a') - 10; @@ -121,7 +127,7 @@ define method print-json (object :: , stream :: ) write-element(stream, '"'); end method; -define method print-json (object :: , stream :: ) +define method do-print-json (object :: , stream :: ) io/printing-logical-block (stream, prefix: "[", suffix: "]") for (o in object, i from 0) @@ -135,7 +141,7 @@ define method print-json (object :: , stream :: ) io/pprint-newline(#"fill", stream); end; end if; - print-json(o, stream); + do-print-json(o, stream); end for; end; end method; @@ -144,17 +150,17 @@ end method; // one element per line. Not sure if the pretty printer can be coaxed into // doing that. Might be easier to do it (even just the current functionality) // by hand. -define method print-json (object :: , stream :: ) +define method do-print-json (object ::
, stream :: ) local method print-key-value-pairs-body (stream, i, key, value) if (i > 0) write(stream, ","); *indent* & io/pprint-newline(#"mandatory", stream); end if; - print-json(key, stream); + do-print-json(key, stream); write(stream, ":"); *indent* & write(stream, " "); - print-json(value, stream); + do-print-json(value, stream); end method, method print-key-value-pairs (stream :: ) if (*sort-keys?*)