Re: small JSON encoder improvement

Jens Thiele <[email protected]> writes:

> in my test I see a suprisingly big performance improvement with this
> one:
> 30s instead of 38s
>
> diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm
> index 73fd021ab..48fcd5956 100644
> --- a/lib/rfc/json.scm
> +++ b/lib/rfc/json.scm
> @@ -307,9 +307,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

there are some more display calls that can be replaced with write-char:

diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm
index 73fd021ab..4c71eec86 100644
--- a/lib/rfc/json.scm
+++ b/lib/rfc/json.scm
@@ -245,7 +245,7 @@
                      "can't convert Scheme object to json:" obj)]))
 
 (define (print-object obj)
-  (display "{")
+  (write-char #\{)
   (fold (^[attr comma]
           (unless (pair? attr)
             (error <json-construct-error> :object obj
@@ -253,23 +253,23 @@
                     but got:" obj))
           (display comma)
           (print-string (x->string (car attr)))
-          (display ":")
+          (write-char #\:)
           (print-value (cdr attr))
           ",")
         "" obj)
-  (display "}"))
+  (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
@@ -277,12 +277,12 @@
                 (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 "}")))
+    (write-char #\})))
 
 (define (print-number num)
   (cond [(or (not (real? num)) (not (finite? num)))
@@ -307,9 +307,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