Goldfish.tmu

<TMU|<tuple|1.0.4|1.2.9.3>>

<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.10.6>
  </hide-preamble>

  文档许可证暂时没有确定！

  \;

  金鱼Scheme，又称Goldfish Scheme，是三鲤网络发起的Scheme解释器实现。目前专注于Scheme语言的标准库。本文档是金鱼Scheme V<value|goldfish-version>的文学编程实现，目前金鱼Scheme中几乎所有的Scheme代码实现和测试都包含在本文档中。

  本文档的用户是人类和大模型服务。基于本文档，用户可以获得金鱼Scheme的实现方法，也可以改进金鱼Scheme的既有实现。本文档的内容越翔实，用户使用金鱼Scheme的体验越好。<chapter|boot.scm>

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

  \;

  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>

  <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|数的运算>

  <paragraph|zero?>

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

  <paragraph|exact-integer-sqrt>

  <paragraph|expt>

  <subsection|数的转换>

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

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

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

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

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

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

    \ \ 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>
    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      (cons '(1 2) '(3 4))
    <|unfolded-io>
      ((1 2) 3 4)
    </unfolded-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|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

    \ \ \ \ \ \ \ \ \ (error 'type-error "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 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|false>
    (define-library (liii bitwise)

    (import (srfi srfi-151)

    \ \ \ \ \ \ \ \ (liii error))

    (export

    \ \ ; from (srfi srfi-151)

    \ \ bitwise-not bitwise-and bitwise-ior bitwise-xor

    \ \ arithmetic-shift

    \ \ ; S7 built-in

    \ \ lognot logand logior logxor

    \ \ ash

    )

    (begin

    ) ; end of begin

    ) ; end of library

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

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

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

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

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

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

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

  <subsection|整数运算>

  <paragraph|ash><index|ash>

  <value|srfi><paragraph|arithmetic-shift><index|arithmetic-shift>

  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>

  <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

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-every

    \ \ \ \ \ \ \ \ \ #\\012345

    \ \ \ \ \ \ \ \ \ "012345"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-every

    \ \ \ \ \ \ \ \ \ "012345"

    \ \ \ \ \ \ \ \ \ "012345"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-every

    \ \ \ \ \ \ \ \ \ 0

    \ \ \ \ \ \ \ \ \ "xxx0xx"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-any

    \ \ \ \ \ \ \ \ \ (lambda (n) (= n 0))

    \ \ \ \ \ \ \ \ \ "xxx0xx"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda ()\ 

    \ \ \ \ \ \ (string-every

    \ \ \ \ \ \ \ \ \ "0"

    \ \ \ \ \ \ \ \ \ "xxx0xx"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

    \ \ (string-any\ 

    \ \ \ \ <code*|char-alphabetic?>

    \ \ \ \ "01c345"

    \ \ \ \ 2

    \ \ \ \ 4)

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (string-any\ 

    \ \ \ \ <code*|char-alphabetic?>

    \ \ \ \ "01c345"

    \ \ \ \ 2

    \ \ \ \ 2)

    \ \ =\<gtr\>

    \ \ #f)

    \;

    (check

    \ \ (string-any\ 

    \ \ \ \ <code*|char-alphabetic?>

    \ \ \ \ "01c345"

    \ \ \ \ 3

    \ \ \ \ 4)

    \ \ =\<gtr\>

    \ \ #f)

    \;

    (check

    \ \ (string-any\ 

    \ \ \ \ char-alphabetic?

    \ \ \ \ "01c345"

    \ \ \ \ 2

    \ \ \ \ 6)

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (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

    \ \ \ \ (lambda () (string-ref "MathAgape" -1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (string-ref "MathAgape" 9))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (string-ref "" 0))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

    \ \ \ \ (lambda () (string-pad "MathAgape" -1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

    \ \ \ \ (lambda () (string-trim " \ 2 4 \ " 0 8))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (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

    \ \ \ \ (lambda () (string-trim-right " \ 2 4 \ " 8))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (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

    \ \ \ \ (lambda () (string-trim-right " \ 2 4 \ " 0 8))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

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

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

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

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

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

  <todo|TODO>

  <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?))><index|vector-ref>

  返回向量中索引为 k 的元素的内容。当 k 不是向量的有效索引，报错。

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

    \ \ \ \ (lambda () (vector-ref #(1 2 3) 2.0))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \ \ 

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda () (vector-ref #(1 2 3) "2"))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

  <todo|TODO>

  <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

    \ \ \ \ (lambda () (vector-set! my-vector 4 10))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

    <\unfolded-io>
      \<gtr\>\ 
    <|unfolded-io>
      b
    <|unfolded-io>
      <guile-result|#("a1" "a2" "a3" "a4" "b4")>
    </unfolded-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

    \ \ \ \ (lambda () (vector-copy! b -1 a))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    ;(\<less\> start 0)

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 0 a -1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    ;(\<gtr\> start (vector-length from))

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 0 a 6))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    ;(\<gtr\> end (vector-length from))

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 0 a 0 6))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    ;(\<gtr\> start end)

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 0 a 2 1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    ;(\<gtr\> (+ at (- end start)) (vector-length to))

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 6 a))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check

    \ \ (catch 'out-of-range

    \ \ \ \ (lambda () (vector-copy! b 1 a))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (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

    \ \ \ \ (lambda () (vector-\<gtr\>list #() 1))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

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

    \ \ \ \ (lambda () (vector-\<gtr\>string (vector #\\0 #\\1 #\\2 #\\3) 2 10))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

    \;

    (check (vector-\<gtr\>string (vector 0 1 #\\2 3 4) 2 3) =\<gtr\> "2")

    \;

    (check

    \ \ (catch 'wrong-type-arg

    \ \ \ \ (lambda () (vector-\<gtr\>string (vector 0 1 #\\2 3 4) 1 3))

    \ \ \ \ (lambda args #t))

    \ \ =\<gtr\>

    \ \ #t)

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

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

  <paragraph|alist-\<gtr\>hash-table><index|alist-\<gtr\>hash-table>

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

  S7内置函数。判断一个对象是不是哈希表。

  <paragraph|hash-table-contains?><index|hash-table-contains?><scm|((ht hash-table?) key) =\<gtr\> bool>

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

  <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=?><scm|(ht1 ht2) =\<gtr\> boolean>

  <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><scm|(hash-table-ref ht 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><scm|(hash-table-ref/default ht key default) =\<gtr\> value>

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

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

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

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

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

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

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

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

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

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

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

  <section|许可证>

  <\scm-chunk|goldfish/liii/set.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-113.scm|false|true>
    ; 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.

    ;

    \;
  </scm-chunk>

  <section|接口>

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

    (import (srfi srfi-113))

    (export set?)

    (begin

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-113.scm|true|true>
    (define-library (srfi srfi-113)

    (import (scheme base))

    (export set?)

    (begin

    \;
  </scm-chunk>

  \;

  <section|结尾>

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

    ) ; end of define-library

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/srfi/srfi-113.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  \;

  <chapter|三鲤扩展库说明>

  三鲤扩展库都是形如<scm|(liii xyz)>的Scheme库。

  <section|结尾>

  <\scm-chunk|goldfish/scheme/base.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

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

  <paragraph|bytevector-base64-encode><index|bytevector-base64-encode>

  <paragraph|string-base64-encode><index|string-base64-encode>

  <paragraph|base64-encode><index|base64-encode>

  <\enumerate>
    <item>计算base64编码的长度

    <\equation*>
      length<around*|(|output|)>=<around*|\<lceil\>|length<around*|(|input|)>/3|\<rceil\>>\<times\>4
    </equation*>

    <item>将输入的字节向量分组，每组三个元素，最后一组存在三种情况：

    <\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>
    </big-table>

    <item>对每一组的<math|<around*|[|b<rsub|1>,b<rsub|2>,b<rsub|3>|]>>映射为<math|<around*|[|c<rsub|1>,c<rsub|2>,c<rsub|3>,c<rsub|4>|]>>，其中<math|c<rsub|n>>必须是字母、数字、<scm|+>、<scm|/>或者<scm|=>。

    <todo|描述一下base64的映射规则>

    \;
  </enumerate>

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

  <section|协议>

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

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

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

  <section|结尾>

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

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