Re: small JSON encoder improvement
Jens Thiele <[email protected]> Thu, 07 Nov 2024 11:07:23 +0100
| Newsgroups | gmane.lisp.scheme.gauche |
|---|---|
| Message-ID | <[email protected]> |
Hi,
a final version replacing the remaining (display comma). Any chances to
get that merged?
greetings
jens
diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm
index 73fd021ab..83be77fca 100644
--- a/lib/rfc/json.scm
+++ b/lib/rfc/json.scm
@@ -245,44 +245,45 @@
"can't convert Scheme object to json:" obj)]))
(define (print-object obj)
- (display "{")
- (fold (^[attr comma]
- (unless (pair? attr)
- (error <json-construct-error> :object obj
- "construct-json needs an assoc list or dictionary, \
- but got:" obj))
- (display comma)
- (print-string (x->string (car attr)))
- (display ":")
- (print-value (cdr attr))
- ",")
- "" obj)
- (display "}"))
+ (write-char #\{)
+ (for-each-with-index (lambda(i attr)
+ (unless (pair? attr)
+ (error <json-construct-error> :object obj
+ "construct-json needs an assoc list or dictionary, \
+ but got:" obj))
+ (when (> i 0)
+ (write-char #\,))
+ (print-string (x->string (car attr)))
+ (write-char #\:)
+ (print-value (cdr attr)))
+ obj)
+ (write-char #\}))
(define (print-array obj)
- (display "[")
+ (write-char #\[)
(for-each-with-index (^[i val]
- (unless (zero? i) (display ","))
+ (unless (zero? i) (write-char #\,))
(print-value val))
- obj)
- (display "]"))
+ obj)
+ (write-char #\]))
(define (print-instance obj) ;<json-mixin>
(let1 class (class-of obj)
- (display "{")
+ (write-char #\{)
(fold (^[slot comma]
(if-let1 json-name (slot-definition-option slot :json-name #f)
(begin
- (display comma)
+ (when (not (char=? comma #\null))
+ (write-char comma))
(print-string (if (eqv? json-name #t)
(x->string (slot-definition-name slot))
(x->string json-name)))
- (display ":")
+ (write-char #\:)
(print-value (slot-ref obj (slot-definition-name slot)))
- ",")
+ #\,)
comma))
- "" (class-slots class))
- (display "}")))
+ #\null (class-slots class))
+ (write-char #\})))
(define (print-number num)
(cond [(or (not (real? num)) (not (finite? num)))
@@ -307,9 +308,9 @@
(if (>= code #x10000)
(for-each hexescape (ucs4->utf16 code))
(hexescape code)))]))
- (display "\"")
+ (write-char #\")
(string-for-each print-char str)
- (display "\""))
+ (write-char #\"))
(define (construct-json x :optional (oport (current-output-port)))
(with-output-to-port oport