Re: small JSON encoder improvement
Shiro Kawai <[email protected]> Thu, 7 Nov 2024 20:16:57 -1000
| Newsgroups | gmane.lisp.scheme.gauche |
|---|---|
| Message-ID | <CALN0JNE0O1Wjhhp6Uu0SfJLNAn2zFeOFxDqQBMnEJSuwcCU=fg@mail.gmail.com> |
--===============3364990592577255877== Content-Type: multipart/alternative; boundary="0000000000005abf97062660b395" --0000000000005abf97062660b395 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable Oops, there was a reason we used `fold` in `print-object`. A dictionary can be passed, which is traversable but not necessarily orderable, i.e. `for-each-with-index` can't be used. On Thu, Nov 7, 2024 at 9:16=E2=80=AFAM Jens Thiele <[email protected]> wrote: > Shiro Kawai <[email protected]> writes: > > > Sure, but if we don't use the trick that `(display comma)` becomes no-o= p > > 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-cha= r > > #\,)). > > 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 (>=3D 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 > --0000000000005abf97062660b395 Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable <div dir=3D"ltr">Oops, there was a reason we used `fold` in `print-object`.= =C2=A0 =C2=A0A dictionary can be passed, which is traversable but not neces= sarily orderable, i.e. `for-each-with-index` can't be used.</div><br><d= iv class=3D"gmail_quote"><div dir=3D"ltr" class=3D"gmail_attr">On Thu, Nov = 7, 2024 at 9:16=E2=80=AFAM Jens Thiele <<a href=3D"mailto:[email protected]= ">[email protected]</a>> wrote:<br></div><blockquote class=3D"gmail_quote" = style=3D"margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);pa= dding-left:1ex">Shiro Kawai <<a href=3D"mailto:[email protected]" ta= rget=3D"_blank">[email protected]</a>> writes:<br> <br> > Sure, but if we don't use the trick that `(display comma)` becomes= no-op<br> > when comma is an empty string, then it may be clearer to carry around = a<br> > boolean flag (e.g. comma-needed?) and do (when comma-needed? (write-ch= ar<br> > #\,)).<br> <br> changed it accordingly:<br> <br> diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm<br> index 73fd021ab..b9bcea5db 100644<br> --- a/lib/rfc/json.scm<br> +++ b/lib/rfc/json.scm<br> @@ -245,44 +245,45 @@<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 "can't convert Scheme object to json:" obj)]))<br> <br> =C2=A0(define (print-object obj)<br> -=C2=A0 (display "{")<br> -=C2=A0 (fold (^[attr comma]<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (unless (pair? attr)<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (error <json-construct-error&= gt; :object obj<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0"= ;construct-json needs an assoc list or dictionary, \<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 but = got:" obj))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (display comma)<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (print-string (x->string (car attr))= )<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (display ":")<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (print-value (cdr attr))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ",")<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 "" obj)<br> -=C2=A0 (display "}"))<br> +=C2=A0 (write-char #\{)<br> +=C2=A0 (for-each-with-index (lambda(i attr)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (unless (pair? attr)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (error <json-construct-error> :object obj<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0"construct-json needs an = assoc list or dictionary, \<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0but got:" obj))<br= > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (when (> i 0)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (write-char #\,))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (print-string (x->string (car attr)))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (write-char #\:)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (print-value (cdr attr)))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 obj)<br> +=C2=A0 (write-char #\}))<br> <br> =C2=A0(define (print-array obj)<br> -=C2=A0 (display "[")<br> +=C2=A0 (write-char #\[)<br> =C2=A0 =C2=A0(for-each-with-index (^[i val]<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0(unless (zero? i) (display ","))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0(unless (zero? i) (write-char #\,))<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (print-value val))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0obj)<br> -=C2=A0 (display "]"))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 obj)<br> +=C2=A0 (write-char #\]))<br> <br> =C2=A0(define (print-instance obj)=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= ;<json-mixin><br> =C2=A0 =C2=A0(let1 class (class-of obj)<br> -=C2=A0 =C2=A0 (display "{")<br> -=C2=A0 =C2=A0 (fold (^[slot comma]<br> +=C2=A0 =C2=A0 (write-char #\{)<br> +=C2=A0 =C2=A0 (fold (^[slot comma-needed?]<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(if-let1 json-name (slot-de= finition-option slot :json-name #f)<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(begin<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (display comma)<br= > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when comma-needed= ?<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (write-char= #\,))<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(print-string= (if (eqv? json-name #t)<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(x->string (slot-definition= -name slot))<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(x->string json-name)))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (display ":&q= uot;)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (write-char #\:)<b= r> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(print-value = (slot-ref obj (slot-definition-name slot)))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ",")<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 comma))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 "" (class-slots class))<br> -=C2=A0 =C2=A0 (display "}")))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 #t)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 comma-needed?))<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 #f (class-slots class))<br> +=C2=A0 =C2=A0 (write-char #\})))<br> <br> =C2=A0(define (print-number num)<br> =C2=A0 =C2=A0(cond [(or (not (real? num)) (not (finite? num)))<br> @@ -307,9 +308,9 @@<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (if (>=3D code #x10000)= <br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (for-each hexescape= (ucs4->utf16 code))<br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (hexescape code)))]= ))<br> -=C2=A0 (display "\"")<br> +=C2=A0 (write-char #\")<br> =C2=A0 =C2=A0(string-for-each print-char str)<br> -=C2=A0 (display "\""))<br> +=C2=A0 (write-char #\"))<br> <br> =C2=A0(define (construct-json x :optional (oport (current-output-port)))<br= > =C2=A0 =C2=A0(with-output-to-port oport<br> <br> <br> _______________________________________________<br> Gauche-devel mailing list<br> <a href=3D"mailto:[email protected]" target=3D"_blank">Gau= [email protected]</a><br> <a href=3D"https://lists.sourceforge.net/lists/listinfo/gauche-devel" rel= =3D"noreferrer" target=3D"_blank">https://lists.sourceforge.net/lists/listi= nfo/gauche-devel</a><br> </blockquote></div> --0000000000005abf97062660b395-- --===============3364990592577255877== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline --===============3364990592577255877== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Gauche-devel mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/gauche-devel --===============3364990592577255877==--