Re: small JSON encoder improvement

Shiro Kawai <[email protected]> writes:

> Sure, but if we don't use the trick that `(display comma)` becomes no-op
> when comma is an empty string, then it may be clearer to carry around a
> boolean flag (e.g. comma-needed?) and do (when comma-needed? (write-char
> #\,)).

changed it accordingly:

diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm
index 73fd021ab..b9bcea5db 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 "{")
-    (fold (^[slot comma]
+    (write-char #\{)
+    (fold (^[slot comma-needed?]
             (if-let1 json-name (slot-definition-option slot :json-name #f)
               (begin
-                (display comma)
+                (when comma-needed?
+                  (write-char #\,))
                 (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 "}")))
+                #t)
+              comma-needed?))
+          #f (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