Goldfish.tmu

<TMU|<tuple|1.0.5|1.2.9.7>>

<style|<tuple|book|chinese|literate|goldfish|reduced-margins|guile|smart-ref|preview-ref|python>>

<\body>
  <\hide-preamble>
    <assign|scm|<macro|body|<goldfish-lang|<arg|body>>>>

    <assign|scm-chunk|<\macro|name|prev|next|body>
      <\generic-chunk|<arg|name>|<arg|prev>|<arg|next>>
        <with|mode|prog|prog-language|goldfish|font-family|rm|<arg|body>>
      </generic-chunk>
    </macro>>

    <assign|subparagraph|<macro|title|<assign|subparagraph-numbered|<compound|subparagraph-display-numbers>><assign|subparagraph-prefix|<macro|<compound|the-subparagraph>.>><compound|next-subparagraph><compound|subparagraph-clean><compound|subparagraph-header|<arg|title>><compound|subparagraph-toc|<arg|title>><small|<if|<value|subparagraph-numbered>|<compound|subparagraph-numbered-title|<arg|title>>|<compound|subparagraph-unnumbered-title|<arg|title>>>>>>

    <assign|r7rs|<flag|R7RS|dark cyan>>

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

    <assign|goldfish-version|17.11.0>

    <assign|typehint|<macro|body|<goldfish-lang|<arg|body>>>>

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

  <part|语言和数据>

  <chapter|金鱼Scheme简介>

  \;

  金鱼Scheme，又称Goldfish Scheme，是三鲤网络发起的Scheme解释器实现。

  金鱼Scheme解释器具有以下特性：

  <\itemize>
    <item>兼容R7RS small标准

    <item>提供类似Python的标准库

    <item>小巧且快速
  </itemize>

  <section|背景>

  金鱼Scheme创建之初的目的是为了服务墨干理工套件及其商业版Liii STEM。

  墨干一开始使用的是S7 Scheme，然而S7 Scheme并不严格遵循R7RS small标准，也没有提供常见的SRFI实现。故而我们决定在S7 Scheme的基础上，发布金鱼Scheme，更加严格地遵循R7RS small标准，并提供常见的SRFI实现作为金鱼Scheme的内置标准库。另外，无论是R7RS small还是SRFI都没有提供同时兼容macOS, GNU/Linux和Windows的类似于Python的os模块的标准库，故而我们模仿了Python的os模块，实现金鱼的内置标准库<scm|(liii os)>，以提供<scm|listdir>、<scm|mkdir>等常见功能。

  <section|文学编程>

  金鱼Scheme最初的三位作者是沈达、刘念和Yansong Li，项目立项时就是采用文学编程的方式实现金鱼Scheme的Scheme部分。

  一开始，我们的文学编程文档<shell|Goldfish.tmu>是不开源的，我们只开源了金鱼Scheme的代码，其中代码是几乎没有任何注释的，因为我们在文学编程文档中的代码块之外会撰写注释。后来来自Emacs China社区的StarSugar开始向金鱼Scheme项目贡献代码，于是我们决定将金鱼Scheme的文学编程文档<shell|Goldfish.tmu>也开源出来，整个项目以开源的方式推进。

  从金鱼Scheme V17.10.8开始，我们确定了金鱼Scheme的文学编程文档的许可证为<with|font-series|bold|知识共享署名-相同方式共享4.0国际许可协议>。

  本文档是采用中文编写的。在2024年，开源软件项目的文档采用中文编写并不是主流。首先，金鱼Scheme项目的前三位作者的母语都是中文，采用母语作为文档的语言是自然而然的；其次，在大模型时代，计算机辅助翻译已经非常成熟且廉价，我们相信中文文档不会是金鱼Scheme走向世界的阻碍。

  <section|许可证>

  本文档采用文学编程方式编写，金鱼Scheme相关的所有代码几乎都包含在本文档中。本文档的许可证分为代码和文档两部分，其中代码部分采用Apache许可证，相关信息在每一个源代码文件的头部都会显式声明，未显式声明的源代码默认采用Apache许可证；其中文档部分采用<with|font-series|bold|知识共享署名-相同方式共享4.0国际许可协议>授权。您可以自由地分享、修改本作品，只要您遵循以下条件：

  <\description>
    <item*|署名>您必须给出适当的署名，提供作品的链接，并指明是否有任何变更。您可以以任何合理的方式做这些事，但不得以任何方式暗示许可人赞同您或您的使用。

    <item*|相同方式共享>如果您再混合、转换或基于本作品创作，您必须以相同的许可协议发布其成果。
  </description>

  金鱼Scheme是浙江三鲤网络科技有限公司发起的开源项目，我们在分发源代码时，版权信息统一采用The Goldfish Scheme Authors作为金鱼Scheme的作者。那么谁是The Goldfish Scheme Authors呢？这些信息我们会在金鱼Scheme的仓库的根目录下的<shell|AUTHORS>文件中维护：

  <\verbatim-chunk|AUTHORS|false|false>
    # The original authors of the SRFI reference IMPL are kept in indivisual files

    # This AUTHORS file is for The Goldfish Scheme Authors.

    #

    # Names should be added to this file like so:

    # Name or Organization \<less\>email address\<gtr\>

    \;

    Liii Network Inc. \<less\>*@liii.pro\<gtr\>

    沈达 \<less\>da@liii.pro\<gtr\>

    刘念 \<less\>nian@liii.pro\<gtr\>

    \;

    Yansong Li \<less\>haggittli@gmail.com\<gtr\>

    Leiyu He \<less\>heleiyu1231@gmail.com\<gtr\>

    Duolei Wang \<less\>duolei.wang@gmail.com\<gtr\>

    Yingyao Zhou \<less\>yingyaozhou51@gmail.com\<gtr\>

    赵淑婷 \<less\>shuting.zhao@outlook.com\<gtr\>

    Shen Wei \<less\>weishen1900@gmail.com\<gtr\>

    Noctis Zhang \<less\>noctis@umass.edu\<gtr\>

    Andy Yu \<less\>andy87654@outlook.com\<gtr\>

    \;
  </verbatim-chunk>

  我们会联系金鱼Scheme的贡献者，更新<shell|AUTHORS>文件。金鱼Scheme的贡献者并不一定在这个文件中，有可能我们没有及时更新，也有可能相关贡献者希望保持匿名。

  <section|相关机构>

  支持金鱼Scheme的相关机构如下所示：

  <\itemize>
    <item>浙江三鲤网络科技有限公司

    <item>中国科学技术大学-德清阿尔法创新研究院
  </itemize>

  <chapter|boot.scm><label|chapter:scheme_boot>

  S7 Scheme默认并不遵循R7RS，在启动S7 Scheme之后，我们需要做的第一件事就是加载<scm|boot.scm>，实现R7RS的<scm|define-library>和<scm|import>。

  <value|r7rs><paragraph|file-exists?><index|file-exists?>

  <\scm-chunk|goldfish/scheme/boot.scm|false|true>
    (define (file-exists? path)

    \ \ (if (string? path)

    \ \ \ \ (if (not (g_access path 0)) ; F_OK

    \ \ \ \ \ \ #f

    \ \ \ \ \ \ (if (g_access path 4) ; R_OK

    \ \ \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ \ \ (error 'permission-error (string-append "No permission: " path))))

    \ \ \ \ (error 'type-error "(file-exists? path): path should be string")))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|delete-file><index|delete-file>

  <\scm-chunk|goldfish/scheme/boot.scm|true|true>
    (define (delete-file path)

    \ \ (if (not (string? path))

    \ \ \ \ (error 'type-error "(delete-file path): path should be string")

    \ \ \ \ (if (not (file-exists? path))

    \ \ \ \ \ \ (error 'read-error (string-append path " does not exist"))

    \ \ \ \ \ \ (g_delete-file path))))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|define-library><index|define-library>

  <\scm-chunk|goldfish/scheme/boot.scm|true|true>
    ; 0-clause BSD

    ; Adapted from S7 Scheme's r7rs.scm

    (define-macro (define-library libname . body) ; \|(lib name)\| -\<gtr\> environment

    \ \ `(define ,(symbol (object-\<gtr\>string libname))

    \ \ \ \ \ (with-let (sublet (unlet)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons 'import import)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons '*export* ())

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons 'export (define-macro (,(gensym) . names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(set! *export* (append ',names *export*)))))

    \ \ \ \ \ \ \ ,@body

    \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (member (car entry) '(*export* export import))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (pair? *export*)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (member (car entry) *export*))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (curlet))))))

    \;

    (unless (defined? 'r7rs-import-library-filename)

    \ \ (define (r7rs-import-library-filename libs)

    \ \ \ \ (when (pair? libs)

    \ \ \ \ \ \ (let ((lib-filename (let loop ((lib (if (memq (caar libs) '(only except prefix rename))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cadar libs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car libs)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (name ""))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! name (string-append name (symbol-\<gtr\>string (car lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr lib))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append name ".scm")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! name (string-append name "/"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr lib) name))))))

    \ \ \ \ \ \ \ \ (unless (member lib-filename (*s7* 'file-names))

    \ \ \ \ \ \ \ \ \ \ (load lib-filename)))

    \ \ \ \ \ \ (r7rs-import-library-filename (cdr libs)))))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|import><index|import>

  <\scm-chunk|goldfish/scheme/boot.scm|true|false>
    (define-macro (import . libs)

    \ \ `(begin

    \ \ \ \ \ (r7rs-import-library-filename ',libs)

    \ \ \ \ \ (varlet (curlet)

    \ \ \ \ \ \ \ ,@(map (lambda (lib)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (case (car lib)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((only)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons name (e name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ names)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((except)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (member (car entry) names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((prefix)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e prefx)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (string-\<gtr\>symbol\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append (symbol-\<gtr\>string prefx)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>string (car entry))))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cdr entry)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (caddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((rename)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((info (assoc (car entry) names)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if info

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cadr info) (cdr entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry)))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(let ((sym (symbol (object-\<gtr\>string ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (not (defined? sym))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (format () "~A not loaded~%" sym)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value sym))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ libs))))

    \;
  </scm-chunk>

  <chapter|(liii base)><label|chapter:liii_base>

  \;

  Goldfish Scheme解释器默认会加载<scm|(liii base)>。如果不想默认加载<scm|(liii base)>，请使用s7、r7rs或者sicp模式。

  <scm|(liii base)>由以下函数库组成：

  <\description>
    <item*|(scheme base)>由R7RS定义的Scheme基础函数库

    <item*|(srfi srfi-2)>由SRFI-2定义的<scm|and-let*>

    <item*|(srfi srfi-8)>由SRFI-8定义的<scm|receive>

    <item*|(liii base)>三鲤扩展函数和S7内置的非R7RS函数，例如<scm|display*>
  </description>

  <section|许可证>

  <\scm-chunk|goldfish/scheme/base.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.

    ;

    \;
  </scm-chunk>

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

    ;

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/base-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define-library (scheme base)

    (export

    \ \ let-values

    \ \ ; R7RS 5: Program Structure

    \ \ define-values define-record-type

    \ \ ; R7RS 6.2: Numbers

    \ \ square exact inexact floor s7-floor ceiling s7-ceiling truncate s7-truncate

    \ \ round s7-round floor-quotient gcd lcm s7-lcm boolean=?

    \ \ ; R7RS 6.4: list

    \ \ pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr

    \ \ null? list? make-list list length append reverse list-tail

    \ \ list-ref list-set! memq memv member assq assv assoc list-copy

    \ \ ; R7RS 6.5: Symbol

    \ \ symbol? symbol=? string-\<gtr\>symbol symbol-\<gtr\>string

    \ \ ; R7RS 6.6: Characters

    \ \ digit-value

    \ \ ; R7RS 6.7: String

    \ \ string-copy

    \ \ ; R7RS 6.8: Vector

    \ \ vector-\<gtr\>string string-\<gtr\>vector vector-copy vector-copy! vector-fill!

    \ \ ; R7RS 6.9: Bytevectors

    \ \ bytevector? make-bytevector bytevector bytevector-length bytevector-u8-ref

    \ \ bytevector-u8-set! bytevector-append utf8-\<gtr\>string string-\<gtr\>utf8 u8-string-length

    \ \ ; Input and Output

    \ \ call-with-port port? binary-port? textual-port? input-port-open? output-port-open?

    \ \ open-binary-input-file open-binary-output-file close-port eof-object

    \ \ ; Control flow

    \ \ string-map vector-map string-for-each vector-for-each

    \ \ ; Exception

    \ \ raise guard read-error? file-error?)

    (begin

    \;
  </scm-chunk>

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

    (import (scheme base)

    \ \ \ \ \ \ \ \ (srfi srfi-2)

    \ \ \ \ \ \ \ \ (srfi srfi-8))

    (export

    \ \ ; (scheme base) defined by R7RS

    \ \ let-values

    \ \ ; R7RS 5: Program Structure

    \ \ define-values define-record-type

    \ \ ; R7RS 6.2: Numbers

    \ \ square exact inexact floor s7-floor ceiling s7-ceiling truncate s7-truncate

    \ \ round s7-round floor-quotient gcd lcm s7-lcm

    \ \ ; R7RS 6.3: Booleans

    \ \ boolean=?

    \ \ ; R7RS 6.4: list

    \ \ pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr

    \ \ null? list? make-list list length append reverse list-tail

    \ \ list-ref list-set! memq memv member assq assv assoc list-copy

    \ \ ; R7RS 6.5: Symbol

    \ \ symbol? symbol=? string-\<gtr\>symbol symbol-\<gtr\>string

    \ \ ; R7RS 6.6: Characters

    \ \ digit-value

    \ \ ; R7RS 6.7: String

    \ \ string-copy

    \ \ ; R7RS 6.8 Vector

    \ \ vector-\<gtr\>string string-\<gtr\>vector vector-copy vector-copy! vector-fill!

    \ \ ; R7RS 6.9 Bytevectors

    \ \ bytevector? make-bytevector bytevector bytevector-length bytevector-u8-ref

    \ \ bytevector-u8-set! bytevector-append utf8-\<gtr\>string string-\<gtr\>utf8 u8-string-length

    \ \ u8-substring

    \ \ ; Input and Output

    \ \ call-with-port port? binary-port? textual-port? input-port-open? output-port-open?

    \ \ open-binary-input-file open-binary-output-file close-port eof-object

    \ \ ; Control flow

    \ \ string-map vector-map string-for-each vector-for-each

    \ \ ; Exception

    \ \ raise guard read-error? file-error?

    \ \ ; SRFI-2

    \ \ and-let*

    \ \ ; SRFI-8

    \ \ receive

    \ \ ; Extra routines for (liii base)

    \ \ == != display* in? let1 compose identity typed-lambda

    )

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii list))

    \;

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

    \;
  </scm-chunk>

  <section|表达式>

  本节对应R7RS的第四节：表达式。

  <subsection|原语表达式>

  原语表达式可以分为：变量、字面量、函数的应用、匿名函数、分支表达式、赋值表达式、文件包含表达式。

  <paragraph|lambda>

  <paragraph|quote>

  <paragraph|if>

  <paragraph|set!>

  <paragraph|include>

  <paragraph|include-ci>

  \;

  <subsection|派生表达式>

  <paragraph|cond>

  <value|r7rs><paragraph|case><index|case>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (case '+

    \ \ \ \ \ \ \ \ \ ((+ -) 'p0)

    \ \ \ \ \ \ \ \ \ ((* /) 'p1))

    \ \ =\<gtr\> 'p0)

    \;

    (check (case '-

    \ \ \ \ \ \ \ \ \ ((+ -) 'p0)

    \ \ \ \ \ \ \ \ \ ((* /) 'p1))

    \ \ =\<gtr\> 'p0)

    \;

    (check (case '*

    \ \ \ \ \ \ \ \ \ ((+ -) 'p0)

    \ \ \ \ \ \ \ \ \ ((* /) 'p1))

    \ \ =\<gtr\> 'p1)

    \;

    (check (case '@

    \ \ \ \ \ \ \ \ \ ((+ -) 'p0)

    \ \ \ \ \ \ \ \ \ ((* /) 'p1))

    \ \ =\<gtr\> #\<less\>unspecified\<gtr\>)

    \;

    (check (case '&

    \ \ \ \ \ \ \ \ \ ((+ -) 'p0)

    \ \ \ \ \ \ \ \ \ ((* /) 'p1))

    \ \ =\<gtr\> #\<less\>unspecified\<gtr\>)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|and><index|and>

  检查 <code*|and> 是否正确处理多个布尔表达式。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (and #t #t #t))

    (check-false (and #t #f #t))

    (check-false (and #f #t #f))

    (check-false (and #f #f #f))

    \;
  </scm-chunk>

  验证当 <code*|and> 没有参数时的行为。

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

    \;
  </scm-chunk>

  测试 <code*|and> 与混合类型参数的组合。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (and 1 '() "non-empty" #t))

    (check-false (and #f '() "non-empty" #t))

    (check-false (and 1 '() "non-empty" #f))

    \;
  </scm-chunk>

  检查 <code*|and> 在复合表达式中的行为。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (and (\<gtr\> 5 3) (\<less\> 5 10)))

    (check-false (and (\<gtr\> 5 3) (\<gtr\> 5 10)))

    \;
  </scm-chunk>

  验证 <code*|and> 的短路行为。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'error-name

    \ \ (and (error 'error-name "This should not be evaluated") #f))

    (check-false (and #f (error "This should not be evaluated")))

    \;
  </scm-chunk>

  验证and返回值非布尔值的情况。

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

    \;
  </scm-chunk>

  <value|r7rs><paragraph|or><index|or>

  <value|r7rs><paragraph|when><index|when>

  <value|r7rs><paragraph|unless><index|unless>

  <value|r7rs><paragraph|let><index|let>

  <value|r7rs><paragraph|let*><index|let*>

  <value|r7rs><paragraph|letrec>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (define (test-letrec)

    \ \ (letrec ((even?

    \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (n)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (= n 0)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (odd? (- n 1)))))

    \ \ \ \ \ \ \ \ \ \ \ \ (odd?

    \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (n)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (= n 0)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #f

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (even? (- n 1))))))

    \ \ \ \ (list (even? 10) (odd? 10))))

    \;

    (check (test-letrec) =\<gtr\> (list #t #f))

    \;

    (check-catch 'wrong-type-arg

    \ \ (letrec ((a 1) (b (+ a 1))) (list a b)))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|letrec*><index|letrec*>

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

    \ \ (letrec* ((a 1) (b (+ a 1))) (list a b))

    \ \ =\<gtr\> (list 1 2))

    \;
  </scm-chunk>

  \;

  <value|r7rs><paragraph|let-values><index|let-values>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0-clause BSD

    ; Bill Schottstaedt

    ; from S7 source repo: r7rs.scm

    (define-macro (let-values vars . body)

    \ \ (if (and (pair? vars)

    \ \ \ \ \ \ \ \ \ \ \ (pair? (car vars))

    \ \ \ \ \ \ \ \ \ \ \ (null? (cdar vars)))

    \ \ \ \ \ \ `((lambda ,(caar vars)

    \ \ \ \ \ \ \ \ \ \ ,@body)

    \ \ \ \ \ \ \ \ ,(cadar vars))

    \ \ \ \ \ \ `(with-let

    \ \ \ \ \ \ \ \ (apply sublet (curlet)

    \ \ \ \ \ \ \ \ \ \ (list

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda ,(car v)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values ,@(map (lambda (name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values (symbol-\<gtr\>keyword name) name))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let args-\<gtr\>proper-list ((args (car v)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cond ((symbol? args)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (list args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((not (pair? args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ args)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((pair? (car args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (caar args)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (args-\<gtr\>proper-list (cdr args))))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (car args)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (args-\<gtr\>proper-list (cdr args)))))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,(cadr v)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ vars)))

    \ \ \ \ \ \ \ \ ,@body)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (let-values (((ret) (+ 1 2))) (+ ret 4)) =\<gtr\> 7)

    (check (let-values (((a b) (values 3 4))) (+ a b)) =\<gtr\> 7)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|let*-values>

  <paragraph|and-let*><index|and-let*>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (and-let* ((hi 3) (ho #f)) (+ hi 1)) =\<gtr\> #f)

    (check (and-let* ((hi 3) (ho #t)) (+ hi 1)) =\<gtr\> 4)

    \;
  </scm-chunk>

  <subparagraph|SRFI>

  <\scm-chunk|goldfish/srfi/srfi-2.scm|false|false>
    ; 0-clause BSD by Bill Schottstaedt from S7 source repo: s7test.scm

    (define-library (srfi srfi-2)

    (export and-let*)

    (begin

    \;

    (define-macro (and-let* vars . body)

    \ \ `(let () (and ,@(map (lambda (v) `(define ,@v)) vars) (begin ,@body))))

    \;

    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <value|r7rs><paragraph|do><index|do>

  检查 <scm|do> 是否能够正确执行迭代并在结束时返回正确的值。

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

    \ \ (do ((i 0 (+ i 1)))

    \ \ \ \ \ \ ((= i 5) i))

    \ \ =\<gtr\> 5)

    \;
  </scm-chunk>

  检查 <scm|do> 是否能正确处理多个变量的绑定和更新。

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

    \ \ (do ((i 0 (+ i 1))

    \ \ \ \ \ \ \ (sum 0 (+ sum i)))

    \ \ \ \ \ \ ((= i 5) sum))

    \ \ =\<gtr\> 10)

    \;
  </scm-chunk>

  检查当步长被省略时，<scm|do> 是否正确处理变量默认更新。

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

    \ \ (do ((i 0))

    \ \ \ \ \ \ ((= i 5) i)

    \ \ \ \ (set! i (+ i 1)))

    \ \ =\<gtr\> 5)

    \;
  </scm-chunk>

  检查 <scm|do> 表达式是否能正确执行副作用，例如修改向量。

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

    \ \ (let1 vec (make-vector 5)

    \ \ \ \ (do ((i 0 (+ i 1)))

    \ \ \ \ \ \ \ \ ((= i 5) vec)

    \ \ \ \ \ \ (vector-set! vec i i)))

    \ \ =\<gtr\> #(0 1 2 3 4))

    \;
  </scm-chunk>

  <subsection|宏>

  金鱼Scheme基于S7 Scheme，不支持<scm|let-syntax>, <scm|letrec-syntax>, <scm|syntax-rules>和<scm|syntax-error>等R7RS定义的宏的基础设施。

  <paragraph|define-macro>

  金鱼Scheme支持<scm|define-macro>来定义宏。宏采用正则序求值。

  <section|程序结构>

  本节对应R7RS的第5节：程序结构。

  <value|r7rs><paragraph|define><index|define>

  <value|r7rs><paragraph|define-values><index|define-values>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0-clause BSD by Bill Schottstaedt from S7 source repo: s7test.scm

    (define-macro (define-values vars expression)

    \ \ `(if (not (null? ',vars))

    \ \ \ \ \ \ \ (varlet (curlet) ((lambda ,vars (curlet)) ,expression))))

    \;
  </scm-chunk>

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

    \ \ (define-values (value1 value2) (values 1 2))

    \ \ (check value1 =\<gtr\> 1)

    \ \ (check value2 =\<gtr\> 2))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|define-record-type><index|define-record-type>

  <subparagraph|实现>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0-clause BSD by Bill Schottstaedt from S7 source repo: r7rs.scm

    (define-macro (define-record-type type make ? . fields)

    \ \ (let ((obj (gensym))

    \ \ \ \ \ \ \ \ (typ (gensym)) ; this means each call on this macro makes a new type

    \ \ \ \ \ \ \ \ (args (map (lambda (field)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values (list 'quote (car field))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((par (memq (car field) (cdr make))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (pair? par) (car par)))))

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

    \ \ \ \ `(begin

    \ \ \ \ \ \ \ (define (,? ,obj)

    \ \ \ \ \ \ \ \ \ (and (let? ,obj)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (eq? (let-ref ,obj ',typ) ',type)))

    \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ (define ,make\ 

    \ \ \ \ \ \ \ \ \ (inlet ',typ ',type ,@args))

    \;

    \ \ \ \ \ \ \ ,@(map

    \ \ \ \ \ \ \ \ \ \ (lambda (field)

    \ \ \ \ \ \ \ \ \ \ \ \ (when (pair? field)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr field))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cddr field))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(define (,(cadr field) ,obj)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let-ref ,obj ',(car field)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (define (,(cadr field) ,obj)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let-ref ,obj ',(car field)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (define (,(caddr field) ,obj val)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let-set! ,obj ',(car field) val)))))))

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

    \ \ \ \ \ \ \ ',type)))

    \;
  </scm-chunk>

  \;

  <subparagraph|测试>

  通过<scm|define-record-type>，定义了一种名为<scm|pare>的记录类型，其中<scm|kons>是这种记录类型的构造器，<scm|pare?>是谓词，<scm|kar>和<scm|kdr>是选择器，<scm|set-kar!>是修改器。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (define-record-type :pare

    \ \ (kons x y)

    \ \ pare?

    \ \ (x kar set-kar!)

    \ \ (y kdr))

    \;

    (check (pare? (kons 1 2)) =\<gtr\> #t)

    (check (pare? (cons 1 2)) =\<gtr\> #f)

    (check (kar (kons 1 2)) =\<gtr\> 1)

    (check (kdr (kons 1 2)) =\<gtr\> 2)

    \;

    (check

    \ (let ((k (kons 1 2)))

    \ \ \ (set-kar! k 3)

    \ \ \ (kar k))

    \ \ =\<gtr\> 3)

    \;
  </scm-chunk>

  \;

  上面那个例子比较难懂，提供一个更易懂的例子：

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (define-record-type :person

    \ \ (make-person name age)

    \ \ person?

    \ \ (name get-name set-name!)

    \ \ (age get-age))

    \;

    (check (person? (make-person "Da" 3)) =\<gtr\> #t)

    (check (get-age (make-person "Da" 3)) =\<gtr\> 3)

    (check (get-name (make-person "Da" 3)) =\<gtr\> "Da")

    (check

    \ \ (let ((da (make-person "Da" 3)))

    \ \ \ \ (set-name! da "Darcy")

    \ \ \ \ (get-name da))

    \ \ =\<gtr\> "Darcy")

    \;
  </scm-chunk>

  <subparagraph|SRFI>

  <\scm-chunk|goldfish/srfi/srfi-9.scm|false|false>
    (define-library (srfi srfi-9)

    (import (scheme base))

    (export define-record-type)

    (begin

    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  \;

  <section|相等性判断>

  <section|数>

  本节对应R7RS的6.2节。

  <subsection|数的类型>

  <value|r7rs><paragraph|number?><index|number?><scm|(number? obj) =\<gtr\> boolean>

  判断一个对象是否是数。

  <paragraph|complex?>

  判断一个对象是否是复数。

  <paragraph|real?>

  <paragraph|rational?>

  <paragraph|integer?>

  <subsection|数的准确性>

  <value|r7rs><paragraph|exact?><index|exact?>

  <todo|<scm|#e3.0>需要支持一下>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (exact? 1))

    (check-true (exact? 1/2))

    (check-false (exact? 0.3))

    ; (check-true (exact? #e3.0))

    \;
  </scm-chunk>

  <paragraph|inexact?>

  <paragraph|exact-integer?>

  <paragraph|exact>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define exact inexact-\<gtr\>exact)

    \;
  </scm-chunk>

  <paragraph|inexact>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define inexact exact-\<gtr\>inexact)

    \;
  </scm-chunk>

  <subsection|数的运算>

  <value|r7rs><paragraph|zero?><index|zero?><scm|(x) =\<gtr\> boolean?>

  判断一个数是否为0，注意该判断为真的情况有两种，其一是整数的0，其二是浮点数的0.0。如有需要，可以使用<scm|exact?>和<scm|inexact?>准确区分两者。

  <subparagraph|真>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (let1 zero-int 0

    \ \ (check-true (and (integer? zero-int) (zero? zero-int))))

    (let1 zero-exact (- 1/2 1/2)

    \ \ (check-true (and (exact? zero-exact) (zero? zero-exact))))

    (let1 zero-inexact 0.0

    \ \ (check-true (and (inexact? zero-inexact) (zero? zero-inexact))))

    \;
  </scm-chunk>

  <subparagraph|假>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (zero? 1+1i))

    (check-false (zero? #b11))

    \;
  </scm-chunk>

  <subparagraph|类型错误>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'wrong-type-arg (zero? #\\A))

    (check-catch 'wrong-type-arg (zero? #t))

    (check-catch 'wrong-type-arg (zero? #f))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|positive?><index|positive?><scm|((x real?)) =\<gtr\> boolean?>

  判断一个实数是否为正数。

  <subparagraph|真>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (positive? 1))

    (check-true (positive? 0.1))

    (check-true (positive? 1/2))

    (check-true (positive? +inf.0))

    (check-true (positive? 1+0i))

    \;
  </scm-chunk>

  <subparagraph|假>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (positive? 0))

    (check-false (positive? -1))

    (check-false (positive? -1.1))

    (check-false (positive? -1/2))

    (check-false (positive? -inf.0))

    (check-false (positive? +nan.0))

    \;
  </scm-chunk>

  <subparagraph|类型错误>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'wrong-type-arg (positive? 1+1i))

    (check-catch 'wrong-type-arg (positive? #\\A))

    (check-catch 'wrong-type-arg (positive? #t))

    (check-catch 'wrong-type-arg (positive? "not-a-number"))

    (check-catch 'wrong-type-arg (positive? 'symbol))

    (check-catch 'wrong-type-arg (positive? '(1 2 3)))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|negative?><index|negative?><scm|((x real?)) =\<gtr\> boolean?>

  判断一个实数是否为负数。

  <subparagraph|真>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (negative? -1))

    (check-true (negative? -0.1))

    (check-true (negative? -1/2))

    (check-true (negative? -inf.0))

    (check-true (negative? -1+0i))

    \;
  </scm-chunk>

  <subparagraph|假>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (negative? 0))

    (check-false (negative? 1))

    (check-false (negative? 1.1))

    (check-false (negative? 1/2))

    (check-false (negative? +inf.0))

    (check-false (negative? -nan.0))

    \;
  </scm-chunk>

  <subparagraph|类型错误>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'wrong-type-arg (negative? -1-1i))

    (check-catch 'wrong-type-arg (negative? #\\A))

    (check-catch 'wrong-type-arg (negative? #t))

    (check-catch 'wrong-type-arg (negative? "not-a-number"))

    (check-catch 'wrong-type-arg (negative? 'symbol))

    (check-catch 'wrong-type-arg (negative? '(1 2 3)))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|odd?><index|odd?><scm|((x integer?)) =\<gtr\> boolean?>

  判断一个整数是否是奇数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (odd? 1))

    (check-false (odd? 0))

    \;

    (check-catch 'wrong-type-arg (odd? 1+i))

    (check-catch 'wrong-type-arg (odd? 1.0))

    (check-catch 'wrong-type-arg (odd? 0.0))

    (check-catch 'wrong-type-arg (odd? #\\A))

    (check-catch 'wrong-type-arg (odd? #t))

    (check-catch 'wrong-type-arg (odd? #f))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|even?><index|even?><scm|((x integer?)) =\<gtr\> boolean?>

  判断一个整数是否是偶数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (even? 0))

    (check-false (even? 1))

    \;

    (check-catch 'wrong-type-arg (even? 0.0))

    (check-catch 'wrong-type-arg (even? 1.0))

    (check-catch 'wrong-type-arg (even? 1+i))

    (check-catch 'wrong-type-arg (even? #\\A))

    (check-catch 'wrong-type-arg (even? #t))

    (check-catch 'wrong-type-arg (even? #f))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|floor><index|floor><scm|(x) =\<gtr\> integer>

  返回最大的不大于<math|x>的整数。如果<math|x>是准确值，那么返回值也是准确值，如果<math|x>不是准确值，那么返回值也不是准确值。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define s7-floor floor)

    \;

    (define (floor x)

    \ \ (if (inexact? x)

    \ \ \ \ \ \ (inexact (s7-floor x))

    \ \ \ \ \ \ (s7-floor x)))

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (floor 1.1) =\<gtr\> 1.0)

    (check (floor 1) =\<gtr\> 1)

    (check (floor 1/2) =\<gtr\> 0)

    (check (floor 0) =\<gtr\> 0)

    (check (floor -1) =\<gtr\> -1)

    (check (floor -1.2) =\<gtr\> -2.0)

    \;

    (check (s7-floor 1.1) =\<gtr\> 1)

    (check (s7-floor -1.2) =\<gtr\> -2)

    \;
  </scm-chunk>

  <paragraph|ceiling>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define s7-ceiling ceiling)

    \;

    (define (ceiling x)

    \ \ (if (inexact? x)

    \ \ \ \ \ \ (inexact (s7-ceiling x))

    \ \ \ \ \ \ (s7-ceiling x)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (ceiling 1.1) =\<gtr\> 2.0)

    (check (ceiling 1) =\<gtr\> 1)

    (check (ceiling 1/2) =\<gtr\> 1)

    (check (ceiling 0) =\<gtr\> 0)

    (check (ceiling -1) =\<gtr\> -1)

    (check (ceiling -1.2) =\<gtr\> -1.0)

    \;

    (check (s7-ceiling 1.1) =\<gtr\> 2)

    (check (s7-ceiling -1.2) =\<gtr\> -1)

    \;
  </scm-chunk>

  <paragraph|truncate>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define s7-truncate truncate)

    \;

    (define (truncate x)

    \ \ (if (inexact? x)

    \ \ \ \ \ \ (inexact (s7-truncate x))

    \ \ \ \ \ \ (s7-truncate x)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (truncate 1.1) =\<gtr\> 1.0)

    (check (truncate 1) =\<gtr\> 1)

    (check (truncate 1/2) =\<gtr\> 0)

    (check (truncate 0) =\<gtr\> 0)

    (check (truncate -1) =\<gtr\> -1)

    (check (truncate -1.2) =\<gtr\> -1.0)

    \;

    (check (s7-truncate 1.1) =\<gtr\> 1)

    (check (s7-truncate -1.2) =\<gtr\> -1)

    \;
  </scm-chunk>

  <paragraph|round>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define s7-round round)

    \;

    (define (round x)

    \ \ (if (inexact? x)

    \ \ \ \ \ \ (inexact (s7-round x))

    \ \ \ \ \ \ (s7-round x)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (round 1.1) =\<gtr\> 1.0)

    (check (round 1.5) =\<gtr\> 2.0)

    (check (round 1) =\<gtr\> 1)

    (check (round 1/2) =\<gtr\> 0)

    (check (round 0) =\<gtr\> 0)

    (check (round -1) =\<gtr\> -1)

    (check (round -1.2) =\<gtr\> -1.0)

    (check (round -1.5) =\<gtr\> -2.0)

    \;
  </scm-chunk>

  \;

  <value|r7rs><paragraph|floor-quotient><index|floor-quotient><scm|((x real?) (y real?)) =\<gtr\> integer>

  <\equation*>
    floor_quotient<around*|(|y,x|)>=<around*|\<lfloor\>|y/x|\<rfloor\>>
  </equation*>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (floor-quotient x y) (floor (/ x y)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  正常情况测试

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (floor-quotient 11 2) =\<gtr\> 5)

    (check (floor-quotient 11 -2) =\<gtr\> -6)

    (check (floor-quotient -11 2) =\<gtr\> -6)

    (check (floor-quotient -11 -2) =\<gtr\> 5)

    \;

    (check (floor-quotient 10 2) =\<gtr\> 5)

    (check (floor-quotient 10 -2) =\<gtr\> -5)

    (check (floor-quotient -10 2) =\<gtr\> -5)

    (check (floor-quotient -10 -2) =\<gtr\> 5)

    \;
  </scm-chunk>

  特殊情况测试

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'division-by-zero (floor-quotient 11 0))

    (check-catch 'division-by-zero (floor-quotient 0 0))

    \;

    (check (floor-quotient 0 2) =\<gtr\> 0)

    (check (floor-quotient 0 -2) =\<gtr\> 0)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|quotient><index|quotient><scm|(quotient (y real?) (x real?)) =\<gtr\> integer>

  求两个数的商。

  <\equation*>
    quotient<around*|(|y,x|)>=truncate<around*|(|y/x|)>
  </equation*>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (quotient 11 2) =\<gtr\> 5)

    (check (quotient 11 -2) =\<gtr\> -5)

    (check (quotient -11 2) =\<gtr\> -5)

    (check (quotient -11 -2) =\<gtr\> 5)

    \;

    (check-catch 'division-by-zero (quotient 11 0))

    (check-catch 'division-by-zero (quotient 0 0))

    (check-catch 'wrong-type-arg (quotient 1+i 2))

    \;
  </scm-chunk>

  <paragraph|remainder>

  <paragraph|modulo>

  <value|r7rs><paragraph|gcd><index|gcd><scm|(x ...) =\<gtr\> (y positive?)>

  求n个数的最大公约数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (gcd) =\<gtr\> 0)

    (check (gcd 0) =\<gtr\> 0)

    (check (gcd 1) =\<gtr\> 1)

    (check (gcd 2) =\<gtr\> 2)

    (check (gcd -1) =\<gtr\> 1)

    \;

    (check (gcd 0 1) =\<gtr\> 1)

    (check (gcd 1 0) =\<gtr\> 1)

    (check (gcd 1 2) =\<gtr\> 1)

    (check (gcd 1 10) =\<gtr\> 1)

    (check (gcd 2 10) =\<gtr\> 2)

    (check (gcd -2 10) =\<gtr\> 2)

    \;

    (check (gcd 2 3 4) =\<gtr\> 1)

    (check (gcd 2 4 8) =\<gtr\> 2)

    (check (gcd -2 4 8) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|lcm>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define s7-lcm lcm)

    \;

    (define (lcm2 x y)

    \ \ (cond ((and (inexact? x) (exact? y))

    \ \ \ \ \ \ \ \ \ (inexact (s7-lcm (exact x) y)))

    \ \ \ \ \ \ \ \ ((and (exact? x) (inexact? y))

    \ \ \ \ \ \ \ \ \ (inexact (s7-lcm x (exact y))))

    \ \ \ \ \ \ \ \ ((and (inexact? x) (inexact? y))

    \ \ \ \ \ \ \ \ \ (inexact (s7-lcm (exact x) (exact y))))

    \ \ \ \ \ \ \ \ (else (s7-lcm x y))))

    \;

    (define (lcm . args)

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

    \ \ \ \ \ \ \ \ ((null? (cdr args))

    \ \ \ \ \ \ \ \ \ (car args))

    \ \ \ \ \ \ \ \ ((null? (cddr args))

    \ \ \ \ \ \ \ \ \ (lcm2 (car args) (cadr args)))

    \ \ \ \ \ \ \ \ (else (apply lcm (cons (lcm (car args) (cadr args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr args))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (lcm) =\<gtr\> 1)

    (check (lcm 1) =\<gtr\> 1)

    (check (lcm 0) =\<gtr\> 0)

    (check (lcm 32 -36) =\<gtr\> \ 288)

    (check (lcm 32 -36.0) =\<gtr\> 288.0)

    (check (lcm 2 4) =\<gtr\> 4)

    (check (lcm 2 4.0) =\<gtr\> 4.0)

    (check (lcm 2.0 4.0) =\<gtr\> 4.0)

    (check (lcm 2.0 4) =\<gtr\> 4.0)

    \;
  </scm-chunk>

  \;

  <value|r7rs><paragraph|square><index|square>

  求一个数的平方。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (square x) (* x x))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (square 2) =\<gtr\> 4)

    \;
  </scm-chunk>

  <paragraph|exact-integer-sqrt>

  <paragraph|expt>

  <subsection|数的转换>

  <value|r7rs><paragraph|number-\<gtr\>string><index|number-\<gtr\>string><typehint|((z number?) (radix 10)) =\<gtr\> string?>

  将一个数<scm|z>转换为字符串，其中<scm|radix>是可选参数，默认值为10。

  <subparagraph|整数>

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

    (check (number-\<gtr\>string -456) =\<gtr\> "-456")

    \;

    (check (number-\<gtr\>string 123 2) =\<gtr\> "1111011")

    \;

    (check (number-\<gtr\>string 123 8) =\<gtr\> "173")

    \;

    (check (number-\<gtr\>string 255 16) =\<gtr\> "ff")

    \;

    (check-catch 'wrong-type-arg (number-\<gtr\>string 123 'not-a-number))

    \;
  </scm-chunk>

  <subparagraph|有理数>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (number-\<gtr\>string 1/2) =\<gtr\> "1/2")

    (check (number-\<gtr\>string 1/2 2) =\<gtr\> "1/10")

    (check (number-\<gtr\>string 3/4 2) =\<gtr\> "11/100")

    \;
  </scm-chunk>

  <subparagraph|实数>

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

    \;
  </scm-chunk>

  <subparagraph|复数>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (number-\<gtr\>string 1+2i) =\<gtr\> "1.0+2.0i")

    (check (number-\<gtr\>string 0+2i) =\<gtr\> "0.0+2.0i")

    \;
  </scm-chunk>

  <value|r7rs><paragraph|string-\<gtr\>number><index|string-\<gtr\>number><typehint|((str string?) (radix 10)) =\<gtr\> number?>

  <section|布尔值>

  <r7rs><paragraph|boolean=?><scm|(obj1 obj2 ...) =\<gtr\> boolean><index|boolean=?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (boolean=? obj1 obj2 . rest)

    \ \ (define (same-boolean obj rest)

    \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ (and (equal? obj (car rest))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (same-boolean obj (cdr rest)))))

    \ \ (cond ((not (boolean? obj1)) #f)

    \ \ \ \ \ \ \ \ ((not (boolean? obj2)) #f)

    \ \ \ \ \ \ \ \ ((not (equal? obj1 obj2)) #f)

    \ \ \ \ \ \ \ \ (else (same-boolean obj1 rest))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (boolean=? #t #t))

    (check-true (boolean=? #f #f))

    (check-true (boolean=? #t #t #t))

    (check-false (boolean=? #t #f))

    (check-false (boolean=? #f #t))

    \;
  </scm-chunk>

  <section|序对和列表>

  见<chapter-ref|chapter:liii_list>

  <section|符号>

  <value|r7rs><paragraph|symbol?><scm|(obj) =\<gtr\> bool><index|symbol?>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (symbol? 'foo))

    (check-true (symbol? (car '(foo bar))))

    (check-true (symbol? 'nil))

    \;

    (check-false (symbol? "bar"))

    (check-false (symbol? #f))

    (check-false (symbol? '()))

    (check-false (symbol? '123))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|symbol=?><index|symbol=?>

  如果所有参数都是符号并且它们的名称通过string=?测试是相同的，返回#t（真），否则返回#f（假）。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (symbol=? sym1 sym2 . rest)

    \ \ (define (same-symbol sym rest)

    \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ (and (eq? sym (car rest))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (same-symbol sym (cdr rest)))))

    \ \ (cond ((not (symbol? sym1)) #f)

    \ \ \ \ \ \ \ \ ((not (symbol? sym2)) #f)

    \ \ \ \ \ \ \ \ ((not (eq? sym1 sym2)) #f)

    \ \ \ \ \ \ \ \ (else (same-symbol sym1 rest))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-catch 'wrong-number-of-args (symbol=? 'a))

    (check-catch 'wrong-number-of-args (symbol=? 1))

    \;

    (check-true (symbol=? 'a 'a))

    (check-true (symbol=? 'foo 'foo))

    (check-false (symbol=? 'a 'b))

    (check-false (symbol=? 'foo 'bar))

    \;

    (check-true (symbol=? 'bar 'bar 'bar))

    \;
  </scm-chunk>

  测试动态生成的符号

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (symbol=? (string-\<gtr\>symbol "foo") (string-\<gtr\>symbol "foo")))

    (check-false (symbol=? (string-\<gtr\>symbol "foo") (string-\<gtr\>symbol "bar")))

    \;
  </scm-chunk>

  测试混合类型

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (symbol=? 1 1))

    (check-false (symbol=? 'a 1))

    (check-false (symbol=? (string-\<gtr\>symbol "foo") 1))

    \;
  </scm-chunk>

  测试空列表\ 

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (symbol=? 'a 'b '()))

    \;
  </scm-chunk>

  <r7rs><paragraph|symbol-\<gtr\>string><index|symbol-\<gtr\>string>

  <scm|symbol-\<gtr\>string>是一个S7内置的函数，用于将符号转换为字符串。

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (symbol-\<gtr\><with|font-series|bold|>string `MathAgape) =\<gtr\> "MathAgape")

    (check (symbol-\<gtr\>string 'goldfish-scheme) =\<gtr\> "goldfish-scheme")

    \;

    (check (symbol-\<gtr\><with|font-series|bold|>string (string-\<gtr\>symbol "MathApage")) =\<gtr\> "MathApage")

    (check (symbol-\<gtr\>string (string-\<gtr\>symbol "Hello World")) =\<gtr\> "Hello World")

    \;
  </scm-chunk>

  <r7rs><paragraph|string-\<gtr\>symbol><index|string-\<gtr\>symbol>

  <scm|string-\<gtr\>symbol> 是一个S7内置的函数，用于将字符串转换为符号。

  <subparagraph|测试>

  <\session|goldfish|default>
    <\output>
      Goldfish Scheme 17.10.6 Community Edition by LiiiLabs

      implemented on S7 Scheme (10.12, 16-Aug-2024)
    </output>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (string-\<gtr\>symbol "123")
    <|unfolded-io>
      <goldfish-result|(symbol "123")>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      '123
    <|unfolded-io>
      <goldfish-result|123>
    </unfolded-io>

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      `123
    <|unfolded-io>
      <goldfish-result|123>
    </unfolded-io>

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

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-\<gtr\>symbol "MathAgape") =\<gtr\> `MathAgape)

    (check-false (equal? (string-\<gtr\>symbol "123") '123))

    (check (string-\<gtr\>symbol "+") =\<gtr\> '+)

    \;

    (check (string-\<gtr\>symbol (symbol-\<gtr\>string `MathAgape)) =\<gtr\> `MathAgape)

    \;
  </scm-chunk>

  <section|字符>

  <value|r7rs><paragraph|char?><index|char?>

  判断一个对象x是否是字符类型。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (char? #\\A) =\<gtr\> #t)

    (check (char? 1) =\<gtr\> #f)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|char=?><index|char=?>

  判断两个及以上字符对象是否相等。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (char=? #\\A #\\A) =\<gtr\> #t)

    (check (char=? #\\A #\\A #\\A) =\<gtr\> #t)

    (check (char=? #\\A #\\a) =\<gtr\> #f)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|char-\<gtr\>integer><index|char-\<gtr\>integer>

  将字符转换为其对应的Unicode标量值。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (char-\<gtr\>integer #\\A) =\<gtr\> 65)

    (check (char-\<gtr\>integer #\\a) =\<gtr\> 97)

    (check (char-\<gtr\>integer #\\newline) =\<gtr\> 10)

    (check (char-\<gtr\>integer #\\space) =\<gtr\> 32)

    (check (char-\<gtr\>integer #\\tab) =\<gtr\> 9)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|integer-\<gtr\>char><index|integer-\<gtr\>char>

  将字符转换为其对应的Unicode标量值。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (integer-\<gtr\>char 65) =\<gtr\> #\\A) \ \ 

    (check (integer-\<gtr\>char 97) =\<gtr\> #\\a) \ 

    (check (integer-\<gtr\>char 48) =\<gtr\> #\\0)

    (check (integer-\<gtr\>char 36) =\<gtr\> #\\$)

    \;
  </scm-chunk>

  <section|字符串>

  见<smart-ref|chapter:liii_string>

  <section|向量>

  见<smart-ref|chapter:liii_vector>

  <section|字节向量>

  字节向量是固定长度的单字节序列，每一个单字节的取值范围是<math|<around*|[|0,255|]>>。字节向量的每一个元素都是类型一致的单字节，其空间利用率会比向量高一些。

  类型一致的向量在S7 Scheme中有<scm|int-vector>和<scm|byte-vector>等特殊形式，这是S7 Scheme里面扩展的功能。R7RS定义的<scm|bytevector>可以使用<scm|byte-vector>作为实现。

  <value|r7rs><paragraph|bytevector><scm|(byte ...) =\<gtr\> bytevector><index|bytevector>

  <\description>
    <item*|byte>一个或多个介于 0 到 255 之间的整数（代表字节的值）。
  </description>

  <code*|bytevector>过程返回一个新分配的字节向量，其元素包含传递给过程的所有参数。每个参数都必须是一个介于 0 到 255 之间的整数，表示字节向量中的一个字节。如果没有提供任何参数，将创建一个空的字节向量。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector byte-vector)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (bytevector 1) =\<gtr\> #u8(1))

    (check (bytevector) =\<gtr\> #u8())

    (check (bytevector 1 2 3) =\<gtr\> #u8(1 2 3))

    \;

    (check (bytevector 255) =\<gtr\> #u8(255))

    (check-catch 'wrong-type-arg (bytevector 256))

    (check-catch 'wrong-type-arg (bytevector -1))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|bytevector?><index|bytevector?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector? byte-vector?)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (bytevector? #u8(0)))

    (check-true (bytevector? #u8()))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|make-bytevector><index|make-bytevector>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define make-bytevector make-byte-vector)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (make-bytevector 3 0) =\<gtr\> #u8(0 0 0))

    (check (make-bytevector 3 3) =\<gtr\> #u8(3 3 3))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|bytevector-length><index|bytevector-length>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector-length length)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|bytevector-u8-ref><index|bytevector-u8-ref>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector-u8-ref byte-vector-ref)

    \;
  </scm-chunk>

  \;

  <value|r7rs><paragraph|bytevector-u8-set!><index|bytevector-u8-set!>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector-u8-set! byte-vector-set!)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|bytevector-append><index|bytevector-append>

  <subparagraph|实现>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define bytevector-append append)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (bytevector-append #u8() #u8()) =\<gtr\> #u8())

    (check (bytevector-append #u8() #u8(1)) =\<gtr\> #u8(1))

    (check (bytevector-append #u8(1) #u8()) =\<gtr\> #u8(1))

    \;
  </scm-chunk>

  <paragraph|u8-string-length><index|u8-string-length>

  <value|r7rs><paragraph|utf8-\<gtr\>string><index|utf8-\<gtr\>string>

  <value|r7rs><paragraph|string-\<gtr\>utf8><index|string-\<gtr\>utf8>

  <paragraph|u8-substring><index|u8-substring>

  这三个函数依赖于一样的公共子函数，故而放在一起实现。

  <subparagraph|公共子函数>

  首先定义公共子函数<scm|bytevector-advance-u8>：<scm|(bv index end) =\<gtr\> index>。

  <\enumerate>
    <item>当前位置超过指定的开区间的结尾时，直接返回当前位置

    <item>当前位置是非法位置，直接返回当前位置

    <item>当前位置是合法位置，返回下一个位置
  </enumerate>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define* (bytevector-advance-u8 bv index (end (length bv)))

    \ \ (if (\<gtr\>= index end)

    \ \ \ \ \ \ index \ ; Reached the end without errors, sequence is valid

    \ \ \ \ \ \ (let ((byte (bv index)))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ ;; 1-byte sequence (0xxxxxxx)

    \ \ \ \ \ \ \ \ \ ((\<less\> byte #x80)

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

    \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ ;; 2-byte sequence (110xxxxx 10xxxxxx)

    \ \ \ \ \ \ \ \ \ ((\<less\> byte #xe0)

    \ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= (+ index 1) end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Incomplete sequence

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((next-byte (bv (+ index 1))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (not (= (logand next-byte #xc0) #x80))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Invalid continuation byte

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ index 2)))))

    \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ ;; 3-byte sequence (1110xxxx 10xxxxxx 10xxxxxx)

    \ \ \ \ \ \ \ \ \ ((\<less\> byte #xf0)

    \ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= (+ index 2) end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Incomplete sequence

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((next-byte1 (bv (+ index 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (next-byte2 (bv (+ index 2))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (not (= (logand next-byte1 #xc0) #x80))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (= (logand next-byte2 #xc0) #x80)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Invalid continuation byte(s)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ index 3)))))

    \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ ;; 4-byte sequence (11110xxx 10xxxxxx 10xxxxxx 10xxxxxx)

    \ \ \ \ \ \ \ \ \ ((\<less\> byte #xf8)

    \ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= (+ index 3) end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Incomplete sequence

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((next-byte1 (bv (+ index 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (next-byte2 (bv (+ index 2)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (next-byte3 (bv (+ index 3))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (not (= (logand next-byte1 #xc0) #x80))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (= (logand next-byte2 #xc0) #x80))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (= (logand next-byte3 #xc0) #x80)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ index \ ; Invalid continuation byte(s)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ index 4)))))

    \ \ \ \ \ \ \ \ \ (else index))))) \ ; Invalid leading byte

    \;
  </scm-chunk>

  <subparagraph|实现u8-string-length>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (u8-string-length str)

    \ \ (let ((bv (string-\<gtr\>byte-vector str))

    \ \ \ \ \ \ \ \ (N (string-length str)))

    \ \ \ \ (let loop ((pos 0) (cnt 0))

    \ \ \ \ \ \ (let ((next-pos (bytevector-advance-u8 bv pos N)))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ ((= next-pos N)

    \ \ \ \ \ \ \ \ \ \ (+ cnt 1))

    \ \ \ \ \ \ \ \ \ ((= next-pos pos)

    \ \ \ \ \ \ \ \ \ \ (error 'value-error "Invalid UTF-8 sequence at index: " pos))

    \ \ \ \ \ \ \ \ \ (else (loop next-pos (+ cnt 1))))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (u8-string-length "中文") =\<gtr\> 2)

    \;
  </scm-chunk>

  <subparagraph|实现utf8-\<gtr\>string>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define* (utf8-\<gtr\>string bv (start 0) (end (bytevector-length bv)))

    \ \ (if (or (\<less\> start 0) (\<gtr\> end (bytevector-length bv)) (\<gtr\> start end))

    \ \ \ \ \ \ (error 'out-of-range start end)

    \ \ \ \ \ \ (let loop ((pos start))

    \ \ \ \ \ \ \ \ (let ((next-pos (bytevector-advance-u8 bv pos end)))

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

    \ \ \ \ \ \ \ \ \ \ \ ((= next-pos end)

    \ \ \ \ \ \ \ \ \ \ \ \ (copy bv (make-string (- end start)) start end))

    \ \ \ \ \ \ \ \ \ \ \ ((= next-pos pos)

    \ \ \ \ \ \ \ \ \ \ \ \ (error 'value-error "Invalid UTF-8 sequence at index: " pos))

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

    \ \ \ \ \ \ \ \ \ \ \ \ (loop next-pos)))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (utf8-\<gtr\>string <code|<code*|(bytevector #x48 #x65 #x6C #x6C #x6F)>>) =\<gtr\> "Hello")

    (check (utf8-\<gtr\>string #u8(#xC3 #xA4)) =\<gtr\> "ä")

    (check (utf8-\<gtr\>string #u8(#xE4 #xB8 #xAD)) =\<gtr\> "中")

    (check (utf8-\<gtr\>string #u8(#xF0 #x9F #x91 #x8D)) =\<gtr\> "👍")

    \;

    (check-catch 'value-error (utf8-\<gtr\>string (bytevector #xFF #x65 #x6C #x6C #x6F)))

    \;
  </scm-chunk>

  \;

  <subparagraph|实现string-\<gtr\>utf8>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define* (string-\<gtr\>utf8 str (start 0) (end #t))

    \ \ ; start \<less\> end in this case

    \ \ (define (string-\<gtr\>utf8-sub str start end)

    \ \ \ \ (let ((bv (string-\<gtr\>byte-vector str))

    \ \ \ \ \ \ \ \ \ \ (N (string-length str)))

    \ \ \ \ \ \ (let loop ((pos 0) (cnt 0) (start-pos 0))

    \ \ \ \ \ \ \ \ (let ((next-pos (bytevector-advance-u8 bv pos N)))

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

    \ \ \ \ \ \ \ \ \ \ \ ((and (not (zero? start)) (zero? start-pos) (= cnt start))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop next-pos (+ cnt 1) pos))

    \ \ \ \ \ \ \ \ \ \ \ ((and (integer? end) (= cnt end))

    \ \ \ \ \ \ \ \ \ \ \ \ (copy bv (make-byte-vector (- pos start-pos)) start-pos pos))

    \ \ \ \ \ \ \ \ \ \ \ ((and end (= next-pos N))

    \ \ \ \ \ \ \ \ \ \ \ \ (copy bv (make-byte-vector (- N start-pos)) start-pos N))

    \ \ \ \ \ \ \ \ \ \ \ ((= next-pos pos)

    \ \ \ \ \ \ \ \ \ \ \ \ (error 'value-error "Invalid UTF-8 sequence at index: " pos))

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

    \ \ \ \ \ \ \ \ \ \ \ \ (loop next-pos (+ cnt 1) start-pos)))))))

    \ \ 

    \ \ (when (not (string? str))

    \ \ \ \ (error 'type-error "str must be string"))

    \ \ (let ((N (u8-string-length str)))

    \ \ \ \ (when (or (\<less\> start 0) (\<gtr\>= start N))

    \ \ \ \ \ \ \ \ (error 'out-of-range

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append "start must \<gtr\>= 0 and \<less\> " (number-\<gtr\>string N))))

    \ \ \ \ (when (and (integer? end) (or (\<less\> end 0) (\<gtr\>= end (+ N 1))))

    \ \ \ \ \ \ \ \ \ \ (error 'out-of-range

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append "end must \<gtr\>= 0 and \<less\> " (number-\<gtr\>string (+ N 1))))) \ \ \ \ \ \ \ \ 

    \ \ \ \ (when (and (integer? end) (\<gtr\> start end))

    \ \ \ \ \ \ \ \ \ \ (error 'out-of-range "start \<less\>= end failed" start end))

    \ \ \ \ 

    \ \ \ \ (if (and (integer? end) (= start end))

    \ \ \ \ \ \ (byte-vector)

    \ \ \ \ \ \ (string-\<gtr\>utf8-sub str start end))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-\<gtr\>utf8 "Hello") =\<gtr\> (bytevector #x48 #x65 #x6C #x6C #x6F))

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "Hello" 1 2)) =\<gtr\> "e")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "Hello" 0 2)) =\<gtr\> "He")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "Hello" 2)) =\<gtr\> "llo")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "Hello" 2 5)) =\<gtr\> "llo")

    \;

    (check-catch 'out-of-range (string-\<gtr\>utf8 "Hello" 2 6))

    \;

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "汉字书写")) =\<gtr\> "汉字书写")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "汉字书写" 1)) =\<gtr\> "字书写")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "汉字书写" 2)) =\<gtr\> "书写")

    (check (utf8-\<gtr\>string (string-\<gtr\>utf8 "汉字书写" 3)) =\<gtr\> "写")

    \;

    (check-catch 'out-of-range (string-\<gtr\>utf8 "汉字书写" 4))

    \;

    (check (string-\<gtr\>utf8 "ä") =\<gtr\> #u8(#xC3 #xA4))

    (check (string-\<gtr\>utf8 "中") =\<gtr\> #u8(#xE4 #xB8 #xAD))

    (check (string-\<gtr\>utf8 "👍") =\<gtr\> #u8(#xF0 #x9F #x91 #x8D))

    \;
  </scm-chunk>

  <subparagraph|实现u8-substring>

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define* (u8-substring str (start 0) (end #t))

    \ \ (utf8-\<gtr\>string (string-\<gtr\>utf8 str start end)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (u8-substring "汉字书写" 0 1) =\<gtr\> "汉")

    (check (u8-substring "汉字书写" 0 4) =\<gtr\> "汉字书写")

    (check (u8-substring "汉字书写" 0) =\<gtr\> "汉字书写")

    \;
  </scm-chunk>

  <section|控制流>

  <paragraph|procedure?><index|procedure?>

  <paragraph|apply><index|apply>

  <scm|apply>是R7RS定义的函数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (apply + (list 3 4)) =\<gtr\> 7)

    (check (apply + (list 2 3 4)) =\<gtr\> 9)

    \;
  </scm-chunk>

  在这个例子中，<scm|(apply + (list 3 4))>实际被展开为<scm|(+ 3 4)>。<scm|+>这个函数接受两个参数，但是无法接受一个列表，利用<scm|apply>就可以把列表展开并作为<scm|+>的两个参数。

  <\big-figure|<scm|<tree|apply|+|(list 3 4)>><space|1em><math|\<Rightarrow\>><space|1em><scm|<tree|+|3|4>>>
    apply的原理可视化
  </big-figure>

  <paragraph|call-with-current-continuation>

  <paragraph|call/cc>

  <paragraph|values><index|values>

  <scm|values>是一个过程（procedure），它用于返回多个值。在 Scheme 中，通常的过程只能返回一个值，但是<scm|values>允许你从一个过程返回多个值，这些值可以被另一个过程接收并处理。

  当我们只传一个值给values时（比如 <code*|(values 4)>），它就简单地返回这个值，这时values的行为就像一个恒等函数。这是最简单的使用场景。

  如果调用<scm|values>时不带任何参数（即<scm|(values)>），它会返回一个空值。这种情况在实践中比较少见，但在某些特殊场合可能会用到。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (values 4) =\<gtr\> 4)

    (check (values) =\<gtr\> #\<less\>unspecified\<gtr\>)

    \;
  </scm-chunk>

  在金鱼Scheme中，<scm|values>的用法有一些特别之处，它允许将多个值直接插入到调用者的参数列表中。这种特性使得金鱼Scheme在处理多个返回值时非常灵活和强大。以下是<scm|values>在金鱼Scheme中的一些特殊用法（这些特殊用法源自于S7 Scheme）：

  <\description>
    <item*|直接插入到调用者参数列表>使用 <code*|values> 生成的多个值会被直接插入到调用者的参数列表中。这意味着，如果你有一个接受多个参数的函数，你可以直接从<scm|values>获得的多个值中解构这些参数。

    <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
      (check (+ (values 1 2 3) 4) =\<gtr\> 10)

      \;
    </scm-chunk>

    这里，<scm|values>生成的三个值<scm|(1 2 3)>被直接插入到 <code*|+> 函数的参数列表中，相当于<scm|(+ 1 2 3 4)>。

    <item*|与<scm|lambda>配合使用>当使用 <code*|lambda> 表达式时，<code*|values> 也可以直接将多个值插入到参数列表中：

    <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
      (check (string-ref ((lambda () (values "abcd" 2)))) =\<gtr\> #\\c)

      \;
    </scm-chunk>

    这里，<code*|values> 生成的字符串 <code*|"abcd"> 和整数 <code*|2> 被直接插入到 <code*|string-ref> 函数的参数列表中，相当于<goldfish-lang|(string-ref "abcd" 2)>。

    <item*|<scm|values>与<scm|call/cc>的隐式使用><code*|call/cc>（call with current continuation）是一个特殊的函数，它接受一个返回多个值的过程，并将其值作为参数传递给一个消费者。在金鱼Scheme中，<code*|call/cc> 有一个隐式的 <code*|values>，这意味着你可以直接返回多个值：

    <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
      (check (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) =\<gtr\> 10)

      \;
    </scm-chunk>

    这里，<code*|ret> 宏生成的多个值 <code*|(1 2 3)> 被 <code*|+> 函数接收并求和。
  </description>

  这些特性使得金鱼Scheme在处理多个返回值时非常灵活，允许程序员以一种直观和高效的方式编写代码。

  \;

  <value|r7rs><paragraph|call-with-values><scm|(producer consumer)>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (call-with-values (lambda () (values 4 5))

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

    \ \ \ \ \ \ \ =\<gtr\> 4)

    \;
  </scm-chunk>

  由于<scm|*>这个函数在没有参数时返回1，而<scm|->在只有一个参数的时候，返回该值的相反数。故而下面这个测试用例的返回值是<scm|-1>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (*) =\<gtr\> 1)

    (check (call-with-values * -) =\<gtr\> -1)

    \;
  </scm-chunk>

  <paragraph|receive><index|receive>

  官网：<slink|https://srfi.schemers.org/srfi-8/srfi-8.html>

  官网的参考实现是：

  <\scm-code>
    (define-syntax receive

    \ \ (syntax-rules ()

    \ \ \ \ ((receive formals expression body ...)

    \ \ \ \ \ (call-with-values (lambda () expression)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda formals body ...)))))
  </scm-code>

  但是S7 Scheme里面没有define-syntax和syntax-rule，在墨干中的实现是这样的：

  <\session|goldfish|default>
    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (define-macro (receive vars vals . body)

      \ \ `((lambda ,vars ,@body) ,vals)) ; GPL
    <|unfolded-io>
      receive
    </unfolded-io>

    <\folded-io>
      \<gtr\>\ 
    <|folded-io>
      (receive (a b) (values 1 2) (+ a b))
    <|folded-io>
      3
    </folded-io>

    <\folded-io>
      \<gtr\>\ 
    <|folded-io>
      ((lambda (a b) (+ a b)) 1 2)
    <|folded-io>
      3
    </folded-io>

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

  S7里面有<scm|call-with-values>，使用<scm|define-macro>就可以实现SRFI-8。

  <\scm-chunk|goldfish/srfi/srfi-8.scm|false|false>
    ;

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

    ;

    \;

    (define-library (srfi srfi-8)

    (export receive) \ \ \ \ \ \ \ \ \ \ \ \ \ 

    (begin

    \;

    (define-macro (receive formals expression . body)

    \ \ `(call-with-values

    \ \ \ \ (lambda () (values ,expression))

    \ \ \ \ (lambda ,formals ,@body)))

    \;

    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \ \ (receive (a b) (values 1 2) (+ a b))

    \ \ =\<gtr\> 3)

    \;
  </scm-chunk>

  <paragraph|dynamic-wind>

  <section|异常处理>

  <paragraph|guard><index|guard>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (raise . args)

    \ \ (apply throw #t args))

    \;

    (define-macro (guard results . body)

    \ \ `(let ((,(car results)\ 

    \ \ \ \ \ \ \ \ \ \ (catch #t\ 

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,@body)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ (lambda (type info)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (pair? (*s7* 'catches))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda () (apply throw type info))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car info))))))

    \ \ \ \ \ (cond ,@(cdr results)

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

    \ \ \ \ \ \ \ \ \ \ \ \ (if (procedure? ,(car results))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (,(car results))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ,(car results))))))

    \;
  </scm-chunk>

  测试用例

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (guard (condition

    \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ (display "condition: ")

    \ \ \ \ \ \ \ \ \ \ (write condition)

    \ \ \ \ \ \ \ \ \ \ (newline)

    \ \ \ \ \ \ \ \ \ \ 'exception))

    \ \ (+ 1 (raise 'an-error)))

    ; PRINTS: condition: an-error

    \;

    (guard (condition

    \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ (display "something went wrong")

    \ \ \ \ \ \ \ \ \ \ (newline)

    \ \ \ \ \ \ \ \ \ \ 'dont-care))

    \ (+ 1 (raise 'an-error)))

    ; PRINTS: something went wrong

    \;
  </scm-chunk>

  <paragraph|read-error?><index|read-error?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (read-error? obj) (eq? (car obj) 'read-error))

    \;
  </scm-chunk>

  <paragraph|file-error?><index|file-error?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (file-error? obj) (eq? (car obj) 'io-error))

    \;
  </scm-chunk>

  <section|输入和输出>

  <subsection|端口>

  <paragraph|call-with-port><index|call-with-port>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (call-with-port port proc)

    \ \ (let ((res (proc port)))

    \ \ \ \ (if res (close-port port))

    \ \ \ \ res))

    \;
  </scm-chunk>

  <paragraph|input-port?><index|input-port?>

  S7内置函数。

  <paragraph|output-port?><index|output-port?>

  S7内置函数。

  <paragraph|port?><index|port?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (port? p) (or (input-port? p) (output-port? p)))

    \;
  </scm-chunk>

  <paragraph|textual-port?><index|textual-port?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define textual-port? port?)

    \;
  </scm-chunk>

  <paragraph|binary-port?><index|binary-port?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define binary-port? port?)

    \;
  </scm-chunk>

  <paragraph|input-port-open?><index|input-port-open?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (input-port-open? p) (not (port-closed? p)))

    \;
  </scm-chunk>

  <paragraph|output-port-open?><index|output-port-open?>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (output-port-open? p) (not (port-closed? p)))

    \;
  </scm-chunk>

  <paragraph|close-port><index|close-port>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (close-port p)

    \ \ (if (input-port? p)

    \ \ \ \ \ \ (close-input-port p)

    \ \ \ \ \ \ (close-output-port p)))

    \;
  </scm-chunk>

  <paragraph|close-input-port><index|close-input-port>

  S7内置函数。

  <paragraph|close-output-port><index|close-output-port>

  S7内置函数。

  <subsection|输入>

  <value|r7rs><paragraph|read><index|read>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (with-input-from-string "(+ 1 2)"

    \ \ (lambda ()

    \ \ \ \ (let ((datum (read)))\ 

    \ \ \ \ \ \ (check-true (list? datum))

    \ \ \ \ \ \ (check datum =\<gtr\> '(+ 1 2)))))

    \;
  </scm-chunk>

  <paragraph|read-char>

  <paragraph|peek-char>

  <paragraph|read-line>

  <paragraph|eof-object?>

  <paragraph|eof-object><index|eof-object>

  <subparagraph|实现>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (eof-object) #\<less\>eof\<gtr\>)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (eof-object) =\<gtr\> #\<less\>eof\<gtr\>)

    \;
  </scm-chunk>

  <paragraph|char-ready?>

  <paragraph|read-string>

  <paragraph|read-u8>

  <paragraph|peek-u8>

  <paragraph|u8-ready?>

  <paragraph|read-bytevector>

  <paragraph|read-bytevector!>

  <subsection|输出>

  <section|系统接口>

  <section|三鲤扩展函数>

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

  <scm|equal?>的语法糖。

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define == equal?)

    \;
  </scm-chunk>

  \;

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

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

    \;
  </scm-chunk>

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

  语法糖。

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

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

    \;
  </scm-chunk>

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

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

    \;
  </scm-chunk>

  \;

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

  <scm|display*>可以输入多个参数，是<scm|display>的加强版。

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

    \ \ (for-each display params))

    \;
  </scm-chunk>

  \;

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

    \ \ (with-output-to-string

    \ \ \ \ (lambda ()

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

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

    \;
  </scm-chunk>

  <paragraph|in?><index|in?><scm|(x sequence) =\<gtr\> bool>

  判断一个元素是否在对象中：

  <\enumerate>
    <item>一个元素是否在列表中

    <item>一个元素是否在向量中

    <item>一个字符是否在字符串中
  </enumerate>

  其中的相等性判断使用的是<scm|==>，也就是R7RS定义的<scm|equal?>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (in? 1 (list )) =\<gtr\> #f)

    (check (in? 1 (list 3 2 1)) =\<gtr\> #t)

    (check (in? #\\x "texmacs") =\<gtr\> #t)

    (check (in? 1 (vector )) =\<gtr\> #f)

    (check (in? 1 (vector 3 2 1)) =\<gtr\> #t)

    (check-catch 'type-error (in? 1 "123"))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define (in? elem l)

    \ \ (cond ((list? l) (not (not (member elem l))))

    \ \ \ \ \ \ \ \ ((vector? l)

    \ \ \ \ \ \ \ \ \ (let loop ((i (- (vector-length l) 1)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #f

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (== elem (vector-ref l i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (- i 1))))))

    \ \ \ \ \ \ \ \ ((and (char? elem) (string? l))

    \ \ \ \ \ \ \ \ \ (in? elem (string-\<gtr\>list l)))

    \ \ \ \ \ \ \ \ (else (error 'type-error "type mismatch"))))

    \;
  </scm-chunk>

  <paragraph|let1><index|let1>

  let的语法嵌套层次太多了，故而引入let1，作为let的单参数版本，简化语法。

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define-macro (let1 name1 value1 . body)

    \ \ `(let ((,name1 ,value1))

    \ \ \ \ \ ,@body))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (let1 x 1 x) =\<gtr\> 1)

    (check (let1 x 1 (+ x 1)) =\<gtr\> 2)

    \;
  </scm-chunk>

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

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define identity (lambda (x) x))

    \;
  </scm-chunk>

  <paragraph|compose><index|compose><scm|(f g ...) =\<gtr\> f>

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    (define (compose . fs)

    \ \ (if (null? fs)

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

    \ \ \ \ \ \ (lambda (x)

    \ \ \ \ \ \ \ \ ((car fs) ((apply compose (cdr fs)) x)))))

    \ \ 
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true ((compose not zero?) 1))

    (check-false ((compose not zero?) 0))

    \;
  </scm-chunk>

  <paragraph|lambda*><index|lambda*>

  S7 Scheme内置宏。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (let1 add1/add (lambda* (x (y 1)) (+ x y))

    \ \ (check (add1/add 1) =\<gtr\> 2)

    \ \ (check (add1/add 0) =\<gtr\> 1)

    \ \ (check (add1/add 1 2)=\<gtr\> 3))

    \;
  </scm-chunk>

  <paragraph|typed-lambda><index|typed-lambda>

  <subparagraph|实现>

  <\scm-chunk|goldfish/liii/base.scm|true|true>
    ; 0 clause BSD, from S7 repo stuff.scm

    (define-macro (typed-lambda args . body)

    \ \ ; (typed-lambda ((var [type])...) ...)

    \ \ (if (symbol? args)

    \ \ \ \ \ \ (apply lambda args body)

    \ \ \ \ \ \ (let ((new-args (copy args)))

    \ \ \ \ \ \ \ \ (do ((p new-args (cdr p)))

    \ \ \ \ \ \ \ \ \ \ \ \ ((not (pair? p)))

    \ \ \ \ \ \ \ \ \ \ (if (pair? (car p))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-car! p (caar p))))

    \ \ \ \ \ \ \ \ `(lambda ,new-args

    \ \ \ \ \ \ \ \ \ \ \ ,@(map (lambda (arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (pair? arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(unless (,(cadr arg) ,(car arg))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "~S is not ~S~%" ',(car arg) ',(cadr arg)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ args)

    \ \ \ \ \ \ \ \ \ \ \ ,@body))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (define add3

    \ \ (typed-lambda

    \ \ \ \ ((i integer?) (x real?) z)

    \ \ \ \ (+ i x z)))

    \;

    (check (add3 1 2 3) =\<gtr\> 6)

    (check-catch 'type-error (add3 1.2 2 3))

    \;
  </scm-chunk>

  \;

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

  \;

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

    \;
  </scm-chunk>

  <chapter|(liii error)>

  异常的命名参考Python标准库的<hlink|内置异常|https://docs.python.org/3/library/exceptions.html>。

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    ; see https://docs.python.org/3/library/exceptions.html#exception-hierarchy

    (define-library (liii error)

    (export ???

    \ \ os-error file-not-found-error not-a-directory-error file-exists-error

    \ \ timeout-error type-error type-error? key-error value-error)

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (liii base))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|os-error><index|os-error>

  系统级别的错误。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (os-error . args)

    \ \ (apply error (cons 'os-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'os-error (os-error))

    \;
  </scm-chunk>

  <paragraph|file-not-found-error><index|file-not-found-error>

  文件未找到。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (file-not-found-error . args)

    \ \ (apply error (cons 'file-not-found-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'file-not-found-error (file-not-found-error))

    \;
  </scm-chunk>

  <paragraph|not-a-directory-error><index|not-a-directory-error>

  不是一个目录。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (not-a-directory-error . args)

    \ \ (apply error (cons 'not-a-directory-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'not-a-directory-error (not-a-directory-error))

    \;
  </scm-chunk>

  <paragraph|file-exists-error><index|file-exists-error>

  文件已存在。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (file-exists-error . args)

    \ \ (apply error (cons 'file-exists-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'file-exists-error (file-exists-error))

    \;
  </scm-chunk>

  <paragraph|timeout-error><index|timeout-error>

  超时错误。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (timeout-error . args)

    \ \ (apply error (cons 'timeout-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'timeout-error (timeout-error))

    \;
  </scm-chunk>

  <paragraph|type-error><index|type-error>

  如果类型不匹配，直接报错。

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (type-error . args)

    \ \ (apply error (cons 'type-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'type-error (type-error))

    (check-catch 'type-error (type-error "msg"))

    (check-catch 'type-error (type-error "msg" "msg2"))

    \;
  </scm-chunk>

  <paragraph|type-error?><index|type-error?>

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (type-error? err)

    \ \ (in? err `(type-error wrong-type-arg)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-true (type-error? 'type-error))

    (check-true (type-error? 'wrong-type-arg))

    \;
  </scm-chunk>

  <paragraph|key-error><index|key-error>

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (key-error . args)

    \ \ (apply error (cons 'key-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'key-error (key-error))

    \;
  </scm-chunk>

  <paragraph|value-error><index|value-error>

  值不正确

  <\scm-chunk|goldfish/liii/error.scm|true|true>
    (define (value-error . args)

    \ \ (apply error (cons 'value-error args)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'value-error (value-error))

    \;
  </scm-chunk>

  <paragraph|???><index|???>

  Scala风格未实现错误，一般用于标记为实现的接口。

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

    \ \ (error 'not-implemented-error "???"))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/error-test.scm|true|true>
    (check-catch 'not-implemented-error (???))

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/liii/error.scm|true|false>
    ) ; begin

    ) ; define-library

    \;
  </scm-chunk>

  \;

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

    \;
  </scm-chunk>

  <chapter|(liii check)>

  <section|协议>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-78.scm|false|true>
    ; \<less\>PLAINTEXT\<gtr\>

    ; Copyright (c) 2005-2006 Sebastian Egner.

    ;\ 

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

    ; a copy of this software and associated documentation files (the

    ; ''Software''), to deal in the Software without restriction, including

    ; without limitation the rights to use, copy, modify, merge, publish,

    ; distribute, sublicense, and/or sell copies of the Software, and to

    ; permit persons to whom the Software is furnished to do so, subject to

    ; the following conditions:

    ;\ 

    ; The above copyright notice and this permission notice shall be

    ; included in all copies or substantial portions of the Software.

    ;\ 

    ; THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,

    ; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF

    ; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

    ; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

    ; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

    ; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

    ; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

    ;\ 

    ; -----------------------------------------------------------------------

    ;\ 

    ; Lightweight testing (reference implementation)

    ; ==============================================

    ;

    ; Sebastian.Egner@philips.com

    ; in R5RS + SRFI 23 (error) + SRFI 42 (comprehensions)

    ;

    ; history of this file:

    ; \ \ SE, 25-Oct-2004: first version based on code used in SRFIs 42 and 67

    ; \ \ SE, 19-Jan-2006: (arg ...) made optional in check-ec

    ;

    ; Naming convention "check:\<less\>identifier\<gtr\>" is used only internally.

    ;

    ; Copyright (c) 2024 The Goldfish Scheme Authors

    ; Follow the same License as the original one

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/srfi/srfi-78-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.

    ;

    \;
  </scm-chunk>

  \;

  <section|接口>

  将<scm|check:proc>导出的原因是<scm|check>是使用宏实现的，而宏里面用到了<scm|check:proc>，不导出无法生效。

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

    (export test check check-set-mode! check:proc

    \ \ check-catch check-report check-failed?

    \ \ check-true check-false)

    (import (srfi srfi-78)

    \ \ \ \ \ \ \ \ (rename (srfi srfi-78)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check-report srfi-78-check-report)))

    (begin

    \;
  </scm-chunk>

  \;

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define-library (srfi srfi-78)

    (export check check-set-mode! check-report check-reset!

    \ \ \ \ \ \ \ \ check-passed? check-failed?

    \ \ \ \ \ \ \ \ check:proc)

    (begin

    \;
  </scm-chunk>

  \;

  \;

  \;

  <section|实现>

  使用display作为测试结果的展示函数，比write好，因为display可以正常显示文本中的汉字。

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define check:write display)

    \;
  </scm-chunk>

  <paragraph|check-set-mode!><index|check-set-mode!>

  \;

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define check:mode #f)

    \;

    (define (check-set-mode! mode)

    \ \ (set! check:mode

    \ \ \ \ \ \ \ \ (case mode

    \ \ \ \ \ \ \ \ \ \ ((off) \ \ \ \ \ \ \ \ \ \ 0)

    \ \ \ \ \ \ \ \ \ \ ((summary) \ \ \ \ \ \ 1)

    \ \ \ \ \ \ \ \ \ \ ((report-failed) 10)

    \ \ \ \ \ \ \ \ \ \ ((report) \ \ \ \ \ \ \ 100)

    \ \ \ \ \ \ \ \ \ \ (else (error "unrecognized mode" mode)))))

    \;

    \;
  </scm-chunk>

  将检查模式初始化为<scm|'report>：

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (check-set-mode! 'report)

    \;
  </scm-chunk>

  以<scm|check>函数为例，不同的检查模式下，得到的结果不同。可以使用单元测试来查看这四种测试用例具体使用方法：

  <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|true>
    (import (srfi srfi-78))

    \;
  </scm-chunk>

  <\description>
    <item*|report>默认检查模式，无论正确还是错误，都会展示详细的信息。

    <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|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.

      ;

      \;

      (display "----------\\n")

      (display "check mode: report\\n")

      \;

      (check-set-mode! 'report)

      \;

      (check (+ 1 2) =\<gtr\> 3)

      \;

      (check (+ 1 2) =\<gtr\> 4)

      \;

      (check-reset!)

      \;
    </scm-chunk>

    <item*|off>设置为off的时候，禁用后续的测试用例。

    <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|true>
      (display "\\n----------\\n")

      (display "check mode: off\\n")

      \;

      (check-set-mode! 'off)

      \;

      (check (+ 1 2) =\<gtr\> 3)

      \;

      (check (+ 1 2) =\<gtr\> 4)

      \;

      (check-reset!)

      \;
    </scm-chunk>

    <item*|report-failed>设置为report-failed的时候，在check正确时只返回正确的测试数量，在check错误时，显示错误。

    <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|true>
      (display "\\n----------\\n")

      (display "check mode: report-failed\\n")

      \;

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

      \;

      (check (+ 1 2) =\<gtr\> 3)

      \;

      (check (+ 1 2) =\<gtr\> 4)

      \;

      (check-reset!)

      \;
    </scm-chunk>

    <item*|summary>设置为summary的时候，不汇报错误，需要显示调用<scm|check-report>才能显示的测试汇总结果，显式调用<scm|check:failed>显式查看错误的例子。

    <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|true>
      (display "\\n----------\\n")

      (display "check mode: summary\\n")

      \;

      (check-set-mode! 'summary)

      \;

      (check (+ 1 2) =\<gtr\> 3)

      \;

      (check (+ 1 2) =\<gtr\> 4)

      \;

      (check-report)

      \;
    </scm-chunk>

    这个时候如果需要查看错误，那么可以重新设置检查模式，重新检查报告：

    <\scm-chunk|tests/goldfish/srfi/srfi-78-test.scm|true|false>
      (check-set-mode! 'report)

      \;

      (check-report)

      \;
    </scm-chunk>
  </description>

  <paragraph|check-failed?><index|check-failed?>

  \;

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define check:correct 0)

    (define check:failed '())

    \;

    (define (check-reset!)

    \ \ (set! check:correct 0)

    \ \ (set! check:failed '()))

    \;

    (define (check:add-correct!)

    \ \ (set! check:correct (+ check:correct 1)))

    \;

    (define (check:add-failed! expression actual-result expected-result)

    \ \ (set! check:failed

    \ \ \ \ \ \ \ \ (cons (list expression actual-result expected-result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ check:failed)))

    \;
  </scm-chunk>

  \;

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define (check:report-expression expression)

    \ \ (newline)

    \ \ (check:write expression)

    \ \ (display " =\<gtr\> "))

    \;

    (define (check:report-actual-result actual-result)

    \ \ (check:write actual-result)

    \ \ (display " ; "))

    \;

    (define (check:report-correct cases)

    \ \ (display "correct")

    \ \ (if (not (= cases 1))

    \ \ \ \ \ \ (begin (display " (")

    \ \ \ \ \ \ \ \ \ \ \ \ \ (display cases)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (display " cases checked)")))

    \ \ (newline))

    \;

    (define (check:report-failed expected-result)

    \ \ (display "*** failed ***")

    \ \ (newline)

    \ \ (display "; expected result: ")

    \ \ (check:write expected-result)

    \ \ (newline))

    \;

    (define (check-passed? expected-total-count)

    \ \ (and (= (length check:failed) 0)

    \ \ \ \ \ \ \ (= check:correct expected-total-count)))

    \;

    (define (check-failed?)

    \ \ (\<gtr\>= (length check:failed) 1))

    \;
  </scm-chunk>

  <paragraph|check><index|check>

  check的具体过程，依据不同的检查模式，做不同的处理：

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define (check:proc expression thunk equal expected-result)

    \ \ (case check:mode

    \ \ \ \ ((0) #f)

    \ \ \ \ ((1)

    \ \ \ \ \ (let ((actual-result (thunk)))

    \ \ \ \ \ \ \ (if (equal actual-result expected-result)

    \ \ \ \ \ \ \ \ \ \ \ (check:add-correct!)

    \ \ \ \ \ \ \ \ \ \ \ (check:add-failed! expression actual-result expected-result))))

    \ \ \ \ ((10)

    \ \ \ \ \ (let ((actual-result (thunk)))

    \ \ \ \ \ \ \ (if (equal actual-result expected-result)

    \ \ \ \ \ \ \ \ \ \ \ (check:add-correct!)

    \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-expression expression)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-actual-result actual-result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-failed expected-result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (check:add-failed! expression actual-result expected-result)))))

    \ \ \ \ ((100)

    \ \ \ \ \ (check:report-expression expression)

    \ \ \ \ \ (let ((actual-result (thunk)))

    \ \ \ \ \ \ \ (check:report-actual-result actual-result)

    \ \ \ \ \ \ \ (if (equal actual-result expected-result)

    \ \ \ \ \ \ \ \ \ \ \ (begin (check:report-correct 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check:add-correct!))

    \ \ \ \ \ \ \ \ \ \ \ (begin (check:report-failed expected-result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check:add-failed! expression\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ actual-result\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ expected-result)))))

    \ \ \ \ (else (error "unrecognized check:mode" check:mode))))

    \;
  </scm-chunk>

  check的接口实现，使用S7 Scheme的<scm|define-macro>实现：

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define-macro (check expr =\<gtr\> expected)

    \ \ `(check:proc ',expr (lambda () ,expr) equal? ,expected))

    \;
  </scm-chunk>

  <paragraph|check-true><index|check-true>

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

    \ \ `(check ,body =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|check-false><index|check-false>

  <\scm-chunk|goldfish/liii/check.scm|true|true>
    (define-macro (check-false body)

    \ \ `(check ,body =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|check-catch><index|check-catch>

  <\scm-chunk|goldfish/liii/check.scm|true|true>
    (define-macro (check-catch error-id body)

    \ \ `(check

    \ \ \ \ (catch ,error-id

    \ \ \ \ \ \ (lambda () ,body)

    \ \ \ \ \ \ (lambda args ,error-id))

    \ \ \ \ \ \ =\<gtr\> ,error-id))

    \;
  </scm-chunk>

  <paragraph|test><index|test><scm|(obj1 obj2) =\<gtr\> boolean>

  <scm|test>函数是为了兼容S7 Scheme仓库里面的测试用例。

  <\scm-chunk|goldfish/liii/check.scm|true|true>
    (define-macro (test left right)

    \ \ `(check ,left =\<gtr\> ,right))

    \;
  </scm-chunk>

  <paragraph|check-report><index|check-report>

  <\scm-chunk|goldfish/liii/check.scm|true|true>
    (define (check-report . msg)

    \ \ (if (not (null? msg))

    \ \ \ \ (begin

    \ \ \ \ \ \ (display (car msg))))

    \ \ (srfi-78-check-report)

    \ \ (if (check-failed?) (exit -1)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|true>
    (define (check-report)

    \ \ (if (\<gtr\>= check:mode 1)

    \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ (newline)

    \ \ \ \ \ \ \ \ (display "; *** checks *** : ")

    \ \ \ \ \ \ \ \ (display check:correct)

    \ \ \ \ \ \ \ \ (display " correct, ")

    \ \ \ \ \ \ \ \ (display (length check:failed))

    \ \ \ \ \ \ \ \ (display " failed.")

    \ \ \ \ \ \ \ \ (if (or (null? check:failed) (\<less\>= check:mode 1))

    \ \ \ \ \ \ \ \ \ \ \ \ (newline)

    \ \ \ \ \ \ \ \ \ \ \ \ (let* ((w (car (reverse check:failed)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (expression (car w))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (actual-result (cadr w))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (expected-result (caddr w)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (display " First failed example:")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (newline)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-expression expression)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-actual-result actual-result)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (check:report-failed expected-result))))))

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/srfi/srfi-78.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    ) ; end of define-library

    \;
  </scm-chunk>

  <chapter|(scheme case-lambda)>

  <section|协议>

  <\scm-chunk|tests/goldfish/scheme/case-lambda-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  在Scheme语言中，<scm|case-lambda>是一种特殊的lambda表达式，它可以根据不同数量的参数执行不同的代码块。<scm|case-lambda>允许你定义一个函数，这个函数根据传入参数的数量来选择执行不同的lambda表达式。

  \;

  下面是一个使用<scm|case-lambda>的示例：

  <\scm-chunk|tests/goldfish/scheme/case-lambda-test.scm|true|false>
    (import (liii list)

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (scheme case-lambda))

    \;

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

    \;

    (define (my-func . args)

    \ \ (case-lambda

    \ \ \ \ (() "zero args")

    \ \ \ \ ((x) (+ x x))

    \ \ \ \ ((x y) (+ x y))

    \ \ \ \ ((x y . rest) (reduce + 0 (cons x (cons y rest))))))

    \;

    (check ((my-func)) =\<gtr\> "zero args")

    (check ((my-func) 2) =\<gtr\> 4)

    (check ((my-func) 3 4) =\<gtr\> 7)

    (check ((my-func) 1 2 3 4) =\<gtr\> 10)

    \;

    (check-report)

    \;
  </scm-chunk>

  <section|实现>

  <\scm-chunk|goldfish/scheme/case-lambda.scm|false|false>
    ; 0-clause BSD

    ; Bill Schottstaedt

    ; from S7 source repo: r7rs.scm

    \;

    (define-library (scheme case-lambda)

    (export case-lambda)

    (begin

    \;

    ;; case-lambda \ \ \ \ \ \ 

    (define-macro (case-lambda . choices)

    \ \ `(lambda args

    \ \ \ \ \ (case (length args)

    \ \ \ \ \ \ \ ,@(map (lambda (choice)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (symbol? (car choice))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (negative? (length (car choice))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(else (apply (lambda ,(car choice) ,@(cdr choice)) args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((,(length (car choice)))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply (lambda ,(car choice) ,@(cdr choice)) args))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ choices))))

    \;

    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <chapter|(liii cut)>

  <section|许可证>

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

  \;

  <\goldfish-chunk|goldfish/srfi/srfi-26.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|接口>

  <\goldfish-chunk|goldfish/srfi/srfi-26.scm|true|true>
    (define-library (srfi srfi-26)

    (export cut cute)

    (import (liii list)

    \ \ \ \ \ \ \ \ (liii error))

    (begin

    \;
  </goldfish-chunk>

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

    \ \ (import (srfi srfi-26))

    \ \ (export cut cute))

    \;
  </goldfish-chunk>

  <section|测试>

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

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

    \;

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

    \;

    (check ((cut list \<less\>\<gtr\> 'y \<less\>\<gtr\>) 'x 'z) =\<gtr\> '(x y z))

    (check ((cut + 1 \<less\>...\<gtr\>) 2 3) =\<gtr\> 6)

    (check ((cut + 1 \<less\>...\<gtr\>)) =\<gtr\> 1)

    (check ((cut \<less\>\<gtr\> 1 \<less\>...\<gtr\>) + 2 3) =\<gtr\> 6)

    (check ((cut list \<less\>\<gtr\> \<less\>\<gtr\> \<less\>...\<gtr\>) 1 2 3) =\<gtr\> '(1 2 3))

    (check ((cut list \<less\>\<gtr\> \<less\>\<gtr\> \<less\>...\<gtr\>) 1 2) =\<gtr\> '(1 2))

    (check ((cut + 1 2)) =\<gtr\> 3)

    (check ((cut \<less\>\<gtr\>) list) =\<gtr\> ())

    (check ((cut)) =\<gtr\> ())

    (check ((cut \<less\>\<gtr\> #t \<less\>...\<gtr\>) if 1 0) =\<gtr\> 1)

    \;

    (check-catch 'wrong-number-of-args ((cut list \<less\>\<gtr\> \<less\>\<gtr\>) 1))

    (check-catch 'wrong-number-of-args ((cut list \<less\>\<gtr\> \<less\>\<gtr\> \<less\>...\<gtr\>) 1))

    (check-catch 'syntax-error ((cut list \<less\>\<gtr\> \<less\>\<gtr\> \<less\>...\<gtr\> \<less\>\<gtr\>) 1 2 3))

    \;

    (let* ((a 1)

    \ \ \ \ \ \ \ (f (cut \<less\>\<gtr\> (set! a 2))))

    \ \ (check a =\<gtr\> 1)

    \ \ (check (f (lambda (x) x)) =\<gtr\> 2)

    \ \ (check a =\<gtr\> 2))

    \;

    (let* ((a 1)

    \ \ \ \ \ \ \ (f (cute \<less\>\<gtr\> (set! a 2))))

    \ \ (check a =\<gtr\> 2)

    \ \ (set! a 1)

    \ \ (check (f (lambda (x) x)) =\<gtr\> 2)

    \ \ (check a =\<gtr\> 1))

    \;

    (check-report)

    \;
  </goldfish-chunk>

  <section|实现>

  <paragraph|cut>

  <\goldfish-chunk|goldfish/srfi/srfi-26.scm|true|true>
    (define-macro (cut . paras)

    \ \ (letrec*

    \ \ \ \ ((slot? (lambda (x) (equal? '\<less\>\<gtr\> x)))

    \ \ \ \ \ (more-slot? (lambda (x) (equal? '\<less\>...\<gtr\> x)))

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

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

    \ \ \ \ \ (xs (map (lambda (x) (gensym)) slots))

    \ \ \ \ \ (rest (gensym))

    \ \ \ \ \ (parse

    \ \ \ \ \ \ \ (lambda (xs paras)

    \ \ \ \ \ \ \ \ \ (cond

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

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

    \ \ \ \ \ \ \ \ \ \ \ ((more-slot? (car paras)) `(,rest ,@(parse xs (cdr paras))))

    \ \ \ \ \ \ \ \ \ \ \ ((slot? (car paras)) `(,(car xs) ,@(parse (cdr xs) (cdr paras))))

    \ \ \ \ \ \ \ \ \ \ \ (else `(,(car paras) ,@(parse xs (cdr paras))))))))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((null? more-slots)

    \ \ \ \ \ \ \ `(lambda ,xs ,(parse xs paras)))

    \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ (when

    \ \ \ \ \ \ \ \ \ \ (or (\<gtr\> (length more-slots) 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (more-slot? (last paras))))

    \ \ \ \ \ \ \ \ \ \ (error 'syntax-error "\<less\>...\<gtr\> must be the last parameter of cut"))

    \ \ \ \ \ \ \ \ (let ((parsed (parse xs paras)))

    \ \ \ \ \ \ \ \ \ \ `(lambda (,@xs . ,rest) (apply ,@parsed)))))))

    \;
  </goldfish-chunk>

  <paragraph|cute>

  <\goldfish-chunk|goldfish/srfi/srfi-26.scm|true|true>
    (define-macro (cute . paras)

    \ \ (letrec*

    \ \ \ \ ((slot? (lambda (x) (equal? '\<less\>\<gtr\> x)))

    \ \ \ \ \ (more-slot? (lambda (x) (equal? '\<less\>...\<gtr\> x)))

    \ \ \ \ \ (exprs (filter (lambda (x) (not (or (slot? x) (more-slot? x))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ paras))

    \ \ \ \ \ (xs (map (lambda (x) (gensym)) exprs))

    \ \ \ \ \ (lets (map list xs exprs))

    \ \ \ \ \ (parse

    \ \ \ \ \ \ \ (lambda (xs paras)

    \ \ \ \ \ \ \ \ \ (cond

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

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

    \ \ \ \ \ \ \ \ \ \ \ ((not (or (slot? (car paras)) (more-slot? (car paras))))

    \ \ \ \ \ \ \ \ \ \ \ \ `(,(car xs) ,@(parse (cdr xs) (cdr paras))))

    \ \ \ \ \ \ \ \ \ \ \ (else `(,(car paras) ,@(parse xs (cdr paras))))))))

    \ \ \ \ `(let ,lets (cut ,@(parse xs paras)))))

    \;
  </goldfish-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/srfi/srfi-26.scm|true|false>
    ) ; end of begin

    ) ; end of library

    \;
  </goldfish-chunk>

  <chapter|(liii case)>

  <scm|case*>克服了R7RS中<scm|case>无法处理字符串等的缺点。

  <section|测试>

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

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

    \;

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

    \;
  </scm-chunk>

  <paragraph|case*><index|case*>

  <\scm-chunk|tests/goldfish/liii/case-test.scm|true|true>
    ; 0 clause BSD, from S7 repo s7test.scm

    (define (scase x)

    \ \ (case* x

    \ \ \ \ ((a b) 'a-or-b)

    \ \ \ \ ((1 2/3 3.0) =\<gtr\> (lambda (a) (* a 2)))

    \ \ \ \ ((pi) 1 123)

    \ \ \ \ (("string1" "string2"))

    \ \ \ \ ((#\<less\>symbol?\<gtr\>) 'symbol!)

    \ \ \ \ (((+ x #\<less\>symbol?\<gtr\>)) 'got-list)

    \ \ \ \ ((#(1 x 3)) 'got-vector)

    \ \ \ \ (((+ #\<less\>\<gtr\>)) 'empty)

    \ \ \ \ (((* #\<less\>x:symbol?\<gtr\> #\<less\>x\<gtr\>)) 'got-label)

    \ \ \ \ (((#\<less\>\<gtr\> #\<less\>x:\<gtr\> #\<less\>x\<gtr\>)) 'repeated)

    \ \ \ \ (((#\<less\>symbol?\<gtr\> #\<less\>symbol?\<gtr\>)) 'two)

    \ \ \ \ (((#\<less\>x:\<gtr\> #\<less\>x\<gtr\>)) 'pair)

    \ \ \ \ ((#(#\<less\>x:\<gtr\> #\<less\>x\<gtr\>)) 'vector)

    \ \ \ \ ((#(#\<less\>symbol?\<gtr\> #\<less\>...\<gtr\> #\<less\>number?\<gtr\>)) 'vectsn)

    \ \ \ \ ((#(#\<less\>...\<gtr\> #\<less\>number?\<gtr\>)) 'vectstart)

    \ \ \ \ ((#(#\<less\>string?\<gtr\> #\<less\>char-whitespace?\<gtr\> #\<less\>...\<gtr\>)) 'vectstr)

    \ \ \ \ (else 'oops)))

    \;

    (test (scase 3.0) 6.0)

    (test (scase 'pi) 123)

    (test (scase "string1") "string1")

    (test (scase "string3") 'oops)

    (test (scase 'a) 'a-or-b)

    (test (scase 'abc) 'symbol!)

    (test (scase #()) 'oops)

    (test (scase '(+ x z)) 'got-list)

    (test (scase #(1 x 3)) 'got-vector)

    (test (scase '(+ x 3)) 'oops)

    (test (scase '(+ x)) 'empty)

    (test (scase '(* z z)) 'got-label)

    (test (scase '(* z x)) 'oops)

    (test (scase '(+ (abs x) (abs x))) 'repeated)

    (test (scase '(+ (abs x) (abs y))) 'oops)

    (test (scase '(a b)) 'two)

    (test (scase '(1 1)) 'pair)

    (test (scase '(1 1 2)) 'oops)

    (test (scase #(1 1)) 'vector)

    (test (scase #(a b c 3)) 'vectsn)

    (test (scase #(1 b 2)) 'vectstart)

    (test (scase #("asdf" #\\space +nan.0 #\<less\>eof\<gtr\>)) 'vectstr)

    (test (scase #(a 3)) 'vectsn)

    (test (scase #(1)) 'vectstart)

    (test (scase #("asdf" #\\space)) 'vectstr)

    (test (scase #("asdf")) 'oops)

    \;
  </scm-chunk>

  <section|结尾>

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

    \;
  </scm-chunk>

  <chapter|(liii list)><label|chapter:liii_list>

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|false|true>
    ;;; SRFI-1 list-processing library \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ -*- Scheme -*-

    ;;; Reference implementation

    ;;;

    ;;; SPDX-License-Identifier: MIT

    ;;;

    ;;; Copyright (c) 1998, 1999 by Olin Shivers. You may do as you please with

    ;;; this code as long as you do not remove this copyright notice or

    ;;; hold me liable for its use. Please send bug reports to shivers@ai.mit.edu.

    ;;; \ \ \ \ -Olin

    ;;;

    ;;; Copyright (c) 2024 The Goldfish Scheme Authors

    ;;; Follow the same License as the original one

    \;
  </scm-chunk>

  <section|接口>

  Liii List函数库是金鱼标准库中的List函数库，其中的大部分函数来自函数库<scm|(srfi srfi-1)>，小部分是三鲤自己设计的函数。来自SRFI 1的，我们只是在Liii List中导出相关函数名，相关实现和单元测试都在SRFI 1中维护。

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

    (export

    \ \ ; S7 built-in

    \ \ cons car cdr map for-each

    \ \ ; SRFI 1: Constructors

    \ \ circular-list iota list-copy

    \ \ ; SRFI 1: Predicates

    \ \ null-list? circular-list? proper-list? dotted-list?

    \ \ ; SRFI 1: Selectors

    \ \ first second third fourth fifth sixth seventh eighth ninth tenth

    \ \ take drop take-right drop-right split-at

    \ \ last-pair last

    \ \ ; SRFI 1: fold, unfold & map

    \ \ count fold fold-right reduce reduce-right

    \ \ filter partition remove append-map

    \ \ ; SRFI 1: Searching

    \ \ find any every list-index

    \ \ take-while drop-while

    \ \ ; SRFI 1: Deleting

    \ \ delete

    \ \ ; SRFI 1: Association List

    \ \ assoc assq assv alist-cons

    \ \ ; Liii List extensions

    \ \ list-view flatmap

    \ \ list-null? list-not-null? not-null-list?

    \ \ length=? length\<gtr\>? length\<gtr\>=? flatten

    )

    (import (srfi srfi-1)

    \ \ \ \ \ \ \ \ (liii error))

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define-library (srfi srfi-1)

    (import (liii error)

    \ \ \ \ \ \ \ \ (liii base))

    (export

    \ \ ; SRFI 1: Constructors

    \ \ circular-list iota list-copy\ 

    \ \ ; SRFI 1: Predicates

    \ \ circular-list? null-list? proper-list? dotted-list?

    \ \ ; SRFI 1: Selectors

    \ \ first second third fourth fifth

    \ \ sixth seventh eighth ninth tenth

    \ \ take drop take-right drop-right count fold fold-right split-at

    \ \ reduce reduce-right append-map filter partition remove find

    \ \ delete delete-duplicates

    \ \ ; SRFI 1: Association List

    \ \ assoc assq assv alist-cons

    \ \ take-while drop-while list-index any every

    \ \ last-pair last)

    (begin

    \;
  </scm-chunk>

  <section|测试>

  在金鱼Scheme中的SRFI 1实现需要遵循最小依赖原则，目前<scm|delete-duplicates>是一个复杂度比较高的实现，在SRFI 1中保留，但并不在<scm|(liii list)>导出，故而在本测试文件的开头需要从<scm|(srfi srfi-1)>单独导入。

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

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (only (srfi srfi-1) delete-duplicates))

    \;

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

    \;
  </scm-chunk>

  <section|SRFI-1>

  SRFI-1中有一部分函数已经在R7RS的<scm|(scheme base)>库里面了。本节包含了R7RS定义的<scm|(scheme base)>里面和列表相关的函数，这些函数的实现和测试均在<shell|base.scm>和<shell|base-test.scm>中维护。用户可以通过<scm|(import (liii base))>导入这些函数，或者使用<scm|(import (liii list))>导入这些函数。

  <subsection|构造器>

  <r7rs><paragraph|cons><index|cons>

  S7 Scheme内置的R7RS中定义的函数。

  <value|r7rs><paragraph|list><index|list>

  S7 Scheme内置的R7RS中定义的函数。

  <value|r7rs><paragraph|make-list><index|make-list><scm|(make-list k [fill]) =\<gtr\> list>

  S7 Scheme内置的R7RS中定义的函数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (make-list 3 #\\a) =\<gtr\> (list #\\a #\\a #\\a))

    (check (make-list 3) =\<gtr\> (list #f #f #f))

    \;

    (check (make-list 0) =\<gtr\> (list ))

    \;
  </scm-chunk>

  <paragraph|iota><index|iota>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    ; 0 clause BSD, from S7 repo stuff.scm

    (define* (iota n (start 0) (incr 1))

    \ \ (when (not (integer? n))

    \ \ \ \ (type-error "iota: n must be a integer"))

    \ \ (when (\<less\> n 0)

    \ \ \ \ (value-error "iota: n must be postive but received ~d" n))

    \ \ (let ((lst (make-list n)))

    \ \ \ \ (do ((p lst (cdr p))

    \ \ \ \ \ \ \ \ \ (i start (+ i incr)))

    \ \ \ \ \ \ ((null? p) lst)

    \ \ \ \ \ \ (set! (car p) i))))

    \;
  </scm-chunk>

  测试用例

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (iota 3) =\<gtr\> (list 0 1 2))

    (check (iota 3 7) =\<gtr\> (list 7 8 9))

    (check (iota 2 7 2) =\<gtr\> (list 7 9))

    \;

    (check-catch 'value-error (iota -1))

    (check-catch 'type-error (iota 'a))

    \;
  </scm-chunk>

  <paragraph|list-copy><index|list-copy>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0 clause BSD, from S7 repo r7rs.scm

    (define list-copy copy)

    \;
  </scm-chunk>

  测试用例

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

    \;

    ;; Check that copying an empty list works as expected

    (check (list-copy '()) =\<gtr\> '())

    \;

    ;; Check that copying a list of numbers works correctly

    (check (list-copy '(1 2 3 4 5)) =\<gtr\> '(1 2 3 4 5))

    \;

    ;; Check that copying a list of symbols works correctly

    (check (list-copy '(a b c d)) =\<gtr\> '(a b c d))

    \;

    ;; Check that copying nested lists works correctly

    (check (list-copy '((1 2) (3 4) (5 6))) =\<gtr\> '((1 2) (3 4) (5 6)))

    \;

    ;; Check that copying the list does not result in the same object

    (check-false (eq? (list-copy '(1 2 3)) '(1 2 3)))

    \;

    ;; Check if list-copy is a deep copy or not\ 

    (let ((obj1 '(1 2 3 4))

    \ \ \ \ \ \ (obj2 (list-copy '(1 2 3 4))))

    \ \ (check obj1 =\<gtr\> obj2)

    \ \ (set-car! obj1 3)

    \ \ (check-false (eq? obj1 obj2)))

    \;
  </scm-chunk>

  <subsection|谓词>

  <value|r7rs><paragraph|pair?><scm|(obj) =\<gtr\> bool><index|pair?>

  <scm|pair?>是S7 Scheme内置的函数：当且仅当obj是序对时，返回真。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (pair? '(a . b)))

    (check-true (pair? '(a b c)))

    \;

    (check-false (pair? '()))

    (check-false (pair? '#(a b)))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|list?><scm|(obj) =\<gtr\> bool><index|list?>

  基本列表测试：检查空列表和包含元素的列表是否被识别为列表。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (list? '()))

    (check-true (list? '(a)))

    (check-true (list? '(a b c)))

    (check-true (list? '(1 . 2)))

    (check-true (list? '(1 2 . 3)))

    \;
  </scm-chunk>

  嵌套列表测试：检查包含其他列表作为元素的列表是否被正确识别。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (list? '((a) (b) (c))))

    (check-true (list? '(a (b) c)))

    \;
  </scm-chunk>

  循环列表测试：检查函数是否能够正确处理循环列表结构。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-true (list? (let ((x '(1 2 3))) (set-cdr! (cddr x) x) x)))

    \;
  </scm-chunk>

  非列表测试：检查基本数据类型以及向量是否被正确地识别为非列表。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check-false (list? #t))

    (check-false (list? #f))

    (check-false (list? 123))

    (check-false (list? "Hello"))

    (check-false (list? '#(1 2 3)))\ 

    (check-false (list? '#()))

    (check-false (list? '12345))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|null?><scm|(obj) =\<gtr\> bool><index|null?>

  <scm|null?>是S7 Scheme内置的函数：当且仅当obj是空列表的时候，返回值为真。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (null? '()) =\<gtr\> #t)

    (check (null? '(1)) =\<gtr\> #f)

    (check (null? '(1 2)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|proper-list?>

  正规列表（proper list）是指满足以下条件的列表：

  <\enumerate>
    <item><strong|空列表>：也写作 <code*|()>，它是唯一的一个既是正规列表也是空列表的数据结构。空列表在 Scheme 中被认为是正规列表。

    <item><strong|非空列表>：如果一个列表的每个元素都是通过<code*|cons>过程构造的，并且该列表的<code*|cdr>部分是正规列表，那么这个列表就是正规列表。
  </enumerate>

  上述递归定义中，该列表通过<scm|cons>过程构造保证了列表不会是循环列表。在判断一个列表是否是正规列表时，我们需要考虑该列表是循环列表的这种情况。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (proper-list? x)

    \ \ (let loop ((x x) (lag x))

    \ \ \ \ (if (pair? x)

    \ \ \ \ \ \ \ \ (let ((x (cdr x)))

    \ \ \ \ \ \ \ \ \ \ (if (pair? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((x \ \ (cdr x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lag (cdr lag)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (not (eq? x lag)) (loop x lag)))

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

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

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (proper-list? (list 1 2)))

    (check-true (proper-list? '()))

    (check-true (proper-list? '(1 2 3)))

    \;

    (check-false (proper-list? '(a . b)))

    (check-false (proper-list? '(a b . c)))

    (check-false (proper-list? (circular-list 1 2 3)))

    \;
  </scm-chunk>

  <paragraph|dotted-list?>

  点状列表（dotted list）是一种列表：

  <\description>
    <item*|空的点状列表>不是空列表、不是序对的任意Scheme对象都是空的点状列表

    <item*|非空点状列表>其中除了最后一个元素之外，其他元素的<code*|cdr>指向另一个元素，最后一个元素的<code*|cdr>指向一个空的点状列表。
  </description>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (dotted-list? x)

    \ \ (let loop ((x x) (lag x))

    \ \ \ \ (if (pair? x)

    \ \ \ \ \ \ \ \ (let ((x (cdr x)))

    \ \ \ \ \ \ \ \ \ \ (if (pair? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((x \ \ (cdr x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lag (cdr lag)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (not (eq? x lag)) (loop x lag)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (null? x))))

    \ \ \ \ \ \ \ \ (not (null? x)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (dotted-list? 1))

    (check-true (dotted-list? '(1 . 2)))

    (check-true (dotted-list? '(1 2 . 3)))

    \;

    (check-false (dotted-list? (circular-list 1 2 3)))

    (check-false (dotted-list? '()))

    (check-false (dotted-list? '(a)))

    \;
  </scm-chunk>

  \;

  <paragraph|null-list?><index|null-list?>

  <scm|null-list?>是一个函数，返回<scm|#t>当且仅当参数是空列表。当参数为空列表，返回<scm|#t>；否则报错。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (null-list? l)

    \ \ (cond ((pair? l) #f)

    \ \ \ \ \ \ \ \ ((null? l) #t)

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (error 'wrong-type-arg "null-list?: argument out of domain" l))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (null-list? '()) =\<gtr\> #t)

    \;
  </scm-chunk>

  当参数为序对，返回<scm|#f>。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (null-list? '(1 . 2)) =\<gtr\> #f)

    \;
  </scm-chunk>

  当参数为非空列表，返回<scm|#f>。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (null-list? '(1 2)) =\<gtr\> #f)

    \;
  </scm-chunk>

  当参数既不是序对也不是列表，报错。

  辨析：<scm|null?>在参数为非序对时，不报错，只是返回<scm|#f>。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (null? 1) =\<gtr\> #f)

    \;
  </scm-chunk>

  如果已经确定需要判别的对象是列表，使用<scm|null-list?>更加合适。<scm|null?>无法分辨非空的序对和非空的列表，命名上偏模糊，不推荐使用。

  <subsection|选择器>

  <value|r7rs><paragraph|car><index|car>

  一个序对由<scm|\<less\>car\<gtr\>>部分与<scm|\<less\>cdr\<gtr\>>部分组成，形如：<scm|(\<less\>car\<gtr\> . \<less\>cdr\<gtr\>)>。<scm|car>是S7 Scheme内置的R7RS定义的函数，用于返回序对的<scm|\<less\>car\<gtr\>>部分。<scm|car>的参数必须是序对，否则报错；特别地，空列表不是序对，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (car '(a b c . d)) =\<gtr\> 'a)

    (check (car '(a b c)) =\<gtr\> 'a)

    \;

    (check-catch 'wrong-type-arg (car '()))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|cdr><index|cdr>

  <scm|cdr>是S7 Scheme内置的R7RS定义的函数，用于返回序对的<scm|\<less\>cdr\<gtr\>>部分。<scm|cdr>的参数必须是序对，否则报错；特别地，空列表不是序对，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (cdr '(a b c . d)) =\<gtr\> '(b c . d))

    (check (cdr '(a b c)) =\<gtr\> '(b c))

    \ \ 

    (check-catch 'wrong-type-arg (cdr '()))

    \;
  </scm-chunk>

  <paragraph|caar><index|caar><scm|(caar pair) =\<gtr\> obj>

  <scm|caar>是S7 Scheme内置的R7RS定义的函数，用于返回序对<scm|\<less\>car\<gtr\>>部分的<scm|\<less\>car\<gtr\>>部分。参数必须是序对，且该序对的<scm|\<less\>car\<gtr\>>部分的内容也要是序对，否则报错。特别地，空列表不是序对，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (caar '((a . b) . c)) =\<gtr\> 'a)

    \;

    (check-catch 'wrong-type-arg (caar '(a b . c)))

    (check-catch 'wrong-type-arg (caar '()))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|list-ref><index|list-ref>

  <scm|list-ref>是S7 Scheme内置的R7RS定义的函数，接收一个列表和一个称为索引值的非负整数k为参数，通过索引值k返回列表的第k个元素（从0开始计数）。当参数为空列表时，报错。当k为负数，报错。当k大于等于列表中元素数时，报错。

  注意<scm|(cons '(1 2) '(3 4))>其实是一个列表，但这个列表的元素不都是整数。这个例子容易理解成结果是一个序对且不是列表。

  <\session|goldfish|default>
    <\folded-io>
      \<gtr\>\ 
    <|folded-io>
      (cons '(1 2) '(3 4))
    <|folded-io>
      ((1 2) 3 4)
    </folded-io>

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

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (list-ref (cons '(1 2) '(3 4)) 1) =\<gtr\> 3)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (list-ref '(a b c) 2) =\<gtr\> 'c)

    \;

    (check-catch 'wrong-type-arg (list-ref '() 0))

    \;

    (check-catch 'out-of-range (list-ref '(a b c) -1))

    (check-catch 'out-of-range (list-ref '(a b c) 3))

    \;
  </scm-chunk>

  <paragraph|first><index|first>

  <scm|first>是一个函数，<scm|car>的同义词，用于返回列表的第1个元素。当列表元素不足1个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (first '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 1)

    (check (first '(left . right)) =\<gtr\> 'left)

    \;

    (check-catch 'wrong-type-arg (first '()))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define first car)

    \;
  </scm-chunk>

  <paragraph|second><index|second>

  <scm|second>是一个函数，<scm|cadr>的同义词，用于返回列表的第2个元素。当列表元素不足2个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (second '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 2)

    \;

    (check-catch 'wrong-type-arg (second '(left . right)))

    (check-catch 'wrong-type-arg (second '(1)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define second cadr)

    \;
  </scm-chunk>

  <paragraph|third><index|third>

  <scm|third>是一个函数，<scm|caddr>的同义词，用于返回列表的第3个元素。当列表元素不足3个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (third '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 3)

    \;

    (check-catch 'wrong-type-arg (third '(1 2)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define third caddr)

    \;
  </scm-chunk>

  <paragraph|fourth><index|fourth>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (fourth x) (list-ref x 3))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fourth '(1 2 3 4 5 6)) =\<gtr\> 4)

    \;
  </scm-chunk>

  <paragraph|fifth><index|fifth>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (fifth x) (list-ref x 4))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fifth '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 5)

    \;
  </scm-chunk>

  <paragraph|sixth><index|sixth>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (sixth x) (list-ref x 5))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (sixth '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 6)

    \;
  </scm-chunk>

  <paragraph|seventh><index|seventh>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (seventh x) (list-ref x 6))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (seventh '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 7)

    \;
  </scm-chunk>

  <paragraph|eighth><index|eighth>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (eighth x) (list-ref x 7))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (eighth '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 8)

    \;
  </scm-chunk>

  <paragraph|ninth><index|ninth>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (ninth x) (list-ref x 8))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (ninth '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 9)

    \;
  </scm-chunk>

  <paragraph|tenth><index|tenth>

  <scm|tenth>是一个函数，用于返回列表的第10个元素。当列表元素不足10个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (tenth '(1 2 3 4 5 6 7 8 9 10)) =\<gtr\> 10)

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (tenth x)\ 

    \ \ (cadr (cddddr (cddddr x))))

    \;
  </scm-chunk>

  <paragraph|take><index|take>

  <scm|take>是一个函数，接收一个列表和一个非负整数k为参数，返回列表的前k个元素组成的新列表。当列表元素数量不足k个，报错。

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (take '(1 2 3 4) 3) =\<gtr\> '(1 2 3))

    (check (take '(1 2 3 4) 4) =\<gtr\> '(1 2 3 4))

    (check (take '(1 2 3 . 4) 3) =\<gtr\> '(1 2 3))

    \;

    (check-catch 'wrong-type-arg (take '(1 2 3 4) 5))

    (check-catch 'wrong-type-arg (take '(1 2 3 . 4) 4))

    \;
  </scm-chunk>

  <subparagraph|实现>

  <\session|goldfish|default>
    <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
      (define (take l k)

      \ \ (let loop ((l l) (k k))

      \ \ \ \ (if (zero? k)

      \ \ \ \ \ \ \ \ '()

      \ \ \ \ \ \ \ \ (cons (car l)

      \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr l) (- k 1))))))

      \;
    </scm-chunk>
  </session>

  <value|r7rs><paragraph|list-tail><index|list-tail>

  <paragraph|drop><index|drop>

  <scm|list-tail>是S7 Scheme的内置函数。<scm|drop>是SRFI定义的函数，语义和<scm|list-tail>一致，接收一个列表和一个非负整数k为参数，返回去掉列表前k个元素组成的新列表。当列表元素数量不足k个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (drop '(1 2 3 4) 2) =\<gtr\> '(3 4))

    (check (drop '(1 2 3 4) 4) =\<gtr\> '())

    (check (drop '(1 2 3 . 4) 3) =\<gtr\> 4)

    \;

    (check-catch 'out-of-range (drop '(1 2 3 4) 5))

    (check-catch 'out-of-range (drop '(1 2 3 . 4) 4))

    \;
  </scm-chunk>

  <\session|goldfish|default>
    \;

    <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
      (define drop list-tail)

      \;
    </scm-chunk>
  </session>

  <paragraph|take-right><index|take-right>

  <scm|take-right>是一个函数，接收一个列表和一个非负整数k为参数，取出列表的后k个元素组成新列表，返回这个新列表。当列表元素数量不足k个，报错。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (take-right '(1 2 3 4) 3) =\<gtr\> '(2 3 4))

    (check (take-right '(1 2 3 4) 4) =\<gtr\> '(1 2 3 4))

    (check (take-right '(1 2 3 . 4) 3) =\<gtr\> '(1 2 3 . 4))

    \;

    (check-catch 'out-of-range (take-right '(1 2 3 4) 5))

    (check-catch 'out-of-range (take-right '(1 2 3 . 4) 4))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (take-right l k)

    \ \ (let loop ((lag l)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (lead (drop l k)))

    \ \ \ \ (if (pair? lead)

    \ \ \ \ \ \ \ \ (loop (cdr lag) (cdr lead))

    \ \ \ \ \ \ \ \ lag)))

    \;
  </scm-chunk>

  <paragraph|drop-right><index|drop-right>

  <scm|drop-right>是一个函数，接收一个列表和一个非负整数k为参数，去掉列表的后k个元素组成新列表，返回这个新列表。当列表元素数量不足k个，报错。当k为负数，报错。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (drop-right l k)

    \ \ (let loop ((lag l) (lead (drop l k)))

    \ \ \ \ (if (pair? lead)

    \ \ \ \ \ \ \ \ (cons (car lag) (loop (cdr lag) (cdr lead)))

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

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (drop-right '(1 2 3 4) 2) =\<gtr\> '(1 2))

    (check (drop-right '(1 2 3 4) 4) =\<gtr\> '())

    (check (drop-right '(1 2 3 . 4) 3) =\<gtr\> '())

    \;

    (check-catch 'out-of-range (drop-right '(1 2 3 4) 5))

    (check-catch 'out-of-range (drop-right '(1 2 3 4) -1))

    (check-catch 'out-of-range (drop-right '(1 2 3 . 4) 4))

    \;
  </scm-chunk>

  <paragraph|split-at><scm|(lst i) =\<gtr\> (values taked droped)> \ <index|split-at>

  <\description>
    <item*|lst><code|<code*|列表，需要被分割的列表。>>

    <item*|i><code|<code*|整数，指定分割的位置。>>

    <item*|(values taked droped)>两个值，第一个是包含原列表前 <scm|i> 个元素的列表，第二个是原列表剩余元素的列表。
  </description>

  将一个列表分割成两部分，返回两个值。第一个值是包含原列表前 <goldfish-lang|i> 个元素的列表，第二个值是原列表剩余元素的列表。

  实现细节：该函数通过迭代方式工作。它遍历列表 <scm|lst>，每次迭代将当前元素添加到结果列表中，直到达到指定的分割位置 <goldfish-lang|i>。如果 <goldfish-lang|i> 为 0，函数返回空列表和原始列表。如果 <scm|i> 大于列表长度或小于〇，函数报错。函数使用 <scm|values> 返回两个值，这样可以同时返回两个列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (split-at lst i)

    \ \ (when (\<less\> i 0)

    \ \ \ \ (value-error "require a index greater than 0, but got ~A -- split-at" i))

    \ \ (let ((result (cons #f '())))

    \ \ \ \ (do ((j i (- j 1))

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

    \ \ \ \ \ \ \ \ \ (node result (cdr node)))

    \ \ \ \ \ \ \ \ ((zero? j)

    \ \ \ \ \ \ \ \ \ (values (cdr result) rest))

    \ \ \ \ \ \ (when (not (pair? rest))

    \ \ \ \ \ \ \ \ (value-error "lst length cannot be greater than i, where lst is ~A, but i is ~A-- split-at" lst i))

    \ \ \ \ \ \ (set-cdr! node (cons (car rest) '())))))

    \;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (list (split-at '(1 2 3 4 5) 3)) =\<gtr\> '((1 2 3) (4 5)))

    (check (list (split-at '(1 2 3 4 5) 0)) =\<gtr\> '(() (1 2 3 4 5)))

    \;

    (check-catch 'value-error (split-at '(1 2 3 4 5) 10))

    (check-catch 'value-error (split-at '(1 2 3 4 5) -1))

    \;

    (check (list (split-at '(1 2 3 4 . 5) 0)) =\<gtr\> '(() (1 2 3 4 . 5)))

    (check (list (split-at '(1 2 3 4 . 5) 3)) =\<gtr\> '((1 2 3) (4 . 5)))

    (check (list (split-at '(1 2 3 4 . 5) 4)) =\<gtr\> '((1 2 3 4) 5))

    \;

    (check-catch 'value-error (split-at '(1 2 3 4 . 5) 10))

    (check-catch 'value-error (split-at '(1 2 3 4 . 5) -1))

    \;

    (check (list (split-at '() 0)) =\<gtr\> '(() ()))

    (check-catch 'value-error (split-at '() 10))

    (check-catch 'value-error (split-at '() -1))

    \;
  </scm-chunk>

  <paragraph|last-pair><index|last-pair>

  <scm|last-pair>是一个函数，以序对形式返回列表的最后一个元素，参数必须是序对，空列表报错。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (last-pair l)

    \ \ (if (pair? (cdr l))

    \ \ \ \ \ \ (last-pair (cdr l))

    \ \ \ \ \ \ l))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (last-pair '(a b c)) =\<gtr\> '(c))

    (check (last-pair '(c)) =\<gtr\> '(c))

    \;

    (check (last-pair '(a b . c)) =\<gtr\> '(b . c))

    (check (last-pair '(b . c)) =\<gtr\> '(b . c))

    \;

    (check-catch 'wrong-type-arg (last-pair '()))

    \;
  </scm-chunk>

  <paragraph|last><index|last>

  <scm|last>是一个函数，以符号形式返回列表的最后一个元素，参数必须是序对，空列表报错。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (last l)

    \ \ (car (last-pair l)))

    \;
  </scm-chunk>

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

    (check (last '(c)) =\<gtr\> 'c)

    \;

    (check (last '(a b . c)) =\<gtr\> 'b)

    (check (last '(b . c)) =\<gtr\> 'b)

    \;

    (check-catch 'wrong-type-arg (last '()))

    \;
  </scm-chunk>

  <subsection|常用函数>

  <value|r7rs><paragraph|length><scm|(lst) -\<gtr\> integer><index|length>

  <scm|length>是一个S7内置函数，它接收一个列表为参数，返回该列表中元素的数量。如果参数不是列表，返回0。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (length ()) =\<gtr\> 0)

    (check (length '(a b c)) =\<gtr\> 3)

    (check (length '(a (b) (c d e))) =\<gtr\> 3)

    \;

    (check (length 2) =\<gtr\> #f)

    (check (length '(a . b)) =\<gtr\> -1)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|append><index|append>

  <scm|append>是一个S7内置的R7RS定义的函数，它接收多个列表为参数，按顺序拼接在一起，返回一个新的列表。<scm|append>没有参数时，返回空列表。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (append '(a) '(b c d)) =\<gtr\> '(a b c d))

    (check (append '(a b) 'c) =\<gtr\> '(a b . c))

    \;

    (check (append () 'c) =\<gtr\> 'c)

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

    \;
  </scm-chunk>

  <value|r7rs><paragraph|reverse><index|reverse>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (reverse '()) =\<gtr\> '())

    (check (reverse '(a)) =\<gtr\> '(a))

    (check (reverse '(a b)) =\<gtr\> '(b a))

    \;
  </scm-chunk>

  <paragraph|count><index|count>

  <scm|count>是一个高阶函数，它接收两个参数：一个谓词和一个列表；返回满足谓词条件的元素在列表中出现的次数。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (count pred list1 . lists)

    \ \ (let lp ((lis list1) (i 0))

    \ \ \ \ (if (null-list? lis) i

    \ \ \ \ \ \ \ \ (lp (cdr lis) (if (pred (car lis)) (+ i 1) i)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (count even? '(3 1 4 1 5 9 2 5 6)) =\<gtr\> 3)

    \;
  </scm-chunk>

  <subsection|折叠和映射>

  <r7rs><paragraph|map><index|map>

  <scm|map>是S7的内置高阶函数，它接收一个函数和一个列表为从参数，把该函数应用于该列表的每个元素上，并返回一个新列表。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (map square (list 1 2 3 4 5)) =\<gtr\> '(1 4 9 16 25))

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|for-each><index|for-each><scm|(for-each proc list1 [list2 ...])>

  <scm|for-each>是S7内置的高阶函数。<scm|for-each>的参数与<scm|map>的参数类似，但<scm|for-each>调用<scm|proc>是为了它的副作用，而不是为了它的返回值。与<scm|map>不同，<scm|for-each>保证会按照从第一个元素到最后一个元素的顺序调用<scm|proc>，并且<scm|for-each>返回的值是未指定的。如果给出了多个列表，并且不是所有列表的长度都相同，<scm|for-each>会在最短的列表用尽时终止。当<scm|proc>不接受与<scm|lists>数量相同的参数，报错。

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

    \ \ (let ((v (make-vector 5)))

    \ \ \ \ (for-each (lambda (i) (vector-set! v i (* i i)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (iota 5))

    \ \ \ \ v)

    \ \ =\<gtr\> #(0 1 4 9 16))

    \;

    (check

    \ \ (let ((v (make-vector 5 #f)))

    \ \ \ \ (for-each (lambda (i) (vector-set! v i (* i i)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (iota 4))

    \ \ \ \ v)

    \ \ =\<gtr\> #(0 1 4 9 #f))

    \;

    (check

    \ \ (let ((v (make-vector 5 #f)))

    \ \ \ \ (for-each (lambda (i) (vector-set! v i (* i i)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (iota 0))

    \ \ \ \ v)

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

    \;
  </scm-chunk>

  \;

  <paragraph|fold><index|fold>

  <scm|fold>是一个高阶函数，它接受三个参数：一个函数、一个初始值和一个列表，将函数累积地应用到一个列表的所有元素上，从左到右，从而将列表折叠成一个单一的值。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (fold f initial l)

    \ \ (when (not (procedure? f))

    \ \ \ \ (error 'type-error "The first param must be a procedure"))

    \ \ (if (null? l)

    \ \ \ \ \ \ initial

    \ \ \ \ \ \ (fold f

    \ \ \ \ \ \ \ \ \ \ \ \ (f (car l) initial)

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

    \;
  </scm-chunk>

  这是SRFI-1官方提供的实现，我们暂时不用。

  <\scm-code>
    (define (fold kons knil lis1 . lists)

    \ \ (if (pair? lists)

    \ \ \ \ \ \ (let lp ((lists (cons lis1 lists)) (ans knil))

    \ \ \ \ \ \ \ \ (receive (cars+ans cdrs) (%cars+cdrs+ lists ans)

    \ \ \ \ \ \ \ \ \ \ (if (null? cars+ans) ans

    \ \ \ \ \ \ \ \ \ \ \ \ \ (lp cdrs (apply kons cars+ans)))))

    \;

    \ \ \ \ \ \ (let lp ((lis lis1) (ans knil))

    \ \ \ \ \ \ \ \ (if (null-list? lis) ans

    \ \ \ \ \ \ \ \ \ \ \ \ (lp (cdr lis) (kons (car lis) ans))))))
  </scm-code>

  常见的用法：

  从初始值开始，依次累加列表中的元素，返回一个数；当列表为空列表时，返回初始值。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fold + 0 '(1 2 3 4)) =\<gtr\> 10)

    (check (fold + 0 '()) =\<gtr\> 0)

    \;

    (check-catch 'type-error (fold 0 + '(1 2 3 4)))

    \;
  </scm-chunk>

  反转列表中的元素，返回一个新列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fold cons () '(1 2 3 4)) =\<gtr\> '(4 3 2 1))

    \;
  </scm-chunk>

  统计列表中满足谓词的元素数量，返回这个数量。

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

    \ \ (fold (lambda (x count) (if (symbol? x) (+ count 1) count))

    \ \ \ \ \ \ \ \ 0

    \ \ \ \ \ \ \ \ '(a b 1 2 3 4))

    \ \ =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|fold-right><index|fold-right>

  <scm|fold-right>与<scm|fold>类似，不同的是，<scm|fold-right>是从右到左折叠。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (fold-right f initial l)

    \ \ (if (null? l)

    \ \ \ \ initial

    \ \ \ \ (f (car l)

    \ \ \ \ \ \ \ \ (fold-right f

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ initial

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

    \;
  </scm-chunk>

  这是SRFI-1官方提供的实现，我们暂时不用：

  <\scm-code>
    (define (fold-right kons knil lis1 . lists)

    \ \ (if (pair? lists)

    \ \ \ \ \ \ (let recur ((lists (cons lis1 lists)))

    \ \ \ \ \ \ \ \ (let ((cdrs (%cdrs lists)))

    \ \ \ \ \ \ \ \ \ \ (if (null? cdrs) knil

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply kons (%cars+ lists (recur cdrs))))))

    \;

    \ \ \ \ \ \ (let recur ((lis lis1))

    \ \ \ \ \ \ \ \ (if (null-list? lis) knil

    \ \ \ \ \ \ \ \ \ \ \ \ (let ((head (car lis)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (kons head (recur (cdr lis))))))))
  </scm-code>

  在用作累加、统计时，<scm|fold-right>与<scm|fold>的结果是相同的。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fold-right + 0 '(1 2 3 4)) =\<gtr\> 10)

    \;

    (check (fold-right + 0 '()) =\<gtr\> 0)

    \;

    (check

    \ \ (fold-right (lambda (x count) (if (symbol? x) (+ count 1) count))

    \ \ \ \ \ \ \ \ 0

    \ \ \ \ \ \ \ \ '(a b 1 2 3 4))

    \ \ =\<gtr\>

    \ \ 2)

    \;
  </scm-chunk>

  但<scm|fold-right>与<scm|fold>的折叠方向是相反的，这就使得列表原本的顺序得以保持，不会反转。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (fold-right cons () '(1 2 3 4)) =\<gtr\> '(1 2 3 4))

    \;
  </scm-chunk>

  <paragraph|reduce><index|reduce>

  <scm|reduce>与<scm|fold>类似，但有微妙且关键的不同。只有在列表为空列表时，才会使用这个初始值。在列表不是空列表时，则把列表的<scm|\<less\>car\<gtr\>>部分取出作为<scm|fold>的初始值，又把列表的<scm|\<less\>cdr\<gtr\>>部分取出作为<scm|fold>的列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (reduce f initial l)

    \ \ (if (null-list? l) initial

    \ \ \ \ \ \ (fold f (car l) (cdr l))))

    \;
  </scm-chunk>

  在用作累加时，<scm|reduce>与<scm|fold>的结果是相同的。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (reduce + 0 '(1 2 3 4)) =\<gtr\> 10)

    (check (reduce + 0 '()) =\<gtr\> 0)

    \;
  </scm-chunk>

  不适用于反转列表中的元素，但当列表非空，返回的不再是列表，而是序对。因为<scm|reduce>会把非空列表的第一个元素取出来作为<scm|fold>的初始值。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (reduce cons () '(1 2 3 4)) =\<gtr\> '(4 3 2 . 1))

    \;
  </scm-chunk>

  不适用于统计列表中满足谓词的元素数量，因为<scm|reduce>会把非空列表的第一个元素取出来作为<scm|fold>的初始值，引发错误。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-catch 'wrong-type-arg\ 

    \ \ (reduce (lambda (x count) (if (symbol? x) (+ count 1) count))

    \ \ \ \ \ \ \ \ \ \ 0

    \ \ \ \ \ \ \ \ \ \ '(a b 1 2 3 4)))

    \;
  </scm-chunk>

  <paragraph|reduce-right><index|reduce-right>

  <scm|reduce-right>与<scm|reduce>类似，不同的是，<scm|reduce-right>是从右到左规约。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (reduce-right f initial l)

    \ \ (if (null-list? l) initial

    \ \ \ \ \ \ (let recur ((head (car l)) (l (cdr l)))

    \ \ \ \ \ \ \ \ (if (pair? l)

    \ \ \ \ \ \ \ \ \ \ \ \ (f head (recur (car l) (cdr l)))

    \ \ \ \ \ \ \ \ \ \ \ \ head))))

    \;
  </scm-chunk>

  在用作累加时，<scm|reduce-right>与<scm|fold>的结果是相同的。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (reduce-right + 0 '(1 2 3 4)) =\<gtr\> 10)

    \;

    (check (reduce-right + 0 '()) =\<gtr\> 0)

    \;
  </scm-chunk>

  也不适用于重列列表中的元素，以及统计列表中满足谓词的元素数量。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (reduce-right cons () '(1 2 3 4))

    \ \ \ \ \ \ \ =\<gtr\> '(1 2 3 . 4) )

    \;

    (check

    \ \ (reduce-right (lambda (x count) (if (symbol? x) (+ count 1) count))

    \ \ \ \ \ \ \ \ 0

    \ \ \ \ \ \ \ \ '(a b 1 2 3 4))

    \ \ =\<gtr\> 6)

    \;
  </scm-chunk>

  <paragraph|append-map><index|append-map>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define append-map

    \ \ (typed-lambda ((proc procedure?) (lst list?))

    \ \ \ \ (let loop ((rest lst)

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

    \ \ \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ \ \ result

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (append result (proc (car rest))))))))

    \;
  </scm-chunk>

  \;

  <subsection|过滤和分组>

  <paragraph|filter><index|filter>

  <scm|filter>是一个高阶函数，接收一个谓词和一个列表为参数，从这个列表中筛出满足谓词的元素，组成一个新列表，返回这个新列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (filter pred l)

    \ \ (let recur ((l l))

    \ \ \ \ (if (null-list? l) l

    \ \ \ \ \ \ \ \ (let ((head (car l))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (tail (cdr l)))

    \ \ \ \ \ \ \ \ \ \ (if (pred head)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((new-tail (recur tail)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (eq? tail new-tail) l

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons head new-tail)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (recur tail))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (filter even? '(-2 -1 0 1 2)) =\<gtr\> '(-2 0 2))

    \;
  </scm-chunk>

  <paragraph|partition><index|partition>

  <scm|partition>是一个高阶函数，接收一个谓词和一个列表为参数，从这个列表中分别筛出满足和不满足谓词的元素，各组成一个新列表，返回以这两个新列表组成的序对。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (partition pred l)

    \ \ (let loop ((lst l) (satisfies '()) (dissatisfies '()))

    \ \ \ \ (cond ((null? lst)

    \ \ \ \ \ \ \ \ \ \ \ (cons satisfies dissatisfies))

    \ \ \ \ \ \ \ \ \ \ ((pred (car lst))

    \ \ \ \ \ \ \ \ \ \ \ (loop (cdr lst) (cons (car lst) satisfies) dissatisfies))

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

    \ \ \ \ \ \ \ \ \ \ \ (loop (cdr lst) satisfies (cons (car lst) dissatisfies))))))

    \;
  </scm-chunk>

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

    \ \ (partition symbol? '(one 2 3 four five 6))

    \ \ =\<gtr\> (cons '(five four one) '(6 3 2)))

    \;
  </scm-chunk>

  <paragraph|remove><index|remove>

  <scm|remove>是一个高阶函数，接收一个谓词和一个列表为参数，从这个列表中去掉满足谓词的元素，组成一个新列表，返回这个新列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (remove pred l)

    \ \ (filter (lambda (x) (not (pred x))) l))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (remove even? '(-2 -1 0 1 2)) =\<gtr\> '(-1 1))

    \;
  </scm-chunk>

  <subsection|搜索>

  <paragraph|memq><index|memq>

  <scm|memq>是一个S7内置函数，和<scm|member>类似，但判断元素等价的谓词是<scm|eq?>。也就是说，检查的是两个元素在是否是同一个实例，即它们是否具有相同的内存地址。

  对比使用<scm|equal?>的<scm|member>或使用<scm|<scm|eqv?>>的<scm|memv>，这种检查最为“严格”，适用于判断的元素类型最少，速度最快，适用于判断布尔值（<scm|#t>、<scm|#f>）、符号、整数（浮点数和复数不行）、函数（的值）这些类型的元素是否在列表中。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (memq #f '(1 #f 2 3)) =\<gtr\> '(#f 2 3))

    (check (memq 'a '(1 a 2 3)) =\<gtr\> '(a 2 3))

    (check (memq 2 '(1 2 3)) =\<gtr\> '(2 3))

    \;

    (check (memq 2.0 '(1 2.0 3)) =\<gtr\> #f)

    (check (memq 2+0i '(1 2+0i 3)) =\<gtr\> #f)

    \;

    (define num1 3)

    (define num2 3)

    (check (memq num1 '(3 num2)) =\<gtr\> '(3 num2))

    (check (memq 3 '(num1 num2)) =\<gtr\> #f)

    (check (memq 'num1 '(num1 num2)) =\<gtr\> '(num1 num2))

    \;

    (check (memq (+ 1 1) '(1 2 3)) =\<gtr\> '(2 3))

    \;
  </scm-chunk>

  <paragraph|memv><index|memv>

  <scm|memv>是一个S7内置函数，和<scm|member>类似，但判断元素元素的谓词是<scm|eqv?>。也就是说，检查的是两个元素是否相同或在数值上等价。

  比使用<scm|equal?>的<scm|member>“严格”，但比使用<scm|<scm|eq?>>的<scm|memq>“宽松”，适用于判断的元素类型次全（<scm|memv>能实现的功能<scm|member>都能实现），速度中等，适用于判断数值类元素（整数、浮点数、复数）是否在列表中。但是注意，即使数值相同也不视为同一元素。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (memv 2 '(1 2 3)) =\<gtr\> '(2 3))

    (check (memv 2.0 '(1 2.0 3)) =\<gtr\> '(2.0 3))

    (check (memv 2+0i '(1 2+0i 3)) =\<gtr\> '(2+0i 3))

    \;

    (check (memv 2 '(1 2.0 3)) =\<gtr\> #f)

    (check (memv 2 '(1 2+0i 3)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|member><index|member>

  <scm|member>是一个S7内置函数，接收一个元素和一个列表为参数，返回包含该元素的第一个子列表。当元素不在列表中，返回<scm|#f>。当列表为空列表，返回<scm|#f>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (member 2 '(1 2 3)) =\<gtr\> '(2 3))

    (check (member 0 '(1 2 3)) =\<gtr\> #f)

    (check (member 0 '()) =\<gtr\> #f)

    \ 
  </scm-chunk>

  注意，判断两个元素等价的谓词是<scm|equal?>。也就是说，检查的是两个元素在结构和内容上是否等价。

  对比使用<scm|eq?>的<scm|memq>或使用<scm|<scm|eqv?>>的<scm|memv>，这种检查最为“宽松”，适用判断的元素类型最全，但速度最慢（因为它会递归地比较复合数据结构的每个部分），建议用于判断字符串、序对、列表这些类型的元素是否在列表中，如果无需判断这些类型，建议选用<scm|memv>或<scm|memq>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (member "1" '(0 "1" 2 3)) =\<gtr\> '("1" 2 3))

    (check (member '(1 . 2) '(0 (1 . 2) 3)) =\<gtr\> '((1 . 2) 3))

    (check (member '(1 2) '(0 (1 2) 3)) =\<gtr\> '((1 2) 3))

    \;
  </scm-chunk>

  <paragraph|find><index|find>

  <scm|find>是一个高阶函数，接收一个谓词和一个列表为参数，返回该列表中第一个满足谓词的元素。当列表为空列表，或列表中没有满足谓词的元素，返回<scm|#f>。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (find pred l)

    \ \ (cond ((null? l) #f)

    \ \ \ \ \ \ \ \ ((pred (car l)) (car l))\ 

    \ \ \ \ \ \ \ \ (else (find pred (cdr l)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (find even? '(3 1 4 1 5 9)) =\<gtr\> 4)

    \;

    (check (find even? '()) =\<gtr\> #f)

    \;

    (check (find even? '(1 3 5 7 9)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|take-while><index|take-while>

  <scm|take-while>是一个高阶函数，接收一个谓词和一个列表为参数，按列表顺序筛出满足谓词的元素，直到不满足谓词的那个一个就停止筛选，返回筛出的元素组成的列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (take-while pred lst)

    \ \ (if (null? lst)\ 

    \ \ \ \ \ \ '()

    \ \ \ \ \ \ (if (pred (car lst))

    \ \ \ \ \ \ \ \ \ \ (cons (car lst) (take-while pred (cdr lst)))

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

    \;
  </scm-chunk>

  当参数的列表为空列表，无论谓词是什么都返回空列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check <code*|(take-while even? '())> =\<gtr\> '())

    \;
  </scm-chunk>

  当列表中所有元素都满足谓词，返回原列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (take-while (lambda (x) #t) '(1 2 3))

    \ \ =\<gtr\> '(1 2 3))

    \;
  </scm-chunk>

  当列表中没有元素满足谓词，返回空列表。

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

    \ \ (take-while (lambda (x) #f) '(1 2 3))

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

    \;
  </scm-chunk>

  当列表的第一个元素就不满足谓词，返回空列表。

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

    \ \ (take-while (lambda (x) (not (= x 1))) '(1 2 3))

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

    \;
  </scm-chunk>

  筛出元素的过程按照列表的顺序进行，当一个元素已经不满足谓词，那么这个元素之后的元素不会被筛出。

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

    \ \ (take-while (lambda (x) (\<less\> x 3)) '(1 2 3 0))

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

    \;
  </scm-chunk>

  <paragraph|drop-while><index|drop-while>

  <scm|drop-while>是一个高阶函数，接收一个谓词和一个列表为参数，按列表顺序丢掉满足谓词的元素，直到不满足谓词的那个一个就停止丢掉，返回剩下的元素组成的列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (drop-while pred l)

    \ \ (if (null? l)

    \ \ \ \ \ \ '()

    \ \ \ \ \ \ (if (pred (car l))

    \ \ \ \ \ \ \ \ \ \ (drop-while pred (cdr l))

    \ \ \ \ \ \ \ \ \ \ l)))

    \;
  </scm-chunk>

  当列表为空列表，返回空列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (drop-while even? '()) =\<gtr\> '())

    \;
  </scm-chunk>

  当列表中所有元素都满足谓词，返回空列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (drop-while (lambda (x) #t) '(1 2 3)) =\<gtr\> '())

    \;
  </scm-chunk>

  当列表中没有元素满足谓词，返回原列表。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (drop-while (lambda (x) #f) '(1 2 3)) =\<gtr\> '(1 2 3))

    \;
  </scm-chunk>

  当列表的第一个元素就不满足谓词，返回原列表。

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

    \ \ (drop-while (lambda (x) (not (= x 1))) '(1 2 3))

    \ \ =\<gtr\> '(1 2 3))

    \;
  </scm-chunk>

  <paragraph|list-index><index|list-index>

  <scm|list-index>是一个高阶函数，接收一个谓词和一个列表为参数，返回第一个符合谓词要求的元素的位置索引。当列表为空列表，或列表中没有满足谓词的元素，返回<scm|#f>。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (list-index pred l)

    \ \ \ \ (let loop ((index 0) (l l))

    \ \ \ \ \ \ (if (null? l)

    \ \ \ \ \ \ \ \ \ \ #f

    \ \ \ \ \ \ \ \ \ \ (if (pred (car l))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ index

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ index 1) (cdr l))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (list-index even? '(3 1 4 1 5 9)) =\<gtr\> 2)

    (check (list-index even? '()) =\<gtr\> #f)

    (check (list-index even? '(1 3 5 7 9)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|any><index|any>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (any pred? l)

    \ \ (cond ((null? l) #f)

    \ \ \ \ \ \ \ \ ((pred? (car l)) #t)

    \ \ \ \ \ \ \ \ (else (any pred? (cdr l)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (any integer? '()) =\<gtr\> #f)

    (check (any integer? '(a 3.14 "3")) =\<gtr\> #f)

    (check (any integer? '(a 3.14 3)) =\<gtr\> #t)

    \;
  </scm-chunk>

  <paragraph|every><index|every>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (every pred? l)

    \ \ (cond ((null? l) #t)

    \ \ \ \ \ \ \ \ ((not (pred? (car l))) #f)

    \ \ \ \ \ \ \ \ (else (every pred? (cdr l)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (every integer? '()) =\<gtr\> #t)

    (check (every integer? '(a 3.14 3)) =\<gtr\> #f)

    (check (every integer? '(1 2 3)) =\<gtr\> #t)

    \;
  </scm-chunk>

  <subsection|删除>

  公共子函数，用于处理可选的<scm|maybe-equal>参数。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (%extract-maybe-equal maybe-equal)

    \ \ (let ((my-equal (if (null-list? maybe-equal)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ =

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car maybe-equal))))

    \ \ \ \ (if (procedure? my-equal)

    \ \ \ \ \ \ \ \ my-equal

    \ \ \ \ \ \ \ \ (error 'wrong-type-arg "maybe-equal must be procedure"))))
  </scm-chunk>

  <paragraph|delete><index|delete>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (delete x l . maybe-equal)

    \ \ (let ((my-equal (%extract-maybe-equal maybe-equal)))

    \ \ \ \ (filter (lambda (y) (not (my-equal x y))) l)))

    \;
  </scm-chunk>

  测试用例

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (delete 1 (list 1 2 3 4)) =\<gtr\> (list 2 3 4))

    \;

    (check (delete 0 (list 1 2 3 4)) =\<gtr\> (list 1 2 3 4))

    \;

    (check (delete #\\a (list #\\a #\\b #\\c) char=?)

    \ \ \ \ \ \ \ =\<gtr\> (list #\\b #\\c))

    \;

    (check (delete #\\a (list #\\a #\\b #\\c) (lambda (x y) #f))

    \ \ \ \ \ \ \ =\<gtr\> (list #\\a #\\b #\\c))

    \;

    (check (delete 1 (list )) =\<gtr\> (list ))

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda ()

    \ \ \ \ \ \ (check (delete 1 (list 1 2 3 4) 'not-pred) =\<gtr\> 1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\> #t)

    \;
  </scm-chunk>

  <paragraph|delete-duplicates><index|delete-duplicates>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    ;;; right-duplicate deletion

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    ;;; delete-duplicates delete-duplicates!

    ;;;

    ;;; Beware -- these are N^2 algorithms. To efficiently remove duplicates

    ;;; in long lists, sort the list to bring duplicates together, then use a

    ;;; linear-time algorithm to kill the dups. Or use an algorithm based on

    ;;; element-marking. The former gives you O(n lg n), the latter is linear.

    \;

    (define (delete-duplicates lis . maybe-equal)

    \ \ (let ((my-equal (%extract-maybe-equal maybe-equal)))

    \ \ \ \ (let recur ((lis lis))

    \ \ \ \ \ \ (if (null-list? lis)

    \ \ \ \ \ \ \ \ \ \ lis

    \ \ \ \ \ \ \ \ \ \ (let* ((x (car lis))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (tail (cdr lis))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (new-tail (recur (delete x tail my-equal))))

    \ \ \ \ \ \ \ \ \ \ \ \ (if (eq? tail new-tail)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lis

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons x new-tail)))))))

    \;
  </scm-chunk>

  测试用例

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (delete-duplicates (list 1 1 2 3)) =\<gtr\> (list 1 2 3))

    (check (delete-duplicates (list 1 2 3)) =\<gtr\> (list 1 2 3))

    (check (delete-duplicates (list 1 1 1)) =\<gtr\> (list 1))

    \;

    (check (delete-duplicates (list )) =\<gtr\> (list ))

    \;

    (check (delete-duplicates (list 1 1 2 3) (lambda (x y) #f))

    \ \ \ \ \ \ \ =\<gtr\> (list 1 1 2 3))

    \;
  </scm-chunk>

  如果判断相等的函数类型不正确，会报错：

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

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda

    \ \ \ \ \ \ ()

    \ \ \ \ \ \ (check (delete-duplicates (list 1 1 2 3) 'not-pred) =\<gtr\> 1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\> #t)

    \;
  </scm-chunk>

  <subsection|关联列表>

  关联列表（association list）的每一个元素都是序对。

  <value|r7rs><paragraph|assoc><index|assoc>

  <value|r7rs><paragraph|assq><index|assq>

  <value|r7rs><paragraph|assv><index|assv>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (let1 l '((a 1) (b 2) (c . 3))

    \ \ (check (assq 'a l) =\<gtr\> `(a 1))

    \ \ (check-true (eq? (assq 'a l) (l 0)))

    \ \ (check (assq 'b l) =\<gtr\> `(b 2))

    \ \ (check (assq 'c l) =\<gtr\> `(c . 3))

    \ \ (check (assq 'd l) =\<gtr\> #f))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (let1 l '((2 3) (5 7) (11 . 13))

    \ \ (check (assv 5 l) =\<gtr\> '(5 7))

    \ \ (check (assv 11 l) =\<gtr\> '(11 . 13)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (let1 l '(((a)) ((b)) ((c)))

    \ \ (check (assoc '(a) l) =\<gtr\> '((a)))

    \ \ (check (assq '(a) l) =\<gtr\> #f)

    \ \ (check (assv '(a) l) =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|alist-cons><index|alist-cons>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (alist-cons key value alist)

    \ \ (cons (cons key value) alist))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (alist-cons 'a 1 '()) =\<gtr\> '((a . 1)))

    (check (alist-cons 'a 1 '((b . 2))) =\<gtr\> '((a . 1) (b . 2)))

    \;
  </scm-chunk>

  <subsection|循环列表>

  <paragraph|circular-list><index|circular-list>

  使用该构造器构造的列表是循环列表，每一个循环的单元包含构造器中的所有参数。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (circular-list val1 . vals)

    \ \ (let ((ans (cons val1 vals)))

    \ \ \ \ (set-cdr! (last-pair ans) ans)

    \ \ \ \ ans))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (let1 cl (circular-list 1 2 3)

    \ \ (check (cl 3) =\<gtr\> 1)

    \ \ (check (cl 4) =\<gtr\> 2)

    \ \ (check (cl 5) =\<gtr\> 3)

    \ \ (check (cl 6) =\<gtr\> 1))

    \;
  </scm-chunk>

  <paragraph|circular-list?><index|circular-list?>

  判断一个列表是不是循环列表，这里采用的是判断链表这个数据结构的是否循环的经典算法，使用两个指针，第一个指针每轮迭代移动两次，第二个指针每轮迭代移动一次，如果两个指针在某一次迭代中指向的是同一个位置，那么该列表就是循环列表。

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|true>
    (define (circular-list? x)

    \ \ (let loop ((x x) (lag x))

    \ \ \ \ (and (pair? x)

    \ \ \ \ \ \ \ \ \ (let ((x (cdr x)))

    \ \ \ \ \ \ \ \ \ \ \ (and (pair? x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((x \ \ (cdr x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lag (cdr lag)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (or (eq? x lag) (loop x lag))))))))

    \;
  </scm-chunk>

  <paragraph|测试>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (circular-list? (circular-list 1 2)))

    (check-true (circular-list? (circular-list 1)))

    \;

    (let* ((l (list 1 2 3))

    \ \ \ \ \ \ \ (end (last-pair l)))

    \ \ (set-cdr! end (cdr l))

    \ \ (check-true (circular-list? l)))

    \;

    (check-false (circular-list? (list 1 2)))

    \;
  </scm-chunk>

  <section|三鲤扩展函数>

  <paragraph|length=?><index|length=?><scm|(x l) =\<gtr\> boolean>

  <\description>
    <item*|x>期望的列表长度，如果长度为负数，该函数会抛出<scm|value-error>

    <item*|l>列表
  </description>

  快速判断一个列表<scm|l>的长度是否为<scm|x>。由于<scm|(= x (length l))>这种判断方式的复杂度是<math|O<around*|(|n|)>>，故而需要<scm|length=?>这种快速的判断方式。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (length=? 3 (list 1 2 3)))

    (check-false (length=? 2 (list 1 2 3)))

    (check-false (length=? 4 (list 1 2 3)))

    \;

    (check-true (length=? 0 (list )))

    (check-catch 'value-error (length=? -1 (list )))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (length=? x scheme-list)

    \ \ (when (\<less\> x 0)

    \ \ \ \ (value-error "length=?: expected non-negative integer x but received ~d" x))

    \ \ (cond ((and (= x 0) (null? scheme-list)) #t)

    \ \ \ \ \ \ \ \ ((or (= x 0) (null? scheme-list)) #f)

    \ \ \ \ \ \ \ \ (else (length=? (- x 1) (cdr scheme-list)))))

    \;
  </scm-chunk>

  <paragraph|length\<gtr\>?><scm|(lst len) =\<gtr\> bool><index|length\<gtr\>?>

  使用贪心策略，先访问列表的前len个元素，如果列表长度不大于len，那么返回布尔值假，否则返回布尔值真。lst并不一定是严格意义上的列表（最后一个元素是空列表），也可能是序对。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (length\<gtr\>? lst len)

    \ \ (let loop ((lst lst)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (cnt 0))

    \ \ \ \ (cond ((null? lst) (\<less\> len cnt))

    \ \ \ \ \ \ \ \ \ \ ((pair? lst) (loop (cdr lst) (+ cnt 1)))

    \ \ \ \ \ \ \ \ \ \ (else (\<less\> len cnt)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (length\<gtr\>? '(1 2 3 4 5) 3))

    (check-false (length\<gtr\>? '(1 2) 3))

    (check-false (length\<gtr\>? '() 0))

    \;

    (check-true (length\<gtr\>? '(1) 0))

    (check-false (length\<gtr\>? '() 1))

    \;

    (check-false (length\<gtr\>? '(1 2 . 3) 2))

    (check-true (length\<gtr\>? '(1 2 . 3) 1))

    \;
  </scm-chunk>

  <paragraph|length\<gtr\>=?><scm|(lst len) =\<gtr\> bool><index|length\<gtr\>=?>

  使用贪心策略，先访问列表的前len个元素，如果列表长度小于len，那么返回布尔值假，否则返回布尔值真。lst并不一定是严格意义上的列表（最后一个元素是空列表），也可能是序对。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (length\<gtr\>=? lst len)

    \ \ (let loop ((lst lst)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (cnt 0))

    \ \ \ \ (cond ((null? lst) (\<less\>= len cnt))

    \ \ \ \ \ \ \ \ \ \ ((pair? lst) (loop (cdr lst) (+ cnt 1)))

    \ \ \ \ \ \ \ \ \ \ (else (\<less\>= len cnt)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check-true (length\<gtr\>=? '(1 2 3 4 5) 3))

    (check-false (length\<gtr\>=? '(1 2) 3))

    (check-true (length\<gtr\>=? '() 0))

    \;

    (check-true (length\<gtr\>=? '(1) 0))

    (check-false (length\<gtr\>=? '() 1))

    \;

    (check-false (length\<gtr\>=? '(1 2 . 3) 3))

    (check-true (length\<gtr\>=? '(1 2 . 3) 2))

    \;
  </scm-chunk>

  <paragraph|list-view><index|list-view>

  由于Scheme的List和数据的流向是相反的：

  <\scm-code>
    (map (lambda (x) (* x x))

    \ \ \ \ \ (map (lambda (x) (+ x 1))

    \ \ \ \ \ \ \ \ \ \ (list 1 2 3)))
  </scm-code>

  \;

  所以我们实现了<scm|list-view>，采用和Scala的List类似的语法来处理数据：

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

    \;

    (check (((list-view (list 1 2 3))

    \ \ \ \ \ \ \ \ map (lambda (x) (+ x 1)))) =\<gtr\> (list 2 3 4))

    \;

    (check (((list-view (list 1 2 3))

    \ \ \ \ \ \ \ \ map (lambda (x) (+ x 1))

    \ \ \ \ \ \ \ \ map (lambda (x) (* x x))))

    \ \ \ \ \ \ \ =\<gtr\> (list 4 9 16))

    \;
  </scm-chunk>

  <scm|(list-view 1 2 3)>得到的是函数，需要在外面再加一层括号才能得到<scm|(list 1 2 3)>。

  <\big-figure|<wide-tabular|<tformat|<table|<row|<\cell>
    <\scm-code>
      (map (lambda (x) (* x x))

      \ \ \ \ \ (map (lambda (x) (+ x 1))

      \ \ \ \ \ \ \ \ \ \ (list 1 2 3)))
    </scm-code>
  </cell>|<\cell>
    <\scm-code>
      (((list-view 1 2 3)

      \ \ \ \ \ \ \ \ map (lambda (x) (+ x 1))

      \ \ \ \ \ \ \ \ map (lambda (x) (* x x))))
    </scm-code>
  </cell>>>>>>
    使用list处理数据和使用list-view处理数据的对比
  </big-figure>

  实现list-view时需要考虑三种情况和一种例外情况。

  <\description>
    <item*|无参数>也就是直接在list-view得到的结果外面添加括号，此时得到的是list-view对应的list

    <item*|有两个参数>这里举例说明，<scm|((list-view 1 2 3) map (lambda (x) (+ x 1)))>实际的计算过程是：

    <\enumerate>
      <item>计算并得到结果<scm|(map (lambda (x) (+ x 1)) (list 1 2 3)) =\<gtr\> (list 2 3 4)>

      <item>将计算结果包装到 <scm|list-view> 里面，这里使用了<scm|apply>这个内置函数
    </enumerate>

    其实也是树的转换：

    <\big-figure|<scm|<tree|(list-view 1 2 3)|map|(lambda (x) (+ x 1))>><space|2em><math|\<Rightarrow\>><space|2em><scm|<tree|map|(lambda (x) (+ x 1))|(list 1 2 3)>>>
      原理的可视化
    </big-figure>

    <item*|偶数个参数>在上述两个递归退出条件写好的情况下，在思考这种一般的情况。

    需要计算<scm|((list-view 1 2 3) hf1 f1 hf2 f2 ... hfn fn)>，其中hf指的是high-order function，也就是高阶函数。也就是需要计算：

    <\scm>
      ((((list-view 1 2 3) hf1 f1) hf2 f2) ... hfn fn)
    </scm>

    \;
  </description>

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (list-view scheme-list)

    \ \ (define (f-inner-reducer scheme-list filter filter-func rest-funcs)

    \ \ \ \ (cond ((null? rest-funcs) (list-view (filter filter-func scheme-list)))

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

    \ \ \ \ \ \ \ \ \ \ \ (f-inner-reducer (filter filter-func scheme-list)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car rest-funcs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cadr rest-funcs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr rest-funcs)))))

    \ \ (define (f-inner . funcs)

    \ \ \ \ (cond ((null? funcs) scheme-list)

    \ \ \ \ \ \ \ \ \ \ ((length=? 2 funcs)

    \ \ \ \ \ \ \ \ \ \ \ (list-view ((car funcs) (cadr funcs) scheme-list)))

    \ \ \ \ \ \ \ \ \ \ ((even? (length funcs))

    \ \ \ \ \ \ \ \ \ \ \ (f-inner-reducer scheme-list

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car funcs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cadr funcs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr funcs)))

    \ \ \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "list-view only accepts even number of args"))))

    \ \ f-inner)

    \;
  </scm-chunk>

  <paragraph|flatmap><index|flatmap>

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define flatmap append-map)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    (check (flatmap (lambda (x) (list x x))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (list 1 2 3))

    \ \ =\<gtr\> (list 1 1 2 2 3 3))

    \;

    (check-catch 'type-error (flatmap 1 (list 1 2 3)))

    \;
  </scm-chunk>

  \;

  <paragraph|not-null-list?><index|not-null-list?>

  <scm|null-list?>的反面，会抛出异常。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (not-null-list? l)

    \ \ (cond ((pair? l)

    \ \ \ \ \ \ \ \ \ (or (null? (cdr l)) (pair? (cdr l))))

    \ \ \ \ \ \ \ \ ((null? l) #f)

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (error 'type-error "type mismatch"))))

    \;
  </scm-chunk>

  <paragraph|list-null?><index|null-list?>

  <scm|null-list?>的没有异常的版本，只要不是<scm|list>，都是<scm|#f>。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (list-null? l)

    \ \ (and (not (pair? l)) (null? l)))

    \;
  </scm-chunk>

  <paragraph|list-not-null?><index|list-not-null?>

  <scm|not-null-list?>的没有异常的版本。

  \;

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define (list-not-null? l)

    \ \ (and (pair? l)

    \ \ \ \ \ \ \ (or (null? (cdr l)) (pair? (cdr l)))))

    \;
  </scm-chunk>

  \;

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

    (check (list-not-null? (list 1)) =\<gtr\> #t)

    (check (list-null? (list 1)) =\<gtr\> #f)

    \;

    (check (not-null-list? (list 1 2 3)) =\<gtr\> #t)

    (check (list-not-null? (list 1 2 3)) =\<gtr\> #t)

    (check (list-null? (list 1 2 3)) =\<gtr\> #f)

    \;

    (check (not-null-list? '(a)) =\<gtr\> #t)

    (check (list-not-null? '(a)) =\<gtr\> #t)

    (check (list-null? '(a)) =\<gtr\> #f)

    \;

    (check (not-null-list? '(a b c)) =\<gtr\> #t)

    (check (list-not-null? '(a b c)) =\<gtr\> #t)

    (check (list-null? '(a b c)) =\<gtr\> #f)

    \;

    (check (not-null-list? ()) =\<gtr\> #f)

    (check (list-not-null? ()) =\<gtr\> #f)

    (check (list-null? ()) =\<gtr\> #t)

    \;

    ; '(a) is a pair and a list

    ; '(a . b) is a pair but not a list

    (check (not-null-list? '(a . b)) =\<gtr\> #f)

    (check (list-not-null? '(a . b)) =\<gtr\> #f)

    (check (list-null? '(a . b)) =\<gtr\> #f)

    \;

    (check-catch 'type-error (not-null-list? 1))

    (check (list-not-null? 1) =\<gtr\> #f)

    (check (list-null? 1) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|flatten><index|flatten><scm|(lst [depth]) =\<gtr\> lst>

  (lst [depth]) =\<gtr\> lst

  压平 lst，压为更扁的形状。直观来说，去掉内层列表的括号。例如，<scm|(flatten '(a b (c (d)) (e) ((f))) 'deepest) =\<gtr\> (a b c d e f)>。参数 depth 可选，默认为 1，指定最深压平层数，depth 为 <scm|n> 时，最深压平 n 层列表，depth 为 <scm|'deepest> 时，压平整个列表。

  注意，定义 flatten 应当使用 <scm|define*> 而非 <scm|define> 以支持可选参数。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    (define* (flatten lst (depth 1))
  </scm-chunk>

  包装一般化的 flatten，使用 <scm|set-cdr!> 加速构建列表，

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    \ \ (define (flatten-depth-iter rest depth res-node)

    \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ res-node

    \ \ \ \ \ \ \ \ (let ((first (car rest))

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

    \ \ \ \ \ \ \ \ \ \ (cond ((and (null? first) (not (= 0 depth)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-depth-iter tail depth res-node))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((or (= depth 0) (not (pair? first)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-cdr! res-node (cons first '()))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-depth-iter tail depth (cdr res-node)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-depth-iter

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tail

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ depth

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-depth-iter

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ first

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (- depth 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ res-node)))))))
  </scm-chunk>

  因为要 <scm|set-cdr!> 参数 <scm|res-node> ，所以必须保证后者是 pair，不能是 null。为达成这个目的，可以先 <scm|cons> 一个 pair，之后返回它的 <scm|\<less\>cdr\<gtr\>>。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    \ \ (define (flatten-depth lst depth)

    \ \ \ \ (let ((res (cons #f '())))

    \ \ \ \ \ \ (flatten-depth-iter lst depth res)

    \ \ \ \ \ \ (cdr res)))

    \;
  </scm-chunk>

  注意到 flatten-depth-iter 迭代中（<scm|cond> 第二个子句），不断传递 depth 参数，只是重新绑定而不加改变。然而 goldfish 访问自由变量不比直接传递参数效率更高，只好辗转传递 depth。<scm|(flatten-depth lst -1)> 固然可以用来实现 <scm|(flatten lst -1)>，但总是额外传递一个无意义的参数 depth，效率较低，可以针对这一点进行优化。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    \ \ (define (flatten-deepest-iter rest res-node)

    \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ res-node

    \ \ \ \ \ \ (let ((first (car rest))

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

    \ \ \ \ \ \ \ \ (cond ((pair? first)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-deepest-iter

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tail

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-deepest-iter

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ first

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ res-node)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((null? first)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-deepest-iter tail res-node))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-cdr! res-node (cons first '()))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (flatten-deepest-iter tail (cdr res-node)))))))

    \ \ (define (flatten-deepest lst)

    \ \ \ \ (let ((res (cons #f '())))

    \ \ \ \ \ \ (flatten-deepest-iter lst res)

    \ \ \ \ \ \ (cdr res)))

    \;
  </scm-chunk>

  最后，分派 <scm|flatten-depth> 和 <scm|flatten-deepest>。注意 <scm|flatten> 参数 depth 不应该是除 <scm|n> 和 <scm|'deepest> 以外的任何值，因而，当出现其它值时抛出错误。

  <\scm-chunk|goldfish/liii/list.scm|true|true>
    \ \ (cond ((eq? depth 'deepest)

    \ \ \ \ \ \ \ \ \ (flatten-deepest lst))

    \ \ \ \ \ \ \ \ ((integer? depth)

    \ \ \ \ \ \ \ \ \ (flatten-depth lst depth))

    \ \ \ \ \ \ \ \ (else

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

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

    \ \ \ \ \ \ \ \ \ \ \ \ "flatten: the second argument depth should be symbol "

    \ \ \ \ \ \ \ \ \ \ \ \ "`deepest' or a integer, which will be uesd as depth,"

    \ \ \ \ \ \ \ \ \ \ \ \ " but got a ~A") depth)))

    \ \ ) ; end of (define* (flatten))

    \;
  </scm-chunk>

  测试代码如下。

  <\scm-chunk|tests/goldfish/liii/list-test.scm|true|true>
    ; deepest flatten

    (check (flatten '((a) () (b ()) () (c)) 'deepest) =\<gtr\> '(a b c))

    (check (flatten '((a b) c (((d)) e)) 'deepest) =\<gtr\> '(a b c d e))

    (check (flatten '(a b (() (c))) 'deepest) =\<gtr\> '(a b c))

    ; depth flatten

    (check (flatten '((a) () (b ()) () (c)) 0) =\<gtr\> '((a) () (b ()) () (c)))

    (check (flatten '((a) () (b ()) () (c)) 1) =\<gtr\> '(a b () c))

    (check (flatten '((a) () (b ()) () (c))) =\<gtr\> '(a b () c))

    (check (flatten '((a) () (b ()) () (c)) 2) =\<gtr\> '(a b c))

    (check (flatten '((a) () (b ()) () (c)) -1) =\<gtr\> '(a b c))

    (check (flatten '((a b) c (((d)) e)) 0) =\<gtr\> '((a b) c (((d)) e)))

    (check (flatten '((a b) c (((d)) e)) 1) =\<gtr\> '(a b c ((d)) e))

    (check (flatten '((a b) c (((d)) e))) =\<gtr\> '(a b c ((d)) e))

    (check (flatten '((a b) c (((d)) e)) 2) =\<gtr\> '(a b c (d) e))

    (check (flatten '((a b) c (((d)) e)) 3) =\<gtr\> '(a b c d e))

    (check (flatten '((a b) c (((d)) e)) -1) =\<gtr\> '(a b c d e))

    (check (flatten '(a b (() (c))) 0) =\<gtr\> '(a b (() (c))))

    (check (flatten '(a b (() (c))) 1) =\<gtr\> '(a b () (c)))

    (check (flatten '(a b (() (c)))) =\<gtr\> '(a b () (c)))

    (check (flatten '(a b (() (c))) 2) =\<gtr\> '(a b c))

    (check (flatten '(a b (() (c))) -1) =\<gtr\> '(a b c))

    ; error depth flatten

    (check-catch 'type-error (flatten '((a) () (b ()) () (c)) 'a))

    (check-catch 'type-error (flatten '((a) () (b ()) () (c)) (make-vector 1 1)))

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of library

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-1.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii alist)><label|chapter:liii_alist>

  <section|概述>

  alist-lib是Chicken Scheme中的函数库：

  <\description>
    <item*|文档><slink|https://wiki.call-cc.org/eggref/5/alist-lib>

    <item*|官网><slink|https://github.com/klutometis/alist-lib>
  </description>

  <section|许可证>

  <\goldfish-chunk|goldfish/liii/alist.scm|false|true>
    ;

    ; BSD License by Peter Danenberg

    ;

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/alist-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.

    ;

    \;
  </scm-chunk>

  \;

  <section|接口>

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

    (import (liii base)

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (scheme case-lambda))

    (export alist-ref alist-ref/default)

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii alist))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|alist-ref><index|alist-ref><scm|(alist key thunk =) =\<gtr\> object>

  alist-ref 是一个用于从关联列表（alist）中检索与给定键（key）相关联的值的函数。如果给定的键在列表中不存在，函数将执行一个提供的thunk（或错误处理函数），或者返回一个默认值。

  <subsubsection*|参数>

  <\itemize>
    <item><code*|alist>: 要搜索的关联列表。

    <item><code*|key>: 要检索的键。

    <item><code*|thunk> (可选): 当键不存在时执行的thunk。默认情况下，如果没有提供thunk，函数将抛出一个错误。

    <item><code*|=> (可选): 用于比较键的等价谓词。默认使用 <code*|eqv?>。
  </itemize>

  <subsubsection*|返回值>

  <itemize|<item>返回与给定键相关联的值，或者如果键不存在，则返回thunk的执行结果或默认值。>

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

    \ \ (case-lambda

    \ \ \ \ ((alist key)

    \ \ \ \ \ (alist-ref

    \ \ \ \ \ \ \ alist

    \ \ \ \ \ \ \ key

    \ \ \ \ \ \ \ (lambda () (key-error "alist-ref: key not found " key))))

    \ \ \ \ ((alist key thunk)

    \ \ \ \ \ (alist-ref alist key thunk eqv?))

    \ \ \ \ ((alist key thunk =)

    \ \ \ \ \ (let ((value (assoc key alist =)))

    \ \ \ \ \ \ \ (if value

    \ \ \ \ \ \ \ \ \ \ \ (cdr value)

    \ \ \ \ \ \ \ \ \ \ \ (thunk))))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/alist-test.scm|true|true>
    (check (alist-ref '((a 1)) 'a) =\<gtr\> '(1))

    (check (alist-ref '((a . 1)) 'a) =\<gtr\> 1)

    (check-catch 'key-error (alist-ref '((a . 1)) 'b))

    \;

    (check (alist-ref '((a . 1)) 'b (lambda () 2)) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|alist-ref/default><index|alist-ref/default><scm|(alist key default =) =\<gtr\> object>

  <\goldfish-chunk|goldfish/liii/alist.scm|true|true>
    (define alist-ref/default

    \ \ (case-lambda

    \ \ \ \ ((alist key default)

    \ \ \ \ \ (alist-ref alist key (lambda () default)))

    \ \ \ \ ((alist key default =)

    \ \ \ \ \ (alist-ref alist key (lambda () default) =))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/alist-test.scm|true|true>
    (check (alist-ref/default '((a . 1)) 'b 2) =\<gtr\> 2)

    \;
  </scm-chunk>

  \;

  <section|结束>

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

    ) ; end of library

    \;
  </goldfish-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii bitwise)><label|chapter:liii_bitwise>

  <section|概述>

  位运算的基本规则如下表所示：

  <\big-table|<math|<tabular|<tformat|<cwith|2|-1|2|-1|cell-halign|r>|<cwith|2|2|1|-1|cell-tborder|1ln>|<cwith|1|1|1|-1|cell-bborder|1ln>|<cwith|2|2|1|-1|cell-bborder|0ln>|<cwith|3|3|1|-1|cell-tborder|0ln>|<cwith|2|2|1|1|cell-lborder|0ln>|<cwith|2|2|5|5|cell-rborder|0ln>|<cwith|1|1|2|2|cell-tborder|0ln>|<cwith|4|4|2|2|cell-bborder|0ln>|<cwith|1|-1|2|2|cell-lborder|1ln>|<cwith|1|-1|1|1|cell-rborder|1ln>|<cwith|1|-1|2|2|cell-rborder|0ln>|<cwith|1|-1|3|3|cell-lborder|0ln>|<table|<row|<cell|>|<cell|1 op 1>|<cell|1 op 0>|<cell|0 op 1>|<cell|0 op 0>>|<row|<cell|and>|<cell|1>|<cell|0>|<cell|0>|<cell|0>>|<row|<cell|or>|<cell|1>|<cell|1>|<cell|1>|<cell|0>>|<row|<cell|xor>|<cell|0>|<cell|1>|<cell|1>|<cell|0>>>>>>>
    二进制1位位运算表
  </big-table>

  在金鱼Scheme中，整数类型是64位的有符号整数，上述运算规则执行64次，就是金鱼Scheme中整数的位运算具体规则。

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-151.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/bitwise-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (srfi srfi-151)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ \ ; from (srfi srfi-151)

    \ \ bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-or bitwise-nor bitwise-nand

    \ \ bit-count bitwise-orc1 bitwise-orc2 bitwise-andc1 bitwise-andc2

    \ \ arithmetic-shift

    \ \ ; S7 built-in

    \ \ lognot logand logior logxor

    \ \ ash

    )

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define-library (srfi srfi-151)

    (export

    \ \ bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-nor bitwise-nand bit-count\ 

    \ \ bitwise-orc1 bitwise-orc2 bitwise-andc1 bitwise-andc2

    \ \ arithmetic-shift

    )

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii bitwise))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <subsection|基础运算>

  <paragraph|lognot><index|lognot>

  <value|srfi><paragraph|bitwise-not><index|bitwise-not><typehint|((x integer?)) =\<gtr\> boolean?>

  使用S7内置的lognot实现，不推荐使用<scm|lognot>。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define bitwise-not lognot)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-not 0) =\<gtr\> -1)

    (check (bitwise-not 1) =\<gtr\> -2)

    (check (bitwise-not #b1000) =\<gtr\> -9)

    (check (bitwise-not -1) =\<gtr\> 0)

    \;
  </scm-chunk>

  <paragraph|logand><index|logand>

  <value|srfi><paragraph|bitwise-and><index|bitwise-and><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|logand>实现，不推荐使用<scm|logand>。此函数应用<with|font-family|tt|and>运算在整数的二进制表示上。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define bitwise-and logand)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-and 5 3) =\<gtr\> 1) \ ; 5 (101) AND 3 (011) = 1 (001)

    (check (bitwise-and 8 4) =\<gtr\> 0) \ ; 8 (1000) AND 4 (0100) = 0 (0000)

    (check (bitwise-and #b101 #b011) =\<gtr\> 1) \ ; 5 (101) AND 3 (011) = 1 (001) \ 

    (check (bitwise-and #b1000 #b0100) =\<gtr\> 0) ; 8 (1000) AND 4 (0100) = 0 (0000)

    (check (bitwise-and #b1100 #b1010) =\<gtr\> 8)\ 

    \;
  </scm-chunk>

  \;

  <paragraph|logior><index|logior>

  <value|srfi><paragraph|bitwise-or><index|bitwise-or><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|logior>实现，不推荐使用<scm|logior>。此函数应用<with|font-family|tt|or>运算在整数的二进制表示上。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define bitwise-ior logior)

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/bitwise.scm|true|true>
    (define bitwise-or bitwise-ior)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-ior 5 3) =\<gtr\> 7) \ ; 5 (101) OR 3 (011) = 7 (111)

    (check (bitwise-or 5 3) =\<gtr\> 7)

    (check (bitwise-ior 8 4) =\<gtr\> 12) ; 8 (1000) OR 4 (0100) = 12 (1100)

    (check (bitwise-ior #b101 #b011) =\<gtr\> 7) \ ; 5 (101) AND 3 (011) = 1 (001) \ 

    (check (bitwise-ior #b1000 #b0100) =\<gtr\> 12) ; 8 (1000) AND 4 (0100) = 0 (0000)

    (check (bitwise-ior #b1100 #b0001) =\<gtr\> 13)

    \;
  </scm-chunk>

  <paragraph|logxor><index|logxor>

  <value|srfi><paragraph|bitwise-xor><index|bitwise-xor><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<scm|logxor>实现，不推荐使用<scm|logxor>，推荐使用<scm|bitwise-xor>。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define bitwise-xor logxor)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-xor 1 1) =\<gtr\> 0)

    (check (bitwise-xor #b10 #b11) =\<gtr\> #b01) ; 2 xor 3 = 1

    (check (bitwise-xor #b101010 #b110100) =\<gtr\> #b011110) ; 42 xor 20 = 34

    (check (bitwise-xor #b0 #b0) =\<gtr\> #b0) ; 0 xor 0 = 0

    (check (bitwise-xor #b1 #b1) =\<gtr\> #b0) ; 1 xor 1 = 0

    (check (bitwise-xor #b101 #b111) =\<gtr\> #b010) ; 5 xor 7 = 2

    (check (bitwise-xor #b1000 #b1001) =\<gtr\> #b0001) ; 8 xor 9 = 1

    (check (bitwise-xor #b10010101 #b01111001) =\<gtr\> #b11101100)

    \;
  </scm-chunk>

  \;

  <paragraph|lognot><index|lognot>

  <value|srfi><paragraph|bitwise-nor><index|bitwise-nor><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|lognot>和<scm|bitwise-ior>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-nor a b) \ 

    \ \ \ \ \ \ \ \ (lognot (bitwise-ior a b)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-nor 2 4) =\<gtr\> -7) \ 

    (check (bitwise-nor 3 1) =\<gtr\> -4) \ 

    (check (bitwise-nor #b111 #b011) =\<gtr\> -8) \ 

    (check (bitwise-nor #b1101 #b1011) =\<gtr\> -16)\ 

    (check (bitwise-nor #b1100 #b0000) =\<gtr\> -13)\ 

    \;
  </scm-chunk>

  \;

  <paragraph|lognot><index|lognot>

  <value|srfi><paragraph|bitwise-nand><index|bitwise-nand><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|lognot>和<scm|bitwise-and>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-nand a b) \ 

    \ \ \ \ \ \ \ \ (lognot (bitwise-and a b)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-nand 1 1) =\<gtr\> -2) \ 

    (check (bitwise-nand 3 1) =\<gtr\> -2) \ 

    (check (bitwise-nand #b110 #b001) =\<gtr\> -1) \ \ \ 

    (check (bitwise-nand #b1001 #b0111) =\<gtr\> -2)\ 

    (check (bitwise-nand #b1011 #b0101) =\<gtr\> -2)\ 

    \;
  </scm-chunk>

  <value|srfi><paragraph|bit-count><index|bit-count><scm|((i integer?)) =\<gtr\> integer?>

  如果i是正数，统计i的二进制表示中的1的数量。如果i是负数，统计i的二进制表示中的0的数量。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define bit-count\ 

    \ \ (typed-lambda ((i integer?))

    \ \ \ \ (define (bit-count-positive i)

    \ \ \ \ \ \ (let loop ((n i) (cnt 0))

    \ \ \ \ \ \ \ \ (if (= n 0)

    \ \ \ \ \ \ \ \ \ \ \ \ cnt

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (logand n (- n 1)) (+ cnt 1)))))

    \;

    \ \ \ \ (cond ((zero? i) 0)

    \ \ \ \ \ \ \ \ \ \ ((positive? i) (bit-count-positive i))

    \ \ \ \ \ \ \ \ \ \ (else (bit-count-positive (lognot i))))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bit-count 0) =\<gtr\> \ 0)

    (check (bit-count -1) =\<gtr\> \ 0)

    (check (bit-count 7) =\<gtr\> \ 3)

    (check (bit-count \ 13) =\<gtr\> \ 3)

    (check (bit-count -13) =\<gtr\> \ 2)

    (check (bit-count \ 30) =\<gtr\> \ 4)

    (check (bit-count -30) =\<gtr\> \ 4)

    (check (bit-count (arithmetic-shift #b10 61)) =\<gtr\> 1)

    \;
  </scm-chunk>

  \;

  <value|srfi><paragraph|bitwise-orc1><index|bitwise-orc1><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|bitwise-ior>和<scm|bitwise-not>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-orc1 i j)

    \ \ (bitwise-ior (bitwise-not i) j))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-orc1 1 1) =\<gtr\> -1)

    (check (bitwise-orc1 3 1) =\<gtr\> -3)

    (check (bitwise-orc1 11 26) =\<gtr\> -2)

    (check (bitwise-orc1 #b110 #b001) =\<gtr\> -7)

    (check (bitwise-orc1 #b1001 #b0111) =\<gtr\> -9)

    (check (bitwise-orc1 #b1011 #b0101) =\<gtr\> -11)

    \;
  </scm-chunk>

  \;

  <value|srfi><paragraph|bitwise-orc2><index|bitwise-orc2><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<with|font-family|tt|bitwise-ior>和<scm|bitwise-not>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-orc2 \ i j)\ 

    \ \ (bitwise-ior i (bitwise-not j)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-orc2 11 26) =\<gtr\> -17)

    (check (bitwise-orc2 3 1) =\<gtr\> -1)

    (check (bitwise-orc2 #b110 #b001) =\<gtr\> -2)

    (check (bitwise-orc2 #b1001 #b0111) =\<gtr\> -7)

    (check (bitwise-orc2 #b1011 #b0101) =\<gtr\> -5)

    \;
  </scm-chunk>

  \;

  <value|srfi><paragraph|bitwise-andc1><index|bitwise-andc1><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<scm|bitwise-and>和<scm|bitwise-not>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-andc1 i j) \ 

    \ \ (bitwise-and (bitwise-not i) j))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-andc1 11 26) =\<gtr\> 16)

    (check (bitwise-andc1 5 3) =\<gtr\> 2)

    (check (bitwise-andc1 #b1100 #b1010) =\<gtr\> 2)

    (check (bitwise-andc1 0 15) =\<gtr\> 15)

    (check (bitwise-andc1 15 0) =\<gtr\> 0)

    (check (bitwise-andc1 7 1) =\<gtr\> 0)

    \;
  </scm-chunk>

  \;

  <value|srfi><paragraph|bitwise-andc2><index|bitwise-andc2><typehint|((a integer?) (b integer?)) =\<gtr\> boolean?>

  使用S7内置的<scm|bitwise-and>和<scm|bitwise-not>实现。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define (bitwise-andc2 i j)\ 

    \ \ (bitwise-and i (bitwise-not j)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (bitwise-andc2 11 26) =\<gtr\> 1)

    (check (bitwise-andc2 5 3) =\<gtr\> 4)

    (check (bitwise-andc2 #b1100 #b1010) =\<gtr\> 4)

    (check (bitwise-andc2 0 15) =\<gtr\> 0)

    (check (bitwise-andc2 15 0) =\<gtr\> 15)

    (check (bitwise-andc2 7 1) =\<gtr\> 6)

    \;
  </scm-chunk>

  <subsection|整数运算>

  <paragraph|ash><index|ash>

  <value|srfi><paragraph|arithmetic-shift><index|arithmetic-shift><typehint|((i integer?) (shift integer?)) =\<gtr\> integer?>

  log开头的S7内置函数不推荐使用，原因是log不符合位运算的语义，<scm|ash>是<scm|arithmetic-shift>的简写，能够有效避免<scm|arithmetic>这个单词拼写错误的可能性，仍旧是推荐使用的。从代码可读性上考虑，还是使用<scm|arithmetic-shift>更加合适。

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|true>
    (define arithmetic-shift ash)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/bitwise-test.scm|true|true>
    (check (arithmetic-shift #b10 -1) =\<gtr\> #b1) ; 2 \<gtr\>\<gtr\> 1 = 1

    (check (arithmetic-shift #b10 1) =\<gtr\> #b100) ; 2 \<less\>\<less\> 1 = 4

    (check (arithmetic-shift #b1000 -2) =\<gtr\> #b10) ; 8 \<gtr\>\<gtr\> 2 = 2

    (check (arithmetic-shift #b1000 2) =\<gtr\> #b100000)

    (check (arithmetic-shift #b10000000000000000 -3) =\<gtr\> #b10000000000000)

    (check (arithmetic-shift #b1000000000000000 3) =\<gtr\> #b1000000000000000000)

    \;
  </scm-chunk>

  \;

  <subsection|单位运算>

  <subsection|按位运算>

  <subsection|按位转换>

  <subsection|高阶函数>

  <section|结束>

  <paragraph|SRFI-151 End>

  <\scm-chunk|goldfish/srfi/srfi-151.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    ) ; end of library

    \;
  </scm-chunk>

  <paragraph|Report Test Result>

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

    \;
  </scm-chunk>

  <chapter|(liii string)><label|chapter:liii_string>

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-13.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (export

    \ \ ; S7 built-in

    \ \ string? string-ref string-length

    \ \ ; from (scheme base)

    \ \ string-copy string-for-each string-map

    \ \ ; from (srfi srfi-13)

    \ \ string-null? string-join

    \ \ string-every string-any

    \ \ string-take string-take-right string-drop string-drop-right

    \ \ string-pad string-pad-right

    \ \ string-trim string-trim-right string-trim-both

    \ \ string-index string-index-right

    \ \ string-contains string-count

    \ \ string-upcase string-downcase

    \ \ string-reverse

    \ \ string-tokenize

    \ \ ; Liii extras

    \ \ string-starts? string-ends?

    \ \ string-remove-prefix string-remove-suffix

    )

    (import (srfi srfi-13)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii error))

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define-library (srfi srfi-13)

    \ \ (import

    \ \ \ \ (liii base)

    \ \ \ \ (srfi srfi-1))

    \ \ (export

    \ \ \ \ string-null? string-copy string-join

    \ \ \ \ string-every string-any

    \ \ \ \ string-take string-take-right string-drop string-drop-right\ 

    \ \ \ \ string-pad string-pad-right

    \ \ \ \ string-trim string-trim-right string-trim-both

    \ \ \ \ string-prefix? string-suffix?\ 

    \ \ \ \ string-index string-index-right

    \ \ \ \ string-contains string-count

    \ \ \ \ string-upcase string-downcase

    \ \ \ \ string-reverse

    \ \ \ \ string-tokenize)

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii string))

    \;

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

    \;
  </scm-chunk>

  <section|SRFI 13>

  <subsection|内部公共子函数>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (%string-from-range str start_end)

    \ \ (cond ((null-list? start_end) str)

    \ \ \ \ \ \ \ \ ((= (length start_end) 1)

    \ \ \ \ \ \ \ \ \ \ (substring str (car start_end)))

    \ \ \ \ \ \ \ \ ((= (length start_end) 2)

    \ \ \ \ \ \ \ \ \ (substring str (first start_end) (second start_end)))

    \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args "%string-from-range"))))

    \;
  </scm-chunk>

  <todo|测试一下边界条件，这样后面漏测也没关系了。>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (%make-criterion char/pred?)

    \ \ (cond ((char? char/pred?) (lambda (x) (char=? x char/pred?)))

    \ \ \ \ \ \ \ \ ((procedure? char/pred?) char/pred?)

    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "%make-criterion"))))

    \;
  </scm-chunk>

  <subsection|谓词>

  <r7rs><paragraph|string?><index|string?>

  <scm|string?>是一个S7内置的谓词函数，当且仅当参数对象类型是字符串（例如<scm|"MathAgape">）时返回<scm|#t>，否则都返回<scm|#f>。当参数为符号（例如<scm|'MathAgape>）、字符（例如<scm|#/MathAgape>）、数字（例如<scm|123>）、列表（例如<scm|'(1 2 3)>）这些非字符串类型时，都返回<scm|#f>。<scm|string?>用于确定对象是否可以被当作字符串处理，在需要执行对字符串特定操作时特别有用，避免类型错误。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string? "MathAgape") =\<gtr\> #t)

    (check (string? "") =\<gtr\> #t)

    \;

    (check (string? 'MathAgape) =\<gtr\> #f)

    (check (string? #/MathAgape) =\<gtr\> #f)

    (check (string? 123) =\<gtr\> #f)

    (check (string? '(1 2 3)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <subsection|列表-字符串转换>

  <r7rs><paragraph|string-\<gtr\>list><index|string-\<gtr\>list>

  <scm|string-\<gtr\>list>是一个S7内置的函数，用于将字符串转换为字符列表。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-\<gtr\>list "MathAgape")

    \ \ =\<gtr\> '(#\\M #\\a #\\t #\\h #\\A #\\g #\\a #\\p #\\e))

    \;

    (check (string-\<gtr\>list "") =\<gtr\> '())

    \;
  </scm-chunk>

  <r7rs><paragraph|list-\<gtr\>string><index|list-\<gtr\>string>

  <scm|list-\<gtr\>string>是一个S7内置的函数，用于将字符列表转换为字符串。

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

    \ \ (list-\<gtr\>string '(#\\M #\\a #\\t #\\h #\\A #\\g #\\a #\\p #\\e))

    \ \ =\<gtr\> "MathAgape")

    \;

    (check (list-\<gtr\>string '()) =\<gtr\> "")

    \;
  </scm-chunk>

  <paragraph|string-join><scm|(l [delim [grammer]]) =\<gtr\> string><index|string-join>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-join l . delim+grammer)

    \ \ (define (extract-params params-l)

    \ \ \ \ (cond ((null-list? params-l)

    \ \ \ \ \ \ \ \ \ \ \ (list "" 'infix))

    \ \ \ \ \ \ \ \ \ \ ((and (= (length params-l) 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string? (car params-l)))

    \ \ \ \ \ \ \ \ \ \ \ (list (car params-l) 'infix))

    \ \ \ \ \ \ \ \ \ \ ((and (= (length params-l) 2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string? (first params-l))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol? (second params-l)))

    \ \ \ \ \ \ \ \ \ \ \ params-l)

    \ \ \ \ \ \ \ \ \ \ ((\<gtr\> (length params-l) 2)

    \ \ \ \ \ \ \ \ \ \ \ (error 'wrong-number-of-args "optional params in string-join"))

    \ \ \ \ \ \ \ \ \ \ (else (error 'type-error "optional params in string-join"))))

    \ \ 

    \ \ (define (string-join-sub l delim)

    \ \ \ \ (cond ((null-list? l) "")

    \ \ \ \ \ \ \ \ \ \ ((= (length l) 1) (car l))

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

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car l)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ delim

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-join-sub (cdr l) delim)))))

    \ \ 

    \ \ (let* ((params \ (extract-params delim+grammer))

    \ \ \ \ \ \ \ \ \ (delim \ \ (first params))

    \ \ \ \ \ \ \ \ \ (grammer (second params))

    \ \ \ \ \ \ \ \ \ (ret \ \ \ \ (string-join-sub l delim)))

    \ \ \ \ (case grammer

    \ \ \ \ \ \ ('infix ret)

    \ \ \ \ \ \ ('strict-infix

    \ \ \ \ \ \ \ (if (null-list? l)

    \ \ \ \ \ \ \ \ \ \ \ (error 'value-error "empty list not allowed")

    \ \ \ \ \ \ \ \ \ \ \ ret))

    \ \ \ \ \ \ ('suffix

    \ \ \ \ \ \ \ \ (if (null-list? l) "" (string-append ret delim)))

    \ \ \ \ \ \ ('prefix

    \ \ \ \ \ \ \ \ (if (null-list? l) "" (string-append delim ret)))

    \ \ \ \ \ \ (else (error 'value-error "invalid grammer")))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-join '("a" "b" "c")) =\<gtr\> "abc")

    \;

    (check (string-join '("a" "b" "c") ":") =\<gtr\> "a:b:c")

    (check (string-join '("a" "b" "c") ":" 'infix) =\<gtr\> "a:b:c")

    (check (string-join '("a" "b" "c") ":" 'suffix) =\<gtr\> "a:b:c:")

    (check (string-join '("a" "b" "c") ":" 'prefix) =\<gtr\> ":a:b:c")

    \;

    (check (string-join '() ":") =\<gtr\> "")

    (check (string-join '() ":" 'infix) =\<gtr\> "")

    (check (string-join '() ":" 'prefix) =\<gtr\> "")

    (check (string-join '() ":" 'suffix) =\<gtr\> "")

    \;

    (check-catch 'value-error (string-join '() ":" 'strict-infix))

    (check-catch 'type-error (string-join '() ":" 2))

    (check-catch 'value-error (string-join '() ":" 'no-such-grammer))

    (check-catch 'wrong-number-of-args (string-join '() ":" 1 2 3))

    \;
  </scm-chunk>

  <subsection|谓词>

  <paragraph|string-null?><index|string-null?><scm|(str) =\<gtr\> boolean>

  <scm|<code|<code*|string-null?>>>是一个谓词函数，当且仅当参数字符串为空（即长度为0）时返回<scm|#t>，否则都返回<scm|#f>，也就是说，当参数是非字符串或长度不为0的字符串时，返回<scm|#f>。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-null? str)

    \ \ (and (string? str)\ 

    \ \ \ \ \ \ \ ((lambda (x) (= x 0)) (string-length str))))

    \;
  </scm-chunk>

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

    \;

    (check-false (string-null? "MathAgape"))

    \;

    (check-false (string-null? 'not-a-string))

    \;
  </scm-chunk>

  <paragraph|string-every><index|string-every>

  <scm|string-every>是一个谓词函数，它接收一个字符串<scm|str>和一个评估规则<scm|criterion>为参数，以及最多2个非负整数为可选参数<scm|. start_end>用于指定搜索的起始位置和结束位置，检查指定范围内字符串中的每个字符是否都满足评估规则<scm|criterion>。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-every char/pred? str . start+end)

    \ \ (define (string-every-sub pred? str)

    \ \ \ \ (let

    \ \ \ \ \ \ loop ((i 0) (len (string-length str)))

    \ \ \ \ \ \ (or (= i len)

    \ \ \ \ \ \ \ \ \ \ (and (pred? (string-ref str i))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) len)))))

    \ \ 

    \ \ (let ((str-sub (%string-from-range str start+end))

    \ \ \ \ \ \ \ \ (criterion (%make-criterion char/pred?)))

    \ \ \ \ (string-every-sub criterion str-sub)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-every #\\x "xxxxxx"))

    (check-false (string-every #\\x "xxx0xx"))

    \;

    (check-true (string-every char-numeric? "012345"))

    (check-false (string-every char-numeric? "012d45"))

    \;
  </scm-chunk>

  注意，评估规则<scm|criterion>必须是谓词或字符，否则报错。

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-catch 'wrong-type-arg (string-every 1 "012345"))

    (check-catch 'wrong-type-arg (string-every #\\012345 "012345"))

    (check-catch 'wrong-type-arg (string-every "012345" "012345"))

    \;
  </scm-chunk>

  注意，谓词要使用字符属性测试函数（例如<scm|char-numeric?>），不要用类型检查函数（例如<scm|<code*|number?>>），否则失去了检查的意义。

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-every char-numeric? "012345"))

    (check-false (string-every number? "012345"))

    \;
  </scm-chunk>

  对于可选参数<scm|. start_end>：没有可选参数时，默认搜索整个字符串；只有1个可选参数时，该数指定的是起始位置，结束位置默认为字符串的最后一个字符。注意，有2个可选参数时，第二个数不能小于第一个数，否则报错；指定的起始位置和结束位置不能超过字符串<scm|str>的起始范围，否则报错；可选参数超过2个时，报错。（注意，可选参数的规则适用于后面所有调用到<scm|%string-from-range>的函数）

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-every char-numeric? "ab2345" 2))

    (check-false (string-every char-numeric? "ab2345" 1))

    (check-false (string-every \ char-numeric? "ab234f" 2))

    (check-true (string-every char-numeric? "ab234f" 2 4))

    (check-true (string-every char-numeric? "ab234f" 2 2))

    (check-false (string-every char-numeric? "ab234f" 1 4))

    (check-true (string-every char-numeric? "ab234f" 2 5))

    (check-false (string-every char-numeric? "ab234f" 2 6))

    \;

    (check-catch 'out-of-range (string-every char-numeric? "ab234f" 2 7))

    (check-catch 'out-of-range (string-every char-numeric? "ab234f" 2 1))

    \;
  </scm-chunk>

  <paragraph|string-any><index|string-any>

  <scm|string-any>是一个谓词函数，它接收一个谓词和一个字符串为参数，用于检查字符串中是否存在字符都满足谓词。注意，这里的谓词必须是字符属性测试函数，否则报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-any char/pred? str . start+end)

    \ \ (define (string-any-sub pred? str)

    \ \ \ \ (let loop ((i 0) (len (string-length str)))

    \ \ \ \ \ \ (if (= i len)

    \ \ \ \ \ \ \ \ \ \ #f \ \ 

    \ \ \ \ \ \ \ \ \ \ (or (pred? (string-ref str i))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) len)))))

    \ \ 

    \ \ (let ((str_sub (%string-from-range str start+end))

    \ \ \ \ \ \ \ \ (criterion (%make-criterion char/pred?)))

    \ \ \ \ (string-any-sub criterion str_sub)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-any #\\0 "xxx0xx"))

    (check-false (string-any #\\0 "xxxxxx"))

    (check-true (string-any char-numeric? "xxx0xx"))

    (check-false (string-any char-numeric? "xxxxxx"))

    \;
  </scm-chunk>

  注意，评估规则<scm|criterion>必须是谓词或字符，否则报错。

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-catch 'wrong-type-arg (string-every 0 "xxx0xx"))

    (check-catch 'wrong-type-arg (string-any (lambda (n) (= n 0)) "xxx0xx"))

    (check-catch 'wrong-type-arg (string-every "0" "xxx0xx"))

    \;
  </scm-chunk>

  对于可选参数：

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-any char-alphabetic? "01c345" 2))

    (check-false (string-any char-alphabetic? "01c345" 3))

    (check-true (string-any <code*|char-alphabetic?> "01c345" 2 4))

    (check-false (string-any char-alphabetic? "01c345" 2 2))

    (check-false (string-any char-alphabetic? "01c345" 3 4))

    (check-true (string-any char-alphabetic? "01c345" 2 6))

    \;

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-any\ 

    \ \ \ \ \ \ \ \ \ char-alphabetic?

    \ \ \ \ \ \ \ \ "01c345"

    \ \ \ \ \ \ \ \ 2

    \ \ \ \ \ \ \ \ 7))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-any\ 

    \ \ \ \ \ \ \ \ \ char-alphabetic?

    \ \ \ \ \ \ \ \ "01c345"

    \ \ \ \ \ \ \ 2

    \ \ \ \ \ \ \ 1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;
  </scm-chunk>

  <subsection|选择器>

  <r7rs><paragraph|string-length><index|string-length>

  <scm|string-length>是一个S7内置的函数，它接收一个字符串作为参数，返回一个表示该字符串长度的整数，即字符串中包含的字符数。当参数不是字符串，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-length "MathAgape") =\<gtr\> 9)

    (check (string-length "") =\<gtr\> 0)

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda () (string-length 'not-a-string))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;
  </scm-chunk>

  <r7rs><paragraph|string-ref><index|string-ref>

  <scm|string-ref>是一个S7内置的函数，接收一个字符串和一个称为索引值的非负整数k为参数，通过索引值k返回字符串的第k个元素（从0开始计数）。当参数为空字符串时，报错。当k为负数，报错。当k大于等于字符串中字符数时，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-ref "MathAgape" 0) =\<gtr\> #\\M)

    (check (string-ref "MathAgape" 2) =\<gtr\> #\\t)

    \;

    (check-catch 'out-of-range (string-ref "MathAgape" -1))

    (check-catch 'out-of-range (string-ref "MathAgape" 9))

    (check-catch 'out-of-range (string-ref "" 0))

    \;
  </scm-chunk>

  <r7rs><paragraph|string-copy><index|string-copy>

  <scm|string-copy>是一个S7内置的函数，用于创建一个现有字符串的副本。这个函数返回一个与原始字符串内容完全相同的新字符串，但它们在内存中是两个独立的实体。也就是说，原始字符串和副本字符串内容相同，但它们是不同的对象，这可以用<code|<code*|equal?>>和<code|<code*|eq?>>对比出来。

  <scm|string-copy>和<scm|%string-from-range>的实现比较接近，区别在于：在没有指定字符串的范围的时候，我们需要使用<scm|substring>来模拟整个字符串的拷贝。S7内置的函数只提供了整个字符串的拷贝，R7RS和SRFI-13是需要额外的字符串的范围的，所以需要重新实现。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (string-copy str . start_end)

    \ \ (cond ((null? start_end)

    \ \ \ \ \ \ \ \ \ (substring str 0))

    \ \ \ \ \ \ \ \ ((= (length start_end) 1)

    \ \ \ \ \ \ \ \ \ \ (substring str (car start_end)))

    \ \ \ \ \ \ \ \ ((= (length start_end) 2)

    \ \ \ \ \ \ \ \ \ (substring str (car start_end) (cadr start_end)))

    \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (define original-string "MathAgape")

    (define copied-string (string-copy original-string))

    \;

    (check-true (equal? original-string copied-string))

    (check-false (eq? original-string copied-string))

    \;

    (check-true

    \ \ (equal? (string-copy "MathAgape" 4)

    \ \ \ \ \ \ \ \ \ \ (string-copy "MathAgape" 4)))

    \;

    (check-false

    \ \ (eq? (string-copy "MathAgape" 4)

    \ \ \ \ \ \ \ (string-copy "MathAgape" 4)))

    \;

    (check-true

    \ \ (equal? (string-copy "MathAgape" 4 9)

    \ \ \ \ \ \ \ \ \ \ (string-copy "MathAgape" 4 9)))

    \;

    (check-false

    \ \ (eq? (string-copy "MathAgape" 4 9)

    \ \ \ \ \ \ \ (string-copy "MathAgape" 4 9)))

    \;
  </scm-chunk>

  \;

  <paragraph|string-take><index|string-take>

  <scm|string-take>是一个函数，接收一个字符串和一个非负整数k为参数，返回字符串的前k个字符组成的新字符串。当字符串字符数量不足k个，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-take str k)

    \ \ (substring str 0 k))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-take "MathAgape" 4) =\<gtr\> "Math")

    \;

    (check-catch 'out-of-range (string-take "MathAgape" 20))

    \;
  </scm-chunk>

  <paragraph|string-take-right><index|string-take-right>

  <scm|string-take-right>是一个函数，接收一个字符串和一个非负整数k为参数，取出字符串的后k个字符组成新字符串，返回这个新字符串。当字符串字符数量不足k个，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-take-right str k)

    \ \ (let ((N (string-length str)))

    \ \ \ \ (if (\<gtr\> k N)

    \ \ \ \ \ \ \ \ (error 'out-of-range "k must be \<less\>= N" k N))

    \ \ \ \ \ \ \ \ (substring str (- N k) N)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-take-right "MathAgape" 0) =\<gtr\> "")

    (check (string-take-right "MathAgape" 1) =\<gtr\> "e")

    (check (string-take-right "MathAgape" 9) =\<gtr\> "MathAgape")

    \;

    (check-catch 'out-of-range (string-take-right "MathAgape" 20))

    \;
  </scm-chunk>

  <paragraph|string-drop><index|string-drop>

  <scm|string-drop>是一个函数，接收一个字符串和一个非负整数k为参数，返回去掉字符串前k个字符组成的新字符串。当字符串字符数量不足k个，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define string-drop

    \ \ (typed-lambda ((str string?) (k integer?))

    \ \ \ \ (when (\<less\> k 0)

    \ \ \ \ \ \ (error 'out-of-range "k must be non-negative" k))

    \ \ \ \ (let ((N (string-length str)))

    \ \ \ \ \ \ (if (\<gtr\> k N)

    \ \ \ \ \ \ \ \ (error 'out-of-range "k must be \<less\>= N" k N)

    \ \ \ \ \ \ \ \ (substring str k N)))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-drop "MathAgape" 8) =\<gtr\> "e")

    (check (string-drop "MathAgape" 9) =\<gtr\> "")

    (check (string-drop "MathAgape" 0) =\<gtr\> "MathAgape")

    \;

    (check-catch 'out-of-range (string-drop "MahtAgape" -1))

    (check-catch 'out-of-range (string-drop "MathAgape" 20))

    \;
  </scm-chunk>

  <paragraph|string-drop-right><index|string-drop-right><scm|(str k) =\<gtr\> string>

  <scm|string-drop-right>是一个函数，接收一个字符串和一个非负整数k为参数，去掉字符串的后k个字符组成新字符串，返回这个新字符串。当字符串字符数量不足k个，报错。当k为负数，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define string-drop-right

    \ \ (typed-lambda ((str string?) (k integer?))

    \ \ \ \ (when (\<less\> k 0)

    \ \ \ \ \ \ (error 'out-of-range "k must be non-negative" k))

    \ \ \ \ (let ((N (string-length str)))

    \ \ \ \ \ \ (if (\<gtr\> k N)

    \ \ \ \ \ \ \ \ (error 'out-of-range "k must be \<less\>= N" k N)

    \ \ \ \ \ \ \ \ (substring str 0 (- N k))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-drop-right "MathAgape" 5) =\<gtr\> "Math")

    (check (string-drop-right "MathAgape" 9) =\<gtr\> "")

    (check (string-drop-right "MathAgape" 0) =\<gtr\> "MathAgape")

    \;

    (check-catch 'out-of-range (string-drop-right "MathAgape" -1))

    (check-catch 'out-of-range (string-drop-right "MathAgape" 20))

    \;
  </scm-chunk>

  <paragraph|string-pad><index|string-pad>

  <scm|string-pad>是一个函数，接收一个字符串、一个指定长度（非负整数）为参数，从左填充空格字符直到指定长度，返回这个新字符。当指定长度等于字符串长度，返回的字符串和原字符串内容相同。当指定长度小于字符串长度，则从左去掉字符直到指定长度，返回这个新字符。当参数的指定长度为负数时，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-pad str len . char+start+end)

    \ \ (define (string-pad-sub str len ch)

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

    \ \ \ \ \ \ (if (\<less\> len orig-len)

    \ \ \ \ \ \ \ \ \ \ (string-take-right str len)

    \ \ \ \ \ \ \ \ \ \ (string-append (make-string (- len orig-len) ch) str))))

    \ \ 

    \ \ (cond ((null-list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-pad-sub str len #\\ ))

    \ \ \ \ \ \ \ \ ((list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-pad-sub

    \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str (cdr char+start+end))

    \ \ \ \ \ \ \ \ \ \ \ len

    \ \ \ \ \ \ \ \ \ \ \ (car char+start+end)))

    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "string-pad"))))

    \;
  </scm-chunk>

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

    (check (string-pad "MathAgape" 12 #\\1) =\<gtr\> "111MathAgape")

    (check (string-pad "MathAgape" 6 #\\1 0 4) =\<gtr\> "11Math")

    (check (string-pad "MathAgape" 9) =\<gtr\> "MathAgape")

    (check (string-pad "MathAgape" 5) =\<gtr\> "Agape")

    (check (string-pad "MathAgape" 2 #\\1 0 4) =\<gtr\> "th")

    \;

    (check-catch 'out-of-range (string-pad "MathAgape" -1))

    \;
  </scm-chunk>

  <paragraph|string-pad-right><index|string-pad-right>

  <scm|string-pad-right>是一个函数，接收一个字符串、一个指定长度（非负整数）为参数，从右填充空格字符直到指定长度，返回这个新字符。当指定长度等于字符串长度，返回的字符串和原字符串内容相同。当指定长度小于字符串长度，则从右去掉字符直到指定长度，返回这个新字符。当参数的指定长度为负数时，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-pad-right str len . char+start+end)

    \ \ (define (string-pad-right-sub str len ch)

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

    \ \ \ \ \ \ (if (\<less\> len orig-len)

    \ \ \ \ \ \ \ \ \ \ (string-take str len)

    \ \ \ \ \ \ \ \ \ \ (string-append str (make-string (- len orig-len) ch)))))

    \ \ 

    \ \ (cond ((null-list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-pad-right-sub str len #\\ ))

    \ \ \ \ \ \ \ \ ((list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-pad-right-sub

    \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str (cdr char+start+end))

    \ \ \ \ \ \ \ \ \ \ \ len

    \ \ \ \ \ \ \ \ \ \ \ (car char+start+end)))

    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "string-pad"))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-pad-right "MathAgape" 15) =\<gtr\> "MathAgape \ \ \ \ \ ")

    (check (string-pad-right "MathAgape" 12 #\\1) =\<gtr\> "MathAgape111")

    (check (string-pad-right "MathAgape" 6 #\\1 0 4) =\<gtr\> "Math11")

    (check (string-pad-right "MathAgape" 9) =\<gtr\> "MathAgape")

    (check (string-pad-right "MathAgape" 9 #\\1) =\<gtr\> "MathAgape")

    (check (string-pad-right "MathAgape" 4) =\<gtr\> "Math")

    (check (string-pad "MathAgape" 2 #\\1 0 4) =\<gtr\> "th")

    \;

    (check-catch 'out-of-range (string-pad-right "MathAgape" -1))

    \;
  </scm-chunk>

  <paragraph|string-trim><index|string-trim>

  <scm|string-trim>是一个函数，用于去除字符串左端的空白字符。空白字符通常包括空格、制表符、换行符等。当原字符串只包含空白字符，返回空字符串。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (%trim-do str string-trim-sub criterion+start+end)

    \ \ (cond ((null-list? criterion+start+end)

    \ \ \ \ \ \ \ \ \ (string-trim-sub str #\\ ))

    \ \ \ \ \ \ \ \ ((list? criterion+start+end)

    \ \ \ \ \ \ \ \ \ (if (char? (car criterion+start+end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (string-trim-sub

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str (cdr criterion+start+end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car criterion+start+end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (string-trim-sub

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str criterion+start+end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\\ )))

    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "string-trim"))))

    \;

    (define (string-trim str . criterion+start+end)

    \ \ (define (string-trim-sub str space-or-char)

    \ \ \ \ (let loop ((i 0)

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

    \ \ \ \ \ \ \ \ \ (if (or (= i len) (not (char=? space-or-char (string-ref str i))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str i len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) len))))

    \ \ (%trim-do str string-trim-sub criterion+start+end))

    \;
  </scm-chunk>

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

    (check (string-trim " \ 2 4 \ " 2) =\<gtr\> "2 4 \ ")

    (check (string-trim " \ 2 4 \ " 3) =\<gtr\> "4 \ ")

    (check (string-trim " \ 2 4 \ " 4) =\<gtr\> "4 \ ")

    (check (string-trim " \ 2 4 \ " 5) =\<gtr\> "")

    \;

    (check-catch 'out-of-range (string-trim " \ 2 4 \ " 8))

    \;

    (check (string-trim " \ 2 4 \ " 0 4) =\<gtr\> "2 ")

    (check (string-trim " \ 2 4 \ " 0 7) =\<gtr\> "2 4 \ ")

    \;

    (check-catch 'out-of-range (string-trim " \ 2 4 \ " 0 8))

    \;

    (check (string-trim " \ 2 4 \ " #\\ ) =\<gtr\> "2 4 \ ")

    (check (string-trim "-- 2 4 --" #\\-) =\<gtr\> " 2 4 --")

    (check (string-trim " - 345" #\\- 1) =\<gtr\> " 345")

    (check (string-trim " - 345" #\\- 1 4) =\<gtr\> " 3")

    \;
  </scm-chunk>

  <paragraph|string-trim-right><index|string-trim-right>

  <scm|string-trim-right>是一个函数，用于去除字符串右端的空白字符。当原字符串只包含空白字符，返回空字符串。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-trim-right str . criterion+start+end)

    \ \ (define (string-trim-right-sub str space-or-char)

    \ \ \ \ (let loop ((i (- (string-length str) 1)))

    \ \ \ \ \ \ (cond ((negative? i) "")

    \ \ \ \ \ \ \ \ \ \ \ \ ((char=? space-or-char (string-ref str i)) (loop (- i 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ (else (substring str 0 (+ i 1))))))

    \ \ (%trim-do str string-trim-right-sub criterion+start+end))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-trim-right " \ 2 4 \ ") =\<gtr\> " \ 2 4")

    (check (string-trim-right " \ 2 4 \ " 1) =\<gtr\> " 2 4")

    (check (string-trim-right " \ 2 4 \ " 2) =\<gtr\> "2 4")

    (check (string-trim-right " \ 2 4 \ " 3) =\<gtr\> " 4")

    (check (string-trim-right " \ 2 4 \ " 4) =\<gtr\> "4")

    (check (string-trim-right " \ 2 4 \ " 5) =\<gtr\> "")

    (check (string-trim-right " \ 2 4 \ " 6) =\<gtr\> "")

    (check (string-trim-right " \ 2 4 \ " 7) =\<gtr\> "")

    \;

    (check-catch 'out-of-range (string-trim-right " \ 2 4 \ " 8))

    \;

    (check (string-trim-right " \ 2 4 \ " 0 4) =\<gtr\> " \ 2")

    (check (string-trim-right " \ 2 4 \ " 0 7) =\<gtr\> " \ 2 4")

    \;

    (check-catch 'out-of-range (string-trim-right " \ 2 4 \ " 0 8))

    \;

    (check (string-trim-right " \ 2 4 \ " #\\ ) =\<gtr\> " \ 2 4")

    (check (string-trim-right "-- 2 4 --" #\\-) =\<gtr\> "-- 2 4 ")

    (check (string-trim-right "012-" #\\- 1) =\<gtr\> "12")

    (check (string-trim-right "012-4" #\\- 0 4) =\<gtr\> "012")

    \;
  </scm-chunk>

  <paragraph|string-trim-both><index|string-trim-both>

  <scm|string-trim-both>是一个函数，用于去除字符串两端的空白字符。当原字符串只包含空白字符，报错。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-trim-both str . criterion+start+end)

    \ \ (define (string-trim-both-sub str space-or-char)

    \ \ \ \ (let loop ((i 0)

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

    \ \ \ \ (if (or (= i len) (not (char=? space-or-char (string-ref str i))))

    \ \ \ \ \ \ \ \ (let loop-end ((j (- len 1)))

    \ \ \ \ \ \ \ \ \ \ (if (or (\<less\> j 0) (not (char=? space-or-char (string-ref str j))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str i (+ j 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop-end (- j 1))))

    \ \ \ \ \ \ \ \ (loop (+ i 1) len))))

    \ \ (%trim-do str string-trim-both-sub criterion+start+end))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-trim-both " \ 2 4 \ ") =\<gtr\> "2 4")

    (check (string-trim-both "--2 4--" #\\-) =\<gtr\> "2 4")

    \;
  </scm-chunk>

  <subsection|前缀和后缀>

  <paragraph|string-prefix?><index|string-prefix?>

  <scm|string-prefix?>是一个谓词函数，用于检查一个字符串是否是另一个字符串的前缀。若第一个字符串是第二个字符串的前缀，则函数返回<scm|#t>；否则返回<scm|#f>。特别地，空字符串是任意字符串的前缀；两个内容相同的字符串互为前缀。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-prefix? prefix str)

    \ \ (let* ((prefix-len (string-length prefix))

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

    \ \ \ \ (and (\<less\>= prefix-len str-len)

    \ \ \ \ \ \ \ \ \ (let loop ((i 0))

    \ \ \ \ \ \ \ \ \ \ \ (or (= i prefix-len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (char=? (string-ref prefix i)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-ref str i))

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

    \;
  </scm-chunk>

  <paragraph|string-suffix?><index|string-suffix?>

  <scm|string-suffix?>是一个谓词函数，用于检查一个字符串是否是另一个字符串的后缀。若第一个字符串是第二个字符串的后缀，则函数返回<scm|#t>；否则返回<scm|#f>。特别地，空字符串是任意字符串的后缀；两个内容相同的字符串互为后缀。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-suffix? suffix str)

    \ \ (let* ((suffix-len (string-length suffix))

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

    \ \ \ \ (and (\<less\>= suffix-len str-len)

    \ \ \ \ \ \ \ \ \ (let loop ((i 0)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (j (- str-len suffix-len)))

    \ \ \ \ \ \ \ \ \ \ \ (or (= i suffix-len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (char=? (string-ref suffix i)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-ref str j))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) (+ j 1))))))))

    \;
  </scm-chunk>

  <subsection|搜索>

  <paragraph|string-index><index|string-index>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-index str char/pred? . start+end)

    \ \ (define (string-index-sub str pred?)

    \ \ \ \ (let loop ((i 0))

    \ \ \ \ \ \ (cond ((\<gtr\>= i (string-length str)) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ ((pred? (string-ref str i)) i)

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

    \ \ 

    \ \ (let* ((start (if (null-list? start+end) 0 (car start+end)))

    \ \ \ \ \ \ \ \ \ (str-sub (%string-from-range str start+end))

    \ \ \ \ \ \ \ \ \ (pred? (%make-criterion char/pred?))

    \ \ \ \ \ \ \ \ \ (ret (string-index-sub str-sub pred?)))

    \ \ \ \ (if ret (+ start ret) ret)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-index "0123456789" #\\2) =\<gtr\> 2)

    (check (string-index "0123456789" #\\2 2) =\<gtr\> 2)

    (check (string-index "0123456789" #\\2 3) =\<gtr\> #f)

    (check (string-index "01x3456789" char-alphabetic?) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|string-index-right><index|string-index-right>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-index-right str char/pred? . start+end)

    \ \ (define (string-index-right-sub str pred?)

    \ \ \ \ (let loop ((i (- (string-length str) 1)))

    \ \ \ \ \ \ (cond ((\<less\> i 0) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ ((pred? (string-ref str i)) i)

    \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (- i 1))))))

    \ \ 

    \ \ (let* ((start (if (null-list? start+end) 0 (car start+end)))

    \ \ \ \ \ \ \ \ (str-sub (%string-from-range str start+end))

    \ \ \ \ \ \ \ \ (pred? (%make-criterion char/pred?))

    \ \ \ \ \ \ \ \ (ret (string-index-right-sub str-sub pred?)))

    \ \ \ \ (if ret (+ start ret) ret)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-index-right "0123456789" #\\8) =\<gtr\> 8)

    (check (string-index-right "0123456789" #\\8 2) =\<gtr\> 8)

    (check (string-index-right "0123456789" #\\8 9) =\<gtr\> #f)

    (check (string-index-right "01234567x9" char-alphabetic?) =\<gtr\> 8)

    \;
  </scm-chunk>

  <paragraph|string-contains><index|string-contains>

  <scm|string-contains>是一个函数，用于检查一个字符串是否包含另一个子字符串，包含则返回<scm|#t>，返回<scm|#f>。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-contains str sub-str)

    \ \ (let loop ((i 0))

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

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

    \ \ \ \ \ \ (if (\<gtr\> i (- len sub-str-len))\ 

    \ \ \ \ \ \ \ \ \ \ #f

    \ \ \ \ \ \ \ \ \ \ (if (string=?\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ str

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ i

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ i sub-str-len))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ sub-str)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ #t

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

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-contains "0123456789" "3"))

    (check-true (string-contains "0123456789" "34"))

    (check-false (string-contains "0123456789" "24"))

    \;
  </scm-chunk>

  <paragraph|string-count><index|string-count>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-count str char/pred? . start+end)

    \ \ (let ((str-sub (%string-from-range str start+end))

    \ \ \ \ \ \ \ \ (criterion (%make-criterion char/pred?)))

    \ \ \ \ (count criterion (string-\<gtr\>list str-sub))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-count "xyz" #\\x) =\<gtr\> 1)

    (check (string-count "xyz" #\\x 0 1) =\<gtr\> 1)

    (check (string-count "xyz" #\\y 0 1) =\<gtr\> 0)

    (check (string-count "xyz" #\\x 0 3) =\<gtr\> 1)

    (check (string-count "xyz" (lambda (x) (char=? x #\\x))) =\<gtr\> 1)

    \;
  </scm-chunk>

  <subsection|大写小写转换>

  <paragraph|string-titlecase>

  <value|srfi><paragraph|string-upcase><index|string-upcase>

  S7内置的<scm|string-upcase>是符合R7RS标准的，这里实现的是SRFI 13定义的<scm|string-upcase>，需要额外实现<scm|start>和<scm|end>这两个可选参数。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define s7-string-upcase string-upcase)

    \;

    (define* (string-upcase str (start 0) (end (string-length str)))

    \ \ (let* ((left (substring str 0 start))

    \ \ \ \ \ \ \ \ \ (middle (substring str start end))

    \ \ \ \ \ \ \ \ \ (right (substring str end)))

    \ \ \ \ (string-append left (s7-string-upcase middle) right)))

    \;
  </scm-chunk>

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

    (check (string-upcase "abc" 0 1) =\<gtr\> "Abc")

    \;

    (check-catch 'out-of-range (string-upcase "abc" 0 4))

    \;
  </scm-chunk>

  <value|srfi><paragraph|string-downcase><index|string-downcase>

  S7内置的<scm|string-downcase>是符合R7RS标准的，这里实现的是SRFI 13定义的<scm|string-downcase>，需要额外实现<scm|start>和<scm|end>这两个可选参数。

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define s7-string-downcase string-downcase)

    \;

    (define* (string-downcase str (start 0) (end (string-length str)))

    \ \ (let* ((left (substring str 0 start))

    \ \ \ \ \ \ \ \ \ (middle (substring str start end))

    \ \ \ \ \ \ \ \ \ (right (substring str end)))

    \ \ \ \ (string-append left (s7-string-downcase middle) right)))

    \;
  </scm-chunk>

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

    (check (string-downcase "ABC" 0 1) =\<gtr\> "aBC")

    \;

    (check-catch 'out-of-range (string-downcase "ABC" 0 4))

    \;
  </scm-chunk>

  <subsection|翻转和追加>

  <paragraph|string-reverse><index|string-reverse>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-reverse str . start+end)

    \ \ (cond ((null-list? start+end)

    \ \ \ \ \ \ \ \ \ (reverse str))

    \ \ \ \ \ \ \ \ ((= (length start+end) 1)

    \ \ \ \ \ \ \ \ \ (let ((start (first start+end)))

    \ \ \ \ \ \ \ \ \ \ \ (string-append (substring str 0 start)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (reverse (substring str start)))))

    \ \ \ \ \ \ \ \ ((= (length start+end) 2)

    \ \ \ \ \ \ \ \ \ (let ((start (first start+end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (end (second start+end)))

    \ \ \ \ \ \ \ \ \ \ \ (string-append (substring str 0 start)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (reverse (substring str start end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring str end))))

    \ \ \ \ \ \ \ \ (else (error 'wrong-number-of-args "string-reverse"))))

    \;
  </scm-chunk>

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

    \;

    (check-catch 'out-of-range (string-reverse "01234" -1))

    \;

    (check (string-reverse "01234" 0) =\<gtr\> "43210")

    (check (string-reverse "01234" 1) =\<gtr\> "04321")

    (check (string-reverse "01234" 5) =\<gtr\> "01234")

    \;

    (check-catch 'out-of-range (string-reverse "01234" 6))

    \;

    (check (string-reverse "01234" 0 2) =\<gtr\> "10234")

    (check (string-reverse "01234" 1 3) =\<gtr\> "02134")

    (check (string-reverse "01234" 1 5) =\<gtr\> "04321")

    (check (string-reverse "01234" 0 5) =\<gtr\> "43210")

    \;

    (check-catch 'out-of-range (string-reverse "01234" 1 6))

    \;

    (check-catch 'out-of-range (string-reverse "01234" -1 3))

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|string-append><index|string-append>

  <scm|string-append>是一个S7内置的函数，用于连接两个或多个字符串。它会将所有提供的字符串参数逐个拼接在一起，并返回一个新的字符串，原始字符串不会被修改。当没有参数时，返回空字符串。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (string-append "Math" "Agape") =\<gtr\> "MathAgape")

    \;

    (check (string-append) =\<gtr\> "")

    \;
  </scm-chunk>

  <subsection|高阶函数>

  <r7rs><paragraph|string-map><index|string-map>

  <subparagraph|实现>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (string-map p . args) (apply string (apply map p args)))

    \;
  </scm-chunk>

  <subparagraph|测试>

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

    \ \ (string-map

    \ \ \ \ (lambda (ch) (integer-\<gtr\>char (+ 1 (char-\<gtr\>integer ch))))

    \ \ \ \ "HAL")

    \ \ =\<gtr\> "IBM")

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|string-for-each><scm|(proc str1 [str2 ...])><index|string-for-each>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define string-for-each for-each)

    \;
  </scm-chunk>

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

    \ \ (let ((lst '()))

    \ \ \ \ (string-for-each

    \ \ \ \ \ \ (lambda (x) (set! lst (cons (char-\<gtr\>integer x) lst)))

    \ \ \ \ \ \ "12345")

    \ \ \ \ lst)

    \ \ =\<gtr\> '(53 52 51 50 49))

    \;

    (check

    \ \ (let ((lst '()))

    \ \ \ \ (string-for-each

    \ \ \ \ \ \ (lambda (x) (set! lst (cons (- (char-\<gtr\>integer x) (char-\<gtr\>integer #\\0)) lst)))

    \ \ \ \ \ \ "12345")

    \ \ \ \ lst)

    \ \ =\<gtr\> '(5 4 3 2 1))

    \;

    (check

    \ \ (let ((lst '()))

    \ \ \ \ (string-for-each

    \ \ \ \ \ \ (lambda (x) (set! lst (cons (- (char-\<gtr\>integer x) (char-\<gtr\>integer #\\0)) lst)))

    \ \ \ \ \ \ "123")

    \ \ \ \ lst)

    \ \ =\<gtr\> '(3 2 1))

    \;

    (check

    \ \ (let ((lst '()))

    \ \ \ \ (string-for-each

    \ \ \ \ \ \ (lambda (x) (set! lst (cons (- (char-\<gtr\>integer x) (char-\<gtr\>integer #\\0)) lst)))

    \ \ \ \ \ \ "")

    \ \ \ \ lst)

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

    \;
  </scm-chunk>

  <subsection|插入和解析>

  <paragraph|string-tokenize><index|string-tokenize>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|true>
    (define (string-tokenize str . char+start+end)

    \ \ 

    \ \ (define (string-tokenize-sub str char)

    \ \ \ \ 

    \ \ \ \ (define (tokenize-helper tokens cursor)

    \ \ \ \ \ \ (let ((sep-pos/false (string-index str char cursor)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ (reverse (cons (substring str cursor) tokens))

    \ \ \ \ \ \ \ \ \ \ \ \ (let ((new-tokens

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (= cursor sep-pos/false)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tokens

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (substring str cursor sep-pos/false) tokens)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (next-cursor (+ sep-pos/false 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (tokenize-helper new-tokens next-cursor)))))

    \ \ 

    \ \ \ \ \ \ (tokenize-helper '() 0))

    \ \ 

    \ \ (cond ((null-list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-tokenize-sub str #\\ ))

    \ \ \ \ \ \ \ \ ((list? char+start+end)

    \ \ \ \ \ \ \ \ \ (string-tokenize-sub

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%string-from-range str (cdr char+start+end))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car char+start+end)))

    \ \ \ \ \ \ \ \ (else (error 'wrong-type-arg "string-tokenize"))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-tokenize "1 22 333") =\<gtr\> '("1" "22" "333"))

    (check (string-tokenize "1 22 333" #\\2) =\<gtr\> '("1 " " 333"))

    (check (string-tokenize "1 22 333" #\\ \ 2) =\<gtr\> `("22" "333"))

    \;
  </scm-chunk>

  <section|三鲤扩展函数>

  <paragraph|string-starts?><index|string-starts?>

  SRFI 13定义的<scm|string-prefix?>的顺序容易弄错，故而定义<scm|string-starts?>将字符串放在前面，前缀放在后面。

  <\scm-chunk|goldfish/liii/string.scm|true|true>
    (define (string-starts? str prefix)

    \ \ (string-prefix? prefix str))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-starts? "MathAgape" "Ma"))

    (check-true (string-starts? "MathAgape" ""))

    (check-true (string-starts? "MathAgape" "MathAgape"))

    \;

    (check-false (string-starts? "MathAgape" "a"))

    \;
  </scm-chunk>

  <paragraph|string-ends?><index|string-ends?>

  SRFI 13定义的<scm|string-suffix?>的顺序容易弄错，故而定义<scm|string-end?>将字符串放在前面，前缀放在后面。

  <\scm-chunk|goldfish/liii/string.scm|true|true>
    (define (string-ends? str suffix)

    \ \ (string-suffix? suffix str))

    \;
  </scm-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check-true (string-ends? "MathAgape" "e"))

    (check-true (string-ends? "MathAgape" ""))

    (check-true (string-ends? "MathAgape" "MathAgape"))

    \;

    (check-false (string-ends? "MathAgape" "p"))

    \;
  </scm-chunk>

  <paragraph|string-remove-prefix><index|string-remove-prefix>

  在编程实践中，移除字符串的前缀是非常常用的功能。

  <\scm-chunk|goldfish/liii/string.scm|true|true>
    (define string-remove-prefix

    \ \ (typed-lambda ((str string?) (prefix string?))

    \ \ \ \ (if (string-prefix? prefix str)

    \ \ \ \ \ \ \ \ (substring str (string-length prefix))

    \ \ \ \ \ \ \ \ str)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-remove-prefix "浙江省杭州市西湖区" "浙江省") =\<gtr\> "杭州市西湖区")

    (check (string-remove-prefix "aaa" "a") =\<gtr\> "aa")

    (check (string-remove-prefix "abc" "bc") =\<gtr\> "abc")

    (check (string-remove-prefix "abc" "") =\<gtr\> "abc")

    \;
  </scm-chunk>

  <paragraph|string-remove-suffix><index|string-remove-suffix>

  <\scm-chunk|goldfish/liii/string.scm|true|true>
    (define string-remove-suffix

    \ \ (typed-lambda ((str string?) (suffix string?))

    \ \ \ \ (if (string-suffix? suffix str)

    \ \ \ \ \ \ \ \ (substring str 0 (- (string-length str) (string-length suffix)))

    \ \ \ \ \ \ \ \ (string-copy str))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (string-remove-suffix "aaa" "a") =\<gtr\> "aa")

    (check (string-remove-suffix "aaa" "") =\<gtr\> "aaa")

    (check (string-remove-suffix "Goldfish.tmu" ".tmu") =\<gtr\> "Goldfish")

    \;
  </scm-chunk>

  <section|字符串的格式化>

  <paragraph|format><index|format><scm|(output-choice control-string . arguments)>

  <scm|format>是S7 Scheme的内置函数，用于生成格式化的字符串，它提供了多种指令来控制输出格式。

  关于输出选项：<code*|(format #f ...)> 简单地返回格式化后的字符串；<code*|(format #t ...)> 也会将字符串发送到当前的输出端口。<code*|(format () ...)> 将输出发送到当前的输出端口，并且不返回字符串（这模仿了其他IO例程，如<code*|display>和<code*|newline>）。其他内置的端口选择包括<code*|*stdout*>和<code*|*stderr*>。

  关于控制格式的字符串，分小段落讨论如下：

  <subparagraph|Scheme对象的格式化>

  <\itemize>
    <item><code*|~A>：按照<code*|display>的方式输出对象。

    <item><code*|~S>：按照<code*|write>的方式输出对象。
  </itemize>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (format #f "~A" 'hello) =\<gtr\> "hello")

    (check (format #f "~S" 'hello) =\<gtr\> "hello")

    (check (format #f "~S" "hello") =\<gtr\> "\\"hello\\"")

    \;
  </scm-chunk>

  <subparagraph|整数的格式化>

  <\itemize>
    <item><code*|~B>：以二进制形式输出整数。

    <item><code*|~O>：以八进制形式输出整数。

    <item><code*|~D>：以十进制形式输出整数。

    <item><code*|~X>：以十六进制形式输出。
  </itemize>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (format #f "~D" 123) =\<gtr\> "123")

    (check (format #f "~X" 255) =\<gtr\> "ff")

    (check (format #f "~B" 13) =\<gtr\> "1101")

    (check (format #f "~O" 13) =\<gtr\> "15")

    \;
  </scm-chunk>

  <subparagraph|基本格式指令>

  <\itemize>
    <item><code*|~E>：这个指令将浮点数转换为科学计数法表示的字符串。例如，<code*|(format #f "~E" 100.1)>将输出<code*|"1.001000e+02">。

    <item><code*|~F>：这个指令将浮点数转换为固定小数点表示的字符串。例如，<code*|(format #f "~F" 100.1)>将输出<code*|"100.100000">。

    <item><code*|~G>：这个指令根据数值的大小自动选择最合适的表示方法。例如，<code*|(format #f "~G" 100.1)>将输出<code*|"100.1">。
  </itemize>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (format #f "~E" 100.1) =\<gtr\> "1.001000e+02")

    (check (format #f "~F" 100.1) =\<gtr\> "100.100000")

    (check (format #f "~G" 100.1) =\<gtr\> "100.1")

    \;
  </scm-chunk>

  <subparagraph|特殊符号>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (format #f "~%") =\<gtr\> "\\n")

    (check (format #f "~~") =\<gtr\> "~")

    \;
  </scm-chunk>

  <subparagraph|控制结构>

  <\itemize>
    <item><code*|~&>：如果前一个字符不是换行符，则输出一个换行符。

    <item><code*|~{> 和 <code*|~}>：用于迭代，可以迭代列表、字符串、向量等。

    <item><code*|~^>：在迭代中，用于在元素之间插入分隔符。
  </itemize>

  <\scm-chunk|tests/goldfish/liii/string-test.scm|true|true>
    (check (format #f "~{~C~^ ~}" "hiho") =\<gtr\> "h i h o")

    (check (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test"))

    \ \ \ \ \ \ \ =\<gtr\> "h i h o...t e s t")

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-13.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii vector)><label|chapter:liii_vector>

  <section|许可证>

  <\scm-chunk|goldfish/srfi/srfi-133.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.

    ;

    \;
  </scm-chunk>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    (define-library (srfi srfi-133)

    (import (liii base))

    (export

    \ \ vector-empty?

    \ \ vector-count

    \ \ vector-any vector-every vector-copy vector-copy!

    \ \ vector-index vector-index-right vector-partition

    \ \ vector-swap! vector-cumulate reverse-list-\<gtr\>vector

    \ \ vector=)

    (begin

    \;
  </scm-chunk>

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

    (import (srfi srfi-133)

    \ \ \ \ \ \ \ \ (liii base))

    (export

    \ \ ; S7 Scheme built-in

    \ \ make-vector vector vector-length vector-ref vector-set! vector-\<gtr\>list list-\<gtr\>vector

    \ \ ; from (scheme base)

    \ \ vector-copy vector-fill! vector-copy! vector-\<gtr\>string string-\<gtr\>vector

    \ \ vector-map vector-for-each

    \ \ ; from (srfi srfi-133)

    \ \ vector-empty?

    \ \ vector-count

    \ \ vector-any vector-every vector-copy vector-copy!

    \ \ vector-index vector-index-right vector-partition

    \ \ vector-swap! vector-cumulate reverse-list-\<gtr\>vector

    \ \ vector=)

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (liii vector)

    \ \ \ \ \ \ \ \ (only (scheme base) let-values))

    \;

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

    \;

    (for-each (lambda (p) (check (procedure? p) =\<gtr\> #t))

    \ \ (list

    \ \ \ vector-empty?

    \ \ \ vector-count

    \ \ \ vector-any vector-every vector-copy vector-copy!

    \ \ \ vector-index vector-index-right vector-partition

    \ \ \ vector-swap! vector-cumulate reverse-list-\<gtr\>vector

    \ \ \ vector=))

    \;
  </scm-chunk>

  <section|实现>

  <subsection|构造器>

  <r7rs><paragraph|make-vector><scm|(k [fill]) =\<gtr\> vector><index|make-vector>

  返回长度为k的向量，如果提供了fill，则采用fill作为每一个元素的初始值，否则每一个元素的初始值是未指定。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (make-vector 1 1) =\<gtr\> (vector 1))

    (check (make-vector 3 'a) =\<gtr\> (vector 'a 'a 'a))

    \;

    (check (make-vector 0) =\<gtr\> (vector ))

    (check (vector-ref (make-vector 1) 0) =\<gtr\> #\<less\>unspecified\<gtr\>)

    \;
  </scm-chunk>

  <r7rs><paragraph|vector><scm|(obj1 obj2 ...) =\<gtr\> vector><index|vector>

  返回一个新分配的向量，其元素包含给定的参数。类似于<scm|list>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (vector 'a 'b 'c) =\<gtr\> #(a b c))

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

    \;
  </scm-chunk>

  <paragraph|int-vector><scm|(integer integer ...) =\<gtr\> vector><index|int-vector>

  返回一个所有元素都是integer类型的int-vector。int-vector是vector的子类型。

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check-true (vector? (int-vector 1 2 3)))

    (check-catch 'wrong-type-arg (int-vector 1 2 'a))

    \;

    (let1 v (int-vector 1 2 3)

    \ \ (check (vector-ref v 0) =\<gtr\> 1)

    \ \ (check (vector-ref v 1) =\<gtr\> 2)

    \ \ (check (vector-ref v 2) =\<gtr\> 3))

    \;
  </scm-chunk>

  <paragraph|vector-unfold>

  <paragraph|vector-unfold-right>

  <r7rs><paragraph|vector-copy><scm|(v [start [end]]) =\<gtr\> vector><index|vector-copy>

  返回一个新的分配副本，包含给定向量从开始到结束的元素。新向量的元素与旧向量的元素相同（在eqv?的意义上）。

  <\scm-code>
    (define (vector-copy v)

    \ \ (let ((new-v (make-vector (vector-length v))))

    \ \ \ \ (let loop ((i 0))

    \ \ \ \ \ \ \ \ \ (if (= i (vector-length v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ new-v

    \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-v i (vector-ref v i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1)))))))
  </scm-code>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define* (vector-copy v (start 0) (end (vector-length v)))

    \ \ (if (or (\<gtr\> start end) (\<gtr\> end (vector-length v)))

    \ \ \ \ \ \ (error 'out-of-range "vector-copy")

    \ \ \ \ \ \ (let ((new-v (make-vector (- end start))))

    \ \ \ \ \ \ \ \ (let loop ((i start) (j 0))

    \ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= i end)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ new-v

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-v j (vector-ref v i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) (+ j 1))))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-copy #(0 1 2 3)) =\<gtr\> #(0 1 2 3))

    (check (vector-copy #(0 1 2 3) 1) =\<gtr\> #(1 2 3))

    (check (vector-copy #(0 1 2 3) 3) =\<gtr\> #(3))

    (check (vector-copy #(0 1 2 3) 4) =\<gtr\> #())

    \;

    (check-catch 'out-of-range (vector-copy #(0 1 2 3) 5))

    (check-catch 'out-of-range (vector-copy #(0 1 2 3) 1 5))

    \;

    (define my-vector #(0 1 2 3))

    (check (eqv? my-vector (vector-copy #(0 1 2 3))) =\<gtr\> #f)

    (check-true

    \ \ (eqv? (vector-ref my-vector 2)

    \ \ \ \ \ \ \ \ (vector-ref (vector-copy #(0 1 2 3)) 2)))

    \;

    (check (vector-copy #(0 1 2 3) 1 1) =\<gtr\> #())

    (check (vector-copy #(0 1 2 3) 1 2) =\<gtr\> #(1))

    (check (vector-copy #(0 1 2 3) 1 4) =\<gtr\> #(1 2 3))

    \;
  </scm-chunk>

  <paragraph|vector-reverse-copy>

  <r7rs><paragraph|vector-append><scm|(v1 v2 v3 ...) =\<gtr\> vector><index|vector-append>

  返回一个新分配的向量，其元素是给定向量的元素的拼接。这是一个S7内置的函数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (vector-append #(0 1 2) #(3 4 5)) =\<gtr\> #(0 1 2 3 4 5))

    \;
  </scm-chunk>

  <subsection|谓词>

  <paragraph|vector?><index|vector?><scm|(vector? obj) =\<gtr\> bool>

  如果obj是一个向量返回<scm|#t>，否则返回<scm|#f>。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (vector? #(1 2 3)) =\<gtr\> #t)

    (check (vector? #()) =\<gtr\> #t)

    (check (vector? '(1 2 3)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|int-vector?><scm|(int-vector? obj) =\<gtr\> bool>

  只有使用int-vector构造的vector，才能在判定为真。

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check-true (int-vector? (int-vector 1 2 3)))

    (check-false (int-vector? (vector 1 2 3)))

    \;
  </scm-chunk>

  <paragraph|vector-empty?><index|vector-empty?>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    (define (vector-empty? v)

    \ \ (when (not (vector? v))

    \ \ \ \ (error 'type-error "v is not a vector"))

    \ \ (zero? (vector-length v)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check-true (vector-empty? (vector)))

    (check-false (vector-empty? (vector 1)))

    (check-catch 'type-error (vector-empty? 1))

    \;
  </scm-chunk>

  <paragraph|vector=>

  使用一个元素比较器 (elt=?) 来比较传入的一组向量是否相等。当传入的向量不足两个的时候默认返回相等。元素比较器 elt=? 以及内置的比较器运算的结果都是 boolean，否则都会抛出类型错误。

  因为比较一组向量是否全部相等，可以通过不断比较相邻两个来实现。所以这里的具体实现中，定义了一个名为 compare2vecs 的 内部 procedure ，它可以使用 elt=? 进行向量的两两比较。

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    (define (vector= elt=? . rest)

    \ \ (define compare2vecs

    \ \ \ \ (typed-lambda ((cmp procedure?) (vec1 vector?) (vec2 vector?))

    \ \ \ \ \ \ \ (let* \ ((len1 (vector-length vec1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (len2 (vector-length vec2)))

    \ \ \ \ \ \ \ \ \ (if (not (= len1 len2)) #f

    \ \ \ \ \ \ \ \ \ \ \ \ \ (let loop ((ilhs 0) (irhs 0) (len len1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (= ilhs len) #t

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (not (cmp (vec1 ilhs) (vec2 irhs))) #f\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ 1 ilhs) (+ 1 irhs) len))))))))

    \ \ (when (not (procedure? elt=?)) (error 'type-error "elt=? should be a procedure"))

    \ \ (if (or(null? rest) (= 1 (length rest))) #t

    \ \ \ \ \ \ (let loop ((vec1 (car rest)) (vec2 (car (cdr rest))) (vrest (cdr (cdr rest))))

    \ \ \ \ \ \ \ \ (let1 rst (compare2vecs elt=? vec1 vec2)

    \ \ \ \ \ \ \ \ \ \ \ (when (not (boolean? rst)) (error 'type-error "elt=\<gtr\> should return bool"))

    \ \ \ \ \ \ \ \ \ \ \ (if (compare2vecs elt=? vec1 vec2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? vrest) #t

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop vec2 (car vrest) (cdr vrest)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #f)))))
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    ; trivial cases

    (check-true (vector= eq?))

    (check-true (vector= eq? '#(a)))

    ; basic cases

    (check-true (vector= eq? '#(a b c d) '#(a b c d)))

    (check-false (vector= eq? '#(a b c d) '#(a b d c)))

    (check-false (vector= = '#(1 2 3 4 5) '#(1 2 3 4)))

    (check-true (vector= = '#(1 2 3 4) '#(1 2 3 4)))

    (check-true (vector= equal? '#(1 2 3) '#(1 2 3) '#(1 2 3)))

    (check-false (vector= equal? '#(1 2 3) '#(1 2 3) '#(1 2 3 4)))

    ; error cases

    (check-catch 'type-error (vector= 1 (vector (vector 'a)) (vector (vector 'a))))

    ; complex cases in srfi-133

    (check-true (vector= equal? (vector (vector 'a)) (vector (vector 'a))))

    (check-false (vector= eq? (vector (vector 'a)) (vector (vector 'a))))
  </scm-chunk>

  \;

  <subsection|选择器>

  <r7rs><paragraph|vector-length><scm|(v) =\<gtr\> integer><index|vector-length>

  以整数返回向量中元素的数量。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (vector-length #(1 2 3)) =\<gtr\> 3)

    (check (vector-length #()) =\<gtr\> 0)

    \;
  </scm-chunk>

  <r7rs><paragraph|vector-ref><scm|((v vector?) (k integer?)) =\<gtr\> object><index|vector-ref>

  返回向量中索引为 k 的元素的内容。当 k 不是向量的有效索引，报错。

  <\remark>
    在金鱼Scheme中，我们推荐使用<scm|(v 0)>而不是<scm|(vector-ref v 0)>，因为前者更加简洁。在使用前者访问向量中的元素时，注意变量的命名需要能够标明变量的类型，比如在<scm|(x 0)>中，我们无法有效分辨<scm|x>是什么类型的变量，而<scm|(vector-ref x 0)>能够有效地标明<scm|x>是向量。故而，在使用前者这种简洁的语法时，建议使用<scm|v->前缀或者<scm|-v>后缀来标明<scm|x>的类型，比如<scm|(v-x 0)>或者<scm|(x-v 0)>。
  </remark>

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (let1 v #(1 2 3)

    \ \ (check (vector-ref v 0) =\<gtr\> 1)

    \ \ (check (v 0) =\<gtr\> 1)

    \ \ 

    \ \ (check (vector-ref v 2) =\<gtr\> 3)

    \ \ (check (v 2) =\<gtr\> 3))

    \;

    (check-catch 'out-of-range (vector-ref #(1 2 3) 3))

    (check-catch 'out-of-range (vector-ref #() 0))

    \ \ 

    (check-catch 'wrong-type-arg (vector-ref #(1 2 3) 2.0))

    (check-catch 'wrong-type-arg (vector-ref #(1 2 3) "2"))

    \;
  </scm-chunk>

  <subsection|迭代>

  <r7rs><paragraph|vector-map><index|vector-map>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define (vector-map p . args) (apply vector (apply map p args)))

    \;
  </scm-chunk>

  <r7rs><paragraph|vector-for-each><scm|(proc vector1 [vector2 ...])><index|vector-for-each>

  <subparagraph|实现>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define vector-for-each for-each)

    \;
  </scm-chunk>

  <subparagraph|测试>

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

    \ \ (let ((lst (make-list 5)))

    \ \ \ \ (vector-for-each

    \ \ \ \ \ \ (lambda (i) (list-set! lst i (* i i)))

    \ \ \ \ \ \ #(0 1 2 3 4))

    \ \ \ \ lst)

    \ \ =\<gtr\> '(0 1 4 9 16))

    \;

    (check

    \ \ (let ((lst (make-list 5)))

    \ \ \ \ (vector-for-each

    \ \ \ \ \ \ (lambda (i) (list-set! lst i (* i i)))

    \ \ \ \ \ \ #(0 1 2))

    \ \ \ \ lst)

    \ \ =\<gtr\> '(0 1 4 #f #f))

    \;

    (check

    \ \ (let ((lst (make-list 5)))

    \ \ \ \ (vector-for-each

    \ \ \ \ \ \ (lambda (i) (list-set! lst i (* i i)))

    \ \ \ \ \ \ #())

    \ \ \ \ lst)

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

    \;
  </scm-chunk>

  <paragraph|vector-count><index|vector-count>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; TODO optional parameters

    (define (vector-count pred v)

    \ \ (let loop ((i 0) (count 0))

    \ \ \ \ \ \ \ (cond ((= i (vector-length v)) count)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((pred (vector-ref v i))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) (+ count 1)))

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

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-count even? #()) =\<gtr\> 0)

    (check (vector-count even? #(1 3 5 7 9)) =\<gtr\> 0)

    (check (vector-count even? #(1 3 4 7 8)) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|vector-cumulate><index|vector-cumulate>

  <subparagraph|实现>

  使用函数 fn 和初始值 knil 在向量 vector 上迭代，迭代结果将在一个等长的新向量中返回。

  每次迭代中，fn 被传入上次迭代的结果 lhs 和向量中的元素 vec i，产生的结果 cumu-i 将存储在结果向量 v-rst 中。

  一般而言，knil, cumu-i 的类型未必与 vector 中的元素相同，只需要保证 fn cumu-i (vec i) 能够得到 cumu-i 同类型的结果即可。

  迭代过程可以形式地表示为：

  vector-cumulate fn knil vec =\<gtr\> #(fn knil (vec 0), fn cumu-0 (vec 1), fn cumu-1 (vec 2), <text-dots>)

  \;

  \;

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; Return a new vector v-rst with same length of input vector vec.

    ; Every element of the result is the result the i-th iteration of fn cumu_i vec_i.

    ; \ \ Where fn should be a procedure with 2 args.

    ; \ \ The type of knil and vector could be different.

    ; In the i-th iteration, cumu_i = fn cumu_(i-1) vec_i, with cumu_0 = fn knil vec_0.

    \;

    (define vector-cumulate

    \ \ (typed-lambda ((fn procedure?) knil (vec vector?))

    \ \ \ \ (let* ((len (vector-length vec))

    \ \ \ \ \ \ \ \ \ \ \ (v-rst (make-vector len)))

    \ \ \ \ \ \ (let loop ((i 0) (lhs knil))

    \ \ \ \ \ \ \ \ \ \ \ (if (= i len)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ v-rst

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let1 cumu-i (fn lhs (vec i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! v-rst i cumu-i)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ 1 i) cumu-i))))))))
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    ; Trivial cases.

    (check (vector-cumulate + 0 '#(1 2 3 4)) =\<gtr\> #(1 3 6 10))

    (check (vector-cumulate - 0 '#(1 2 3 4)) =\<gtr\> #(-1 -3 -6 -10))

    (check (vector-cumulate * 1 '#(-1 -2 -3 -4)) =\<gtr\> #(-1 2 -6 24))

    \;

    ;;; Test cases of vec.

    ; Not a vec input.

    (check-catch 'type-error (vector-cumulate + 0 'a))

    ; Empty vec test.

    (check (vector-cumulate + 0 '#()) =\<gtr\> #())

    \;

    ;; Test cases of fn.

    ; A case with consant fn.

    (check (vector-cumulate (lambda (x y) 'a) 0 '#(1 2 3)) =\<gtr\> #(a a a))

    ; A wrong-number-of-args case with 1-arg fn.

    (check-catch 'wrong-number-of-args (vector-cumulate (lambda (x) 'a) 0 '#(1 2 3)))

    ; A wrong-type-arg case with args can't be mapped by fn.

    (check-catch 'wrong-type-arg (vector-cumulate + '(1) '#(1 2 3)))

    \;

    ;;; Test cases of knil.

    ; A case of different type of knil/cumu and vec-i.

    (check (vector-cumulate (lambda (x y) (+ x 2)) 0 '#('a 'b 'c)) =\<gtr\> #(2 4 6))
  </scm-chunk>

  <subsection|搜索>

  <paragraph|vector-any><index|vector-any>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; TODO optional parameters

    (define (vector-any pred v)

    \ \ (let loop ((i 0))

    \ \ \ \ \ \ \ (cond ((= i (vector-length v)) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((pred (vector-ref v i)) #t)

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

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-any even? #()) =\<gtr\> #f)

    (check (vector-any even? #(1 3 5 7 9)) =\<gtr\> #f)

    (check (vector-any even? #(1 3 4 7 8)) =\<gtr\> #t)

    \;
  </scm-chunk>

  <paragraph|vector-every><index|vector-every>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; TODO optional parameters

    (define (vector-every pred v)

    \ \ (let loop ((i 0))

    \ \ \ \ \ \ \ (cond ((= i (vector-length v)) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((not (pred (vector-ref v i))) #f)

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

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-every odd? #()) =\<gtr\> #t)

    (check (vector-every odd? #(1 3 5 7 9)) =\<gtr\> #t)

    (check (vector-every odd? #(1 3 4 7 8)) =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|vector-index><index|vector-index>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; TODO optional parameters

    (define (vector-index pred v)

    \ \ (let loop ((i 0))

    \ \ \ \ \ \ \ (cond ((= i (vector-length v)) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((pred (vector-ref v i)) i)

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

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-index even? #()) =\<gtr\> #f)

    (check (vector-index even? #(1 3 5 7 9)) =\<gtr\> #f)

    (check (vector-index even? #(1 3 4 7 8)) =\<gtr\> 2)

    \;
  </scm-chunk>

  <paragraph|vector-index-right><index|vector-index-right>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; TODO optional parameters

    (define (vector-index-right pred v)

    \ \ (let ((len (vector-length v)))

    \ \ \ \ (let loop ((i (- len 1)))

    \ \ \ \ \ \ \ \ \ (cond ((\<less\> i 0) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((pred (vector-ref v i)) i)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (- i 1)))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-index-right even? #()) =\<gtr\> #f)

    (check (vector-index-right even? #(1 3 5 7 9)) =\<gtr\> #f)

    (check (vector-index-right even? #(1 3 4 7 8)) =\<gtr\> 4)

    \;
  </scm-chunk>

  <paragraph|vector-skip><index|vector-skip>

  <paragraph|vector-skip-right><index|vector-skip-right>

  <paragraph|vector-partition><index|vector-partition>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    (define (vector-partition pred v)

    \ \ (let* ((len (vector-length v))

    \ \ \ \ \ \ \ \ \ (cnt (vector-count pred v))

    \ \ \ \ \ \ \ \ \ (ret (make-vector len)))

    \ \ \ \ (let loop ((i 0) (yes 0) (no cnt))

    \ \ \ \ \ \ (if (= i len)

    \ \ \ \ \ \ \ \ (values ret cnt)

    \ \ \ \ \ \ \ \ (let ((elem (vector-ref v i)))

    \ \ \ \ \ \ \ \ \ \ (if (pred elem)

    \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! ret yes elem)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) (+ yes 1) no))

    \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! ret no elem)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) yes (+ no 1)))))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (define (vector-partition-\<gtr\>list pred v)

    \ \ (let-values (((ret cnt) (vector-partition pred v))) (list ret cnt)))

    \;

    (check (vector-partition-\<gtr\>list even? #()) =\<gtr\> '(#() 0))

    (check (vector-partition-\<gtr\>list even? #(1 3 5 7 9)) =\<gtr\> '(#(1 3 5 7 9) 0))

    (check (vector-partition-\<gtr\>list even? #(1 3 4 7 8)) =\<gtr\> '(#(4 8 1 3 7) 2))

    \;
  </scm-chunk>

  <subsection|修改器>

  <r7rs><paragraph|vector-set!><scm|(vector-set! v k obj )><index|vector-set!>

  该函数将对象 obj 存储到向量中索引为 k 的元素里。注意，返回的不是向量，而是那个 obj。当 k 不是向量的有效索引，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (define my-vector #(0 1 2 3))

    (check my-vector =\<gtr\> #(0 1 2 3))

    \;

    (check (vector-set! my-vector 2 10) =\<gtr\> 10)

    (check my-vector =\<gtr\> #(0 1 10 3))

    \;

    (check-catch 'out-of-range (vector-set! my-vector 4 10))

    \;
  </scm-chunk>

  <paragraph|vector-swap!><index|vector-swap!>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    (define (vector-swap! vec i j)

    \ \ (let ((elem-i (vector-ref vec i))

    \ \ \ \ \ \ \ \ (elem-j (vector-ref vec j)))

    \ \ \ \ (vector-set! vec i elem-j)

    \ \ \ \ (vector-set! vec j elem-i)

    \ \ \ \ ))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (define my-vector (vector 0 1 2 3))

    (vector-swap! my-vector 1 2)

    (check my-vector =\<gtr\> #(0 2 1 3))

    \;

    (define my-vector (vector 0 1 2 3))

    (vector-swap! my-vector 1 1)

    (check my-vector =\<gtr\> #(0 1 2 3))

    \;

    (define my-vector (vector 0 1 2 3))

    (vector-swap! my-vector 0 (- (vector-length my-vector) 1))

    (check my-vector =\<gtr\> #(3 1 2 0))

    \;

    (check-catch 'out-of-range

    \ \ (vector-swap! my-vector 1 (vector-length my-vector)))

    \;
  </scm-chunk>

  <r7rs><paragraph|vector-fill!><index|vector-fill!>

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define vector-fill! fill!)

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (define my-vector (vector 0 1 2 3 4))

    (fill! my-vector #f)

    (check my-vector =\<gtr\> #(#f #f #f #f #f))\ 

    \;

    (define my-vector (vector 0 1 2 3 4))

    (fill! my-vector #f 1 2)

    (check my-vector =\<gtr\> #(0 #f 2 3 4))\ 

    \;
  </scm-chunk>

  <r7rs><paragraph|vector-copy!><scm|(vector-copy! to at from [start [end]])><index|vector-copy!>

  <scm|to>和<scm|from>都是向量，<scm|vector-copy!>就是从<scm|from>向量复制元素依次粘贴到<scm|to>向量，粘贴从<scm|to>向量的第<scm|at>个索引位置开始；<scm|start>和<scm|end>是可选参数，用于指定从<scm|from>向量选取元素的范围。

  <\scm-code>
    a (vector "a0" "a1" "a2" "a3" "a4")

    b (vector "b0" "b1" "b2" "b3" "b4"

    \;

    (vector-copy! b 1 a 0 2) 就是：

    第一步：从a中选取索引为[0,2)的元素，即"a0" "a1"

    第二步：定位到b的索引为 1 的位置，即"b1"所在的那个位置

    第二步：以刚刚定位到的那个"b1"位置为起点，把刚刚选出的元素"a0" "a1"依次替换，直到

    \;

    \;

    代码实现时要注意

    at、to、from的边界条件，按顺序写它们会导致报错的条件

    要注意每一个参数在后面会遇到怎样的使用

    \;

    第一步：只涉及单个参数的报错条件

    (\<less\> at 0) 可省去

    (\<gtr\> at (vector-length to)) 可省去

    (\<less\> start 0)

    (\<less\> start 0)

    (\<gtr\> start (vector-length from))

    (\<less\> end 0)

    (\<gtr\> end (vector-length from))

    \;

    第二步：两个依赖关系的参数的报错条件

    (\<gtr\> start end)

    \;

    第三步：三个依赖关系参数的报错条件

    (\<gtr\> (+ at (- end start)) (vector-length to))

    \;

    综合上方的报错条件，去掉一些多余的条件：

    (\<less\> start 0)可省去

    因为有(\<gtr\> (+ at (- end start)) (vector-length to))，所以(\<gtr\> at (vector-length to))可省去
  </scm-code>

  <\session|guile|default>
    <\input>
      \<gtr\>\ 
    <|input>
      (define a (vector "a0" "a1" "a2" "a3" "a4"))
    </input>

    <\input>
      \<gtr\>\ 
    <|input>
      (define b (vector "b0" "b1" "b2" "b3" "b4"))
    </input>

    <\input>
      \<gtr\>\ 
    <|input>
      (vector-copy! b 0 a 1)
    </input>

    <\folded-io>
      \<gtr\>\ 
    <|folded-io>
      b
    <|folded-io>
      <guile-result|#("a1" "a2" "a3" "a4" "b4")>
    </folded-io>

    <\folded-io>
      \<gtr\>\ 
    <|folded-io>
      a
    <|folded-io>
      <guile-result|#("a0" "a1" "a2" "a3" "a4")>
    </folded-io>

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

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    (define* (vector-copy! to at from (start 0) (end (vector-length from)))

    \ \ (if (or (\<less\> at 0)

    \ \ \ \ \ \ \ \ \ \ (\<gtr\> start (vector-length from))

    \ \ \ \ \ \ \ \ \ \ (\<less\> end 0)

    \ \ \ \ \ \ \ \ \ \ (\<gtr\> end (vector-length from))

    \ \ \ \ \ \ \ \ \ \ (\<gtr\> start end)

    \ \ \ \ \ \ \ \ \ \ (\<gtr\> (+ at (- end start)) (vector-length to)))

    \ \ \ \ \ \ (error 'out-of-range "vector-copy!")

    \ \ \ \ \ \ (let loop ((to-i at) (from-i start))

    \ \ \ \ \ \ \ \ (if (\<gtr\>= from-i end)

    \ \ \ \ \ \ \ \ \ \ \ \ to

    \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! to to-i (vector-ref from from-i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ to-i 1) (+ from-i 1)))))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (define a (vector "a0" "a1" "a2" "a3" "a4"))

    (define b (vector "b0" "b1" "b2" "b3" "b4"))

    \;

    ;(\<less\> at 0)

    (check-catch 'out-of-range (vector-copy! b -1 a))

    \;

    ;(\<less\> start 0)

    (check-catch 'out-of-range (vector-copy! b 0 a -1))

    \;

    ;(\<gtr\> start (vector-length from))

    (check-catch 'out-of-range (vector-copy! b 0 a 6))

    \;

    ;(\<gtr\> end (vector-length from))

    (check-catch 'out-of-range (vector-copy! b 0 a 0 6))

    \;

    ;(\<gtr\> start end)

    (check-catch 'out-of-range (vector-copy! b 0 a 2 1))

    \;

    ;(\<gtr\> (+ at (- end start)) (vector-length to))

    (check-catch 'out-of-range (vector-copy! b 6 a))

    \;

    (check-catch 'out-of-range (vector-copy! b 1 a))

    \;

    (define a (vector "a0" "a1" "a2" "a3" "a4"))

    (define b (vector "b0" "b1" "b2" "b3" "b4"))

    (vector-copy! b 0 a 1)

    (check b =\<gtr\> #("a1" "a2" "a3" "a4" "b4"))

    \;

    (define a (vector "a0" "a1" "a2" "a3" "a4"))

    (define b (vector "b0" "b1" "b2" "b3" "b4"))

    (vector-copy! b 0 a 0 5)

    (check b =\<gtr\> #("a0" "a1" "a2" "a3" "a4"))\ 

    \;
  </scm-chunk>

  <subsection|转换>

  <r7rs><paragraph|vector-\<gtr\>list><scm|(vector-\<gtr\>list v [start [end]])><index|vector-\<gtr\>list>

  返回一个新分配的列表，包含向量中从 start 到 end 之间的元素中的对象。当 <scm|start>、<scm|end>不是向量的有效索引，报错。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|true>
    (check (vector-\<gtr\>list #()) =\<gtr\> '())

    (check (vector-\<gtr\>list #() 0) =\<gtr\> '())

    \;

    (check-catch 'out-of-range (vector-\<gtr\>list #() 1))

    \;

    (check (vector-\<gtr\>list #(0 1 2 3)) =\<gtr\> '(0 1 2 3))

    (check (vector-\<gtr\>list #(0 1 2 3) 1) =\<gtr\> '(1 2 3))

    (check (vector-\<gtr\>list #(0 1 2 3) 1 1) =\<gtr\> '())

    (check (vector-\<gtr\>list #(0 1 2 3) 1 2) =\<gtr\> '(1))

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|list-\<gtr\>vector><scm|(list-\<gtr\>vector l)><index|list-\<gtr\>vector>

  返回一个新创建的向量，其元素初始化为列表 <code*|list> 中的元素。注意，<item*|list-\<gtr\>vector>不像<item*|vector-\<gtr\>list>那样可用接收索引参数。

  <\scm-chunk|tests/goldfish/liii/base-test.scm|true|false>
    (check (list-\<gtr\>vector '(0 1 2 3)) =\<gtr\> #(0 1 2 3))

    (check (list-\<gtr\>vector '()) =\<gtr\> #())

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|reverse-list-\<gtr\>vector><scm|(reverse-list-\<gtr\>vector l)><index|list-\<gtr\>vector>

  返回一个新创建的向量，其元素初始化为反转后的列表 <code*|list> 中的元素。

  传入的列表应当是一个 proper-list。

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|true>
    ; Input a proper-list, return a vector with inversed order elements.

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

    \ \ (typed-lambda ((lst proper-list?))

    \ \ \ \ (let* ((len (length lst)) (v-rst (make-vector len)))

    \ \ \ \ \ \ (let loop ((l lst) (i (- len 1)))

    \ \ \ \ \ \ \ \ (if (null? l) v-rst

    \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! v-rst i (car l))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr l) (- i 1))))))))

    \;
  </scm-chunk>

  \;

  <subparagraph|测试>

  常见情况：

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (reverse-list-\<gtr\>vector '()) =\<gtr\> '#())

    (check (reverse-list-\<gtr\>vector '(1 2 3)) =\<gtr\> '#(3 2 1))

    \;
  </scm-chunk>

  点状列表不是正规列表，故而会直接抛出<goldfish-lang|type-error>：

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check-catch 'type-error (reverse-list-\<gtr\>vector '(1 2 . 3)))

    \;
  </scm-chunk>

  循环列表不是正规列表，故而会直接抛出<scm|type-error>：

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check-catch 'type-error (reverse-list-\<gtr\>vector (circular-list 1 2 3)))

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|vector-\<gtr\>string><scm|(v [start [end]]) =\<gtr\> string><index|vector-\<gtr\>string>

  将向量v转化为字符串，如果指定了起始索引和终止索引，则只将指定范围内的子向量转化为字符串。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0-clause BSD

    ; Bill Schottstaedt

    ; from S7 source repo: r7rs.scm

    (define* (vector-\<gtr\>string v (start 0) end)\ 

    \ \ (let ((stop (or end (length v))))\ 

    \ \ \ \ (copy v (make-string (- stop start)) start stop)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3)) =\<gtr\> "0123")

    (check (vector-\<gtr\>string (vector #\\a #\\b #\\c)) =\<gtr\> "abc")

    \;

    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 0 4) =\<gtr\> "0123")

    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 1) =\<gtr\> "123")

    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 1 4) =\<gtr\> "123")

    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 1 3) =\<gtr\> "12")

    (check (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 1 2) =\<gtr\> "1")

    \;

    (check-catch 'out-of-range (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 2 10))

    \;

    (check (vector-\<gtr\>string (vector 0 1 #\\2 3 4) 2 3) =\<gtr\> "2")

    \;

    (check-catch 'wrong-type-arg (vector-\<gtr\>string (vector 0 1 #\\2 3 4) 1 3))

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|string-\<gtr\>vector><scm|(s [start [end]]) =\<gtr\> vector><index|string-\<gtr\>vector>

  将字符串s转化为向量，如果指定了起始索引和终止索引，则只将指定范围内的子字符串转化为向量。

  <\scm-chunk|goldfish/scheme/base.scm|true|true>
    ; 0-clause BSD

    ; Bill Schottstaedt

    ; from S7 source repo: r7rs.scm

    (define* (string-\<gtr\>vector s (start 0) end)

    \ \ (let ((stop (or end (length s))))\ 

    \ \ \ \ (copy s (make-vector (- stop start)) start stop)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/vector-test.scm|true|true>
    (check (string-\<gtr\>vector "0123") =\<gtr\> (vector #\\0 #\\1 #\\2 #\\3))

    (check (string-\<gtr\>vector "abc") =\<gtr\> (vector #\\a #\\b #\\c))

    \;

    (check (string-\<gtr\>vector "0123" 0 4) =\<gtr\> (vector #\\0 #\\1 #\\2 #\\3))

    (check (string-\<gtr\>vector "0123" 1) =\<gtr\> (vector #\\1 #\\2 #\\3))

    (check (string-\<gtr\>vector "0123" 1 4) =\<gtr\> (vector #\\1 #\\2 #\\3))

    (check (string-\<gtr\>vector "0123" 1 3) =\<gtr\> (vector #\\1 #\\2))

    (check (string-\<gtr\>vector "0123" 1 2) =\<gtr\> (vector #\\1))

    \;

    (check-catch 'out-of-range (string-\<gtr\>vector "0123" 2 10))

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/srfi/srfi-133.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii stack)>

  栈是一个先进后出（FILO）的数据结构。

  这个函数库是三鲤自定义的库，参考了C++和Java的栈相关的函数库的接口。

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (srfi srfi-9)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ stack

    \ stack? stack-empty?

    \ stack-size stack-top

    \ stack-push! stack-pop!

    \ stack-\<gtr\>list

    )

    (begin

    \;
  </scm-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/stack-test.scm|false|false>
    (import (liii stack)

    \ \ \ \ \ \ \ \ (liii check))

    \;

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

    \;

    (define stack1 (stack))

    (check (stack-empty? stack1) =\<gtr\> #t)

    (check (stack-\<gtr\>list stack1) =\<gtr\> '())

    (check-catch 'value-error (stack-pop! stack1))

    \;

    (stack-push! stack1 1)

    (check (stack-\<gtr\>list stack1) =\<gtr\> '(1))

    (check (stack-top stack1) =\<gtr\> 1)

    (check (stack-size stack1) =\<gtr\> 1)

    (check (stack-pop! stack1) =\<gtr\> 1)

    (check (stack-empty? stack1) =\<gtr\> #t)

    (check (stack-size stack1) =\<gtr\> 0)

    \;

    (define stack2 (stack 1 2 3))

    (check (stack-\<gtr\>list stack2) =\<gtr\> '(1 2 3))

    (check (stack-size stack2) =\<gtr\> 3)

    (check (stack-pop! stack2) =\<gtr\> 1)

    (check (stack-pop! stack2) =\<gtr\> 2)

    (check (stack-pop! stack2) =\<gtr\> 3)

    \;

    (define stack3 (stack ))

    (stack-push! stack3 1)

    (stack-push! stack3 2)

    (stack-push! stack3 3)

    (check (stack-pop! stack3) =\<gtr\> 3)

    (check (stack-pop! stack3) =\<gtr\> 2)

    (check (stack-pop! stack3) =\<gtr\> 1)

    \;

    (check-catch 'type-error (stack-empty? 1))

    \;
  </scm-chunk>

  <section|实现>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define-record-type :stack

    \ \ (make-stack data)

    \ \ stack?

    \ \ (data get-data set-data!))

    \;

    (define (%stack-check-parameter st)

    \ \ (when (not (stack? st))

    \ \ \ \ (error 'type-error "Parameter st is not a stack")))

    \;
  </scm-chunk>

  <paragraph|stack><index|stack><scm|(x1 x2 ...) =\<gtr\> stack>

  传入参数，构造一个栈，第一个参数是栈顶。如果没有参数，则构造的是空栈。

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack . l)

    \ \ (if (null? l)

    \ \ \ \ \ \ (make-stack '())

    \ \ \ \ \ \ (make-stack l)))

    \;
  </scm-chunk>

  <paragraph|stack-empty?><index|stack-empty?><scm|(st) =\<gtr\> bool>

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

    \ \ (%stack-check-parameter st)

    \ \ (null? (get-data st)))

    \;
  </scm-chunk>

  <paragraph|stack-size><index|stack-size><scm|(st) =\<gtr\> int>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack-size st)

    \ \ (%stack-check-parameter st)

    \ \ (length (get-data st)))

    \;
  </scm-chunk>

  <paragraph|stack-top><index|stack-top><scm|(st) =\<gtr\> x>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack-top st)

    \ \ (%stack-check-parameter st)

    \ \ (car (get-data st)))

    \;
  </scm-chunk>

  <paragraph|stack-push!><index|stack-push!><scm|(st x) =\<gtr\> #\<less\>unspecified\<gtr\>>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack-push! st elem)

    \ \ (%stack-check-parameter st)

    \ \ (set-data! st (cons elem (get-data st))))

    \;
  </scm-chunk>

  <paragraph|stack-pop!><index|stack-pop!><scm|(st) =\<gtr\> x>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack-pop! st)

    \ \ (%stack-check-parameter st)

    \ \ (when (stack-empty? st)

    \ \ \ \ (error 'value-error "Failed to stack-pop! on empty stack"))

    \ \ (let1 data (get-data st)

    \ \ \ \ (set-data! st (cdr data))

    \ \ \ \ (car data)))

    \;
  </scm-chunk>

  <paragraph|stack-\<gtr\>list><index|stack-\<gtr\>list><scm|(st) =\<gtr\> list>

  <\scm-chunk|goldfish/liii/stack.scm|true|true>
    (define (stack-\<gtr\>list st)

    \ \ (%stack-check-parameter st)

    \ \ (get-data st))

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of library

    \;
  </scm-chunk>

  <chapter|(liii queue)>

  这个函数库是三鲤自定义的库，参考了C++和Java的队列相关的函数库的接口。目前基于Scheme的列表实现，从队列取出数据的复杂度是<math|O<around*|(|1|)>>，从队列存入数据的复杂度是<math|O<around*|(|n|)>>。

  <section|许可证>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/queue-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (liii list)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (srfi srfi-9)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ \ queue

    \ \ queue? queue-empty?

    \ \ queue-size queue-front queue-back

    \ \ queue-pop! queue-push!

    \ \ queue-\<gtr\>list)

    (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii check))

    \;

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

    \;

    (let1 q1 (queue)

    \ \ (check-true (queue-empty? q1))

    \ \ (check (queue-size q1) =\<gtr\> 0)

    \ \ (check-catch 'value-error (queue-pop! q1))

    \;

    \ \ (queue-push! q1 1)

    \ \ (check (queue-size q1) =\<gtr\> 1)

    \ \ (check (queue-front q1) =\<gtr\> 1)

    \ \ (check (queue-back q1) =\<gtr\> 1)

    \ \ (check (queue-pop! q1) =\<gtr\> 1)

    \ \ (check-true (queue-empty? q1))

    )

    \;

    (let1 q2 (queue 1 2 3)

    \ \ (check (queue-size q2) =\<gtr\> 3)

    \ \ (check (queue-front q2) =\<gtr\> 1)

    \ \ (check (queue-back q2) =\<gtr\> 3)

    \ \ (check (queue-pop! q2) =\<gtr\> 1)

    \ \ (check (queue-pop! q2) =\<gtr\> 2)

    \ \ (check (queue-pop! q2) =\<gtr\> 3)

    )

    \;
  </scm-chunk>

  <section|实现>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define-record-type :queue

    \ \ (make-queue data)

    \ \ queue?

    \ \ (data get-data set-data!))

    \;

    (define (%queue-assert-type q)

    \ \ (when (not (queue? q))

    \ \ \ \ (type-error "Parameter q is not a queue")))

    \;

    (define (%queue-assert-value q)

    \ \ (when (queue-empty? q)

    \ \ \ \ (value-error "q must be non-empty")))

    \;
  </scm-chunk>

  <paragraph|queue><index|queue>

  第一个参数是队列的头部，最后一个参数是队列的尾部。

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue . l)

    \ \ (if (null? l)

    \ \ \ \ \ \ (make-queue '())

    \ \ \ \ \ \ (make-queue l)))

    \;
  </scm-chunk>

  <paragraph|queue-empty?><index|queue-empty?><scm|(queue) =\<gtr\> bool>

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

    \ \ (%queue-assert-type q)

    \ \ (null? (get-data q)))

    \;
  </scm-chunk>

  <paragraph|queue-size><index|queue-size><scm|(queue) =\<gtr\> int>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-size q)

    \ \ (%queue-assert-type q)

    \ \ (length (get-data q)))

    \;
  </scm-chunk>

  <paragraph|queue-front><index|queue-front><scm|(queue) =\<gtr\> x>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-front q)

    \ \ (%queue-assert-type q)

    \ \ (%queue-assert-value q)

    \ \ (first (get-data q)))

    \;
  </scm-chunk>

  <paragraph|queue-back><index|queue-back><scm|(queue) =\<gtr\> x>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-back q)

    \ \ (%queue-assert-type q)

    \ \ (%queue-assert-value q)

    \ \ (last (get-data q)))

    \;
  </scm-chunk>

  <paragraph|queue-push!><index|queue-push!><scm|(queue x) =\<gtr\> queue>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-push! q x)

    \ \ (%queue-assert-type q)

    \ \ (let1 data (get-data q)

    \ \ \ \ (set-data! q (append data (list x)))))

    \;
  </scm-chunk>

  <paragraph|queue-pop!><index|queue-pop!><scm|(queue) =\<gtr\> x>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-pop! q)

    \ \ (%queue-assert-type q)

    \ \ (%queue-assert-value q)

    \ \ (let1 data (get-data q)

    \ \ \ \ (set-data! q (cdr data))

    \ \ \ \ (car data)))

    \;
  </scm-chunk>

  <paragraph|queue-\<gtr\>list><index|queue-\<gtr\>list><scm|(queue) =\<gtr\> list>

  <\scm-chunk|goldfish/liii/queue.scm|true|true>
    (define (queue-\<gtr\>list q)

    \ \ (get-data q))

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii comparator)>

  <section|许可证>

  SRFI 128的参考实现依赖于SRFI 39。我们可以移除SRFI 128的参考实现对于SRFI 39的依赖。

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|false|true>
    ;;; SPDX-License-Identifier: MIT

    ;;;

    ;;; Copyright (C) John Cowan (2015). All Rights Reserved.

    ;;;\ 

    ;;; Permission is hereby granted, free of charge, to any person

    ;;; obtaining a copy of this software and associated documentation

    ;;; files (the "Software"), to deal in the Software without

    ;;; restriction, including without limitation the rights to use,

    ;;; copy, modify, merge, publish, distribute, sublicense, and/or

    ;;; sell copies of the Software, and to permit persons to whom the

    ;;; Software is furnished to do so, subject to the following

    ;;; conditions:

    ;;;\ 

    ;;; The above copyright notice and this permission notice shall be

    ;;; included in all copies or substantial portions of the Software.

    ;;;\ 

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

    ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES

    ;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

    ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

    ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

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

    ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

    ;;; OTHER DEALINGS IN THE SOFTWARE.\ 

    \;

    ;;;; Main part of the SRFI 114 reference implementation

    \;

    ;;; "There are two ways of constructing a software design: One way is to

    ;;; make it so simple that there are obviously no deficiencies, and the

    ;;; other way is to make it so complicated that there are no *obvious*

    ;;; deficiencies." --Tony Hoare

    \;
  </scm-chunk>

  <section|接口>

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

    (import (srfi srfi-128))

    (export

    \ \ comparator? comparator-ordered? comparator-hashable?

    \ \ make-comparator make-pair-comparator make-list-comparator

    \ \ make-vector-comparator make-eq-comparator make-eqv-comparator make-equal-comparator

    \ \ boolean-hash char-hash char-ci-hash string-hash string-ci-hash

    \ \ symbol-hash number-hash

    \ \ make-default-comparator default-hash

    \ \ comparator-type-test-predicate comparator-equality-predicate

    \ \ comparator-ordering-predicate comparator-hash-function

    \ \ comparator-test-type comparator-check-type comparator-hash

    \ \ =? \<less\>? \<gtr\>? \<less\>=? \<gtr\>=?

    )

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define-library (srfi srfi-128)

    (import (scheme base)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ \ comparator? comparator-ordered? comparator-hashable?

    \ \ make-comparator make-pair-comparator make-list-comparator

    \ \ make-vector-comparator make-eq-comparator make-eqv-comparator make-equal-comparator

    \ \ boolean-hash char-hash char-ci-hash string-hash string-ci-hash

    \ \ symbol-hash number-hash

    \ \ make-default-comparator default-hash

    \ \ comparator-type-test-predicate comparator-equality-predicate

    \ \ comparator-ordering-predicate comparator-hash-function

    \ \ comparator-test-type comparator-check-type comparator-hash

    \ \ =? \<less\>? \<gtr\>? \<less\>=? \<gtr\>=?

    )

    (begin

    \;
  </scm-chunk>

  <paragraph|comparator?><index|comparator?>

  <paragraph|comparator-ordered?><index|comparator-ordered?>

  <paragraph|comparator-hashable?><index|comparator-hashable?>

  <paragraph|comparator-type-test-predicate><index|comparator-type-test-predicate>

  <paragraph|comparator-equality-predicate><index|comparator-equality-predicate>

  <paragraph|comparator-ordering-predicate><index|comparator-ordering-predicate>

  <paragraph|comparator-hash-function><index|comparator-hash-function>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define-record-type comparator

    \ \ (make-raw-comparator type-test equality ordering hash ordering? hash?)

    \ \ comparator?

    \ \ (type-test comparator-type-test-predicate)

    \ \ (equality comparator-equality-predicate)

    \ \ (ordering comparator-ordering-predicate)

    \ \ (hash comparator-hash-function)

    \ \ (ordering? comparator-ordered?)

    \ \ (hash? comparator-hashable?))

    \;
  </scm-chunk>

  \;

  <paragraph|comparator-test-type><index|comparator-test-type>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    ;; Invoke the test type

    (define (comparator-test-type comparator obj)

    \ \ ((comparator-type-test-predicate comparator) obj))

    \;
  </scm-chunk>

  \;

  <paragraph|comparator-check-type><index|comparator-check-type>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (comparator-check-type comparator obj)

    \ \ (if (comparator-test-type comparator obj)

    \ \ \ \ #t

    \ \ \ \ (type-error "comparator type check failed" comparator obj)))

    \;
  </scm-chunk>

  \;

  <paragraph|comparator-hash><index|comparator-hash>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (comparator-hash comparator obj)

    \ \ ((comparator-hash-function comparator) obj))

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (liii base))

    \;

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

    \;
  </scm-chunk>

  \;

  <section|内部函数>

  <paragraph|binary=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (binary=? comparator a b)

    \ \ ((comparator-equality-predicate comparator) a b))

    \;
  </scm-chunk>

  <paragraph|binary\<less\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (binary\<less\>? comparator a b)

    \ \ ((comparator-ordering-predicate comparator) a b))

    \;
  </scm-chunk>

  \;

  <paragraph|binary\<gtr\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (binary\<gtr\>? comparator a b)

    \ \ (binary\<less\>? comparator b a))

    \;
  </scm-chunk>

  \;

  <paragraph|binary\<less\>=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (binary\<less\>=? comparator a b)

    \ \ (not (binary\<gtr\>? comparator a b)))

    \;
  </scm-chunk>

  \;

  <paragraph|binary\<gtr\>=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (binary\<gtr\>=? comparator a b)

    \ \ (not (binary\<less\>? comparator a b)))

    \;
  </scm-chunk>

  <paragraph|%salt%>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (%salt%)

    \ \ 16064047)

    \;
  </scm-chunk>

  <paragraph|hash-bound>

  <\equation*>
    2<rsup|25>-1
  </equation*>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (hash-bound)

    \ \ 33554432)

    \;
  </scm-chunk>

  <paragraph|make-hasher>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-hasher)

    \ \ (let ((result (%salt%)))

    \ \ \ \ (case-lambda

    \ \ \ \ \ (() result)

    \ \ \ \ \ ((n) (set! result (+ (modulo (* result 33) (hash-bound)) n))

    \ \ \ \ \ \ \ \ \ \ result))))

    \;
  </scm-chunk>

  <section|构造器>

  <paragraph|make-comparator><index|make-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-comparator type-test equality ordering hash)

    \ \ (make-raw-comparator

    \ \ \ \ (if (eq? type-test #t) (lambda (x) #t) type-test)

    \ \ \ \ (if (eq? equality #t) (lambda (x y) (eqv? (ordering x y) 0)) equality)

    \ \ \ \ (if ordering ordering (lambda (x y) (error "ordering not supported")))

    \ \ \ \ (if hash hash (lambda (x y) (error "hashing not supported")))

    \ \ \ \ (if ordering #t #f)

    \ \ \ \ (if hash #t #f)))

    \;
  </scm-chunk>

  <paragraph|make-eq-comparator><index|make-eq-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-eq-comparator)

    \ \ (make-comparator #t eq? #f default-hash))

    \;
  </scm-chunk>

  \;

  <paragraph|make-eqv-comparator><index|make-eqv-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-eqv-comparator)

    \ \ (make-comparator #t eqv? #f default-hash))

    \;
  </scm-chunk>

  \;

  <paragraph|make-equal-comparator><index|make-equal-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-equal-comparator)

    \ \ (make-comparator #t equal? #f default-hash))

    \;
  </scm-chunk>

  \;

  <paragraph|make-pair-comparator><index|make-pair-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-pair-type-test car-comparator cdr-comparator)

    \ \ (lambda (obj)

    \ \ \ \ (and (pair? obj)

    \ \ \ \ \ \ \ \ \ (comparator-test-type car-comparator (car obj))

    \ \ \ \ \ \ \ \ \ (comparator-test-type cdr-comparator (cdr obj)))))

    \;

    (define (make-pair=? car-comparator cdr-comparator)

    \ \ \ (lambda (a b)

    \ \ \ \ \ (and ((comparator-equality-predicate car-comparator) (car a) (car b))

    \ \ \ \ \ \ \ \ \ \ ((comparator-equality-predicate cdr-comparator) (cdr a) (cdr b)))))

    \;

    (define (make-pair\<less\>? car-comparator cdr-comparator)

    \ \ \ (lambda (a b)

    \ \ \ \ \ \ (if (=? car-comparator (car a) (car b))

    \ \ \ \ \ \ \ \ (\<less\>? cdr-comparator (cdr a) (cdr b))

    \ \ \ \ \ \ \ \ (\<less\>? car-comparator (car a) (car b)))))

    \;

    (define (make-pair-hash car-comparator cdr-comparator)

    \ \ \ (lambda (obj)

    \ \ \ \ \ (let ((acc (make-hasher)))

    \ \ \ \ \ \ \ (acc (comparator-hash car-comparator (car obj)))

    \ \ \ \ \ \ \ (acc (comparator-hash cdr-comparator (cdr obj)))

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

    \;

    (define (make-pair-comparator car-comparator cdr-comparator)

    \ \ \ (make-comparator

    \ \ \ \ \ (make-pair-type-test car-comparator cdr-comparator)

    \ \ \ \ \ (make-pair=? car-comparator cdr-comparator)

    \ \ \ \ \ (make-pair\<less\>? car-comparator cdr-comparator)

    \ \ \ \ \ (make-pair-hash car-comparator cdr-comparator)))

    \;
  </scm-chunk>

  <paragraph|make-list-comparator><index|make-list-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    ;; Cheap test for listness

    (define (norp? obj) (or (null? obj) (pair? obj)))

    \;

    (define (make-list-comparator element-comparator type-test empty? head tail)

    \ \ \ (make-comparator

    \ \ \ \ \ (make-list-type-test element-comparator type-test empty? head tail)

    \ \ \ \ \ (make-list=? element-comparator type-test empty? head tail)

    \ \ \ \ \ (make-list\<less\>? element-comparator type-test empty? head tail)

    \ \ \ \ \ (make-list-hash element-comparator type-test empty? head tail)))

    \;

    (define (make-list-type-test element-comparator type-test empty? head tail)

    \ \ (lambda (obj)

    \ \ \ \ (and

    \ \ \ \ \ \ (type-test obj)

    \ \ \ \ \ \ (let ((elem-type-test (comparator-type-test-predicate element-comparator)))

    \ \ \ \ \ \ \ \ (let loop ((obj obj))

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

    \ \ \ \ \ \ \ \ \ \ \ \ ((empty? obj) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ ((not (elem-type-test (head obj))) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (tail obj)))))))))

    \;

    (define (make-list=? element-comparator type-test empty? head tail)

    \ \ (lambda (a b)

    \ \ \ \ (let ((elem=? (comparator-equality-predicate element-comparator)))

    \ \ \ \ \ \ (let loop ((a a) (b b))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((and (empty? a) (empty? b) #t))

    \ \ \ \ \ \ \ \ \ \ ((empty? a) #f)

    \ \ \ \ \ \ \ \ \ \ ((empty? b) #f)

    \ \ \ \ \ \ \ \ \ \ ((elem=? (head a) (head b)) (loop (tail a) (tail b)))

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

    \;

    (define (make-list\<less\>? element-comparator type-test empty? head tail)

    \ \ (lambda (a b)

    \ \ \ \ (let ((elem=? (comparator-equality-predicate element-comparator))

    \ \ \ \ \ \ \ \ \ \ (elem\<less\>? (comparator-ordering-predicate element-comparator)))

    \ \ \ \ \ \ (let loop ((a a) (b b))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((and (empty? a) (empty? b) #f))

    \ \ \ \ \ \ \ \ \ \ ((empty? a) #t)

    \ \ \ \ \ \ \ \ \ \ ((empty? b) #f)

    \ \ \ \ \ \ \ \ \ \ ((elem=? (head a) (head b)) (loop (tail a) (tail b)))

    \ \ \ \ \ \ \ \ \ \ ((elem\<less\>? (head a) (head b)) #t)

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

    \;

    (define (make-list-hash element-comparator type-test empty? head tail)

    \ \ (lambda (obj)

    \ \ \ \ (let ((elem-hash (comparator-hash-function element-comparator))

    \ \ \ \ \ \ \ \ \ \ (acc (make-hasher)))

    \ \ \ \ \ \ (let loop ((obj obj))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((empty? obj) (acc))

    \ \ \ \ \ \ \ \ \ \ (else (acc (elem-hash (head obj))) (loop (tail obj))))))))

    \;
  </scm-chunk>

  \;

  <paragraph|make-vector-comparator><index|make-vector-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-vector-comparator element-comparator type-test length ref)

    \ \ (make-comparator

    \ \ \ \ (make-vector-type-test element-comparator type-test length ref)

    \ \ \ \ (make-vector=? element-comparator type-test length ref)

    \ \ \ \ (make-vector\<less\>? element-comparator type-test length ref)

    \ \ \ \ (make-vector-hash element-comparator type-test length ref)))

    \;

    (define (make-vector-type-test element-comparator type-test length ref)

    \ \ (lambda (obj)

    \ \ \ \ (and

    \ \ \ \ \ \ (type-test obj)

    \ \ \ \ \ \ (let ((elem-type-test (comparator-type-test-predicate element-comparator))

    \ \ \ \ \ \ \ \ \ \ \ \ (len (length obj)))

    \ \ \ \ \ \ \ \ (let loop ((n 0))

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

    \ \ \ \ \ \ \ \ \ \ \ \ ((= n len) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ ((not (elem-type-test (ref obj n))) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (+ n 1)))))))))

    \;

    (define (make-vector=? element-comparator type-test length ref)

    \ \ \ (lambda (a b)

    \ \ \ \ \ (and

    \ \ \ \ \ \ \ (= (length a) (length b))

    \ \ \ \ \ \ \ (let ((elem=? (comparator-equality-predicate element-comparator))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (len (length b)))

    \ \ \ \ \ \ \ \ \ (let loop ((n 0))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((= n len) #t)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((elem=? (ref a n) (ref b n)) (loop (+ n 1)))

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

    \;

    (define (make-vector\<less\>? element-comparator type-test length ref)

    \ \ \ (lambda (a b)

    \ \ \ \ \ (cond

    \ \ \ \ \ \ \ ((\<less\> (length a) (length b)) #t)

    \ \ \ \ \ \ \ ((\<gtr\> (length a) (length b)) #f)

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (let ((elem=? (comparator-equality-predicate element-comparator))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (elem\<less\>? (comparator-ordering-predicate element-comparator))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (len (length a)))

    \ \ \ \ \ \ \ \ \ (let loop ((n 0))

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

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((= n len) #f)

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((elem=? (ref a n) (ref b n)) (loop (+ n 1)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ ((elem\<less\>? (ref a n) (ref b n)) #t)

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

    \;

    (define (make-vector-hash element-comparator type-test length ref)

    \ \ (lambda (obj)

    \ \ \ \ (let ((elem-hash (comparator-hash-function element-comparator))

    \ \ \ \ \ \ \ \ \ \ (acc (make-hasher))

    \ \ \ \ \ \ \ \ \ \ (len (length obj)))

    \ \ \ \ \ \ (let loop ((n 0))

    \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ ((= n len) (acc))

    \ \ \ \ \ \ \ \ \ \ (else (acc (elem-hash (ref obj n))) (loop (+ n 1))))))))

    \;
  </scm-chunk>

  <section|标准函数>

  <paragraph|object-type>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (object-type obj)

    \ \ (cond

    \ \ \ \ ((null? obj) 0)

    \ \ \ \ ((pair? obj) 1)

    \ \ \ \ ((boolean? obj) 2)

    \ \ \ \ ((char? obj) 3)

    \ \ \ \ ((string? obj) 4)

    \ \ \ \ ((symbol? obj) 5)

    \ \ \ \ ((number? obj) 6)

    \ \ \ \ ((vector? obj) 7)

    \ \ \ \ ((bytevector? obj) 8)

    \ \ \ \ (else 65535)))

    \;
  </scm-chunk>

  <paragraph|boolean\<less\>?><index|boolean\<less\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (boolean\<less\>? a b)

    \ \ ;; #f \<less\> #t but not otherwise

    \ \ (and (not a) b))

    \;
  </scm-chunk>

  <paragraph|complex\<less\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (complex\<less\>? a b)

    \ \ (if (= (real-part a) (real-part b))

    \ \ \ \ (\<less\> (imag-part a) (imag-part b))

    \ \ \ \ (\<less\> (real-part a) (real-part b))))

    \;
  </scm-chunk>

  <paragraph|symbol\<less\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (symbol\<less\>? a b)

    \ \ (string\<less\>? (symbol-\<gtr\>string a) (symbol-\<gtr\>string b)))

    \;
  </scm-chunk>

  \;

  <paragraph|boolean-hash><index|boolean-hash>

  <paragraph|char-hash><index|char-hash>

  <paragraph|char-ci-hash><index|char-ci-hash>

  <paragraph|string-hash><index|string-hash>

  <paragraph|string-ci-hash><index|string-ci-hash>

  <paragraph|symbol-hash><index|symbol-hash>

  <paragraph|number-hash><index|number-hash>

  <paragraph|default-hash><index|default-hash>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define boolean-hash hash-code)

    (define char-hash hash-code)

    (define char-ci-hash hash-code)

    (define string-hash hash-code)

    (define string-ci-hash hash-code)

    (define symbol-hash hash-code)

    (define number-hash hash-code)

    (define default-hash hash-code)

    \;
  </scm-chunk>

  <paragraph|default-ordering>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (dispatch-ordering type a b)

    \ \ (case type

    \ \ \ \ ((0) 0) ; All empty lists are equal

    \ \ \ \ ((1) ((make-pair\<less\>? (make-default-comparator) (make-default-comparator)) a b))

    \ \ \ \ ((2) (boolean\<less\>? a b))

    \ \ \ \ ((3) (char\<less\>? a b))

    \ \ \ \ ((4) (string\<less\>? a b))

    \ \ \ \ ((5) (symbol\<less\>? a b))

    \ \ \ \ ((6) (complex\<less\>? a b))

    \ \ \ \ ((7) ((make-vector\<less\>? (make-default-comparator) vector? vector-length vector-ref)

    \ \ \ \ \ \ \ \ \ \ a b))

    \ \ \ \ ((8) ((make-vector\<less\>? (make-comparator exact-integer? = \<less\> default-hash)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ bytevector? bytevector-length bytevector-u8-ref)

    \ \ \ \ \ \ \ \ \ \ a b))

    \ \ \ \ ; Add more here

    \ \ \ \ (else (binary\<less\>? (registered-comparator type) a b))))

    \;

    (define (default-ordering a b)

    \ \ (let ((a-type (object-type a))

    \ \ \ \ \ \ \ \ (b-type (object-type b)))

    \ \ \ \ (cond

    \ \ \ \ \ \ ((\<less\> a-type b-type) #t)

    \ \ \ \ \ \ ((\<gtr\> a-type b-type) #f)

    \ \ \ \ \ \ (else (dispatch-ordering a-type a b)))))

    \;
  </scm-chunk>

  <paragraph|default-equality>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (dispatch-equality type a b)

    \ \ (case type

    \ \ \ \ ((0) #t) ; All empty lists are equal

    \ \ \ \ ((1) ((make-pair=? (make-default-comparator) (make-default-comparator)) a b))

    \ \ \ \ ((2) (boolean=? a b))

    \ \ \ \ ((3) (char=? a b))

    \ \ \ \ ((4) (string=? a b))

    \ \ \ \ ((5) (symbol=? a b))

    \ \ \ \ ((6) (= a b))

    \ \ \ \ ((7) ((make-vector=? (make-default-comparator)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ vector? vector-length vector-ref) a b))

    \ \ \ \ ((8) ((make-vector=? (make-comparator exact-integer? = \<less\> default-hash)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ bytevector? bytevector-length bytevector-u8-ref) a b))

    \ \ \ \ ; Add more here

    \ \ \ \ (else (binary=? (registered-comparator type) a b))))

    \;

    (define (default-equality a b)

    \ \ (let ((a-type (object-type a))

    \ \ \ \ \ \ \ \ (b-type (object-type b)))

    \ \ \ \ (if (= a-type b-type)

    \ \ \ \ \ \ \ \ (dispatch-equality a-type a b)

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

    \;
  </scm-chunk>

  \;

  <paragraph|make-default-comparator><index|make-default-comparator>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (make-default-comparator)

    \ \ (make-comparator

    \ \ \ \ (lambda (obj) #t)

    \ \ \ \ default-equality

    \ \ \ \ default-ordering

    \ \ \ \ default-hash))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/comparator-test.scm|true|true>
    (let1 default-comp (make-default-comparator)

    \ \ (check-false (\<less\>? default-comp #t #t))

    \ \ (check-false (\<less\>? default-comp #f #f))

    \ \ (check-true (\<less\>? \ default-comp #f #t))

    \ \ (check-false (\<less\>? default-comp #t #f))

    \ \ (check-true (\<less\>? default-comp (cons #f #f) (cons #t #t)))

    \ \ (check-true (\<less\>? default-comp (list 1 2) (list 2 3)))

    \ \ (check-true (\<less\>? default-comp (list 1 2) (list 1 3)))

    \ \ (check-true (\<less\>? default-comp (vector "a" "b") (vector "b" "c")))

    \ \ 

    \ \ (check-false (\<less\>? default-comp 1 1))

    \ \ (check-true (\<less\>? default-comp 0+1i 0+2i))

    \ \ (check-true (\<less\>? default-comp 1+2i 2+2i))

    \ \ 

    \ \ (check (comparator-hash default-comp (list 1 2)) =\<gtr\> 42)

    )

    \;
  </scm-chunk>

  <section|比较谓词>

  <paragraph|=?><index|=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (=? comparator a b . objs)

    \ \ (let loop ((a a) (b b) (objs objs))

    \ \ \ \ (and (binary=? comparator a b)

    \ \ \ \ \ \ \ \ \ (if (null? objs) #t (loop b (car objs) (cdr objs))))))

    \;
  </scm-chunk>

  \;

  <paragraph|\<less\>?><index|\<less\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (\<less\>? comparator a b . objs)

    \ \ (let loop ((a a) (b b) (objs objs))

    \ \ \ \ (and (binary\<less\>? comparator a b)

    \ \ \ \ \ \ \ \ \ (if (null? objs) #t (loop b (car objs) (cdr objs))))))

    \;
  </scm-chunk>

  \;

  <paragraph|\<gtr\>?><index|\<gtr\>?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (\<gtr\>? comparator a b . objs)

    \ \ (let loop ((a a) (b b) (objs objs))

    \ \ \ \ (and (binary\<gtr\>? comparator a b)

    \ \ \ \ \ \ \ \ \ (if (null? objs) #t (loop b (car objs) (cdr objs))))))

    \;
  </scm-chunk>

  \;

  <paragraph|\<less\>=?><index|\<less\>=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (\<less\>=? comparator a b . objs)

    \ \ (let loop ((a a) (b b) (objs objs))

    \ \ \ \ (and (binary\<less\>=? comparator a b)

    \ \ \ \ \ \ \ \ \ (if (null? objs) #t (loop b (car objs) (cdr objs))))))

    \;
  </scm-chunk>

  \;

  <paragraph|\<gtr\>=?><index|\<gtr\>=?>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|true>
    (define (\<gtr\>=? comparator a b . objs)

    \ \ (let loop ((a a) (b b) (objs objs))

    \ \ \ \ (and (binary\<gtr\>=? comparator a b)

    \ \ \ \ \ \ \ \ \ (if (null? objs) #t (loop b (car objs) (cdr objs))))))

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-128.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii hash-table)>

  <section|许可证>

  <\scm-chunk|goldfish/srfi/srfi-125.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/hash-table.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-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.

    ;

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii comparator)

    \ \ \ \ \ \ \ \ (liii hash-table)

    \ \ \ \ \ \ \ \ (liii base))

    \;

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

    \;

    (define empty-ht (make-hash-table))

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define-library (srfi srfi-125)

    (import (srfi srfi-1)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ \ make-hash-table hash-table hash-table-unfold alist-\<gtr\>hash-table

    \ \ hash-table? hash-table-contains? hash-table-empty? hash-table=?

    \ \ hash-table-mutable?

    \ \ hash-table-ref hash-table-ref/default

    \ \ hash-table-set! hash-table-delete! hash-table-intern! hash-table-update!

    \ \ hash-table-update!/default hash-table-pop! hash-table-clear!

    \ \ hash-table-size hash-table-keys hash-table-values hash-table-entries

    \ \ hash-table-find hash-table-count

    \ \ hash-table-for-each hash-table-map-\<gtr\>list

    \ \ hash-table-\<gtr\>alist

    )

    (begin

    \;
  </scm-chunk>

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

    (import (srfi srfi-125)

    \ \ \ \ \ \ \ \ (srfi srfi-128))

    (export

    \ \ make-hash-table hash-table hash-table-unfold alist-\<gtr\>hash-table

    \ \ hash-table? hash-table-contains? hash-table-empty? hash-table=?

    \ \ hash-table-mutable?

    \ \ hash-table-ref hash-table-ref/default

    \ \ hash-table-set! hash-table-delete! hash-table-intern! hash-table-update!

    \ \ hash-table-update!/default hash-table-pop! hash-table-clear!

    \ \ hash-table-size hash-table-keys hash-table-values hash-table-entries

    \ \ hash-table-find hash-table-count

    \ \ hash-table-for-each hash-table-map-\<gtr\>list

    \ \ hash-table-\<gtr\>alist

    )

    (begin
  </scm-chunk>

  <subsection|访问哈希表中的元素>

  除了SRFI 125定义的<scm|hash-table-ref>和<scm|hash-table-ref/default>之外，我们可以用S7 Scheme内置的访问方式：

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (check (ht 'a) =\<gtr\> #f)

    \ \ (hash-table-set! ht 'a 1)

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

    \;
  </scm-chunk>

  <section|实现>

  <subsection|子函数>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (assert-hash-table-type ht f)

    \ \ (when (not (hash-table? ht))

    \ \ \ \ (error 'type-error f "this parameter must be typed as hash-table")))

    \;

    (define s7-hash-table-set! hash-table-set!)

    (define s7-make-hash-table make-hash-table)

    (define s7-hash-table-entries hash-table-entries)

    \;
  </scm-chunk>

  <subsection|构造器>

  <paragraph|make-hash-table><index|make-hash-table><todo|>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (make-hash-table . args)

    \ \ (cond ((null? args) (s7-make-hash-table))

    \ \ \ \ \ \ \ \ ((comparator? (car args))

    \ \ \ \ \ \ \ \ \ (let* ((equiv (comparator-equality-predicate (car args)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-func (comparator-hash-function (car args))))

    \ \ \ \ \ \ \ \ \ \ \ (s7-make-hash-table 8 (cons equiv hash-func) (cons #t #t))))

    \ \ \ \ \ \ \ \ (else (type-error "make-hash-table"))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table (<code*|make-default-comparator>))

    \ \ (hash-table-set! ht 1 2)

    \ \ (check (ht 1) =\<gtr\> 2))

    \;

    (let* ((mod10 (lambda (x) (modulo x 10)))

    \ \ \ \ \ \ \ (digit=? (lambda (x y) (= (modulo x 10) (modulo y 10))))

    \ \ \ \ \ \ \ (comp (make-comparator number? digit=? #f mod10))

    \ \ \ \ \ \ \ (ht (make-hash-table comp)))

    \ \ (hash-table-set! ht 1 2)

    \ \ (hash-table-set! ht 11 3)

    \ \ (check (ht 1) =\<gtr\> 3)

    \ \ (check (ht 11) =\<gtr\> 3)

    \ \ (check (ht 21) =\<gtr\> 3))

    \;
  </scm-chunk>

  <paragraph|hash-table><todo|>

  <paragraph|alist-\<gtr\>hash-table><index|alist-\<gtr\>hash-table><todo|>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define alist-\<gtr\>hash-table

    \ \ (typed-lambda ((lst list?))

    \ \ \ \ (when (odd? (length lst))

    \ \ \ \ \ \ (value-error "The length of lst must be even!"))

    \ \ \ \ (let1 ht (make-hash-table)

    \ \ \ \ \ \ (let loop ((rest lst))

    \ \ \ \ \ \ \ \ (if (null? rest)

    \ \ \ \ \ \ \ \ \ \ \ \ ht

    \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table-set! ht (car rest) (cadr rest))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cddr rest))))))))

    \;
  </scm-chunk>

  <subsection|谓词>

  <paragraph|hash-table?><index|hash-table?><typehint|(obj) =\<gtr\> boolean?>

  S7内置函数。判断一个对象是不是哈希表。

  <paragraph|hash-table-contains?><index|hash-table-contains?><typehint|((ht hash-table?) key) =\<gtr\> boolean?>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-contains? ht key)

    \ \ (not (not (hash-table-ref ht key))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (hash-table-set! ht 'brand 'liii)

    \ \ (check (hash-table-contains? ht 'brand) =\<gtr\> #t)

    \ \ (hash-table-set! ht 'brand #f)

    \ \ (check (hash-table-contains? ht 'brand) =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|hash-table-empty?><index|hash-table-empty?><typehint|((ht hash-table?)) =\<gtr\> boolean?>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-empty? ht)

    \ \ (zero? (hash-table-size ht)))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-empty? empty-ht) =\<gtr\> #t)

    \;

    (let1 test-ht (make-hash-table)

    \ \ (hash-table-set! test-ht 'key 'value)

    \ \ (check (hash-table-empty? test-ht) =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|hash-table=?><index|hash-table=?><typehint|((ht1 hash-table?) (ht2 hash-table?)) =\<gtr\> boolean?>

  <todo|改进实现，需要使用typed-lambda保证ht1和ht2都是哈希表>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table=? ht1 ht2)

    \ \ (equal? ht1 ht2))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let ((empty-h1 (make-hash-table))

    \ \ \ \ \ \ (empty-h2 (make-hash-table)))

    \ \ (check (hash-table=? empty-h1 empty-h2) =\<gtr\> #t))

    \;

    (let ((t1 (make-hash-table))

    \ \ \ \ \ \ (t2 (make-hash-table)))

    \ \ (hash-table-set! t1 'a 1)

    \ \ (hash-table-set! t2 'a 1)

    \ \ (check (hash-table=? t1 t2) =\<gtr\> #t)

    \ \ (hash-table-set! t1 'b 2)

    \ \ (check (hash-table=? t1 t2) =\<gtr\> #f))

    \;
  </scm-chunk>

  <subsection|选择器>

  <paragraph|hash-table-ref><index|hash-table-ref><typehint|((ht hash-table?) key) =\<gtr\> value>

  <\description>
    <item*|ht>哈希表

    <item*|key>键

    <item*|value>返回hash表中key这个键对应的值
  </description>

  SRFI 125定义的<scm|hash-table-ref>的函数签名是这样的：<scm|(hash-table-ref hash-table key [failure [success]])>。两参数形式的<scm|hash-table-ref>是S7 Scheme的内置函数。

  在S7 Scheme中，可以直接将hash-table视作一个单参数的函数，比如<scm|(ht 'key)>等价于<scm|(hash-table-ref ht 'key)>。

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-ref empty-ht 'key) =\<gtr\> #f)

    \;

    (let1 ht (make-hash-table)

    \ \ (hash-table-set! ht 'key 'value)

    \ \ (check (hash-table-ref ht 'key) =\<gtr\> 'value)

    \ \ (check (ht 'key) =\<gtr\> 'value))

    \;
  </scm-chunk>

  <paragraph|hash-table-ref/default><index|hash-table-ref/default><typehint|((ht hash-table?) key default) =\<gtr\> value>

  <todo|需要设计一种合理的方式，标注default参数实际上是惰性求值的>

  <\description>
    <item*|ht>哈希表

    <item*|key>键

    <item*|default>默认值，如果key这个键在哈希表中对应的值不存在，则返回默认值。注意，该默认值只有在key这个键不存在的时候，才会被求值。

    <item*|value>键对应的值，如果不存在，则为默认值。
  </description>

  <subparagraph|测试>

  当键对应的值存在时，default不会被求值，故而测试中的<scm|(display "hello")>实际不会被执行。

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (check (hash-table-ref/default ht 'key 'value1) =\<gtr\> 'value1)

    \ \ (check (hash-table-ref/default ht 'key (+ 1 2)) =\<gtr\> 3)

    \;

    \ \ (hash-table-set! ht 'key 'value)

    \ \ (check (hash-table-ref/default ht 'key

    \ \ \ \ \ \ \ \ \ \ \ (begin (display "hello")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (+ 1 2)))

    \ \ \ \ =\<gtr\> 'value)

    ) ; end of let1

    \;
  </scm-chunk>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define-macro (hash-table-ref/default ht key default)

    \ \ `(or (hash-table-ref ,ht ,key)

    \ \ \ \ \ \ \ \ ,default))

    \;
  </scm-chunk>

  <subsection|修改器>

  <paragraph|hash-table-set!><index|hash-table-set!><todo|typehint>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (hash-table-set! ht 'k1 'v1 'k2 'v2)

    \ \ (check (ht 'k1) =\<gtr\> 'v1)

    \ \ (check (ht 'k2) =\<gtr\> 'v2)

    )

    \;
  </scm-chunk>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-set! ht . rest)

    \ \ (assert-hash-table-type ht hash-table-set!)

    \ \ (let1 len (length rest)

    \ \ \ \ (when (or (odd? len) (zero? len))

    \ \ \ \ \ \ (error 'wrong-number-of-args len "but must be even and non-zero"))

    \ \ \ \ 

    \ \ \ \ (s7-hash-table-set! ht (car rest) (cadr rest))

    \ \ \ \ (when (\<gtr\> len 2)

    \ \ \ \ \ \ \ \ \ \ (apply hash-table-set! (cons ht (cddr rest))))))

    \;
  </scm-chunk>

  <paragraph|hash-table-delete!><index|hash-table-delete!><todo|typehints>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (hash-table-update! ht 'key 'value)

    \ \ (check (hash-table-delete! ht 'key) =\<gtr\> 1)

    \ \ (check-false (hash-table-contains? ht 'key))

    \ \ 

    \ \ (hash-table-update! ht 'key1 'value1)

    \ \ (hash-table-update! ht 'key2 'value2)

    \ \ (hash-table-update! ht 'key3 'value3)

    \ \ (hash-table-update! ht 'key4 'value4)

    \ \ (check (hash-table-delete! ht 'key1 'key2 'key3) =\<gtr\> 3)

    )

    \;
  </scm-chunk>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-delete! ht key . keys)

    \ \ (assert-hash-table-type ht hash-table-delete!)

    \ \ (let1 all-keys (cons key keys)

    \ \ \ \ (length

    \ \ \ \ \ \ (filter

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

    \ \ \ \ \ \ \ \ \ \ (if (hash-table-contains? ht x)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (s7-hash-table-set! ht x #f)

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

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

    \ \ \ \ \ \ \ \ all-keys))))

    \;
  </scm-chunk>

  <paragraph|hash-table-update!><index|hash-table-update!><todo|typehint>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-update! ht key value)

    \ \ (hash-table-set! ht key value))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (hash-table-update! ht 'key 'value)

    \ \ (check (ht 'key) =\<gtr\> 'value)

    \ \ (hash-table-update! ht 'key 'value1)

    \ \ (check (ht 'key) =\<gtr\> 'value1)

    \ \ (hash-table-update! ht 'key #f)

    \ \ (check (ht 'key) =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|hash-table-clear!><index|hash-table-clear!><todo|typehint>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-clear! ht)

    \ \ (for-each

    \ \ \ \ (lambda (key)

    \ \ \ \ \ \ (hash-table-set! ht key #f))

    \ \ \ \ (hash-table-keys ht)))

    \;
  </scm-chunk>

  \;

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (hash-table-update! ht 'key 'value)

    \ \ (hash-table-update! ht 'key1 'value1)

    \ \ (hash-table-update! ht 'key2 'value2)

    \ \ (hash-table-clear! ht)

    \ \ (check-true (hash-table-empty? ht)))

    \;
  </scm-chunk>

  <subsection|哈希表整体>

  <paragraph|hash-table-size><index|hash-table-size><typehint|((ht hash-table?)) =\<gtr\> integer?>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-size s7-hash-table-entries)

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-size empty-ht) =\<gtr\> 0)

    \;

    (let1 populated-ht (make-hash-table)

    \ \ (hash-table-set! populated-ht 'key1 'value1)

    \ \ (hash-table-set! populated-ht 'key2 'value2)

    \ \ (hash-table-set! populated-ht 'key3 'value3)

    \ \ (check (hash-table-size populated-ht) =\<gtr\> 3))

    \;
  </scm-chunk>

  <paragraph|hash-table-keys><index|hash-table-keys><typehint|((ht hash-table?)) =\<gtr\> list?>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-keys ht)

    \ \ (map car ht))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-keys empty-ht) =\<gtr\> '())

    \;

    (let1 ht (make-hash-table)

    \ \ (hash-table-set! ht 'k1 'v1)

    \ \ (check (hash-table-keys ht) =\<gtr\> '(k1)))

    \;
  </scm-chunk>

  <paragraph|hash-table-values><index|hash-table-values><todo|typehint>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define (hash-table-values ht)

    \ \ (map cdr ht))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-values empty-ht) =\<gtr\> '())

    \;

    (let1 ht (make-hash-table)

    \ \ (hash-table-set! ht 'k1 'v1)

    \ \ (check (hash-table-values ht) =\<gtr\> '(v1)))

    \;
  </scm-chunk>

  <paragraph|hash-table-entries><index|hash-table-entries><todo|typehint>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-entries

    \ \ (typed-lambda ((ht hash-table?))

    \ \ \ \ (let ((ks (hash-table-keys ht))

    \ \ \ \ \ \ \ \ \ \ (vs (hash-table-values ht)))

    \ \ \ \ \ \ (values ks vs))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (check (call-with-values (lambda () (hash-table-entries ht))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (ks vs) (list ks vs)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> (list (list ) (list )))

    \ \ 

    \ \ (hash-table-set! ht 'k1 'v1)

    \ \ (check (call-with-values (lambda () (hash-table-entries ht))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (lambda (ks vs) (list ks vs)))

    \ \ \ \ \ \ \ \ \ =\<gtr\> (list (list 'k1) (list 'v1))))

    \;
  </scm-chunk>

  <paragraph|hash-table-find><index|hash-table-find><typehint|(proc (ht hash-table?) failure) =\<gtr\> obj>

  对于哈希表中的每个关联项，调用proc函数处理它的键和值。如果proc返回真（true），那么hash-table-find函数将返回proc返回的结果。如果所有对proc的调用都返回假（#f），则返回调用thunk failure函数的结果。

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    \;
  </scm-chunk>

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

  \;

  <paragraph|hash-table-count><index|hash-table-count><typehint|((pred? procedure?) (ht hash-table?)) =\<gtr\> integer?>

  <subparagraph|实现>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-count

    \ \ (typed-lambda ((pred? procedure?) (ht hash-table?))

    \ \ \ \ (count (lambda (x) (pred? (car x) (cdr x)))

    \ \ \ \ \ \ \ \ \ \ \ (map values ht))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (check (hash-table-count (lambda (k v) #f) (hash-table)) =\<gtr\> 0)

    (check (hash-table-count (lambda (k v) #t) (hash-table 'a 1 'b 2 'c 3)) =\<gtr\> 3)

    (check (hash-table-count (lambda (k v) #f) (hash-table 'a 1 'b 2 'c 3)) =\<gtr\> 0)

    \;

    (check (hash-table-count (lambda (k v) (eq? k 'b)) (hash-table 'a 1 'b 2 'c 3)) =\<gtr\> 1)

    \;

    (check (hash-table-count (lambda (k v) (\<gtr\> v 1)) (hash-table 'a 1 'b 2 'c 3)) =\<gtr\> 2)

    \;

    (check (hash-table-count (lambda (k v) (string? k))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table "apple" 1 "banana" 2)) =\<gtr\> 2)

    \;

    (check (hash-table-count (lambda (k v) (and (symbol? k) (even? v)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table 'apple 2 'banana 3 'cherry 4)) =\<gtr\> 2)

    \;

    \;

    (check (hash-table-count (lambda (k v) (eq? k v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table 'a 'a 'b 'b 'c 'd)) =\<gtr\> 2)

    \;

    (check (hash-table-count (lambda (k v) (number? k))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table 1 100 2 200 3 300)) =\<gtr\> 3)

    \;

    (check (hash-table-count (lambda (k v) (list? v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table 'a '(1 2) 'b '(3 4) 'c 3)) =\<gtr\> 2)

    \;

    (check (hash-table-count (lambda (k v) \ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (= (char-\<gtr\>integer (string-ref (symbol-\<gtr\>string k) 0)) v))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (hash-table 'a 97 'b 98 'c 99)) =\<gtr\> 3)

    \;
  </scm-chunk>

  <subsection|映射和折叠>

  <paragraph|hash-table-foreach><index|hash-table-foreach><typehint|((proc procedure?) (ht hash-table?)) =\<gtr\> #\<less\>unspeficied\<gtr\>>

  对哈希表中的每个关联调用 proc，传递两个参数：关联的键和关联的值。proc 返回的值被丢弃。返回一个未指定的值。

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-for-each

    \ \ (typed-lambda ((proc procedure?) (ht hash-table?))

    \ \ \ \ (for-each (lambda (x) (proc (car x) (cdr x)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ ht)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 cnt 0

    \ \ (hash-table-for-each

    \ \ \ \ (lambda (k v)

    \ \ \ \ \ \ (set! cnt (+ cnt v)))

    \ \ \ \ (hash-table 'a 1 'b 2 'c 3))

    \ \ (check cnt =\<gtr\> 6))

    \;
  </scm-chunk>

  <paragraph|hash-table-map-\<gtr\>list><index|hash-table-map-\<gtr\>list><typehint|((proc procedure?) (ht hash-table?)) =\<gtr\> list?>

  对哈希表中的每个关联调用 proc，传递两个参数：关联的键和关联的值。每次调用 proc 返回的值会被累积到一个列表中，并最终返回该列表。

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-map-\<gtr\>list

    \ \ (typed-lambda ((proc procedure?) (ht hash-table?))

    \ \ \ \ (map (lambda (x) (proc (car x) (cdr x)))

    \ \ \ \ \ \ \ \ \ ht)))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let* ((ht (hash-table 'a 1 'b 2 'c 3))

    \ \ \ \ \ \ \ (ks (hash-table-map-\<gtr\>list (lambda (k v) k) ht))

    \ \ \ \ \ \ \ (vs (hash-table-map-\<gtr\>list (lambda (k v) v) ht)))

    \ \ (check-true (in? 'a ks))

    \ \ (check-true (in? 'b ks))

    \ \ (check-true (in? 'c ks))

    \ \ (check-true (in? 1 vs))

    \ \ (check-true (in? 2 vs))

    \ \ (check-true (in? 3 vs)))

    \;
  </scm-chunk>

  \;

  <subsection|复制和转换>

  <paragraph|hash-table-\<gtr\>alist><index|hash-table-\<gtr\>alist><todo|typehint>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|true>
    (define hash-table-\<gtr\>alist

    \ \ (typed-lambda ((ht hash-table?))

    \ \ \ \ (append-map

    \ \ \ \ \ \ (lambda (x) (list (car x) (cdr x)))

    \ \ \ \ \ \ (map values ht))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|true>
    (let1 ht (make-hash-table)

    \ \ (check (hash-table-\<gtr\>alist ht) =\<gtr\> (list))

    \ \ (hash-table-set! ht 'k1 'v1)

    \ \ (check (hash-table-\<gtr\>alist ht) =\<gtr\> '(k1 v1)))

    \;

    (check (hash-table-\<gtr\>alist (alist-\<gtr\>hash-table (list 'k1 'v1)))

    \ \ \ \ \ \ \ =\<gtr\> (list 'k1 'v1))

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|tests/goldfish/liii/hash-table-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-125.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    ) ; end of library

    \;
  </scm-chunk>

  \;

  <chapter|函数库和章节设计>

  <section|函数库的依赖关系>

  <subsection|R7RS以及和语言特性相关函数库的依赖关系>

  <\enumerate>
    <item>本节的依赖方向是父节点依赖于子节点，根节点仅仅是一个虚拟节点

    <item>下图中的<scm|srfi-n>表示函数库<scm|(srfi srfi-n)>

    <item>下图中的<scm|base>和<scm|case-lambda>分别表示<scm|(scheme base)>和<scm|(scheme case-lambda)>
  </enumerate>

  <\big-figure|<tree|root|<tree|(liii base)|base|srfi-2|srfi-8>|(liii error)|<tree|(liii cut)|srfi-26>|(liii case)|case-lambda>>
    语言基础和语言特性函数库
  </big-figure>

  \;

  <subsection|基础数据类型和数据结构相关函数库的依赖关系>

  <\enumerate>
    <item>本节的依赖方向是子节点依赖于父节点

    <item>下图中的<scm|srfi-n>表示函数库<scm|(srfi srfi-n)>

    <item>下图中的char表示函数库<scm|(scheme char)>，别的<scm|xyz>均表示函数库<scm|(liii xyz)>

    <item>本节中的函数库在实现时可以自由依赖上一节中的函数库，但仍旧需要遵守最小依赖原则
  </enumerate>

  <\big-figure|<tree|(liii base) and others|char|<tree|srfi-1|list>|alist|<tree|srfi-151|bitwise>|<tree|srfi-13|string>|<tree|srfi-133|vector>|stack|queue|<tree|srfi-128|comparator>|<tree|srfi-125|hash-table>|<tree|srfi-113|set>>>
    数据类型和数据结构函数库
  </big-figure>

  <section|章节设计>

  R7RS定义的函数库<scm|(scheme base)>所涉及的章节如下所示：

  <\itemize>
    <item><smart-ref|chapter:liii_base>：<scm|(liii base)>

    <item><smart-ref|chapter:liii_list>：<scm|(liii list)>

    <item><smart-ref|chapter:liii_string>：<scm|(liii string)>

    <item><smart-ref|chapter:liii_vector>：<scm|(liii vector)>
  </itemize>

  比如<scm|list-ref>这个函数，按照R7RS的定义，可以从<scm|(scheme base)>中得到。按照<scm|liii>开头的函数库的设计，也可以从<scm|(liii list)>中得到。

  <\scm-chunk|goldfish/scheme/base.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <part|标准库>

  <chapter|(liii base64)>

  <section|协议>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base64-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (liii base)

    \ \ \ \ \ \ \ \ (liii bitwise))

    (export

    \ \ string-base64-encode bytevector-base64-encode base64-encode

    \ \ string-base64-decode bytevector-base64-decode base64-decode

    )

    (begin
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii base64))

    \;

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

    \;
  </scm-chunk>

  <section|Base64编解码介绍>

  Base64编码是一种将任意字节序列编码为可打印字符的方式，其编码和解码的过程如下：

  <paragraph*|编码的长度计算：>

  Base64的编码长度与输入数据的长度相关，长度计算公式为：

  <equation*|<with|mode|text|length(output)>=<around*|\<lceil\>|<frac|<with|mode|text|length(input)>|3>|\<rceil\>>\<times\>4>

  其中，输入的每3个字节被转换为4个Base64字符。如果输入的字节数不是3的倍数，会在编码后用<code*|=>符号填充，保证输出长度始终是4的倍数。

  <paragraph*|输入数据的分组与填充：>

  <\big-table|<scm|<tabular|<tformat|<table|<row|<cell|b1>|<cell|b2>|<cell|b3>>|<row|<cell|0-255>|<cell|0-255>|<cell|0-255>>|<row|<cell|0-255>|<cell|0-255>|<cell|#f>>|<row|<cell|0-255>|<cell|#f>|<cell|#f>>>>>>>
    最后一组不足的元素需要设置为<scm|#f><label|table:16.1>
  </big-table>

  输入的字节流被分为每组3个字节进行编码。对于不足3个字节的最后一组，根据不同情况补充<code*|#f>（表示填充字节）。<smart-ref|table:16.1>展示了3种情况：

  <\itemize>
    <item>如果有3个字节，则正常处理。

    <item>如果有2个字节，则第三个字节补充为<code*|#f>。

    <item>如果只有1个字节，则后两个字节补充为<code*|#f>。
  </itemize>

  <paragraph*|映射规则：>

  每组3个字节 <math|<around*|[|b<rsub|1>,b<rsub|2>,b<rsub|3>|]>> 将映射为4个Base64字符 <math|<around*|[|c<rsub|1>,c<rsub|2>,c<rsub|3>,c<rsub|4>|]>>，其中，Base64字符的取值范围是字母、数字、<code*|+>、<code*|/>，以及可能的填充符号<code*|=>。映射的具体规则如下：

  <\itemize>
    <item>将3个字节（24位）按6位一组，分成4个部分，每个部分对应一个Base64字符。

    <item>如果不足3个字节（即有填充的情况），则最后一个或两个Base64字符会用<code*|=>替代。
  </itemize>

  <paragraph*|例子：>

  假设输入为"Man"，其ASCII值为<math|77,97,110>，其二进制表示为：

  <equation*|77=01001101,97=01100001,110=01101110>

  将24位二进制分为4组，每组6位：

  <equation*|010011,010110,000101,<with|mode|text|>101110>

  转换为Base64字符，分别对应<code*|T>, <code*|W>, <code*|F>, <code*|u>。因此，"Man"的Base64编码为<code*|TWFu>。

  解码时，过程反过来：将Base64字符转换为6位二进制，再拼接回原始的字节序列。

  Base64编码的特点是保持输入的可读性并使其适合传输，但相较于原始数据，会增加大约33%的大小。

  <section|实现>

  <paragraph|bytevector-base64-encode><index|bytevector-base64-encode>

  <paragraph|string-base64-encode><index|string-base64-encode>

  <paragraph|base64-encode><index|base64-encode>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define-constant BYTE2BASE64_BV

    \ \ (string-\<gtr\>utf8 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

    \;

    (define-constant BASE64_PAD_BYTE

    \ \ (char-\<gtr\>integer #\\=))

    \;

    (define bytevector-base64-encode

    \ \ (typed-lambda ((bv bytevector?))

    \ \ \ \ (define (encode b1 b2 b3)

    \ \ \ \ \ \ (let* ((p1 b1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (p2 (if b2 b2 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (p3 (if b3 b3 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (combined (bitwise-ior (ash p1 16) (ash p2 8) p3))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c1 (bitwise-and (ash combined -18) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c2 (bitwise-and (ash combined -12) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c3 (bitwise-and (ash combined -6) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c4 (bitwise-and combined #x3F)))

    \ \ \ \ \ \ \ \ (values

    \ \ \ \ \ \ \ \ \ \ (BYTE2BASE64_BV c1)

    \ \ \ \ \ \ \ \ \ \ (BYTE2BASE64_BV c2)

    \ \ \ \ \ \ \ \ \ \ (if b2 (BYTE2BASE64_BV c3) BASE64_PAD_BYTE)

    \ \ \ \ \ \ \ \ \ \ (if b3 (BYTE2BASE64_BV c4) BASE64_PAD_BYTE))))

    \ \ \ \ 

    \ \ \ \ (let* ((input-N (bytevector-length bv))

    \ \ \ \ \ \ \ \ \ \ \ (output-N (* 4 (ceiling (/ input-N 3))))

    \ \ \ \ \ \ \ \ \ \ \ (output (make-bytevector output-N)))

    \ \ \ \ \ \ (let loop ((i 0) (j 0))

    \ \ \ \ \ \ \ \ (when (\<less\> i input-N)

    \ \ \ \ \ \ \ \ \ \ (let* ((b1 (bv i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (b2 (if (\<less\> (+ i 1) input-N) (bv (+ i 1)) #f))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (b3 (if (\<less\> (+ i 2) input-N) (bv (+ i 2)) #f)))

    \ \ \ \ \ \ \ \ \ \ \ \ (receive (r1 r2 r3 r4) (encode b1 b2 b3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output j r1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 1) r2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 2) r3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 3) r4)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 3) (+ j 4))))))

    \ \ \ \ \ \ output)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define string-base64-encode

    \ \ (typed-lambda ((str string?))

    \ \ \ \ (utf8-\<gtr\>string (bytevector-base64-encode (string-\<gtr\>utf8 str)))))

    \;
  </scm-chunk>

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

    \ \ (cond ((string? x)

    \ \ \ \ \ \ \ \ \ (string-base64-encode x))

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

    \ \ \ \ \ \ \ \ \ (bytevector-base64-encode x))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (type-error "input must be string or bytevector"))))

    \;
  </scm-chunk>

  <subparagraph|测试>

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

    (check (base64-encode "a") =\<gtr\> "YQ==")

    (check (base64-encode "z") =\<gtr\> "eg==")

    (check (base64-encode "f") =\<gtr\> "Zg==")

    (check (base64-encode "fo") =\<gtr\> "Zm8=")

    (check (base64-encode "foo") =\<gtr\> "Zm9v")

    (check (base64-encode "foob") =\<gtr\> "Zm9vYg==")

    (check (base64-encode "fooba") =\<gtr\> "Zm9vYmE=")

    (check (base64-encode "foobar") =\<gtr\> "Zm9vYmFy")

    \;

    (check-catch 'type-error (base64-encode 1))

    \;
  </scm-chunk>

  <paragraph|bytevector-base64-decode><index|bytevector-base64-decode>

  <paragraph|string-base64-decode><index|string-base64-decode>

  <paragraph|base64-decode><index|base64-decode>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define-constant BASE64_TO_BYTE_V

    \ \ (let1 byte2base64-N (bytevector-length BYTE2BASE64_BV)

    \ \ \ \ (let loop ((i 0) (v (make-vector 256 -1)))

    \ \ \ \ \ \ (if (\<less\> i byte2base64-N)

    \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! v (BYTE2BASE64_BV i) i)

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) v))

    \ \ \ \ \ \ \ \ \ \ v))))

    \;

    (define (bytevector-base64-decode bv)

    \ \ (define (decode c1 c2 c3 c4)

    \ \ \ \ (let* ((b1 (BASE64_TO_BYTE_V c1))

    \ \ \ \ \ \ \ \ \ \ \ (b2 (BASE64_TO_BYTE_V c2))

    \ \ \ \ \ \ \ \ \ \ \ (b3 (BASE64_TO_BYTE_V c3))

    \ \ \ \ \ \ \ \ \ \ \ (b4 (BASE64_TO_BYTE_V c4)))

    \ \ \ \ \ \ (if (or (negative? b1) (negative? b2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (negative? b3) (!= c3 BASE64_PAD_BYTE))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (negative? b4) (!= c4 BASE64_PAD_BYTE)))

    \ \ \ \ \ \ \ \ \ \ (value-error "Invalid base64 input")

    \ \ \ \ \ \ \ \ \ \ (values

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-ior (ash b1 2) (ash b2 -4))

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-and (bitwise-ior (ash b2 4) (ash b3 -2)) #xFF)

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-and (bitwise-ior (ash b3 6) b4) #xFF)

    \ \ \ \ \ \ \ \ \ \ \ \ (if (negative? b3) 1 (if (negative? b4) 2 3))))))

    \ \ 

    \ \ (let* ((input-N (bytevector-length bv))

    \ \ \ \ \ \ \ \ \ (output-N (* input-N 3/4))

    \ \ \ \ \ \ \ \ \ (output (make-bytevector output-N)))

    \;

    \ \ \ \ (unless (zero? (modulo input-N 4))

    \ \ \ \ \ \ (value-error "length of the input bytevector must be 4X"))

    \ \ \ \ 

    \ \ \ \ (let loop ((i 0) (j 0))

    \ \ \ \ \ \ (if (\<less\> i input-N)

    \ \ \ \ \ \ \ \ \ \ (receive (r1 r2 r3 cnt)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (decode (bv i) (bv (+ i 1)) (bv (+ i 2)) (bv (+ i 3)))

    \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output j r1)

    \ \ \ \ \ \ \ \ \ \ \ \ (when (\<gtr\>= cnt 2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 1) r2))

    \ \ \ \ \ \ \ \ \ \ \ \ (when (\<gtr\>= cnt 3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 2) r3))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 4) (+ j cnt)))

    \ \ \ \ \ \ \ \ \ \ (let ((final (make-bytevector j)))

    \ \ \ \ \ \ \ \ \ \ \ \ (vector-copy! final 0 output 0 j)

    \ \ \ \ \ \ \ \ \ \ \ \ final)))))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define string-base64-decode

    \ \ (typed-lambda ((str string?))

    \ \ \ \ (utf8-\<gtr\>string (bytevector-base64-decode (string-\<gtr\>utf8 str)))))

    \;
  </scm-chunk>

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

    \ \ (cond ((string? x)

    \ \ \ \ \ \ \ \ \ (string-base64-decode x))

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

    \ \ \ \ \ \ \ \ \ (bytevector-base64-decode x))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (type-error "input must be string or bytevector"))))

    \;
  </scm-chunk>

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

    \;

    (check (base64-decode "YQ==") =\<gtr\> "a")

    (check (base64-decode "eg==") =\<gtr\> "z")

    (check (base64-decode "Zg==") =\<gtr\> "f")

    (check (base64-decode "Zm8=") =\<gtr\> "fo")

    (check (base64-decode "Zm9v") =\<gtr\> "foo")

    (check (base64-decode "Zm9vYg==") =\<gtr\> "foob")

    (check (base64-decode "Zm9vYmE=") =\<gtr\> "fooba")

    (check (base64-decode "Zm9vYmFy") =\<gtr\> "foobar")

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii sys)>

  <section|许可证>

  <\goldfish-chunk|goldfish/liii/sys.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|接口>

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

    (export argv executable)

    (import (scheme process-context))

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii sys))

    \;

    (display (executable))

    (newline)

    \;

    (check-report)

    \;
  </goldfish-chunk>

  <section|实现>

  <paragraph|argv>

  <\goldfish-chunk|goldfish/liii/sys.scm|true|true>
    (define (argv) (command-line))

    \;
  </goldfish-chunk>

  <paragraph|executable><index|executable><typehint|() =\<gtr\> string?>

  具体实现见<smart-ref|paragraph:g_executable>。

  <\goldfish-chunk|goldfish/liii/sys.scm|true|true>
    (define (executable) (g_executable))

    \;
  </goldfish-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <chapter|(liii os)>

  <section|协议>

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

  <\scm-chunk|tests/goldfish/liii/os-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (export

    \ \ os-arch os-type os-windows? os-linux? os-macos? os-temp-dir

    \ \ os-sep pathsep

    \ \ os-call system

    \ \ mkdir chdir rmdir getenv unsetenv getcwd listdir access getlogin getpid)

    (import (scheme process-context)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (liii string))

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii string)

    \ \ \ \ \ \ \ \ (liii os)

    \ \ \ \ \ \ \ \ (liii uuid)

    \ \ \ \ \ \ \ \ (scheme time))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-call command)

    \ \ (g_os-call command))

    \;

    (define (system command)

    \ \ (g_system command))

    \;

    (define (os-arch)

    \ \ (g_os-arch))

    \;

    (define (os-type)

    \ \ (g_os-type))

    \;

    (define (os-windows?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Windows"))))

    \;

    (define (os-linux?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Linux"))))

    \;

    (define (os-macos?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Darwin"))))

    \;

    (define (os-sep)

    \ \ (if (os-windows?)

    \ \ \ \ #\\\\

    \ \ \ \ #\\/))

    \;

    (define (pathsep)

    \ \ (if (os-windows?)

    \ \ \ \ #\\;

    \ \ \ \ #\\:))

    \;

    (define (os-temp-dir)

    \ \ (let1 temp-dir (g_os-temp-dir)

    \ \ \ \ (string-remove-suffix temp-dir (string (os-sep)))))

    \;

    (define (access path mode)

    \ \ (cond ((eq? mode 'F_OK) (g_access path 0))

    \ \ \ \ \ \ \ \ ((eq? mode 'X_OK) (g_access path 1))

    \ \ \ \ \ \ \ \ ((eq? mode 'W_OK) (g_access path 2))

    \ \ \ \ \ \ \ \ ((eq? mode 'R_OK) (g_access path 4))

    \ \ \ \ \ \ \ \ (else (error 'value-error "Allowed mode 'F_OK, 'X_OK,'W_OK, 'R_OK"))))

    \;

    (define (%check-dir-andthen path f)

    \ \ (cond ((not (file-exists? path))

    \ \ \ \ \ \ \ \ \ (file-not-found-error

    \ \ \ \ \ \ \ \ \ \ \ (string-append "No such file or directory: '" path "'")))

    \ \ \ \ \ \ \ \ ((not (g_isdir path))

    \ \ \ \ \ \ \ \ \ (not-a-directory-error

    \ \ \ \ \ \ \ \ \ \ \ (string-append "Not a directory: '" path "'")))

    \ \ \ \ \ \ \ \ (else (f path))))

    \;

    (define (mkdir path)

    \ \ (if (file-exists? path)

    \ \ \ \ (file-exists-error (string-append "File exists: '" path "'"))

    \ \ \ \ (g_mkdir path)))

    \;

    \;

    (define (chdir path)

    \ \ (if (file-exists? path)

    \ \ \ \ (g_chdir path)

    \ \ \ \ (file-not-found-error (string-append "No such file or directory: '" path "'"))))

    \;

    (define (rmdir path)

    \ \ (%check-dir-andthen path delete-file))

    \;

    (define (listdir path)

    \ \ (%check-dir-andthen path g_listdir))

    \;

    (define (getenv key)

    \ \ (get-environment-variable key))

    \;

    (define (unsetenv key)

    \ \ (g_unsetenv key))

    \;
  </goldfish-chunk>

  \;

  <paragraph|os-linux?><goldfish-lang|() =\<gtr\> boolean>

  <paragraph|os-macos?><goldfish-lang|() =\<gtr\> boolean>

  <paragraph|os-windows?><goldfish-lang|() =\<gtr\> boolean>

  <paragraph|os-type><goldfish-lang|() =\<gtr\> boolean>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (os-linux?)

    \ \ (check (os-type) =\<gtr\> "Linux"))

    \;

    (when (os-macos?)

    \ \ (check (os-type) =\<gtr\> "Darwin"))

    \;

    (when (os-windows?)

    \ \ (check (os-type) =\<gtr\> "Windows"))

    \;

    (when (not (os-windows?))

    \ \ (let ((t1 (current-second)))

    \ \ \ \ (os-call "sleep 1")

    \ \ \ \ (let ((t2 (current-second)))

    \ \ \ \ \ \ (check (\<gtr\>= (ceiling (- t2 t1)) 1) =\<gtr\> #t))))

    \;
  </scm-chunk>

  <paragraph|os-temp-dir>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (os-windows?)

    \ \ (check (string-starts? (os-temp-dir) "C:") =\<gtr\> #t))

    \;

    (when (os-linux?)

    \ \ (check (os-temp-dir) =\<gtr\> "/tmp"))

    \;
  </scm-chunk>

  <paragraph|mkdir>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check-catch 'file-exists-error

    \ \ \ \ (mkdir "/tmp"))

    \ \ (check (begin

    \ \ \ \ \ \ \ \ \ \ \ (let ((test_dir "/tmp/test_124"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (when (file-exists? test_dir)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rmdir "/tmp/test_124"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (mkdir "/tmp/test_124")))

    \ \ \ \ =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|getcwd>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (check-false (string-null? (getcwd)))

    \;
  </scm-chunk>

  <paragraph|listdir>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check (\<gtr\> (vector-length (listdir "/usr")) 0) =\<gtr\> #t))

    \;

    (let* ((test-dir (string-append (os-temp-dir) (string (os-sep)) (uuid4)))

    \ \ \ \ \ \ \ (test-dir2 (string-append test-dir (string (os-sep))))

    \ \ \ \ \ \ \ (dir-a (string-append test-dir2 "a"))

    \ \ \ \ \ \ \ (dir-b (string-append test-dir2 "b"))

    \ \ \ \ \ \ \ (dir-c (string-append test-dir2 "c")))

    \ \ (mkdir test-dir)

    \ \ (mkdir dir-a)

    \ \ (mkdir dir-b)

    \ \ (mkdir dir-c)

    \ \ (let1 r (listdir test-dir)

    \ \ \ \ (check-true (in? "a" r))

    \ \ \ \ (check-true (in? "b" r))

    \ \ \ \ (check-true (in? "c" r)))

    \ \ (let1 r2 (listdir test-dir2)

    \ \ \ \ (check-true (in? "a" r2))

    \ \ \ \ (check-true (in? "b" r2))

    \ \ \ \ (check-true (in? "c" r2)))

    \ \ (rmdir dir-a)

    \ \ (rmdir dir-b)

    \ \ (rmdir dir-c)

    \ \ (rmdir test-dir))

    \;

    (when (os-windows?)

    \ \ (check (\<gtr\> (vector-length (listdir "C:")) 0) =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|getenv>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (check (string-null? (getenv "PATH")) =\<gtr\> #f)

    (unsetenv "PATH")

    (check (getenv "PATH") =\<gtr\> #f)

    \;
  </scm-chunk>

  <paragraph|getcwd><index|getcwd>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getcwd)

    \ \ (g_getcwd))

    \;
  </goldfish-chunk>

  <paragraph|getlogin><index|getlogin>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getlogin)

    \ \ (if (os-windows?)

    \ \ \ \ \ \ (getenv "USERNAME")

    \ \ \ \ \ \ (g_getlogin)))

    \;
  </goldfish-chunk>

  <paragraph|getpid><index|getpid>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getpid)

    \ \ (g_getpid))

    \;
  </goldfish-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </goldfish-chunk>

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

    \;
  </scm-chunk>

  <chapter|(liii path)>

  <section|协议>

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

  <\scm-chunk|tests/goldfish/liii/path-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (export

    \ \ path-dir? path-file? path-exists? path-getsize

    )

    (import (liii error))

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (liii os))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|path-dir?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-dir? path)

    \ \ (g_isdir path))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check (path-dir? ".") =\<gtr\> #t)

    (check (path-dir? "..") =\<gtr\> #t)

    \;

    (when (not (os-windows?))

    \ \ (check (path-dir? "/") =\<gtr\> #t)

    \ \ (check (path-dir? "/tmp") =\<gtr\> #t)

    \ \ (check (path-dir? "/no_such_dir") =\<gtr\> #f))

    \;

    (when (os-windows?)

    \ \ (check (path-dir? "C:/") =\<gtr\> #t)

    \ \ (check (path-dir? "C:/no_such_dir/") =\<gtr\> #f))

    \;
  </scm-chunk>

  <paragraph|path-file?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-file? path)

    \ \ (g_isfile path))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check (path-file? ".") =\<gtr\> #f)

    (check (path-file? "..") =\<gtr\> #f)

    \;

    (when (os-linux?)

    \ \ (check (path-file? "/etc/passwd") =\<gtr\> #t))

    \;
  </scm-chunk>

  <paragraph|path-exists?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-exists? path)

    \ \ (file-exists? path))

    \;
  </goldfish-chunk>

  <paragraph|path-getsize><index|path-getsize><scm|((path string?)) =\<gtr\> integer?>

  返回当前路径的文件大小。

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-getsize

    \ \ (typed-lambda ((path string?))

    \ \ \ \ (if (not (file-exists? path))

    \ \ \ \ \ \ (file-not-found-error

    \ \ \ \ \ \ \ \ (string-append "No such file or directory: '" path "'"))

    \ \ \ \ \ \ (g_path-getsize path))))

    \;
  </goldfish-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check-true (\<gtr\> (path-getsize "/") 0))

    \ \ (check-true (\<gtr\> (path-getsize "/etc/hosts") 0)))

    \;

    (when (os-windows?)

    \ \ (check-true (\<gtr\> (path-getsize "C:") 0))

    \ \ (check-true (\<gtr\> (path-getsize "C:/Windows") 0))

    \ \ (check-true (\<gtr\> (path-getsize "C:\\\\Windows\\\\System32\\\\drivers\\\\etc\\\\hosts") 0)))

    \;
  </scm-chunk>

  <section|结尾>

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

    \;
  </scm-chunk>

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

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <chapter|(liii argparse)>

  <section|协议>

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

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/argparse-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (liii base)

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (liii list)

    \ \ \ \ \ \ \ \ (liii string)

    \ \ \ \ \ \ \ \ (liii hash-table)

    \ \ \ \ \ \ \ \ (liii alist)

    \ \ \ \ \ \ \ \ (liii sys))

    (export make-argument-parser)

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (liii argparse))

    \;

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

    \;
  </scm-chunk>

  <subparagraph|测试命令行参数的类型>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "name") (type . string) (short . "n") (default . "anonymous")))

    \ \ (check (parser 'name) =\<gtr\> "anonymous")

    \ \ (parser 'parse-args '("--name" "john"))

    \ \ (check (parser 'name) =\<gtr\> "john"))

    \;
  </scm-chunk>

  <subparagraph|测试命令行参数的两种形式>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "width") (type . number) (short . "width") (default . 80)))

    \;

    \ \ (check (parser 'get-argument "width") =\<gtr\> 80)

    \;

    \ \ (parser 'parse-args '("--width" "100"))

    \ \ (check (parser 'get-argument "width") =\<gtr\> 100)

    \ \ (check (parser 'width) =\<gtr\> 100)

    \;

    \ \ (parser 'parse-args '("-width" "60"))

    \ \ (check (parser 'width) =\<gtr\> 60))

    \;

    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "height") (type . number) (default . 60))) \ ; without short name

    \ \ (parser 'parse-args '("--height" "120"))

    \ \ (check (parser 'get-argument "height") =\<gtr\> 120))

    \;
  </scm-chunk>

  <subparagraph|测试多个命令行参数多种类型>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "width") (type . number) (short . "w") (default . 80)))

    \ \ (parser 'add-argument\ 

    \ \ \ \ '((name . "title") (type . string) (default . "Untitled")))

    \ \ (parser 'parse-args '("-w" "100" "--title" "My Document"))

    \ \ (check (parser 'get-argument "width") =\<gtr\> 100)

    \ \ (check (parser 'get-argument "title") =\<gtr\> "My Document"))

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|make-arg-record>

  <todo|使用define-record-type>

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (make-arg-record name type short-name default)

    \ \ (list name type short-name default default))

    \;
  </scm-chunk>

  <paragraph|convert-value>

  将给定值转化为给定类型。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (convert-value value type)

    \ \ (case type

    \ \ \ \ ((number)\ 

    \ \ \ \ \ (if (number? value)

    \ \ \ \ \ \ \ \ \ value

    \ \ \ \ \ \ \ \ \ (let ((num (string-\<gtr\>number value)))

    \ \ \ \ \ \ \ \ \ \ \ (if num\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ num

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Invalid number format" value)))))

    \ \ \ \ ((string)\ 

    \ \ \ \ \ (if (string? value)

    \ \ \ \ \ \ \ \ \ value

    \ \ \ \ \ \ \ \ \ (error "Value is not a string")))

    \ \ \ \ (else (error "Unsupported type" type))))

    \;
  </scm-chunk>

  <paragraph|arg-type?>

  命令行参数的类型必须是<scm|symbol>类型的Scheme字面量。目前命令行参数仅支持两种类型：

  <\description>
    <item*|string>如果没有指定，那么参数类型默认是字符串类型。

    <item*|number>在传入参数时，参数的值是字符串，我们会调用<scm|number-\<gtr\>string>将字符串转化为Scheme的number类型。
  </description>

  \;

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (arg-type? type)

    \ \ (unless (symbol? type)

    \ \ \ \ (type-error "type of the argument must be symbol"))

    \ \ (in? type '(string number)))

    \;
  </scm-chunk>

  <paragraph|add-argument>

  新增命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%add-argument args-ht args)

    \ \ (let* ((options (car args))

    \ \ \ \ \ \ \ \ \ (name (alist-ref options 'name

    \ \ \ \ \ \ \ \ \ \ \ (lambda () (value-error "name is required for an option"))))

    \ \ \ \ \ \ \ \ \ (type (alist-ref/default options 'type 'string))

    \ \ \ \ \ \ \ \ \ (short-name (alist-ref/default options 'short #f))

    \ \ \ \ \ \ \ \ \ (default (alist-ref/default options 'default #f))

    \ \ \ \ \ \ \ \ \ (arg-record (make-arg-record name type short-name default)))

    \ \ \ \ (unless (string? name)

    \ \ \ \ \ \ (type-error "name of the argument must be string"))

    \ \ \ \ (unless (arg-type? type)

    \ \ \ \ \ \ (value-error "Invalid type of the argument" type))

    \ \ \ \ (unless (or (not short-name) (string? short-name))

    \ \ \ \ \ \ (type-error "short name of the argument must be string if given"))

    \ \ \ \ (hash-table-set! args-ht name arg-record)

    \ \ \ \ (when short-name

    \ \ \ \ \ \ \ \ \ \ (hash-table-set! args-ht short-name arg-record))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let1 parser (make-argument-parser)

    \ \ (check-catch 'type-error (parser 'add-argument '((name name))))

    \ \ (check-catch 'value-error (parser 'add-argument '())))

    \;
  </scm-chunk>

  <paragraph|get-argument>

  获得命令行参数对应的值。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%get-argument args-ht args)

    \ \ (let ((found (hash-table-ref/default args-ht (car args) #f)))

    \ \ \ \ (if found

    \ \ \ \ \ \ \ \ (fifth found)

    \ \ \ \ \ \ \ \ (error "Argument not found" (car args)))))

    \;
  </scm-chunk>

  \;

  \;

  <paragraph|parse-args>

  解析命令行参数。

  <subparagraph|long-form?>

  判断是否形如<shell|--help>、<shell|--version>等形式。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (long-form? arg)

    \ \ (and (string? arg)\ 

    \ \ \ \ \ \ \ (\<gtr\>= (string-length arg) 3)

    \ \ \ \ \ \ \ (string-starts? arg "--")))

    \;
  </scm-chunk>

  <subparagraph|short-form?>

  判断是否形如<shell|-w>、<shell|-help>等形式。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (short-form? arg)

    \ \ (and (string? arg)

    \ \ \ \ \ \ \ (\<gtr\>= (string-length arg) 2)

    \ \ \ \ \ \ \ (char=? (string-ref arg 0) #\\-)))

    \;
  </scm-chunk>

  <subparagraph|retrieve-args>

  如果在代码中传入的参数是空列表，那么默认使用命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (retrieve-args args)

    \ \ (if (null? args)

    \ \ \ \ \ \ (cddr (argv))

    \ \ \ \ \ \ (car args)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%parse-args args-ht prog-args)

    \ \ (let loop ((args (retrieve-args prog-args)))

    \ \ \ \ (if (null? args)

    \ \ \ \ \ \ \ \ args-ht

    \ \ \ \ \ \ \ \ (let ((arg (car args)))

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

    \ \ \ \ \ \ \ \ \ \ \ \ ((long-form? arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((name (substring arg 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (found (hash-table-ref args-ht name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Missing value for argument" name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((value (convert-value (cadr args) (cadr found))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-car! (cddddr found) value))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cddr args))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error (string-append "Unknown option: --" name)))))

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

    \ \ \ \ \ \ \ \ \ \ \ \ ((short-form? arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((name (substring arg 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (found (hash-table-ref args-ht name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Missing value for argument" name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((value (convert-value (cadr args) (cadr found))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-car! (cddddr found) value))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cddr args))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error (string-append "Unknown option: -" name)))))

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

    \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (cdr args))))))))

    \;
  </scm-chunk>

  \;

  <paragraph|make-argument-parser><index|make-argument-parser>

  构造argparser，用于解析命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (make-argument-parser)

    \ \ (let ((args-ht (make-hash-table)))

    \ \ \ \ (lambda (command . args)

    \ \ \ \ \ \ (case command

    \ \ \ \ \ \ \ \ ((add) (%add-argument args-ht args))

    \ \ \ \ \ \ \ \ ((add-argument) (%add-argument args-ht args))

    \ \ \ \ \ \ \ \ ((get) (%get-argument args-ht args))

    \ \ \ \ \ \ \ \ ((get-argument) (%get-argument args-ht args))

    \ \ \ \ \ \ \ \ ((parse) (%parse-args args-ht args))

    \ \ \ \ \ \ \ \ ((parse-args) (%parse-args args-ht args))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ (if (and (null? args) (symbol? command))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%get-argument args-ht (list (symbol-\<gtr\>string command)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Unknown parser command" command)))))))

    \;
  </scm-chunk>

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(scheme char)>

  <section|许可证>

  <\scm-chunk|goldfish/scheme/char.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/scheme/char-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  大部分<scm|(scheme char)>里面的函数都是S7 Scheme内置函数，这里仍旧导出相关符号，以方便金鱼Scheme的用户搜索到相关函数。

  <\scm-chunk|goldfish/scheme/char.scm|true|true>
    (define-library (scheme char)

    (export

    \ \ char-upcase char-downcase char-upper-case? char-lower-case? digit-value

    )

    (begin
  </scm-chunk>

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

    \ \ \ \ \ \ \ \ (scheme char))

    \;

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

    \;
  </scm-chunk>

  <section|实现>

  <value|r7rs><paragraph|char-upcase><index|char-upcase>

  S7内置函数。将小写英文字母转换为大写英文字母，如果不是小写英文字母，则直接返回。

  <\scm-chunk|tests/goldfish/scheme/char-test.scm|true|true>
    (check (char-upcase #\\z) =\<gtr\> #\\Z)

    (check (char-upcase #\\a) =\<gtr\> #\\A)

    \;

    (check (char-upcase #\\A) =\<gtr\> #\\A)

    (check (char-upcase #\\?) =\<gtr\> #\\?)

    (check (char-upcase #\\$) =\<gtr\> #\\$)

    (check (char-upcase #\\.) =\<gtr\> #\\.)

    (check (char-upcase #\\\\) =\<gtr\> #\\\\)

    (check (char-upcase #\\5) =\<gtr\> #\\5)

    (check (char-upcase #\\)) =\<gtr\> #\\))

    (check (char-upcase #\\%) =\<gtr\> #\\%)

    (check (char-upcase #\\0) =\<gtr\> #\\0)

    (check (char-upcase #\\_) =\<gtr\> #\\_)

    (check (char-upcase #\\?) =\<gtr\> #\\?)

    (check (char-upcase #\\space) =\<gtr\> #\\space)

    (check (char-upcase #\\newline) =\<gtr\> #\\newline)

    (check (char-upcase #\\null) =\<gtr\> #\\null)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|char-downcase><index|char-downcase>

  S7内置函数。将大写英文字母转换为小写英文字母，如果不是大写英文字母，则直接返回。

  <\scm-chunk|tests/goldfish/scheme/char-test.scm|true|true>
    (check (char-downcase #\\A) =\<gtr\> #\\a)

    (check (char-downcase #\\Z) =\<gtr\> #\\z)

    \;

    (check (char-downcase #\\a) =\<gtr\> #\\a)

    \;
  </scm-chunk>

  <value|r7rs><paragraph|char-upper-case?><index|char-upper-case?>

  S7内置函数。检查是否是大写英文字母。

  <\scm-chunk|tests/goldfish/scheme/char-test.scm|true|true>
    (check-true (char-upper-case? #\\A))

    (check-true (char-upper-case? #\\Z))

    \;

    (check-false (char-upper-case? #\\a))

    (check-false (char-upper-case? #\\z))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|char-lower-case?><index|char-lower-case?>

  S7内置函数。检查是否是小写英文字母。

  <\scm-chunk|tests/goldfish/scheme/char-test.scm|true|true>
    (check-true (char-lower-case? #\\a))

    (check-true (char-lower-case? #\\z))

    \;

    (check-false (char-lower-case? #\\A))

    (check-false (char-lower-case? #\\Z))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|digit-value><index|digit-value>

  <paragraph|实现>

  <\scm-chunk|goldfish/scheme/char.scm|true|true>
    (define (digit-value ch)

    \ \ (if (char-numeric? ch)

    \ \ \ \ \ \ (- (char-\<gtr\>integer ch) (char-\<gtr\>integer #\\0))

    \ \ \ \ \ \ #f))

    \;
  </scm-chunk>

  <paragraph|测试>

  <\scm-chunk|tests/goldfish/scheme/char-test.scm|true|true>
    (check (digit-value #\\1) =\<gtr\> 1)

    (check (digit-value #\\2) =\<gtr\> 2)

    (check (digit-value #\\3) =\<gtr\> 3)

    (check (digit-value #\\4) =\<gtr\> 4)

    (check (digit-value #\\5) =\<gtr\> 5)

    (check (digit-value #\\6) =\<gtr\> 6)

    (check (digit-value #\\7) =\<gtr\> 7)

    (check (digit-value #\\8) =\<gtr\> 8)

    (check (digit-value #\\9) =\<gtr\> 9)

    (check (digit-value #\\0) =\<gtr\> 0)

    (check (digit-value #\\a) =\<gtr\> #f)

    (check (digit-value #\\c) =\<gtr\> #f)

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/scheme/char.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

    \;
  </scm-chunk>

  <chapter|(scheme file)>

  <section|许可证>

  <\scm-chunk|goldfish/scheme/file.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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/scheme/file.scm|true|true>
    (define-library (scheme file)

    (export open-binary-input-file open-binary-output-file)

    (begin

    \ \ 
  </scm-chunk>

  <section|实现>

  <r7rs><paragraph|open-input-file><index|open-input-file>

  S7内置函数。

  <r7rs><paragraph|open-binary-input-file><index|open-binary-input-file>

  <\scm-chunk|goldfish/scheme/file.scm|true|true>
    (define open-binary-input-file open-input-file)

    \;
  </scm-chunk>

  \;

  <r7rs><paragraph|open-output-file><index|open-output-file>

  S7内置函数。

  <r7rs><paragraph|open-binary-output-file><index|open-binary-output-file>

  <\scm-chunk|goldfish/scheme/file.scm|true|true>
    (define open-binary-output-file open-output-file)

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/scheme/file.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  \;

  <chapter|(scheme inexact)>

  <section|许可证>

  <\scm-chunk|goldfish/scheme/inexact.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/scheme/inexact-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/scheme/inexact.scm|true|true>
    ; The (scheme inexact) library exports procedures which are typically only

    ; useful with inexact values

    (define-library (scheme inexact)

    (export acos asin atan cos exp finite? infinite? log nan? sin sqrt tan)

    (begin

    \;
  </scm-chunk>

  <section|测试>

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

    \ \ \ \ \ \ \ \ (scheme inexact))

    \;

    (check-set-mode! 'report-failed)
  </scm-chunk>

  <section|实现>

  <value|r7rs><paragraph|finite?><index|finite?>

  \;

  <value|r7rs><paragraph|infinite?><index|infinite?>

  \;

  <value|r7rs><paragraph|nan?><index|nan?>

  \;

  <value|r7rs><paragraph|exp><index|acos>

  \;

  <value|r7rs><paragraph|log><index|log>

  \;

  <value|r7rs><paragraph|sin><index|sin>

  \;

  <value|r7rs><paragraph|cos><index|cos>

  \;

  <value|r7rs><paragraph|tan><index|tan>

  \;

  <value|r7rs><paragraph|asin><index|asin>

  \;

  <value|r7rs><paragraph|acos><index|acos>

  \;

  <value|r7rs><paragraph|atan><index|atan>

  \;

  <value|r7rs><paragraph|sqrt><index| sqrt>

  \;

  <section|结尾>

  <\scm-chunk|goldfish/scheme/inexact.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

  <chapter|(srfi sicp)>

  <section|许可证>

  <\scm-chunk|goldfish/srfi/srfi-216.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/sicp.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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/srfi/sicp-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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/srfi/srfi-216.scm|true|true>
    (define-library (srfi srfi-216)

    (export true false nil runtime)

    (import (scheme time))

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/sicp.scm|true|false>
    (define-library (srfi sicp)

    (export true false nil runtime)

    (import (srfi srfi-216)))

    \;
  </scm-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/srfi/sicp-test.scm|true|false>
    (import (srfi sicp)

    \ \ \ \ \ \ \ \ (liii os)

    \ \ \ \ \ \ \ \ (liii check))

    \;

    (display (runtime))

    (newline)

    \;

    (when (os-linux?)

    \ \ (os-call "sleep 0.01"))

    \;

    (display (runtime))

    (newline)

    \;

    (check-true true)

    (check-false false)

    (check-true (null? nil))

    \;

    (check-report)

    \;
  </scm-chunk>

  <section|实现>

  <\scm-chunk|goldfish/srfi/srfi-216.scm|true|true>
    (define true #t)

    \;

    (define false #f)

    \;

    (define nil '())

    \;

    (define (runtime)

    \ \ (round (* 1000 (current-second))))

    \;
  </scm-chunk>

  \;

  <section|结尾>

  <\scm-chunk|goldfish/srfi/srfi-216.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <part|基础设施>

  <chapter|C++部分>

  <section|许可证>

  <\cpp-chunk|src/goldfish.cpp|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.

    //

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|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.

    //

    \;
  </cpp-chunk>

  <section|入口>

  金鱼Scheme的入口是非常精简的，主要的逻辑在<shell|src/goldfish.hpp>里面。这样做的好处在于方便复用hpp文件中的源代码。

  <\cpp-chunk|src/goldfish.cpp|true|false>
    #include "goldfish.hpp"

    \;

    int

    main (int argc, char** argv) {

    \ \ return goldfish::repl_for_community_edition (argc, argv);

    }
  </cpp-chunk>

  <section|实现>

  <paragraph|头文件>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #include \<less\>algorithm\<gtr\>

    #include \<less\>cstdlib\<gtr\>

    #include \<less\>cstring\<gtr\>

    #include \<less\>iostream\<gtr\>

    #include \<less\>s7.h\<gtr\>

    #include \<less\>string\<gtr\>

    #include \<less\>vector\<gtr\>

    \;

    #include \<less\>tbox/platform/file.h\<gtr\>

    #include \<less\>tbox/platform/path.h\<gtr\>

    #include \<less\>tbox/tbox.h\<gtr\>

    \;

    #ifdef TB_CONFIG_OS_WINDOWS

    #include \<less\>io.h\<gtr\>

    #include \<less\>windows.h\<gtr\>

    #elif TB_CONFIG_OS_MACOSX

    #include \<less\>limits.h\<gtr\>

    #include \<less\>mach-o/dyld.h\<gtr\>

    #else

    #include \<less\>linux/limits.h\<gtr\>

    #endif

    \;

    #if !defined(TB_CONFIG_OS_WINDOWS)

    #include \<less\>errno.h\<gtr\>

    #include \<less\>pwd.h\<gtr\>

    #include \<less\>unistd.h\<gtr\>

    #include \<less\>wordexp.h\<gtr\>

    #endif

    \;
  </cpp-chunk>

  <paragraph|GOLDFISH_VERSION>

  金鱼Scheme的版本，<todo|后续统一使用<value|goldfish-version>这个在导言区预定义的值>。文学编程的Build Buffer功能暂时不支持展开导言区预定义的值。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #define GOLDFISH_VERSION "17.11.0"

    \;
  </cpp-chunk>

  <paragraph|GOLDFISH_PATH_MAXN>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #define GOLDFISH_PATH_MAXN TB_PATH_MAXN

    \;
  </cpp-chunk>

  <paragraph|全局变量>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static std::vector\<less\>std::string\<gtr\> command_args= std::vector\<less\>std::string\<gtr\> ();

    \;
  </cpp-chunk>

  <paragraph|goldfish命名空间的开始>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    namespace goldfish {

    using std::cerr;

    using std::cout;

    using std::endl;

    using std::string;

    using std::vector;

    \;
  </cpp-chunk>

  <subsection|胶水代码>

  <subsubsection|公共辅助函数>

  <subparagraph|string_vector_to_s7_vector>

  将<cpp|std::vector>复制为S7的<scm|vector>。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline s7_pointer

    string_vector_to_s7_vector (s7_scheme* sc, vector\<less\>string\<gtr\> v) {

    \ \ int \ \ \ \ \ \ \ N \ = v.size ();

    \ \ s7_pointer ret= s7_make_vector (sc, N);

    \ \ for (int i= 0; i \<less\> N; i++) {

    \ \ \ \ s7_vector_set (sc, ret, i, s7_make_string (sc, v[i].c_str ()));

    \ \ }

    \ \ return ret;

    }

    \;
  </cpp-chunk>

  <subsubsection|Goldfish基础胶水代码>

  <paragraph|g_version><index|g_version><typehint|=\<gtr\> string?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_version (s7_scheme* sc, s7_pointer args) {

    \ \ return s7_make_string (sc, GOLDFISH_VERSION);

    }

    \;
  </cpp-chunk>

  <paragraph|g_delete-file><index|g_delete-file><typehint|((file-name string?)) =\<gtr\> boolean?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_delete_file (s7_scheme* sc, s7_pointer args) {

    \ \ const char* path_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_file_remove (path_c));

    }

    \;
  </cpp-chunk>

  <paragraph|glue_goldfish>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_goldfish (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_version \ \ \ = "version";

    \ \ const char* d_version \ \ \ = "(version) =\<gtr\> string";

    \ \ const char* s_delete_file= "g_delete-file";

    \ \ const char* d_delete_file= "(g_delete-file string) =\<gtr\> boolean";

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_version),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_version, f_version, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_version, NULL));

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_delete_file),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_delete_file, f_delete_file, 1, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_delete_file, NULL));

    }

    \;
  </cpp-chunk>

  <subsubsection|(scheme time)的胶水代码>

  <paragraph|g_current-second><index|g_current-second><typehint|=\<gtr\> inexact?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_current_second (s7_scheme* sc, s7_pointer args) {

    \ \ // TODO: use std::chrono::tai_clock::now() when using C++ 20

    \ \ tb_timeval_t tp= {0};

    \ \ tb_gettimeofday (&tp, tb_null);

    \ \ s7_double res= (time_t) tp.tv_sec + (tp.tv_usec / 1000000.0);

    \ \ return s7_make_real (sc, res);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_scheme_time>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_scheme_time (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_current_second= "g_current-second";

    \ \ const char* d_current_second= "(g_current-second): () =\<gtr\> double, return the "

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "current unix timestamp in double";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_current_second),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_current_second, f_current_second, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 0, false, d_current_second, NULL));

    }

    \;
  </cpp-chunk>

  <subsubsection|(scheme process-context)的胶水代码>

  <paragraph|g_get-environment-variable><index|g_get-environment-variable>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_get_environment_variable (s7_scheme* sc, s7_pointer args) {

    #ifdef _MSC_VER

    \ \ std::string path_sep= ";";

    #else

    \ \ std::string path_sep= ":";

    #endif

    \ \ std::string \ \ \ \ \ \ \ \ \ ret;

    \ \ tb_size_t \ \ \ \ \ \ \ \ \ \ \ size \ \ \ \ \ \ = 0;

    \ \ const char* \ \ \ \ \ \ \ \ \ key \ \ \ \ \ \ \ = s7_string (s7_car (args));

    \ \ tb_environment_ref_t environment= tb_environment_init ();

    \ \ if (environment) {

    \ \ \ \ size= tb_environment_load (environment, key);

    \ \ \ \ if (size \<gtr\>= 1) {

    \ \ \ \ \ \ tb_for_all_if (tb_char_t const*, value, environment, value) {

    \ \ \ \ \ \ \ \ ret.append (value).append (path_sep);

    \ \ \ \ \ \ }

    \ \ \ \ }

    \ \ }

    \ \ tb_environment_exit (environment);

    \ \ if (size == 0) { // env key not found

    \ \ \ \ return s7_make_boolean (sc, false);

    \ \ }

    \ \ else {

    \ \ \ \ return s7_make_string (sc, ret.substr (0, ret.size () - 1).c_str ());

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|g_command-line><index|g_command-line>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_command_line (s7_scheme* sc, s7_pointer args) {

    \ \ s7_pointer ret = s7_nil (sc);

    \ \ int \ \ \ \ \ \ \ size= command_args.size ();

    \ \ for (int i= size - 1; i \<gtr\>= 0; i--) {

    \ \ \ \ ret= s7_cons (sc, s7_make_string (sc, command_args[i].c_str ()), ret);

    \ \ }

    \ \ return ret;

    }

    \;
  </cpp-chunk>

  <paragraph|glue_scheme_process_context>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_unset_environment_variable (s7_scheme* sc, s7_pointer args) {

    \ \ const char* env_name= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_environment_remove (env_name));

    }

    \;

    inline void

    glue_scheme_process_context (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_get_environment_variable= "g_get-environment-variable";

    \ \ const char* d_get_environment_variable=

    \ \ \ \ \ \ "(g_get-environemt-variable string) =\<gtr\> string";

    \ \ const char* s_command_line= "g_command-line";

    \ \ const char* d_command_line= "(g_command-line) =\<gtr\> string";

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_get_environment_variable),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_get_environment_variable,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ f_get_environment_variable, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_get_environment_variable, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_command_line),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_command_line, f_command_line, 0, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_command_line, NULL));

    }

    \;
  </cpp-chunk>

  <subsubsection|(liii sys)的胶水代码>

  <paragraph|g_executable><index|g_executable><label|paragraph:g_executable>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    goldfish_exe () {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ char buffer[GOLDFISH_PATH_MAXN];

    \ \ GetModuleFileName (NULL, buffer, GOLDFISH_PATH_MAXN);

    \ \ return string (buffer);

    #elif TB_CONFIG_OS_MACOSX

    \ \ char \ \ \ \ \ \ \ buffer[PATH_MAX];

    \ \ uint32_t \ \ \ size= sizeof (buffer);

    \ \ if (_NSGetExecutablePath (buffer, &size) == 0) {

    \ \ \ \ char real_path[GOLDFISH_PATH_MAXN];

    \ \ \ \ if (realpath (buffer, real_path) != NULL) {

    \ \ \ \ \ \ return string (real_path);

    \ \ \ \ }

    \ \ }

    \ \ return "";

    #elif TB_CONFIG_OS_LINUX

    \ \ char \ \ \ buffer[GOLDFISH_PATH_MAXN];

    \ \ ssize_t len= readlink ("/proc/self/exe", buffer, sizeof (buffer) - 1);

    \ \ if (len != -1) {

    \ \ \ \ buffer[len]= '\\0';

    \ \ \ \ return std::string (buffer);

    \ \ }

    \ \ return "";

    #endif

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_executable (s7_scheme* sc, s7_pointer args) {

    \ \ string exe_path= goldfish_exe ();

    \ \ return s7_make_string (sc, exe_path.c_str ());

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_sys>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_sys (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_executable= "g_executable";

    \ \ const char* d_executable= "(g_executable) =\<gtr\> string";

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_executable),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_executable, f_executable, 0, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_executable, NULL));

    }

    \;
  </cpp-chunk>

  <subsubsection|(liii os)的胶水代码>

  <paragraph|g_os-type><index|g_os-type>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_type (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_LINUX

    \ \ return s7_make_string (sc, "Linux");

    #endif

    #ifdef TB_CONFIG_OS_MACOSX

    \ \ return s7_make_string (sc, "Darwin");

    #endif

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_string (sc, "Windows");

    #endif

    \ \ return s7_make_boolean (sc, false);

    }

    \;
  </cpp-chunk>

  <paragraph|g_os-arch><index|g_os-arch>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_arch (s7_scheme* sc, s7_pointer args) {

    \ \ return s7_make_string (sc, TB_ARCH_STRING);

    }

    \;
  </cpp-chunk>

  <paragraph|g_os-call><index|g_os-call>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_call (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ \ \ \ cmd_c= s7_string (s7_car (args));

    \ \ tb_process_attr_t attr = {tb_null};

    \ \ attr.flags \ \ \ \ \ \ \ \ \ \ \ \ = TB_PROCESS_FLAG_NO_WINDOW;

    \ \ int ret;

    \;

    #if _MSC_VER

    \ \ ret= (int) std::system (cmd_c);

    #else

    \ \ wordexp_t p;

    \ \ ret= wordexp (cmd_c, &p, 0);

    \ \ if (ret != 0) {

    \ \ \ \ // failed after calling wordexp

    \ \ }

    \ \ else if (p.we_wordc == 0) {

    \ \ \ \ wordfree (&p);

    \ \ \ \ ret= EINVAL;

    \ \ }

    \ \ else {

    \ \ \ \ ret= (int) tb_process_run (p.we_wordv[0], (tb_char_t const**) p.we_wordv,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ &attr);

    \ \ \ \ wordfree (&p);

    \ \ }

    #endif

    \ \ return s7_make_integer (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|g_system><index|g_system>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_system (s7_scheme* sc, s7_pointer args) {

    \ \ const char* cmd_c= s7_string (s7_car (args));

    \ \ int \ \ \ \ \ \ \ \ ret \ = (int) std::system (cmd_c);

    \ \ return s7_make_integer (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|g_os-temp-dir><index|g_os-temp-dir>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_temp_dir (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t path[GOLDFISH_PATH_MAXN];

    \ \ tb_directory_temporary (path, GOLDFISH_PATH_MAXN);

    \ \ return s7_make_string (sc, path);

    }

    \;
  </cpp-chunk>

  <paragraph|g_isdir><index|g_isdir>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_isdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ dir_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ bool \ \ \ \ \ \ \ \ \ \ ret= false;

    \ \ if (tb_file_info (dir_c, &info)) {

    \ \ \ \ switch (info.type) {

    \ \ \ \ case TB_FILE_TYPE_DIRECTORY:

    \ \ \ \ case TB_FILE_TYPE_DOT:

    \ \ \ \ case TB_FILE_TYPE_DOT2:

    \ \ \ \ \ \ ret= true;

    \ \ \ \ }

    \ \ }

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|g_isfile><index|g_isfile>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_isfile (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ dir_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ bool \ \ \ \ \ \ \ \ \ \ ret= false;

    \ \ if (tb_file_info (dir_c, &info)) {

    \ \ \ \ switch (info.type) {

    \ \ \ \ case TB_FILE_TYPE_FILE:

    \ \ \ \ \ \ ret= true;

    \ \ \ \ }

    \ \ }

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|g_mkdir><index|g_mkdir>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_mkdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* dir_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_directory_create (dir_c));

    }

    \;
  </cpp-chunk>

  <paragraph|g_chdir><index|g_chdir>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_chdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* dir_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_directory_current_set (dir_c));

    }

    \;
  </cpp-chunk>

  <paragraph|g_getcwd><index|g_getcwd>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getcwd (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t path[GOLDFISH_PATH_MAXN];

    \ \ tb_directory_current (path, GOLDFISH_PATH_MAXN);

    \ \ return s7_make_string (sc, path);

    }

    \;
  </cpp-chunk>

  <paragraph|g_listdir><index|g_listdir>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static tb_long_t

    tb_directory_walk_func (tb_char_t const* path, tb_file_info_t const* info,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tb_cpointer_t priv) {

    \ \ // check

    \ \ tb_assert_and_check_return_val (path && info, TB_DIRECTORY_WALK_CODE_END);

    \;

    \ \ vector\<less\>string\<gtr\>* p_v_result= (vector\<less\>string\<gtr\>*) priv;

    \ \ p_v_result-\<gtr\>push_back (string (path));

    \ \ return TB_DIRECTORY_WALK_CODE_CONTINUE;

    }

    \;

    static s7_pointer

    f_listdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ path_c= s7_string (s7_car (args));

    \ \ vector\<less\>string\<gtr\> entries;

    \ \ s7_pointer \ \ \ \ ret= s7_make_vector (sc, 0);

    \ \ tb_directory_walk (path_c, 0, tb_false, tb_directory_walk_func, &entries);

    \;

    \ \ int \ \ \ entries_N \ \ = entries.size ();

    \ \ string path_s \ \ \ \ \ = string (path_c);

    \ \ int \ \ \ path_N \ \ \ \ \ = path_s.size ();

    \ \ int \ \ \ path_slash_N= path_N;

    \ \ char \ \ last_ch \ \ \ \ = path_s[path_N - 1];

    #if defined(TB_CONFIG_OS_WINDOWS)

    \ \ if (last_ch != '/' && last_ch != '\\\\') {

    \ \ \ \ path_slash_N= path_slash_N + 1;

    \ \ }

    #else

    \ \ if (last_ch != '/') {

    \ \ \ \ path_slash_N= path_slash_N + 1;

    \ \ }

    #endif

    \ \ for (int i= 0; i \<less\> entries_N; i++) {

    \ \ \ \ entries[i]= entries[i].substr (path_slash_N);

    \ \ }

    \ \ return string_vector_to_s7_vector (sc, entries);

    }

    \;
  </cpp-chunk>

  <paragraph|g_access><index|g_access>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_access (s7_scheme* sc, s7_pointer args) {

    \ \ const char* path_c= s7_string (s7_car (args));

    \ \ int \ \ \ \ \ \ \ \ mode \ = s7_integer ((s7_cadr (args)));

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ bool ret= (_access (path_c, mode) == 0);

    #else

    \ \ bool \ \ \ \ \ \ \ \ \ \ ret= (access (path_c, mode) == 0);

    #endif

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|g_getlogin><index|g_getlogin>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getlogin (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_boolean (sc, false);

    #else

    \ \ uid_t \ \ \ \ \ \ \ \ \ uid= getuid ();

    \ \ struct passwd* pwd= getpwuid (uid);

    \ \ return s7_make_string (sc, pwd-\<gtr\>pw_name);

    #endif

    }

    \;
  </cpp-chunk>

  <paragraph|g_getpid><index|g_getpid>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getpid (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_integer (sc, (int) GetCurrentProcessId ());

    #else

    \ \ return s7_make_integer (sc, getpid ());

    #endif

    }

    \;
  </cpp-chunk>

  <paragraph|g_path-getsize><index|g_path-getsize>

  返回指定路径的文件大小，如果该文件不存在，那么返回-1。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_path_getsize (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ path_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ if (tb_file_info (path_c, &info)) {

    \ \ \ \ return s7_make_integer (sc, (int) info.size);

    \ \ }

    \ \ else {

    \ \ \ \ return s7_make_integer (sc, (int) -1);

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_os>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_os (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;
  </cpp-chunk>

  <subparagraph|g_os-type>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    \ \ const char* s_os_type= "g_os-type";

    \ \ const char* d_os_type= "(g_os-type) =\<gtr\> string";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_os_type),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_os_type, f_os_type, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_os_type, NULL));

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    \ \ const char* s_os_arch \ \ \ = "g_os-arch";

    \ \ const char* d_os_arch \ \ \ = "(g_os-arch) =\<gtr\> string";

    \ \ const char* s_os_call \ \ \ = "g_os-call";

    \ \ const char* d_os_call \ \ \ = "(string) =\<gtr\> int";

    \ \ const char* s_system \ \ \ \ = "g_system";

    \ \ const char* d_system \ \ \ \ = "(string) =\<gtr\> int";

    \ \ const char* s_os_temp_dir= "g_os-temp-dir";

    \ \ const char* d_os_temp_dir= "(g_os-temp-dir) =\<gtr\> string";

    \ \ const char* s_isdir \ \ \ \ \ = "g_isdir";

    \ \ const char* d_isdir \ \ \ \ \ = "(g_isdir string) =\<gtr\> boolean";

    \ \ const char* s_isfile \ \ \ \ = "g_isfile";

    \ \ const char* d_isfile \ \ \ \ = "(g_isfile string) =\<gtr\> boolean";

    \ \ const char* s_mkdir \ \ \ \ \ = "g_mkdir";

    \ \ const char* d_mkdir \ \ \ \ \ = "(g_mkdir string) =\<gtr\> boolean";

    \ \ const char* s_chdir \ \ \ \ \ = "g_chdir";

    \ \ const char* d_chdir \ \ \ \ \ = "(g_chdir string) =\<gtr\> boolean";

    \ \ const char* s_listdir \ \ \ = "g_listdir";

    \ \ const char* d_listdir \ \ \ = "(g_listdir) =\<gtr\> vector";

    \ \ const char* s_getcwd \ \ \ \ = "g_getcwd";

    \ \ const char* d_getcwd \ \ \ \ = "(g_getcwd) =\<gtr\> string";

    \ \ const char* s_access \ \ \ \ = "g_access";

    \ \ const char* d_access \ \ \ \ = "(g_access string integer) =\<gtr\> boolean";

    \ \ const char* s_getlogin \ \ = "g_getlogin";

    \ \ const char* d_getlogin \ \ = "(g_getlogin) =\<gtr\> string";

    \ \ const char* s_getpid \ \ \ \ = "g_getpid";

    \ \ const char* d_getpid \ \ \ \ = "(g_getpid) =\<gtr\> integer";

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_os_arch),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_os_arch, f_os_arch, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_os_arch, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_os_call),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_os_call, f_os_call, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_os_call, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_system),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_system, f_system, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_system, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_os_temp_dir),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_os_temp_dir, f_os_temp_dir, 0, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_os_call, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_isdir),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_isdir, f_isdir, 1, 0, false, d_isdir,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_isfile),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_isfile, f_isfile, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_isfile, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_mkdir),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_mkdir, f_mkdir, 1, 0, false, d_mkdir,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_chdir),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_chdir, f_chdir, 1, 0, false, d_chdir,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_listdir),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_listdir, f_listdir, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_listdir, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_getcwd),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_getcwd, f_getcwd, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_getcwd, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_access),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_access, f_access, 2, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_access, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_getlogin),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_getlogin, f_getlogin, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_access, NULL));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_getpid),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_getpid, f_getpid, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_getpid, NULL));

    \;
  </cpp-chunk>

  <subparagraph|g_unsetenv>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    \ \ const char* s_unsetenv= "g_unsetenv";

    \ \ const char* d_unsetenv= "(g_unsetenv string): string =\<gtr\> boolean";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_unsetenv),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_unsetenv,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ f_unset_environment_variable, 1, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_unsetenv, NULL));

    \;
  </cpp-chunk>

  <subparagraph|g_path-getsize>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    \ \ const char* s_path_getsize= "g_path-getsize";

    \ \ const char* d_path_getsize= "(g_path_getsize string): string =\<gtr\> integer";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_path_getsize),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_unsetenv, f_path_getsize, 1, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_path_getsize, NULL));
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    }

    \;
  </cpp-chunk>

  <subsubsection|(liii uuid)的胶水代码>

  <scm|(liii uuid)>是通过C++实现的，本节是相关的胶水代码。

  <paragraph|g_uuid4><index|g_uuid4><typehint|=\<gtr\> string?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_uuid4 (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t \ \ \ \ \ \ \ uuid[37];

    \ \ const tb_char_t* ret= tb_uuid4_make_cstr (uuid, tb_null);

    \ \ return s7_make_string (sc, ret);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_uuid>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_uuid (s7_scheme* sc) {

    \ \ s7_pointer \ cur_env= s7_curlet (sc);

    \ \ const char* s_uuid4= "g_uuid4";

    \ \ const char* d_uuid4= "(g_uuid4) =\<gtr\> string";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_uuid4),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_uuid4, f_uuid4, 0, 0, false, d_uuid4,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ NULL));

    }

    \;
  </cpp-chunk>

  <subsubsection|胶水代码汇总接口>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    void

    glue_for_community_edition (s7_scheme* sc) {

    \ \ glue_goldfish (sc);

    \ \ glue_scheme_time (sc);

    \ \ glue_scheme_process_context (sc);

    \ \ glue_liii_sys (sc);

    \ \ glue_liii_os (sc);

    \ \ glue_liii_uuid (sc);

    }

    \;
  </cpp-chunk>

  <subsection|命令行>

  <paragraph|显示帮助>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_help () {

    \ \ cout \<less\>\<less\> "Goldfish Scheme " \<less\>\<less\> GOLDFISH_VERSION \<less\>\<less\> " by LiiiLabs" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "--version\\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Display version" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-m default\\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Allowed mode: default, liii, sicp, r7rs, s7" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-e \ \ \ \ \ \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on the command line" \<less\>\<less\> endl

    \ \ \ \ \ \ \ \<less\>\<less\> "\\t\\teg. -e '(begin (display ‘Hello) (+ 1 2))'" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-l FILE \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on path" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "FILE \ \ \ \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on path and print the evaluated result" \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|显示版本>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_version () {

    \ \ cout \<less\>\<less\> "Goldfish Scheme " \<less\>\<less\> GOLDFISH_VERSION \<less\>\<less\> " by LiiiLabs" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "based on S7 Scheme " \<less\>\<less\> S7_VERSION \<less\>\<less\> " (" \<less\>\<less\> S7_DATE \<less\>\<less\> ")" \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|错误的命令行选项>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_for_invalid_options () {

    \ \ cerr \<less\>\<less\> "Invalid command line options!" \<less\>\<less\> endl \<less\>\<less\> endl;

    \ \ display_help ();

    }

    \;
  </cpp-chunk>

  <paragraph|执行文件中的代码>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    goldfish_eval_file (s7_scheme* sc, string path, bool quiet) {

    \ \ s7_pointer result= s7_load (sc, path.c_str ());

    \ \ if (!result) {

    \ \ \ \ cerr \<less\>\<less\> "Failed to load " \<less\>\<less\> path \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ if (!quiet) {

    \ \ \ \ cout \<less\>\<less\> path \<less\>\<less\> " =\<gtr\> " \<less\>\<less\> s7_object_to_c_string (sc, result) \<less\>\<less\> endl;

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|执行命令行中以字符串形式传入的代码>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    goldfish_eval_code (s7_scheme* sc, string code) {

    \ \ s7_pointer x= s7_eval_c_string (sc, code.c_str ());

    \ \ cout \<less\>\<less\> s7_object_to_c_string (sc, x) \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|金鱼Scheme的初始化>

  <\enumerate>
    <item>初始化S7 Scheme

    <item>为S7 Scheme设置load path

    <item>初始化tbox

    <item>初始化胶水代码
  </enumerate>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    s7_scheme*

    init_goldfish_scheme (const char* gf_lib) {

    \ \ s7_scheme* sc= s7_init ();

    \ \ s7_add_to_load_path (sc, gf_lib);

    \;

    \ \ if (!tb_init (tb_null, tb_null)) exit (-1);

    \;

    \ \ glue_for_community_edition (sc);

    \ \ return sc;

    }

    \;
  </cpp-chunk>

  <paragraph|金鱼Scheme的运行模式>

  <code*|-m>帮助您指定预加载的标准库。

  <\description>
    <item*|default><code*|-m default>等价于<code*|-m liii>

    <item*|liii>预加载<code*|(liii base)>和<code*|(liii error)>的金鱼Scheme

    <item*|sicp>预加载<code*|(srfi sicp)>和<code*|(scheme base)>的S7 Scheme

    <item*|r7rs>预加载<code*|(scheme base)>的S7 Scheme

    <item*|s7>无任何无加载库的S7 Scheme
  </description>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    void

    customize_goldfish_by_mode (s7_scheme* sc, string mode,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ const char* boot_file_path) {

    \ \ if (mode != "s7") {

    \ \ \ \ s7_load (sc, boot_file_path);

    \ \ }

    \;

    \ \ if (mode == "default" \|\| mode == "liii") {

    \ \ \ \ s7_eval_c_string (sc, "(import (liii base) (liii error))");

    \ \ }

    \ \ else if (mode == "sicp") {

    \ \ \ \ s7_eval_c_string (sc, "(import (scheme base) (srfi sicp))");

    \ \ }

    \ \ else if (mode == "r7rs") {

    \ \ \ \ s7_eval_c_string (sc, "(import (scheme base))");

    \ \ }

    \ \ else if (mode == "s7") {

    \ \ }

    \ \ else {

    \ \ \ \ cerr \<less\>\<less\> "No such mode: " \<less\>\<less\> mode \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|REPL>

  <subparagraph|find_goldfish_library>

  定位Goldfish的函数库的目录，如果不存在，直接以-1为返回值退出，如果存在，则返回目录对应的完整路径。

  <\description>
    <item*|开发者模式>在这种模式下，Goldfish的可执行文件的路径是<shell|$(projectdir)/bin/goldfish>，而函数库的路径是<shell|$(projectdir)/goldfish)>。这种情况仅用于开发或者集成Goldfish。

    <item*|Linux>

    <\description>
      <item*|/usr/bin/goldfish>

      <item*|/usr/local/goldfish>

      这两种情况可以通过相对路径分别定位到Goldfish的函数库目录是<shell|/usr/share/goldfish>和<shell|/usr/local/share/goldfish>。

      <item*|/bin/goldfish>

      在这种情况下，我们直接将函数库目录设置为<shell|/usr/share/goldfish>。
    </description>
  </description>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    find_goldfish_library () {

    \ \ string exe_path= goldfish_exe ();

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_bin[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* ret_bin=

    \ \ \ \ \ \ tb_path_directory (exe_path.c_str (), data_bin, sizeof (data_bin));

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_root[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_root=

    \ \ \ \ \ \ tb_path_directory (ret_bin, data_root, sizeof (data_root));

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_lib[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_lib= tb_path_absolute_to (gf_root, "share/goldfish",

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ data_lib, sizeof (data_lib));

    #ifdef TB_CONFIG_OS_LINUX

    \ \ if (strcmp (gf_root, "/") == 0) {

    \ \ \ \ gf_lib= "/usr/share/goldfish";

    \ \ }

    #endif

    \;

    \ \ if (!tb_file_access (gf_lib, TB_FILE_MODE_RO)) {

    \ \ \ \ gf_lib=

    \ \ \ \ \ \ \ \ tb_path_absolute_to (gf_root, "goldfish", data_lib, sizeof (data_lib));

    \ \ \ \ if (!tb_file_access (gf_lib, TB_FILE_MODE_RO)) {

    \ \ \ \ \ \ cerr \<less\>\<less\> "The load path for Goldfish standard library does not exist"

    \ \ \ \ \ \ \ \ \ \ \ \<less\>\<less\> endl;

    \ \ \ \ \ \ exit (-1);

    \ \ \ \ }

    \ \ }

    \;

    \ \ return string (gf_lib);

    }

    \;
  </cpp-chunk>

  <subparagraph|find_goldfish_boot>

  定位Goldfish用于启动的Scheme脚本文件，如果不存在，直接以-1为返回值退出，如果存在，则返回改文件对应的完整路径。关于<shell|boot.scm>的具体细节，见<smart-ref|chapter:scheme_boot>。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    find_goldfish_boot (const char* gf_lib) {

    \ \ tb_char_t \ \ \ \ \ \ \ data_boot[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_boot= tb_path_absolute_to (gf_lib, "scheme/boot.scm",

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ data_boot, sizeof (data_boot));

    \;

    \ \ if (!tb_file_access (gf_boot, TB_FILE_MODE_RO)) {

    \ \ \ \ cerr \<less\>\<less\> "The boot.scm for Goldfish Scheme does not exist" \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ return string (gf_boot);

    }

    \;
  </cpp-chunk>

  <subparagraph|repl_for_community_edition>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    int

    repl_for_community_edition (int argc, char** argv) {

    \ \ string \ \ \ \ \ gf_lib_dir \ = find_goldfish_library ();

    \ \ const char* gf_lib \ \ \ \ \ = gf_lib_dir.c_str ();

    \ \ string \ \ \ \ \ gf_boot_path= find_goldfish_boot (gf_lib);

    \ \ const char* gf_boot \ \ \ \ = gf_boot_path.c_str ();

    \;

    \ \ vector\<less\>string\<gtr\> all_args (argv, argv + argc);

    \ \ int \ \ \ \ \ \ \ \ \ \ \ all_args_N= all_args.size ();

    \ \ for (int i= 0; i \<less\> all_args_N; i++) {

    \ \ \ \ command_args.push_back (all_args[i]);

    \ \ }

    \;

    \ \ // zero args

    \ \ vector\<less\>string\<gtr\> args (argv + 1, argv + argc);

    \ \ if (args.size () == 0) {

    \ \ \ \ display_help ();

    \ \ \ \ exit (0);

    \ \ }

    \;

    \ \ // Init the underlying S7 Scheme and add the load_path

    \ \ s7_scheme* sc= init_goldfish_scheme (gf_lib);

    \;

    \ \ const char* errmsg= NULL;

    \ \ s7_pointer \ old_port=

    \ \ \ \ \ \ s7_set_current_error_port (sc, s7_open_output_string (sc));

    \ \ int gc_loc= -1;

    \ \ if (old_port != s7_nil (sc)) gc_loc= s7_gc_protect (sc, old_port);

    \;

    \ \ // -m: Load the standard library by mode

    \ \ string mode_flag= "-m";

    \ \ string mode \ \ \ \ = "default";

    \ \ int \ \ \ args_N \ \ = args.size ();

    \ \ int \ \ \ i;

    \ \ for (i= 0; i \<less\> args_N; i++) {

    \ \ \ \ if (args[i] == mode_flag) {

    \ \ \ \ \ \ break;

    \ \ \ \ }

    \ \ }

    \ \ if (i \<less\> args_N && i + 1 \<gtr\>= args_N) {

    \ \ \ \ cerr \<less\>\<less\> "No mode specified after -m" \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ if (i \<less\> args_N) {

    \ \ \ \ mode= args[i + 1];

    \ \ \ \ args.erase (args.begin () + i);

    \ \ \ \ args.erase (args.begin () + i);

    \ \ }

    \;

    \ \ customize_goldfish_by_mode (sc, mode, gf_boot);

    \;

    \ \ // Command options

    \ \ if (args.size () == 1 && args[0].size () \<gtr\> 0 && args[0][0] == '-') {

    \ \ \ \ if (args[0] == "--version") {

    \ \ \ \ \ \ display_version ();

    \ \ \ \ }

    \ \ \ \ else {

    \ \ \ \ \ \ display_for_invalid_options ();

    \ \ \ \ }

    \ \ }

    \ \ else if (args.size () \<gtr\>= 2 && args[0] == "-e") {

    \ \ \ \ goldfish_eval_code (sc, args[1]);

    \ \ }

    \ \ else if (args.size () \<gtr\>= 2 && args[0] == "-l") {

    \ \ \ \ goldfish_eval_file (sc, args[1], true);

    \ \ }

    \ \ else if (args.size () \<gtr\>= 1 && args[0].size () \<gtr\> 0 && args[0][0] != '-') {

    \ \ \ \ goldfish_eval_file (sc, args[0], false);

    \ \ }

    \ \ else {

    \ \ \ \ display_for_invalid_options ();

    \ \ }

    \;

    \ \ errmsg= s7_get_output_string (sc, s7_current_error_port (sc));

    \ \ if ((errmsg) && (*errmsg)) cout \<less\>\<less\> errmsg;

    \ \ s7_close_output_port (sc, s7_current_error_port (sc));

    \ \ s7_set_current_error_port (sc, old_port);

    \ \ if (gc_loc != -1) s7_gc_unprotect_at (sc, gc_loc);

    \;

    \ \ if ((errmsg) && (*errmsg)) return -1;

    \ \ else return 0;

    }

    \;
  </cpp-chunk>

  <paragraph|goldfish命名空间的结束>

  <\cpp-chunk|src/goldfish.hpp|true|false>
    } // namespace goldfish
  </cpp-chunk>

  <chapter|CI/CD流水线>

  <section|持续集成>

  <subsection|Github平台macOS系统>

  <paragraph|触发条件>

  <\verbatim-chunk|.github/workflows/ci-macos.yml|false|true>
    name: Build and Test on macOS

    \;

    on:

    \ \ push:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-macos.yml'

    \ \ pull_request:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-macos.yml'

    \;
  </verbatim-chunk>

  <paragraph|具体任务>

  <\verbatim-chunk|.github/workflows/ci-macos.yml|true|false>
    jobs:

    \ \ macosbuild:

    \ \ \ \ runs-on: macos-13

    \ \ \ \ steps:

    \ \ \ \ \ \ - uses: actions/checkout@v2

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ fetch-depth: 1

    \;

    \ \ \ \ \ \ - name: cache xmake

    \ \ \ \ \ \ \ \ uses: actions/cache@v2

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ path: \|

    \ \ \ \ \ \ \ \ \ \ \ \ ${{github.workspace}}/build/.build_cache

    \ \ \ \ \ \ \ \ \ \ \ \ /Users/runner/.xmake

    \ \ \ \ \ \ \ \ \ \ key: ${{ runner.os }}-xmake-${{ hashFiles('**/xmake.lua') }}

    \;

    \ \ \ \ \ \ - name: set XMAKE_GLOBALDIR

    \ \ \ \ \ \ \ \ run: echo "XMAKE_GLOBALDIR=${{ runner.workspace }}/xmake-global" \<gtr\>\<gtr\> $GITHUB_ENV

    \;

    \ \ \ \ \ \ - uses: xmake-io/github-action-setup-xmake@v1

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ xmake-version: v2.8.7

    \ \ \ \ \ \ \ \ \ \ actions-cache-folder: '.xmake-cache'

    \;

    \ \ \ \ \ \ - name: xmake repo --update

    \ \ \ \ \ \ \ \ run: xmake repo --update

    \;

    \ \ \ \ \ \ - name: cache packages from xrepo

    \ \ \ \ \ \ \ \ uses: actions/cache@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ path: \|

    \ \ \ \ \ \ \ \ \ \ \ \ ${{ env.XMAKE_GLOBALDIR }}/.xmake/packages

    \ \ \ \ \ \ \ \ \ \ key: ${{ runner.os }}-xrepo-${{ hashFiles('**/xmake.lua') }}

    \;

    \ \ \ \ \ \ - name: config

    \ \ \ \ \ \ \ \ run: xmake config -vD --policies=build.ccache -o tmp/build -m releasedbg --yes

    \;

    \ \ \ \ \ \ - name: build

    \ \ \ \ \ \ \ \ run: xmake build --yes -vD goldfish

    \;

    \ \ \ \ \ \ - name: run tests

    \ \ \ \ \ \ \ \ run: bin/goldfish -l tests/test_all.scm

    \;
  </verbatim-chunk>

  <subsection|Github平台Windows系统>

  <paragraph|触发条件>

  <\verbatim-chunk|.github/workflows/ci-windows.yml|false|true>
    name: Build on windows

    \;

    on:

    \ \ push:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-windows.yml'

    \ \ pull_request:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-windows.yml'

    \ \ workflow_dispatch:

    \;
  </verbatim-chunk>

  <paragraph|具体任务>

  <\verbatim-chunk|.github/workflows/ci-windows.yml|true|false>
    jobs:

    \ \ windowsbuild:

    \ \ \ \ runs-on: windows-2019

    \ \ \ \ env:

    \ \ \ \ \ \ \ \ # Force xmake to a specific folder (for cache)

    \ \ \ \ \ \ \ \ XMAKE_GLOBALDIR: ${{ github.workspace }}/.xmake-global

    \ \ \ \ steps:

    \ \ \ \ \ \ - uses: xmake-io/github-action-setup-xmake@v1

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ xmake-version: v2.8.9

    \ \ \ \ \ \ - name: update repo

    \ \ \ \ \ \ \ \ run: xmake repo -u

    \ \ \ \ \ \ - name: git crlf

    \ \ \ \ \ \ \ \ run: git config --global core.autocrlf false

    \ \ \ \ \ \ - uses: actions/checkout@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ fetch-depth: 1

    \ \ \ \ \ \ - name: cache xmake

    \ \ \ \ \ \ \ \ uses: actions/cache@v2

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ path: \|

    \ \ \ \ \ \ \ \ \ \ \ \ ${{ env.XMAKE_GLOBALDIR }}/.xmake/packages

    \ \ \ \ \ \ \ \ \ \ \ \ ${{ github.workspace }}/build/.build_cache

    \ \ \ \ \ \ \ \ \ \ key: ${{ runner.os }}-xmake-${{ hashFiles('**/xmake.lua') }}

    \ \ \ \ \ \ - name: config

    \ \ \ \ \ \ \ \ run: xmake config --yes -vD

    \ \ \ \ \ \ - name: build

    \ \ \ \ \ \ \ \ run: xmake build --yes -vD goldfish

    \ \ \ \ \ \ - name: test

    \ \ \ \ \ \ \ \ run: bin/goldfish -l tests/test_all.scm

    \;
  </verbatim-chunk>

  <subsection|Github平台Debian系统>

  <paragraph|触发条件>

  <\verbatim-chunk|.github/workflows/ci-debian.yml|false|true>
    name: CI on Debian bookworm

    on:

    \ \ push:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-debian.yml'

    \ \ pull_request:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-debian.yml'

    \;
  </verbatim-chunk>

  <paragraph|环境变量>

  <\verbatim-chunk|.github/workflows/ci-debian.yml|true|true>
    env:

    \ \ XMAKE_ROOT: y

    \ \ DEBIAN_FRONTEND: noninteractive

    \;
  </verbatim-chunk>

  <paragraph|具体任务>

  <\verbatim-chunk|.github/workflows/ci-debian.yml|true|false>
    jobs:

    \ \ build:

    \ \ \ \ container: debian:bookworm

    \ \ \ \ runs-on: ubuntu-22.04

    \ \ \ \ strategy:

    \ \ \ \ \ \ fail-fast: true

    \ \ \ \ steps:

    \ \ \ \ \ \ - name: Install dependencies

    \ \ \ \ \ \ \ \ run: \|

    \ \ \ \ \ \ \ \ \ \ apt-get update

    \ \ \ \ \ \ \ \ \ \ apt-get install -y git 7zip unzip curl build-essential

    \ \ \ \ \ \ - uses: actions/checkout@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ fetch-depth: 1

    \;

    \ \ \ \ \ \ - name: git add safe directory

    \ \ \ \ \ \ \ \ run: git config --global --add safe.directory '*'

    \;

    \ \ \ \ \ \ - name: de-gitee

    \ \ \ \ \ \ \ \ run: sed -i '/gitee\\.com/d' xmake/packages/s/s7/xmake.lua

    \;

    \ \ \ \ \ \ - name: set XMAKE_GLOBALDIR

    \ \ \ \ \ \ \ \ run: echo "XMAKE_GLOBALDIR=${{ runner.workspace }}/xmake-global" \<gtr\>\<gtr\> $GITHUB_ENV

    \;

    \ \ \ \ \ \ - uses: xmake-io/github-action-setup-xmake@v1

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ xmake-version: v2.8.7

    \ \ \ \ \ \ \ \ \ \ actions-cache-folder: '.xmake-cache'

    \;

    \ \ \ \ \ \ - name: xmake repo --update

    \ \ \ \ \ \ \ \ run: xmake repo --update

    \;

    \ \ \ \ \ \ - name: cache packages from xrepo

    \ \ \ \ \ \ \ \ uses: actions/cache@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ path: \|

    \ \ \ \ \ \ \ \ \ \ \ \ ${{ env.XMAKE_GLOBALDIR }}/.xmake/packages

    \ \ \ \ \ \ \ \ \ \ key: ${{ runner.os }}-xrepo-${{ hashFiles('**/xmake.lua') }}

    \;

    \ \ \ \ \ \ - name: config

    \ \ \ \ \ \ \ \ run: xmake config -vD --policies=build.ccache -o tmp/build -m releasedbg --yes

    \;

    \ \ \ \ \ \ - name: build

    \ \ \ \ \ \ \ \ run: xmake build --yes -vD goldfish

    \;

    \ \ \ \ \ \ - name: run tests

    \ \ \ \ \ \ \ \ run: bin/goldfish -l tests/test_all.scm

    \;
  </verbatim-chunk>

  <subsection|Github平台Fedora系统>

  <paragraph|触发条件>

  <\verbatim-chunk|.github/workflows/ci-fedora.yml|false|true>
    name: CI on Fedora 41

    on:

    \ \ push:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-fedora.yml'

    \ \ pull_request:

    \ \ \ \ branches: [ main ]

    \ \ \ \ paths:

    \ \ \ \ \ \ - 'goldfish/**'

    \ \ \ \ \ \ - 'src/**'

    \ \ \ \ \ \ - 'tests/**'

    \ \ \ \ \ \ - 'xmake/**'

    \ \ \ \ \ \ - 'xmake.lua'

    \ \ \ \ \ \ - '.github/workflows/ci-fedora.yml'

    \;
  </verbatim-chunk>

  <paragraph|环境变量>

  <\verbatim-chunk|.github/workflows/ci-fedora.yml|true|true>
    env:

    \ \ XMAKE_ROOT: y

    \ \ DEBIAN_FRONTEND: noninteractive

    \;
  </verbatim-chunk>

  <paragraph|具体任务>

  <\verbatim-chunk|.github/workflows/ci-fedora.yml|true|false>
    jobs:

    \ \ build:

    \ \ \ \ container: fedora:41

    \ \ \ \ runs-on: ubuntu-22.04

    \ \ \ \ strategy:

    \ \ \ \ \ \ fail-fast: true

    \ \ \ \ steps:

    \ \ \ \ \ \ - name: Install dependencies

    \ \ \ \ \ \ \ \ run: \|

    \ \ \ \ \ \ \ \ \ \ sudo dnf update -y

    \ \ \ \ \ \ \ \ \ \ sudo dnf install -y gcc g++ xmake git unzip curl

    \ \ \ \ \ \ - uses: actions/checkout@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ fetch-depth: 1

    \;

    \ \ \ \ \ \ - name: git add safe directory

    \ \ \ \ \ \ \ \ run: git config --global --add safe.directory '*'

    \;

    \ \ \ \ \ \ - name: de-gitee

    \ \ \ \ \ \ \ \ run: sed -i '/gitee\\.com/d' xmake/packages/s/s7/xmake.lua

    \;

    \ \ \ \ \ \ - name: set XMAKE_GLOBALDIR

    \ \ \ \ \ \ \ \ run: echo "XMAKE_GLOBALDIR=${{ runner.workspace }}/xmake-global" \<gtr\>\<gtr\> $GITHUB_ENV

    \;

    \ \ \ \ \ \ - name: xmake repo --update

    \ \ \ \ \ \ \ \ run: xmake repo --update

    \;

    \ \ \ \ \ \ - name: cache packages from xrepo

    \ \ \ \ \ \ \ \ uses: actions/cache@v3

    \ \ \ \ \ \ \ \ with:

    \ \ \ \ \ \ \ \ \ \ path: \|

    \ \ \ \ \ \ \ \ \ \ \ \ ${{ env.XMAKE_GLOBALDIR }}/.xmake/packages

    \ \ \ \ \ \ \ \ \ \ key: ${{ runner.os }}-xrepo-${{ hashFiles('**/xmake.lua') }}

    \;

    \ \ \ \ \ \ - name: config

    \ \ \ \ \ \ \ \ run: xmake config -vD --policies=build.ccache -o tmp/build -m releasedbg --yes

    \;

    \ \ \ \ \ \ - name: build

    \ \ \ \ \ \ \ \ run: xmake build --yes -vD goldfish

    \;

    \ \ \ \ \ \ - name: run tests

    \ \ \ \ \ \ \ \ run: bin/goldfish -l tests/test_all.scm

    \;
  </verbatim-chunk>
</body>

<\initial>
  <\collection>
    <associate|font-base-size|8>
    <associate|info-flag|paper>
    <associate|page-height|auto>
    <associate|page-medium|papyrus>
    <associate|page-screen-margin|false>
    <associate|page-type|a5>
    <associate|page-width|auto>
    <associate|par-par-sep|0.3333fn>
    <associate|save-aux|false>
  </collection>
</initial>