GoldfishLang.tmu

<TMU|<tuple|1.1.0|2025.0.5>>

<style|<tuple|book|goldfish|literate|reduced-margins|python|padded-paragraphs|chinese>>

<\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|(liii lang)>

  <section|许可证>

  <\goldfish-chunk|goldfish/liii/lang.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>

  <\goldfish-chunk|tests/goldfish/liii/lang-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>

  <section|接口>

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

    (import (liii base) (liii string) (liii vector) (liii sort)

    \ \ \ \ \ \ \ \ (liii list) (liii hash-table) (liii bitwise))

    (export

    \ \ @ typed-define

    \ \ define-case-class case-class? == != chained-define display* object-\<gtr\>string

    \ \ option none

    \ \ rich-integer rich-float rich-char rich-string

    \ \ rich-list rich-vector array rich-hash-table

    \ \ box $

    )

    (begin

    \;
  </scm-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (import (liii check)

    \ \ \ \ \ \ \ \ (liii lang)

    \ \ \ \ \ \ \ \ (liii cut)

    \ \ \ \ \ \ \ \ (liii case))

    \;

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

    \;
  </scm-chunk>

  <section|部分应用>

  <paragraph*|@>

  宏<scm|@>提供类似Scala语法的部分应用（Partial Application）功能，详情参考SFRI 26中宏<scm|cute>的说明。

  宏<scm|@>的关键在于<strong|宏展开时的静态求值>，而非运行时的动态绑定。简短的来说，<scm|@>只在宏展开时求值并绑定占位符，而不是每次被调用时重新求值。

  \;

  <strong|通过示例和机制分步解释>

  <\goldfish-code>
    (let ((a 10))

    \ \ (define add10 (@ + a _)) \ ; a 在宏展开时被求值为 10

    \ \ (set! a 100)

    \ \ (add10 5)) ; =\<gtr\> 15（而不是 105）
  </goldfish-code>

  <\enumerate>
    <item><strong|宏展开阶段>：

    当 <scm|(@ + a _)> 被展开时，宏会立即对非占位符参数（此处为 <scm|a>）进行求值。此时 <scm|a> 的值为 <scm|10>，所以宏生成的代码类似：

    <\goldfish-code>
      (define add10 (lambda (x) (+ 10 x))) ; a 被替换为固定值 10
    </goldfish-code>

    占位符 <scm|_> 对应后续传入的参数。

    <item><strong|运行时阶段>：

    即使后续通过 <scm|(set! a 100)> 修改了 <code*|<scm|a>>，<scm|add10> 内部已经固定为 <scm|10>，因此 <scm|(add10 5)> 等价于 <scm|(+ 10 5)>，结果为 <scm|15>。
  </enumerate>

  \;

  <strong|与普通闭包的区别>

  <\itemize>
    若不用 <scm|@>，直接使用 <scm|lambda>：

    <\goldfish-code>
      (let ((a 10))

      \ \ (define add10 (lambda (x) (+ a x))) ; 闭包捕获变量 a 的引用

      \ \ (set! a 100)

      \ \ (add10 5)) ; 结果为 105
    </goldfish-code>

    <strong|闭包行为>：<scm|lambda> 捕获的是变量 <scm|a> 的引用，而非其当前值。因此 <scm|a><verbatim|> 的修改会影响闭包的结果。
  </itemize>

  \;

  <strong|宏 <scm|@> 的核心机制>

  <\enumerate>
    <item><strong|静态求值>：

    在宏展开阶段，所有非占位符参数（如 <code*|<scm|a>>）会被立即求值，结果直接嵌入生成的代码中。这类似于 <strong|“值捕获”>。

    <item><strong|占位符 <scm|_>>：

    表示参数位置由后续调用时传入的值填充，类似 Scala 的 <scm|_> 占位符。例如 <scm|(@ f _ b _)> 会生成一个接受两个参数的函数。

    <item><strong|与 <scm|cute> 宏的区别>：

    <scm|cute> 宏支持更复杂的模式（如 <scm|\<...\>> 表示未定参数序列），而 <scm|@> 仅支持固定位置的 <scm|_>，且不延迟求值。
  </enumerate>

  \;

  <strong|设计意义>

  <\itemize>
    <item><strong|性能优化>：若部分参数是常量或昂贵的计算，<scm|@> 可避免重复求值。

    <item><strong|语义确定性>：部分应用的结果在定义时即固定，不受后续环境变化影响。
  </itemize>

  \;

  <strong|实现函数>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-macro (@ . paras)

    \ \ (letrec*

    \ \ \ \ (

    \ \ \ \ \ \ (slot? (lambda (x) (equal? '_ x)))

    \ \ \ \ \ \ (exprs (filter (lambda (x) (not (slot? x))) paras))

    \ \ \ \ \ \ (slots (filter slot? paras))

    \;

    \ \ \ \ \ \ (exprs-sym-list (map (lambda (x) (gensym)) exprs)) \ 

    \ \ \ \ \ \ (slots-sym-list (map (lambda (x) (gensym)) slots))

    \;

    \ \ \ \ \ \ (lets (map list exprs-sym-list exprs))

    \;

    \ \ \ \ \ \ (parse

    \ \ \ \ \ \ \ \ (lambda (exprs-sym-list slots-sym-list paras)

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

    \ \ \ \ \ \ \ \ \ \ \ \ ((null? paras) paras)

    \ \ \ \ \ \ \ \ \ \ \ \ ((not (list? paras)) paras)

    \ \ \ \ \ \ \ \ \ \ \ \ ((slot? (car paras))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(,(car slots-sym-list)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,@(parse exprs-sym-list (cdr slots-sym-list) (cdr paras))))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(,(car exprs-sym-list)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,@(parse (cdr exprs-sym-list) slots-sym-list (cdr paras))))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ `(let ,lets\ 

    \ \ \ \ \ \ \ \ (lambda ,slots-sym-list\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,(parse exprs-sym-list slots-sym-list paras)))))

    \;
  </goldfish-chunk>

  <strong|测试用例>

  测试：基本部分应用

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((@ + _ 2) 1) =\<gtr\> 3)

    (check ((@ list 1 _ 3 _ 5) 2 4) =\<gtr\> (list 1 2 3 4 5))

    (check ((@ list _ _) 'a 'b) =\<gtr\> (list 'a 'b))

    \;
  </goldfish-chunk>

  测试：只宏展开时求值并绑定占位符

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check

    \ \ (let ((a 10))

    \ \ \ \ (define add (@ + (* a 2) _)) \ 

    \ \ \ \ (set! a 100)

    \ \ \ \ (add 5))

    =\<gtr\> 25)

    \;

    (let ((x 5))

    \ \ (check\ 

    \ \ \ \ ((@ cons (+ x 1) _) 'y)\ 

    \ \ \ =\<gtr\> (cons 6 'y)))

    \;
  </goldfish-chunk>

  测试：无占位符时生成的函数无参数

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (procedure? (@ list 1 2)) =\<gtr\> #t)

    (check ((@ list 1 2)) =\<gtr\> '(1 2))

    \;
  </goldfish-chunk>

  测试：函数作为占位符参数

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((@ _ 'a 'b) list) =\<gtr\> (list 'a 'b))

    (check ((@ map _ '(1 2 3)) (lambda (x) (+ x 1))) =\<gtr\> '(2 3 4))

    (check ((@ apply _ '(1 2 3)) +) =\<gtr\> 6)

    \;
  </goldfish-chunk>

  测试：嵌套<scm|@>宏

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((@ (@ + _ 1) _) 2) =\<gtr\> 3)

    (check ((@ _ _) (@ * _ 2) 3) =\<gtr\> 6)

    \;
  </goldfish-chunk>

  <section|typed-define>

  <paragraph|typed-define>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-macro (typed-define name-and-params body . rest)

    \ \ (let* ((name (car name-and-params))

    \ \ \ \ \ \ \ \ \ \ (params (cdr name-and-params))

    \ \ \ \ \ \ \ \ \ \ (param-names (map car params)))

    \;

    \ \ \ \ \ \ \ \ `(define*\ 

    \ \ \ \ \ \ \ \ \ \ \ \ (,name\ 

    \ \ \ \ \ \ \ \ \ \ \ \ ,@(map \ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (param)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let \ ((param-name (car param))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (type-pred (cadr param))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (default-value (cddr param)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? default-value)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ param-name

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(,param-name ,(car default-value)))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ params))

    \;

    \ \ \ \ \ \ \ \ ;; Runtime type check \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ ,@(map (lambda (param)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((param-name (car param))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (type-pred (cadr param))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;;remove the '?' in 'type?'

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (type-name-str\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((s (symbol-\<gtr\>string type-pred)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (and (positive? (string-length s))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (char=? (string-ref s (- (string-length s) 1)) #\\?))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring s 0 (- (string-length s) 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ s))))

    \;

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(unless\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (,type-pred ,param-name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (type-error\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (format #f "In funtion #\<less\>~a ~a\<gtr\>: argument *~a* must be *~a*! \ \ \ **Got ~a**"

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,name

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ',param-names

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ',param-name

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,type-name-str

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (object-\<gtr\>string ,param-name))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ params)

    \ \ \ \ \ \ \ ,body

    \ \ \ \ \ \ \ ,@rest)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (typed-define (person (name string? "Bob") (age integer?))

    \ \ (string-append name " is " (number-\<gtr\>string age) " years old"))

    \;

    (check (person :age 21) =\<gtr\> "Bob is 21 years old")

    (check (person :name "Alice" :age 25) =\<gtr\> "Alice is 25 years old")

    (check-catch 'type-error (person :name 123 :age 25))

    \;
  </goldfish-chunk>

  <section|样本类>

  <paragraph|define-case-class><index|define-case-class>

  <scm|define-case-class>用于在Goldfish Scheme定义类似Scala的样本类。

  样本类对象实际上是函数，该函数的第一个参数可以是字段或者是方法，字段统一使用<scm|'field>表示，方法统一使用<scm|:method>表示。实例方法采用<scm|%>作为前缀，静态方法采用<scm|@>作为前缀，内部方法没有<scm|@>和<scm|%>前缀。比如<scm|(bob :to-string)>实际上调用的是bob对象的实例方法<scm|%to-string>。静态方法只能通过样本类名调用，例如<scm|(person :default)>。实例方法只能通过该样本类构造的实例调用，例如 <scm|(bob :to-string)>。内部方法只能在定义实例方法时调用。例如

  <\scm-code>
    (define-case-class my-vector ((vec vector?) (size integer?))

    \ \ (define (@empty) (my-vector #() 0))

    \;

    \ \ (define (check-bound n)

    \ \ \ \ (when (or (\<less\> n 0) (\<gtr\>= n size))

    \ \ \ \ \ \ (value-error "out of bound")))

    \;

    \ \ (define (%at n)

    \ \ \ \ (check-bound n)

    \ \ \ \ (vector-ref vec n)))

    \;

    (let1 vec (my-vector #(1 2 3) 3)

    \ \ (check (my-vector :empty) =\<gtr\> (my-vector #() 0))

    \ \ (check (vec :at 0) =\<gtr\> 1)

    \ \ (check-catch 'value-error (vec :at 3)))
  </scm-code>

  在此例中，<scm|@empty> 是一个静态方法，<scm|%at> 是一个实例方法，<scm|check-bound> 是一个内部方法。

  实例方法将第一个参数之外剩下的参数作为参数传入，我们通过只处理部分参数，递归处理未处理参数的方式，可以实现方法调用链。比如

  <\goldfish-code>
    (l :filter positive? :filter zero?)

    =\<gtr\> ((l :filter positve?) :filter zero?)
  </goldfish-code>

  在这个filter方法的实现中，<scm|%filter>这个实例方法只处理第一个参数，得到的结果仍旧是一个样本类对象，再使用得到的样本类对象处理剩余的参数。

  <scm|define-case-class>会自动生成两种实例方法。

  其中一种是固定命名的实例方法：<scm|%equals>、<scm|%is-instance-of>、<scm|%to-string>和<scm|%apply>。其中<scm|%apply>是一个特殊方法，如果第一个参数没有命中字段或者方法，那么<scm|(person 1 2 3)>实际等价于<scm|(person :apply 1 2 3)>。

  另外一种是将字段名用做实例方法名，表示拷贝一个对象，并修改相应的字段。在下面的示例中，<scm|bob_2024>这个对象的实例方法接受一个整数作为输入，返回的是新的对象<scm|bob_2025>，这两个对象是完全不同的对象，他们的区别仅仅在于age字段的值。

  <\scm-code>
    (define person ((name string?) (age integer?)))

    (define bob_2024 (person "Bob" 24))

    (define bob_2025 (bob_2024 :age (+ 1 (bob_2024 'age))))
  </scm-code>

  样本类的默认构造函数有类型校验，但不做任何值校验。如果需要做值校验，那么需要使用同名的函数覆盖<scm|define-case-class>生成的默认实现。该同名函数可称为该样本类的伴生函数。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-macro (define-case-class class-name fields . methods)

    \ \ (let* ((key-fields

    \ \ \ \ \ \ \ \ \ (map (lambda (field) (string-\<gtr\>symbol (string-append ":" (symbol-\<gtr\>string (car field)))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ fields))

    \ \ \ \ \ \ \ \ \ (instance-methods

    \ \ \ \ \ \ \ \ \ \ (filter (lambda (method) (string-starts? (symbol-\<gtr\>string (caadr method)) "%"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ methods))

    \ \ \ \ \ \ \ \ \ (instance-method-symbols (map caadr instance-methods))

    \ \ \ \ \ \ \ \ \ (instance-messages

    \ \ \ \ \ \ \ \ \ \ (map (lambda (method)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let1 name (string-remove-prefix (symbol-\<gtr\>string method) "%")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-\<gtr\>symbol (string-append ":" name))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ instance-method-symbols))

    \ \ \ \ \ \ \ \ \ (static-methods

    \ \ \ \ \ \ \ \ \ \ (filter (lambda (method) (string-starts? (symbol-\<gtr\>string (caadr method)) "@"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ methods))

    \ \ \ \ \ \ \ \ \ (static-method-symbols (map caadr static-methods))

    \ \ \ \ \ \ \ \ \ (static-messages

    \ \ \ \ \ \ \ \ \ \ (map (lambda (method)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let1 name (string-remove-prefix (symbol-\<gtr\>string method) "@")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-\<gtr\>symbol (string-append ":" name))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ static-method-symbols))

    \ \ \ \ \ \ \ \ \ (internal-methods

    \ \ \ \ \ \ \ \ \ \ \ (filter (lambda (method) (not (or (string-starts? (symbol-\<gtr\>string (caadr method)) "%")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-starts? (symbol-\<gtr\>string (caadr method)) "@"))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ methods))

    \ \ \ \ \ \ \ \ \ (this-symbol (gensym))

    \ \ \ \ \ \ \ \ \ (f-make-case-class (string-\<gtr\>symbol (string-append "make-case-class-" (symbol-\<gtr\>string class-name)))))

    \;

    `(define (,class-name msg . args)

    \;

    (define (@is-type-of obj)

    \ \ (and (case-class? obj)

    \ \ \ \ \ \ \ (obj :is-instance-of ',class-name)))

    \ \ \ 

    ,@static-methods

    \;

    (define (is-normal-function? msg)

    \ \ (and \ (symbol? msg)\ 

    \ \ \ \ \ \ \ \ (char=? (string-ref (symbol-\<gtr\>string msg) 0) #\\:)))

    \;

    (define (static-dispatcher msg . args)

    \ \ \ \ (cond

    \ \ \ \ \ ((eq? msg :is-type-of) (apply @is-type-of args))

    \ \ \ \ \ ,@(map (lambda (method expected) `((eq? msg ,expected) (apply ,method args)))

    \ \ \ \ \ \ \ \ \ \ \ \ static-method-symbols static-messages)

    \ \ \ \ \ (else (value-error "No such static method " msg))))

    \;

    (typed-define (,f-make-case-class ,@fields)

    \ \ (define ,this-symbol #f)

    \ \ (define (%this . xs)

    \ \ \ \ (if (null? xs)

    \ \ \ \ \ \ ,this-symbol

    \ \ \ \ \ \ (apply ,this-symbol xs)))

    \;

    \ \ (define (%is-instance-of x)

    \ \ \ \ (eq? x ',class-name))

    \ \ \ \ \ \ \ \ \ 

    \ \ (typed-define (%equals (that case-class?))

    \ \ \ \ (and (that :is-instance-of ',class-name)

    \ \ \ \ \ \ \ \ \ ,@(map (lambda (field) `(equal? ,(car field) (that ',(car field))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ fields)))

    \ \ \ \ \ \ \ \ \ 

    \ \ (define (%apply . args)

    \ \ \ \ (cond ((null? args)

    \ \ \ \ \ \ \ \ \ \ \ (value-error ,class-name "Apply on zero args is not implemented"))

    \ \ \ \ \ \ \ \ \ \ ((equal? ((symbol-\<gtr\>string (car args)) 0) #\\:)

    \ \ \ \ \ \ \ \ \ \ \ (value-error ,class-name "No such method: " (car args)))

    \ \ \ \ \ \ \ \ \ \ (else (value-error ,class-name "No such field: " (car args)))))

    \ \ \ \ \ \ \ \ \ 

    \ \ (define (%to-string)

    \ \ \ \ (let ((field-strings

    \ \ \ \ \ \ \ \ \ \ \ (list ,@(map (lambda (field key-field)

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,(symbol-\<gtr\>string key-field) " "

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (object-\<gtr\>string ,(car field))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ fields key-fields))))

    \ \ \ \ \ \ (let loop ((strings field-strings)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (acc ""))

    \ \ \ \ \ \ \ \ (if (null? strings)

    \ \ \ \ \ \ \ \ \ \ \ \ (string-append "(" ,(symbol-\<gtr\>string class-name) " " acc ")")

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr strings)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (zero? (string-length acc))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car strings)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append acc " " (car strings))))))))

    \;

    \ \ ,@internal-methods

    \ \ ,@instance-methods

    \ 

    \ \ (define (instance-dispatcher)

    \ \ \ \ (lambda (msg . args)

    \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ ((eq? msg :is-instance-of) (apply %is-instance-of args))

    \ \ \ \ \ \ \ \ ((eq? msg :equals) (apply %equals args))

    \ \ \ \ \ \ \ \ ((eq? msg :to-string) (%to-string))

    \ \ \ \ \ \ \ \ ((eq? msg :this) (apply %this args))

    \ \ \ \ \ \ \ \ ,@(map (lambda (field key-field)

    \ \ \ \ \ \ \ \ \ \ \ \ `((eq? msg ,key-field)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (,class-name

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,@(map (lambda (f) (if (eq? (car f) (car field)) '(car args) (car f)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ fields))))

    \ \ \ \ \ \ \ \ \ \ fields key-fields)

    \ \ \ \ \ \ \ \ ((is-normal-function? msg)

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,@(map (lambda (method expected) `((eq? msg ,expected) (apply ,method args)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ instance-method-symbols instance-messages)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (value-error ,class-name "No such method: " msg))))

    \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ ,@(map (lambda (field) `((eq? msg ',(car field)) ,(car field))) fields)

    \ \ \ \ \ \ \ \ (else (apply %apply (cons msg args))))))

    \;

    \ \ (set! ,this-symbol (instance-dispatcher))

    \ \ ,this-symbol

    ) ; end of the internal typed define

    \;

    (if (in? msg (list ,@static-messages :is-type-of))

    \ \ \ \ (apply static-dispatcher (cons msg args))

    \ \ \ \ (apply ,f-make-case-class (cons msg args)))

    \;

    ) ; end of define

    ) ; end of let

    ) ; end of define-macro

    \;
  </goldfish-chunk>

  测试：不带用户自定义方法的样本类person

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (define-case-class person

    \ \ ((name string? "Bob")

    \ \ \ (age integer?)))

    \;

    (let1 bob (person :name "Bob" :age 21)

    \ \ (check (bob 'name) =\<gtr\> "Bob")

    \ \ (check (bob 'age) =\<gtr\> 21)

    \ \ (check ((bob :name "hello") 'name) =\<gtr\> "hello")

    \ \ (check-catch 'value-error (bob 'sex))

    \ \ (check-catch 'value-error (bob :sex))

    \ \ (check-true (bob :is-instance-of 'person))

    \ \ (check (bob :to-string) =\<gtr\> "(person :name \\"Bob\\" :age 21)"))

    \;

    (check-catch 'type-error (person 1 21))

    \;

    (let ((bob (person "Bob" 21))

    \ \ \ \ \ \ (get-name (lambda (x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (case* x

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((#\<less\>procedure?\<gtr\>) (x 'name))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (value-error))))))

    \ \ (check (get-name bob) =\<gtr\> "Bob")

    \ \ (check-catch 'value-error (get-name 1)))

    \;
  </goldfish-chunk>

  测试：带用户自定义方法的样本类jerson

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (define-case-class jerson

    \ \ ((name string?)

    \ \ \ (age integer?))

    \ \ 

    \ \ (define (%to-string)

    \ \ \ \ (string-append "I am " name " " (number-\<gtr\>string age) " years old!"))

    \ \ (define (%greet x)

    \ \ \ \ (string-append "Hi " x ", " (%to-string)))

    )

    \;

    (let1 bob (jerson "Bob" 21)

    \ \ (check (bob :to-string) =\<gtr\> "I am Bob 21 years old!")

    \ \ (check (bob :greet "Alice") =\<gtr\> "Hi Alice, I am Bob 21 years old!"))

    \;
  </goldfish-chunk>

  测试：只有%开头的才是实例方法，其它的不应该被识别。

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (define-case-class test-case-class

    \ \ ((name string?))

    \ \ 

    \ \ (define (@this-is-a-static-method)

    \ \ \ \ (test-case-class "static"))

    \ \ 

    \ \ (define (%this-is-a-instance-method)

    \ \ \ \ (test-case-class (string-append name "instance")))

    )

    \;

    (let1 hello (test-case-class "hello ")

    \ \ (check-catch 'value-error (hello :this-is-a-static-method))

    \ \ (check (test-case-class :this-is-a-static-method) =\<gtr\> (test-case-class "static")))

    \;
  </goldfish-chunk>

  测试：使用 %this 引用实例本身

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

    \ \ (define-case-class person ((name string?) (country string?))

    \ \ \ \ (define (@default)

    \ \ \ \ \ \ (person "Andy" "China"))

    \ \ \ \ (define (%set-country! c . xs)

    \ \ \ \ \ \ (set! country c)

    \ \ \ \ \ \ (apply (%this) (if (null? xs) '(:this) xs)))

    \ \ \ \ (define (%set-name! n . xs)

    \ \ \ \ \ \ (set! name n)

    \ \ \ \ \ \ (apply (%this) (if (null? xs) '(:this) xs)))

    \ \ \ \ (define (%to-string)

    \ \ \ \ \ \ (format #f "Hello ~a from ~a" name country)))

    \ \ (define Andy (person :default))

    \ \ (check-catch 'wrong-type-arg (person :this))

    \ \ (check (Andy :to-string) =\<gtr\> "Hello Andy from China")

    \ \ (check (Andy :set-country! "USA" :to-string) =\<gtr\> "Hello Andy from USA")

    \ \ (check (Andy :to-string) =\<gtr\> "Hello Andy from USA")

    \ \ (check (Andy :set-country! "China" :set-name! "Ancker-0" :to-string) =\<gtr\> "Hello Ancker-0 from China")

    \ \ (check (Andy :set-country! "China") =\<gtr\> (person "Ancker-0" "China"))

    \ \ (check (Andy :this :set-country! "USA" :this :set-name! "Andy" :this :to-string) =\<gtr\> "Hello Andy from USA"))

    \;
  </goldfish-chunk>

  测试：内部方法

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

    \ \ (define-case-class person ((name string?) (country string?))

    \ \ \ \ (chained-define (@default)

    \ \ \ \ \ \ (person "Andy" "China"))

    \ \ \ \ (chained-define (set-country! c)

    \ \ \ \ \ \ (set! country c)

    \ \ \ \ \ \ (%this))

    \ \ \ \ (chained-define (set-name! n)

    \ \ \ \ \ \ (set! name n)

    \ \ \ \ \ \ (%this))

    \ \ \ \ (chained-define (%set-both! n c)

    \ \ \ \ \ \ (set-country! c)

    \ \ \ \ \ \ (set-name! n)

    \ \ \ \ \ \ (%this))

    \ \ \ \ (chained-define (%to-string)

    \ \ \ \ \ \ (rich-string (format #f "Hello ~a from ~a" name country))))

    \ \ (check (person :default :to-string :get) =\<gtr\> "Hello Andy from China")

    \ \ (check (person :default :set-both! "Bob" "Russia" :to-string :get) =\<gtr\> "Hello Bob from Russia")

    \ \ (check-catch 'value-error (person :default :set-country! "French")))

    \;
  </goldfish-chunk>

  <paragraph|case-class?>

  case class的前两个方法必须是<scm|:is-instance-of>和<scm|:equals>。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (case-class? x)

    \ \ (and-let* ((is-proc? (procedure? x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (source (procedure-source x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (source-at-least-3? (and (list? source) (\<gtr\>= (length source) 3)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (body (source 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (body-at-least-3? (and (list? body) (\<gtr\>= (length body) 3)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (is-cond? (eq? (car body) 'cond))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (pred1 ((body 1) 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (pred2 ((body 2) 0)))

    \ \ \ \ (and (equal? pred1 '(eq? msg :is-instance-of))

    \ \ \ \ \ \ \ \ \ (equal? pred2 '(eq? msg :equals)))))

    \;
  </goldfish-chunk>

  匿名函数、内置函数、简单的自定义函数都不是case class，需要正确返回。

  <\session|goldfish|default>
    <\output>
      Liii Scheme 17.11.8 Enterprise Edition by LiiiLabs

      implemented on S7 Scheme (11.2, 30-Dec-2024)
    </output>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (procedure-source (lambda (x) x))
    <|unfolded-io>
      <goldfish-result|(lambda (x) x)>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (procedure-source +)
    <|unfolded-io>
      <goldfish-result|()>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (procedure-source identity)
    <|unfolded-io>
      <goldfish-result|(lambda (x) x)>
    </unfolded-io>

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

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-false (case-class? (lambda (x) x)))

    (check-false (case-class? +))

    (check-false (case-class? identity))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true (case-class? (person "Bob" 21)))

    \;
  </scm-chunk>

  <paragraph|==><index|==><scm|(x y) =\<gtr\> bool>

  如果两个参数都是样本类，那么使用样本类的相等性判断；

  如果某个参数为非样本类，我们使用box函数装箱，之后再进行比较；

  如果两个样本都不是样本类，则使用<scm|equal?>判断。

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (== left right)

    \ \ (cond

    \ \ \ \ ((and (case-class? left) (case-class? right))

    \ \ \ \ \ (left :equals right))

    \ \ \ \ ((case-class? left)

    \ \ \ \ \ (left :equals ($ right)))

    \ \ \ \ ((case-class? right)

    \ \ \ \ \ ($ left :equals right))

    \ \ \ \ (else

    \ \ \ \ \ (equal? left right))))

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (== (list 1 2) (list 1 2)) =\<gtr\> #t)

    (check (!= (list 1 2) (list 1 2)) =\<gtr\> #f)

    (check (== (box 10) 10) =\<gtr\> #t) \ 

    (check (== 10 (box 10)) =\<gtr\> #t) \ 

    (check (== (box 10) (box 10)) =\<gtr\> #t) \ 

    (check (== 10 10) =\<gtr\> #t) \ 

    (check-true (== (person "Bob" 21) (person "Bob" 21)))

    \;
  </scm-chunk>

  <paragraph|!=><index|!=><scm|(x y) =\<gtr\> bool>

  ==的布尔逻辑取反。

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (!= left right)

    \ \ (not (== left right)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (== (list 1 2) (list 1 2)) =\<gtr\> #t)

    (check (!= (list 1 2) (list 1 2)) =\<gtr\> #f)

    (check-true (!= (person "Bob" 20) (person "Bob" 21)))

    \;
  </scm-chunk>

  <paragraph|chained-define><index|chained-define>

  可以在 case class 中更方便地定义支持链式调用的函数。例如

  <\scm-code>
    (define (%set! index value . xs)

    \ \ (set! (data index) value)

    \ \ (if (null? xs)

    \ \ \ \ \ \ (%this)

    \ \ \ \ \ \ (apply (%this) xs)))
  </scm-code>

  可以用 chained-define 简化为

  <\scm-code>
    (chained-define (%set! index value)

    \ \ (set! (data index) value)

    \ \ (%this))
  </scm-code>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define-macro (chained-define head . body)

    \ \ (let ((xs (gensym))

    \ \ \ \ \ \ \ \ (result (gensym)))

    \ \ \ \ `(define ,(append head xs)

    \ \ \ \ \ \ \ (let ((,result (begin ,@body)))

    \ \ \ \ \ \ \ \ \ (if (null? ,xs)

    \ \ \ \ \ \ \ \ \ \ \ ,result

    \ \ \ \ \ \ \ \ \ \ \ (apply ,result ,xs))))))

    \;
  </scm-chunk>

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

    \ \ (define-case-class person ((name string?) (country string?))

    \ \ \ \ (chained-define (@default)

    \ \ \ \ \ \ (person "Andy" "China"))

    \ \ \ \ (chained-define (%set-country! c)

    \ \ \ \ \ \ (set! country c)

    \ \ \ \ \ \ (%this))

    \ \ \ \ (chained-define (%set-name! n)

    \ \ \ \ \ \ (set! name n)

    \ \ \ \ \ \ (%this))

    \ \ \ \ (chained-define (%set-both! n c)

    \ \ \ \ \ \ (%this :set-name! n :set-country! c))

    \ \ \ \ (chained-define (%to-string)

    \ \ \ \ \ \ (rich-string (format #f "Hello ~a from ~a" name country))))

    \ \ (check (person :default :to-string :get) =\<gtr\> "Hello Andy from China")

    \ \ (check (person :default :set-both! "Bob" "Russia" :to-string :get) =\<gtr\> "Hello Bob from Russia")

    \ \ (check ((person "Alice" "Japan") :set-name! "Lily" :to-string :get) =\<gtr\> "Hello Lily from Japan"))

    \;
  </scm-chunk>

  <paragraph|display*><index|display*><scm|(x y z ...) =\<gtr\> \<less\>#unspecified\<gtr\>>

  <scm|display*>可以正确展示样本类，以及接受多个参数，是<scm|display>的加强版。

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (display* . params)

    \ \ (define (%display x)

    \ \ \ \ (if (case-class? x)

    \ \ \ \ \ \ \ \ (display (x :to-string))

    \ \ \ \ \ \ \ \ (display x)))

    \ \ (for-each %display params))

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check

    \ \ (with-output-to-string

    \ \ \ \ (lambda ()

    \ \ \ \ \ \ (display* "hello world" "\\n")))

    \ \ =\<gtr\> "hello world\\n")

    \;
  </scm-chunk>

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

  基于S7的实现，新增对样本类的支持。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define s7-object-\<gtr\>string object-\<gtr\>string)

    \;

    (define (object-\<gtr\>string x)

    \ \ (if (case-class? x)

    \ \ \ \ \ \ (x :to-string)

    \ \ \ \ \ \ (s7-object-\<gtr\>string x)))

    \;
  </goldfish-chunk>

  <paragraph|box>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (box x)

    \ \ (cond ((integer? x) (rich-integer x))

    \ \ \ \ \ \ \ \ ((float? x) (rich-float x))

    \ \ \ \ \ \ \ \ ((char? x) (rich-char (char-\<gtr\>integer x)))

    \ \ \ \ \ \ \ \ ((string? x) (rich-string x))

    \ \ \ \ \ \ \ \ ((list? x) (rich-list x))

    \ \ \ \ \ \ \ \ ((vector? x) (rich-vector x))

    \ \ \ \ \ \ \ \ ((hash-table? x) (rich-hash-table x))

    \ \ \ \ \ \ \ \ (else (type-error "box: x must be integer?, float?, char?, string?, list?, vector?, hash-table?"))))

    \;
  </goldfish-chunk>

  <paragraph|$ 语法糖>

  $语法糖将第一个参数装箱（boxing），得到一个样本类，并将剩下的参数作为样本类的参数。该语法糖简化了语法，同时避免了隐式转换。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define ($ x . xs)

    \ \ (if (null? xs) (box x) (apply (box x) xs)))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ 1 :to 3) =\<gtr\> '(1 2 3))

    (check ($ "hello world" :replace "world" "suger" :index-of "suger") =\<gtr\> 6)

    (check ($ '(1 2 3) :empty?) =\<gtr\> #f)

    \;

    (check

    \ (($ 100 :to 128)

    \ \ :take 10

    \ \ :map (@ + _ 1)

    \ \ :filter even?

    \ \ :collect)

    \ \ =\<gtr\> '(102 104 106 108 110))

    \;
  </scm-chunk>

  <chapter|rich-integer>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-integer ((data integer?))

    \;
  </goldfish-chunk>

  <section|选择器>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get) data)

    \;
  </goldfish-chunk>

  <section|谓词>

  <paragraph|rich-integer%equals>

  该函数由define-case-class自动生成。

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ($ 42 :equals ($ 42)))

    (check-false ($ 41 :equals ($ 42)))

    \;
  </goldfish-chunk>

  <section|转换器>

  <paragraph|rich-integer%to>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (typed-define (%to (n integer?))

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

    \ \ \ \ \ \ (rich-list (list))

    \ \ \ \ \ \ (rich-list (iota (+ (- n data) 1) data))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (($ 1 :to 2) :collect) =\<gtr\> (list 1 2))

    (check (($ 1 :to 1) :collect) =\<gtr\> (list 1))

    (check (($ 2 :to 1) :collect) =\<gtr\> (list ))

    \;
  </goldfish-chunk>

  <paragraph|rich-integer%until>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (typed-define (%until (n integer?))

    \ \ (if (\<less\>= n data)

    \ \ \ \ \ \ (rich-list (list))

    \ \ \ \ \ \ (rich-list (iota (+ (- n data)) data))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (($ 1 :until 3) :collect) =\<gtr\> (list 1 2))

    (check (($ 1 :until 2) :collect) =\<gtr\> (list 1))

    (check (($ 2 :until 2) :collect) =\<gtr\> (list ))

    \;
  </goldfish-chunk>

  <paragraph|rich-integer%to-char>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-char)

    \ \ (rich-char data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-catch 'value-error ($ #x110000 :to-char))

    \;
  </goldfish-chunk>

  <paragraph|rich-integer%to-string>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-string)

    \ \ (number-\<gtr\>string data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ 1 :to-string) =\<gtr\> "1")

    \;
  </goldfish-chunk>

  <section|静态方法>

  <paragraph|rich-integer@max-value>

  Goldfish Scheme中的integer是64位有符号整数，最大值为<math|2<rsup|63>-1>。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@max-value) 9223372036854775807)

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (+ 1 (rich-integer :max-value)) =\<gtr\> (rich-integer :min-value))

    \;
  </goldfish-chunk>

  <paragraph|rich-integer@min-value>

  Goldfish Scheme中的integer是64位有符号整数，最大值为<math|-2<rsup|63>>。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@min-value) -9223372036854775808)

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (- (rich-integer :min-value) 1) =\<gtr\> (rich-integer :max-value))

    \;
  </goldfish-chunk>

  <section|其余函数>

  <paragraph|rich-integer%sqrt>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    ;;return exact integer

    (define (%sqrt)

    \ \ (if (\<less\> data 0)

    \ \ \ \ \ \ (value-error

    \ \ \ \ \ \ \ \ (format #f "sqrt of negative integer is undefined! \ \ \ \ \ \ \ \ ** Got ~a **" data))

    \ \ \ \ \ \ (inexact-\<gtr\>exact (floor (sqrt data)))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ 0 :sqrt) =\<gtr\> 0) \ \ \ \ \ \ 

    (check ($ 1 :sqrt) =\<gtr\> 1) \ \ \ \ \ \ 

    (check ($ 2 :sqrt) =\<gtr\> 1) \ \ \ \ \ \ 

    (check ($ 9 :sqrt) =\<gtr\> 3) \ \ \ \ \ \ 

    (check ($ 8 :sqrt) =\<gtr\> 2)

    (check ($ 10 :sqrt) =\<gtr\> 3)

    (check ($ 144 :sqrt) =\<gtr\> 12) \ \ \ \ \ \ 

    (check ($ 289 :sqrt) =\<gtr\> 17) \ \ \ \ \ \ 

    (check ($ 290 :sqrt) =\<gtr\> 17) \ \ \ \ \ \ 

    (check ($ 10201 :sqrt) =\<gtr\> 101) \ \ \ \ \ \ 

    (check ($ 10403 :sqrt) =\<gtr\> 101)\ 

    (check ($ (rich-integer :max-value) :sqrt) =\<gtr\> 3037000499)

    (check-catch 'value-error ($ -1 :sqrt))

    \;
  </goldfish-chunk>

  <subsection|结尾>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  \;

  <chapter|rich-float>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-float ((data float?))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
  </goldfish-chunk>

  <section|选择器>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get) data)

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ 12.2 :get) =\<gtr\> 12.2)

    \;
  </goldfish-chunk>

  <section|谓词>

  <paragraph|rich-float%abs>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%abs)\ 

    \ \ (if (\<less\> data 0)

    \ \ \ \ \ \ (- 0 data)

    \ \ \ \ \ \ data))

    \ \ 
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ 1.1 :abs) =\<gtr\> 1.1)

    (check ($ 0.0 :abs) =\<gtr\> 0.0)

    (check ($ -1.1 :abs) =\<gtr\> 1.1)

    \;
  </goldfish-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  <chapter|rich-char>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-char ((code-point integer?))

    \;
  </goldfish-chunk>

  <section|谓词>

  <paragraph|rich-char%equals>

  该函数由<scm|define-case-class>自动生成。

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ((rich-char #x30) :equals (rich-char #x30)))

    (check-false ((rich-char #x31) :equals (rich-char #x30)))

    \;
  </goldfish-chunk>

  <paragraph|rich-char%ascii?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%ascii?)

    \ \ (and (\<gtr\>= code-point 0) (\<less\>= code-point 127)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ((rich-char #x0) :ascii?))

    (check-true ((rich-char #x7f) :ascii?))

    (check-false ((rich-char #x8f) :ascii?))

    \;

    (check-true ($ #\\a :ascii?))

    (check-true ($ #\\Z :ascii?))

    \;
  </goldfish-chunk>

  <paragraph|rich-char%numeric?>

  <paragraph|rich-char%upper?>

  用于判断字符是否为大写字母，基于 ASCII 字符集的范围（<scm|#x41> 到 <scm|#x5A>）。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%upper?)

    \ \ (and (\<gtr\>= code-point #x41) (\<less\>= code-point #x5A)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    ;; 大写字母

    (check-true ($ #\\A :upper?))

    (check-true ($ #\\Z :upper?))

    \;

    ;; 小写字母

    (check-false ($ #\\a :upper?))

    (check-false ($ #\\z :upper?))

    \;

    ;; 非字母字符

    (check-false ($ #\\0 :upper?))

    (check-false ($ #\\@ :upper?)) \ ;; @ 符号 (ASCII 64)

    (check-false ($ #\\[ :upper?)) \ ;; 左方括号 (ASCII 91)

    \;
  </goldfish-chunk>

  <paragraph|rich-char%lower?>

  用于判断字符是否为小写字母，基于ASCII字符集的范围（<scm|#x61>到<scm|#x7A>）

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%lower?)

    \ \ (and (\<gtr\>= code-point #x61) (\<less\>= code-point #x7A)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    ;; 小写字母

    (check-true ($ #\\a :lower?))

    (check-true ($ #\\z :lower?))

    \;

    ;; 大写字母

    (check-false ($ #\\A :lower?))

    (check-false ($ #\\Z :lower?))

    \;

    ;; 非字母字符

    (check-false ($ #\\0 :lower?))

    (check-false ($ #\\` :lower?)) \ ;; 反引号 (ASCII 96)

    (check-false ($ #\\{ :lower?)) \ ;; 左花括号 (ASCII 123)

    \;
  </goldfish-chunk>

  <paragraph|rich-char%digit?>

  判断一个字符是否为数字。它支持所有 Unicode 标准中定义的数字字符，包括以下范围：

  <tabular|<tformat|<twith|table-hmode|min>|<twith|table-width|1par>|<cwith|1|-1|1|-1|cell-hyphen|t>|<table|<row|<\cell>
    数字名称
  </cell>|<\cell>
    范围
  </cell>|<\cell>
    示例字符
  </cell>>|<row|<\cell>
    <strong|ASCII 数字>
  </cell>|<\cell>
    <code*|U+0030><nbsp>-<nbsp><code*|U+0039>
  </cell>|<\cell>
    <code*|0-9>
  </cell>>|<row|<\cell>
    <strong|全角数字>
  </cell>|<\cell>
    <code*|U+FF10><nbsp>-<nbsp><code*|U+FF19>
  </cell>|<\cell>
    <code*|０-９>
  </cell>>|<row|<\cell>
    <strong|阿拉伯数字>
  </cell>|<\cell>
    <code*|U+0660><nbsp>-<nbsp><code*|U+0669>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|扩展阿拉伯数字>
  </cell>|<\cell>
    <code*|U+06F0><nbsp>-<nbsp><code*|U+06F9>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|印度数字>
  </cell>|<\cell>
    <code*|U+0966><nbsp>-<nbsp><code*|U+096F>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|孟加拉数字>
  </cell>|<\cell>
    <code*|U+09E6><nbsp>-<nbsp><code*|U+09EF>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|古尔穆奇数字>
  </cell>|<\cell>
    <code*|U+0A66><nbsp>-<nbsp><code*|U+0A6F>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|古吉拉特数字>
  </cell>|<\cell>
    <code*|U+0AE6><nbsp>-<nbsp><code*|U+0AEF>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|奥里亚数字>
  </cell>|<\cell>
    <code*|U+0B66><nbsp>-<nbsp><code*|U+0B6F>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|泰米尔数字>
  </cell>|<\cell>
    <code*|U+0BE6><nbsp>-<nbsp><code*|U+0BEF>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|泰卢固数字>
  </cell>|<\cell>
    <code*|U+0C66><nbsp>-<nbsp><code*|U+0C6F>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|卡纳达数字>
  </cell>|<\cell>
    <code*|U+0CE6><nbsp>-<nbsp><code*|U+0CEF>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|马拉雅拉姆数字>
  </cell>|<\cell>
    <code*|U+0D66><nbsp>-<nbsp><code*|U+0D6F>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|泰文数字>
  </cell>|<\cell>
    <code*|U+0E50><nbsp>-<nbsp><code*|U+0E59>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|老挝数字>
  </cell>|<\cell>
    <code*|U+0ED0><nbsp>-<nbsp><code*|U+0ED9>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|藏文数字>
  </cell>|<\cell>
    <code*|U+0F20><nbsp>-<nbsp><code*|U+0F29>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|缅甸数字>
  </cell>|<\cell>
    <code*|U+1040><nbsp>-<nbsp><code*|U+1049>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|高棉数字>
  </cell>|<\cell>
    <code*|U+17E0><nbsp>-<nbsp><code*|U+17E9>
  </cell>|<\cell>
    \;
  </cell>>|<row|<\cell>
    <strong|蒙古数字>
  </cell>|<\cell>
    <code*|U+1810><nbsp>-<nbsp><code*|U+1819>
  </cell>|<\cell>
    \;
  </cell>>>>>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%digit?)

    \ \ (or

    \ \ \ (and (\<gtr\>= code-point 48) (\<less\>= code-point 57))

    \ \ \ (and (\<gtr\>= code-point #xFF10) (\<less\>= code-point #xFF19))

    \ \ \ (and (\<gtr\>= code-point #x0660) (\<less\>= code-point #x0669))

    \ \ \ (and (\<gtr\>= code-point #x06F0) (\<less\>= code-point #x06F9))

    \ \ \ (and (\<gtr\>= code-point #x0966) (\<less\>= code-point #x096F))

    \ \ \ (and (\<gtr\>= code-point #x09E6) (\<less\>= code-point #x09EF))

    \ \ \ (and (\<gtr\>= code-point #x0A66) (\<less\>= code-point #x0A6F))

    \ \ \ (and (\<gtr\>= code-point #x0AE6) (\<less\>= code-point #x0AEF))

    \ \ \ (and (\<gtr\>= code-point #x0B66) (\<less\>= code-point #x0B6F))

    \ \ \ (and (\<gtr\>= code-point #x0BE6) (\<less\>= code-point #x0BEF))

    \ \ \ (and (\<gtr\>= code-point #x0C66) (\<less\>= code-point #x0C6F))

    \ \ \ (and (\<gtr\>= code-point #x0CE6) (\<less\>= code-point #x0CEF))

    \ \ \ (and (\<gtr\>= code-point #x0D66) (\<less\>= code-point #x0D6F))

    \ \ \ (and (\<gtr\>= code-point #x0E50) (\<less\>= code-point #x0E59))

    \ \ \ (and (\<gtr\>= code-point #x0ED0) (\<less\>= code-point #x0ED9))

    \ \ \ (and (\<gtr\>= code-point #x0F20) (\<less\>= code-point #x0F29))

    \ \ \ (and (\<gtr\>= code-point #x1040) (\<less\>= code-point #x1049))

    \ \ \ (and (\<gtr\>= code-point #x17E0) (\<less\>= code-point #x17E9))

    \ \ \ (and (\<gtr\>= code-point #x1810) (\<less\>= code-point #x1819))))

    \ \ 
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((char1 (rich-char 48)) \ ;; ASCII '0'

    \ \ \ \ \ \ (char2 (rich-char #xFF10)) \ ;; 全角 '０'

    \ \ \ \ \ \ (char3 (rich-char #x0660)) \ ;; 阿拉伯数字 '٠'

    \ \ \ \ \ \ (char4 (rich-char #x06F0)) \ ;; 扩展阿拉伯数字 '۰'

    \ \ \ \ \ \ (char5 (rich-char #x0966)) \ ;; 印度数字

    \ \ \ \ \ \ (char6 (rich-char #x09E6)) \ ;; 孟加拉数字

    \ \ \ \ \ \ (char7 (rich-char #x0A66)) \ ;; 古尔穆奇数字

    \ \ \ \ \ \ (char8 (rich-char #x0AE6)) \ ;; 古吉拉特数字

    \ \ \ \ \ \ (char9 (rich-char #x0B66)) \ ;; 奥里亚数字

    \ \ \ \ \ \ (char10 (rich-char #x0BE6)) \ ;; 泰米尔数字

    \ \ \ \ \ \ (char11 (rich-char #x0C66)) \ ;; 泰卢固数字

    \ \ \ \ \ \ (char12 (rich-char #x0CE6)) \ ;; 卡纳达数字\ 

    \ \ \ \ \ \ (char13 (rich-char #x0D66)) \ ;; 马拉雅拉姆数字

    \ \ \ \ \ \ (char14 (rich-char #x0E50)) \ ;; 泰文数字 '๐'

    \ \ \ \ \ \ (char15 (rich-char #x0ED0)) \ ;; 老挝数字

    \ \ \ \ \ \ (char16 (rich-char #x0F20)) \ ;; 藏文数字

    \ \ \ \ \ \ (char17 (rich-char #x1040)) \ ;; 缅甸数字 '၀'

    \ \ \ \ \ \ (char18 (rich-char #x17E0)) \ ;; 高棉数字 '០'

    \ \ \ \ \ \ (char19 (rich-char #x1810)) \ ;; 蒙古数字 '᠐'

    \ \ \ \ \ \ (char20 (rich-char 65))) \ ;; ASCII 'A'

    \;

    \ \ ;; 测试 %digit?

    \ \ (check (char1 :digit?) =\<gtr\> #t) \ ;; ASCII 数字

    \ \ (check (char2 :digit?) =\<gtr\> #t) \ ;; 全角数字

    \ \ (check (char3 :digit?) =\<gtr\> #t) \ ;; 阿拉伯数字

    \ \ (check (char4 :digit?) =\<gtr\> #t) \ ;; 扩展阿拉伯数字

    \ \ (check (char5 :digit?) =\<gtr\> #t) \ ;; 印度数字

    \ \ (check (char6 :digit?) =\<gtr\> #t) \ ;; 孟加拉数字

    \ \ (check (char7 :digit?) =\<gtr\> #t) \ ;; 古尔穆奇数字

    \ \ (check (char8 :digit?) =\<gtr\> #t) \ ;; 古吉拉特数字

    \ \ (check (char9 :digit?) =\<gtr\> #t) \ ;; 奥里亚数字

    \ \ (check (char10 :digit?) =\<gtr\> #t) \ ;; 泰米尔数字

    \ \ (check (char11 :digit?) =\<gtr\> #t) \ ;; 泰卢固数字

    \ \ (check (char12 :digit?) =\<gtr\> #t) \ ;; 卡纳达数字

    \ \ (check (char13 :digit?) =\<gtr\> #t) \ ;; 马拉雅拉姆数字

    \ \ (check (char14 :digit?) =\<gtr\> #t) \ ;; 泰文数字

    \ \ (check (char15 :digit?) =\<gtr\> #t) \ ;; 老挝数字

    \ \ (check (char16 :digit?) =\<gtr\> #t) \ ;; 藏文数字

    \ \ (check (char17 :digit?) =\<gtr\> #t) \ ;; 缅甸数字

    \ \ (check (char18 :digit?) =\<gtr\> #t) \ ;; 高棉数字

    \ \ (check (char19 :digit?) =\<gtr\> #t) \ ;; 蒙古数字

    \ \ (check (char20 :digit?) =\<gtr\> #f)) \ ;; 非数字字符

    \;
  </goldfish-chunk>

  <section|转换>

  <paragraph|rich-char%to-upper>

  目前只支持将英文字母的a-z转换为A-Z，其它字符保持不变。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-upper . xs)

    \ \ (let1 r (rich-char

    \ \ \ \ (if (and (\<gtr\>= code-point #x61) (\<less\>= code-point #x7A))

    \ \ \ \ \ \ (bitwise-and code-point #b11011111)

    \ \ \ \ \ \ code-point))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\a :to-upper) =\<gtr\> #\\A)

    (check ($ #\\z :to-upper) =\<gtr\> #\\Z)

    (check ($ #\\A :to-upper) =\<gtr\> #\\A)

    (check ($ #\\Z :to-upper) =\<gtr\> #\\Z)

    (check ($ #\\@ :to-upper) =\<gtr\> #\\@)

    \;

    (check ($ #\\Z :to-upper :to-lower) =\<gtr\> #\\z) ; chain

    \;
  </goldfish-chunk>

  <paragraph|rich-char%to-lower>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-lower . xs)

    \ \ (let1 r (rich-char

    \ \ \ \ (if (and (\<gtr\>= code-point #x41) (\<less\>= code-point #x5A))

    \ \ \ \ \ \ (bitwise-ior code-point #b00100000)

    \ \ \ \ \ \ code-point))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\A :to-lower) =\<gtr\> #\\a)

    (check ($ #\\Z :to-lower) =\<gtr\> #\\z)

    (check ($ #\\a :to-lower) =\<gtr\> #\\a)

    (check ($ #\\z :to-lower) =\<gtr\> #\\z)

    (check ($ #\\@ :to-lower) =\<gtr\> #\\@)

    \;

    (check ($ #\\z :to-lower :to-upper) =\<gtr\> #\\Z) ; chain

    \;
  </goldfish-chunk>

  <paragraph|rich-char%to-bytevector>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-bytevector)

    \ \ (cond

    \ \ \ \ ((\<less\>= code-point #x7F)

    \ \ \ \ \ (bytevector code-point))

    \;

    \ \ \ \ ((\<less\>= code-point #x7FF)

    \ \ \ \ \ (let ((byte1 (bitwise-ior #b11000000 (bitwise-and (arithmetic-shift code-point -6) #b00011111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte2 (bitwise-ior #b10000000 (bitwise-and code-point #b00111111))))

    \ \ \ \ \ \ \ (bytevector byte1 byte2)))

    \;

    \ \ \ \ ((\<less\>= code-point #xFFFF)

    \ \ \ \ \ (let ((byte1 (bitwise-ior #b11100000 (bitwise-and (arithmetic-shift code-point -12) #b00001111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte2 (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift code-point -6) #b00111111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte3 (bitwise-ior #b10000000 (bitwise-and code-point #b00111111))))

    \ \ \ \ \ \ \ (bytevector byte1 byte2 byte3)))

    \;

    \ \ \ \ ((\<less\>= code-point #x10FFFF)

    \ \ \ \ \ (let ((byte1 (bitwise-ior #b11110000 (bitwise-and (arithmetic-shift code-point -18) #b00000111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte2 (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift code-point -12) #b00111111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte3 (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift code-point -6) #b00111111)))

    \ \ \ \ \ \ \ \ \ \ \ (byte4 (bitwise-ior #b10000000 (bitwise-and code-point #b00111111))))

    \ \ \ \ \ \ \ (bytevector byte1 byte2 byte3 byte4)))

    \;

    \ \ \ \ (else

    \ \ \ \ \ (value-error "Invalid code point"))))

    \;
  </goldfish-chunk>

  <paragraph|rich-char%to-string>

  在Scheme中，有一些表示字符的特殊规则，这种特殊的规则，解决了那些无法显示的字符的显示问题，比如：

  <\session|goldfish|default>
    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      #\\space
    <|unfolded-io>
      <goldfish-result|#\\space>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (object-\<gtr\>string (integer-\<gtr\>char 32))
    <|unfolded-io>
      <goldfish-result|"#\\space">
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      #\\return
    <|unfolded-io>
      <goldfish-result|#\\return>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (char-\<gtr\>integer #\\return)
    <|unfolded-io>
      <goldfish-result|13>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (object-\<gtr\>string (integer-\<gtr\>char 13))
    <|unfolded-io>
      <goldfish-result|"#\\return">
    </unfolded-io>

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

  <subparagraph|实现>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-string)

    \ \ (if (%ascii?)

    \ \ \ \ \ \ (object-\<gtr\>string (integer-\<gtr\>char code-point))

    \ \ \ \ \ \ (string-append "#\\\\" (utf8-\>string (%to-bytevector)))))

    \;
  </goldfish-chunk>

  <subparagraph|测试>

  不可见的ASCII字符

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\space :to-string) =\<gtr\> "#\\\\space")

    (check ($ #\\return :to-string) =\<gtr\> "#\\\\return")

    \;
  </goldfish-chunk>

  普通的字母

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\a :to-string) =\<gtr\> "#\\\\a")

    (check ($ #\\A :to-string) =\<gtr\> "#\\\\A")

    \;
  </goldfish-chunk>

  ASCII范围外的字符：希腊字母、中文、表情符：

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((rich-char #xA3) :to-string) =\<gtr\> "#\\\\£")

    \;

    (check ((rich-char #x4E2D) :to-string) =\<gtr\> "#\\\\<code|中>")

    (check (object-\<gtr\>string (rich-char #x4E2D)) =\<gtr\> "#\\\\中")

    \;

    (check ((rich-char #x1F600) :to-string) =\<gtr\> "#\\\\<code|😀>")

    \;
  </goldfish-chunk>

  <paragraph|rich-char%make-string><typehint|() =\<gtr\> rich-string>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%make-string)

    \ \ (rich-string (utf8-\>string (%to-bytevector))))

    \;
  </goldfish-chunk>

  <subparagraph|测试>

  不可见的ASCII字符

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\space :make-string) =\<gtr\> " ")

    (check ($ #\\return :make-string) =\<gtr\> (string #\\return))

    \;
  </goldfish-chunk>

  普通的字母

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #\\a :make-string) =\<gtr\> "a")

    (check ($ #\\A :make-string) =\<gtr\> "A")

    \;
  </goldfish-chunk>

  ASCII范围外的字符：希腊字母、中文、表情符：

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((rich-char #xA3) :make-string) =\<gtr\> "£")

    (check ((rich-char #x4E2D) :make-string) =\<gtr\> "<code|中>")

    (check ((rich-char #x1F600) :make-string) =\<gtr\> "<code|😀>")

    \;
  </goldfish-chunk>

  <section|结尾>

  \;

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  <paragraph|rich-char>

  rich-char是样本类rich-char的伴生函数，用于定义更好的构造器。本构造器支持：

  <\description>
    <item*|integer>将整数形式的Unicode码点转换为rich-char，一般我们使用十六进制来表示整数

    <item*|bytevector>将UTF-8编码的字节数组转换为rich-char

    <item*|string>将UTF-8编码的长度为1的字符串转换为rich-char。由于字符字面量不支持Unicode，故而采用这种方式做转换。
  </description>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define make-rich-char rich-char)

    \;

    (define (utf8-byte-sequence-\<gtr\>code-point byte-seq)

    \ \ (let ((len (bytevector-length byte-seq)))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((= len 1)

    \ \ \ \ \ \ \ (bytevector-u8-ref byte-seq 0))

    \ \ \ \ \ \ ((= len 2)

    \ \ \ \ \ \ \ (let ((b1 (bytevector-u8-ref byte-seq 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b2 (bytevector-u8-ref byte-seq 1)))

    \ \ \ \ \ \ \ \ \ (bitwise-ior

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b1 #x1F) 6)

    \ \ \ \ \ \ \ \ \ \ (bitwise-and b2 #x3F))))

    \ \ \ \ \ \ ((= len 3)

    \ \ \ \ \ \ \ (let ((b1 (bytevector-u8-ref byte-seq 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b2 (bytevector-u8-ref byte-seq 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b3 (bytevector-u8-ref byte-seq 2)))

    \ \ \ \ \ \ \ \ \ (bitwise-ior

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b1 #x0F) 12)

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b2 #x3F) 6)

    \ \ \ \ \ \ \ \ \ \ (bitwise-and b3 #x3F))))

    \ \ \ \ \ \ ((= len 4)

    \ \ \ \ \ \ \ (let ((b1 (bytevector-u8-ref byte-seq 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b2 (bytevector-u8-ref byte-seq 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b3 (bytevector-u8-ref byte-seq 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (b4 (bytevector-u8-ref byte-seq 3)))

    \ \ \ \ \ \ \ \ \ (bitwise-ior

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b1 #x07) 18)

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b2 #x3F) 12)

    \ \ \ \ \ \ \ \ \ \ (arithmetic-shift (bitwise-and b3 #x3F) 6)

    \ \ \ \ \ \ \ \ \ \ (bitwise-and b4 #x3F))))

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ (value-error "Invalid UTF-8 byte sequence length")))))

    \;

    (define (rich-char x)

    \ \ (cond ((integer? x)

    \ \ \ \ \ \ \ \ \ (if (and (\<gtr\>= x 0) (\<less\>= x #x10FFFF))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (make-rich-char x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error "rich-char: code point out of range" x)))

    \ \ \ \ \ \ \ \ ((string? x)

    \ \ \ \ \ \ \ \ \ (if (= 1 (u8-string-length x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (rich-char (string-\<gtr\>utf8 x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error "rich-char: must be u8 string which length equals 1")))

    \ \ \ \ \ \ \ \ ((bytevector? x)

    \ \ \ \ \ \ \ \ \ (make-rich-char (utf8-byte-sequence-\<gtr\>code-point x)))

    \ \ \ \ \ \ \ \ (else (type-error "rich-char: must be integer, string, bytevector"))))

    \;
  </goldfish-chunk>

  <chapter|rich-string>

  Unicode编码的字符串。

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-string ((data string?))

    \;
  </scm-chunk>

  \;

  <section|静态方法>

  <paragraph|rich-string@is-type-of>

  这个静态方法是自动生成的，用于判断一个对象的类型是否是<scm|rich-string>。

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true (rich-string :is-type-of ($ "Hello")))

    \;

    (check-false (rich-string :is-type-of "hello"))

    (check-false (rich-string :is-type-of 1))

    (check-false (rich-string :is-type-of (box 1)))

    \;
  </goldfish-chunk>

  <paragraph|rich-string@value-of>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (@value-of v)\ 

    \ \ (cond ((char? v) (rich-string (string v)))

    \ \ \ \ \ \ \ \ ((number? v) (rich-string (number-\<gtr\>string v)))

    \ \ \ \ \ \ \ \ ((symbol? v) (rich-string (symbol-\<gtr\>string v)))

    \ \ \ \ \ \ \ \ ((string? v) (rich-string v))

    \ \ \ \ \ \ \ \ ((and (case-class? v) (v :is-instance-of 'rich-char))

    \ \ \ \ \ \ \ \ \ (v :make-string))

    \ \ \ \ \ \ \ \ (else (type-error "Expected types are char, rich-char, number, symbol or string"))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-string :value-of #\\a) =\<gtr\> "a")

    (check (rich-string :value-of 'a) =\<gtr\> "a")

    (check (rich-string :value-of 123) =\<gtr\> "123")

    (check (rich-string :value-of 1.0) =\<gtr\> "1.0")

    (check (rich-string :value-of "abc") =\<gtr\> "abc")

    (check (rich-string :value-of (rich-char #x4E2D)) =\<gtr\> "中")

    (check (rich-string :value-of #\\ ) =\<gtr\> " ")

    \;
  </goldfish-chunk>

  <section|选择器>

  <paragraph|rich-string%get>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get) data)

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "abc" :get) =\<gtr\> "abc")

    (check ($ "" :get) =\<gtr\> "")

    \;
  </goldfish-chunk>

  <paragraph|rich-string%length>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%length)

    \ \ (u8-string-length data))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((rich-string "abc") :length) =\<gtr\> 3)

    (check ((rich-string "中文") :length) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|rich-string%char-at>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%char-at index)

    \ \ (let* ((start index)

    \ \ \ \ \ \ \ \ \ (end (+ index 1))

    \ \ \ \ \ \ \ \ \ (byte-seq (string-\<gtr\>utf8 data start end))

    \ \ \ \ \ \ \ \ \ (code-point (utf8-byte-sequence-\<gtr\>code-point byte-seq)))

    \ \ \ \ (rich-char byte-seq)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 str ($ "你好，世界")

    \ \ (check (str :char-at 0) =\<gtr\> (rich-char #x4F60)) \ ;; "你" 的 Unicode 码点

    \ \ (check (str :char-at 1) =\<gtr\> (rich-char #x597D)) \ ;; "好" 的 Unicode 码点

    \ \ (check (str :char-at 2) =\<gtr\> (rich-char #xFF0C)) \ ;; "，" 的 Unicode 码点

    \ \ (check (str :char-at 3) =\<gtr\> (rich-char #x4E16)) \ ;; "世" 的 Unicode 码点

    \ \ (check (str :char-at 4) =\<gtr\> (rich-char #x754C)) \ ;; "界" 的 Unicode 码点

    \ \ (check-catch 'out-of-range (str :char-at 10)))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%apply>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (typed-define (%apply (i integer?))

    \ \ (%char-at i))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 str ($ "Hello，世界")

    \ \ \ (check (str 0) =\<gtr\> ($ #\\H))

    \ \ \ (check (str 7) =\<gtr\> (rich-char "界")))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%slice>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%slice from until)

    \ \ (let* ((len (u8-string-length data))

    \ \ \ \ \ \ \ \ \ (start (max 0 from))

    \ \ \ \ \ \ \ \ \ (end (min len until)))

    \ \ \ \ (if (\<less\> start end)

    \ \ \ \ \ \ \ \ (rich-string (u8-substring data start end))

    \ \ \ \ \ \ \ \ (rich-string ""))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 str ($ "Hello，世界")

    \ \ \ (check (str :slice 0 5) =\<gtr\> ($ "Hello"))

    \ \ \ (check (str :slice -10 5) =\<gtr\> ($ "Hello"))

    \ \ \ (check (str :slice 6 100) =\<gtr\> ($ "世界"))

    \ \ \ (check (str :slice 6 2) =\<gtr\> ($ ""))

    \ \ \ (check (str :slice -3 -2) =\<gtr\> ($ ""))

    \ \ \ (check (str :slice 100 101) =\<gtr\> ($ ""))

    \ \ \ (check (str :slice -1 100) =\<gtr\> ($ "Hello，世界"))

    \ \ \ (check (str :slice 0 5 :to-string) =\<gtr\> "Hello"))

    \;
  </goldfish-chunk>

  <section|谓词>

  <paragraph|rich-string%equals>

  该函数由<scm|define-case-class>自动生成。

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "42") =\<gtr\> ($ "42"))

    (check-false ($ "41" :equals ($ "42")))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%empty?><typehint|=\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%empty?)

    \ \ (string-null? data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ((rich-string "") :empty?))

    (check-false ((rich-string "abc") :empty?))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%starts-with>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%starts-with prefix)

    \ \ (string-starts? data prefix))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%ends-with>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%ends-with suffix)

    \ \ (string-ends? data suffix))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%forall>

  检查字符串中的所有字符是否都满足给定的谓词。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%forall pred)

    \ \ ((%to-vector) :forall pred))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-false ($ "全部都是中文" :forall (@ _ :digit?)))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%exists>

  检查字符串中是否存在至少一个字符满足给定的谓词。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%exists pred)

    \ \ ((%to-vector) :exists pred))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ($ "全部都是中文" :exists (@ _ :equals (rich-char "中"))))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%contains>

  检查字符串中是否包含指定的字符或者子字符串。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%contains elem)

    \ \ (cond ((string? elem)

    \ \ \ \ \ \ \ \ \ (string-contains data elem))

    \ \ \ \ \ \ \ \ ((char? elem)

    \ \ \ \ \ \ \ \ \ (string-contains data (string elem)))

    \ \ \ \ \ \ \ \ (else (type-error "elem must be char or string"))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 str (rich-string "Hello, World!")

    \ \ (check-true (str :contains #\\W))

    \ \ (check-true (str :contains "Hello"))

    \ \ (check-true (str :contains "")))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%index-of>

  查找字符串中指定的字符或子串的下标，找不到则返回 -1。默认从字符串起始位置开始查找。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    ;; Find the index for the char or substring in rich-string (from start-index), else return -1

    (define (%index-of sub . start-index)

    \ \ (let1 start (if (null? start-index) 0 (car start-index))

    \ \ (cond

    \ \ \ \ ((string? sub)

    \ \ \ \ \ (let ((str-len (string-length data))

    \ \ \ \ \ \ \ \ \ \ \ (sub-len (string-length sub)))

    \ \ \ \ \ \ \ (let loop ((i start))

    \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\> (+ i sub-len) str-len) -1)

    \ \ \ \ \ \ \ \ \ \ \ ((equal? (substring data i (+ i sub-len)) sub) i)

    \ \ \ \ \ \ \ \ \ \ \ (else (loop (+ i 1)))))))

    \ \ \ \ ((char? sub)

    \ \ \ \ \ (let loop ((lst (string-\>list (substring data start))) (index start))

    \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ ((null? lst) -1)

    \ \ \ \ \ \ \ ((char=? (car lst) sub) index)

    \ \ \ \ \ \ \ (else (loop (cdr lst) (+ index 1)))))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 str (rich-string "hello world!")

    \ \ (check (str :index-of "hello") =\<gtr\> 0)

    \ \ (check (str :index-of "hello") =\<gtr\> (str :index-of "hello" 0))

    \ \ (check (str :index-of "hello" 1) =\<gtr\> -1)

    \ \ (check (str :index-of "world") =\<gtr\> 6)

    \ \ (check (str :index-of "world" 1) =\<gtr\> 6)

    \ \ (check (str :index-of "!") =\<gtr\> 11)

    \ \ (check (str :index-of "scheme") =\<gtr\> -1)

    \ \ (check (str :index-of #\\h) =\<gtr\> 0)

    \ \ (check (str :index-of #\\h) =\<gtr\> (str :index-of #\\h 0))

    \ \ (check (str :index-of #\\h 1) =\<gtr\> -1)

    \ \ (check (str :index-of #\\w) =\<gtr\> 6)

    \ \ (check (str :index-of #\\w 1) =\<gtr\> 6)

    \ \ (check (str :index-of #\\!) =\<gtr\> 11)

    \ \ (check (str :index-of #\\~) =\<gtr\> -1))

    \;
  </goldfish-chunk>

  <section|高阶函数>

  <paragraph|rich-string%map><typehint|((p procedure?)) =\<gtr\> rich-string?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%map f)

    \ \ ((%to-vector)

    \ \ \ :map f

    \ \ \ :map (@ _ :make-string)

    \ \ \ :make-string))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "abc" :map (lambda (c) (c :to-upper))) =\<gtr\> "ABC")

    (check ($ "abc中文" :map (lambda (c) (c :to-upper))) =\<gtr\> "ABC中文")

    \;
  </goldfish-chunk>

  <paragraph|rich-string%count>

  计算字符串中满足给定谓词的字符的数量

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%count pred?)

    \ \ ((%to-vector) :count pred?))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "" :count (@ == _ #\\A)) =\<gtr\> 0)

    (check ($ "hello" :count (@ == _ #\\l)) =\<gtr\> 2)

    (check ($ "你好，我是韩梅梅" :count (@ == _ (rich-char "梅"))) =\<gtr\> 2)

    \;
  </goldfish-chunk>

  <section|转换器>

  <paragraph|rich-string%to-string>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-string)

    \ \ data)

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((rich-string "hello") :to-string) =\<gtr\> "hello")

    \;
  </goldfish-chunk>

  <paragraph|rich-string%to-vector>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-vector)

    \ \ (if (string-null? data)

    \ \ \ \ \ \ (rich-vector :empty)

    \ \ \ \ \ \ (let* ((bv (string-\<gtr\>utf8 data))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (bv-size (length bv))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (len (u8-string-length data))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (result (make-vector len)))

    \ \ \ \ \ \ \ \ (let loop ((i 0) (j 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= i len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rich-vector result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((next-j (bytevector-advance-u8 bv j bv-size))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (code (utf8-byte-sequence-\<gtr\>code-point (bytevector-copy bv j next-j))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! result i (rich-char code))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) next-j)))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 v ($ "中文" :to-vector)

    \ \ (check (v 0) =\<gtr\> (rich-char "中"))

    \ \ (check (v 1) =\<gtr\> (rich-char "文")))

    \;
  </goldfish-chunk>

  <section|修改器>

  <paragraph|rich-string%+>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%+ s)

    \ \ (cond

    \ \ \ \ ((string? s)

    \ \ \ \ \ (rich-string (string-append data s)))

    \ \ \ \ ((rich-string :is-type-of s)

    \ \ \ \ \ (rich-string (string-append data (s :get))))

    \ \ \ \ (else

    \ \ \ \ \ \ (type-error (string-append (object-\<gtr\>string s) "is not string or rich-string")))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "Hello" :+ " " :+ "World") =\<gtr\> "Hello World")

    (check ($ "hello " :+ (box "world")) =\<gtr\> "hello world")

    (check-catch 'type-error ($ "hello" :+ 1))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%strip-left>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%strip-left)

    \ \ (rich-string (string-trim data)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ " abc " :strip-left) =\<gtr\> "abc ")

    (check ($ " \ \ abc" :strip-left) =\<gtr\> "abc")

    (check ($ "\\t\\n abc" :strip-left) =\<gtr\> "abc")

    (check ($ " \\t \\n abc \\t \\n " :strip-left) =\<gtr\> "abc \\t \\n ")

    (check ($ "" :strip-left) =\<gtr\> "")

    (check ($ " \ \ " :strip-left) =\<gtr\> "")

    \;
  </goldfish-chunk>

  <paragraph|rich-string%strip-right>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%strip-right)

    \ \ (rich-string (string-trim-right data)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ " abc " :strip-right) =\<gtr\> " abc")

    (check ($ "abc \ \ " :strip-right) =\<gtr\> "abc")

    (check ($ "abc \\t\\n" :strip-right) =\<gtr\> "abc")

    (check ($ " \\t \\n abc \\t \\n " :strip-right) =\<gtr\> " \\t \\n abc")

    (check ($ "" :strip-right) =\<gtr\> "")

    (check ($ " \ \ " :strip-right) =\<gtr\> "")

    \;
  </goldfish-chunk>

  <paragraph|rich-string%strip-both>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%strip-both)

    \ \ (rich-string (string-trim-both data)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ " abc " :strip-both) =\<gtr\> "abc")

    (check ($ " \ \ abc \ \ " :strip-both) =\<gtr\> "abc")

    (check ($ "\\t\\n abc \\t\\n" :strip-both) =\<gtr\> "abc")

    (check ($ " \\t \\n abc \\t \\n " :strip-both) =\<gtr\> "abc")

    (check ($ "" :strip-both) =\<gtr\> "")

    (check ($ " \ \ " :strip-both) =\<gtr\> "")

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-string%strip-prefix>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%strip-prefix prefix)

    \ \ (rich-string (string-remove-prefix data prefix)))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "" :strip-prefix "") =\<gtr\> ($ ""))

    (check ($ "hello" :strip-prefix "") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-prefix "he") =\<gtr\> ($ "llo"))

    (check ($ "hello" :strip-prefix "hello") =\<gtr\> ($ ""))

    (check ($ "hello" :strip-prefix "abc") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-prefix "helloo") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-prefix "he" :strip-prefix "ll") =\<gtr\> ($ "o"))

    \;

    (check-catch 'wrong-number-of-args ("hello":strip-prefix "he"))

    (check-catch 'unbound-variable (123:strip-prefix 1))

    \;
  </goldfish-chunk>

  <paragraph|rich-string%strip-suffix>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%strip-suffix suffix)

    \ \ (rich-string (string-remove-suffix data suffix)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "" :strip-suffix "") =\<gtr\> ($ ""))

    (check ($ "hello" :strip-suffix "") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-suffix "lo") =\<gtr\> ($ "hel"))

    (check ($ "hello" :strip-suffix "hello") =\<gtr\> ($ ""))

    (check ($ "hello" :strip-suffix "abc") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-suffix "hhello") =\<gtr\> ($ "hello"))

    (check ($ "hello" :strip-suffix "lo" :strip-suffix "el") =\<gtr\> ($ "h"))

    \;

    (check-catch 'wrong-number-of-args ("hello":strip-suffix "llo"))

    (check-catch 'unbound-variable (123:strip-suffix 1))
  </goldfish-chunk>

  <paragraph|rich-string%replace-first>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    ;; Replace the first occurrence of the substring old to new.

    (define (%replace-first old new . xs)

    \ \ (define (replace-helper str old new start)

    \ \ \ \ (let ((next-pos (%index-of old start)))

    \ \ \ \ \ \ (if (= next-pos -1)

    \ \ \ \ \ \ \ \ \ \ str

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

    \ \ \ \ \ \ \ \ \ \ \ (substring str 0 next-pos)

    \ \ \ \ \ \ \ \ \ \ \ new

    \ \ \ \ \ \ \ \ \ \ \ (substring str (+ next-pos (string-length old)))))))

    \ \ (let ((result (rich-string (replace-helper data old new 0))))

    \ \ \ \ (if (null? xs)

    \ \ \ \ \ \ \ \ result

    \ \ \ \ \ \ \ \ (apply result xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "hahaha" :replace-first "a" "oo") =\<gtr\> ($ "hoohaha"))

    (check ($ "hello" :replace-first "world" "") =\<gtr\> ($ "hello"))

    (check ($ "hello" :replace-first "l" "L" :strip-prefix "he") =\<gtr\> ($ "Llo")) ; chain

    \;
  </goldfish-chunk>

  <paragraph|rich-string%replace>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    ;; Replace the occurrences of the substring old to new.

    (define (%replace old new . xs)

    \ \ (define (replace-helper str old new start)

    \ \ \ \ (let ((next-pos ((rich-string str) :index-of old start)))

    \ \ \ \ \ \ (if (= next-pos -1)

    \ \ \ \ \ \ \ \ \ \ str

    \ \ \ \ \ \ \ \ \ \ (replace-helper ((rich-string str) :replace-first old new :get) old new next-pos))))

    \ \ (let ((result (rich-string (replace-helper data old new 0))))

    \ \ \ \ (if (null? xs)

    \ \ \ \ \ \ \ \ result

    \ \ \ \ \ \ \ \ (apply result xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "hahaha" :replace "a" "oo") =\<gtr\> ($ "hoohoohoo"))

    (check ($ "hello" :replace "world" "") =\<gtr\> ($ "hello"))

    (check ($ "hello" :replace "l" "L" :strip-prefix "he") =\<gtr\> ($ "LLo")) ; chain

    \;
  </goldfish-chunk>

  <section|其余函数>

  <paragraph|rich-string%split>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%split sep)

    \ \ (let ((str-len (string-length data))

    \ \ \ \ \ \ \ \ (sep-len (string-length sep)))

    \;

    \ \ \ \ (define (split-helper start acc)

    \ \ \ \ \ \ (let ((next-pos (%index-of sep start)))

    \ \ \ \ \ \ \ \ (if (= next-pos -1)

    \ \ \ \ \ \ \ \ \ \ \ \ (cons (substring data start) acc)

    \ \ \ \ \ \ \ \ \ \ \ \ (split-helper (+ next-pos sep-len) (cons (substring data start next-pos) acc)))))

    \ \ \ \ 

    \ \ \ \ (if (zero? sep-len)

    \ \ \ \ \ \ \ \ ((%to-vector) :map (lambda (c) (rich-string :value-of c :get)) :collect)

    \ \ \ \ \ \ \ \ (rich-vector (reverse-list-\<gtr\>vector (split-helper 0 '()))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ "da@liii.pro" :split "@") =\<gtr\> #("da" "liii.pro"))

    (check ($ "da@liii.pro" :split ".") =\<gtr\> #("da@liii" "pro"))

    (check ($ "test" :split "") =\<gtr\> #("t" "e" "s" "t"))

    (check ($ "aXXbXXcXX" :split "XX") =\<gtr\> #("a" "b" "c" ""))

    (check ($ "a\|\|b\|\|c" :split "\|\|") =\<gtr\> #("a" "b" "c"))

    (check ($ "XXaXXb" :split "XX") =\<gtr\> #("" "a" "b"))

    (check ($ "你好，欢迎使用Liii STEM" :split "，") =\<gtr\> #("你好" "欢迎使用Liii STEM"))

    (check ($ "中国智造，惠及全球" :split "") =\<gtr\> #("中" "国" "智" "造" "，" "惠" "及" "全" "球"))

    \;

    (check (($ "qingyu@liii.pro" :split "@") :head) =\<gtr\> "qingyu")

    (check (($ "127.0.0.1" :split ".") :count) =\<gtr\> 4)

    (check-catch 'wrong-number-of-args ($ "127.0.0.1" :split "." :count))

    \;
  </goldfish-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </scm-chunk>

  <chapter|option>

  <section|option>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class option ((value any?))

    \;
  </goldfish-chunk>

  <subsection|测试>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42))

    \ \ \ \ \ \ (opt2 (option '())))

    \ \ (check (opt1 :map (lambda (x) (+ x 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :map (lambda (x) (* x 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :get) =\<gtr\> 86)

    \ \ (check (opt2 :map (lambda (x) (+ x 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :map (lambda (x) (* x 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :empty?) =\<gtr\> #t)

    \;

    \ \ (check (opt1 :flat-map (lambda (x) (option (+ x 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :flat-map (lambda (x) (option (* x 2)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :get) =\<gtr\> 86)

    \ \ (check (opt2 :flat-map (lambda (x) (option (+ x 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :flat-map (lambda (x) (option (* x 2)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :empty?) =\<gtr\> #t)

    \;

    \ \ (check (opt1 :filter (lambda (x) (\<gtr\> x 40))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :filter (lambda (x) (\<less\> x 50))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :get) =\<gtr\> 42)

    \ \ (check (opt1 :filter (lambda (x) (\<gtr\> x 50))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :filter (lambda (x) (\<less\> x 60))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :empty?) =\<gtr\> #t)

    \ \ (check (opt2 :filter (lambda (x) (\<gtr\> x 40))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :filter (lambda (x) (\<less\> x 50))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :empty?) =\<gtr\> #t)

    \;

    \ \ (check (opt1 :defined?) =\<gtr\> #t)

    \ \ (check (opt1 :empty?) =\<gtr\> #f)

    \ \ (check (opt2 :defined?) =\<gtr\> #f)

    \ \ (check (opt2 :empty?) =\<gtr\> #t)

    )

    \;
  </scm-chunk>

  <subsection|选择器>

  <paragraph|option%get>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get)

    \ \ (if (null? value)

    \ \ \ \ \ \ (value-error "option is empty, cannot get value")

    \ \ \ \ \ \ value))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42)) (opt2 (option '())))

    \ \ (check (opt1 :get) =\<gtr\> 42)

    \ \ (check-catch 'value-error (opt2 :get)))

    \;
  </goldfish-chunk>

  <paragraph|option%get-or-else>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get-or-else default)

    \ \ (cond ((not (null? value)) value)

    \ \ \ \ \ \ \ \ ((and (procedure? default) (not (case-class? default)))

    \ \ \ \ \ \ \ \ \ (default))

    \ \ \ \ \ \ \ \ (else default)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42)) (opt2 (option '())))

    \ \ (check (opt1 :get-or-else 0) =\<gtr\> 42)

    \ \ (check (opt2 :get-or-else 0) =\<gtr\> 0)

    \;

    \ \ (check (opt1 :get-or-else (lambda () 0)) =\<gtr\> 42)

    \ \ (check (opt2 :get-or-else (lambda () 0)) =\<gtr\> 0)

    )

    \;

    (check ((none) :get-or-else ($ 1)) =\<gtr\> ($ 1))

    \;
  </goldfish-chunk>

  <paragraph|option%or-else>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (typed-define (%or-else (default case-class?))

    \ \ (when (not (default :is-instance-of 'option))

    \ \ \ \ (type-error "The first parameter of option%or-else must be a option case class"))

    \;

    \ \ (if (null? value)

    \ \ \ \ \ \ default

    \ \ \ \ \ \ (option value)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42)) (opt2 (option '())))

    \ \ (check (opt1 :or-else (option 0)) =\<gtr\> (option 42))

    \ \ (check (opt2 :or-else (option 0)) =\<gtr\> (option 0))

    \ \ (check-catch 'type-error (opt1 :or-else 0))

    )

    \;
  </goldfish-chunk>

  <subsection|谓词>

  <paragraph|option%equals>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%equals that)

    \ \ (== value (that 'value)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ((option "str") :equals (option "str")))

    \;
  </goldfish-chunk>

  <paragraph|option%defined?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%defined?) (not (null? value)))

    \ \ 
  </goldfish-chunk>

  <paragraph|option%empty?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%empty?) (null? value))

    \;
  </goldfish-chunk>

  <paragraph|option%forall>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%forall f)

    \ \ (if (null? value)

    \ \ \ \ \ \ #f

    \ \ \ \ \ \ (f value)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42)) (opt2 (option '())))

    \ \ (check-true (opt1 :forall (lambda (x) (== x 42))))

    \ \ (check-false (opt2 :forall (lambda (x) (== x 42)))))

    \;
  </goldfish-chunk>

  <paragraph|option%exists>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%exists f)

    \ \ (if (null? value)

    \ \ \ \ \ \ #f

    \ \ \ \ \ \ (f value)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((opt1 (option 42)) (opt2 (option '())))

    \ \ (check-true (opt1 :exists (lambda (x) (== x 42))))

    \ \ (check-false (opt2 :exists (lambda (x) (== x 42)))))

    \;
  </goldfish-chunk>

  <subsection|高阶函数>

  <paragraph|option%for-each>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%for-each f)

    \ \ (when (not (null? value))

    \ \ \ \ \ \ \ \ (f value)))

    \;
  </goldfish-chunk>

  <paragraph|option%map>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%map f)

    \ \ (if (null? value)

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

    \ \ \ \ \ \ (option (f value))))

    \;
  </goldfish-chunk>

  <paragraph|option%flatmap>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%flat-map f . xs)

    \ \ (let1 r (if (null? value)

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (f value))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <paragraph|option%filter>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%filter pred . xs)

    \ \ \ \ (let1 r (if (or (null? value) (not (pred value)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (option value))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <subsection|结尾>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  <paragraph|none><index|none>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (none) (option '()))

    \;
  </scm-chunk>

  <chapter|rich-list>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-list ((data list?))

    \;
  </goldfish-chunk>

  <section|静态方法>

  <paragraph|rich-list@range>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@range start end . step)

    \ \ (let ((step-size (if (null? step) 1 (car step))))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((and (positive? step-size) (\<gtr\>= start end))

    \ \ \ \ \ \ \ (rich-list '()))

    \ \ \ \ \ \ ((and (negative? step-size) (\<less\>= start end))

    \ \ \ \ \ \ \ (rich-list '()))

    \ \ \ \ \ \ ((zero? step-size)

    \ \ \ \ \ \ \ (value-error "Step size cannot be zero"))

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ (let1 cnt (ceiling (/ (- end start) step-size))

    \ \ \ \ \ \ \ \ \ (rich-list (iota cnt start step-size)))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-list :range 1 5) =\<gtr\> ($ (list 1 2 3 4)))

    (check (rich-list :range 1 5 2) =\<gtr\> ($ (list 1 3)))

    (check (rich-list :range 1 6 2) =\<gtr\> ($ (list 1 3 5)))

    (check (rich-list :range 5 1 -1) =\<gtr\> ($ (list 5 4 3 2)))

    \;

    (check (rich-list :range 5 1 1) =\<gtr\> ($ (list )))

    \;

    (check-catch 'value-error (rich-list :range 1 5 0))

    \;
  </goldfish-chunk>

  <paragraph|rich-list@empty>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@empty . xs)

    \ \ (let1 r (rich-list (list ))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-list :empty :empty?) =\<gtr\> #t)

    (check (rich-list :empty :head-option) =\<gtr\> (none))

    \;
  </goldfish-chunk>

  <paragraph|rich-list@concat>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@concat lst1 lst2 . xs)

    \ \ (let1 r (rich-list (append (lst1 :collect) (lst2 :collect)))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    \;

    (check (rich-list :concat ($ (list 1)) ($ (list 2))) =\<gtr\> ($ (list 1 2)))

    (check (rich-list :concat ($ (list 1 2)) ($ (list 3 4))) =\<gtr\> ($ (list 1 2 3 4)))

    (check (rich-list :concat (rich-list :range 1 4) ($ (list 3 4))) =\<gtr\> ($ (list 1 2 3 3 4)))

    (check (rich-list :concat ($ (list 1)) ($ (list 2))

    \ \ \ \ \ \ \ \ \ \ \ :collect) =\<gtr\> (list 1 2))

    <code|(check (rich-list :concat (rich-list '(1)) (rich-list '(2)) :count) =\> 2)>

    \;
  </goldfish-chunk>

  <paragraph|rich-list@fill>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@fill n elem)

    \ \ (cond

    \ \ \ \ ((\<less\> n 0)

    \ \ \ \ \ \ (value-error "n cannot be negative"))

    \ \ \ \ ((= n 0)

    \ \ \ \ \ \ (rich-list '()))

    \ \ \ \ (else

    \ \ \ \ \ \ (rich-list (make-list n elem)))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 result (rich-list :fill 3 "a")

    \ \ (check (result :collect) =\<gtr\> '("a" "a" "a")))

    \;

    (let1 result (rich-list :fill 0 "a")

    \ \ (check (result :collect) =\<gtr\> '()))

    \;

    (check-catch 'value-error (rich-list :fill -1 "a"))

    \;

    (let1 result (rich-list :fill 2 42)

    \ \ (check (result :collect) =\<gtr\> '(42 42)))

    \;

    (let1 result (rich-list :fill 1000 "x")

    \ \ (check (length (result :collect)) =\<gtr\> 1000))

    \;
  </goldfish-chunk>

  <section|选择器>

  <paragraph|rich-list%collect>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%collect) data)

    \;
  </goldfish-chunk>

  <paragraph|rich-list%apply>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%apply n)

    \ \ (list-ref data n))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ '(1 2 3) :apply 0) =\<gtr\> 1)

    (check ($ '(1 2 3) 0) =\<gtr\> 1)

    \;
  </goldfish-chunk>

  <paragraph|rich-list%find><typehint|((pred procedure?)) =\<gtr\> option?>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%find pred)

    \ \ (let loop ((lst data))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((null? lst) (none))

    \ \ \ \ \ \ ((pred (car lst)) (option (car lst)))

    \ \ \ \ \ \ (else (loop (cdr lst))))))

    \;
  </scm-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 lst (rich-list '(1 2 3 4 5))

    \ \ (check ((lst :find (lambda (x) (= x 3))) :get) =\<gtr\> 3)

    \ \ (check ((lst :find (lambda (x) (\<gtr\> x 2))) :get) =\<gtr\> 3)

    \ \ (check ((lst :find (lambda (x) (\<gtr\> x 10))) :empty?) =\<gtr\> #t)

    \ \ (check ((lst :find even?) :get) =\<gtr\> 2)

    \ \ (check ((lst :find (lambda (x) (\<less\> x 0))) :empty?) =\<gtr\> #t))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%head>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    <\code>
      (define (%head)

      \ \ (if (null? data)

      \ \ \ \ \ \ (error 'out-of-range "rich-list%head: list is empty")

      \ \ \ \ \ \ (car data)))

      \;
    </code>

    \;
  </scm-chunk>

  <paragraph|rich-list%head-option>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    <\code>
      (define (%head-option)

      \ \ (if (null? data)

      \ \ \ \ \ \ (none)

      \ \ \ \ \ \ (option (car data))))

      \;
    </code>

    \;
  </scm-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ (list 1 2 3) :head) =\<gtr\> 1)

    (check-catch 'out-of-range (rich-list :empty :head))

    (check ($ (list 1 2 3) :head-option) =\<gtr\> (option 1))

    (check (rich-list :empty :head-option) =\<gtr\> (none))

    \;
  </goldfish-chunk>

  \;

  <section|谓词>

  <paragraph|rich-list%empty?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%empty?)

    \ \ (null? data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ($ (list) :empty?))

    (check-false ($ '(1 2 3) :empty?))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%equals>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%equals that)

    \ \ (let* ((l1 data)

    \ \ \ \ \ \ \ \ \ (l2 (that 'data))

    \ \ \ \ \ \ \ \ \ (len1 (length l1))

    \ \ \ \ \ \ \ \ \ (len2 (length l2)))

    \ \ \ \ (if (not (eq? len1 len2))

    \ \ \ \ \ \ \ \ #f

    \ \ \ \ \ \ \ \ (let loop ((left l1) (right l2))

    \ \ \ \ \ \ \ \ \ \ (cond ((null? left) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((!= (car left) (car right)) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (cdr left) (cdr right))))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ (list ($ 1) ($ 2) ($ 3))) =\<gtr\> (($ 1 :to 3) :map $))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%forall>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%forall pred)

    \ \ (every pred data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 lst ($ '(1 2 3 4 5))

    \ \ (check (lst :forall (@ \<gtr\> _ 0)) =\<gtr\> #t)

    \ \ (check (lst :forall (@ \<gtr\> _ 3)) =\<gtr\> #f)

    )

    \;

    (check (rich-list :empty :forall (@ \<gtr\> _ 0)) =\<gtr\> #t)

    \;
  </goldfish-chunk>

  <paragraph|rich-list%exists>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%exists pred)

    \ \ (any pred data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 l (rich-list '(1 2 3))

    \ \ (check-true (l :exists even?)))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%contains><typehint|(elem) =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%contains elem)

    \ \ (%exists (lambda (x) (equal? x elem))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 l (rich-list '(1 2 3))

    \ \ (check-true (l :contains 1))

    \ \ (check-false (l :contains 4)))

    \;
  </goldfish-chunk>

  <section|高阶函数>

  <paragraph|rich-list%map>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%map x)

    \ \ (rich-list (map x data)))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%flat-map>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%flat-map x)

    \ \ (rich-list (flat-map x data)))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%filter>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%filter x)

    \ \ (rich-list (filter x data)))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%for-each>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%for-each x)

    \ \ (for-each x data))

    \;
  </scm-chunk>

  <paragraph|rich-list%reverse>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%reverse)

    \ \ (rich-list (reverse data)))

    \ \ \ \ 
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :reverse :collect) =\<gtr\> '(5 4 3 2 1)))

    \;

    (let ((lst (rich-list '(a b c d e))))

    \ \ (check (lst :reverse :collect) =\<gtr\> '(e d c b a)))

    \;

    (let ((lst (rich-list '())))

    \ \ (check (lst :reverse :collect) =\<gtr\> '()))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%take>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%take x . xs)

    \ \ \ \ (typed-define (scala-take (data list?) (n integer?))

    \ \ \ \ \ \ (cond ((\<less\> n 0) '())

    \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n (length data)) data)

    \ \ \ \ \ \ \ \ \ \ \ \ (else (take data n))))

    \;

    \ \ \ \ (let1 r (rich-list (scala-take data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :take -1 :collect) =\<gtr\> '())

    \ \ (check (lst :take 0 :collect) =\<gtr\> '())

    \ \ (check (lst :take 3 :collect) =\<gtr\> '(1 2 3))

    \ \ (check (lst :take 5 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :take 10 :collect) =\<gtr\> '(1 2 3 4 5))

    )

    \;
  </scm-chunk>

  \;

  <paragraph|rich-list%drop >

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%drop x . xs)

    \ \ \ \ (typed-define (scala-drop (data list?) (n integer?))

    \ \ \ \ \ \ (cond ((\<less\> n 0) data)

    \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n (length data)) '())

    \ \ \ \ \ \ \ \ \ \ \ \ (else (drop data n))))

    \;

    \ \ \ \ (let1 r (rich-list (scala-drop data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :drop -1 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :drop 0 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :drop 3 :collect) =\<gtr\> '(4 5))

    \ \ (check (lst :drop 5 :collect) =\<gtr\> '())

    \ \ (check (lst :drop 10 :collect) =\<gtr\> '())

    )

    \;
  </goldfish-chunk>

  \;

  <\paragraph>
    rich-list%take-right
  </paragraph>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%take-right x . xs)

    \ \ \ \ (typed-define (scala-take-right (data list?) (n integer?))

    \ \ \ \ \ \ (cond ((\<less\> n 0) '())

    \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n (length data)) data)

    \ \ \ \ \ \ \ \ \ \ \ \ (else (take-right data n))))

    \;

    \ \ \ \ (let1 r (rich-list (scala-take-right data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :take-right -1 :collect) =\<gtr\> '())

    \ \ (check (lst :take-right 0 :collect) =\<gtr\> '())

    \ \ (check (lst :take-right 3 :collect) =\<gtr\> '(3 4 5))

    \ \ (check (lst :take-right 5 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :take-right 10 :collect) =\<gtr\> '(1 2 3 4 5))

    )

    \;
  </scm-chunk>

  <paragraph|rich-list%drop-right>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    \ (define (%drop-right x . xs)

    \ \ \ \ (typed-define (scala-drop-right (data list?) (n integer?))

    \ \ \ \ \ \ (cond ((\<less\> n 0) data)

    \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n (length data)) '())

    \ \ \ \ \ \ \ \ \ \ \ \ (else (drop-right data n))))

    \;

    \ \ \ \ (let1 r (rich-list (scala-drop-right data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \ 
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :drop-right -1 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :drop-right 0 :collect) =\<gtr\> '(1 2 3 4 5))

    \ \ (check (lst :drop-right 3 :collect) =\<gtr\> '(1 2))

    \ \ (check (lst :drop-right 5 :collect) =\<gtr\> '())

    \ \ (check (lst :drop-right 10 :collect) =\<gtr\> '())

    )

    \;
  </goldfish-chunk>

  <paragraph|rich-list%count>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%count . xs)

    \ \ \ \ (cond ((null? xs) (length data))

    \ \ \ \ \ \ \ \ \ \ ((length=? 1 xs) (count (car xs) data))

    \ \ \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args "rich-list%count" xs))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((rich-list (list 1 2 3)) :count) =\<gtr\> 3)

    (check ((rich-list (list 1 2 3)) :count (cut \<gtr\> \<less\>\<gtr\> 1)) =\<gtr\> 2)

    \;
  </scm-chunk>

  \;

  <paragraph|rich-list%fold>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%fold initial f)

    \ \ \ \ (fold f initial data))

    \;

    \ \ (define (%fold-right initial f)

    \ \ \ \ (fold-right f initial data))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((lst (rich-list '(1 2 3 4 5))))

    \ \ (check (lst :fold 0 +) =\<gtr\> 15)

    \ \ (check (lst :fold '() (lambda (x acc) (cons x acc))) =\<gtr\> '(5 4 3 2 1))

    \;

    \ \ (check (lst :fold-right 0 +) =\<gtr\> 15)

    \ \ (check (lst :fold-right '() (lambda (x acc) (cons x acc))) =\<gtr\> '(1 2 3 4 5))

    )

    \;
  </scm-chunk>

  \;

  <paragraph|rich-list%sort-with>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%sort-with less-p . xs)

    \ \ (let*\ 

    \ \ \ \ ((sorted-data (list-stable-sort less-p data))

    \ \ \ \ (sorted-rich-list (rich-list sorted-data)))

    \ \ \ \ (if (null? xs)\ 

    \ \ \ \ \ \ \ \ sorted-rich-list\ 

    \ \ \ \ \ \ \ \ (apply sorted-rich-list xs))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ '(3 1 2 4 5)

    \ \ \ \ \ \ \ \ :sort-with (lambda (x y) (\<less\> x y)))

    \ \ \ \ =\<gtr\> ($ '(1 2 3 4 5)))

    \;

    (check ($ (list 1 3 4 2 5) :sort-with \<less\> :take 2) =\<gtr\> (list 1 2))

    \;

    (check\ 

    \ \ ($ (list 1 3 4 2 5)\ 

    \ \ \ \ \ :sort-with \<less\>

    \ \ \ \ \ :take 2

    \ \ \ \ \ :collect)

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

    \;

    (check\ 

    \ \ ($ '((3 . a) (1 . b) (2 . c) (1 . d))

    \ \ \ \ \ :sort-with (lambda (x y) (\<less\> (car x) (car y))) \ ;; 按 car 排序

    \ \ \ \ \ :collect)

    \ \ =\<gtr\> '((1 . b) (1 . d) (2 . c) (3 . a)))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-list%group-by>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%group-by func)

    \ \ (let ((group (make-hash-table)))

    \ \ \ \ (for-each

    \ \ \ \ \ \ (lambda (elem)\ 

    \ \ \ \ \ \ \ \ (let ((key (func elem)))

    \ \ \ \ \ \ \ \ \ \ (hash-table-update!/default

    \ \ \ \ \ \ \ \ \ \ \ \ group

    \ \ \ \ \ \ \ \ \ \ \ \ key

    \ \ \ \ \ \ \ \ \ \ \ \ (lambda (current-list) (cons elem current-list))

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

    \ \ \ \ \ \ data)

    \ \ \ \ (hash-table-for-each\ 

    \ \ \ \ \ \ (lambda (k v) (hash-table-set! group k (reverse v)))\ 

    \ \ \ \ \ \ group)

    \ \ (rich-hash-table group)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ (($ '(1 2 3 4 5 6) :group-by (@ modulo _ 2)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 '(2 4 6) 1 '(1 3 5)))

    \;

    (check \ (($ '(1 2 3 4 5 6) :group-by (@ modulo _ 3)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 '(3 6) 1 '(1 4) 2 '(2 5)))

    \;

    (check \ (($ '(1 2 3 4 5 6 7) :group-by (@ modulo _ 3)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 '(3 6) 1 '(1 4 7) 2 '(2 5)))

    \;

    (let ((result ($ '("apple" "banana" "cat" "dog") :group-by (@ string-length _))))

    \ \ (check (result :collect)\ 

    \ \ \ \ \ \ \ \ \ \ =\<gtr\> (hash-table 3 '("cat" "dog") 5 '("apple") 6 '("banana"))))

    \;
  </goldfish-chunk>

  <paragraph|rich-list%zip>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%zip l) (box (apply map cons (list data l))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (($ '(1 2 3)) :zip '(a b c) :collect) =\<gtr\> '((1 . a) (2 . b) (3 . c)))

    (check (($ '(1 2 3)) :zip '(a b) :collect) =\<gtr\> '((1 . a) (2 . b)))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-list%zip-with-index>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%zip-with-index)

    \ \ (let loop ((lst data) (idx 0) (result '()))

    \ \ \ \ (if (null? lst)

    \ \ \ \ \ \ \ \ (rich-list (reverse result)) \ 

    \ \ \ \ \ \ \ \ (loop (cdr lst)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ idx 1)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cons idx (car lst)) result)))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ ($ '(a b c) :zip-with-index :collect) \ 

    \ \ \ \ \ \ \ \ =\<gtr\> '((0 . a) (1 . b) (2 . c)))

    \;

    (check \ ($ '() :zip-with-index :collect)\ 

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

    \;

    (check \ ($ '(1 1 2 2 2 3 4 5 6 7) :zip-with-index :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> '((0 . 1) (1 . 1) (2 . 2) (3 . 2) (4 . 2) (5 . 3) (6 . 4) (7 . 5) (8 . 6) (9 . 7)))

    \;
  </goldfish-chunk>

  \;

  \;

  <paragraph|rich-list%distinct>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%distinct)

    \ \ (let loop

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

    \ \ \ \ \ \ (data data)\ 

    \ \ \ \ \ \ (ht (make-hash-table)))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((null? data) (rich-list (reverse result))) \ 

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ (let ((elem (car data)))

    \ \ \ \ \ \ \ \ \ (if (eq? (hash-table-ref ht elem) #f)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table-set! ht elem #t) \ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cons elem result) (cdr data) ht))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (loop result (cdr data) ht)))))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ ($ '(a a b c b) :distinct :collect)\ 

    \ \ \ \ \ \ \ \ =\<gtr\> '(a b c))

    \;

    (check \ ($ '(1 1 1 2 2 3 3 3 3 5 5 5) :distinct :collect)\ 

    \ \ \ \ \ \ \ \ =\<gtr\> '(1 2 3 5))

    \;

    (check \ ($ '() :distinct :collect)\ 

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

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-list%reduce>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%reduce f)

    \ \ (if (null? data)

    \ \ \ \ \ \ (value-error "rich-list%reduce: empty list is not allowed to reduce")

    \ \ \ \ \ \ (reduce f '() data)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-catch 'value-error ($ '() :reduce +))

    \;

    (check ($ '(1 2 3) :reduce +) =\<gtr\> 6) \ 

    (check ($ '(2 3 4) :reduce *) =\<gtr\> 24) \ 

    (check ($ '(5) :reduce (lambda (x y) (+ x y 10))) =\<gtr\> 5)

    \;
  </goldfish-chunk>

  <paragraph|rich-list%reduce-option>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%reduce-option f)

    \ \ (if (null? data)

    \ \ \ \ \ \ (none)

    \ \ \ \ \ \ (option (reduce f '() data))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ '() :reduce-option +) =\<gtr\> (none))

    \;

    (check ($ '(1 2 3) :reduce-option +) =\<gtr\> (option 6)) \ 

    (check ($ '(2 3 4) :reduce-option *) =\<gtr\> (option 24)) \ 

    (check ($ '(5) :reduce-option (lambda (x y) (+ x y 10))) =\<gtr\> (option 5))

    \;
  </goldfish-chunk>

  <section|转换器>

  <paragraph|rich-list%to-string>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-string)

    \ \ (object-\<gtr\>string data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (object-\<gtr\>string ($ '(1 2 3))) =\<gtr\> "(1 2 3)")

    \;
  </goldfish-chunk>

  <paragraph|rich-list%make-string>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%make-string . xs)

    \ \ (define (parse-args xs)

    \ \ \ \ (cond

    \ \ \ \ \ \ ((null? xs) (values "" "" ""))

    \ \ \ \ \ \ ((length=? 1 xs)

    \ \ \ \ \ \ \ (let1 sep (car xs)

    \ \ \ \ \ \ \ \ \ (if (string? sep)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (values "" sep "")

    \ \ \ \ \ \ \ \ \ \ \ \ \ (type-error "rich-list%make-string: separator must be a string" sep))))

    \ \ \ \ \ \ ((length=? 2 xs)

    \ \ \ \ \ \ \ (error 'wrong-number-of-args "rich-list%make-string: expected 0, 1, or 3 arguments, but got 2" xs))

    \ \ \ \ \ \ ((length=? 3 xs)

    \ \ \ \ \ \ \ (let ((start (car xs))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (sep (cadr xs))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (end (caddr xs)))

    \ \ \ \ \ \ \ \ \ (if (and (string? start) (string? sep) (string? end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (values start sep end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (error 'type-error "rich-list%make-string: prefix, separator, and suffix must be strings" xs))))

    \ \ \ \ \ \ (else (error 'wrong-number-of-args "rich-list%make-string: expected 0, 1, or 3 arguments" xs))))

    \;

    \ \ (receive (start sep end) (parse-args xs)

    \ \ \ \ (let1 as-string (lambda (x) (if (string? x) x (object-\<gtr\>string x)))

    \ \ \ \ \ \ \ \ \ \ (rich-string (string-append start (string-join (map as-string data) sep) end)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 l (rich-list (list 1 2 3))

    \ \ (check (l :make-string) =\<gtr\> "123")

    \ \ (check (l :make-string " ") =\<gtr\> "1 2 3")

    \ \ (check (l :make-string "[" "," "]") =\<gtr\> "[1,2,3]")

    \ \ 

    \ \ (check-catch 'wrong-number-of-args (l :make-string "[" ","))

    \ \ (check-catch 'type-error (l :make-string 123 "," "]"))

    \ \ (check-catch 'type-error (l :make-string "[" 123 "]"))

    \ \ (check-catch 'type-error (l :make-string "[" "," 123))

    )

    \;

    (check ($ (list "a" "b") :make-string) =\<gtr\> "ab")

    (check ($ (list "a" "b") :make-string " ") =\<gtr\> "a b")

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </scm-chunk>

  \;

  <chapter|rich-vector>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-vector ((data vector?))

    \;
  </goldfish-chunk>

  <section|静态方法>

  <paragraph|rich-vector@is-type-of>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true (rich-vector :is-type-of (rich-vector :empty)))

    (check-true (rich-vector :is-type-of (rich-vector #(1 2 3))))

    \;

    (check-false (rich-vector :is-type-of #(1 2 3)))

    (check-false (rich-vector :is-type-of 1))

    \;

    \;
  </goldfish-chunk>

  <paragraph|rich-vector@range>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@range start end . step)

    \ \ (let ((step-size (if (null? step) 1 (car step))))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((and (positive? step-size) (\<gtr\>= start end))

    \ \ \ \ \ \ \ (rich-vector #()))

    \ \ \ \ \ \ ((and (negative? step-size) (\<less\>= start end))

    \ \ \ \ \ \ \ (rich-vector #()))

    \ \ \ \ \ \ ((zero? step-size)

    \ \ \ \ \ \ \ (value-error "Step size cannot be zero"))

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ (let1 cnt (ceiling (/ (- end start) step-size))

    \ \ \ \ \ \ \ \ \ (rich-vector <code|<code*|(list-\>vector>> (iota cnt start step-size))))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (array :range 1 5) =\<gtr\> ($ (vector 1 2 3 4)))

    (check (array :range 1 5 2) =\<gtr\> ($ (vector 1 3)))

    (check (array :range 1 6 2) =\<gtr\> ($ (vector 1 3 5)))

    (check (array :range 5 1 -1) =\<gtr\> ($ (vector 5 4 3 2)))

    \;

    (check (array :range 5 1 1) =\<gtr\> ($ (vector )))

    \;

    (check-catch 'value-error (array :range 1 5 0))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector@empty>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@empty . xs)

    \ \ (let1 r (rich-vector #())

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (array :empty :empty?) =\<gtr\> #t)

    (check (array :empty :head-option) =\<gtr\> (none))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector@fill>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@fill n elem . xs)

    \ \ (unless (integer? n)

    \ \ \ \ (type-error "n must be integer" n))

    \ \ (when (\<less\> n 0)

    \ \ \ \ (value-error "n must be non-negative" n))

    \;

    \ \ (let1 r (rich-vector (make-vector n elem))

    \ \ \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true (array :fill 0 #\\a :empty?))

    \;

    (check (array :fill 3 #\\a) =\<gtr\> ($ (vector #\\a #\\a #\\a)))

    \;
  </goldfish-chunk>

  <section|选择器>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%collect) data)

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%length>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%length)

    \ \ (vector-length data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #() :length) =\<gtr\> 0)

    (check ($ #(1 2 3) :length) =\<gtr\> 3)

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%size>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%size)

    \ \ (vector-length data))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #() :size) =\<gtr\> 0)

    (check ($ #(1 2 3) :size) =\<gtr\> 3)

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%apply>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%apply n)

    \ \ (vector-ref data n))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #(1 2 3) :apply 1) =\<gtr\> 2)

    (check ($ #(1 2 3) 1) =\<gtr\> 2)

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%find>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%find p)

    \ \ (let loop ((i 0))

    \ \ \ \ (cond

    \ \ \ \ \ ((\<gtr\>= i (vector-length data)) (none))

    \ \ \ \ \ ((p (vector-ref data i)) (option (vector-ref data i)))

    \ \ \ \ \ (else (loop (+ i 1))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check ((vec :find (lambda (x) (= x 3))) :get) =\<gtr\> 3)

    \ \ (check ((vec :find (lambda (x) (\<gtr\> x 2))) :get) =\<gtr\> 3)

    \ \ (check ((vec :find (lambda (x) (\<gtr\> x 10))) :empty?) =\<gtr\> #t)

    \ \ (check ((vec :find even?) :get) =\<gtr\> 2)

    \ \ (check ((vec :find (lambda (x) (\<less\> x 0))) :empty?) =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|rich-vector%head>

  <paragraph|rich-vector%head-option>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%head)

    \ \ (if (\<gtr\> (vector-length data) 0)

    \ \ \ \ \ \ (vector-ref data 0)

    \ \ \ \ \ \ (error 'out-of-range "out-of-range")))

    \;

    (define (%head-option)

    \ \ (if (\<gtr\> (vector-length data) 0)

    \ \ \ \ \ \ (option (vector-ref data 0))

    \ \ \ \ \ \ (none)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ (vector 1 2 3) :head) =\> 1)

    (check-catch 'out-of-range (array :empty :head))

    (check ($ (vector 1 2 3) :head-option) =\> (option 1))

    (check (array :empty :head-option) =\> (none))

    \;
  </scm-chunk>

  <paragraph|rich-vector%last>

  <paragraph|rich-vector%last-option>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%last)

    \ \ (let ((len (vector-length data)))

    \ \ \ \ (if (\<gtr\> len 0)

    \ \ \ \ \ \ (vector-ref data (- len 1))

    \ \ \ \ \ \ (error 'out-of-range "out-of-range"))))

    \;

    (define (%last-option)

    \ \ (let ((len (vector-length data)))

    \ \ \ \ (if (\<gtr\> len 0)

    \ \ \ \ \ \ (option (vector-ref data (- len 1)))

    \ \ \ \ \ \ (none))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ (vector 1 2 3) :last) =\> 3)

    (check-catch 'out-of-range (array :empty :last))

    (check ($ (vector 1 2 3) :last-option) =\> (option 3))

    (check (array :empty :last-option) =\> (none))

    \;
  </scm-chunk>

  <paragraph|rich-vector%slice>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%slice from until . xs)

    \ \ (let* ((len (vector-length data))

    \ \ \ \ \ \ \ \ \ (start (max 0 from))

    \ \ \ \ \ \ \ \ \ (end (min len until)))

    \ \ \ \ (let ((res (if (\<less\> start end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rich-vector (vector-copy data start end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rich-vector :empty))))

    \ \ \ \ \ \ (if (null? xs) res (apply res xs)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 vec (array #(1 2 3 4 5))

    \ \ (check (vec :slice 0 2) =\<gtr\> ($ #(1 2)))

    \ \ (check (vec :slice -1 2) =\<gtr\> ($ #(1 2)))

    \ \ (check (vec :slice 2 -1) =\<gtr\> ($ #()))

    \ \ (check (vec :slice 2 2) =\<gtr\> ($ #()))

    \ \ (check (vec :slice 6 2) =\<gtr\> ($ #()))

    \ \ (check (vec :slice -1 10) =\<gtr\> ($ #(1 2 3 4 5)))

    \ \ (check (vec :slice 4 10) =\<gtr\> ($ #(5)))

    \ \ (check (vec :slice 2 4) =\<gtr\> ($ #(3 4))))

    \;
  </scm-chunk>

  <section|谓词>

  <paragraph|rich-vector%empty?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%empty?)

    \ \ (= (length data) 0))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ($ (vector) :empty?))

    (check-false ($ #(1 2 3) :empty?))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%equals>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%equals that)

    \ \ (and (that :is-instance-of 'rich-vector)

    \ \ \ \ \ \ \ (vector= == data (that 'data))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-true ($ #(1 2 3) :equals ($ #(1 2 3))))

    \;

    (check ($ (vector (rich-char "中") (rich-char "文"))) =\<gtr\> ($ "中文" :to-vector))

    \;

    (check-false (($ "中文" :to-vector) :equals (rich-char "中")))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%forall>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%forall p)

    \ \ (vector-every p data))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :forall (lambda (x) (\<gtr\> x 0))) =\<gtr\> #t)

    \ \ (check (vec :forall (lambda (x) (\<gtr\> x 3))) =\<gtr\> #f))

    \;

    (let ((empty-vec (array #())))

    \ \ (check (empty-vec :forall (lambda (x) (\<gtr\> x 0))) =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|rich-vector%exists>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%exists p)

    \ \ (vector-any p data))

    \;
  </goldfish-chunk>

  <section|高阶函数>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%map x . xs)

    \ \ \ \ (let1 r (rich-vector (vector-map x data))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \ \ 

    \ \ (define (%filter x . xs)

    \ \ \ \ (let1 r (rich-vector (vector-filter x data))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;

    \ \ (define (%for-each x)

    \ \ \ \ (vector-for-each x data))

    \;

    \ \ (define (%count . xs)

    \ \ \ \ (cond ((null? xs) (vector-length data))

    \ \ \ \ \ \ \ \ \ \ ((length=? 1 xs) (vector-count (car xs) data))

    \ \ \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args "rich-vector%count" xs))))

    \;
  </scm-chunk>

  <paragraph|rich-vector%take>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%take x . xs)

    \ \ \ \ (typed-define (scala-take (data vector?) (n integer?))

    \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ ((\<less\> n 0) (vector))

    \ \ \ \ \ \ \ \ ((\<gtr\>= n (vector-length data)) data)

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ (let ((new-vec (make-vector n)))

    \ \ \ \ \ \ \ \ \ \ \ \ (do ((i 0 (+ i 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= i n) new-vec)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-vec i (vector-ref data i)))))))

    \;

    \ \ \ \ (let1 r (rich-vector (scala-take data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </scm-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :take -1 :collect) =\<gtr\> #())

    \ \ (check (vec :take 0 :collect) =\<gtr\> #())

    \ \ (check (vec :take 3 :collect) =\<gtr\> #(1 2 3))

    \ \ (check (vec :take 5 :collect) =\<gtr\> #(1 2 3 4 5))

    \ \ (check (vec :take 10 :collect) =\<gtr\> #(1 2 3 4 5))

    )

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%take-right>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%take-right x . xs)

    \ \ \ \ (typed-define (scala-take-right (data vector?) (n integer?))

    \ \ \ \ \ \ (let ((len (vector-length data)))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((\<less\> n 0) (vector))

    \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n len) data)

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

    \ \ \ \ \ \ \ \ \ \ \ \ (let ((new-vec (make-vector n)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (do ((i (- len n) (+ i 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (j 0 (+ j 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= j n) new-vec)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-vec j (vector-ref data i))))))))

    \;

    \ \ \ \ (let1 r (rich-vector (scala-take-right data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :take-right -1 :collect) =\<gtr\> #())

    \ \ (check (vec :take-right 0 :collect) =\<gtr\> #())

    \ \ (check (vec :take-right 3 :collect) =\<gtr\> #(3 4 5))

    \ \ (check (vec :take-right 5 :collect) =\<gtr\> #(1 2 3 4 5))

    \ \ (check (vec :take-right 10 :collect) =\<gtr\> #(1 2 3 4 5))

    )

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-vector%drop>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%drop x . xs)

    \ \ \ \ (typed-define (scala-drop (data vector?) (n integer?))

    \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ ((\<less\> n 0) data)

    \ \ \ \ \ \ \ \ ((\<gtr\>= n (vector-length data)) (vector))

    \ \ \ \ \ \ \ \ (else (vector-copy data n))))

    \ \ \ \ \ \ \ \ 

    \ \ \ \ (let1 r (rich-vector (scala-drop data x))

    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :drop -1 :collect) =\<gtr\> #(1 2 3 4 5))

    \ \ (check (vec :drop 0 :collect) =\<gtr\> #(1 2 3 4 5))

    \ \ (check (vec :drop 3 :collect) =\<gtr\> #(4 5))

    \ \ (check (vec :drop 5 :collect) =\<gtr\> #())

    \ \ (check (vec :drop 10 :collect) =\<gtr\> #())

    )

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-vector%drop-right>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%drop-right x . xs)

    \ \ (typed-define (scala-drop-right (data vector?) (n integer?))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((\<less\> n 0) data)\ 

    \ \ \ \ \ \ ((\<gtr\>= n (vector-length data)) (vector))\ 

    \ \ \ \ \ \ (else (vector-copy data 0 (- (vector-length data) n)))))\ 

    \;

    \ \ (let1 r (rich-vector (scala-drop-right data x)) \ 

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :drop-right -1 :collect) =\<gtr\> #(1 2 3 4 5))\ 

    \ \ (check (vec :drop-right 0 :collect) =\<gtr\> #(1 2 3 4 5))\ 

    \ \ (check (vec :drop-right 3 :collect) =\<gtr\> #(1 2))\ 

    \ \ (check (vec :drop-right 5 :collect) =\<gtr\> #())\ 

    \ \ (check (vec :drop-right 10 :collect) =\<gtr\> #())\ 

    )

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-vector%fold>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%fold initial f)

    \ \ \ \ (vector-fold f initial data))

    \;

    \ \ (define (%fold-right initial f)

    \ \ \ \ (vector-fold-right f initial data))

    \;
  </scm-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (array #(1 2 3 4 5))))

    \ \ (check (vec :fold 0 +) =\<gtr\> 15)

    \ \ (check (vec :fold '() (lambda (x acc) (cons x acc))) =\<gtr\> '(5 4 3 2 1))

    \;

    \ \ (check (vec :fold-right 0 +) =\<gtr\> 15)

    \ \ (check (vec :fold-right '() (lambda (x acc) (cons x acc))) =\<gtr\> '(1 2 3 4 5))

    )

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%count>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    \ \ (define (%count . xs)

    \ \ \ \ (cond ((null? xs) (vector-length data))

    \ \ \ \ \ \ \ \ \ \ ((length=? 1 xs) (count (car xs) (vector-\<gtr\>list data)))

    \ \ \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args "rich-vector%count" xs))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ($ #() :count) =\<gtr\> 0)

    (check ($ #() :count (@ \<gtr\> _ 2)) =\<gtr\> 0)

    (check ($ #(1 2 3 4 5) :count) =\<gtr\> 5)

    (check ($ #(1 2 3 4 5) :count (@ \<gtr\> _ 2)) =\<gtr\> 3)

    \;
  </scm-chunk>

  <paragraph|rich-vector%sort-with>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%sort-with less-p . xs)

    \ \ (let ((res (rich-vector (vector-stable-sort less-p data))))

    \ \ \ \ (if (null? xs)

    \ \ \ \ \ \ res

    \ \ \ \ \ \ (apply res xs))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((vec (rich-vector #(3 1 4 2 5))))

    \ \ (check (vec :sort-with \<less\>) =\<gtr\> (array #(1 2 3 4 5)))

    \ \ (check (vec :sort-with \<gtr\>) =\<gtr\> (array #(5 4 3 2 1)))

    \ \ (check (vec :sort-with \<less\> :collect) =\<gtr\> #(1 2 3 4 5)))

    \;

    (let ((vec (rich-vector #((2 . 1) (3 . 3) (1 . 3) (1 . 2) (3 . 2)))))

    \ \ (check (vec :sort-with (lambda (x y) (\<less\> (car x) (car y))))

    \ \ \ \ \ \ \ \ \ =\<gtr\> (rich-vector #((1 . 3) (1 . 2) (2 . 1) (3 . 3) (3 . 2))))

    \ \ (check (vec :sort-with (lambda (x y) (\<less\> (cdr x) (cdr y))))

    \ \ \ \ \ \ \ \ \ =\<gtr\> (rich-vector #((2 . 1) (1 . 2) (3 . 2) (3 . 3) (1 . 3)))))

    \;
  </scm-chunk>

  \;

  <paragraph|rich-vector%group-by>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%group-by func)

    \ \ (let ((group (make-hash-table)))

    \ \ \ \ (for-each

    \ \ \ \ \ \ (lambda (elem)\ 

    \ \ \ \ \ \ \ \ (let ((key (func elem)))

    \ \ \ \ \ \ \ \ \ \ (hash-table-update!/default

    \ \ \ \ \ \ \ \ \ \ \ \ group

    \ \ \ \ \ \ \ \ \ \ \ \ key

    \ \ \ \ \ \ \ \ \ \ \ \ (lambda (current-list) (cons elem current-list))

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

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

    \ \ \ \ (hash-table-for-each\ 

    \ \ \ \ \ \ (lambda (k v) (hash-table-set! group k (reverse-list-\>vector v)))\ 

    \ \ \ \ \ \ group)

    \ \ \ \ (rich-hash-table group)))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ (($ #(1 2 3 4 5 6) :group-by (@ modulo _ 2)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 #(2 4 6) 1 #(1 3 5)))

    \;

    (check \ (($ #(1 2 3 4 5 6) :group-by (@ modulo _ 3)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 #(3 6) 1 #(1 4) 2 #(2 5)))

    \;

    (check \ (($ #(1 2 3 4 5 6 7) :group-by (@ modulo _ 3)) :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> \ (hash-table 0 #(3 6) 1 #(1 4 7) 2 #(2 5)))

    \;

    (let ((result ($ #("apple" "banana" "cat" "dog") :group-by (@ string-length _))))

    \ \ (check (result :collect)\ 

    \ \ \ \ \ \ \ \ \ \ =\<gtr\> (hash-table 3 #("cat" "dog") 5 #("apple") 6 #("banana"))))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-vector%zip-with-index>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%zip-with-index)

    \ \ (let* ((n (vector-length data))

    \ \ \ \ \ \ \ \ \ (result (make-vector n)))

    \ \ \ \ (let loop ((idx 0))

    \ \ \ \ \ \ (if (\<gtr\>= idx n)

    \ \ \ \ \ \ \ \ \ \ (rich-vector result)

    \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ (vector-set!\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ result\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ idx\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons idx (vector-ref data idx)))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ idx 1)))))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ ($ #(a b c) :zip-with-index :collect) \ 

    \ \ \ \ \ \ \ \ =\<gtr\> #((0 . a) (1 . b) (2 . c)))

    \;

    (check \ ($ #() :zip-with-index :collect)\ 

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

    \;

    (check \ ($ #(1 1 2 2 2 3 4 5 6 7) :zip-with-index :collect)

    \ \ \ \ \ \ \ \ =\<gtr\> #((0 . 1) (1 . 1) (2 . 2) (3 . 2) (4 . 2) (5 . 3) (6 . 4) (7 . 5) (8 . 6) (9 . 7)))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-vector%distinct>

  \;

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%distinct)

    \ \ (let ((ht (make-hash-table))

    \ \ \ \ \ \ \ \ (length (vector-length data)))

    \ \ \ \ (let loop ((result '())

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (index 0))

    \ \ \ \ \ \ (if (\<gtr\>= index length)

    \ \ \ \ \ \ \ \ \ \ (rich-vector (list-\<gtr\>vector (reverse result)))

    \ \ \ \ \ \ \ \ \ \ (let ((elem (vector-ref data index)))

    \ \ \ \ \ \ \ \ \ \ \ \ (if (eq? (hash-table-ref ht elem) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table-set! ht elem #t)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cons elem result) (+ index 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop result (+ index 1))))))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check \ ($ #(a a b c b) :distinct :collect)\ 

    \ \ \ \ \ \ \ \ =\<gtr\> #(a b c))

    \;

    (check \ ($ #(1 1 1 2 2 3 3 3 3 5 5 5) :distinct :collect)\ 

    \ \ \ \ \ \ \ \ =\<gtr\> #(1 2 3 5))

    \;

    (check \ ($ #() :distinct :collect)\ 

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

    \;
  </goldfish-chunk>

  <section|转换器>

  <paragraph|rich-vector%to-string>

  将Rich Vector转换为基础类型的字符串。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%to-string)

    \ \ ((%map object-\<gtr\>string)

    \ \ \ :make-string "#(" " " ")"))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (object-\<gtr\>string ($ #(1 2 3))) =\<gtr\> "#(1 2 3)")

    \;

    (let ((vec ($ #("Hello" "World"))))

    \ \ (check (vec :to-string) =\<gtr\> "#(\\"Hello\\" \\"World\\")"))

    \;

    (let ((vec ($ #())))

    \ \ (check (vec :to-string) =\<gtr\> "#()"))

    \;

    (let ((vec ($ "test123 你好" :to-vector)))

    \ \ (check (vec :to-string) =\<gtr\> "#(#\\\\t #\\\\e #\\\\s #\\\\t #\\\\1 #\\\\2 #\\\\3 #\\\\space #\\\\你 #\\\\好)"))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector%make-string>

  <\scm-chunk|goldfish/liii/lang.scm|true|true>
    (define (%make-string . xs)

    \ \ (define (parse-args xs)

    \ \ \ \ (cond

    \ \ \ \ \ \ ((null? xs) (values "" "" ""))

    \ \ \ \ \ \ ((length=? 1 xs)

    \ \ \ \ \ \ \ (let1 sep (car xs)

    \ \ \ \ \ \ \ \ \ (if (string? sep)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (values "" sep "")

    \ \ \ \ \ \ \ \ \ \ \ \ \ (type-error "rich-vector%make-string: separator must be a string" sep))))

    \ \ \ \ \ \ ((length=? 2 xs)

    \ \ \ \ \ \ \ (error 'wrong-number-of-args "rich-vector%make-string: expected 0, 1, or 3 arguments, but got 2" xs))

    \ \ \ \ \ \ ((length=? 3 xs)

    \ \ \ \ \ \ \ (let ((start (car xs))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (sep (cadr xs))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (end (caddr xs)))

    \ \ \ \ \ \ \ \ \ (if (and (string? start) (string? sep) (string? end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (values start sep end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (type-error "rich-vector%make-string: prefix, separator, and suffix must be strings" xs))))

    \ \ \ \ \ \ (else (error 'wrong-number-of-args "rich-vector%make-string: expected 0, 1, or 3 arguments" xs))))

    \;

    \ \ (receive (start sep end) (parse-args xs)

    \ \ \ \ (let* ((as-string (lambda (x) (if (string? x) x (object-\<gtr\>string x))))

    \ \ \ \ \ \ \ \ \ \ \ (middle (string-join (map as-string (vector-\<gtr\>list data)) sep)))

    \ \ \ \ \ \ (rich-string (string-append start middle end)))))

    \;
  </scm-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 v ($ #(1 2 3))

    \ \ (check (v :count) =\<gtr\> 3)

    \ \ (check (v :count (cut \<gtr\> \<less\>\<gtr\> 1)) =\<gtr\> 2)

    \ \ (check (v :make-string) =\<gtr\> "123")

    \ \ (check (v :make-string " ") =\<gtr\> "1 2 3")

    \ \ (check (v :make-string "[" "," "]") =\<gtr\> "[1,2,3]")

    \ \ 

    \ \ (check-catch 'wrong-number-of-args (v :make-string "[" ","))

    \ \ (check-catch 'type-error (v :make-string 123 "," "]"))

    \ \ (check-catch 'type-error (v :make-string "[" 123 "]"))

    \ \ (check-catch 'type-error (v :make-string "[" "," 123))

    )

    \;

    (check ($ #("a" "b" "c") :make-string) =\<gtr\> "abc")

    \;
  </goldfish-chunk>

  <section|修改器>

  <paragraph|rich-vector%set!>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%set! i x)

    \ \ (when (or (\<less\> i 0) (\<gtr\>= i (length data)))

    \ \ \ \ (error 'out-of-range "rich-vector%set! out of range at index" i))

    \ \ (vector-set! data i x))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 v ($ #(1 2 3))

    \ \ (v :set! 0 2)

    \ \ (check (v 0) =\<gtr\> 2)

    \ \ (check-catch 'out-of-range (v -1))

    \ \ (check-catch 'out-of-range (v 3)))

    \;

    (check-catch 'out-of-range (array :empty :set! 0 1))

    \;
  </goldfish-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  <section|array>

  在Scala语言中，和Rich Vector等价的数据结构是Array，我们这里为rich-vector设置一个名为array的别名。

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define array rich-vector)

    \;
  </goldfish-chunk>

  <chapter|rich-hash-table>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define-case-class rich-hash-table ((data hash-table?))

    \ \ (define (%collect) data)

    \;
  </goldfish-chunk>

  \;

  <section|静态方法>

  <paragraph|rich-hash-table@empty>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (@empty . xs)

    \ \ (let1 r (rich-hash-table (make-hash-table))

    \ \ \ \ (if (null? xs) r (apply r xs))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-hash-table :empty) =\<gtr\> ($ (hash-table)))

    (check (rich-hash-table :empty :collect) =\<gtr\> (hash-table))

    \;
  </goldfish-chunk>

  \;

  <section|选择器>

  <paragraph|rich-hash-table%find>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%find pred?)

    \ \ (define iter (make-iterator data))

    \ \ (let loop ((kv (iter)))

    \ \ \ \ (cond\ 

    \ \ \ \ \ \ \ \ ((eof-object? kv) (none))

    \ \ \ \ \ \ \ \ ((and (pair? kv) (pred? (car kv) (cdr kv))) (option kv))

    \ \ \ \ \ \ \ \ (else (loop (iter))))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 ht ($ (hash-table 'a 1 'b 2 'c 3))

    \ \ (check (ht :find (lambda (k v) (and (symbol? k) (even? v)))) =\<gtr\> (option (cons 'b 2)))

    \ \ (check ((ht :find (lambda (k v) (\<gtr\> v 4))) :empty?) =\<gtr\> #t))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-hash-table%get><typehint|((k any?)) =\<gtr\> option?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%get k)

    \ \ (option (hash-table-ref/default data k '())))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 ht ($ (hash-table 'a 1 'b 2 'c 3))

    \ \ (check ((ht :get 'a) :get) =\<gtr\> 1)

    \ \ (check ((ht :get 'd) :empty?) =\<gtr\> #t))

    \;
  </goldfish-chunk>

  \;

  <section|谓词>

  <paragraph|rich-hash-table%contains><typehint|((k any?)) =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%contains k)

    \ \ (hash-table-contains? data k))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 ht ($ (hash-table 'a 1 'b 2 'c 3))

    \ \ (check-true (ht :contains 'a))

    \ \ (check-false (ht :contains 'd)))

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-hash-table%forall>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%forall pred?)

    \ \ (let ((all-kv (map identity data)))

    \ \ \ \ (let loop ((kvs all-kv)) \ 

    \ \ \ \ \ \ (if (null? kvs)

    \ \ \ \ \ \ \ \ \ \ #t \ 

    \ \ \ \ \ \ \ \ \ \ (let1 kv (car kvs)

    \ \ \ \ \ \ \ \ \ \ \ \ (if (pred? (car kv) (cdr kv))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr kvs)) \ 

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

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 ht ($ (hash-table 'a 5 'b 8 'c 10 'd 12))

    \ \ \ \ (check (ht :forall (lambda (k v) (\<gtr\> v 4))) \ \ \ \ \ \ \ \ =\<gtr\> #t) \ 

    \ \ \ \ (check (ht :forall (lambda (k v) (\<less\> v 13))) \ \ \ \ \ \ \ =\<gtr\> #t) \ 

    \ \ \ \ (check (ht :forall (lambda (k v) (even? v))) \ \ \ \ \ \ =\<gtr\> #f) \ 

    \ \ 

    \ \ \ \ (check (ht :forall (lambda (k v) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (symbol? k) (\<gtr\> v 4)))) \ \ \ \ \ \ \ =\<gtr\> #t) \ 

    \;

    \ \ \ \ (check (ht :forall (lambda (k v) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol? k))) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ =\<gtr\> #t) \ 

    \ \ 

    \ \ \ \ (check (ht :forall (lambda (k v) (eq? k v))) \ \ \ \ \ \ =\<gtr\> #f) \ 

    )

    \;

    (let1 ht-empty ($ (hash-table))

    \ \ \ \ (check (ht-empty :forall (lambda (k v) (string? v))) =\<gtr\> #t)

    )

    \;

    (let1 ht-mixed ($ (hash-table 'id 10 'score 85 3.14 "pi"))

    \ \ \ \ (check (ht-mixed :forall (lambda (k v) (number? v))) =\> #f)\ 

    \ \ \ \ (check (ht-mixed :forall (lambda (k v) (and (integer? v) (even? v)))) =\> #f)\ 

    )

    \;

    (let1 ht-fail ($ (hash-table 'valid 42 'invalid "string"))

    \ \ \ \ (check (ht-fail :forall (lambda (k v) (number? v))) \ \ \ =\<gtr\> #f)\ 

    \;

    \ \ \ \ (check (ht-fail :forall (lambda (k v)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (symbol? k) (number? v) (positive? v)))) =\<gtr\> #f)

    )

    \;

    ;; nested hash table test

    (let1 ht-nested ($ (hash-table\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 'a ($ (hash-table 'x 10))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 'b ($ (hash-table 'y 20))))

    \ \ (check (ht-nested :forall\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (k sub-ht)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (sub-ht :forall (lambda (k v) (\<gtr\> v 9))))) =\<gtr\> #t)

    )

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-hash-table%exists>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%exists pred?)

    \ \ (define iter (make-iterator data))

    \ \ (let loop ((kv (iter)))

    \ \ \ \ (cond\ 

    \ \ \ \ \ \ \ \ ((eof-object? kv) #f)

    \ \ \ \ \ \ \ \ ((and (pair? kv) (pred? (car kv) (cdr kv))) #t)

    \ \ \ \ \ \ \ \ (else (loop (iter))))))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let ((ht ($ (hash-table 'a 1 'b "2" 'c 3))))

    \ \ (check (ht :exists (lambda (k v) (string? v))) =\<gtr\> #t))

    \;

    (let ((ht ($ (hash-table "a" 1 'b 2 3 'c))))

    \ \ (check (ht :exists (lambda (k v) (number? k))) =\<gtr\> #t))

    \;

    (let ((ht ($ (hash-table))))

    \ \ (check (ht :exists (lambda (k v) #t)) =\<gtr\> #f))

    \;
  </goldfish-chunk>

  <section|高阶函数>

  <paragraph|rich-hash-table%map>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (chained-define (%map f)

    \ \ (let1 r (make-hash-table)

    \ \ \ \ (hash-table-for-each

    \ \ \ \ \ \ \ (lambda (k v)

    \ \ \ \ \ \ \ \ \ (receive (k1 v1) (f k v)

    \ \ \ \ \ \ \ \ \ \ \ (hash-table-set! r k1 v1)))

    \ \ \ \ \ \ \ data)

    \ \ \ \ (rich-hash-table r)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 ht ($ (hash-table 'a 1 'b 2 'c 3))

    \ \ (let1 r (ht :map (lambda (k v) (values k (+ v 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ :collect)

    \ \ \ \ (check (r 'a) =\<gtr\> 2)

    \ \ \ \ (check (r 'b) =\<gtr\> 3)

    \ \ \ \ (check (r 'c) =\<gtr\> 4)))

    \ \ \ \ \ \ 
  </goldfish-chunk>

  \;

  \;

  <paragraph|rich-hash-table%count>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%count pred)

    \ \ (hash-table-count pred data))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (define ht\ 

    \ \ ($ (hash-table 'a 2 'b 5 'c 8 'd 10 'e 1 'f "test" 'g -2)))

    \;

    (check (ht :count (lambda(k v) (and (number? v) (even? v)))) =\<gtr\> 4)

    (check (ht :count (lambda(k v) (and (number? v) (odd? v)))) =\<gtr\> 2)

    \;
  </goldfish-chunk>

  \;

  <paragraph|rich-hash-table%foreach>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%foreach proc)

    \ \ (hash-table-for-each proc data))

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let \ ((ht ($ (hash-table 'x 10 'y 20 'z 30 'new 40))) \ \ \ \ 

    \ \ \ \ \ \ (sum 0)) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ (ht :foreach (lambda (k v)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! sum (+ sum v)))) \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ (check sum =\<gtr\> 100) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    )

    \;

    ;; Empty hash table

    (let ((ht ($ (make-hash-table))) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ (call-counter 0)) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ 

    \ \ (ht :foreach (lambda (k v)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! call-counter (+ call-counter 1))))

    \ \ 

    \ \ (check call-counter =\<gtr\> 0) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    )

    \;

    ;; Nested hash tables

    (let* ((inner ($ (hash-table 'x 100 'y 200))) \ \ \ \ \ 

    \ \ \ \ \ \ \ (outer ($ (hash-table 'a inner 'b 42))) \ \ \ \ 

    \ \ \ \ \ \ \ (total 0)) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ 

    \ \ (outer :foreach\ 

    \ \ \ \ (lambda (k v)

    \ \ \ \ \ \ (if (case-class? v)

    \ \ \ \ \ \ \ \ (v \ :foreach

    \ \ \ \ \ \ \ \ \ \ \ \ (lambda (k v)

    \ \ \ \ \ \ \ \ \ \ \ \ (set! total (+ total v))))

    \ \ \ \ \ \ \ \ (set! total (+ total v)))))

    \ \ 

    \ \ (check total =\<gtr\> 342) \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

    )

    \;
  </goldfish-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    )

    \;
  </goldfish-chunk>

  <chapter|(liii lang)模块的结尾>

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

    ) ; end of library

    \;
  </scm-chunk>

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

    \;
  </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>