liii_json.tmu

<TMU|<tuple|1.0.5|1.2.9.8>>

<style|<tuple|generic|chinese|goldfish|literate|reduced-margins|python>>

<\body>
  <\hide-preamble>
    <assign|r7rs|<flag|R7RS|dark cyan>>

    <assign|srfi|<flag|SRFI|dark red>>

    <assign|font|math=Latin Modern Math,cjk=Noto CJK SC,CMU>

    <assign|typehint|<macro|body|<goldfish-lang|<arg|body>>>>
  </hide-preamble>

  <chapter|JSON>

  <subsection|许可证>

  <\goldfish-chunk|json/liii/json.scm|false|true>
    ;; \ MIT License

    \;

    ; \ Copyright guenchi (c) 2018 - 2019

    ; \ \ \ \ \ \ \ \ \ \ \ Da Shen (c) 2024 - 2025

    \ \ \ \ \ 

    ; \ Permission is hereby granted, free of charge, to any person obtaining a copy

    ; \ of this software and associated documentation files (the "Software"), to deal

    ; \ in the Software without restriction, including without limitation the rights

    ; \ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

    ; \ copies of the Software, and to permit persons to whom the Software is

    ; \ furnished to do so, subject to the following conditions:

    \ \ \ \ \ 

    ; \ The above copyright notice and this permission notice shall be included in all

    ; \ copies or substantial portions of the Software.

    \ \ \ \ \ 

    ; \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

    ; \ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

    ; \ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

    ; \ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

    ; \ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

    ; \ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE

    ; \ SOFTWARE.

    \;
  </goldfish-chunk>

  <\goldfish-chunk|json/tests/json-test.scm|false|true>
    ;

    ; Copyright (C) 2024 The Goldfish Scheme Authors

    ;

    ; Licensed under the Apache License, Version 2.0 (the "License");

    ; you may not use this file except in compliance with the License.

    ; You may obtain a copy of the License at

    ;

    ; http://www.apache.org/licenses/LICENSE-2.0

    ;

    ; Unless required by applicable law or agreed to in writing, software

    ; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT

    ; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the

    ; License for the specific language governing permissions and limitations

    ; under the License.

    ;

    \;
  </goldfish-chunk>

  <subsection|接口>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define-library (liii json)

    (import (liii chez) (liii alist) (liii list) (liii string))

    (export\ 

    \ \ json-string-escape json-string-unescape string-\<gtr\>json json-\<gtr\>string

    \ \ json-ref json-ref*

    \ \ json-set json-set* json-push json-push* json-drop json-drop* json-reduce json-reduce*)

    (begin

    \;
  </goldfish-chunk>

  <subsection|测试>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (set! *load-path* (cons "json" *load-path*))

    \;

    (import (liii check)

    \ \ \ \ \ \ \ \ (liii json))

    \;

    (check-set-mode! 'report-failed)

    \;
  </goldfish-chunk>

  <subsection|实现>

  <paragraph|json-string-escape>

  下面的实现同样适用于输入字符串是UTF-8的情况。

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define (json-string-escape str)

    \ \ (define (escape-char c)

    \ \ \ \ (case c

    \ \ \ \ \ \ ((#\\") "\\\\\\"")

    \ \ \ \ \ \ ((#\\\\) "\\\\\\\\")

    \ \ \ \ \ \ ((#\\/) "\\\\/")

    \ \ \ \ \ \ ((#\\backspace) "\\\\b")

    \ \ \ \ \ \ ((#\\xc) "\\\\f")

    \ \ \ \ \ \ ((#\\newline) "\\\\n")

    \ \ \ \ \ \ ((#\\return) "\\\\r")

    \ \ \ \ \ \ ((#\\tab) "\\\\t")

    \ \ \ \ \ \ (else (string c))))

    \ \ \ \ \ \ \ \ 

    \ \ (let ((escaped (string-fold (lambda (ch result) (string-append result (escape-char ch))) "" str)))

    \ \ \ \ (string-append "\\"" escaped "\\"")))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (check (json-string-escape "hello") =\<gtr\> "\\"hello\\"")

    (check (json-string-escape "hello\\"world") =\<gtr\> "\\"hello\\\\\\"world\\"")

    (check (json-string-escape "hello\\\\world") =\<gtr\> "\\"hello\\\\\\\\world\\"")

    (check (json-string-escape "hello/world") =\<gtr\> "\\"hello\\\\/world\\"")

    (check (json-string-escape "hello\\bworld") =\<gtr\> "\\"hello\\\\bworld\\"")

    (check (json-string-escape "hello\\fworld") =\<gtr\> "\\"hello\\\\fworld\\"")

    (check (json-string-escape "hello\\nworld") =\<gtr\> "\\"hello\\\\nworld\\"")

    (check (json-string-escape "hello\\rworld") =\<gtr\> "\\"hello\\\\rworld\\"")

    (check (json-string-escape "hello\\tworld") =\<gtr\> "\\"hello\\\\tworld\\"")

    \;
  </goldfish-chunk>

  <paragraph|string-\<gtr\>json>

  <subparagraph|测试>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (check (string-\<gtr\>json "{\\"age\\":18}") =\<gtr\> `(("age" . 18)))

    (check (string-\<gtr\>json "{age:18}") =\<gtr\> `((age . 18)))

    (check (string-\<gtr\>json "{\\"name\\":\\"中文\\"}") =\<gtr\> `(("name" . "中文")))\ 

    \;
  </goldfish-chunk>

  <\session|python|default>
    <\unfolded-io>
      \<gtr\>\<gtr\>\<gtr\>\ 
    <|unfolded-io>
      json.loads("{\\"name\\":\\"中文\\"}")
    <|unfolded-io>
      {'name': '\<less\>#4E2D\<gtr\>\<less\>#6587\<gtr\>'}
    </unfolded-io>

    <\input>
      \<gtr\>\<gtr\>\<gtr\>\ 
    <|input>
      \;
    </input>
  </session>

  测试边界情况

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (check (string-\<gtr\>json "\\"\\"") =\<gtr\> "")

    \;
  </goldfish-chunk>

  测试转义字符

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\nBob\\"}") =\<gtr\> '(("name" . "Alice\\nBob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\tBob\\"}") =\<gtr\> '(("name" . "Alice\\tBob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\rBob\\"}") =\<gtr\> '(("name" . "Alice\\rBob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\bBob\\"}") =\<gtr\> '(("name" . "Alice\\bBob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\fBob\\"}") =\<gtr\> '(("name" . "Alice\\fBob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\\\\\Bob\\"}") =\<gtr\> '(("name" . "Alice\\\\Bob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\\\/Bob\\"}") =\<gtr\> '(("name" . "Alice/Bob")))

    (check (string-\<gtr\>json "{\\"name\\":\\"Alice\\\\\\"Bob\\"}") =\<gtr\> '(("name" . "Alice\\"Bob")))

    \;
  </goldfish-chunk>

  \;

  <subparagraph|实现>

  <\scm-chunk|json/liii/json.scm|true|true>
    (define (string-length-sum strings)

    \ \ (let loop ((o 0)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (rest strings))

    \ \ \ \ (cond

    \ \ \ \ \ ((eq? '() rest) o)

    \ \ \ \ \ (else

    \ \ \ \ \ \ (loop (+ o (string-length (car rest)))

    \ \ \ \ \ \ \ \ \ \ \ \ (cdr rest))))))

    \;

    (define (fast-string-list-append strings)

    \ \ (let* ((output-length (string-length-sum strings))

    \ \ \ \ \ \ \ \ \ (output (make-string output-length #\\_))

    \ \ \ \ \ \ \ \ \ (fill 0))

    \ \ \ \ (let outer ((rest strings))

    \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ ((eq? '() rest) output)

    \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ (let* ((s (car rest))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (n (string-length s)))

    \ \ \ \ \ \ \ \ \ \ (let inner ((i 0))

    \ \ \ \ \ \ \ \ \ \ \ \ (cond ((= i n) 'done)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-set! output fill (string-ref s i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! fill (+ fill 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (inner (+ i 1))))))

    \ \ \ \ \ \ \ \ (outer (cdr rest)))))))

    \;

    (define (handle-escape-char s end len)

    \ \ (let ((next-char (if (\<less\> (+ end 1) len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-ref s (+ end 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #f)))

    \ \ \ \ (case next-char

    \ \ \ \ \ \ ((#\\")

    \ \ \ \ \ \ \ (values "\\"" (+ end 2)))

    \ \ \ \ \ \ ((#\\\\)

    \ \ \ \ \ \ \ (values "\\\\" (+ end 2)))

    \ \ \ \ \ \ ((#\\/)

    \ \ \ \ \ \ \ (values "/" (+ end 2)))

    \ \ \ \ \ \ ((#\\b)

    \ \ \ \ \ \ \ (values "\\b" (+ end 2)))

    \ \ \ \ \ \ ((#\\f)

    \ \ \ \ \ \ \ (values "\\f" (+ end 2)))

    \ \ \ \ \ \ ((#\\n)

    \ \ \ \ \ \ \ (values "\\n" (+ end 2)))

    \ \ \ \ \ \ ((#\\r)

    \ \ \ \ \ \ \ (values "\\r" (+ end 2)))

    \ \ \ \ \ \ ((#\\t)

    \ \ \ \ \ \ \ (values "\\t" (+ end 2)))

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ (values (string (string-ref s end) next-char) (+ end 2))))))

    \;

    (define string-\<gtr\>json

    \ \ (lambda (s)

    \ \ \ \ (read (open-input-string

    \ \ \ \ \ \ (let loop

    \ \ \ \ \ \ \ \ ((s s) (bgn 0) (end 0) (rst '()) (len (string-length s)) (quts? #f) (lst '(#t)))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((and (= len 2) (string=? s "\\"\\""))

    \ \ \ \ \ \ \ \ \ \ \ "\\"\\"")

    \ \ \ \ \ \ \ \ \ \ ((= end len)

    \ \ \ \ \ \ \ \ \ \ \ (fast-string-list-append (reverse rst)))

    \ \ \ \ \ \ \ \ \ \ ((and quts? (char=? (string-ref s end) #\\\\))

    \ \ \ \ \ \ \ \ \ \ \ (let-values (((escaped-char new-end) (handle-escape-char s end len)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s bgn new-end rst len quts? lst)))

    \ \ \ \ \ \ \ \ \ \ ((and quts? (not (char=? (string-ref s end) #\\")))

    \ \ \ \ \ \ \ \ \ \ \ (loop s bgn (+ 1 end) rst len quts? lst))

    \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ (case (string-ref s end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\{)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end) "((" ) rst) len quts? (cons #t lst)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\})

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end) "))") rst) len quts? (loose-cdr lst)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\[)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end) "#(") rst) len quts? (cons #f lst)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\])

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end) ")") rst) len quts? (loose-cdr lst)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\:)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end) " . ") rst) len quts? lst))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\,)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s (+ 1 end) (+ 1 end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s bgn end)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (loose-car lst) ")(" " ")) rst) len quts? lst))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\\")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s bgn (+ 1 end) rst len (not quts?) lst))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop s bgn (+ 1 end) rst len quts? lst))))))))))

    \;
  </scm-chunk>

  <paragraph|json-\<gtr\>string>

  <\scm-chunk|json/tests/json-test.scm|true|true>
    (check (json-\<gtr\>string '(("age" . 18))) =\<gtr\> "{\\"age\\":18}")

    (check (json-\<gtr\>string #(0 1 2 3)) =\<gtr\> "[0,1,2,3]")

    \;
  </scm-chunk>

  <\scm-chunk|json/liii/json.scm|true|true>
    (define json-\<gtr\>string

    \ \ (lambda (lst)

    \ \ \ \ (define f

    \ \ \ \ \ \ (lambda (x)

    \ \ \ \ \ \ \ \ (cond \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ ((string? x) (json-string-escape x)) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ ((number? x) (number-\<gtr\>string x)) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ ((symbol? x) (symbol-\<gtr\>string x)))))

    \ \ \ \ (define c

    \ \ \ \ \ \ (lambda (x)

    \ \ \ \ \ \ \ \ (if (zero? x) "" ",")))

    \ \ \ \ (let l ((lst lst)(x (if (vector? lst) "[" "{")))

    \ \ \ \ \ \ (if (vector? lst)

    \ \ \ \ \ \ \ \ (string-append x\ 

    \ \ \ \ \ \ \ \ \ \ (let t ((len (vector-length lst))(n 0)(y ""))

    \ \ \ \ \ \ \ \ \ \ \ \ (if (\<less\> n len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (t len (+ n 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((k (vector-ref lst n)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (atom? k)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (vector? k)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l k (string-append y (c n) "["))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append y (c n) (f k)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l k (string-append y (c n) "{")))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append y "]"))))

    \ \ \ \ \ \ \ \ (let ((k (cdar lst)))

    \ \ \ \ \ \ \ \ \ \ (if (null? (cdr lst))

    \ \ \ \ \ \ \ \ \ \ \ \ (string-append x "\\"" (caar lst) "\\":"

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((list? k)(l k "{"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((vector? k)(l k "["))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (f k))) "}")

    \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr lst)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cond\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((list? k)(string-append x "\\"" (caar lst) "\\":" (l k "{") ","))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((vector? k)(string-append x "\\"" (caar lst) "\\":" (l k "[") ","))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (string-append x "\\"" (caar lst) "\\":" (f k) ","))))))))))

    \;
  </scm-chunk>

  <paragraph|json-ref>

  <\scm-chunk|json/liii/json.scm|true|true>
    (define json-ref

    \ \ (lambda (x k)

    \ \ \ \ (define return

    \ \ \ \ \ \ (lambda (x)

    \ \ \ \ \ \ \ \ (if (symbol? x)

    \ \ \ \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((symbol=? x 'true) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((symbol=? x 'false) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((symbol=? x 'null) '())

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else x))

    \ \ \ \ \ \ \ \ \ \ \ \ x)))

    \ \ \ \ (if (vector? x)

    \ \ \ \ \ \ \ \ (return (vector-ref x k))

    \ \ \ \ \ \ \ \ (let l ((x x) (k k))

    \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) k)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (return (cdar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr x) k)))))))

    \;
  </scm-chunk>

  <\scm-chunk|json/tests/json-test.scm|true|true>
    (check (json-ref '(("age" . 18)) "age") =\<gtr\> 18)

    (check (json-ref #(0 1 2 3) 0) =\<gtr\> 0)

    \;
  </scm-chunk>

  <paragraph|json-ref*>

  <\scm-chunk|json/liii/json.scm|true|true>
    (define (json-ref* j . keys)

    \ \ (let loop ((expr j) (keys keys))

    \ \ \ \ (if (null? keys)

    \ \ \ \ \ \ \ \ expr

    \ \ \ \ \ \ \ \ (loop (json-ref expr (car keys)) (cdr keys)))))

    \;
  </scm-chunk>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (check (json-ref* `((bob . ((age . 18) (sex . male)))) 'bob 'age) =\<gtr\> 18)

    \;
  </goldfish-chunk>

  <paragraph|json-set><typehint|(input-json verify value) =\<gtr\> return-json>

  <scm|json-set>可以更改json中最外层中的键<scm|verify>对应的值<scm|value>。输入的json数据不会被更改，被修改之后的json数据作为返回值返回。

  <scm|value>可以是一个值或一个函数。当它是一个值时，它将直接替换旧的值。当它是一个函数时，它必须接受一个参数（键的当前值）并返回一个新值来替换旧值。不要使用<scm|#t>，<scm|#f>或者<scm|'()>作为值，应当使用<scm|'true>，<scm|'false>或者<scm|'null>。

  <subparagraph|测试：verify是symbol>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((j0 `((age . 18) (sex . male)))

    \ \ \ \ \ \ \ (j1 (json-set j0 'age 19))

    \ \ \ \ \ \ \ (j2 (json-set j0 'age 'null)))

    \ \ \ \ \ \ (check (json-ref j0 'age) =\<gtr\> 18)

    \ \ \ \ \ \ (check (json-ref j1 'age) =\<gtr\> 19)

    \ \ \ \ \ \ (check (json-ref j2 'age) =\<gtr\> '()))

    \;
  </goldfish-chunk>

  <subparagraph|测试：verify是字符串>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let1 j `(("age" . 18) ("sex" . male))

    \ \ \ \ \ \ (check (json-ref (json-set j "age" 19) "age") =\<gtr\> 19)

    \ \ \ \ \ \ (check (json-ref j "age") =\<gtr\> 18))

    \;
  </goldfish-chunk>

  <subparagraph|测试：verify是自然数>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((j0 #(red green blue))

    \ \ \ \ \ \ \ (j1 (json-set j0 0 'black)))

    \ \ (check j0 =\<gtr\> #(red green blue))

    \ \ (check j1 =\<gtr\> #(black green blue)))

    \;
  </goldfish-chunk>

  <subparagraph|测试：verify是布尔值>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((j0 `((bob . 18) (jack . 16)))

    \ \ \ \ \ \ \ (j1 (json-set j0 #t 3))

    \ \ \ \ \ \ \ (j2 (json-set j0 #t (lambda (x) (+ x 1)))))

    \ \ (check j1 =\<gtr\> `((bob . 3) (jack . 3)))

    \ \ (check j2 =\<gtr\> `((bob . 19) (jack . 17))))

    \;
  </goldfish-chunk>

  <subparagraph|实现>

  <\scm-chunk|json/liii/json.scm|true|true>
    (define json-set

    \ \ (lambda (x v p)

    \ \ \ \ (let ((x x) (v v) (p (if (procedure? p) p (lambda (x) p))))

    \ \ \ \ \ \ (if (vector? x)

    \ \ \ \ \ \ \ \ \ \ (list-\<gtr\>vector

    \ \ \ \ \ \ \ \ \ \ \ \ (cond\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((boolean? v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if v

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x))(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (cdar x)) (l (cdr x) p))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x))(v v)(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (cdar x)) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v p))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x))(v v)(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (cdar x)) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v p))))))))

    \ \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ \ ((boolean? v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if v

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x x)(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons (caar x) (p (cdar x)))(l (cdr x) p))))))

    \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x x)(v v)(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons (caar x) (p (cdar x)))(l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v p))))))

    \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x x)(v v)(p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons v (p (cdar x)))(l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v p)))))))))))

    \;
  </scm-chunk>

  <paragraph|json-set*>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define (json-set* json k0 k1_or_v . ks_and_v)

    \ \ (if (null? ks_and_v)

    \ \ \ \ \ \ (json-set json k0 k1_or_v)

    \ \ \ \ \ \ (json-set json k0

    \ \ \ \ \ \ \ \ (lambda (x)

    \ \ \ \ \ \ \ \ \ \ (apply json-set* (cons x (cons k1_or_v ks_and_v)))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试单键更新>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((name . "Alice") (age . 25)))

    \ \ \ \ \ \ \ (updated-json (json-set* json 'age 26)))

    \ \ (check (json-ref updated-json 'age) =\<gtr\> 26))

    \;
  </goldfish-chunk>

  <subparagraph|测试多键更新>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((person . ((name . "Alice")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (age . 25)))))

    \ \ \ \ \ \ \ (updated-json (json-set* json 'person 'age 26)))

    \ \ (check (json-ref* updated-json 'person 'age) =\<gtr\> 26))

    \;
  </goldfish-chunk>

  <subparagraph|测试嵌套多键更新>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((person . ((name . "Alice")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (age . 25)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (address . ((city . "Wonderland")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (zip . "12345")))))))

    \ \ \ \ \ \ \ (updated-json (json-set* json 'person 'address 'city "Newland")))

    \ \ (check (json-ref* updated-json 'person 'address 'city) =\<gtr\> "Newland"))

    \;
  </goldfish-chunk>

  <subparagraph|测试使用过程作为值>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((name . "Alice") (age . 25)))

    \ \ \ \ \ \ \ (updated-json (json-set* json 'age (lambda (x) (+ x 1)))))

    \ \ (check (json-ref updated-json 'age) =\<gtr\> 26))

    \;
  </goldfish-chunk>

  <subparagraph|测试嵌套使用过程作为值>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((person . ((name . "Alice") (age . 25)))))

    \ \ \ \ \ \ \ (updated-json (json-set* json 'person 'age (lambda (x) (+ x 1)))))

    \ \ (check (json-ref* updated-json 'person 'age) =\<gtr\> 26))

    \;
  </goldfish-chunk>

  <paragraph|json-push>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define (json-push x k v)

    \ \ (if (vector? x)

    \ \ \ \ \ \ (if (= (vector-length x) 0)

    \ \ \ \ \ \ \ \ \ \ (vector v)

    \ \ \ \ \ \ \ \ \ \ (list-\<gtr\>vector

    \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (k k) (v v) (b #f))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if b '() (cons v '()))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) k)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons v (cons (cdar x) (l (cdr x) k v #t)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) k v b)))))))

    \ \ \ \ \ \ (cons (cons k v) x)))

    \;
  </goldfish-chunk>

  <paragraph|json-push*>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define (json-push* json k0 v0 . rest)

    \ \ (if (null? rest)

    \ \ \ \ \ \ (json-push json k0 v0)

    \ \ \ \ \ \ (json-set json k0

    \ \ \ \ \ \ \ \ (lambda (x) (apply json-push* (cons x (cons v0 rest)))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：在嵌套对象中添加新键值对>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((person . ((name . "Alice") (age . 25))))))

    \ \ (let ((updated-json (json-push* json 'person 'city "Wonderland")))

    \ \ \ \ (check (json-ref* updated-json 'person 'city) =\<gtr\> "Wonderland")))

    \;

    (let ((json '(("person" . (("name" . "Alice") ("age" . 25))))))

    \ \ (let ((updated-json (json-push* json "person" "city" "Wonderland")))

    \ \ \ \ (check (json-ref* updated-json "person" "city") =\<gtr\> "Wonderland")))

    \;

    (let ((json '((person . ((name . "Alice") (age . 25) (address . ((city . "Oldland") (zip . "12345"))))))))

    \ \ (let ((updated-json (json-push* json 'person 'address 'street "Main St")))

    \ \ \ \ (check (json-ref* updated-json 'person 'address 'street) =\<gtr\> "Main St")))

    \;
  </goldfish-chunk>

  <subparagraph|测试：在嵌套数组中添加新元素>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((data . #(1 2 3)))))

    \ \ (let ((updated-json (json-push* json 'data 3 4)))

    \ \ \ \ (check updated-json =\<gtr\> '((data . #(1 2 3 4))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((data . #(#(1 2) #(3 4))))))

    \ \ (let ((updated-json (json-push* json 'data 1 2 5)))

    \ \ \ \ (check updated-json =\<gtr\> '((data . #(#(1 2) #(3 4 5)))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：键值是数字>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((data . ((0 . "zero") (1 . "one"))))))

    \ \ (let ((updated-json (json-push* json 'data 2 "two")))

    \ \ \ \ (check (json-ref* updated-json 'data 2) =\<gtr\> "two")))

    \;
  </goldfish-chunk>

  <subparagraph|测试：键值是布尔值>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((flags . ((#t . "true") (#f . "false"))))))

    \ \ (let ((updated-json (json-push* json 'flags #t "yes")))

    \ \ \ \ (check (json-ref* updated-json 'flags #t) =\<gtr\> "yes")))

    \;
  </goldfish-chunk>

  <paragraph|json-drop>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define json-drop

    \ \ (lambda (x v)

    \ \ \ \ (if (vector? x)

    \ \ \ \ \ \ \ \ (if (zero? (vector-length x))

    \ \ \ \ \ \ \ \ \ \ \ \ x

    \ \ \ \ \ \ \ \ \ \ \ \ (list-\<gtr\>vector

    \ \ \ \ \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (v v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (v v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v)))))))))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ (let l ((x x) (v v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v))))))

    \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ (let l ((x x) (v v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (l (cdr x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v))))))))))

    \;
  </goldfish-chunk>

  <paragraph|json-drop*>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define json-drop*

    \ \ (lambda (json key . rest)

    \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ (json-drop json key)

    \ \ \ \ \ \ \ \ (json-set json key

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (x) (apply json-drop* (cons x rest)))))))

    \;
  </goldfish-chunk>

  测试删除单层键

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((name . "Alice") (age . 25))))

    \ \ (let ((updated-json (json-drop json 'age)))

    \ \ \ \ (check (json-ref updated-json 'age) =\<gtr\> '())))

    \;
  </goldfish-chunk>

  测试删除嵌套键

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((name . "Alice")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (age . 25)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (address . ((city . "Wonderland")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (zip . "12345"))))))

    \ \ (let ((updated-json (json-drop* json 'address 'city)))

    \ \ \ \ (check (json-ref* updated-json 'address 'city) =\<gtr\> '())))

    \;
  </goldfish-chunk>

  测试使用过程作为键

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let* ((json '((name . "Alice")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (age . 25)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (address . ((city . "Wonderland")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (zip . "12345"))))))

    \ \ (let1 j1 (json-drop json (lambda (k) (equal? k 'city)))

    \ \ \ \ (check (json-ref* j1 'address 'city) =\<gtr\> "Wonderland"))

    \ \ (let1 j2 (json-drop json (lambda (k) (equal? k 'name)))

    \ \ \ \ (check (json-ref* j2 'name) =\<gtr\> '()))

    \ \ (let1 j3 (json-drop* json 'address (lambda (k) (equal? k 'city)))

    \ \ \ \ (check (json-ref* j3 'address 'city) =\<gtr\> '())))

    \;
  </goldfish-chunk>

  <paragraph|json-reduce>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define json-reduce

    \ \ (lambda (x v p)

    \ \ \ \ (if (vector? x)

    \ \ \ \ \ \ \ \ (list-\<gtr\>vector

    \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ ((boolean? v)

    \ \ \ \ \ \ \ \ \ \ \ \ (if v

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (caar x) (cdar x)) (l (cdr x) p))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ x))

    \ \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (v v) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (caar x) (cdar x)) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v p))))))

    \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x (vector-\<gtr\>alist x)) (v v) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (p (caar x) (cdar x)) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cdar x) (l (cdr x) v p))))))))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((boolean? v)

    \ \ \ \ \ \ \ \ \ \ \ (if v

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let l ((x x) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons (caar x) (p (caar x) (cdar x))) (l (cdr x) p))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ x))

    \ \ \ \ \ \ \ \ \ \ ((procedure? v)

    \ \ \ \ \ \ \ \ \ \ \ (let l ((x x) (v v) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (v (caar x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons (caar x) (p (caar x) (cdar x))) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v p))))))

    \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ (let l ((x x) (v v) (p p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ '()

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (equal? (caar x) v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons v (p v (cdar x))) (l (cdr x) v p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car x) (l (cdr x) v p))))))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：单层或者嵌套JSON数据，直接值键>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((name . "Alice") (age . 25))))

    \ \ (check (json-reduce json 'name (lambda (k v) (string-upcase v)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((name . "ALICE") (age . 25))))

    \;

    (let ((json '((person . ((name . "Alice") (age . 25))))))

    \ \ (check (json-reduce json 'person (lambda (k v) v))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((person . ((name . "Alice") (age . 25))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：单层 JSON 数据，过程条件>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((name . "Alice") (age . 25))))

    \ \ (check (json-reduce json (lambda (k) (equal? k 'age)) (lambda (k v) (+ v 1)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((name . "Alice") (age . 26))))

    \;

    (let ((json '((person . ((name . "Alice") (age . 25))))))

    \ \ (check (json-reduce json (lambda (k) (equal? k 'person)) (lambda (k v) v))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((person . ((name . "Alice") (age . 25))))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：单层 JSON 数据，布尔值条件（true，对所有键值对操作）>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((name . "Alice") (age . 25))))

    \ \ (check (json-reduce json #t (lambda (k v) (if (string? v) (string-upcase v) v)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((name . "ALICE") (age . 25))))

    \;
  </goldfish-chunk>

  <paragraph|测试：单层 JSON 数据，布尔值条件（false，不操作）>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((name . "Alice") (age . 25))))

    \ \ (check (json-reduce json #f (lambda (k v) v))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((name . "Alice") (age . 25))))

    \;
  </goldfish-chunk>

  <subparagraph|测试：边界情况>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '()))

    \ \ (check (json-reduce json 'name (lambda (k v) v))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '()))

    \;

    (let ((json #()))

    \ \ (check (json-reduce json 'name (lambda (k v) v))

    \ \ \ \ \ \ \ \ \ =\<gtr\> #()))

    \;
  </goldfish-chunk>

  <paragraph|json-reduce*>

  <\goldfish-chunk|json/liii/json.scm|true|true>
    (define (json-reduce* j v1 v2 . rest)

    \ \ (cond

    \ \ \ \ ((null? rest) (json-reduce j v1 v2))

    \ \ \ \ ((length=? 1 rest)

    \ \ \ \ \ (json-reduce j v1

    \ \ \ \ \ \ \ (lambda (x y)

    \ \ \ \ \ \ \ \ \ (let* ((new-v1 v2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (p (last rest)))

    \ \ \ \ \ \ \ \ \ \ (json-reduce y new-v1

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (n m) (p (list x n) m)))))))

    \ \ \ \ (else

    \ \ \ \ \ (json-reduce j v1

    \ \ \ \ \ \ \ (lambda (x y)

    \ \ \ \ \ \ \ \ \ (let* ((new-v1 v2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (p (last rest)))

    \ \ \ \ \ \ \ \ \ \ (apply json-reduce*

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (append (cons y (cons new-v1 (drop-right rest 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (list (lambda (n m) (p (cons x n) m)))))))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|json/tests/json-test.scm|true|true>
    (let ((json '((person . ((name . "Alice") (age . 25))))))

    \ \ (check (json-reduce* json 'person 'name (lambda (k v) (string-upcase v)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> '((person . ((name . "ALICE") (age . 25))))))

    \;

    (let1 json '((person . ((name . "Alice")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (age . 25)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (address . ((city . "Wonderland")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (zip . "12345"))))))

    \ \ (let ((updated-json (json-reduce* json 'person 'address 'city (lambda (x y) (string-upcase y)))))

    \ \ \ \ (check (json-ref* updated-json 'person 'address 'city) =\<gtr\> "WONDERLAND")))

    \;
  </goldfish-chunk>

  <subsection|结尾>

  <\scm-chunk|json/tests/json-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <\scm-chunk|json/liii/json.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  \;
</body>

<\initial>
  <\collection>
    <associate|font-base-size|12>
    <associate|page-height|auto>
    <associate|page-orientation|landscape>
    <associate|page-screen-margin|false>
    <associate|page-type|a4>
    <associate|page-width|auto>
    <associate|save-aux|false>
  </collection>
</initial>