Re: small JSON encoder improvement

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
#\,)).


On Thu, Nov 7, 2024 at 12:07 AM Jens Thiele <[email protected]> wrote:

> 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
>
>
> _______________________________________________
> Gauche-devel mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

_______________________________________________
Gauche-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/gauche-devel