GoldfishLang.tmu

<TMU|<tuple|1.1.0|2025.0.3>>

<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 list) (liii hash-table) (liii bitwise))

    (export

    \ \ @ cut_

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

    \ \ option none

    \ \ rich-integer rich-char rich-string

    \ \ rich-list range

    \ \ rich-vector 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|部分应用>

  宏@提供类似Scala语法的部分应用（Partial Application）功能，详情参考SFRI 26中宏cute的说明，宏@与宏cute的区别在于@不支持类似\<less\><text-dots>\<gtr\>的未定参数，且用_表示占位符。

  宏@的特点，简短的来说，@只在宏展开时求值并绑定占位符，而不是每次被调用时重新求值：

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

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

      \ \ (set! a 100)

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

  \;

  <\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>

  \;

  测试：基本部分应用

  <\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>

  \;

  测试：嵌套@宏

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

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

    \;
  </goldfish-chunk>

  <section|样本类>

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

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

  样本类对象实际上是函数，该函数的第一个参数可以是字段或者是方法，字段统一使用<scm|'field>表示，方法统一使用<scm|:method>表示，方法的实现统一采用<scm|%>作为前缀。比如<scm|(person :to-string)>实际上调用的是person对象的内部方法<scm|%to-string>。

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

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

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

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

  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)>。

  样本类的默认构造函数有类型校验，不做任何值校验的。如果需要做值校验，那么需要使用同名的函数覆盖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)))

    \;

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

    \;

    ,@static-methods

    \ \ \ 

    (define (static-dispatcher msg . args)

    \ \ \ \ (cond

    \ \ \ \ \ ,@(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 (create-instance ,@fields)

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

    \ \ \ \ (when (null? args)

    \ \ \ \ \ \ \ \ \ \ (??? ,class-name "apply on zero args is not implemented"))

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

    \ \ \ \ \ \ \ \ \ \ \ (??? ,class-name "No such method: " (car args) "Please implement the method"))

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

    \ \ \ \ \ \ \ \ \ \ \ (??? ,class-name "No such field: " (car args)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "Please use the correct field name\\n"

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "Or you may implement %apply to process " 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))))))))

    \;

    \ \ ,@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))

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

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

    \ \ \ \ \ \ \ \ ,@(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)

    \;

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

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

    \;

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

    \;

    \ \ (instance-dispatcher)

    ) ; end of the internal typed define

    \;

    (if (in? msg (list ,@static-messages))

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

    \ \ \ \ (apply create-instance (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 '??? (bob 'sex))

    \ \ (check-catch '??? (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 (???))))))

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

    \ \ (check-catch '??? (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 '??? (hello :this-is-a-static-method))

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

    \;
  </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.3 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 (box right)))

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

    \ \ \ \ \ ((box 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|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>

  <section|公共子函数>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define (%apply-one x xs r)

    \ \ (let1 result r

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

    \;
  </goldfish-chunk>

  <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 (box 1)) =\<gtr\> (box 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>
    (define (%map f . xs)

    \ \ (%apply-one f xs

    \ \ \ \ (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>

  <section|rich-integer>

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

    \;
  </goldfish-chunk>

  <subsection|选择器>

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

    \;
  </goldfish-chunk>

  <subsection|谓词>

  <paragraph|rich-integer%equals>

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

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

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

    \;
  </goldfish-chunk>

  <subsection|转换器>

  <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 (((box 1) :to 2) :collect) =\<gtr\> (list 1 2))

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

    (check (((box 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 (((box 1) :until 3) :collect) =\<gtr\> (list 1 2))

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

    (check (((box 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 ((box #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 ((box 1) :to-string) =\<gtr\> "1")

    \;
  </goldfish-chunk>

  <subsection|静态方法>

  <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>

  <subsection|结尾>

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

    \;
  </goldfish-chunk>

  <section|rich-char>

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

    \;
  </goldfish-chunk>

  <subsection|谓词>

  <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%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>

  <subsection|转换>

  <paragraph|rich-char%to-upper>

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

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

    \ \ (if (and (\<gtr\>= code-point 97) (\<less\>= code-point 122))

    \ \ \ \ \ \ (rich-char (- code-point 32))

    \ \ \ \ \ \ (rich-char code-point)))

    \;
  </goldfish-chunk>

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

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

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

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

    \;
  </goldfish-chunk>

  <paragraph|rich-char%to-lower>

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

    \ \ (if (and (\<gtr\>= code-point 65) (\<less\>= code-point 90))

    \ \ \ \ \ \ (rich-char (+ code-point 32))

    \ \ \ \ \ \ (rich-char code-point)))

    \;
  </goldfish-chunk>

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

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

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

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

    \;
  </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>

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

    \ \ (utf8-\<gtr\>string (%to-bytevector)))

    \;
  </goldfish-chunk>

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

    (check-true ((box #\\A) :equals (rich-char #x41)))

    \;

    (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>

  <subsection|结尾>

  \;

  <\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>

  <section|rich-string>

  Unicode编码的字符串。

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

    \;
  </scm-chunk>

  <subsection|选择器>

  <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 ((box "abc") :get) =\<gtr\> "abc")

    (check ((box "") :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 (box "你好，世界") \ 

    \ \ (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 (box "Hello，世界")

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

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

    \;
  </goldfish-chunk>

  <subsection|谓词>

  <paragraph|rich-string%equals>

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

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

    (check-false ((box "41") :equals (box "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 ((box "全部都是中文") :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 ((box "全部都是中文") :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>

  <subsection|高阶函数>

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

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

    \ \ (%apply-one x xs

    \ \ \ \ (rich-string

    \ \ \ \ \ ((%to-vector)

    \ \ \ \ \ \ :map x

    \ \ \ \ \ \ :map (lambda (c) (c :to-string))

    \ \ \ \ \ \ :make-string))))

    \;
  </goldfish-chunk>

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

    (check ((box "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 ((box "") :count (@ == _ #\\A)) =\<gtr\> 0)

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

    (check ((box "你好，我是韩梅梅")

    \ \ \ \ \ \ \ \ :count (@ == _ (rich-char "梅"))) =\<gtr\> 2)

    \;
  </goldfish-chunk>

  <subsection|转换器>

  <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 ((box "中文") :to-vector)

    \ \ (check (v 0) =\<gtr\> (rich-char "中"))

    \ \ (check (v 1) =\<gtr\> (rich-char "文")))

    \;
  </goldfish-chunk>

  <subsection|修改器>

  <paragraph|rich-string%strip-prefix>

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

    \ \ (let ((result (rich-string (string-remove-prefix data prefix))))

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

    \ \ \ \ \ \ \ \ result

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

    \;
  </goldfish-chunk>

  \;

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((box "") :strip-prefix "") =\<gtr\> (box ""))

    (check ((box "hello") :strip-prefix "") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-prefix "he") =\<gtr\> (box "llo"))

    (check ((box "hello") :strip-prefix "hello") =\<gtr\> (box ""))

    (check ((box "hello") :strip-prefix "abc") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-prefix "helloo") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-prefix "he"

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :strip-prefix "ll") =\<gtr\> (box "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>
    (define (%strip-suffix suffix . xs)

    \ \ (let ((result (rich-string (string-remove-suffix data suffix))))

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

    \ \ \ \ \ \ \ \ result

    \ \ \ \ \ \ \ \ (apply result xs))))\ 
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check ((box "") :strip-suffix "") =\<gtr\> (box ""))

    (check ((box "hello") :strip-suffix "") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-suffix "lo") =\<gtr\> (box "hel"))

    (check ((box "hello") :strip-suffix "hello") =\<gtr\> (box ""))

    (check ((box "hello") :strip-suffix "abc") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-suffix "hhello") =\<gtr\> (box "hello"))

    (check ((box "hello") :strip-suffix "lo"

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ :strip-suffix "el") =\<gtr\> (box "h"))

    \;

    (check-catch 'wrong-number-of-args ("hello":strip-suffix "llo"))

    (check-catch 'unbound-variable (123:strip-suffix 1))
  </goldfish-chunk>

  <subsection|其余函数>

  <paragraph|rich-string%split>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    ;; Split string with sep.

    (define (%split sep)

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

    \ \ \ \ \ \ \ \ (sep-len (string-length sep)))

    \ \ \ \ ; find the index for the pattern in str from index start, else #f

    \ \ \ \ (define (find-string str pattern start)

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

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((\<gtr\> (+ i sep-len) str-len) #f)

    \ \ \ \ \ \ \ \ \ \ ((equal? (substring str i (+ i sep-len)) pattern) i)

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

    \ \ \ \ ; tail recursive auxiliary function

    \ \ \ \ (define (split-helper start acc)

    \ \ \ \ \ \ (let ((next-pos/false (find-string data sep start)))

    \ \ \ \ \ \ \ \ (if (not next-pos/false)

    \ \ \ \ \ \ \ \ \ \ \ \ (cons (substring data start) acc)

    \ \ \ \ \ \ \ \ \ \ \ \ (split-helper (+ next-pos/false sep-len) (cons (substring data start next-pos/false) acc)))))

    \ \ \ \ ; do split

    \ \ \ \ (rich-vector

    \ \ \ \ \ \ (if (zero? sep-len)

    \ \ \ \ \ \ \ \ \ \ ((%to-vector) :map (lambda (c) (c :to-string)) :collect)

    \ \ \ \ \ \ \ \ \ \ (list-\<gtr\>vector (reverse (split-helper 0 '())))))))

    \;
  </goldfish-chunk>

  SRFI 文档（<hlink|SRFI 135: Immutable Texts|https://srfi.schemers.org/srfi-135/srfi-135.html#ReplicationSplitting>，<hlink|SRFI 140: Immutable Strings|https://srfi.schemers.org/srfi-140/srfi-140.html>）指出：<cite*|The returned list will have one more item than the number of non-overlapping occurrences of the delimiter in the string.>

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

    (check ((box "da@liii.pro") :split "@") =\<gtr\> (box (vector "da" "liii.pro")))

    (check ((box "da@liii.pro") :split ".") =\<gtr\> (box (vector "da@liii" "pro")))

    (check (((box "da@liii.pro") :split "@") :collect) =\<gtr\> (vector "da" "liii.pro"))

    (check ((box "test") :split "") =\<gtr\> (box (vector "t" "e" "s" "t")))

    (check ((box "aXXbXXcXX") :split "XX") =\<gtr\> (box (vector "a" "b" "c" "")))

    (check ((box "a\|\|b\|\|c") :split "\|\|") =\<gtr\> (box (vector "a" "b" "c")))

    (check ((box "XXaXXb") :split "XX") =\<gtr\> (box (vector "" "a" "b")))

    (check ((box "你好，欢迎使用Liii STEM") :split "，") =\<gtr\> (box (vector "你好" "欢迎使用Liii STEM")))

    (check ((box "中国智造，惠及全球") :split "") =\<gtr\> #("中" "国" "智" "造" "，" "惠" "及" "全" "球"))

    \;
  </goldfish-chunk>

  <subsection|结尾>

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

    \;
  </scm-chunk>

  <section|rich-list>

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

    \;
  </goldfish-chunk>

  <subsection|静态方法>

  <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\> (box (list 1 2 3 4)))

    (check (rich-list :range 1 5 2) =\<gtr\> (box (list 1 3)))

    (check (rich-list :range 1 6 2) =\<gtr\> (box (list 1 3 5)))

    (check (rich-list :range 5 1 -1) =\<gtr\> (box (list 5 4 3 2)))

    \;

    (check (rich-list :range 5 1 1) =\<gtr\> (box (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)

    \ \ (rich-list(list )))

    \;
  </goldfish-chunk>

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

    (check (rich-list :empty)=\<gtr\> (box (list )))

    \;
  </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 (box (list 1)) (box (list 2))) =\<gtr\> (box (list 1 2)))

    (check (rich-list :concat (box (list 1 2)) (box (list 3 4))) =\<gtr\> (box (list 1 2 3 4)))

    (check (rich-list :concat (rich-list :range 1 4) (box (list 3 4))) =\<gtr\> (box (list 1 2 3 3 4)))

    (check (rich-list :concat (box (list 1)) (box (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>
    ;; test :fill

    (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)

    )

    \;

    ;; test :fill finished
  </goldfish-chunk>

  <subsection|选择器>

  <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 ((box '(1 2 3)) :apply 0) =\<gtr\> 1)

    (check ((box '(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 ((box (list 1 2 3)) :head) =\<gtr\> 1)

    (check-catch 'out-of-range ((rich-list :empty) :head))

    (check ((box (list 1 2 3)) :head-option) =\<gtr\> (option 1))

    (check ((rich-list :empty) :head-option) =\<gtr\> (none))

    \;
  </goldfish-chunk>

  \;

  <subsection|谓词>

  <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 (box (list (box 1) (box 2) (box 3)))

    \ \ =\<gtr\> (((box 1) :to 3) :map box))

    \;
  </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 (box '(1 2 3 4 5))

    \ \ (check (lst :forall (lambda (x) (\<gtr\> x 0))) =\<gtr\> #t)

    \ \ (check (lst :forall (lambda (x) (\<gtr\> x 3))) =\<gtr\> #f)

    )

    \;

    (let1 empty-lst (rich-list '())

    \ \ (check (empty-lst :forall (lambda (x) (\<gtr\> x 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>

  <subsection|高阶函数>

  \;

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

    \ \ \ \ (let1 r (rich-list (map x data))

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

    \ \ 

    \ \ (define (%flat-map x . xs)

    \ \ \ \ (let1 r (rich-list (flat-map x data))

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

    \ \ 

    \ \ (define (%filter x . xs)

    \ \ \ \ (let1 r (rich-list (filter x data))

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

    \;

    \ \ (define (%for-each x)

    \ \ \ \ (for-each x data))

    \;
  </scm-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>

  \;

  <subparagraph|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>

  <subsection|转换器>

  <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 (box '(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)))

    \ \ \ \ \ \ \ \ \ \ (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 ((box (list "a" "b")) :make-string) =\<gtr\> "ab")

    (check ((box (list "a" "b")) :make-string " ") =\<gtr\> "a b")

    \;
  </scm-chunk>

  <subsection|结尾>

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

    \;
  </scm-chunk>

  <section|range>

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

    \ \ ((start integer?) (end integer?) (step integer?) (inclusive? boolean?))

    \;
  </goldfish-chunk>

  <subsection|静态方法>

  <paragraph|@inclusive>

  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
    (define* (@inclusive start end (step 1))

    \ \ (range start end step #t))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 r (range :inclusive 1 2)

    \ \ (check (r 'start) =\<gtr\> 1)

    \ \ (check (r 'end) =\<gtr\> 2)

    \ \ (check (r 'step) =\<gtr\> 1)

    \ \ (check-true (r 'inclusive?)))

    \;

    (let1 r (range :inclusive 1 3 2)

    \ \ (check (r 'start) =\<gtr\> 1)

    \ \ (check (r 'end) =\<gtr\> 3)

    \ \ (check (r 'step) =\<gtr\> 2)

    \ \ (check-true (r 'inclusive?)))

    \;
  </goldfish-chunk>

  <subsection|谓词>

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

    \ \ (or (and (\<gtr\> start end) (\<gtr\> step 0))

    \ \ \ \ \ \ (and (\<less\> start end) (\<less\> step 0))

    \ \ \ \ \ \ (and (= start end) (not inclusive?))))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check-false ((range :inclusive 1 3) :empty?))

    (check-true ((range :inclusive 3 1) :empty?))

    (check-false ((range :inclusive 1 3 0) :empty?))

    \;
  </goldfish-chunk>

  <subsection|结尾>

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

    \;
  </goldfish-chunk>

  <section|rich-vector>

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

    \;
  </goldfish-chunk>

  <subsection|静态方法>

  <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 (rich-vector :range 1 5) =\<gtr\> (box (vector 1 2 3 4)))

    (check (rich-vector :range 1 5 2) =\<gtr\> (box (vector 1 3)))

    (check (rich-vector :range 1 6 2) =\<gtr\> (box (vector 1 3 5)))

    (check (rich-vector :range 5 1 -1) =\<gtr\> (box (vector 5 4 3 2)))

    \;

    (check (rich-vector :range 5 1 1) =\<gtr\> (box (vector )))

    \;

    (check-catch 'value-error (rich-vector :range 1 5 0))

    \;
  </goldfish-chunk>

  <paragraph|rich-vector@empty>

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

    \ \ (rich-vector #()))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-vector :empty) =\<gtr\> (box #()))

    \;
  </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 (rich-vector :fill 0 #\\a :empty?))

    \;

    (check (rich-vector :fill 3 #\\a) =\<gtr\> (box (vector #\\a #\\a #\\a)))

    \;
  </goldfish-chunk>

  <subsection|选择器>

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

    \;
  </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 ((box #(1 2 3)) :apply 1) =\<gtr\> 2)

    (check ((box #(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 (rich-vector #(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 ((box (vector 1 2 3)) :head) =\> 1)

    (check-catch 'out-of-range ((rich-vector :empty) :head))

    (check ((box (vector 1 2 3)) :head-option) =\> (option 1))

    (check ((rich-vector :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 ((box (vector 1 2 3)) :last) =\> 3)

    (check-catch 'out-of-range ((rich-vector :empty) :last))

    (check ((box (vector 1 2 3)) :last-option) =\> (option 3))

    (check ((rich-vector :empty) :last-option) =\> (none))

    \;
  </scm-chunk>

  <subsection|谓词>

  <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 ((box (vector)) :empty?))

    (check-false ((box #(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 ((box #(1 2 3)) :equals (box #(1 2 3))))

    \;

    (check (box (vector (rich-char "中")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rich-char "文")))

    \ \ \ \ \ \ \ =\<gtr\> ((box "中文") :to-vector))

    \;

    (check-false (((box "中文") :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 (rich-vector #(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 (rich-vector #())))

    \ \ (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>

  <subsection|高阶函数>

  <\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 (rich-vector #(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 (rich-vector #(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 (rich-vector #(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 (rich-vector #(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 (rich-vector #(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>

  <subsection|转换器>

  <paragraph|rich-vector%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 (box #(1 2 3))) =\<gtr\> "#(1 2 3)")

    \;
  </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)))

    \ \ \ \ \ \ (string-append start middle end))))

    \;
  </scm-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (let1 v (box #(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 ((box #("a" "b" "c")) :make-string) =\<gtr\> "abc")

    \;
  </goldfish-chunk>

  <section|结尾>

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

    \;
  </goldfish-chunk>

  <section|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>

  <paragraph|rich-hash-table%map>

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

    \ \ (%apply-one f xs

    \ \ \ \ (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 (box (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%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 (box (hash-table 'a 1 'b 2 'c 3))

    \ \ (check ((ht :get 'a) :get) =\<gtr\> 1)

    \ \ (check ((ht :get 'd) :empty?) =\<gtr\> #t))

    \;
  </goldfish-chunk>

  <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 (box (hash-table 'a 1 'b 2 'c 3))

    \ \ (check-true (ht :contains 'a))

    \ \ (check-false (ht :contains 'd)))

    \;
  </goldfish-chunk>

  <paragraph|rich-hash-table@empty>

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

    \ \ (rich-hash-table (make-hash-table)))

    \;
  </goldfish-chunk>

  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
    (check (rich-hash-table :empty) =\<gtr\> (box (hash-table)))

    \;
  </goldfish-chunk>

  <subsection|结尾>

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

    \;
  </goldfish-chunk>

  <section|常用函数>

  <paragraph|box>

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

    \ \ (cond ((integer? x) (rich-integer 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?, char?, string?, list?, vector?, hash-table?"))))

    \;
  </goldfish-chunk>

  <section|结尾>

  <\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>