Re: small JSON encoder improvement
Shiro Kawai <[email protected]> Fri, 8 Nov 2024 00:53:40 -1000
| Newsgroups | gmane.lisp.scheme.gauche |
|---|---|
| Message-ID | <CALN0JNFiiR_4bSHwtTScobwYPaWt7nrG=JiYqJc6sq_YNMyLXg@mail.gmail.com> |
--===============6459300835282699582== Content-Type: multipart/alternative; boundary="000000000000fa3c020626649080" --000000000000fa3c020626649080 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable Thanks. Patch applied. On Thu, Nov 7, 2024 at 9:17=E2=80=AFPM Jens Thiele <[email protected]> wrote: > Shiro Kawai <[email protected]> writes: > > > Oops, there was a reason we used `fold` in `print-object`. A dictiona= ry > > can be passed, which is traversable but not necessarily orderable, i.e. > > `for-each-with-index` can't be used. > > Ah sorry, missed that. Fixed it in the spirit of print-instance: > > diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm > index 73fd021ab..a8fdd7612 100644 > --- a/lib/rfc/json.scm > +++ b/lib/rfc/json.scm > @@ -245,44 +245,46 @@ > "can't convert Scheme object to json:" obj)])) > > (define (print-object obj) > - (display "{") > - (fold (^[attr comma] > + (write-char #\{) > + (fold (^[attr comma-needed?] > (unless (pair? attr) > (error <json-construct-error> :object obj > "construct-json needs an assoc list or dictionary, \ > but got:" obj)) > - (display comma) > + (when comma-needed? > + (write-char #\,)) > (print-string (x->string (car attr))) > - (display ":") > + (write-char #\:) > (print-value (cdr attr)) > - ",") > - "" obj) > - (display "}")) > + #t) > + #f 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 +309,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 > --000000000000fa3c020626649080 Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable <div dir=3D"ltr">Thanks.=C2=A0 Patch applied.<div><br></div><div><br></div>= </div><br><div class=3D"gmail_quote"><div dir=3D"ltr" class=3D"gmail_attr">= On Thu, Nov 7, 2024 at 9:17=E2=80=AFPM Jens Thiele <<a href=3D"mailto:ka= [email protected]">[email protected]</a>> wrote:<br></div><blockquote class=3D"g= mail_quote" style=3D"margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204= ,204,204);padding-left:1ex">Shiro Kawai <<a href=3D"mailto:shiro.kawai@g= mail.com" target=3D"_blank">[email protected]</a>> writes:<br> <br> > Oops, there was a reason we used `fold` in `print-object`.=C2=A0 =C2= =A0A dictionary<br> > can be passed, which is traversable but not necessarily orderable, i.e= .<br> > `for-each-with-index` can't be used.<br> <br> Ah sorry, missed that. Fixed it in the spirit of print-instance:<br> <br> diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm<br> index 73fd021ab..a8fdd7612 100644<br> --- a/lib/rfc/json.scm<br> +++ b/lib/rfc/json.scm<br> @@ -245,44 +245,46 @@<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 (write-char #\{)<br> +=C2=A0 (fold (^[attr comma-needed?]<br> =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(error <json-construct-e= rror> :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 =C2= =A0but 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 (when comma-needed?<br> +=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(print-string (x->string (car a= ttr)))<br> -=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (display ":")<br> +=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(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 =C2=A0 =C2=A0 =C2=A0 =C2=A0 #t)<br> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 #f 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 +309,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> _______________________________________________<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> --000000000000fa3c020626649080-- --===============6459300835282699582== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline --===============6459300835282699582== 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 --===============6459300835282699582==--