s7 是一个 Scheme 解释器，旨在作为其他应用程序的扩展语言。 它仅由两个文件组成：s7.c 和 s7.h，只需将它们融入他人的源代码树即可。没有库文件、 没有运行时初始化文件，也没有配置脚本。 它可以构建为独立的 解释器（参见 repl）。s7test.scm 是 s7 的回归测试。 tarball 可在此获取：s7 tarball。 在 sourceforge 上有一个 svn 仓库（Snd 项目）：Snd， 以及一个 git 仓库（仅 s7）：git@cm-gitlab.stanford.edu:bil/s7.git s7.git。 请忽略所有其他 "s7" github 站点。Christos Vagias 创建了一个带有 repl 的 web-assembly 站点：https://github.com/actonDev/s7-playground/。
s7 是 Snd 和 sndlib（snd）、 Rick Taube 的 Common Music（commonmusic at sourceforge）、Kjetil Matheussen 的 Radium 音乐编辑器以及 Iain Duncan 的 Scheme for Max（或 Pd）的扩展语言。 在 Snd tarball 中有 X、Motif 和 openGL 绑定 （位于 libxm 中），或在 ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz 获取。
虽然它是 tinyScheme 的后裔，但 s7 作为 Scheme 方言最接近 Guile 1.8。 我相信它与 r5rs 和 r7rs 兼容：你可以忽略本文件中讨论的所有新增内容。 它支持 continuation（续延）、 ratio（有理数）、复数、 macro（宏）、关键字、哈希表、 多精度算术、 广义 set!、unicode 等等。 它没有 syntax-rules 或其任何相关形式，并且它认为 不存在不精确整数这样的东西。
本文件假设你了解 Scheme 及其所有问题， 并且想要快速了解 s7 的不同之处。（嗯，它曾经是很快的）。 主要区别是：如果某样东西在 s7 中，它就是 s7 的一等公民，这包括 macro（宏）、环境和语法值。
我原本用小号字体显示注释，但现在我需要眯着眼 才能看清那微小的文字，所以不太重要的评论使用正常字体显示，但 缩进并放在略带棕色的背景上。
支持所有数值类型：整数、有理数、实数和复数。 基本的整数和实数类型定义在 s7.h 中，默认为 int64_t 和 double。 一个有理数由两个整数组成，一个复数由两个实数组成。 pi 是预定义的。 s7 可以使用 gmp、mpfr 和 mpc 库构建多精度支持 （在 s7.c 中将 WITH_GMP 设置为 1）。 如果启用了多精度算术， 则包含以下函数：bignum 和 bignum?，以及变量 (*s7* 'bignum-precision)。 (*s7* 'bignum-precision) 默认为 128；它设置每个浮点数占用的位数。 pi 会自动反映当前的 (*s7* 'bignum-precision)：
> pi 3.141592653589793238462643383279502884195E0 > (*s7* 'bignum-precision) 128 > (set! (*s7* 'bignum-precision) 256) 256 > pi 3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0
bignum? 如果其参数是某种类型的大数则返回 #t；我用 "bignum" 表示任何大数，不仅仅是整数。要创建大数， 可以包含足够多的数字以溢出默认类型，或者使用 bignum 函数。 它的参数可以是一个数字（将其转换为大数），或者一个表示所需数字的字符串：
> (bignum "123456789123456789") 123456789123456789 > (bignum "1.123123123123123123123123123") 1.12312312312312312312312312300000000009E0
对于读取时大数：
(set! *#readers*
(cons (cons #\B (lambda (str)
(bignum (string->number (substring str 1)))))
*#readers*))
现在 #B123 就是 (bignum 123) 的读取器等价形式。
在非 gmp 情况下，如果 s7 使用 double 构建（s7.h 中的 s7_double），浮点数 "epsilon" 大约是 (expt 2 -53)，即约 1e-16。在 gmp 情况下，它大约是 (expt 2 (- (*s7* 'bignum-precision)))。 所以在默认情况下（精度 = 128），使用 gmp：
> (= 1.0 (+ 1.0 (expt 2.0 -128))) #t > (= 1.0 (+ 1.0 (expt 2.0 -127))) #f在非 gmp 情况下：
> (= 1.0 (+ 1.0 (expt 2 -53))) #t > (= 1.0 (+ 1.0 (expt 2 -52))) #f在 gmp 情况下，整数和有理数仅受内存大小限制， 但实数受 (*s7* 'bignum-precision) 限制。这意味着，例如
> (floor 1e56) ; (*s7* 'bignum-precision) is 128 99999999999999999999999999999999999999927942405962072064 > (set! (*s7* 'bignum-precision) 256) 256 > (floor 1e56) 100000000000000000000000000000000000000000000000000000000非 gmp 情况类似，但很容易找到边界情况：
> (floor (+ 0.9999999995 (expt 2.0 23))) 8388609
s7 包含：
random 函数可以接受任何数值参数，包括 0。 s7 与 r5rs 之间其他数学相关的差异：
> (exact? 1.0) #f > (rational? 1.5) #f > (floor 1.4) 1 > (remainder 2.4 1) 0.4 > (modulo 1.4 1.0) 0.4 > (lcm 3/4 1/6) 3/2 > (log 8 2) 3 > (number->string 0.5 2) "0.1" > (string->number "0.1" 2) 0.5 > (rationalize 1.5) 3/2 > (complex 1/2 0) 1/2 > (logbit? 6 1) ; argument order, (logbit? int index), follows gmp, not CL #t
参见 cload 和 libgsl.scm 了解 GSL 的便捷访问方式， 同样 libm.scm 用于 C 数学库。
指数本身始终以 10 为底；这遵循 gmp 的用法。 Scheme 通常使用 "@" 表示无用的极坐标记法，但这意味着
(string->number "1e1" 16)是有歧义的——"e" 是一个数字还是指数标记？ 在 s7 中，"@" 是指数标记。> (string->number "1e9" 2) ; (expt 2 9) 512.0 > (string->number "1e1" 12) ; "e" is not a digit in base 12 #f > (string->number "1e1" 16) ; (+ (* 1 16 16) (* 14 16) 1) 481 > (string->number "1.2e1" 3); (* 3 (+ 1 2/3)) 5.0函数 nan 和 nan-payload 指的是可以与 NaN 关联的 "payload"（负载）。s7 的读取器 可以读取带有这些负载的 NaN：
+nan.123是一个负载为 123 的 NaN。s7 以相同方式显示 NaN 负载： +nan.123。没有负载（或负载为 0）的 NaN 写为 +nan.0。> (nan 123) +nan.123 > (nan-payload (nan 123)) 123nan 函数（以及 s7 的读取器）始终返回正的 NaN。
(/ 1.0 0.0)是什么？s7 在这里给出 "division by zero"（除以零）错误，在(/ 1 0)中也是如此。 Guile 在第一种情况下返回 +inf.0，这看起来是合理的，但在第二种情况下给出 "numerical overflow"（数值溢出）错误。 稍微奇怪一点的是(expt 0.0 0+i)。目前 s7 返回 0.0，Guile 返回 +nan.0+nan.0i， Clisp 和 sbcl 抛出错误。大家都同意(expt 0 0)是 1，Guile 认为(expt 0.0 0.0)是 1.0。但(expt 0 0.0)和(expt 0.0 0)在 Guile 中返回不同 结果（1 和 1.0），在 s7 中两者都是 0.0，在 Clisp 中第一个是错误但第二个返回 1， 等等——真是一团糟！当 IEEE 规定 0.0 等于 -0.0 时，这个混乱变得更加严重，我们无法区分它们，但它们产生不同的结果：scheme@(guile-user)> (= -0.0 0.0) #t scheme@(guile-user)> (negative? -0.0) #f scheme@(guile-user)> (= (/ 1.0 0.0) (/ 1.0 -0.0)) #f scheme@(guile-user)> (< (/ 1.0 -0.0) -1e100 1e100 (/ 1.0 0.0)) #t它们怎么可能相等？在 s7 中，-0.0 的符号被忽略， 它们确实相等。 另一个奇怪之处：两个浮点数可以满足 eq? 但不满足 eqv?：
(eq? +nan.0 +nan.0)可能是 #t（这是未指定的），但(eqv? +nan.0 +nan.0)是 #f。 同样的问题也困扰着 memq 和 assq。random 函数接受一个范围和一个可选的状态，返回一个 介于零和范围之间的数字，类型与范围相同。 使用范围 0 是完全合理的，此时 random 返回 0。 random-state 从一个种子创建新的随机状态。如果没有传递种子， random-state 返回当前状态。 如果未向 random 传递状态， 它使用从当前时间初始化的某个默认状态。random-state? 如果传入随机状态对象则返回 #t。
> (random 0) 0 > (random 1.0) 0.86331198514245 > (random 3/4) 654/1129 > (random 1+i) 0.86300308872748+0.83601002730848i > (random -1.0) -0.037691127513267 > (define r0 (random-state 1234)) r0 > (random 100 r0) 94 > (random 100 r0) 19 > (define r1 (random-state 1234)) r1 > (random 100 r1) 94 > (random 100 r1) 19复制 random-state 以保存随机数序列中的某个位置，或者通过 random-state->list 将 random-state 保存为列表，然后要从该点重新开始，对该列表应用 random-state。
在 gmp 版本的 s7 中，random 调用 gmp 的随机数生成器。 GSL 中也有许多生成器（参见 libgsl.scm）。在非 gmp 版本的 s7 中，我们使用 Marsaglia 的 MWC 算法， 我认为这是质量和速度之间的一个很好的折衷。
我找不到这一节合适的语气；这是第 400 次修订了；我希望我能写得更好！
在某些 Scheme 中， "rational" 意味着 "可能同样可以表示为有理数：浮点数是近似的"。在 s7 中它是："实际上在 scheme 层面表示为有理数（或整数当然）"； 否则 "rational?" 等同于 "real?"：
(not-s7)> (rational? (sqrt 2)) #t1.0 在 IEEE 浮点层面以某种有理数的形式表示， 并不意味着它必须是 scheme 有理数；这两个概念是独立的。
但与完全疯狂的 "inexact integer"（不精确整数）相比，这种混淆是微不足道的。 据我理解，"inexact" 最初意味着 "浮点数"，"exact" 意味着整数或整数之比。 但词语有自己的生命。 0.0 不知怎的变成了一个 "inexact" 整数（尽管它可以在浮点中精确表示）。 +inf.0 必须是一个整数——它的 小数部分明确为零！但 +nan.0…… 还有：
(not-s7)> (integer? 9007199254740993.1) #t什么时候这很重要？我经常需要索引到向量中，但索引是一个浮点数（Scheme 术语中的 "real"： 其小数部分可以非零）。 在某个 Scheme 中：
(not-s7)> (vector-ref #(0) (floor 0.1)) ERROR: Wrong type (expecting exact integer): 0.0 ; [why? "it's probably a programmer mistake"!]不用担心，我会使用 inexact->exact：
(not-s7)> (inexact->exact 0.1) 3602879701896397/36028797018963968 ; [why? "floats are ratios"!]所以我最终到处使用冗长的
(floor (inexact->exact ...))， 即使这样我也无法保证我会得到一个合法的向量索引。 我从未见过 exact/inexact 区分被实际使用——只是 疯狂的挣扎试图绕过它。 我认为整个想法是混乱且无用的，会导致 冗长且有 bug 的代码。 如果我们抛弃它， 我们可以通过以下方式保持向后兼容性：(define exact? rational?) (define (inexact? x) (not (rational? x))) (define inexact->exact rationalize) ; or floor (define (exact->inexact x) (* x 1.0))标准 Scheme 的 #i 和 #e 也是无用的，因为 在例如 #b 之后可以有任何数字：
> #b1.1 1.5 > #b1e2 4.0 > #o17.5+i 15.625+1is7 将 #i 用于 int-vector，不实现 #e。 说到 #b 及其相关形式，
(string->number "#xffff" 2)应该返回什么？ （关于 exact/inexact 的不同观点请参见 https://www.deinprogramm.de/sperber/papers/numerical-tower.pdf）。
define* 和 lambda* 是 define 和 lambda 的扩展，使其更容易 处理可选参数、关键字参数和 rest 参数。 语法非常简单：define* 的每个参数都有一个默认值， 并且自动作为关键字参数可用。默认值 如果未指定则为 #f，或在列表中给出（列表的第一个成员是 参数名）。 最后一个参数 前面可以加 :rest 或点号，表示所有其他尾随参数 应作为列表打包在该参数名下。尾随或 rest 参数的默认值是 ()，不能在声明中指定。 rest 参数不能作为关键字参数使用。
(define* (hi a (b 32) (c "hi")) (list a b c))
这里参数 "a" 默认为 #f，"b" 为 32，等等。 当函数被调用时， 参数名从传递给函数的值中设置， 然后任何未设置的参数绑定到它们的默认值，按从左到右的顺序求值。 在扫描当前参数列表时，作为关键字出现的任何名称（例如 :arg，其中参数名为 arg） 设置该参数的新值。否则，当值出现时， 它们根据位置插入到实际参数列表中，将关键字/值对算作一个参数。 这在 CLM 中称为 optional-key 列表。所以，以上面的函数为例：
> (hi 1) (1 32 "hi") > (hi :b 2 :a 3) (3 2 "hi") > (hi 3 2 1) (3 2 1)
更多示例请参见 s7test.scm。（s7 的 define* 与 srfi-89 的 define* 非常接近）。 要将参数标记为必需，将其默认值设置为对 error 函数的调用：
> (define* (f a (b (error 'unset-arg "f's b parameter not set"))) (list a b)) f > (f 1 2) (1 2) > (f 1) error: f's b parameter not set
可选参数和关键字参数的组合在 Lisp 社区中 不受欢迎，但问题在于 CL 对这个想法的实现，而不是想法本身。 我从 1976 年左右就使用 s7 风格，从未觉得它令人困惑。CL 的错误 在于如果出现关键字参数就要求可选参数，并将它们视为与关键字参数不同的东西。 所以每个人都会忘记，把关键字放在 CL 期望必需可选参数的位置。 CL 然后做一些荒谬的事情，程序员到处嚷嚷关键字，但错误在于 CL。 如果 s7 的方式被认为太宽松，一种收紧的方法可能是坚持一旦使用了关键字， 后面只能跟关键字参数对。
lambda* 的一个天然伴侣是 named let*。在 named let 中，隐式函数的 参数有初始值，但此后，每次调用都需要完整的参数集。 为什么不将初始值视为默认值呢？
> (let* func ((i 1) (j 2)) (+ i j (if (> i 0) (func (- i 1)) 0))) 5 > (letrec ((func (lambda* ((i 1) (j 2)) (+ i j (if (> i 0) (func (- i 1)) 0))))) (func)) 5这与 lambda* 参数是一致的，因为它们的默认值 已经按从左到右的顺序设置，并且当每个参数被设置为其默认值时， 绑定被添加到默认值表达式环境中（就像 let* 一样）。 let* 名称本身（隐式函数）直到绑定 被求值之后才被定义（如 named let 中）。
在 CL 中，关键字默认值以相同方式处理：
> (defun foo (&key (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c)) FOO > (foo :b 2 :a 60) (60 2 67)在 s7 中，我们使用：
(define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c))此外 CL 和 s7 以相同方式处理作为值的关键字：
> (defun foo (&key a) a) FOO > (defvar x :a) X > (foo x 1) 1> (define* (foo a) a) foo > (define x :a) :a > (foo x 1) 1关键字（命名参数）在 named let* 中也能工作：
> (let* loop ((i 0) (j 0)) (if (> i 3) (+ i j) (loop :j 2 :i (+ i 1)))) 6为了尝试捕获我认为通常是错误的情况，我添加了两个 错误检查。一个在同一次调用中设置相同参数两次时触发， 另一个在键位置遇到未知关键字时触发。 要关闭这些错误，在参数列表末尾添加 :allow-other-keys。 这些问题出现在这样的情况中：
(define* (f (a 1) (b 2)) (list a b))你可能意外地做以下任何事情：
(f 1 :a 2) ; what is a? (f :b 1 2) ; what is b? (f :c 3) ; did you really want a to be :c and b to be 3?在最后一种情况下，要故意传递关键字，可以包含 参数关键字：
(f :a :c)，或将默认值设为关键字：(define* (f (a :c) ...))，或将(*s7* 'accept-all-keyword-arguments)设置为某个真值。 更多示例请参见 s7test.scm。如果两个函数共享一个关键字参数， 而一个想要调用另一个，将两个参数都传递给包装器呢？
(define* (f1 a) a) ; the wrappee (define* (f2 a :rest b :allow-other-keys) ; the wrapper (+ a (apply f1 b))) (f2 :a 3 :a 4) ; 7, b='(:a 4) (let ((c :a)) (f2 c 3 c 4)) ; also 7由于 named let* 是 lambda* 的一种形式，禁止重复变量名使其与 let* 不同：
(let* ((a 1) (a 2)) a)是 2，但(let* loop ((a 1) (a 2)) a)是错误。 如果 let* 和 named let* 在此一致，我们就会与 lambda* 产生不一致。如果三者都允许重复 变量，决定哪个参数是有意的就变得混乱：((lambda* (a a) a) 2 :a 3)， 或(let* loop ((a 1) (a 2)) (loop 2 :a 3))。 CL 和标准 scheme 接受 let* 中的重复变量，所以我认为当前 选择是最不令人惊讶的。s7 的 lambda* 参数列表处理与 CL 的 lambda-list 不同。首先， 你可以有多个 :rest 参数：
> ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5) '(3 5 7 9)其次，rest 参数（如果有）像其他参数一样占用一个参数槽：
> ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) (32 1 ()) > ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) (1 3 (2 3 4 5))如果我们对 'c' 使用 &key，CL 会同意第一种情况，但在第二种情况下会给出错误。 当然，主要区别是 s7 关键字参数不要求键必须存在。 :rest 参数在这些情况下是需要的，因为我们不能使用这样的表达式：
> ((lambda* ((a 3) . b c) (list a b c)) 1 2 3 4 5) error: stray dot? > ((lambda* (a . (b 1)) b) 1 2) ; the reader turns the arglist into (a b 1) error: lambda* parameter '1 is a constant还有一个细节：:rest 参数不被视为关键字参数，所以
> (define* (f :rest a) a) f > (f :a 1) (:a 1)
define-macro, define-macro*, define-bacro, define-bacro*, macroexpand, gensym, gensym? 和 macro? 实现了标准的传统宏。 匿名版本（类似于 lambda 和 lambda*）是 macro、macro*、bacro 和 bacro*。 更多宏示例请参见 s7test.scm，包括一些经典收藏如 loop、dotimes、do*、enum、pushnew 和 defstruct。
> (define-macro (and-let* vars . body)
`(let ()
(and ,@(map (lambda (v)
`(define ,@v))
vars)
(begin ,@body))))
macroexpand 可以帮助调试宏。我总是忘记它 需要一个表达式：
> (define-macro (add-1 arg) `(+ 1 ,arg)) add-1 > (macroexpand (add-1 32)) (+ 1 32)
gensym 返回一个保证唯一的符号。它接受一个可选的字符串参数 给出新符号名的前缀。gensym? 如果其参数是由 gensym 创建的符号则返回 #t。
(define-macro (pop! sym)
(let ((v (gensym)))
`(let ((,v (car ,sym)))
(set! ,sym (cdr ,sym))
,v)))
如在 define* 中一样，星号形式提供可选和关键字参数：
> (define-macro* (add-2 a (b 2)) `(+ ,a ,b)) add-2 > (add-2 1 3) 4 > (add-2 1) 3 > (add-2 :b 3 :a 1) 4
宏是 s7 的一等公民。你可以 将它作为函数参数传递，将其应用于列表，从函数中返回它， 递归调用它， 并将其赋值给变量。你甚至可以设置它的 setter！
> (define-macro (hi a) `(+ ,a 1)) hi > (apply hi '(4)) 5 > (define (fmac mac) (apply mac '(4))) fmac > (fmac hi) 5 > (define (fmac mac) (mac 4)) fmac > (fmac hi) 5 > (define (make-mac) (define-macro (hi a) `(+ ,a 1))) make-mac > (let ((x (make-mac))) (x 2)) 3 > (define-macro (ref v i) `(vector-ref ,v ,i)) ref > (define-macro (set v i x) `(vector-set! ,v ,i ,x)) set > (set! (setter ref) set) set > (let ((v (vector 1 2 3))) (set! (ref v 0) 32) v) #(32 2 3)要展开代码中的所有宏：
(define-macro (fully-macroexpand form) (list 'quote (let expand ((form form)) (cond ((not (pair? form)) form) ((and (symbol? (car form)) (macro? (symbol->value (car form)))) (expand (apply macroexpand (list form)))) ((and (eq? (car form) 'set!) ; look for (set! (mac ...) ...) and use mac's setter (pair? (cdr form)) (pair? (cadr form)) (macro? (symbol->value (caadr form)))) (expand (apply macroexpand (list (cons (setter (symbol->value (caadr form))) (append (cdadr form) (copy (cddr form)))))))) (else (cons (expand (car form)) (expand (cdr form))))))))这并不总是正确处理 bacros，因为它们的展开可以依赖于运行时 状态。
bacro 是一种展开其体并在 调用环境中求值结果的宏。
(define setf (let ((args (gensym)) (name (gensym))) (apply define-bacro `((,name . ,args) (unless (null? ,args) (apply set! (car ,args) (cadr ,args) ()) (apply setf (cddr ,args)))))))setf 参数是一个 gensym（在 setf 定义时创建），这样它的名称不会遮蔽任何现有 变量。Bacros 在调用环境中展开，普通的参数名 可能在 bacro 展开时遮蔽该环境中的某些东西。 同样，如果你在 bacro 展开代码中引入绑定，你需要 跟踪你希望事情发生在哪个环境中。大量使用 with-let 和 gensym。 stuff.scm 有 bacro-shaker，可以发现无意的名称冲突， 但它不稳定且容易出错。 调用环境本身在 bacro 内部是 (outlet (curlet))，所以
(define-bacro (holler) `(format *stderr* "(~S~{ ~S ~S~^~})~%" (let ((f (*function*))) (if (pair? f) (car f) f)) (map (lambda (slot) (values (symbol->keyword (car slot)) (cdr slot))) (map values ,(outlet (curlet)))))) (define (f1 a b) (holler) (+ a b)) (f1 2 3) ; prints out "(f1 :a 2 :b 3)" and returns 5由于 bacro（通常）会丢弃其定义时环境：
(define call-bac (let ((x 2)) (define-bacro (m a) `(+ ,a ,x)))) > (call-bac 1) error: x: unbound variable这里的宏返回 3。bacro 可以通过 funclet 获取其定义时环境（它的 closure 闭包）， 所以 define-macro 是 define-bacro 的特例！我们可以定义 以所有四种方式工作的宏：展开可以发生在定义环境或调用环境中， 展开的求值也是如此。在 bacro 中，如果我们不采取其他行动，两者都发生在调用环境中， 在普通宏（define-macro）中，展开发生在定义 环境中，求值发生在调用环境中。 以下是所有四种方式的简要示例：
(let ((x 1) (y 2)) (define-bacro (bac1 a) `(+ ,x y ,a)) ; expand and eval in calling env (let ((x 32) (y 64)) (bac1 3))) ; (with-let (inlet 'x 32 'y 64) (+ 32 y 3)) -> 99 ; with-let and inlet refer to environments (let ((x 1) (y 2)) ; this is like define-macro (define-bacro (bac2 a) (with-let (sublet (funclet bac2) :a a) `(+ ,x y ,a))) ; expand in definition env, eval in calling env (let ((x 32) (y 64)) (bac2 3))) ; (with-let (inlet 'x 32 'y 64) (+ 1 y 3)) -> 68 (let ((x 1) (y 2)) (define-bacro (bac3 a) (let ((e (with-let (sublet (funclet bac3) :a a) `(+ ,x y ,a)))) `(with-let ,(sublet (funclet bac3) :a a) ,e))) ; expand and eval in definition env (let ((x 32) (y 64)) (bac3 3))) ; (with-let (inlet 'x 1 'y 2) (+ 1 y 3)) -> 6 (let ((x 1) (y 2)) (define-bacro (bac4 a) (let ((e `(+ ,x y ,a))) `(with-let ,(sublet (funclet bac4) :a a) ,e))) ; expand in calling env, eval in definition env (let ((x 32) (y 64)) (bac4 3))) ; (with-let (inlet 'x 1 'y 2) (+ 32 y 3)) -> 37s7 中的反引号（quasiquote）几乎是平凡的。常量不变，符号被引用， ",arg" 变成 "arg"，",@arg" 变成 "(apply values arg)"——为真正的多值欢呼！ 编写实际的宏体几乎和编写它的反引号版本一样容易。
> (define-macro (hi a) `(+ 1 ,a)) hi > (procedure-source hi) (lambda (a) (list-values '+ 1 a)) > (define-macro (hi a) `(+ 1 ,@a)) hi > (procedure-source hi) (lambda (a) (list-values '+ 1 (apply-values a)))list-values 和 apply-values 是准引用辅助函数，下文有描述。 s7 中没有 unquote-splicing 宏；",@(...)" 在读取时变成 "(unquote (apply-values ...))"。也不应该有 unquote。 在 Scheme 中读取器将 ,x 转换为 (unquote x)，所以：
> (let (,'a) unquote) a > (let (, (lambda (x) (+ x 1))) ,,,,'3) 7逗号变成了一种符号宏！我想我会移除 unquote；,x 和 ,@x 仍将按预期工作， 但生成的源代码中不会有 "unquote" 或 "unquote-splicing"。
s7 的宏不是卫生的。例如，
> (define-macro (mac b)
`(let ((a 12))
(+ a ,b)))
mac
> (let ((a 1) (+ *)) (mac a))
144
这返回 144，因为 '+' 变成了 '*'，而 'a' 是内部的 'a'，
不是参数 'a'。我们得到 (* 12 12)，而我们可能期望
(+ 12 1)。
从 '+' 问题开始，
只要 '+' 的重定义是局部的（即发生在宏定义之后），我们可以反引号 +：
> (define-macro (mac b)
`(let ((a 12))
(,+ a ,b))) ; ,+ picks up the definition-time +
mac
> (let ((a 1) (+ *)) (mac a))
24 ; (+ a a) where a is 12
但如果我们之前加载了某个文件在顶层重定义了 '+'（所以宏定义时，+ 是 *，但我们想要内置的 +）， 反引号技巧就不会有效。 尽管这个例子很愚蠢，但在 Scheme 中这个问题是真实的， 因为 Scheme 没有保留字且只有一个命名空间。
> (define + *) + > (define (add a b) (+ a b)) add > (add 2 3) 6 > (define (divide a b) (/ a b)) divide > (divide 2 3) 2/3 > (set! / -) ; a bad idea — this turns off s7's optimizer - > (divide 2 3) -1
显然宏不是这里的问题。由于我们可能加载 他人编写的代码，有时很难判断该代码依赖或重定义了哪些名称。 我们需要一种方法来获取 '+' 的原始（启动时、内置的）值。 s7 中一种冗长的方式使用 unlet：
> (define + *) + > (define (add a b) (with-let (unlet) (+ a b))) add > (add 2 3) 5
但这难以阅读，我们可能想要符号的所有三个值：启动值、定义时值和
当前值。后者可以用裸符号访问，定义时值用反引号（','），启动值用 unlet
或 #_<name>。即 #_+ 是 (with-let (unlet) +) 的读取器宏。
> (define-macro (mac b)
`(#_let ((a 12))
(#_+ a ,b))) ; #_+ and #_let are start-up values
mac
> (let ((a 1) (+ *)) (mac a))
24 ; (+ a a) where a is 12 and + is the start-up +
;;; make + generic (there's a similar C-based example below)
> (define (+ . args)
(if (null? args) 0
(apply (if (number? (car args)) #_+ #_string-append) args)))
+
> (+ 1 2)
3
> (+ "hi" "ho")
"hiho"
概念上，#_<name> 可以通过 *#readers* 实现：
(set! *#readers* (cons (cons #\_ (lambda (str) (with-let (unlet) (string->symbol (substring str 1))))) *#readers*))但 s7 不允许你更改 #\_ 的含义；否则：
(set! *#readers* (list (cons #\_ (lambda (str) (string->symbol (substring str 1))))))现在 #_ 不提供任何保护：
> (let ((+ -)) (#_+ 1 2)) -1#t 和 #f（连同它们愚蠢的 r7rs 亲戚 #true 和 #false）也是不可设置的。
所以，现在我们只剩下变量捕获问题（'a' 在前面的例子中被捕获了）。 这是庞大的 "卫生宏" 系统实际处理的唯一问题： 一个微小的问题，从宣传来看，你会以为它和疟疾及 国债一样严重。gensym 是标准方法：
> (define-macro (mac b)
(let ((var (gensym)))
`(#_let ((,var 12))
(#_+ ,var ,b))))
mac
> (let ((a 1) (+ *)) (mac a))
13
;; or use lambda:
> (define-macro (mac b)
`((lambda (b) (let ((a 12)) (#_+ a b))) ,b))
mac
> (let ((a 1) (+ *)) (mac a))
13
我认为 syntax-rules 及其相关形式试图自动召唤 gensym，但 真正的问题不是名称冲突，而是未指定的环境。 在 s7 中我们有第一类环境，所以你对任何时刻的环境有完全的控制：
(define-macro (mac b)
`(with-let (inlet 'b ,b)
(let ((a 12))
(+ a b))))
> (let ((a 1) (+ *)) (mac a))
13
(define-macro (mac1 . b) ; originally `(let ((a 12)) (+ a ,@b ,@b))
`(with-let (inlet 'e (curlet)) ; this 'e will not collide with the calling env
(let ((a 12)) ; nor will 'a (so no gensyms are needed etc)
(+ a (with-let e ,@b) (with-let e ,@b)))))
> (let ((a 1) (e 2)) (mac1 (display a) (+ a e)))
18 ; (and it displays "11")
(define-macro (mac2 x) ; this will use mac2's definition environment for its body
`(with-let (sublet (funclet mac2) :x ,x)
(let ((a 12))
(+ a b x)))) ; a is always 12, b is whatever b happens to be in mac2's env
> (define b 10) ; this is mac2's b
10
> (let ((+ *) (a 1) (b 15)) (mac2 (+ a b)))
37 ; mac2 uses its own a (12), b (10), and + (+)
; but (+ a b) is 15 because at that point + is *: (* 1 15)
卫生宏是微不足道的！谁需要 syntax-rules？ 以下是 stuff.scm 中 while 宏卫生化前后的示例 （使用 "exit" 而非 "break"）：
(define-macro (unsafe-while test . body)
`(call-with-exit
(lambda (exit)
(let loop ()
(call-with-exit
(lambda (continue)
(do () ((not ,test) (exit))
,@body)))
(loop)))))
(define-macro (safe-while test . body)
(with-let (sublet (unlet) :test test :body body)
(let ((loop (gensym)))
(call-with-exit
(lambda (exit)
(let ,loop ()
(call-with-exit
(lambda (continue)
(do () ((not ,test) (exit))
,@body)))
(,loop)))))))
s7test.scm 中有更多示例（特别参见 s7test.scm 末尾的 "or" 宏）。
(define-macro (swap a b) ; assume a and b are symbols `(with-let (inlet 'e (curlet) 'tmp ,a) (set! (e ',a) (e ',b)) (set! (e ',b) tmp))) > (let ((b 1) (tmp 2)) (swap b tmp) (list b tmp)) (2 1) (define-macro (swap a b) ; here a and b can be any settable expressions `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a) (with-let e (set! ,a ,b)) tmp))) > (let ((v (vector 1 2))) (swap (v 0) (v 1)) v) #(2 1) > (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp) (2 . 1) (set! (setter swap) (define-macro (set-swap a b c) `(set! ,b ,c))) > (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d)) (2 3 4 1) ;;; but this is simpler: (define-macro (rotate! . args) `(set! ,(args (- (length args) 1)) (with-let (inlet 'e (curlet) 'tmp ,(car args)) (with-let e ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args))) tmp))) > (let ((a 1) (b 2) (c 3)) (rotate! a b c) (list a b c)) (2 3 1)
(let () (define (f23 y) (+ y 1)) ; the first f23 (define-macro (m1 x) `(f23 ,x)) ; picks up f23 from whatever the local env is where m1 is expanded (m1 3) ; 4 (let ((f23 (lambda (y) (+ y 2)))) ; the second f23 (m1 3) ; 5 (set! (symbol-initial-value :f23) f23)) ;; this remembers the second f23 as #_:f23 or (symbol-initial-value :f23) (define-macro (m2 x) `(,f23 ,x)) ; ",f23" picks up f23 from m2's definition-time environment (define e1 #f) (let ((f23 (lambda (y) (+ y 3)))) ; the third f23 (set! e1 (curlet)) ; save the environment holding the third f23 (m2 3)) ; 4 ; y + 1 because at this point the definition env f23 is the first (set! (symbol-initial-value 'f23) f23) ; #_f23 now refers to the first f23 (set! f23 (lambda (y) (+ y 4))) ; the fourth f23 (define-macro (m3 x) `((#_symbol-initial-value 'f23) ,x)) ;; this picks up the first f23 by delaying the reference to it until evaluation time. ;; Using `(#_f23 ,x) here will fail unless f23's symbol-initial-value is set at the top-level ;; because the reader only knows about global values: (define-macro (m4 x) `(#_f23 ,x)) ;; that is, when this definition is encountered, the reader sees the #_f23 without knowing anything about its ;; context (this is while reading the let form, before the symbol-initial-value is actually set). ;; When the let is later evaluated, the m4 code has already become `(#<undefined: f23> ,x) ;; so we get the error: "attempt to apply an undefined object #_f23 in (#_f23 3)?" (define-macro (m5 x) `((#_symbol-initial-value :f23) ,x)) ; this is a reference to the second f23 ;; 'f23 and :f23 can have different initial-values (define-macro (m6 x) `((,e1 'f23) ,x)) ; use e1 to get the third f23 ;; more hygienic: set e1's symbol-initial-value to itself above, then use (#_symbol-initial-value 'e1) here (let ((f23 (lambda (y) (+ y 5)))) ; the fifth f23 (m1 3) ; 8 = 3 + 5 from local (fifth) f23 (m2 3) ; 7 = 3 + 4 from definition environment f23 (the fourth) (m3 3) ; 4 = 3 + 1 from the first f23 (before the (set! f23 ...)) (catch #t (lambda () (m4 3)) (lambda (type info) (apply format #f info))))) ; error given above (m5 3) ; 5 = 3 + 2 from second f23 (m6 3))) ; 6 = 3 + 3 from third f23
关于 *#readers* 的主题，假设我们有：
(set! *#readers* (list (cons #\o (lambda (str) 42)) ; #o... -> 42 (cons #\x (lambda (str) 3)))) ; #x... -> 3现在我们加载一个文件：
(define (oct) #o123) (let-temporarily ((*#readers* ())) (eval (with-input-from-string "(define (hex) #x123)" read))) (define-constant old-readers *#readers*) (set! *#readers* ()) (define (oct1) #o123) (define (hex1) #x123) (set! *#readers* old-readers) (define (oct2) #o123) (define (hex2) #x123)现在我们求值这些函数，得到：
(oct): 42 ; oct is not read-time hygienic so #o123 -> 42 (oct1): 83 ; oct1 is protected by the top-level set, #o123 -> 83 (hex): 291 ; hex is protected by let-temporarily + read (hex1): 291 ; hex1 is like oct1 (hex2): 3 ; hex2 is like oct
这是 Peter Seibel 精彩的 once-only 宏：
(define-macro (once-only names . body) (let ((gensyms (map (lambda (n) (gensym)) names))) `(let (,@(map (lambda (g) (list g '(gensym))) gensyms)) `(let (,,@(map (lambda (g n) (list list g n)) gensyms names)) ,(let (,@(map list names gensyms)) ,@body)))))来自闪光 bacros 的世界：
(define once-only (let ((names (gensym)) (body (gensym))) (apply define-bacro `((,(gensym) ,names . ,body) `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names)) ,@,body)))))遗憾的是，with-let 更简单。
(setter proc) (dilambda proc setter)
有几种 setter，反映了 set! 可以被调用的多种方式。 首先是符号 setter：
> (let ((x 1))
(set! (setter 'x) (lambda (name new-value) (* new-value 2)))
(set! x 2)
x)
4
这里 setter 是一个在变量被设置之前调用的函数。
它可以接受两个或三个参数。在上面显示的两个参数情况下，
第一个是变量名（一个符号），第二个是新值。
变量被设置为 setter 函数返回的值。
当 s7 看到上面的 (set! x 2) 时，它调用返回 4 的 setter。
所以 x 被设置为 4。
在某些情况下你需要变量所在的环境（例如获取其当前值）， 所以你可以在 setter 函数参数列表中包含它：
> (let ((x 1))
(set! (setter 'x) (lambda (name new-value enviroment) (* new-value 2)))
(set! x 2)
x)
4
(define-macro (watch var) ; notification if 'var is set!
`(set! (setter ',var)
(lambda (s v e)
(format *stderr* "~S set! to ~S~A~%" s v
(let ((func (with-let e (*function*))))
(if (eq? func #<undefined>) "" (format #f ", ~S" func))))
v)))
由于符号 setter 通常实现类型限制，你可以使用 内置的类型检查函数如 integer? 作为要求新值为整数的 setter 的简写：
> (let ((x 1))
(set! (setter 'x) integer?)
(set! x 3.14))
error: set! x: 3.14, is a real but should be an integer
;;; use typed-let from stuff.scm to do the same thing:
> (typed-let ((x 3 integer?))
(set! x 3.14))
error: set! x: 3.14, is a real but should be an integer
;; see also typed-lambda in stuff.scm
C 端符号 setter 通过 s7_set_setter。下文有示例。
第二种情况是函数 setter。几乎任何函数或宏都可以 有一个关联的 setter，当该函数是 set! 的目标时被调用。 在这种情况下，setter 函数自己执行 set!（与符号 setter 不同）：
> (setter cadr)
#f ; by default cadr has no setter so (set! (cadr p) x) is an error
> (set! (setter cadr) ; add a setter to cadr
(lambda (lst val)
(set! (car (cdr lst)) val)))
#<lambda (lst val)>
> (procedure-source (setter cadr))
(lambda (lst val) (set! (car (cdr lst)) val))
> (let ((lst (list 1 2 3)))
(set! (cadr lst) 4)
lst)
(1 4 3)
在某些情况下，setter 需要是一个宏：
> (set! (setter logbit?)
(define-macro (m var index on) ; here we want to set "var", so we need a macro
`(if ,on
(set! ,var (logior ,var (ash 1 ,index)))
(set! ,var (logand ,var (lognot (ash 1 ,index)))))))
m
> (define (mingle a b)
(let ((r 0))
(do ((i 0 (+ i 1)))
((= i 31) r)
(set! (logbit? r (* 2 i)) (logbit? a i))
(set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
mingle
> (mingle 6 3) ; the INTERCAL mingle operator?
30
dilambda 定义一个函数（或 macro）及其 setter，无需手动 set! setter：
> (define f (let ((x 123))
(dilambda (lambda ()
x)
(lambda (new-value)
(set! x new-value)))))
f
> (f)
123 ; x = 123
> (set! (f) 32)
32 ; now x = 32
> (f)
32
下面是 dilambda 的一个漂亮示例：
(define-macro (c?r path)
;; "path" is a list and "X" marks the spot in it that we are trying to access
;; (a (b ((c X)))) — anything after the X is ignored, other symbols are just placeholders
;; c?r returns a dilambda that gets/sets X
(define (X-marks-the-spot accessor tree)
(if (eq? tree 'X)
accessor
(and (pair? tree)
(or (X-marks-the-spot (cons 'car accessor) (car tree))
(X-marks-the-spot (cons 'cdr accessor) (cdr tree))))))
(let ((body 'lst))
(for-each
(lambda (f)
(set! body (list f body)))
(reverse (X-marks-the-spot () path)))
`(dilambda
(lambda (lst)
,body)
(lambda (lst val)
(set! ,body val)))))
> ((c?r (a b (X))) '(1 2 (3 4) 5))
3
> (let ((lst (list 1 2 (list 3 4) 5)))
(set! ((c?r (a b (X))) lst) 32)
lst)
(1 2 (32 4) 5)
> (procedure-source (c?r (a b (X))))
(lambda (lst) (car (car (cdr (cdr lst)))))
> ((c?r (a b . X)) '(1 2 (3 4) 5))
((3 4) 5)
> (let ((lst (list 1 2 (list 3 4) 5)))
(set! ((c?r (a b . X)) lst) '(32))
lst)
(1 2 32)
> (procedure-source (c?r (a b . X)))
(lambda (lst) (cdr (cdr lst)))
> ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6))))))))))
6
> (let ((lst '(((((1 (2 (3 (4 (5 6)))))))))))
(set! ((c?r (((((a (b (c (d (e X)))))))))) lst) 32)
lst)
(((((1 (2 (3 (4 (5 32)))))))))
> (procedure-source (c?r (((((a (b (c (d (e X)))))))))))
(lambda (lst) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (car (car (car lst)))))))))))))))
我可能会在某天移除 dilambda 和 dilambda?；它们很平凡：
(define (dilambda get set) (set! (setter get) set) get) (define dilambda? setter)
当一个函数 setter 被调用时，(set! (func ...) val) 会被 s7
求值为 ((setter func) ... val)，因此 setter 函数需要同时处理
函数的内部参数和新值。
(let ((x 123)) (define (f a b) (+ x a b)) (set! (setter f) (lambda (a b val) (set! x val))) (display (f 1 2)) (newline) ; "126" (set! (f 1 2) 32) (display (f 1 2)) (newline)) ; "35"
第三种类型的 setter 处理向量元素类型以及哈希表的键和值类型。 相关内容在 类型化向量 和 类型化哈希表 中描述。
说到 INTERCAL，COME-FROM：
(define-macro (define-with-goto-and-come-from name-and-args . body) (let ((labels ()) (gotos ()) (come-froms ())) (let collect-jumps ((tree body)) (when (pair? tree) (when (pair? (car tree)) (case (caar tree) ((label) (set! labels (cons tree labels))) ((goto) (set! gotos (cons tree gotos))) ((come-from) (set! come-froms (cons tree come-froms))) (else (collect-jumps (car tree))))) (collect-jumps (cdr tree)))) (for-each (lambda (goto) (let* ((name (cadr (cadar goto))) (label (member name labels (lambda (a b) (eq? a (cadr (cadar b))))))) (if label (set-cdr! goto (car label)) (error 'bad-goto "can't find label: ~S" name)))) gotos) (for-each (lambda (from) (let* ((name (cadr (cadar from))) (label (member name labels (lambda (a b) (eq? a (cadr (cadar b))))))) (if label (set-cdr! (car label) from) (error 'bad-come-from "can't find label: ~S" name)))) come-froms) `(define ,name-and-args (let ((label (lambda (name) #f)) (goto (lambda (name) #f)) (come-from (lambda (name) #f))) ,@body))))
带有 setter 的过程可以看作是 set! 的一种广义化。另一种方式是将对象视为具有预定义的 get 和 set 函数。在 s7 中， 列表、字符串、向量、哈希表、环境以及任何协作的 C 或 Scheme 定义的对象都是可应用且可设置的。newLisp 称之为隐式索引，Kawa 也有此特性，Gauche 通过 object-apply 实现， Guile 通过 procedure-with-setter 实现；CL 的 funcallable instance 可能是相同的概念。
例如在 (vector-ref #(1 2) 0) 中，vector-ref 只是一个类型
声明。但在 Scheme 中，类型声明是不必要的，因此我们从 (#(1 2) 0) 得到完全
相同的结果。类似地，(lst 1) 与 (list-ref lst 1)
相同，(set! (lst 1) 2) 与
(list-set! lst 1 2) 相同。
我喜欢这种语法：噪音越少越好！
嗯，也许可应用的字符串看起来很奇怪：
("hi" 1)是 #\i，但更糟的是，(cond (1 => "hi"))也是！尽管字符串、列表或向量是"可应用的"，它 目前不被认为是过程，所以(procedure? "hi")是 #f。然而 map 和 for-each 接受任何 apply 能处理的东西，所以(map #(0 1) '(1 0))是 '(1 0)。（在这种情况下对 map 的第一次调用中，你得到(#(0 1) 1)的结果，依此类推）。 string->list、vector->list 和 let->list 就是(map values object)。 它们的逆操作（一直以来）同样简单。可应用对象语法使得编写泛型函数变得容易。 例如，s7test.scm 中有 Common Lisp 序列函数的实现。 length、copy、reverse、fill!、iterate、map 和 for-each 在此意义上是泛型的（map 始终返回列表）。
> (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4)) (5 -3 9) > (length "hi") 2这是一个泛型 FFT：
(define* (cfft data n (dir 1)) ; complex data (unless n (set! n (length data))) (do ((i 0 (+ i 1)) (j 0)) ((= i n)) (if (> j i) (let ((temp (data j))) (set! (data j) (data i)) (set! (data i) temp))) (do ((m (/ n 2) (/ m 2))) ((not (<= 2 m j)) (set! j (+ j m))) (set! j (- j m)))) (do ((ipow (floor (log n 2))) (prev 1) (lg 0 (+ lg 1)) (mmax 2 (* mmax 2)) (pow (/ n 2) (/ pow 2)) (theta (complex 0.0 (* pi dir)) (* theta 0.5))) ((= lg ipow)) (do ((wpc (exp theta)) (wc 1.0) (ii 0 (+ ii 1))) ((= ii prev) (set! prev mmax)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow) (set! wc (* wc wpc))) (let ((tc (* wc (data j)))) (set! (data j) (- (data i) tc)) (set! (data i) (+ (data i) tc)))))) data) > (cfft (list 0.0 1+i 0.0 0.0)) (1+1i -1+1i -1-1i 1-1i) > (cfft (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i)以及一个将一个序列的元素复制到另一个序列的泛型函数：
(define (copy-into source dest) ; this is equivalent to (copy source dest) (do ((i 0 (+ i 1))) ((= i (min (length source) (length dest))) dest) (set! (dest i) (source i))))但这已经作为 copy 函数的双参数版本内置了。
有一个地方 list-set! 等函数与 set! 不同：前者 会对第一个参数求值，但 set! 不会（有例外；见下文）：
> (let ((str "hi")) (string-set! (let () str) 1 #\a) str) "ha" > (let ((str "hi")) (set! (let () str) 1 #\a) str) ;((let () str) 1 #\a): too many arguments to set! > (let ((str "hi")) (set! ((let () str) 1) #\a) str) "ha" > (let ((str "hi")) (set! (str 1) #\a) str) "ha"set! 会查看其第一个参数来决定要设置什么。 如果它是符号，没问题。如果它是一个对，set! 会查看其 car 以确定它是否是 某个有 setter 的对象。如果 car 本身是一个列表，set! 会对内部表达式 求值，然后重试。所以上面第二种情况是唯一不工作的。 当然：
> (let ((x (list 1 2))) (set! ((((lambda () (list x))) 0) 0) 3) x) (3 2)据我统计，大约 20 个 Scheme 内置函数已经是泛型的，它们接受多种类型的参数 （撇开数值和类型检查函数，例如 equal?、display、 member、assoc、apply、eval、quasiquote 和 values）。s7 扩展了该列表，增加了 map、for-each、reverse 和 length，并添加了其他一些函数如 copy、fill!、sort!、object->string、object->let、vector-length 及相关函数和 append。 newLisp 采取了比 s7 更激进的方式：它扩展了诸如 '>' 等运算符 以比较字符串和列表以及数字。然而在 map 和 for-each 中，你可以混合使用不同类型的 参数，所以我对使 '>' 泛型化不太感兴趣；例如你不能
(> "hi" 32.1)， 甚至不能(> 1 0+i)。
s7 中一些非标准的泛型序列函数是：
(sort! sequence less?) (reverse! sequence) and (reverse sequence) (fill! sequence value (start 0) end) (copy obj) and (copy source destination (start 0) end) (object->string obj (write #t) (max-len (*s7* 'most-positive-fixnum))) (object->let obj) (length obj) (append . sequences) (map func . sequences) and (for-each func . sequences) (equivalent? obj1 obj2)
copy 返回其参数的（浅）副本。如果提供了目标， 它不必与源在大小或类型上匹配。起始和结束索引指的是源。
> (copy '(1 2 3 4) (make-list 2)) (1 2) > (copy #(1 2 3 4) (make-list 5) 1) ; start at 1 in the source (2 3 4 #f #f) > (copy "1234" (make-vector 2)) #(#\1 #\2) > (define lst (list 1 2 3 4 5)) (1 2 3 4 5) > (copy #(8 9) (cddr lst)) (8 9 5) > lst (1 2 8 9 5)
reverse! 是 reverse 的就地版本。也就是说，
它在反转内容的过程中修改传入的序列。
如果序列是一个列表，记住要使用 set!：
(set! p (reverse! p))。这与其他情况有些不一致，
但历史上，lisp 程序员一直将就地 reverse 视为快速
版本，因此 s7 也遵循了这一做法。
> (define lst (list 1 2 3)) (1 2 3) > (reverse! lst) (3 2 1) > lst (1)
撇开奇怪的列表情况不谈， append 返回与其第一个参数相同类型的序列。
> (append #(1 2) '(3 4)) #(1 2 3 4) > (append (float-vector) '(1 2) (byte-vector 3 4)) (float-vector 1.0 2.0 3.0 4.0)
sort! 使用作为第二个参数传入的函数对序列排序：
> (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (0 1 2 3 4 5 6 7 8 9)
sort! 调用 qsort 或 qsort_r；如果序列很大（超过 1024 个元素？），qsort_r 可能会分配一个内部数组； 如果比较函数引发错误，这个内部数组可能不会被释放。
这些函数底层是一些泛型迭代器，也是 s7 内置的：
(make-iterator sequence carrier) (iterator? obj) (iterate iterator) (iterator-sequence iterator) (iterator-at-end? iterator)
make-iterator 接受一个序列参数并返回一个迭代器对象，该对象在被调用时
遍历该序列。序列可以是列表、let、向量（任意类型）、字符串、哈希表、
或 c-object，或者是声明自身可迭代的函数或 macro（通过 +iterator+）。
make-iterator 返回的迭代器可以被视为无参数的函数，
或者（为了代码清晰）它可以作为 iterate 的参数，iterate 做同样的事情。
即 (iter) 与 (iterate iter) 相同。迭代器正在遍历的序列
是 iterator-sequence。
c-object 迭代器通过调用 c-object-ref (s7_c_type_set_ref) 进行迭代，直到
达到 c-object-length (s7_c_type_set_length)（用于数组遍历等）。
如果序列是哈希表或 let，迭代器通常返回键和值的 cons。 在许多情况下这种开销是不可接受的，因此 make-iterator 接受一个可选的 第二个参数 carrier，它应该是要使用的 cons。类似地， 对于 int、float 和 complex 向量，carrier 参数可以是 #t，这告诉 s7 使用正确类型的可变数。 在两种情况下，返回的 carrier 在所有迭代器调用中是相同的，所以 如果需要保存它，请复制 carrier 的值。
当迭代器到达其序列的末尾时，默认返回 #<eof>。 要更改此值，请设置 (*s7* 'iterator-at-end-value)。（如果新值可能被 GC 回收，你需要对其进行 GC 保护）。 如果列表上的迭代器发现其列表是循环的，它会返回 (*s7* 'iterator-at-end) 的值； map 和 for-each 使用 迭代器，所以如果你将循环列表传给其中任何一个，它最终会停止。（对方法编写者的一个 深奥提示：特化 make-iterator，而不是 map 或 for-each）。
(define (find-if f sequence)
(let ((iter (make-iterator sequence)))
(do ((x (iter) (iter)))
((or (iterator-at-end? iter)
(f x))
(and (not (iterator-at-end? iter))
x)))))
make-iterator 的参数也可以是函数或 macro。 在这种情况下，为了能被 iterate 接受，闭包（closure）的环境必须有一个 名为 '+iterator+' 的变量，且其值非 #f：
(define (make-circular-iterator obj)
(let ((iter (make-iterator obj)))
(make-iterator
(let ((+iterator+ #t))
(lambda ()
(case (iter)
((#<eof>) ((set! iter (make-iterator obj))))
(else)))))))
+iterator+ 变量类似于文档使用的 '+documentation+ 变量。 它给 make-iterator 一些机会来捕获无意中传入的虚假函数参数，否则 会导致无限循环。但不幸的是它可能逃逸并感染 其他函数：
(with-let (let ((+iterator+ #t))
(lambda () #<eof>)) ; we intended this to be our iterator
(concatenate vector (lambda a (copy a)))) ; from stuff.scm
;; (lambda a (copy a)) is also considered an iterator by map (in sequences->list) because
;; the local +iterator+ is #t. "a" is () because there are no further arguments to
;; concatenate, so (lambda a (copy a)) is generating infinitely many ()'s and this
;; code eventually dies with a heap overflow!
s7 支持 任意维度数的向量。正是在这里，广义 set! 尤其出色。make-vector 的第一个参数可以是维度列表，而 不是一维情况下的整数：
(make-vector (list 2 3 4)) (make-vector '(2 3) 1.0) (vector-dimensions (make-vector '(2 3 4))) -> (2 3 4)
第二个示例包含可选的初始元素。
(vect i ...) 或 (vector-ref vect i ...) 返回给定的
元素，(set! (vect i ...) value) 和 (vector-set! vect i ... value)
设置它。vector-length（或仅 length）返回元素总数。
vector-dimensions 返回维度列表；vector-rank 返回该列表的长度，
vector-dimension 返回列表的第 n 个成员（第 n 个维度的大小）。
> (define v (make-vector '(2 3) 1.0)) #2d((1.0 1.0 1.0) (1.0 1.0 1.0)) > (set! (v 0 1) 2.0) #2d((1.0 2.0 1.0) (1.0 1.0 1.0)) > (v 0 1) 2.0 > (vector-length v) 6
以下函数初始化多维向量的每个元素：
(define (make-array dims . inits) (subvector (apply vector (flatten inits)) 0 (apply * dims) dims)) > (make-array '(3 3) '(1 1 1) '(2 2 2) '(3 3 3)) #2d((1 1 1) (2 2 2) (3 3 3))
make-int-vector、make-float-vector、make-complex-vector 和 make-byte-vector 产生持有 s7_ints、s7_doubles、s7_complexs 或无符号字节的同构向量。
(make-vector length-or-list-of-dimensions initial-value element-type-function) (vector-dimensions vect) (vector-dimension vect n) (vector-rank obj) (vector-typer obj) (float-vector? obj) (float-vector . args) (make-float-vector len (init 0.0)) (float-vector-ref obj . indices) (float-vector-set! obj indices[...] value) (complex-vector? obj) (complex-vector . args) (make-complex-vector len (init 0.0)) (complex-vector-ref obj . indices) (complex-vector-set! obj indices[...] value) (int-vector? obj) (int-vector . args) (make-int-vector len (init 0)) (int-vector-ref obj . indices) (int-vector-set! obj indices[...] value) (byte-vector? obj) (byte-vector . args) (make-byte-vector len (init 0)) (byte-vector-ref obj . indices) (byte-vector-set! obj indices[...] byte) (byte? obj) (string->byte-vector str) (byte-vector->string str) (subvector vector start end dimensions) (subvector? obj) (subvector-vector obj) (subvector-position obj)
除了上面提到的维度列表外，make-vector 还接受 可选参数来指定初始元素和元素类型。如果 给出了类型，每次设置向量元素时都会先对新值调用 类型函数。 如果省略类型函数（或设为 #t）， 则不执行类型检查。 如果类型函数是一个 closure（而非 C 定义或内置函数）， 其名称必须可访问；不能是匿名 lambda（签名和 错误处理器需要这个名称）。vector-typer 返回或设置此类型函数； 通过 vector-typer 设置时，不会自动检查向量的当前内容 是否匹配该类型函数。
> (define v (make-vector 3 'x symbol?)) ; initial element: 'x, elements must be symbols #(x x x) > (vector-set! v 0 123) error: vector-set! argument 3, 123, is an integer but should be a symbol? > (define (10|12? val) (memv val '(10 12))) 10|12? > (define v1 (make-vector 3 10 10|12?)) ; only allow values 10 or 12 (initially 10) #(10 10 10) > (set! (v1 0) 12) 12 > v1 #(12 10 10) > (set! (v1 1) 32) error: vector-set! argument 3, 32, is an integer but should be a 10|12?
要以与原始向量不同的维度访问向量的元素，请使用
(subvector original-vector 0 (length original-vector) new-dimensions)：
> (let ((v1 #2d((1 2 3) (4 5 6))))
(let ((v2 (subvector v1))) ; flatten the original (1D is the default)
v2))
#(1 2 3 4 5 6)
> (let ((v1 #(1 2 3 4 5 6)))
(let ((v2 (subvector v1 0 6 '(3 2))))
v2))
#2d((1 2) (3 4) (5 6))
subvector 是另一个向量数据上的一个窗口。数据不会被复制，只是以不同的方式访问。 new-dimensions 参数是一个给出各维度长度的列表。start 和 end 参数指的是原始向量中的位置。 subvector-vector 返回 底层向量，subvector-position 返回 subvector 在底层数据中的起始位置。subvector 使得访问被视为矩阵的向量的行或列变得容易：
> (define V (vector 0 1 2 3 4 5 6 7 8 9 10 11))
#(0 1 2 3 4 5 6 7 8 9 10 11)
> (do ((i 0 (+ i 4))) ((= i 12)) (display (subvector V i (+ i 4))) (newline))
#(0 1 2 3)
#(4 5 6 7)
#(8 9 10 11)
> (do ((sV (subvector V 0 12 '(3 4))) (i 0 (+ i 1))) ((= i 4))
(display (vector (sV 0 i) (sV 1 i) (sV 2 i))) (newline))
#(0 4 8)
#(1 5 9)
#(2 6 10)
#(3 7 11)
矩阵乘法：
(define (matrix-multiply A B) ;; assume square matrices and so on for simplicity (let ((size (car (vector-dimensions A)))) (do ((C (make-vector (list size size) 0)) (i 0 (+ i 1))) ((= i size) C) (do ((j 0 (+ j 1))) ((= j size)) (do ((sum 0) (k 0 (+ k 1))) ((= k size) (set! (C i j) sum)) (set! sum (+ sum (* (A i k) (B k j)))))))))Conway 的生命游戏：
(define* (life (width 40) (height 40)) (let ((state0 (make-vector (list width height) 0)) (state1 (make-vector (list width height) 0))) ;; initialize with some random pattern (do ((x 0 (+ x 1))) ((= x width)) (do ((y 0 (+ y 1))) ((= y height)) (set! (state0 x y) (if (< (random 100) 15) 1 0)))) (do () () ;; show current state (using terminal escape sequences, borrowed from the Rosetta C code) (format *stderr* "~C[H" #\escape) ; ESC H = tab set (do ((y 0 (+ y 1))) ((= y height)) (do ((x 0 (+ x 1))) ((= x width)) (format *stderr* (if (zero? (state0 x y)) " " ; ESC 07m below = inverse (values "~C[07m ~C[m" #\escape #\escape)))) (format *stderr* "~C[E" #\escape)) ; ESC E = next line ;; get the next state (do ((x 1 (+ x 1))) ((= x (- width 1))) (do ((y 1 (+ y 1))) ((= y (- height 1))) (let ((n (+ (state0 (- x 1) (- y 1)) (state0 x (- y 1)) (state0 (+ x 1) (- y 1)) (state0 (- x 1) y) (state0 (+ x 1) y) (state0 (- x 1) (+ y 1)) (state0 x (+ y 1)) (state0 (+ x 1) (+ y 1))))) (set! (state1 x y) (if (or (= n 3) (and (= n 2) (not (zero? (state0 x y))))) 1 0))))) (copy state1 state0))))多维向量常量语法仿照 CL：#nd(...) 表示列表指定的是 'n' 维向量的元素：
#2d((1 2 3) (4 5 6))int-vector 常量使用 #i，float-vector 使用 #r，complex-vector 使用 #c。 在类型指示后附加 "nd" 部分：#i2d((1 2) (3 4))。此语法 与 r7rs byte-vector 记法 "#u8" 冲突；s7 对 byte-vector 使用 "#u"。"#u2d(...)" 是二维 byte-vector。 为了向后兼容，你可以对一维 byte-vector 使用 "#u8"。> (vector-ref #2d((1 2 3) (4 5 6)) 1 2) 6 > (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2))) #2d((-2 0) (2 -2)) > (int-vector 1 2 3) #i(1 2 3) > (make-float-vector '(2 3) 1.0) #r2d((1.0 1.0 1.0) (1.0 1.0 1.0)) > (vector (vector 1 2) (int-vector 1 2) (float-vector 1 2)) #(#(1 2) #i(1 2) #r(1.0 2.0))如果任何维度的长度为 0，你得到一个 n 维空向量。它不 等于一维空向量。
> (make-vector '(10 0 3)) #3d() > (equal? #() #3d()) #f为了节省昂贵的括号，并使编写泛型多维序列函数更容易， 你可以对列表使用相同的语法。
> (let ((L '((1 2 3) (4 5 6)))) (L 1 0)) ; same as (list-ref (list-ref L 1) 0) or ((L 1) 0) 4 > (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0 2) 32) ; same as (list-set! (list-ref (list-ref L 1) 0) 2 32) which is unreadable! L) (((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))或者使用向量的向量，当然：
> (let ((V #(#(1 2 3) #(4 5 6)))) (V 1 2)) ; same as (vector-ref (vector-ref V 1) 2) or ((V 1) 2) 6 > (let ((V #2d((1 2 3) (4 5 6)))) (V 0)) #(1 2 3)向量的向量与多维向量有一个区别： 在后一种情况下，你不能覆盖其中一个内部向量。
> (let ((V #(#(1 2 3) #(4 5 6)))) (set! (V 1) 32) V) #(#(1 2 3) 32) > (let ((V #2d((1 2 3) (4 5 6)))) (set! (V 1) 32) V) ;not enough arguments for vector-set!: (#2d((1 2 3) (4 5 6)) 1 32)使用列表来显示内部向量可能不是最优的，尤其是当元素也是列表时：
#2d(((0) (0) ((0))) ((0) 0 ((0))))"#()" 记法也好不了多少（元素可以是向量），而且我不喜欢 "[]" 括号。 也许我们可以使用不同的颜色？或者不同大小的括号？
#2D(((0) (0) ((0))) ((0) 0 ((0)))) #2D(((0) (0) ((0))) ((0) 0 ((0))))我不确定如何在多维情况下处理 vector->list 和 list->vector。 目前，vector->list 展平向量，而 list->vector 总是返回 一维向量，所以两者不是互逆的。
> (vector->list #2d((1 2) (3 4))) (1 2 3 4) ; should this be '((1 2) (3 4)) or '(#(1 2) #(3 4))? > (list->vector '(#(1 2) #(3 4))) ; what about '((1 2) (3 4))? #(#(1 2) #(3 4))这也影响 format 和 sort!：
> (format #f "~{~A~^ ~}" #2d((1 2) (3 4))) "1 2 3 4" > (sort! #2d((1 4) (3 2)) >) #2d((4 3) (2 1))也许 subvector 可以帮助：
>(subvector (list->vector '(1 2 3 4)) 0 4 '(2 2)) #2d((1 2) (3 4)) > (let ((a #2d((1 2) (3 4))) (b #2d((5 6) (7 8)))) (list (subvector (append a b) 0 8 '(2 4)) (subvector (append a b) 0 8 '(4 2)) (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(2 4)) (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(4 2)))) (#2d((1 2 3 4) (5 6 7 8)) #2d((1 2) (3 4) (5 6) (7 8)) #2d((1 2 5 6) (3 4 7 8)) #2d((1 2) (5 6) (3 4) (7 8)))另一个问题：我们是否应该在像
(#("abc" "def") 0 2)这样的情况下接受多索引语法？ 我最初的想法是索引应该都指向同一种 类型的对象，所以在这种混合情况下 s7 会报错。 如果我们能嵌套任何可应用对象并将整个东西应用于 任意的索引列表，就会产生歧义：((lambda (x) x) "hi" 0) ((lambda (x) (lambda (y) (+ x y))) 1 2)我认为这些应该报错说函数得到了太多参数， 但从隐式索引的角度来看，它们可以被解释为：
(string-ref ((lambda (x) x) "hi") 0) ; i.e. (((lambda (x) x) "hi") 0) (((lambda (x) (lambda (y) (+ x y))) 1) 2)加上可选参数和 rest 参数，你就无法分辨谁应该 接受哪些参数。 目前，你可以混合使用不同类型的隐式索引，但如果你隐式 调用序列中某个是函数的元素，而该函数不 被知为"安全的"（无问题的），你会得到一个错误。 要坚持所有对象都是同一类型，请使用显式的 getter：
> (list-ref (list 1 (list 2 3)) 1 0) ; same as ((list 1 (list 2 3)) 1 0) 2 > ((list 1 (vector 2 3)) 1 0) 2 > (list-ref (list 1 (vector 2 3)) 1 0) error: list-ref argument 1, #(2 3), is a vector but should be a proper list
每个哈希表跟踪它包含的键，在可能的情况下优化搜索。
任何 s7 对象都可以是键或键的值。
如果你传入的表大小不是 2 的幂，make-hash-table 会向上舍入到下一个 2 的幂。
表会根据需要增长。length 返回当前大小。
如果键不在表中，hash-table-ref 返回 #f。要移除一个键，
将其值设为 #f；要移除所有键，(fill! table #f)。
（此 #f 是 (*s7* 'hash-table-missing-key-value)；它可以被设置为其他值
如 #<undefined>：(set! (*s7* 'hash-table-missing-key-value) #<undefined>)。）
（如果新值可能被 GC 回收，你需要对其进行 GC 保护）。
> (let ((ht (make-hash-table)))
(set! (ht "hi") 123)
(ht "hi"))
123
hash-table（函数）与 vector、list 和 string 函数类似。
它的参数是
键和值：(hash-table 'a 1 'b 2)。
隐式索引提供了多级哈希：
> (let ((h (hash-table 'a (hash-table 'b 2 'c 3)))) (h 'a 'b)) 2 > (let ((h (hash-table 'a (hash-table 'b 2 'c 3)))) (set! (h 'a 'b) 4) (h 'a 'b)) 4
hash-code 类似于 Common Lisp 的 sxhash。它返回一个整数，在你实现自己的哈希表时可以与 s7 对象关联。s7test.scm 中有一个使用向量的示例。 在这种情况下 eqfunc 参数被忽略（hash-code 假设使用 equal?）。
由于哈希表接受与向量相同的可应用对象语法，我们可以 将哈希表视为，例如，稀疏数组：
> (define make-sparse-array make-hash-table) make-sparse-array > (let ((arr (make-sparse-array))) (set! (arr 1032) "1032") (set! (arr -23) "-23") (list (arr 1032) (arr -23))) ("1032" "-23")map 和 for-each 接受哈希表参数。每次迭代时，map 或 for-each 函数会被传入 一个条目
'(key . value)，顺序为在表中遇到条目的顺序。(define (hash-table->alist table) (map values table))reverse 哈希表返回一个键和值互换的新表。 fill! 设置所有的值。 两个哈希表如果具有相同的键和相同的值则相等。这与 表的大小或键/值对添加的顺序无关。
make-hash-table 的第二个参数 (eq-func) 稍微复杂。如果省略（或 #f）， s7 会根据哈希表中的键选择哈希相等性和映射函数。 有时你事先知道 想要的相等函数。如果它是 s7 内置的相等 函数之一——eq?、eqv?、equal?、equivalent?、=、string=?、string-ci=?、char=? 或 char-ci=?， 你可以将该函数作为第二个参数传入。在任何其他情况下，你需要 给 s7 同时提供相等函数和映射函数。后者接受任何对象 并返回其哈希表位置（一个整数）。这里的问题是， 为了使任意相等函数能够工作，根据该函数相等的对象 必须被映射到相同的哈希表位置。除了内置情况外，s7 无法推断 此映射应该是什么。所以要指定某个任意函数，第二个 参数是一个 cons：'(equality-checker mapper)。
这里有一个简短的例子。在 CLM 中，我们有 mus-generator 类型的 c-objects（从 s7 的角度来看）， 我们想使用 equal? 对其进行哈希（这将调用特定于生成器的相等函数）。 但 s7 不知道 mus-generator 类型涵盖了 40 或 50 个内部类型，所以作为 mapper 我们传入 mus-type：
(make-hash-table 64 (cons equal? mus-type))。如果哈希键是浮点数（非有理数），hash-table-ref 使用 equivalent?。 否则，例如，你可以使用 NaN 作为键，但然后永远无法访问它！
要使用 #h(...) 实现读取时哈希表：
(set! *#readers* (cons (cons #\h (lambda (str) (and (string=? str "h") ; #h(...) (apply hash-table (read))))) *#readers*)) (display #h(:a 1)) (newline) (display #h(:a 1 :b "str")) (newline)这些可以通过
(immutable! (apply...))设为不可变的，或者更好的是，(let ((h (apply hash-table (read)))) (if (> (*s7* 'safety) 1) (immutable! h) h))(define-macro (define-memoized name&arg . body) (let ((arg (cadr name&arg)) (memo (gensym "memo"))) `(define ,(car name&arg) (let ((,memo (make-hash-table))) (lambda (,arg) (or (,memo ,arg) ; check for saved value (set! (,memo ,arg) (begin ,@body)))))))) ; set! returns the new value > (define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) fib > (define-memoized (memo-fib n) (if (< n 2) n (+ (memo-fib (- n 1)) (memo-fib (- n 2))))) memo-fib > (time (fib 34)) ; un-memoized time 1.168 ; 0.70 on ccrma's i7-3930 machines > (time (memo-fib 34)) ; memoized time 3.200e-05 > (outlet (funclet memo-fib)) (inlet '{memo}-18 (hash-table '(0 . 0) '(1 . 1) '(2 . 1) '(3 . 2) '(4 . 3) '(5 . 5) '(6 . 8) '(7 . 13) '(8 . 21) '(9 . 34) '(10 . 55) '(11 . 89) '(12 . 144) '(13 . 233) '(14 . 377) '(15 . 610) '(16 . 987) '(17 . 1597) '(18 . 2584) '(19 . 4181) '(20 . 6765) '(21 . 10946) '(22 . 17711) '(23 . 28657) '(24 . 46368) '(25 . 75025) '(26 . 121393) '(27 . 196418) '(28 . 317811) '(29 . 514229) '(30 . 832040) '(31 . 1346269) '(32 . 2178309) '(33 . 3524578) '(34 . 5702887)))但 fib 的尾递归版本更简单，几乎和 memoized 版本一样快， 而迭代版本则超过了两者。
第三个参数 typers 设置表中键和值的类型检查器， 与 make-vector 的第三个参数类似。 它是类型函数的一个 cons， 例如
(cons symbol? integer?)。这表示所有键必须 是符号，所有值是整数。 hash-table-key-typer 和 hash-table-value-typer 返回或设置这些函数。> (define (10|12? val) (memv val '(10 12))) 10|12? > (define hash (make-hash-table 8 #f (cons #t 10|12?))) ; any key is ok, but all values must be 10 or 12 (hash-table) > (set! (hash 'a) 10) 10 > hash (hash-table 'a 10) > (set! (hash 'b) 32) error: hash-table-set! value argument 3, 32, is an integer but should be a 10|12?(define H (hash-table 'v1 1 'v2 2 'v3 3)) (let ((last-key #f)) (define (valtyp val) (or (not last-key) (eq? last-key 'v1) (and (eq? last-key 'v2) (integer? val) (<= 0 val 32)))) (define (keytyp key) (set! last-key key) #t) (set! (hash-table-key-typer H) keytyp) (set! (hash-table-value-typer H) valtyp)) ;; now (H 'v1) can be set to anything ;; (H 'v2) must be an integer between 0 and 32 ;; (H 'v3) is immutable (but setting it to #f will remove it from H) > (hash-table-set! H 'v1 11) 11 >(hash-table-set! H 'v2 12) 12 > (hash-table-set! H 'v3 13) error: hash-table-set! third argument 13, is an integer, but the hash-table's value type checker, valtyp, rejects it > (hash-table-set! H 'v2 112) error: hash-table-set! third argument 112, is an integer, but the hash-table's value type checker, valtyp, rejects it
环境持有符号及其值。例如，全局环境 持有所有在顶层定义的变量。 环境是 s7 中的一等（且可应用的）对象。 在许多情况下，下面描述中说 "env" 或 "let" 的地方，你实际上可以 传入一个 let（一个环境）或任何拥有自己 let 的对象。
(rootlet) 顶层（全局）环境 (curlet) 当前（最内层）环境 (funclet proc) proc 定义时的环境 (funclet? env) 如果 env 是 funclet 则为 #t (owlet) 最后一次错误时的环境 (unlet) 一个包含内置函数及其原始值的 let (let-ref env sym) 获取 env 中 sym 的值，与 (env sym) 相同 (let-set! env sym val) 将 env 中 sym 的值设为 val，与 (set! (env sym) val) 相同 (inlet . bindings) 用给定绑定创建新环境 (sublet env . bindings) 与 inlet 相同，但新环境是 env 的局部环境 (varlet env . bindings) 将新绑定直接添加到 env (cutlet env . fields) 从 env 移除绑定 (let? obj) 如果 obj 是环境则为 #t (with-let env . body) 在环境 env 中求值 body (outlet env) 包围环境 env 的环境（可设置） (let->list env) 将环境绑定作为 (symbol . value) cons 的列表返回 (openlet env) 将 env 标记为开放的（见下文） (openlet? env) 如果 env 是开放的则为 #t (coverlet env) 将 env 标记为封闭的（撤销先前的 openlet） (object->let obj) 返回一个包含 obj 信息的环境 (let-temporarily vars . body)
> (inlet 'a 1 'b 2) (inlet 'a 1 'b 2) > (let ((a 1) (b 2)) (curlet)) (inlet 'a 1 'b 2) > (let ((x (inlet :a 1 :b 2))) (x 'a)) 1 > (with-let (inlet 'a 1 'b 2) (+ a b)) 3 > (let ((x (inlet :a 1 :b 2))) (set! (x 'a) 4) x) (inlet 'a 4 'b 2) > (let ((x (inlet))) (varlet x 'a 1) x) (inlet 'a 1) > (let ((a 1)) (let ((b 2)) (outlet (curlet)))) (inlet 'a 1) > (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (e 'a 'b)) ; in C terms, e->a->b 1 > (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (set! (e 'a 'b) 3) (e 'a 'b)) 3 > (define* (make-let (a 1) (b 2)) (sublet (rootlet) (curlet))) make-let > (make-let :b 32) (inlet 'a 1 'b 32)
顾名思义，在 s7 中环境被视为脱离躯体的 let。如果两个环境 包含相同的符号和相同的值（忽略遮蔽，并考虑到 到 rootlet 的环境链），则它们相等。也就是说，如果两个环境中任何一个的局部变量在两者中都有相同的值，则它们相等。
let-ref 和 let-set! 在第一个参数未在 环境或其父环境中定义时返回 #<undefined>。要仅搜索给定的环境（忽略其 outlet 链）， 请在调用 let-ref 或 let-set! 之前使用 defined? 并将第三个参数设为 #t：
> (defined? 'car (inlet 'a 1) #t) #f > (defined? 'car (inlet 'a 1)) #t
这在 let-set! 中很重要：(let-set! (inlet 'a 1) 'car #f)
与 (set! car #f) 相同！
with-let 在给定环境中对其 body 求值，因此
(with-let e . body) 等价于
(eval `(begin ,@body) e)，但可能更快。
类似地，(let bindings . body) 等价于
(eval `(begin ,@body) (apply inlet (flatten bindings)))，
忽略外层（包围的）环境（inlet 的默认外层环境
是 rootlet）。
或者更好的是，
(define-macro (with-environs e . body) `(apply let (map (lambda (a) (list (car a) (cdr a))) ,e) '(,@body)))
或者反过来，
(define-macro (Let vars . body)
`(with-let (sublet (curlet)
,@(map (lambda (var)
(values (symbol->keyword (car var)) (cadr var)))
vars))
,@body))
(Let ((c 4))
(Let ((a 2)
(b (+ c 2)))
(+ a b c)))
使用 (biglet 'a-function) 比 (with-let biglet a-function) 更快。
let-temporarily 与其他 Scheme 中的 fluid-let 类似。 它的语法看起来像 let，但它先保存当前值，然后通过 set! 将变量设置为新值， 调用 body，最后恢复原始值。它可以处理任何可设置的东西：
(let-temporarily (((*s7* 'print-length) 8)) (display x))
这在显示 x 时将 s7 的 print-length 变量设为 8，然后 恢复为其原始值。
> (define ourlet
(let ((x 1))
(define (a-func) x)
(define b-func (let ((y 1))
(lambda ()
(+ x y))))
(curlet)))
(inlet 'x 1 'a-func a-func 'b-func b-func)
> (ourlet 'x)
1
> (let-temporarily (((ourlet 'x) 2))
((ourlet 'a-func)))
2
> ((funclet (ourlet 'b-func)) 'y)
1
> (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3))
((ourlet 'b-func)))
4
尽管名称如此，let-temporarily 不会创建新环境：
(let () (let-temporarily () (define x 2)) (+ x 1)) 是 3。
此外，如果相关变量有 setter，该 setter 会被
调用两次（一次设置新值，一次恢复旧值）。
sublet 用传入的绑定创建一个新的 let，然后将新环境的 outlet 设为 'env' 参数。 这类似于在另一个 let 内部的 let 形式。
> (sublet (curlet) 'b 2) (inlet 'b 2) > (let ((a 1)) (with-let (sublet (curlet) 'b 2) (+ a b))) 3
要直接将绑定添加到环境中， 请使用 varlet。 两者都接受除了第一个参数之外的环境以及单独的绑定， 将所有参数的绑定添加到新环境中。 inlet 非常相似，但通常省略环境参数。 sublet 和 inlet 的参数可以作为 符号/值对传递，作为 cons 传递，或使用关键字（如同在 define* 中）。 inlet 也可以用来复制环境而不会意外调用 该环境的 copy 方法。
要使用 #let(...) 实现读取时 let：
(set! *#readers*
(cons (cons #\l (lambda (str)
(and (string=? str "let") ; #let(...)
(apply inlet (read)))))
*#readers*))
(display #let(:a 1)) (newline)
(display #let(:a 1 :b "str")) (newline)
下面是 varlet 的一个例子：我们要定义两个共享 局部变量的函数：
(varlet (curlet) ; import f1 and f2 into the current environment
(let ((x 1)) ; x is our local variable
(define (f1 a) (+ a x))
(define (f2 b) (* b x))
(inlet 'f1 f1 'f2 f2))) ; export f1 and f2
为单个环境槽添加读取器和写入器函数的一种方式是：
(define e (inlet
'x (let ((local-x 3)) ; x's initial value
(dilambda
(lambda () local-x)
(lambda (val) (set! local-x (max 0 (min val 100))))))))
> ((e 'x))
3
> (set! ((e 'x)) 123)
100
funclet 返回函数的局部环境。下面是一个 保存对该函数调用的循环缓冲区的例子：
(define func (let ((history (let ((lst (make-list 8 #f))) (set-cdr! (list-tail lst 7) lst)))) (lambda (x y) (let ((result (+ x y))) (set-car! history (list result x y)) (set! history (cdr history)) result)))) > (func 1 2) 3 > (func 3 4) 7 > ((funclet func) 'history) #1=(#f #f #f #f #f #f (3 1 2) (7 3 4) . #1#)
在 Scheme 中可以重新定义内置函数如 car。
要确保某些代码看到原始的内置函数定义，
请将其包装在 (with-let (unlet) ...) 中：
> (let ((caar 123))
(+ caar (with-let (unlet)
(caar '((2) 3)))))
125
或者也许更好，保持当前环境不变，只替换 更改的内置函数：
> (let ((x 1)
(display 3))
(with-let (sublet (curlet) (unlet)) ; (curlet) picks up 'x, (unlet) the original 'display
(display x)))
1
with-let 和 unlet 是常量，因此你可以在任何上下文中
使用它们而不用担心它们是否被重新定义。
如宏（macro）部分所述，#_<name> 是
(with-let (unlet) <name>) 的内置读取器宏，
所以例如，#_+ 是内置的 + 函数，无论如何。
（unlet 访问的内置函数的环境
无法从 scheme 代码访问，因此那些值
不可能被破坏）。
cutlet 从环境中移除绑定。如果该环境是
函数 outlet 链的一部分，你可能会得到段错误。
例如，不要 (cutlet (outlet (funclet func) 'x))
其中 func 在其 body 中引用了 x。类似地，不要搞乱
函数的 outlet 链（通过 (set! (outlet...))），然后还
期望该函数做合理的事情。（我可能会在某天移除 cutlet）。
我认为这些函数可以实现库、 独立命名空间或模块的概念。 一种方式是：首先库作者只需编写他的库。 普通用户只需加载它。异常用户担心一切， 所以他首先在局部 let 中加载库以确保没有绑定逃逸 污染他的代码，然后他 使用 unlet 确保他的绑定不会污染库代码：
(let ()
(with-let (unlet)
(load "any-library.scm" (curlet))
;; by default load puts stuff in the global environment
...))
现在异常用户可以用库实体做他想做的。 假设他想用名称 "bitwise-not-or" 使用 "lognor"，而 所有其他函数都不感兴趣：
(varlet (curlet)
'bitwise-not-or (with-let (unlet)
(load "any-library.scm" (curlet))
lognor)) ; lognor is presumably defined in "any-library.scm"
假设他想确保库被干净地加载，但所有 顶层绑定都导入到当前环境中：
(varlet (curlet)
(with-let (unlet)
(let ()
(load "any-library.scm" (curlet))
(curlet)))) ; these are the bindings introduced by loading the library
要做同样的事，但在每个名称前加 "library:"：
(apply varlet (curlet)
(with-let (unlet)
(let ()
(load "any-library.scm" (curlet))
(map (lambda (binding)
(cons (symbol "library:" (symbol->string (car binding)))
(cdr binding)))
(curlet)))))
就这样！以下是相同想法作为宏的版本：
(define-macro (let! init end . body)
;; syntax mimics 'do: (let! (vars&values) ((exported-names) result) body)
;; (let! ((a 1)) ((hiho)) (define (hiho x) (+ a x)))
`(let ,init
,@body
(varlet (outlet (curlet))
,@(map (lambda (export)
`(cons ',export ,export))
(car end)))
,@(cdr end)))
嗯，差不多了，真糟糕。如果加载的库文件通过 set! 设置了一个全局值 如 abs，我们需要将其恢复为原始形式：
(define (safe-load file)
(let ((e (with-let (unlet) ; save the environment before loading
(let->list (curlet)))))
(load file (curlet))
(let ((new-e (with-let (unlet) ; get the environment after loading
(let->list (curlet)))))
(for-each ; see if any built-in functions were stepped on
(lambda (sym)
(unless (assoc (car sym) e)
(format () "~S clobbered ~A~%" file (car sym))
(apply set! (car sym) (list (cdr sym)))))
new-e))))
;; say libtest.scm has the line (set! abs odd?)
> (safe-load "libtest.scm")
"libtest.scm" clobbered abs
> (abs -2)
2
openlet 将其参数——环境、闭包（closure）、c-object 或 c-pointer——标记为开放的；coverlet 标记为封闭的。我需要更好的术语！一个开放对象是 s7 内置函数会特别处理的对象。如果它们在参数列表中遇到一个开放对象，它们会在该对象中查找自己的名称，如果存在则调用该函数。一个基本示例：
> (abs (openlet (inlet 'abs (lambda (x) 47)))) 47 > (define* (f1 (a 1)) (if (real? a) (abs a) ((a 'f1) a))) f1 > (f1 :a (openlet (inlet 'f1 (lambda (e) 47)))) 47
在 CLOS 中，我们需要声明一个类和一个方法，然后调用 make-instance， 然后发现它反正也不会工作。 这里我们实际上有一个匿名类的匿名实例。 我认为这被称为"原型系统"；javascript 显然是类似的。 一个稍微复杂的示例：
(let* ((e1 (openlet
(inlet
'x 3
'* (lambda args
(apply * (if (number? (car args))
(values (car args) ((cadr args) 'x) (cddr args))
(values ((car args) 'x) (cdr args))))))))
(e2 (copy e1)))
(set! (e2 'x) 4)
(* 2 e1 e2)) ; (* 2 3 4) => 24
也许这些名称会更好：openlet -> with-methods，coverlet -> without-methods， openlet? -> methods?。如果被替换函数的签名与 新函数不匹配，你可能会遇到优化器问题，特别是如果替换的是 for-each、map、member 或 assoc。
let-ref 和 let-set! 作为方法是有问题的。很容易陷入无限 循环，特别是 let-ref，因为方法 body 中对 let 的任何引用可能 会调用 let-ref，从而调用 let-ref 方法。我们过去推荐在这里使用 coverlet，但 即使那也不够，所以现在 let-ref 和 let-set! 是不可变的；它们不能被用作 方法。 如果可能的话，请改用 let-ref-fallback 和 let-set-fallback。
object->let 返回一个环境（更像字典）包含 其参数的详细信息。它旨在作为调试辅助工具，例如支持调试器的"检查"功能。
> (let ((iter (make-iterator "1234")))
(iter)
(iter)
(object->let iter))
(inlet 'value #<iterator: string> 'type iterator? 'at-end #f 'sequence "1234" 'length 4 'position 2)
c-object（在 s7_make_c_type 的意义上）可以通过其局部环境中的 object->let
方法将自己的信息添加到此命名空间。snd-marks.c 有一个使用类范围环境 (g_mark_methods) 的简单示例，
其 'object->let 字段的值是函数 s7_mark_to_let。后者使用 s7_varlet 将
信息添加到 (object->let mark) 创建的命名空间中。
(define-macro (value->symbol expr)
`(let ((val ,expr)
(e1 (curlet)))
(call-with-exit
(lambda (return)
(do ((e e1 (outlet e))) ()
(for-each
(lambda (slot)
(if (equal? val (cdr slot))
(return (car slot))))
e)
(if (eq? e (rootlet))
(return #f)))))))
> (let ((a 1) (b "hi"))
(value->symbol "hi"))
b
openlet 通知 s7 的其余部分该环境有方法。
(begin
(define fvector? #f)
(define make-fvector #f)
(let ((type (gensym))
(->float (lambda (x)
(if (real? x)
(* x 1.0)
(error 'wrong-type-arg "fvector new value is not a real: ~A" x)))))
(set! make-fvector
(lambda* (len (init 0.0))
(openlet
(inlet :v (make-vector len (->float init))
:type type
:length (lambda (f) len)
:object->string (lambda (f . args) "#<fvector>")
:let-set! (lambda (fv i val) (#_vector-set! (fv 'v) i (->float val)))
:let-ref-fallback (lambda (fv i) (#_vector-ref (fv 'v) i))))))
(set! fvector? (lambda (p)
(and (let? p)
(eq? (p 'type) type)))))
> (define fv (make-fvector 32))
fv
> fv
#<fvector>
> (length fv)
32
> (set! (fv 0) 123)
123.0
> (fv 0)
123.0
通常，每个 let 的 outlet 链都回到 rootlet。如果我们想 创建一个打破该链的 let，可以使用 let-ref-fallback：
(define lt (openlet (inlet 'a 1 'let-ref-fallback #<undefined>))) > (lt 'abs) #<undefined>
let-ref-fallback 可以是常量（最有用的是 #<undefined>）或 接受两个参数（let 和符号）的函数。
如果 s7 函数忽略参数的类型，例如 cons 或 vector， 那么该参数不会被视为拥有任何方法。
由于 outlet 是可设置的，有两种方式使环境变得
循环。一种是将当前环境作为其某个变量的值包含。
另一种是：(let () (set! (outlet (curlet)) (curlet)))。
如果你想在不预先知道字段名称的任何 s7 部分面前隐藏环境的字段，
(openlet ; make it appear to be empty to the rest of s7
(inlet 'object->string (lambda args "#<let>")
'map (lambda args ())
'for-each (lambda args #<unspecified>)
'let->list (lambda args ())
'length (lambda args 0)
'copy (lambda args (inlet))
'open #t
'coverlet (lambda (e) (set! (e 'open) #f) e)
'openlet (lambda (e) (set! (e 'open) #t) e)
'openlet? (lambda (e) (e 'open))
;; your secret data here
))
（仍然至少有两种方式可以察觉到有些不对劲）。
下面是为闭包（closure）添加方法的一种方式：
(define sf (openlet (let ((object->string (lambda (obj . arg)
"#<secret function!>")))
(lambda (x)
(+ x 1)))))
> sf
#<secret function!>
在 s7 中，多值被直接拼接到调用者的参数列表中。
> (+ (values 1 2 3) 4)
10
> (string-ref ((lambda () (values "abcd" 2))))
#\c
> ((lambda (a b) (+ a b)) ((lambda () (values 1 2))))
3
> (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) ; call/cc has an implicit "values"
10
> ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3))
(3 2)
(define-macro (call-with-values producer consumer)
`(,consumer (,producer)))
(define-macro (multiple-value-bind vars expr . body)
`((lambda ,vars ,@body) ,expr))
(define-macro (define-values vars expression)
`(if (not (null? ',vars))
(varlet (curlet) ((lambda ,vars (curlet)) ,expression))))
(define (curry function . args)
(if (null? args)
function
(lambda more-args
(if (null? more-args)
(apply function args)
(function (apply values args) (apply values more-args))))))
multiple-values（多值）在多种场景下很有用。例如，
(if test (+ a b c) (+ a b d e))可以写成(+ a b (if test c (values d e)))。 multiple-values 有一些特殊的用途。 首先，你可以使用 values 函数从 map 的函数应用中返回任意数量的值，包括 0 个：> (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3)) (1 20 3 60) > (map values (list 1 2 3) (list 4 5 6)) (1 4 2 5 3 6) (define (remove-if func lst) (map (lambda (x) (if (func x) (values) x)) lst)) (define (pick-mappings func lst) (map (lambda (x) (or (func x) (values))) lst)) (define (shuffle . args) (apply map values args)) > (shuffle '(1 2 3) #(4 5 6) '(7 8 9)) (1 4 7 2 5 8 3 6 9) (define (concatenate . args) (apply append (map (lambda (arg) (map values arg)) args)))其次，macro（宏）可以返回多个值；这些值会被求值并拼接，与普通宏的处理方式完全一样， 所以你可以使用
(values '(define a 1) '(define b 2))在宏调用处拼接多个定义。 如果展开返回 (values)，则不会拼接任何内容。这主要在 reader-cond 和 #; reader 中有用， 但不幸的是，使用起来比较棘手。reader 只知道在遇到时全局定义的内容， 而局部定义的展开会被当作普通宏处理，所以：> (define-expansion (comment str) (values)) ; this must be at the top-level comment > (+ 1 (comment "one") 2 (comment "two")) 3在顶层（REPL 中），由于没有可以拼接的目标，你只是简单地取回你的值：
> (values 1 (list 1 2) (+ 3 4 5)) (values 1 (1 2) 12)但这个打印输出只是为了提供信息。s7 中没有 multiple-values 对象。 例如，你不能
(set! x (values 1 2))。values 函数 告诉 s7 其参数应以特殊方式处理，而 multiple-value 标记会在参数被拼接到某个调用者的参数中时消失。有两个用于多值的辅助函数，apply-values 和 list-values， 两者主要面向 quasiquote，其中 (apply-values ...) 实现了其他 scheme 中称为 unquote-splicing (",@...") 的功能。 (apply-values lst) 类似于 (apply values lst)， 而 (list-values ...) 类似于 (list ...)，但有一个特殊情况。在编写宏时， 常常需要创建某些代码片段拼接到输出中，但如果该代码为空，则生成的 宏代码应该不包含任何内容（而非 nil）。apply-values 和 list-values 与 quasiquote 协作来实现这一点。例如：
> (list-values 1 2 (apply-values) 3) (1 2 3) > (define (supply . args) (apply-values args)) supply > (define (consume f . args) (apply f (apply list-values args))) consume > (consume + (supply 1 2) (supply 3 4 5) (supply)) 15 > (consume + (supply)) 0让 (values) 返回"无"而不是 #<unspecified> 可能看起来更简单， 但这有缺点。首先，
(abs -1 (values))，或者更糟的(abs (f x) (f y))在程序文本层面不再是错误；你失去了快速判断一个 普通函数参数数量是否正确的能力。其次，大量代码目前假定 (values) 返回 #<unspecified>，这意味着(apply values ())也是如此。 但如果((lambda* ((x 1)) x) (values))能返回 1 就好了！由于 set! 不会对其第一个参数求值，而且 "values" 没有 setter，
(set! (values x) ...)不等同于(set! x ...)。(string-set! (values string) ...)可以工作，因为 string-set! 会对其第一个参数求值。((values + 1 2) (values 3 4) 5)是 15，如任何人所预期。这种处理多值方式的一个问题涉及无法判断一个表达式是否会返回多值的情况。 例如，你有
(let ((val (expr)))...)然后需要接受来自expr的一个普通单值，或者可能的多值集合中的一个成员。 在 lint.scm 中，我目前用 lambda 来处理：(let ((val ((lambda args (car args)) (expr))))...)，但这感觉很笨拙。 CL 有 nth-value，看起来在这种情境下做了"正确的事情"；也许 s7 也需要它。类似的困难出现在
(if (expr) ...)中，其中(expr)可能 返回多值。CL（至少 sbcl）将其视为被包裹在(nth-value 0 (expr))中。 另一方面，将值拼接进去可能导致灾难：将无法从代码中判断 if 语句是否有效，或者会执行哪个分支！因此，在那些语法形式对其 参数求值的情况下，s7 遵循 CL 的做法，只使用值中的第一个（这影响 if、when、unless、cond 和 case）。s7 的签名（signature）可以指示函数返回多值：call-with-exit 的签名是 '(values procedure?)。 也许我们可以通过 '((values integer? integer?)...) 来指示这些值的数量和预期类型； 这是函数的"稀有度"吗？
call-with-exit 是没有跳回原始上下文能力的 call/cc， 类似于 C 中的 "return"。这比 call/cc 更简洁，而且快得多。
(define-macro (block . body)
;; borrowed loosely from CL — predefine "return" as an escape
`(call-with-exit (lambda (return) ,@body)))
(define-macro (while test . body) ; while loop with predefined break and continue
`(call-with-exit
(lambda (break)
(let continue ()
(if (let () ,test)
(begin
(let () ,@body)
(continue))
(break))))))
(define-macro (switch selector . clauses) ; C-style case (branches fall through unless break called)
`(call-with-exit
(lambda (break)
(case ,selector
,@(do ((clause clauses (cdr clause))
(new-clauses ()))
((null? clause) (reverse new-clauses))
(set! new-clauses (cons `(,(caar clause)
,@(cdar clause)
,@(map (lambda (nc)
(apply values (cdr nc))) ; doubly spliced!
(if (pair? clause) (cdr clause) ())))
new-clauses)))))))
(define (and-for-each func . args)
;; apply func to the first member of each arg, stopping if it returns #f
(call-with-exit
(lambda (quit)
(apply for-each (lambda arglist
(if (not (apply func arglist))
(quit #<unspecified>)))
args))))
(define (find-if f . args) ; generic position-if is very similar
(call-with-exit
(lambda (return)
(apply for-each (lambda main-args
(if (apply f main-args)
(apply return main-args)))
args))))
> (find-if even? #(1 3 5 2))
2
> (* (find-if > #(1 3 5 2) '(2 2 2 3)))
6
call-with-exit 函数的参数（"continuation"）仅在 call-with-exit 函数内部有效。 在 call/cc 中，你可以保存它，然后稍后调用它以跳回，但如果你用 call-with-exit 尝试这样做（从 call-with-exit 函数体外部），你会得到一个错误。 这类似于尝试从已关闭的输入端口读取。goto-active? 在 goto 或 continuation 当前可调用时返回 #t。
可以这么说，call-with-exit 的另一面是 with-baffle。 有时我们需要普通的 call/cc，但想确保它仅在给定的代码块内有效。 通常，如果一个 continuation 逃逸了，就无法知道它什么时候可能对我们造成破坏。 with-baffle 阻止了这一点——没有 continuation 可以跳入其主体：
(let ((what's-for-breakfast ())
(bad-dog 'fido)) ; bad-dog wonders what's for breakfast?
(with-baffle ; the syntax is (with-baffle . body)
(set! what's-for-breakfast
(call/cc
(lambda (biscuit?)
(set! bad-dog biscuit?) ; bad-dog smells a biscuit!
'biscuit!))))
(if (eq? what's-for-breakfast 'biscuit!)
(bad-dog 'biscuit!)) ; now, outside the baffled block, bad-dog wants that biscuit!
what's-for-breakfast) ; but s7 says "No!": baffled! ("continuation can't jump into with-baffle")
continuation? 如果其参数是 continuation 则返回 #t， 与普通过程相对。我不知道为什么 Scheme 从一开始就没有这个函数， 但如果你想编写一个可继续的错误处理程序，它是必需的。 以下是该场景的概要：
(catch #t
(lambda ()
(let ((res (call/cc
(lambda (ok)
(error 'cerror "an error" ok)))))
(display res) (newline)))
(lambda args
(when (and (eq? (car args) 'cerror)
(continuation? (cadadr args)))
(display "continuing...")
((cadadr args) 2))
(display "oops")))
在更一般的情况下，错误处理程序与 catch 主体是分开的， 需要一种方式来区分真正的 continuation 和普通的过程。
(define (continuable-error . args)
(call/cc
(lambda (continue)
(apply error args))))
(define (continue-from-error)
(if (continuation? ((owlet) 'continue)) ; might be #<undefined> or a function as in the while macro
(((owlet) 'continue))
'bummer))
(object->string obj (write #t) (max-len (*s7* 'most-positive-fixnum))) (format output-choice control-string . arguments)
object->string 返回其第一个参数的字符串表示。其可选的第二个参数 可以是 #f 或 :display（使用 display），#t 或 :write（默认，使用 write），或 :readable。在后一种情况下，object->string 尝试生成一个可以通过 eval-string 求值以返回与原始对象相等的对象的字符串。可选的第三个参数设置期望的最大字符串长度；如果 object->string 发现已超过此限制，则返回部分字符串。
> (object->string "hiho") "\"hiho\"" > (format #f "~S" "hiho") "\"hiho\""
s7 的 format 函数非常接近 CL 和 srfi-48 中的实现。
> (format #f "~A ~D ~F" 'hi 123 3.14) "hi 123 3.140000"
format 指令（波浪号字符）如下：
~% insert newline
~& insert newline if preceding char was not newline
~~ insert tilde
~\n (tilde followed by newline): trim white space
~{ begin iteration (take arguments from a list, string, vector, or any other applicable object)
~} end iteration
~^ ~| jump out of iteration
~* ignore the current argument
~C print character (numeric argument = how many times to print it)
~P insert 's' if current argument is not 1 or 1.0 (use ~@P for "ies" or "y")
~A object->string as in display
~S object->string as in write
~B number->string in base 2
~O number->string in base 8
~D number->string in base 10 (~:D for ordinal)
~X number->string in base 16
~E float to string, (format #f "~E" 100.1) -> "1.001000e+02", (%e in C)
~F float to string, (format #f "~F" 100.1) -> "100.100000", (%f in C)
~G float to string, (format #f "~G" 100.1) -> "100.1", (%g in C)
~T insert spaces (padding)
~N get numeric argument from argument list (similar to ~V in CL)
~W object->string with :readable (write readably: "serialization"; s7 is the intended reader)
~N 之前的八个指令接受通常的数值参数来指定字段宽度和精度。 这些也可以是 ~N 或 ~n，在这种情况下数值参数从参数列表中读取：
(format #f "~ND" 20 1234) ; => (format "~20D" 1234) " 1234"
(format #f ...) 简单地返回格式化后的字符串；(format #t ...)
还会将字符串发送到 current-output-port。(format () ...) 将输出发送到
current-output-port 但不返回字符串（这模仿了其他 IO 例程
如 display 和 newline）。其他内置的端口选择是 *stdout* 和 *stderr*。
浮点数可以在任何进制中出现，所以：
> #xf.c 15.75这也影响 format。在大多数 Scheme 实现中，
(format #f "~X" 1.25)是 一个错误。在 CL 中，它等同于使用 ~A，这是不合理的。但> (number->string 1.25 16) "1.4"而且没有明显的方法从 format 获得相同的效果，除非我们在 "~X" 情况下接受 浮点数。所以在 s7 中，
> (format #f "~X" 21) "15" > (format #f "~X" 1.25) "1.4" > (format #f "~X" 1.25+i) "1.4+1.0i" > (format #f "~X" 21/4) "15/4"也就是说，输出选择与参数匹配。Guile 邮件列表中出现的一个例子是：
(format #f "~F" 1/3)。s7 目前返回 "1/3"，但 Clisp 返回 "0.33333334"。花括号指令适用于任何可以 map 遍历的对象，不仅仅是列表：
> (format #f "~{~C~^ ~}" "hiho") "h i h o" > (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test")) "h i h o...t e s t" > (with-input-from-string (format #f "(~{~C~^ ~})" (format #f "~B" 1367)) read) ; integer->list (1 0 1 0 1 0 1 0 1 1 1)由于任何序列都可以传递给 ~{~}，我们需要一种方式来截断输出并用 "..." 表示序列的其余部分， 但 ~^ 只在序列末尾停止。~| 类似于 ~^，但它还会在处理完 (*s7* 'print-length) 个元素后停止并打印 "..."。所以，
(format #f "~{~A~| ~}" #(0 1 2 3 4))返回 "0 1 2 ..." 如果 (*s7* 'print-length) 为 3。
我在决定包含 format 之前就把 object->string 加入了 s7。format 引起了一种 模糊的不安——为什么我们需要这个古老的、非 lisp 风格的东西？ 我们几乎可以用以下方式替代它：
(define (objects->string . objects) (apply string-append (map (lambda (obj) (object->string obj #f)) objects)))但如何处理列表（format 中的 ~{...~}），或者列化输出（~T）？ 我怀疑格式化字符串输出在 REPL 之外是否仍然重要。即使在那个上下文中， 现代 GUI 将格式化决策留给文本或表格小部件。
(define-macro (string->objects str . objs) `(with-input-from-string ,str (lambda () ,@(map (lambda (obj) `(set! ,obj (eval (read)))) objs))))format 是一团糟。它试图将两个不同的选择塞入其第一个（"端口"）参数。 也许应该把它拆分为 format->string 和 format->port。format->string 没有 端口参数并返回字符串。format->port 写入其端口参数（必须是输出端口， 而非布尔值），并返回空字符串。那么：
(format #f ...) -> (format->string ...) (format () ...) -> (format->port (current-output-port) ...) (format #t ...) -> (display (format->string ...)) (format port ...) -> (display (format->string ...) port)以及当前不可用的选择，直接写入端口而不创建字符串：
(format->port port ...)。
(make-hook . fields) ; make a new hook (hook-functions hook) ; the hook's list of 'body' functions
hook 是由 make-hook 创建的函数，通常在发生某些有趣事件时从 C 调用。 在 GUI 工具包中，hook 被称为回调列表（callback-list），在 CL 中称为 condition， 在其他上下文中称为监视点（watchpoint）或信号（signal）。s7 本身有几个 hook：*error-hook*、*read-error-hook*、 *unbound-variable-hook*、*missing-close-paren-hook*、*rootlet-redefinition-hook*、 *load-hook* 和 *autoload-hook*。 make-hook 的定义如下：
(define (make-hook . args)
(let ((body ()))
(apply lambda* args
'(let ((result #<unspecified>))
(let ((e (curlet)))
(for-each (lambda (f) (f e)) body)
result))
())))
所以调用 make-hook 的结果是一个函数（上面应用于 args 的 lambda*）， 它包含一个函数列表 'body。 该列表中的每个函数接受一个参数，即 hook。 每次 hook 本身被调用时，body 中的每个函数都会被调用，并返回 'result 的值。 该变量以及 hook 的每个参数都可以通过传递给内部函数的环境被 hook 的内部函数访问。这有点迂回； 以下是概要：
> (define h (make-hook '(a 32) 'b)) ; h is a function: (lambda* ((a 32) b) ...)
h
> (set! (hook-functions h) ; this sets ((funclet h) 'body)
(list (lambda (hook) ; each hook internal function takes one argument, the environment
(set! (hook 'result) ; this is the "result" variable above
(format #f "a: ~S, b: ~S" (hook 'a) (hook 'b))))))
(#<lambda (hook)>)
> (h 1 2) ; this calls the hook's internal functions (just one in this case)
"a: 1, b: 2" ; we set "result" to this string, so it is returned as the hook application result
> (h)
"a: 32, b: #f"
在 C 中，创建一个 hook：
hook = s7_eval_c_string("(make-hook '(a 32) 'b)");
s7_gc_protect(s7, hook);
并调用它：
result = s7_call(s7, hook, s7_list(s7, 2, s7_make_integer(s7, 1), s7_make_integer(s7, 2)));
(define-macro (hook . body) ; return a new hook with "body" as its body, setting "result"
`(let ((h (make-hook)))
(set! (hook-functions h) (list (lambda (h) (set! (h 'result) (begin ,@body)))))
h))
(documentation obj) (signature obj) (setter obj) (arity obj) (aritable? obj num-args) (funclet proc) (procedure-source proc) (procedure-arglist proc)
funclet 返回过程的环境。
> (funclet (let ((b 32)) (lambda (a) (+ a b)))) (inlet 'b 32) > (funclet abs) (rootlet)
setter 返回或设置与过程关联的 setter 函数（例如 car 的 setter 是 set-car!）。
procedure-source 返回过程的源码（一个列表）：
(define (procedure-arglist f) (cadr (procedure-source f)))
procedure-arglist 返回过程的参数列表。 这里的"过程"指的是在 s7 中定义的函数和宏，而非内置过程。
documentation 返回与过程关联的文档字符串。这通常通过函数环境中的 '+documentation+ 变量提供。如果你愿意， 也可以将函数体中的初始字符串视为文档。
(define func
(let ((+documentation+ "helpful info"))
(lambda (a) a)))
> (documentation func)
"helpful info"
(define (cl-func)
"this is documentation"
123)
> (documentation cl-func)
"this is documentation"
由于 documentation 是一个方法，函数的文档可以在运行时计算：
(define func
(let ((documentation (lambda (f) (format #f "this is func's funclet: ~S" (funclet f)))))
(lambda (x)
(+ x 1))))
> (documentation func)
"this is func's funclet: (inlet 'x ())"
arity 接受任何对象，如果该对象不可应用则返回 #f，否则返回一个 cons，包含可接受的最小和最大参数数量。如果报告的最大值是一个非常大的数字，意味着接受任意数量的参数。 aritable? 接受两个参数，一个对象和一个整数，如果该对象可以应用于那么多参数则返回 #t。（对于 define* 及其相关形式，键值对被视为一个参数）。
> (define* (add-2 a (b 32)) (+ a b)) add-2 > (procedure-source add-2) (lambda* (a (b 32)) (+ a b)) > (arity add-2) (0 . 2) > (aritable? add-2 1) #t > (aritable? add-2 2) #t > (aritable? add-2 3) ; we can call (add-2 1 :b 2), but #f ; as mentioned above, the key+value pair is one argument
signature 是一个描述函数参数类型和返回值类型的列表。列表中的第一项是返回类型，其余是 参数类型。#t 表示任何类型都可能，'values 表示函数返回多值。
> (signature round) (integer? real?) ; round takes a real argument, returns an integer > (signature vector-ref) (#t vector? . #1=(integer? . #1#)) ; trailing args are all integers (indices)
如果一个条目是列表，则可以出现列表中的任何类型：
> (signature char-position) ((boolean? integer?) (char? string?) string? integer?)
这表示 char-position 的第一个参数可以是字符串或字符， 返回类型可以是布尔值或整数。要指定返回多值时的类型，使用 (values type1 ..)。所以函数：
(define (f int) (case ((0) (values 0 1)) ((1) ((values 'a 1)) (else 0))))
可以声明其签名为
(((values integer? integer?) (values symbol? integer?) integer?) integer?)
;; or would it be better to omit the 'values and just have a list of types?
如果函数在 scheme 中定义，其签名是其 closure 中 '+signature+ 变量的值：
> (define f1 (let ((+documentation+ "helpful info")
(+signature+ '(boolean? real?)))
(lambda (x)
(positive? x))))
f1
> (documentation f1)
"helpful info"
> (signature f1)
(boolean? real?)
我们可以使用方法做同样的事情：
> (define f1 (let ((documentation (lambda (f) "helpful info"))
(signature (lambda (f) '(boolean? real?))))
(openlet ; openlet alerts s7 that f1 has methods
(lambda (x)
(positive? x)))))
> (documentation f1)
"helpful info"
> (signature f1)
(boolean? real?)
signature 也可用于实现 CL 的 'the：
(define-macro (the value-type form)
`((let ((+signature+ (list ,value-type)))
(lambda ()
,form))))
(display (+ 1 (the integer? (+ 2 3))))
但优化器目前不知道如何利用这种模式。
你显然可以添加自己的方法：
(define my-add
(let ((tester (lambda ()
(if (not (= (my-add 2 3) 5))
(format #t "oops: (myadd 2 3) -> ~A~%"
(my-add 2 3))))))
(lambda (x y)
(- x y))))
(define (auto-test) ; scan the symbol table for procedures with testers
(let ((st (symbol-table)))
(for-each (lambda (f)
(let* ((fv (and (defined? f)
(symbol->value f)))
(testf (and (procedure? fv)
((funclet fv) 'tester))))
(when (procedure? testf) ; found one!
(testf))))
st)))
> (auto-test)
oops: (myadd 2 3) -> -1
甚至 setter 也可以这样设置：
(define flocals
(let ((x 1))
(let ((+setter+ (lambda (val) (set! x val))))
(lambda ()
x))))
> (flocals)
1
> (setter flocals)
#<lambda (val)>
> (set! (flocals) 32)
32
> (flocals)
32
(define (for-each-subset func args) ;; form each subset of args, apply func to the subsets that fit its arity (let subset ((source args) (dest ()) (len 0)) (if (null? source) (if (aritable? func len) ; does this subset fit? (apply func dest)) (begin (subset (cdr source) (cons (car source) dest) (+ len 1)) (subset (cdr source) dest len)))))
eval 对其参数（表示一段代码的列表）求值。它接受一个可选的 第二个参数，即求值应该在其中进行的环境。eval-string 类似，但其参数是一个字符串。
> (eval '(+ 1 2)) 3 > (eval-string "(+ 1 2)") 3
除了少数特殊情况，eval-string 可以这样定义：
(define-macro* (eval-string x e) `(eval (with-input-from-string ,x read) (or ,e (curlet))))
除了文件，端口还可以表示字符串和函数。字符串端口函数 如下：
(with-output-to-string thunk) ; open a string port as current-output-port, call thunk, return string (with-input-from-string string thunk) ; open string as current-input-port, call thunk (call-with-output-string proc) ; open a string port, apply proc to it, return string (call-with-input-string string proc) ; open string as current-input-port, apply proc to it (open-output-string) ; open a string output port (get-output-string port clear) ; return output accumulated in the string output port (open-input-string string) ; open a string input port reading string (open-input-function function) ; open a function input port (open-output-function function) ; open a function output port
> (let ((result #f)
(p (open-output-string)))
(format p "this ~A ~C test ~D" "is" #\a 3)
(set! result (get-output-string p))
(close-output-port p)
result)
"this is a test 3"
在 get-output-string 中，如果可选的 'clear' 参数为 #t，则端口被清除（我认为在 r7rs 中是默认的）。 其他函数：
read-byte and write-byte ; binary IO, also read-bytes and write-bytes read-line ; line-at-a-time reads, optional second argument #t to include the newline read-string current-error-port and set-current-error-port port-filename port-line-number port-position ; input port, settable port-string ; string port data, settable port-file ; file port FILE* pointer
使用 length 获取输入端口文件或字符串的字节长度。 port-line-number 是可设置的（用于高级 *#readers*）。 port-position 是读取器在端口中的字节位置。它是可设置的。 port-string 是字符串端口的字符串内容。它也是可设置的。 port-file 用于与 *libc* 库配合使用。它返回一个包含与文件端口关联的 FILE* 指针的 c-pointer（Windows 除外）：
(call-with-input-file "s7test.scm"
(lambda (p)
(with-let (sublet *libc* :file (port-file p))
(fseek file 1000 SEEK_SET))))
变量 (*s7* 'print-length) 设置了 object->string 和 format 打印序列元素数量的上限。
read-bytes 和 write-bytes 处理字节（或其他数字）序列。
(read-bytes port n (destination-vector #f)) 从端口读取 n 个元素，
将其写入目标向量，或者如果未提供目标向量，则写入它创建的 byte-vector。
它返回该向量。目标向量可以是任何数值向量（float-vector 等）。
读取的字节数取决于目标向量的类型。如果你想将 read-bytes 与字符串一起使用，
请先通过 string->byte-vector 将字符串转换为 byte-vector。
类似地，(write-bytes port v n) 将向量 'v' 的 'n' 个元素写入给定端口。
'n' 默认为 'v' 的元素长度。'v' 可以是任何数值类型的向量。在以下
示例中，我们将向量的混合写入端口，然后读回：
(let ((port (open-output-file "test.data")))
(let ((zv (complex-vector 1+i 2+2i 3+3i 4+4i))
(iv (int-vector 1 2 3))
(bv (byte-vector 4 5 6 7 8))
(fv (float-vector 10.0 11.0 12.0)))
(write-bytes port bv 4)
(write-bytes port fv 3)
(write-bytes port iv 2)
(write-bytes port zv 4)
(close-output-port port)
(set! port (open-input-file "test.data"))
(let* ((bv (read-bytes port 4))
(fv (read-bytes port 3 (make-float-vector 3)))
(iv (read-bytes port 2 (make-int-vector 2)))
(zv (read-bytes port 4 (make-complex-vector 4))))
(format *stderr* "~S ~S ~S ~S~%" bv fv iv zv)
(close-input-port port))))
输出为：#u(4 5 6 7) #r(10.0 11.0 12.0) #i(1 2) #c(1.0+1.0i 2.0+2.0i 3.0+3.0i 4.0+4.0i)。
在 GUI 后面运行 s7 时，你通常希望输入来自和输出去往任意小部件。函数端口提供了一种在 C 中重定向 IO 的方式。参见 redirect display
获取示例。
函数端口调用函数而不是将数据读写到字符串或文件。
参见 nrepl.scm 和 s7test.scm 获取示例。函数端口的函数可通过
((object->let function-port) 'function) 访问。这些端口甚至比
它们的 C 端对应物更难懂。一个捕获 current-output-port 输出的示例：
(let* ((str ())
(stdout-wrapper (open-output-function
(lambda (c)
(set! str (cons c str))))))
(let-temporarily (((current-output-port) stdout-wrapper))
(write-char #\a)
...))
文件结束对象是 #<eof>。 当 read 函数遇到常量 #<eof> 时，它返回 #<eof>。 这既不矛盾也不异常：read 返回一个表单或 #<eof>。如果 read 遇到一个包含 #<eof> 的表单，它返回一个 包含 #<eof> 的表单，就像处理任何其他常量一样。
> (with-input-from-string "(or x #<eof>)" read) (or x #<eof>) > (eof-object? (with-input-from-string "'#<eof>" read)) #f如果 read 在读取表单时到达输入末尾，它会引发错误（例如"缺少右括号"）。 如果它在顶层遇到单独的 #<eof>（这永远不会发生）， 它返回该 #<eof>。但这仅针对 read，不针对（例如）load：
;; say we have "t234.scm" with: (display "line 1") (newline) #<eof> (display "line 2") (newline) ;; end of t234.scm > (load "t234.scm") line 1 line 2 (with-input-from-file "t234.scm" (lambda () (do ((c (read) (read))) ((eof-object? c)) (eval c)))) line 1内置 #<eof> 有很多用途，据我所见，没有缺点。例如， 在循环中调用 read（或其相关函数）是很常见的，循环首先检查 #<eof>，然后进入 一个 case 语句。在 s7 中，我们可以省去额外的 if（和 let），并将 #<eof> 包含在 case 语句中：
(case (read-char) ((#<eof>) (quit-reading)) ((#\a)...))。 另一个例子：(or (eof-object? x) (eqv x 24)...)可以写成：(memv x '(#<eof> 24 ...)。 （我在网上看到的所有关于 #<eof> 或其等价物的讨论都混淆了事物本身（文件结束指示）和它的名称（#<eof>）。默认的 IO 端口是 *stdin*、*stdout* 和 *stderr*。 *stderr* 在你想确保输出立即刷新时很有用。 默认输出端口是 *stdout*，它会缓冲输出直到看到换行符。
环境可以被当作 IO 端口使用，提供 Guile 所称的"软端口"：
(define (call-with-input-vector v proc) (let ((i -1)) (proc (openlet (inlet 'read (lambda (p) (v (set! i (+ i 1)))))))))这里 IO 端口是一个开放的环境，它重新定义了 "read" 函数，使其返回向量的下一个元素。参见 stuff.scm 中的 call-with-output-vector。 上面的 "proc" 参数也可以是一个宏，给你一种笨拙的方式来绕过愚蠢的 "lambda"。以下是更多有用的示例：
(openlet ; a soft port for format that sends its output to *stderr* and returns the string (inlet 'format (lambda (port str . args) (apply format *stderr* str args)))) (define (open-output-log name) ;; return a soft output port that does not hold its output file open (define (logit name str) (let ((p (open-output-file name "a"))) (display str p) (close-output-port p))) (openlet (inlet :name name :format (lambda (p str . args) (logit (p 'name) (apply format #f str args))) :write (lambda (obj p) (logit (p 'name) (object->string obj #t))) :display (lambda (obj p) (logit (p 'name) (object->string obj #f))) :write-string (lambda (str p) (logit (p 'name) str)) :write-char (lambda (ch p) (logit (p 'name) (string ch))) :newline (lambda (p) (logit (p 'name) (string #\newline))) :output-port? (lambda (p) #t) :close-output-port (lambda (p) #f) :flush-output-port (lambda (p) #f)))) (let ((p (open-output-log "logit.data"))) (format p "this is a test~%") (format p "line: ~A~%" 2))Snd 包中的 binary-io.scm 有各种大小和两种字节序选择的整数和浮点数读写函数。
如果编译时开关 WITH_SYSTEM_EXTRAS 为 1，则会内置几个额外的操作系统相关和 文件相关函数。这是进行中的工作；目前此开关添加了：
(directory? str) ; return #t if str is the name of a directory (file-exists? str) ; return #t if str names an existing file (delete-file str) ; try to delete the file, return 0 is successful, else -1 (getenv var) ; return the value of an environment variable: (getenv "HOME") (directory->list dir) ; return contents of directory as a list of strings (if HAVE_DIRENT_H) (system command) ; execute command, if optional second arg is #t output is returned as a string
但也许这不是必需的；参见下面的 cload.scm 了解 一种更直接的方法。
(error tag . info) ; signal an error of type tag with addition information (catch tag body err) ; if error of type tag signalled in body (a thunk), call err with tag and info (throw tag . info) ; jump to corresponding catch
s7 的错误处理模仿了 Guile 的方式。错误通过 error 函数发出信号， 并可以通过 catch 捕获和处理。
> (catch 'wrong-number-of-args
(lambda () ; code protected by the catch
(abs 1 2))
(lambda args ; the error handler
(apply format #t (cadr args))))
"abs: too many arguments: (1 2)"
> (catch 'division-by-zero
(lambda () (/ 1.0 0.0))
(lambda args (string->number "+inf.0")))
+inf.0
(define-macro (catch-all . body)
`(catch #t (lambda () ,@body) (lambda args args)))
catch 有 3 个参数：一个标签，指示要捕获什么错误（#t = 任何）； catch 保护的代码（一个 thunk）；以及在 thunk 求值期间如果发生匹配错误时要调用的函数。 标签通过 eq? 与错误类型匹配。 错误处理程序接受一个 rest 参数，其中将包含 error 函数选择传递的任何内容。 error 函数本身至少接受 2 个参数：错误类型（一个符号）和错误消息。还可能有其他描述错误的参数。 默认动作（在没有任何 catch 的情况下）是将消息视为 格式控制字符串，对其和其他参数应用 format，并将信息发送到 current-error-port：
(catch #t
(lambda ()
(error 'oops))
(lambda args
(format (current-error-port) "~A: ~A~%~A[~A]:~%~A~%"
(car args) ; the error type
(apply format #f (cadr args)) ; the error info
(port-filename) (port-line-number); error file location
(stacktrace)))) ; and a stacktrace
通常在读取文件时，我们必须检查 #<eof>，但我们可以让 s7 来做：
(define (copy-file infile outfile) (call-with-input-file infile (lambda (in) (call-with-output-file outfile (lambda (out) (catch 'wrong-type-arg ; s7 raises this error if write-char gets #<eof> (lambda () (do () () ; read/write until #<eof> (write-char (read-char in) out))) (lambda err outfile))))))catch 不限于错误处理：
(define (map-with-exit func . args) ;; map, but if early exit taken, return the accumulated partial result ;; func takes escape thunk, then args (let* ((result ()) (escape-tag (gensym)) (escape (lambda () (throw escape-tag)))) (catch escape-tag (lambda () (let ((len (apply max (map length args)))) (do ((ctr 0 (+ ctr 1))) ((= ctr len) (reverse result)) ; return the full result if no throw (let ((val (apply func escape (map (lambda (x) (x ctr)) args)))) (set! result (cons val result)))))) (lambda args (reverse result))))) ; if we catch escape-tag, return the partial result (define (truncate-if func lst) (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst)) > (truncate-if even? #(1 3 5 -1 4 6 7 8)) (1 3 5 -1)但这不如 map 有用（例如它不能 map 遍历 hash-table）， 而且基本上是在重新实现内置代码。也许 s7 应该有一个 扩展的 map（更有用的是 for-each），其模式模仿 dynamic-wind：
(dynamic-for-each init-func main-func end-func . args)，其中 init-func 接受一个参数，即最短序列参数的长度（for-each 和 map 预先知道这个）；main-func 接受 n 个参数，n 匹配 传递的序列数量；即使 main-func 跳出也会调用 end-func（在这方面类似 dynamic-wind）。在 dynamic-map 情况下，end-func 接受一个参数，即当前可能的部分结果列表。dynamic-for-each 可以轻松地（但也许不是高效地）实现通用函数，如 ->list、->vector 和 ->string（将任何序列转换为某种其他类型的序列）。 map-with-exit 将是(define (map-with-exit func . args) (let ((result ())) (call-with-exit (lambda (quit) (apply dynamic-map #f ; no init-func in this case (lambda main-args (apply func quit main-args)) (lambda (res) (set! result res)) args))) result))由于所有的 lambda 样板代码，嵌套的 catch 很难阅读：
(catch #t (lambda () (catch 'division-by-zero (lambda () (catch 'wrong-type-arg (lambda () (abs -1)) (lambda args (format () "got a bad arg~%") -1))) (lambda args 0))) (lambda args 123))也许我们需要一个宏：
(define-macro (catch-case clauses . body) (let ((base (cons 'lambda (cons () body)))) (for-each (lambda (clause) (let ((tag (car clause))) (set! base `(lambda () (catch ',(or (eq? tag 'else) tag) ,base ,@(cdr clause)))))) clauses) (caddr base))) ;;; the code above becomes: (catch-case ((wrong-type-arg (lambda args (format () "got a bad arg~%") -1)) (division-by-zero (lambda args 0)) (else (lambda args 123))) (abs -1))这类似于 r7rs scheme 的 "guard"，但我不想要一个无意义的 thunk 作为 catch 的主体。 同样的思路：
(define (catch-if test func err) (catch #t func (lambda args (apply (if (test (car args)) err throw) args)))) ; if not caught, re-raise the error via throw (define (catch-member lst func err) (catch-if (lambda (tag) (member tag lst)) func err)) (define-macro (catch* clauses . error) ;; try each clause until one evaluates without error, else error: ;; (macroexpand (catch* ((+ 1 2) (- 3 4)) 'error)) ;; (catch #t (lambda () (+ 1 2)) (lambda args (catch #t (lambda () (- 3 4)) (lambda args 'error)))) (define (builder lst) (if (null? lst) (apply values error) `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst)))))) (builder clauses))
当遇到错误时，以及当 s7 通过 begin_hook 被中断时， (owlet) 返回一个包含有关该错误的附加信息的环境：
error-history 字段取决于编译器标志 WITH_HISTORY。参见 stuff.scm 中的 ow! 了解 显示这些数据的一种方式。*s7* 字段 'history-size 设置缓冲区大小。
要在错误发生处查找变量的值：
((owlet) var)。 要从错误向外列出所有局部绑定：(do ((e (outlet (owlet)) (outlet e))) ((eq? e (rootlet))) (format () "~{~A ~}~%" e))要查看当前的 s7 栈，
(stacktrace)。 要在错误环境中求值错误处理程序：(let ((x 1)) (catch #t (lambda () (let ((y 2)) (error 'oops))) (lambda args (with-let (sublet (owlet) :args args) ; add the error handler args (list args x y))))) ; we have access to 'y'要限制栈的最大大小，设置 (*s7* 'max-stack-size)。
hook *error-hook* 提供了一种专门化错误报告的方式。 其参数名为 'type 和 'data。在没有 catch 时会被调用。
(set! (hook-functions *error-hook*)
(list (lambda (hook)
(apply format *stderr* (hook 'data))
(newline *stderr*))))
*read-error-hook* 为 reader 提供两个钩子。 读取为其他 Scheme 编写的代码时的一个主要问题是，每个 Scheme 提供了大量特有的 #-name（甚至特殊字符名称）， 以及字符串常量中的 \\ 转义。*read-error-hook* 提供了一种处理这些特殊情况的方式。如果遇到 s7 无法处理的 #-name， *read-error-hook* 以两个参数被调用：#t 和表示常量的字符串。如果你设置了 (hook 'result)，该结果会返回给 reader。 否则会引发 'read-error 并进入错误处理程序。 类似地，如果发生某些奇怪的 \\ 用法，*read-error-hook* 以两个参数被调用： #f 和有问题的字符。如果你返回一个字符，它被传递给 reader； 否则你会得到一个错误。lint.scm 有一个示例。
*rootlet-redefinition-hook* 在 顶层变量被重新定义时调用（通过 define 及其相关形式，而非 set!）。
(set! (hook-functions *rootlet-redefinition-hook*)
(list (lambda (hook)
(format *stderr* "~A ~A~%" (hook 'name) (hook 'value)))))
将打印变量名和新值。
s7 内置的 catch 标签有 'wrong-type-arg、'syntax-error、'read-error、'unbound-variable、 'out-of-memory、'wrong-number-of-args、'format-error、'out-of-range、'division-by-zero、'io-error 和 'bignum-error。
如果 s7 遇到一个未绑定的变量，它首先查看是否有任何关于它的 autoload 信息。 此信息可以通过 autoload 声明，一个接受两个参数的函数：触发 autoload 的符号， 以及一个文件名或函数。如果是文件名，s7 加载该文件；如果是函数，则以一个参数（当前调用环境）调用它。
(autoload 'channel-distance "dsp.scm") ;; now if we subsequently call channel-distance but forget to load "dsp.scm" first, ;; s7 loads "dsp.scm" itself, and uses its definition of channel-distance. ;; The C-side equivalent is s7_autoload. ;; here is the cload.scm case, loading j0 from the math library if it is called: (autoload 'j0 (lambda (e) (unless (provided? 'cload.scm) (load "cload.scm")) (c-define '(double j0 (double)) "" "math.h") (varlet e 'j0 j0)))
保存 autoload 信息的实体（可能是 hash-table 或环境）名为 *autoload*。 如果在检查 autoload 后符号仍然未绑定，s7 调用 *unbound-variable-hook*。 有问题的符号在 hook 环境中名为 'variable。 如果在运行 *unbound-variable-hook* 后符号仍然未绑定， s7 调用错误处理程序。
自动加载器了解用作库的 s7 环境，所以，例如，
你可以 (autoload 'j0 "libm.scm")，然后在 scheme 代码中使用 j0。s7 第一次
遇到 j0 时，j0 是未定义的，所以 s7 加载 libm.scm。该 load 返回 C 数学库作为环境 *libm*。
s7 然后自动在 *libm* 中查找 j0，并为你定义它。
所以结果与你在 C 代码中自己定义 j0 相同。
你可以在这里使用 r7rs 库机制，或者 with-let，
或者任何你想要的！（在 Snd 中，libc、libm、libdl 和 libgdbm 通过 autoload 自动绑定到 s7，
所以如果你调用，例如，frexp，libm.scm 被加载，frexp 从 *libm* 环境中导出，然后
求值器继续运行，就像 frexp 一直在 s7 中定义一样）。
你还可以通过 (varlet (curlet) *libgsl*) 将（比如说）gsl 的所有内容导入当前环境。
define-constant 定义一个其值始终相同的符号（在当前词法作用域内）， constant? 如果其参数是常量则返回 #t， immutable! 声明一个序列为不可变的（其元素不能被更改），而 immutable? 如果其参数是不可变的则返回 #t。
> (define v (immutable! (vector 1 2 3))) #(1 2 3) > (vector-set! v 0 23) error: can't vector-set! #(1 2 3) (it is immutable) > (immutable? v) #t > (define-constant var 32) var > (set! var 1) ;set!: can't alter immutable object: var > (let ((var 1)) var) ;can't bind or set an immutable object: var, line 1
要使特定 let 中的绑定不可变，将符号（引用的）作为第一个参数传递， let 作为第二个参数。如果第一个参数是列表，则整个列表被设置为不可变。 要仅将列表的前 n 个成员设置为不可变，将 n 作为第二个参数传递。
这里有一个复杂情况。(immutable! let) 关闭了 let，意味着
你不能向 let 添加局部变量或删除局部变量。你仍然可以 set! 局部变量。要使
局部变量本身不可变：
(define (vars-immutable! L)
(with-let L
(for-each (lambda (f)
(immutable! (car f)))
(curlet)))
L)
现在 (vars-immutable! let) 使 set! 任何局部变量成为错误，但你
可以向 let 添加局部变量。
你可以通过这样做来加速求值，因为它告诉优化器 let 中的当前条目不会改变。
要完全固化 let，(immutable! (vars-immutable! let))。
要使函数的文档不可变：(with-let (funclet 'f2) (immutable! '+documentation+))，
其他函数 closure 条目类似。
immutable! 阻止从对象外部的更改（通过 string-set! 等），但不影响内部更改，所以它对 迭代器、端口、random-state 对象、c-object 或用作迭代器的函数没有影响。如果 (*s7* 'safety) 大于 0（无安全性），当 immutable! 使用一个忽略它的参数被调用时，s7 会引发警告。
define-constant 阻止任何 set! 或遮蔽常量的尝试（当然是在词法层面）， 所以局部常量的行为如你所预期：
> (let () (define-constant x 3) (let ((x 32)) x)) error: can't bind an immutable object: ((x 32)) > (let ((x 3)) (set! x (let () (define-constant x 32) x))) ; outer x is not a constant 32
但要注意延迟绑定：
> (define (func a) (let ((cvar (+ a 1))) cvar))
func
> (define-constant cvar 23) ; cvar is now globally constant so it can't be shadowed
23
> (func 1) ; here we're trying to shadow cvar
error: can't bind an immutable object: ((cvar (+ a 1)))
> (let ((x 1))
(define z (let ()
(define-constant x 3)
(lambda (y)
(let ((x y)) ; this x is the inner constant x
x))))
(z 1)) ; so this is an error even though the outer x is not a constant
error: can't bind an immutable object: ((x y))
函数也可以是常量。在某些情况下，优化器可以利用此信息来加速函数调用。
常量与关键字（不能设置，总是返回自身作为值）、 变量追踪（设置时调用信息函数或保持历史值）、类型化变量（限制变量的值或在设置时进行自动转换）， 以及设置时通知（在 Scheme 或 C 中；我多年前在 Snd 中就想有这个）等非常相似。通知函数在你有一个 Scheme 变量并想立即将其值的任何更改反映到 C 中时特别有用（参见 notification in C）。 在 s7 中，setter 设置此函数。
每个环境是一组符号及其关联的值。setter 在给定环境中将一个函数（或宏）放置在符号 和其值之间。setter 函数接受两个参数，符号和新值，并返回实际设置的值。 如果 setter 函数接受第三个参数，当前（相对于符号的）环境也会被传递（奇怪的参数顺序是历史遗留）。
(define e ; save environment for use below
(let ((x 3) ; will always be an integer
(y 3) ; will always keep its initial value
(z 3)) ; will report set!
(set! (setter 'x) (lambda (s v) (if (integer? v) v x)))
(set! (setter 'y) (lambda (s v) y))
(set! (setter 'z) (lambda (s v) (format *stderr* "z ~A -> ~A~%" z v) v))
(set! x 3.3) ; x does not change because 3.3 is not an integer
(set! y 3.3) ; y does not change
(set! z 3.3) ; prints "z 3 -> 3.3"
(curlet)))
> e
(inlet 'x 3 'y 3 'z 3.3)
>(begin (set! (e 'x) 123) (set! (e 'y) #()) (set! (e 'z) #f))
;; prints "z 3.3 -> #f"
> e
(inlet 'x 123 'y 3 'z #f)
> (define-macro (reflective-let vars . body)
`(let ,vars
,@(map (lambda (vr)
`(set! (setter ',(car vr))
(lambda (s v)
(format *stderr* "~S -> ~S~%" s v)
v)))
vars)
,@body))
reflective-let
> (reflective-let ((a 1)) (set! a 2))
2 ; prints "a -> 2"
>(let ((a 0))
(set! (setter 'a)
(let ((history (make-vector 3 0))
(position 0))
(lambda (s v)
(set! (history position) v)
(set! position (+ position 1))
(if (= position 3) (set! position 0))
v)))
(set! a 1)
(set! a 2)
((funclet (setter 'a)) 'history))
#(1 2 0)
另见 stuff.scm 中的 typed-let。 define-constant 比引发错误的 setter 限制更多：后者 不阻止符号的嵌套（可能非常量）绑定。setter 有点丑陋。这里有一个宏，让你可以在初始值之后放置 let 变量的 setter：
(define-macro (let/setter vars . body)
;; (let/setter ((name value [setter])...) ...)
(let ((setters (map (lambda (binding)
(and (pair? (cddr binding))
(caddr binding)))
vars))
(gsetters (gensym)))
`(let ((,gsetters (list ,@setters))
,@(map (lambda (binding)
(list (car binding) (cadr binding)))
vars))
,@(do ((s setters (cdr s))
(var vars (cdr var))
(i 0 (+ i 1))
(result ()))
((null? s)
(reverse result))
(if (car s)
(set! result (cons `(set! (setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result))))
,@body)))
(let ((a 3))
(let/setter ((a 1)
(b 2 (lambda (s v)
(+ v a)))) ; this is the outer "a"
(set! a (+ a 1))
(set! b (+ a b))
(display (list a b)) (newline)))
*load-path* 是加载文件时要搜索的目录列表。 *load-hook* 是一个 hook，其函数在加载文件之前被调用。 hook 函数参数名为 'name，是文件名。 在加载期间，current-input-port 的 port-filename 和 port-line-number 可以告诉你 在文件中的位置。加载后，此数据也可通过 pair-line-number 和 pair-filename 获得。
(set! (hook-functions *load-hook*)
(list (lambda (hook)
(format () "loading ~S...~%" (hook 'name)))))
(set! (hook-functions *load-hook*)
(cons (lambda (hook)
(format *stderr* "~A~%"
(system (string-append "./snd lint.scm -e '(begin (lint \\\"" (hook 'name) "\\\") (exit))'") #t)))
(hook-functions *load-hook*)))
这是一个 *load-hook* 函数，它将已加载文件的目录添加到 *load-path* 变量中，这样后续的加载就不需要指定目录：
(set! (hook-functions *load-hook*)
(list (lambda (hook)
(let ((pos -1)
(filename (hook 'name)))
(do ((len (length filename))
(i 0 (+ i 1)))
((= i len))
(if (char=? (filename i) #\/)
(set! pos i)))
(if (positive? pos)
(let ((directory-name (substring filename 0 pos)))
(if (not (member directory-name *load-path*))
(set! *load-path* (cons directory-name *load-path*)))))))))
与 Common Lisp 一样，*features* 是描述当前加载到 s7 中内容的列表。你可以 通过 provided? 函数检查它，或通过 provide 添加内容。在我的 Snd 版本中， 启动时 *features* 是：
> *features* (snd-24.7 snd24 snd audio snd-s7 snd-motif gsl alsa xm clm6 clm sndlib gcc linux autoload dlopen system-extras overflow-checks ieee-float complex-numbers ratios s7-10.12 s7) > (provided? 'gsl) #t
provide 的另一面是 require。
(require . things) 查找每个 thing
（通过 autoload），如果该 thing 尚未加载，
则加载关联的文件。(require integrate-envelope)
加载 "env.scm"，例如；在这种情况下它等同于
简单使用 integrate-envelope，但如果放在文件开头，它记录了你正在使用该函数。
在更常见的用法中，(require snd-ws.scm)
查找具有 (provide 'snd-ws.scm) 的文件，
如果尚未加载则加载它（在这种情况下是 "ws.scm"）。
要将你自己的文件添加到此机制中，通过 autoload 添加 provided 符号。
由于 load 可以接受环境参数，*features* 及其相关形式遵循块结构。
所以，例如，(let () (require stuff.scm) ...) 将 "stuff.scm" 加载到局部环境中，
而非全局。
*features* 是一个奇怪的变量：它分布在环境链中，并且 可以在中间环境中持有后续（嵌套）值中不存在的特性。 一个简单的方式是：在 let 中加载文件，但导致加载发生在顶层。提供的实体被添加到顶层 *features* 值中， 而非当前 let 的值，但它们实际上在局部是可访问的。所以 *features* 是其所有当前可访问值的合并，类似于 CLOS 中的 call-next-method。 我们可以模仿这种行为：
(let ((x '(a)))
(let ((x '(b)))
(define (transparent-memq sym var e)
(let ((val (symbol->value var e)))
(or (and (pair? val)
(memq sym val))
(and (not (eq? e (rootlet)))
(transparent-memq sym var (outlet e))))))
(let ((ce (curlet)))
(list (transparent-memq 'a 'x ce)
(transparent-memq 'b 'x ce)
(transparent-memq 'c 'x ce)))))
'((a) (b) #f)
多行和行内注释可以包含在 #| 和 |# 中。
(+ #| add |# 1 2)。
除了这种情况和布尔值 #f 和 #t，你可以为以 "#" 开头的标记指定自己的处理程序。*#readers* 是一个对的列表：(char . func)。
"char" 指的是井号（#）之后的第一个字符。"func" 是一个接受一个参数的函数，该参数是井号之后直到下一个分隔符的字符串。当遇到 #<char> 时调用 "func"。如果它返回非 #f 的值，#-表达式会被替换为该值。Scheme 有几个预定义的 #-reader 用于 #b1、#\a 等情况，但如果你愿意可以覆盖它们。如果传入的字符串不是完整的 #-表达式，函数可以使用 read-char 或 read 获取其余部分。假设我们想要 #t<number> 将数字按 12 进制解释：
(set! *#readers* (cons (cons #\t (lambda (str) (string->number (substring str 1) 12))) *#readers*)) > #tb 11 > #t11.3 13.25
或者让 #C(real imag) 被读取为复数：
(set! *#readers* (cons (cons #\C (lambda (str) (apply complex (read)))) *#readers*)) > #C(1 2) 1+2i
这是一个用于读取时求值的 reader macro（读取宏）：
(set! *#readers*
(cons (cons #\. (lambda (str)
(if (string=? str ".")
(eval (read)) ; e.g. #.(+ 1 2)
(symbol->value (string->symbol (substring str 1)))))) ; e.g. #.pi
*#readers*))
> '(1 2 #.(* 3 4) 5)
(1 2 12 5)
以及一个实现 #[...]# 字面量哈希表的 reader：
> (set! *#readers*
(list (cons #\[ (lambda (str)
(let ((h (make-hash-table)))
(do ((c (read) (read)))
((eq? c ']#) h) ; ]# is a symbol from the reader's point of view
(set! (h (car c)) (cdr c))))))))
((#\[ . #<lambda (str)>))
> #[(a . 1) (b . #[(c . 3)]#)]#
(hash-table '(b . (hash-table '(c . 3))) '(a . 1))
要从 reader 中不返回任何值，使用 (values)。
> (set! *#readers* (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values))) *#readers*)) ((#\; . #<lambda (str)>)) > (+ 1 #;(* 2 3) 4) 5
这是 CL 的 #+ reader：
(define (sharp-plus str)
;; str here is "+", we assume either a symbol or an expression involving symbols follows
(let ((e (if (string=? str "+")
(read) ; must be #+(...)
(string->symbol (substring str 1)))) ; #+feature
(expr (read))) ; this is the expression following #+
(if (symbol? e)
(if (provided? e)
expr
(values))
(if (not (pair? e))
(error 'wrong-type-arg "strange #+ chooser: ~S~%" e)
(begin ; evaluate the #+(...) expression as in cond-expand
(define (traverse tree)
(if (pair? tree)
(cons (traverse (car tree))
(case (cdr tree) ((())) (else => traverse)))
(if (memq tree '(and or not)) tree
(and (symbol? tree) (provided? tree)))))
(if (eval (traverse e))
expr
(values)))))))
另见下面的 #n= reader。
(make-list length (initial-element #f)) 返回一个包含 'length' 个元素的列表，默认值为 'initial-element'。
(char-position char-or-string searched-string (start 0)) (string-position substring searched-string (start 0))
char-position 和 string-position 在字符串中搜索字符、一组字符中的任意一个或子字符串的出现。如果没有找到则返回 #f，否则返回在被搜索字符串中首次出现的位置。可选的第三个参数设置搜索从第二个参数中的何处开始。
如果 char-position 的第一个参数是字符串，它会被视为一组字符，char-position 会查找该集合中任意成员的首次出现。 目前，所涉及的字符串假定为 C 字符串（不要期望嵌入的空字符在此上下文中正常工作）。
(call-with-input-file "s7.c" ; report any lines with "static " but no following open paren
(lambda (file)
(let loop ((line (read-line file #t)))
(or (eof-object? line)
(let ((pos (string-position "static " line)))
(if (and pos
(not (char-position #\( (substring line pos))))
(if (> (length line) 80)
(begin (display (substring line 0 80)) (newline))
(display line))))
(loop (read-line file #t)))))))
(substring-uncopied str (start 0) end)
substring-uncopied 存在的原因是有些情况下你需要 substring，但不需要对字符串进行复制。substring-uncopied 不会对原始字符串进行 GC 保护，但显然依赖于它；它用于非常短暂的使用场景，此时不会有机会调用 GC。通常优化器可以发现这些情况，例如在 (string-length (substring str 1)) 中不需要使用 substring-uncopied。
substring-uncopied 返回一个不可变字符串。
关键字（Keyword）主要是为 define* 而存在的。关键字函数有： keyword?、string->keyword、symbol->keyword 和 keyword->symbol。 关键字是一个以冒号开头或结尾的 symbol。冒号被视为 symbol 名称的一部分。关键字是一个常量，求值结果为其自身。
(symbol-table) (symbol->value sym (env (curlet))) (symbol->dynamic-value sym) (symbol-initial-value sym) ; settable (defined? sym (env (curlet)) ignore-rootlet)
defined? 如果 symbol 在环境中已定义则返回 #t：
(define-macro (defvar name value)
`(unless (defined? ',name)
(define ,name ,value)))
如果 ignore-rootlet 为 #t，则搜索仅限于给定的环境。
symbol->value 返回在词法作用域中绑定到该 symbol 的值，而 symbol->dynamic-value
返回动态绑定到它的值。symbol->dynamic-value 在 s7 中有一个陷阱。如果一个函数调用它，并且该函数作为 let body 中的唯一内容被调用，则该 let 不在栈上，因此如果该 let 绑定了我们想通过 symbol->dynamic-value 访问的某个 symbol，新值将不会被看到。几乎任何更改都能使其正常工作：
(let ()
(define (gx) (symbol->dynamic-value 'x))
(let ((x 12))
(gx))) ; returns #<undefined>
(let ()
(define (gx) (symbol->dynamic-value 'x))
(let ((x 12))
"comment"
(gx))) ; returns 12
这是 s7 中的一个 bug，但我宁愿删除 symbol->dynamic-value 也不愿修复它。
symbol-initial-value 通常是函数的内置（启动时）值，例如通过 #_abs 访问。
对于其他 symbol，这个值只能设置一次，且该值应受到 GC 保护（s7 不保护它）。
symbol-table 返回一个包含当前 symbol 表中所有 symbol 的 vector。
这里我们扫描 symbol 表，查找没有文档的函数：
(for-each
(lambda (sym)
(if (defined? sym)
(let ((val (symbol->value sym)))
(if (and (procedure? val)
(string=? "" (documentation val)))
(format *stderr* "~S " sym)))))
(symbol-table))
或获取 gensym 列表：
(map (lambda (sym) (if (gensym? sym) sym (values))) (symbol-table))
一个自动软件测试器（另见 tools 目录中的 tauto.scm 和 auto-tester.scm）：
(for-each
(lambda (sym)
(if (defined? sym)
(let ((val (symbol->value sym)))
(if (procedure? val)
(let ((max-args (cdr (arity val))))
(if (or (> max-args 4)
(memq sym '(exit abort)))
(format () ";skip ~S for now~%" sym)
(begin
(format () ";whack on ~S...~%" sym)
(let ((constants (list #f #t pi () 1 1.5 3/2 1.5+i)))
(let autotest ((args ()) (args-left max-args))
(catch #t (lambda () (apply func args)) (lambda any #f))
(if (> args-left 0)
(for-each
(lambda (c)
(autotest (cons c args) (- args-left 1)))
constants)))))))))))
(symbol-table))
help 尝试查找关于其参数的信息。
> (help 'caadar) "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
gc 调用垃圾回收器（garbage collector）。(gc #f) 关闭 GC，(gc #t) 打开 GC。
如果你收到关于 "free cell" 的错误，这通常是 GC 释放了某个它不应该释放的对象的标志。在纯 Scheme 代码中，这是 s7 的 bug；请发邮件告诉我！ 在外部代码中，这可能表明你需要用 s7_gc_protect 保护某些 s7_pointer。
(equivalent? x y)
假设我们想要检查两个不同的计算是否得到了相同的结果，而该结果可能涉及循环结构。equal? 能帮上忙吗？
> (equal? 2 2.0) #f > (let ((x +nan.0)) (equal? x x)) #f > (equal? .1 1/10) #f > (= .1 1/10) #f > (= 0.0 0+1e-300i) #f
不行！我们需要一个忽略实数和复数中微小差异的相等性检查，并且知道 NaN 在实际用途中是相等的。 暂且不谈数字， 已关闭的 port 不相等，但它们也无法再做任何事情。 #() 不等于 #2d()。而且两个 closure（闭包）永远不相等，即使它们的参数、环境和 body 都相等。 由于可能存在循环，在 Scheme 中编写 equal? 的替代品并不容易。 因此，在 s7 中，如果一个东西基本上与另一个东西相同，它们就满足函数 equivalent?。
> (equivalent? 2 2.0) #t > (equivalent? 1/0 1/0) ; NaN #t > (equivalent? .1 1/10) #t ; floating-point epsilon here is 1.0e-15 or thereabouts > (equivalent? 0.0 1e-300) #t > (equivalent? 0.0 1e-14) #f ; its not always #t! > (equivalent? (lambda () #f) (lambda () #f)) #t
*s7* 字段 equivalent-float-epsilon 设置浮点容差因子。 我无法决定 bignum 应如何与 equivalent? 交互。目前， 如果涉及 bignum，无论是在这里还是在 hash-table 中，s7 都使用 equal?。 最后，如果任一参数是带有 'equivalent? 方法的环境， 则会调用该方法。
define-expansion 定义一个在读取时展开的 macro（宏）。 它的语法与 define-macro 相同，（在正常使用中）结果也相同，但它快得多，因为它只展开一次。 类似地，define-expansion* 定义一个读取时 macro*。 （另见 s7test.scm 中的 define-with-macros，它提供了一种在定义时展开函数体中 macro 的方法）。 匿名形式是 expansion 和 expansion*（示例见 s7test.scm）。它们与 lambda 和 lambda* 的角色相同，但返回读取时 macro（在 s7 中称为 expansion 以避免与 Common Lisp 的 reader macro 混淆）。 由于 reader 几乎不知道它正在读取的代码， 你需要确保 expansion 定义在顶层，并且其名称是唯一的。 reader 确实知道全局变量，所以：
(define *debugging* #t)
(define-expansion (assert assertion)
(if *debugging* ; or maybe better, (eq? (symbol->value '*debugging*) #t)
`(unless ,assertion
(format *stderr* "~A: ~A failed~%" (*function*) ',assertion))
(values)))
现在断言代码仅在 *debugging* 为 #t 时才出现在函数体（或其他地方）中；否则 assert 展开为空。另一个非常方便的用途是将源文件行号嵌入消息中；例如见 lint.scm 中的 lint-format。 暂且不谈 读取时展开和拼接，define-macro 和 define-expansion 之间的真正区别在于 expansion 的结果不会被求值。 我不是历史学家，但我相信这意味着 define-expansion 创建了一个（令人惊讶的！）f*xpr。事实上：
(define-macro (define-f*xpr name-and-args . body)
`(define ,(car name-and-args)
(apply define-expansion
(append (list (append (list (gensym)) ',(cdr name-and-args))) ',body))))
> (define-f*xpr (mac a) `(+ ,a 1))
mac
> (mac (* 2 3))
(+ (* 2 3) 1)
你可以用普通 macro 做类似的事情，或者使间接引用显式化：
> (define-macro (fx x) `'(+ 1 ,x)) ; quote result to avoid evaluation fx > (let ((a 3)) (fx a)) (+ 1 a) > (define-expansion (ex x) `(+ 1 ,x)) ex > (let ((x ex) (a 3)) (x a)) ; avoid read-time splicing (+ 1 a) > (let ((a 3)) (ex a)) ; spliced in at read-time 4
如本例所示，reader 对程序上下文一无所知，
因此如果它没有看到一个第一个元素是 expansion 名称的列表，它不会做任何特殊的事情。在上面的 (x a) 情况中，
expansion 发生在代码求值时，expansion 结果
简单地被返回，不被求值。
你也可以使用 macroexpand 来取消 macro 展开的求值：
(define-macro (rmac . args)
(if (null? args)
()
(if (null? (cdr args))
`(display ',(car args))
(list 'begin
`(display ',(car args))
(apply macroexpand (list (cons 'rmac (cdr args))))))))
> (macroexpand (rmac a b c))
(begin (display 'a) (begin (display 'b) (display 'c)))
> (begin (rmac a b c d) (newline))
abcd
主要的内置 expansion 是 reader-cond。其语法基于 cond： 每个子句的 car 在读取时上下文中被求值，如果不为假， 则该子句的其余部分被拼接到代码中，就像你从一开始就输入了它一样。
> '(1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6) (1 2 3 5 6) > ((reader-cond ((> 1 0) list 1 2) (else cons)) 5 6) (1 2 5 6)
这是 reader-if：
(define-expansion (reader-if test true . false)
(let ((test-val (eval test)))
(if test-val
true
(and (pair? false)
(car false)))))
当 (*s7* 'profile) 为正数时，性能分析（profiling）被开启。 程序运行时，profiler 收集它能识别的每个函数的数据。 任何时候，你都可以调用 show-profile 来查看这些数据。第一个时间是包含性的 （包括嵌套调用中花费的时间），第二个是排他性的（仅在当前函数中花费的时间）。在 Linux 和 *BSD 中，我们使用 clock_gettime()，它相当 快速，但有一些 profiler 开销。在其他系统中，我们使用 clock()，它 出奇地慢。优化器有时会将尾递归和类似情况重新转换为 while 循环， 因此列出的调用次数可能少于你的预期，但总时间应该是 正确的。要清除当前数据，请调用 clear-profile。
*s7* 是一个 let，提供对 s7 某些内部 状态的访问：
version a string describing the current s7: e.g. "s7 10.0, 13-Jan-2022"
major-version an integer (10 in the example above)
minor-version an integer (0 in the example above)
scheme-version 's7, 'r7rs
print-length number of elements to print of a non-string sequence
max-string-length maximum size arg to make-string and read-string
max-list-length maximum size arg to make-list
max-vector-length maximum size arg to make-vector and make-hash-table
max-vector-dimensions make-vector limit on the number of dimensions
default-hash-table-length default size for make-hash-table (8, tables resize as needed)
initial-string-port-length 128, initial size of a input string port's buffer
max-string-port-length maximum size of a port data buffer
output-file-port-length 2048, size of an output port's buffer
history a circular buffer of recent eval entries stored backwards (use set! to add an entry)
history-size eval history buffer size if s7 built WITH_HISTORY=1
history-enabled is history buffer receiving additions (if WITH_HISTORY=1 as above)
debug determines debugging level (see debug.scm), default=0
profile profile switch (0=default, 1=gather profiling info)
profile-info the current profiling data; see profile.scm
profile-prefix name (a symbol) used to identify the current environment in profile data
default-rationalize-error 1e-12
equivalent-float-epsilon 1e-15
hash-table-missing-key-value #f
iterator-at-end-value #<eof>
bignum-precision bits for bignum floats (128)
float-format-precision digits to print for floats (16) in object->string and number->string
default-random-state the default arg for random
most-positive-fixnum if not using gmp, the most positive integer ("fixnum" comes from CL)
most-negative-fixnum as above, but negative
number-separator #\null
symbol-quote? #f, so in (quote x) "quote" is a #_quote (a c-function); set to #t to get quote as a symbol
symbol-printer #f, a function to print symbols whose names contain unusual characters
safety 0 (see below)
undefined-identifier-warnings #f
undefined-constant-warnings #f
accept-all-keyword-arguments #f
autoloading? #t
openlets #t, whether any let can be open globally (this overrides all openlets)
expansions? #t, whether expansions are handled at read-time
muffle-warnings? #f, if #t s7_warn does not output anything
cpu-time run time so far (proportional to cpu cycles consumed, not wall-clock seconds)
file-names or filenames currently loaded files (a list)
catches a list of the currently active catch tags
c-types a list of c-object type names (from s7_make_c_type, etc)
stack the current stack entries
stack-top current stack location
stack-size current stack size
max-stack-size maximum stack size
stacktrace-defaults stacktrace formatting info for error handler
rootlet-size the number of globals
heap-size total cells currently available
max-heap-size maximum heap size
free-heap-size the number of currently unused cells
gc-stats 0 (or #f), 1: show GC activity, 2: heap, 4: stack, 8: protected_objects, #t = 1
gc-freed number of cells freed by the last GC pass
gc-total-freed number of cells freed so far by the GC; the total allocated is probably close to
(with-let *s7* (+ (- heap-size free-heap-size) gc-total-freed))
gc-info a list: calls total-time ticks-per-second (see profile.scm)
gc-temps-size number of cells just allocated that are protected from the GC (256)
gc-resize-heap-fraction when to resize the heap (0.8); these two are aimed at GC experiments
gc-resize-heap-by-4-fraction when to get panicky about resizing the heap
gc-protected-objects vector of objects protected from the GC
memory-usage a let (environment) describing current s7 memory allocations
使用标准环境语法来访问这些字段：
(*s7* 'stack-top)。stuff.scm 中有函数
*s7*->list，它以列表形式返回大多数这些字段。
其中一些字段的编译时默认值可以设置：
heap-size: INITIAL_HEAP_SIZE (64000) stack-size: INITIAL_STACK_SIZE (4096) gc-temps-size: GC_TEMPS_SIZE (256) bignum-precision: DEFAULT_BIGNUM_PRECISION (128) history-size: DEFAULT_HISTORY_SIZE (8) print-length: DEFAULT_PRINT_LENGTH (40) gc-resize-heap-fraction: GC_RESIZE_HEAP_FRACTION (0.8) output-file-port-length: OUTPUT_PORT_DATA_SIZE (2048) See also WITH_WARNINGS, S7_ALIGNED, and GC_TRIGGER_SIZE.
(set! (*s7* 'autoloading) #f) 关闭自动加载器。
'safety 变量是一个整数。目前：
0: default. 1: no remove_from_heap (a GC optimization) infinite loop check in eval, sort! and some iterators immutable object check in reverse!, sort!, and fill! more info in (*s7* 'history) for s7_apply_function, s7_call and s7_eval less aggressive optimization in with-let and lambda warnings about syntax redefinition incoming s7_pointer checks in some FFI functions bignum int to s7_int conversion checks 2: vector, string, and pair constants are immutable (but checks for this are currently sparse)
debug 变量控制 debug.scm 在何处激活。如果激活（debug > 0），它会在函数中插入
trace 调用等。它使用 dynamic-unwind
来为返回值建立一个 catcher。(dynamic-unwind function arg) 使得
function 在被 trace 的函数返回后被调用，将 arg
和返回值传递给它。
(*s7* 'stacktrace-defaults) 是一个包含四个整数和一个布尔值的列表，用于告诉错误
处理程序如何格式化 stacktrace 信息。四个整数是：
要显示的帧数、
用于代码显示的列数、
一行数据可用的列数、
以及注释放置的位置。
布尔值设置是否将整个输出显示为注释。
默认值是 '(30 50 80 50 #f)。
这将类似 top 程序那样显示 s7 内存使用情况：
(format *stderr* "~C[~D;~DH" #\escape 0 0) (format *stderr* "~C[J" #\escape) (display (with-output-to-string (lambda() (*s7* 'memory-usage))))
（理想情况下我们只重新显示变化的字段）。
标准 time macro：
(define-macro (time expr)
`(let ((start (*s7* 'cpu-time)))
(let ((res (list ,expr))) ; expr might return multiple values
(list (car res)
(- (*s7* 'cpu-time) start)))))
向 (*s7* 'bignum-precision) 添加自动 log10 重新计算：
(define log10 (log (bignum 10))) (define bignum-precision (dilambda (lambda () (*s7* 'bignum-precision)) (lambda (val) (set! (*s7* 'bignum-precision) val) (set! log10 (log (bignum 10))) val)))
stack、history 和 gc-protected-objects 字段用于调试。不要保留 这些字段并期望有好的结果！
*s7* 字段 'number-separator 指的是某些语言所称的"数字字面量分隔符"， 一个可以出现在数字中作为分隔符使其更易读的字符：例如 "123,321" 与 "123321"。如果编译时标志 WITH_NUMBER_SEPARATOR 被设置，并且 (*s7* 'number-separator) 不是 #\\null（默认值），则该字符可以出现在 数字中的任何位置（只要它在两个数字之间），reader 将忽略它。*features* 列表中会有条目 'number-separator（如果 s7 编译时定义了 WITH_NUMBER_SEPARATOR）。 （数字分隔符不适用于 bignum）。
(*s7* 'symbol-printer) 在 object->string 需要打印一个其名称通常只能由 symbol 函数处理的 symbol 时被调用。
(c-object? obj) (c-object-type obj) (c-object-let obj) (c-pointer? obj) (c-pointer int type info weak1 weak2) (c-pointer-type obj) (c-pointer-info obj) (c-pointer-weak1 obj) ; also weak2 (c-pointer->list obj)
c-object? 如果其参数是 c-object 则返回 #t。 c-object-type 返回对象的类型标签（否则当然返回 #f）。此标签也是 对象类型在 (*s7* 'c-types) 列表中的位置。 (*s7* 'c-types) 返回由 s7_make_c_type 创建的类型列表。 c-object-let 返回 c-object 的本地 let。更多信息见 c-objects。
你可以封装原始 C 指针并在 s7 代码中传递它们。函数 c-pointer 返回一个封装后的指针，
c-pointer? 如果传入一个这样的指针则返回 #t。(define NULL (c-pointer 0))。
如果 type 字段是一个 symbol，它用于在 s7_c_pointer with_type 中检查类型。
如果 c-pointer 的 'info 字段是一个 let，该指针可以参与
通用函数机制，类似于 c-object：
> (let ((ptr (c-pointer 1 'abc
(inlet 'object->string
(lambda (obj . args)
(let ((lt (object->let obj)))
(format #f "I am pointer ~A of type '~A!"
(lt 'c-pointer) ; we need c-pointer-type etc
(lt 'c-type))))))))
(openlet ptr)
(object->string ptr))
"I am pointer 1 of type 'abc!"
c-pointer->list 返回 (list pointer-as-int type info)。 "weak1" 和 "weak2" 字段用于自定义"弱"引用。weak 字段的值在 GC 扫描期间不会被标记，类似于 weak-hash-table 中的 key。 如果任一值被 GC 回收，该字段会被 GC 设置为 #f。weak 字段在 比较 c-pointer 时被 equal? 和 equivalent? 忽略，对于 c-pointer 的 object->string 即使指定了 :readable 也是如此。
目前有几个内置在 s7 中的面向树的函数：
(tree-cyclic? tree) returns #t if tree contains a cycle. (tree-leaves tree) returns the number of leaves in tree. (tree-memq obj tree) returns #t if obj is in tree (using eq?). (tree-set-memq set tree) returns #t if any member of the set (using eq?) is in tree. (tree-count obj tree) returns how many times obj is in tree.
s7 最初有 Scheme 级别的多线程支持，但我在 2011 年 8 月移除了它。 事实证明它不如我期望的那么有用， 主要是因为 s7 线程共享堆，因此必须协调 所有 cell 的分配。使用多个 进程各运行一个独立的 s7 解释器，比让一个 s7 运行多个 s7 线程更快更简单。在 CLM 中，访问 输出流也存在争用。在 GUI 相关的情况下， 线程无用主要是因为 GUI 工具包不是线程安全的。 最后但同样重要的是，使非线程化的 s7 更快的努力搞乱了线程版本的部分内容。与其 浪费大量时间修复这个问题，我选择放弃多线程。 s7 是线程安全的：
#include <stdio.h> #include <stdlib.h> #include <pthread.h> #include "s7.h" #define NUM_THREADS 16 static pthread_t threads[NUM_THREADS]; static pthread_mutex_t lock = PTHREAD_MUTEX_INITIALIZER; static void *run_thread(void *obj) { s7_scheme *sc = (s7_scheme *)obj; const char *str = s7_object_to_c_string(sc, s7_make_integer(sc, 123)); s7_eval_c_string(sc, "(let () \ (define (f) \ (do ((i 0 (+ i 1))) ((= i 10)) \ (do ((k 0 (+ k 1))) ((= k 1000000))) \ (format *stderr* \"~D \" i))) \ (f))"); pthread_mutex_lock(&lock); fprintf(stderr, "%s\n", str); pthread_mutex_unlock(&lock); } int main(int argc, char **argv) { for (int32_t i = 0; i < NUM_THREADS; i++) pthread_create(&threads[i], NULL, run_thread, (void *)s7_init()); for (int32_t i = 0; i < NUM_THREADS; i++) pthread_join(threads[i], NULL); exit(0); } /* linux: gcc -o threads threads.c s7.o -Wl,-export-dynamic -pthread -lm -I. -ldl * mac: clang -o threads threads.c s7.o -pthread -lm -I. -ldl * g++ can compile s7.c, but clang++ can't. */这是一个使用 gdbm 处理线程全局变量的示例：
#include <stdio.h> #include <stdlib.h> #include <pthread.h> #include <gdbm.h> #include "s7.h" #define GDBM_DB "test.gdbm" GDBM_FILE gdb; #define NUM_THREADS 1024 static pthread_t threads[NUM_THREADS]; static void *run_thread(void *obj) { s7_scheme *sc = (s7_scheme *)obj; datum key, rtn; key.dptr = "global_int"; key.dsize = 10; rtn = gdbm_fetch(gdb, key); if (rtn.dptr) { /* this makes a local copy of the global variable and displays its value */ /* s7_define_variable(sc, "global-int", s7_make_integer(sc, strtol((const char *)rtn.dptr, NULL, 10))); */ /* s7_display(sc, s7_name_to_value(sc, "global-int"), s7_current_error_port(sc)); */ /* this increments the global variable and displays it */ datum val; char buf[128]; int bytes; long int ctr = strtol((const char *)rtn.dptr, NULL, 10); bytes = snprintf(buf, 128, "%ld", ++ctr); val.dptr = buf; val.dsize = bytes + 1; gdbm_store(gdb, key, val, GDBM_REPLACE); fprintf(stderr, "%s ", buf); free(rtn.dptr); } else fprintf(stderr, "oops "); s7_free(sc); } int main(int argc, char **argv) { int32_t i, k, rtn, last_i = 0; datum key, val; key.dptr = "global_int"; key.dsize = 10; val.dptr = "0"; val.dsize = 2; gdb = gdbm_open(GDBM_DB, 1024, GDBM_NEWDB, 0664, NULL); gdbm_store(gdb, key, val, GDBM_REPLACE); for (i = 0; i < NUM_THREADS; i++) { rtn = pthread_create(&threads[i], NULL, run_thread, (void *)s7_init()); if (rtn) { fprintf(stderr, "failed to create thread %d\n", i); exit(0); } if ((i - last_i) > 16) { for (k = last_i; k < i; k++) pthread_join(threads[k], NULL); last_i = i; }} gdbm_close(gdb); } /* linux: gcc -o gthreads gthreads.c s7.o -O -g -Wl,-export-dynamic -pthread -lgdbm -lm -I. -ldl */Scheme 端示例见 libgdbm。
与 r5rs 的一些其他差异：
- 没有 force 或 delay（见下文）。
- 没有 syntax-rules 或其任何相关形式。
- 没有 scheme-report-environment、null-environment 或 interaction-environment（使用 curlet）。
- 没有 transcript-on 或 transcript-off。
- begin 返回最后一个形式的值；它可以包含定义和其他语句。
- #<unspecified>、#<eof> 和 #<undefined> 是一等对象。
- for-each 和 map 接受不同长度的参数；当任一参数到达末尾时操作停止。
- for-each 和 map 接受任何可应用对象作为第一个参数，任何序列或迭代器作为尾部参数。
- letrec*，但没有坚定的信念。
- set! 和 *-set! 返回新值（经过 setter 处理），而不是 #<unspecified>。
- define 及其相关形式返回新值。
- port-closed?
- list? 意味着 "pair 或 null"，proper-list? 是 r5rs 的 list?，float? = real 且不是 rational，sequence? = 有 length，byte? = 无符号字节。
- 默认 IO 端口命名为 *stdin*、*stdout* 和 *stderr*。
- #f 作为输出端口意味着不输出任何内容（#f 大概是 /dev/null）。
- member 和 assoc 接受可选的第三个参数，即比较函数（默认为 equal?）。
- case 接受 =>，类似于 cond（函数参数是选择器）。
- 如果 WITH_SYSTEM_EXTRAS 为 1，则以下是内置的：directory?、file-exists?、delete-file、system、directory->list、getenv。
- s7 区分大小写。
- when 和 unless（用于 r7rs），返回最后一个形式的值。
- 默认不支持 "d"、"f"、"s" 和 "l" 指数标记（使用 "e"、"E" 或 "@"）。
- 不支持 quasiquoted vector 常量（可以在此使用读取时 expansion；见 s7test.scm）。
- type-of 返回其参数的类型指示符。
- type-name 返回描述其参数类型的字符串。 li>'<datum> 是 (#_quote <datum>)，见下文。
- s7 symbol 名称可以以数字开头：
(define (1+ x) (+ x 1))。- eq? 是 r4rs 版本的 eq?。如果其参数完全相同则返回 #t。
在 s7 中，如果像 gcd 这样的内置函数在函数体中被引用， 优化器可以自由地用 #_function 替换它。也就是说，
(gcd ...)可以在 s7 的意愿下 被更改为(#_gcd ...)，只要在优化器 看到使用它的表达式时 gcd 仍具有其原始值。随后的(set! gcd +)不会影响此优化调用。 我想我可以挥挥手然后喃喃地说些"激进词法作用域"之类的话，但实际上这里 的选择是速度胜过那种老顽固的一致性。如果你想将 gcd 改为 +，在 加载调用 gcd 的代码之前做。 我认为大多数 Scheme 都这样处理 macro：macro 调用使用其当前 定义被其展开所替换，之后的重定义不影响之前的使用。 Guile 的行为与 s7 相同：(define (add1 x) (+ x 1)) (set! + -) (display (add1 3))) ; 4 in both s7 and Guile 3.0.4但如果涉及 Scheme 函数，事情就变得混乱了：
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (define oldfib fib) (set! fib 32) (display (oldfib 10))) ; s7 says 55, Guile says "wrong type to apply: 32"我无法决定哪种方式是正确的：s7 看起来更一致， 但是：
(define (fib n) 32) (set! fib (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))) (define oldfib fib) (set! fib 32) (display (oldfib 10)) ; "attempt to apply an integer 32 to..."所以 s7 也不一致！（实际上在 2021 年 1 月之前是一致的，当时我突然觉得这是一个 错误并"修复"了它；现在我又有了新的想法）。
以下是如果我不在意与其他 Scheme 的兼容性会对 s7 做的一些更改：
- 移除 exact/inexact 区分，包括 #i 和 #e（已完成！#i 现在表示 int-vector 常量）。
- 移除 call-with-values 及其相关形式
- 移除 char-ready?
- 将 eof-object? 改为 eof? 或直接省略它（你可以使用 eq? #<eof>）
- 将 make-rectangular 改为 complex（已完成！），并移除 make-polar。
- 移除 unquote（名称，不是功能）。
- 移除 cond-expand。
- 移除 *-ci 函数
- 移除 #d（已完成！）
（如果设置编译器标志 WITH_PURE_S7，其中大部分都会被移除），也许还有：
- 移除 even? 和 odd?，gcd 和 lcm。
- 移除 string-length 和 vector-length。
- 将 file-exists? 改为 file?（或省略它并假设使用 libc.scm — 何必重新发明轮子？）。
- 移除所有转换和复制函数，如 vector->list 和 vector-copy（使用 copy 或 map）。
- 将 string->symbol 改为 symbol（那 symbol->string 怎么办？）
- 将 with-output-to-* 和 with-input-from-* 改为省略无意义的 lambda。
- 移除 with-* IO 函数（例如 with-input-from-string），保留 call-with-* 版本（call-with-input-string）。
- 移除 assq、assv、memq 和 memv（既然 assoc 和 member 可以传入 eq? 和 eqv?，这些就没有意义了）。
- 将所有 "*var*" 名称移到 *s7* 中：例如 *load-hook* 变成 (*s7* 'load-hook)。
目前 WITH_PURE_S7：
- 在 *features* 中放置 'pure-s7
- 省略 char-ready、char-ci*、string-ci*
- 省略 string-fill!、vector-fill!、vector-append
- 省略 list->string、list->vector、string->list、vector->list、let->list
- 省略 string-length 和 vector-length
- 省略 cond-expand、multiple-values-bind|set!、call-with-values
- 省略 unquote（名称）
- 省略 d/f/s/l 指数
- 省略 make-polar 和 make-rectangular（使用 complex）
- 省略 exact?、inexact?、exact->inexact、inexact->exact
- 省略 set-current-output-port 和 set-current-input-port
随着向 s7_setter 和 s7_set_setter（Scheme 中的 setter）的迁移， dilambda 和 dilambda? 已减少为微不足道的便利函数，所以也许它们也可以 被移除。
string-copy 有 3 个额外参数，允许将字符串直接复制到其他字符串中。 在 vector 中，我们可以使用 subvector，但 substring 返回一个新字符串（复制其参数），除非 优化器注意到不需要复制。Copy 几乎可以工作，但它的 start 和 end 参数 指的是源，而不是目标。substring 应该像 subvector 一样，但这不向后兼容。
有几个不太理想的名称。 get-output-string 应该是 current-output-string。write-char 的行为像 display，而不是 write。 provided? 应该是 feature?，或者 *features* 应该是 *provisions*。 list-ref、list-set! 和 list-tail 实际上只适用于 pair。 let-temporarily 应该是 templet、set-temporarily，或者也许就叫 "with"。define-expansion 应该是 define-reader-macro，但 该名称与 Common Lisp 中的 reader macro 冲突。*cload-directory* 应该是 *cload-path*。 同一事物不应该有两个名称：call/cc 和 call-with-current-continuation：删掉后者！ CL 启发的 "log*" 名称如 logand 看起来非常老式。标准 Scheme 选择 "bitwise*" 作为名称；为什么不用 "integerwise" 或 "bytevectorwise"？"wise" 这套东西只是噪音；他们是不是在想《霍比特人》？
(define & logand) (define | logior) (define ~ lognot)，但 ^ 用于 logxor （如 C 中）不太理想；^ 应该是 expt。最后，我认为当前输入或输出端口的概念 是一个错误：IO 函数应该总是获取一个显式的端口。cond-expand 很蠢，它的名字更蠢。 以 libgsl.scm 为例；不同版本的 GSL 库有不同的函数。在构建 FFI 时我们需要知道 我们在处理哪个 GSL 版本。当我们真正想要的只是
(> version 23.19)时，开始推送和检查几十个 库版本 symbol 是很疯狂的。 s7 使用 reader-cond 代替 cond-expand， 因此读取时决策涉及正常的 Scheme 求值。在关于 cond-expand 的部分，r7rs 规范说 "如果没有任何 <feature requirement> 求值为 #t， 那么如果存在 else 子句，则包含其 <expression>。否则，cond-expand 没有效果。" 我将其理解为
(begin 23 (cond-expand (surreals 1)))应求值为 23， 而(abs -1 (cond-expand (surreals 1)))应为 1。目前 s7 对第一个返回 #<unspecified>， 对第二个返回错误 "abs: too many arguments: (abs -1 #<unspecified>)"。 reader-cond 的行为符合 r7rs 规范：(begin 23 (reader-cond ((provided? 'surreals) 1)))返回 23，(abs -1 (reader-cond ((provided? 'surreals) 1)))返回 1，但这些例子让我 不高兴。更糟糕的是：(define (f a (reader-cond ((provided? 'surreals) b))) a)，如果提供了 surreals 则添加 参数 "b"。 也许 reader-cond（以及一般的 expansion）在这些情况下不应该神奇地消失。 （我刚注意到修正后的 r7rs.pdf 说 cond-expand 的结果是未指定的）。然后是 case 的情况：在 r7rs 中，没有结果的 case 子句似乎是一个错误。 但用于表示这一点的记法与 begin 所用的相同， 所以如果我们允许
(begin)，我们应该允许 case 子句没有显式结果。 在 cond 中， "隐式 progn"（用 CL 术语来说）包括测试表达式，所以没有结果的子句返回 测试结果（当然如果为真）。在 case 的情况中，s7 返回选择器。(case x ((0 1)))等价于(case x ((0 1) => values))， 就像(cond (A))等价于(cond (A => values))。 一个应用是方法查找：((case (obj 'abs) ((#<undefined>) abs) (else)) ...)； 否则我们必须保存查找结果或执行两次查找。 这个选择对 do 有连锁 影响：如果没有为 do 指定结果，s7 返回测试结果。 它也影响 hash-table。目前 hash-table-ref 如果 key 不在表中则返回 #f， 模仿 assoc 并针对 cond 的 =>，但如果我们同时使用 case 和 #<undefined>， 模仿 let-ref 似乎更有用也更直观。但如果 hash-table-ref 返回 #<undefined>，将 hash-table 用作集合就更困难了。嗯。 无论如何， case 的 fall-through 值应该是（在 s7 中也是） #<unspecified>：case 是 if 的一种形式，所以(if #f #f)、(cond (#f #f))和(case #t ((#f) #f))应该相等。欢迎提出更好的想法！
以下是内置的 s7 变量：
- *features* ; 一个 symbol 列表
- *libraries* ; 一个 (filename . let) 对的列表
- *load-path* ; 一个目录列表
- *cload-directory* ; cload 输出目录
- *autoload* ; 自动加载信息
- *#readers* ; 一个 (char . handler) 对的列表
以及内置常量：
- pi
- *stdin* *stdout* *stderr*
- *s7*
- +nan.0 -nan.0 +inf.0 -inf.0（多么糟糕的名称！+nan.0 是一个不是数字的正的不精确整数？）
- *unbound-variable-hook* *missing-close-paren-hook* *load-hook* *autoload-hook*
- *error-hook* *read-error-hook* *rootlet-redefinition-hook*
+nan.0 中的 "+" 不能省略，但在复数中使用时，有人会丢掉一个 "+"：1+nan.0i，这不奇怪吗？
(*function*) 返回当前被调用函数的名称（或名称和位置）。
(define (example) (*function*))返回'example。 这是一个使用 bacro（访问调用时环境）和 openlet 来实现探针的示例； 它使用 *function* 获取调用函数名称，报告探针参与的任何操作：(define (probe-eval val) (let ((all-let (inlet))) (for-each (lambda (sym) (unless (immutable? sym) ; apply-values etc (let ((func (symbol->value sym (rootlet)))) (when (procedure? func) (varlet all-let sym (apply bacro 'args `((let-temporarily (((*s7* 'openlets) #f)) (let ((clean-args (map (lambda (arg) (if (eq? arg probe-eval) (probe-eval 'value) arg)) args))) (format *stderr* "(~S ~{~S~^ ~}) ; ~S~%" ,sym clean-args (*function* (outlet (outlet (curlet))))) (apply ,func clean-args)))))))))) (symbol-table)) (varlet all-let 'value val) (openlet all-let))) (define (call-any x) (+ x 21)) (call-any (probe-eval 42)) ; prints "(+ 42 21) ; call-any", returns 63*function* 的第二个参数是开始搜索函数的 let。 在上面的例子中，我们从 bacro 外面的 let 开始搜索，因为我们希望找到 bacro 的调用者。 作为便利，*function* 接受一个可选的第三个参数，指定你想要 关于当前函数的什么信息。例如：
(*function* (curlet) 'name)。
name返回当前函数的名称（一个 symbol）。line返回函数的定义行号。file返回函数的定义文件。 其他可能的值包括signature、documentation、arity、arglist、value和source。funclet返回当前函数的 funclet。 要获取任何函数的信息：(*function* (funclet func) 'arglist)。不同 Scheme 对 () 的处理不同。s7 将其视为一个求值为自身的常量， 所以你不需要引用它。
(eq? () '())为 #t。 这与例如(eq? #f '#f)也为 #t 一致。 标准说"空列表是其自身类型的特殊对象"，所以两种选择在这一点上 当然都是可接受的（但是，唉，标准愚蠢地继续否认 () 可以求值为自身）。 （我被告知在标准对英语的狡猾滥用中，"is an error" 意味着 "is not portable"；如果 他们意思是 "is not portable"，为什么不说呢？）。 一些混乱似乎是由"列表"这个词引起的。我会这样描述求值器："如果它得到一个 常量（而 () 是一个常量）它返回该常量；如果是一个 symbol，它返回该 symbol 关联的值；如果是一个 pair，它看 pair 的 car 来决定做什么"。类似地，在 s7 中，vector 常量不需要被引用。列表常量被引用 是为了防止它被求值，但 #(1 2 3) 和 "123" 或 123 一样没有问题。
这些例子引出了 scheme 的另一个奇怪角落：else。在
(cond (else 1))中 'else 被求值（像任何 cond 测试一样），所以它的值可能是 #f；在(case 0 (else 1))中 它不被求值（像任何 case key 一样），所以它只是一个 symbol。 由于 setter 在 s7 中是局部的， 即使我们保护了 rootlet 的 'else，某人也可以(let ((else #f)) (cond (else 1)))。 当然，在 scheme 中这种麻烦是普遍的，所以与其将 'else 设为常量， 我认为最好的路径是使用 unlet：(let ((else #f)) (cond (#_else 1)))。这是 1（不是 ()），因为 'else 的初始值 不能被更改。s7 将
'<datum>视为(#_quote <datum>)，这与 r7rs 标准的(quote <datum>)不同。 名称 'quote' 可以被局部上下文捕获，而函数 #_quote 不行。撇号应该是 不需要你担心名称捕获的东西；形式'a不包含 名称 'quote'，所以它的结果可以被重定义 'quote' 改变是令人恼火的。以下是几个差异的例子 （我使用 guile 因为它在这台机器上可用）：(let ((quote "Friends, Romans...")) 'x) ; guile Unbound variable: x, s7 x (let (' 1) quote) ; guile 1, s7 error (#_quote is not a symbol) (let ((quote 32)) (length '(1 2))) ; guile error Wrong type to apply: 1, s7 2 (let ((quote cos)) '0) ; guile 1, s7 0 (let ((quote -) (x 1)) 'x) ; guile -1, s7 x (let ('(lambda (x) (+ x 1))) '1) ; guile 2, s7 error (#_quote is not a symbol) ((lambda 'x (+ 'x 1)) cos 0) ; guile 2, s7 error (lambda parameter #_quote is a constant) (define-macro (m x) `(length ',x)) (let ((quote 32)) (m (1 2 3))) ; guile "wrong type to apply: 1", s7 3也许这些简单的例子能阐明 s7 处理撇号的方式。
(syntax? #_quote) -> #t (syntax? 'quote) -> #f ; the symbol quote (equal? quote #_quote) -> #t (equal? 'quote quote) -> #f ; quote is not self-evaluating (equal? 'quote #_quote) -> #f (equal? '#f (quote #f)) -> #t如果你想使用标准 scheme 方式，
(set! (*s7* 'symbol-quote?) #t)。s7 以其惯有的从容处理循环列表、vector 和 dotted list。 你可以将它们传给 memq，或者打印它们；你甚至可以求值它们。 打印语法借鉴自 CL：
> (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) lst) #1=(1 2 3 . #1#) > (let* ((x (cons 1 2)) (y (cons 3 x))) (list x y)) (#1=(1 . 2) (3 . #1#))但这种语法是否也应该可读？我倾向于说不，因为 那样它就成了语言的一部分，而它看起来不像语言的其他部分。 （我觉得它有点丑）。也许我们可以通过 *#readers* 实现它：
(define circular-list-reader (let ((known-vals #f) (top-n -1)) (lambda (str) (define (replace-syms lst) ;; walk through the new list, replacing our special keywords ;; with the associated locations (define (replace-sym tree getter) (if (keyword? (getter tree)) (let ((n (string->number (symbol->string (keyword->symbol (getter tree)))))) (if (integer? n) (let ((lst (assoc n known-vals))) (if lst (set! (getter tree) (cdr lst)) (format *stderr* "#~D# is not defined~%" n))))))) (let walk-tree ((tree (cdr lst))) (if (pair? tree) (begin (if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car)) (if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr)))) tree)) ;; str is whatever followed the #, first char is a digit (let* ((len (length str)) (last-char (str (- len 1)))) (and (memv last-char '(#\= #\#)) ; is it #n= or #n#? (let ((n (string->number (substring str 0 (- len 1))))) (and (integer? n) (begin (if (not known-vals) ; save n so we know when we're done (begin (set! known-vals ()) (set! top-n n))) (if (char=? last-char #\=) ; #n= (and (eqv? (peek-char) #\() ; eqv? since peek-char can return #<eof> (let ((cur-val (assoc n known-vals))) ;; associate the number and the list it points to ;; if cur-val, perhaps complain? (#n# redefined) (let ((lst (catch #t read (lambda args ; a read error (set! known-vals #f) ; so clear our state (apply throw args))))) ; and pass the error on up (if cur-val (set! (cdr cur-val) lst) (set! known-vals (cons (set! cur-val (cons n lst)) known-vals)))) (if (= n top-n) ; replace our special keywords (let ((result (replace-syms cur-val))) (set! known-vals #f) ; '#1=(#+gsl #1#) -> '(:1)! result) (cdr cur-val)))) ; #n=<not a list>? ;; else it's #n# — set a marker for now since we may not ;; have its associated value yet. We use a symbol name that ;; string->number accepts. (symbol->keyword (symbol (number->string n) (string #\null) " ")))))) ; #n<not an integer>? ))))) ; #n<something else>? (do ((i 0 (+ i 1))) ((= i 10)) ;; load up all the #n cases (set! *#readers* (cons (cons (integer->char (+ i (char->integer #\0))) circular-list-reader) *#readers*))) > '#1=(1 2 . #1#) #1=(1 2 . #1#) > '#1=(1 #2=(2 . #2#) . #1#) #2=(1 #1=(2 . #1#) . #2#)当然，我们可以将它们当作标签使用：
(let ((ctr 0)) #1=(begin (format () "~D " ctr) (set! ctr (+ ctr 1)) (if (< ctr 4) #1# (newline))))这会打印 "0 1 2 3" 和一个换行符。
Length 如果传入循环列表则返回 +inf.0，如果传入 dotted list 则返回负数。 在 dotted 情况下，长度的绝对值是不计算最终 cdr 的列表长度。
(define (circular? lst) (infinite? (length lst)))。cyclic-sequences 返回其参数中的循环序列列表，或 nil。
(define (cyclic? obj) (pair? (cyclic-sequences obj)))。这是循环列表的一个有趣用途：
(define (for-each-permutation func vals) ;; apply func to every permutation of vals: ;; (for-each-permutation (lambda args (format () "~{~A~^ ~}~%" args)) '(1 2 3)) (define (pinner cur nvals len) (if (= len 1) (apply func (car nvals) cur) (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish ((= i len)) (let ((start nvals)) (set! nvals (cdr nvals)) (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list (set! (cdr start) (cdr nvals)) ; splice out that element and (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down, "wheels within wheels" (set! (cdr start) nvals)))))) ; restore original circle (let ((len (length vals))) (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle (pinner () vals len) (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shapes7 和 Snd 在变量名中使用 "*"，例如 *features*，来表示 该变量是预定义的。它可能在 macro 中不受保护地出现，例如。 "*" 并不意味着该变量在 CL 动态作用域的意义上是特殊的， 但需要一个清晰的标记来标识全局变量，这样程序员 就不会意外地踩到它。
虽然变量名的首字符更受限制，但目前 只有 #\\null、#\\newline、#\\tab、#\\space、#\\)、#\\(、#\\" 和 #\\; 不能 出现在名称中。我最初没有将双引号包含在这个集合中，所以像
(let ((nam""e 1)) nam""e)这样的疯狂代码 会工作，但那意味着'(1 ."hi")被解析为 1 和 symbol."hi"，而(string-set! x"hi")是一个错误。 首字符不应该是 #\\#、#'、#`、#,、#: 或上面提到的任何字符， 某些字符不能单独出现。例如，"." 不是合法的变量名， 但 ".." 是。 这些奇怪的 symbol 有时需要打印：> (list 1 (string->symbol (string #\; #\" #\\)) 2) (1 ;"\ 2) > (list 1 (string->symbol (string #\.)) 2) (1 . 2)这是一团糟。Guile 将第一个打印为
(1 #{\\;\\\"\\\\}# 2)。 在 CL 和一些 Scheme 中：[1]> (list 1 (intern (coerce (list #\; #\" #\\) 'string)) 2) ; thanks to Rob Warnock (1 |;"\\| 2) [2]> (equalp 'A '|A|) ; in CL case matters here T这很整洁，而且有传统的力量支持，但 我想我会改用 "symbol"：
> (list 1 (string->symbol (string #\; #\" #\\)) 2) (1 (symbol ";\"\\") 2)这个输出是可读的，而且不会吃掉像竖线这样 完全可用的字符，但这意味着我们不能轻松使用 像 "| e t c |" 这样的变量名。我们可以允许名称 以 "|" 开头和结尾时包含任何字符， 但那样一个竖线就很麻烦了。我们可以定义一个 reader 将
#symbol<...>转换为(symbol "...")， 使更广泛地使用奇怪的名称成为可能：(set! *#readers* (list (cons #\s (lambda (str) (let ((len (length str))) (and (string=? (substring str 0 7) "symbol<") (if (char=? (str (- len 1)) #\>) ; pointless use of #symbol! (symbol (substring str 7 (- len 1))) (do ((sym (substring str 7)) (c (read-char) (read-char))) ((memq c (list #\> #<eof>)) (string->symbol sym)) (set! sym (string-append sym (string c))))))))))) > (let ((#symbol<a b c> 32)) (+ #symbol<a b c> 1)) 33但有一个问题：如果我们尝试对这些 symbol token 使用 :readable 调用 object->string， 它不知道我们想让它使用我们的 "#symbol<...>" reader-macro。我们需要设置 *s7* 字段
'symbol-printer：> (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b"))))) f > (f) 3 > (object->string f :readable) "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))" ; not actually readable! > (set! (*s7* 'symbol-printer) (lambda (obj) (string-append "#symbol<" (symbol->string obj) ">"))) #<lambda (obj)> > (object->string f :readable) "(lambda () (let ((#symbol<a b> 3)) #symbol<a b>))"
symbol函数 接受任意数量的字符串参数，将其连接 形成新的 symbol 名称。这些 symbol 不仅仅是对字符串比较的优化：
> (define-macro (hi a) (let ((funny-name (string->symbol ";"))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) hi > (hi 2) 3 > (macroexpand (hi 2)) (let ((; 2)) (+ 1 ;)) ; for a good time, try (string #\") > (define-macro (hi a) (let ((funny-name (string->symbol "| e t c |"))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) hi > (hi 2) 3 > (macroexpand (hi 2)) (let ((| e t c | 2)) (+ 1 | e t c |)) > (let ((funny-name (string->symbol "| e t c |"))) ; now use it as a keyword arg to a function (apply define* `((func (,funny-name 32)) (+ ,funny-name 1))) ;; (procedure-source func) is (lambda* ((| e t c | 32)) (+ | e t c | 1)) (apply func (list (symbol->keyword funny-name) 2))) 3我希望这让你和我一样开心！
内置语法形式，如 "begin"，几乎是头等公民。
> (let ((progn begin)) (progn (define x 1) (set! x 3) (+ x 4))) 7 > (let ((function lambda)) ((function (a b) (list a b)) 3 4)) (3 4) > (apply begin '((define x 3) (+ x 2))) 5 > ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let) 3 (define-macro (symbol-set! var val) ; like CL's set `(apply set! ,var ',val ())) ; trailing nil is just to make apply happy — apply*? (define-macro (progv vars vals . body) `(apply (apply lambda ,vars ',body) ,vals)) > (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two))) 3我们可以拼接程序片段（"看妈妈，没有 macro！"）：
(let* ((x 3) (arg '(x)) (body `((+ ,x x 1)))) ((apply lambda arg body) 12)) ; "legolambda"? (define (engulph form) (let ((body `(let ((L ())) (do ((i 0 (+ i 1))) ((= i 10) (reverse L)) (set! L (cons ,form L)))))) (define function (apply lambda () (list (copy body)))) (function))) (let () (define (hi a) (+ a x)) ((apply let '((x 32)) (list (procedure-source hi))) 12)) ; one function, many closures? (let ((ctr -1)) ; (enum zero one two) but without using a macro (apply begin (map (lambda (symbol) (set! ctr (+ ctr 1)) (list 'define symbol ctr)) ; e.g. '(define zero 0) '(zero one two))) (+ zero one two))但有更优雅的方式实现 enum（"transparent-for-each"）：
> (define-macro (enum . args) `(for-each define ',args (iota (length ',args)))) enum > (enum a b c) #<unspecified> > b 1现在我们注意到
(case 0.0 ((0.0) 1) (else 0))是 1，但 如何将 pi 放入 key 列表？> (apply case 'pi `(((,pi) 1) (else 0))) 1 > (let ((lst '(1 2))) (apply case 'lst `(((,lst) 1) (else 0)))) 1 ; same trick puts a list in the keys > (apply case '+nan.0 `(((,+nan.0) 1) (else 0))) 0 ; (eqv? +nan.0 +nan.0) is #f
(apply define ...)类似于 CL 的 set。> ((apply define-macro '((m a) `(+ 1 ,a))) 3) 4 > ((apply define '((hi a) (+ a 1))) 3) 4Apply let 与 eval 非常相似：
> (apply let '((a 2) (b 3)) '((+ a b))) 5 > (eval '(+ a b) (inlet 'a 2 'b 3)) 5 > ((apply lambda '(a b) '((+ a b))) 2 3) 5 > (apply let '((a 2) (b 3)) '((list + a b))) ; a -> 2, b -> 3 (+ 2 3)看起来冗余的双层列表是为了 apply 的好处。我们可以 改用尾部 null（模仿某些古老 lisp 中的 apply*）：
> (apply let '((a 2) (b 3)) '(list + a b) ()) (+ 2 3)Scheme 声称它对表达式求值 car，然后用表达式的其余部分调用 结果。所以
((if x + -) y z)根据 x 调用(+ y z)或(- y z)。 但据我所知，只有 s7 能处理((if x or and) y z)。catch、dynamic-wind 和标准 Scheme 中许多其他接受函数 参数的函数在 s7 中也接受 macro，dynamic-wind 还接受 #f 作为初始和最终条目。
目前，你不能将内置语法关键字 set! 为某个新值：
(set! if 3)。 let-temporarily 使用 set!，所以(let-temporarily ((if 3))...)也不太可能工作。说到速度... 广泛认为 一个所有东西都是一等公民的 Scheme 不可能与任何 "真正的" Scheme 竞争。我表示不屑。看看这个小例子（它并不是 误导到让我感到内疚的程度）：
(define (do-loop n) (do ((i 0 (+ i 1))) ((= i n)) (if (zero? (modulo i 1000)) (display "."))) (newline)) (for-each do-loop (list 1000 1000000 10000000))在 s7 中，在我的家用机器上这需要 0.09 秒。在 tinyScheme 中，我们 的起源地，它需要 85 秒。在 chicken 解释器中，5.3 秒，编译后（使用 -O2）的 chicken 编译器输出， 0.75 秒。所以，s7 的速度与 chicken 相当，即使 chicken 是编译到 C 的。我认为 Guile 2.0.9 大约需要 1 秒。 CL 中的等价代码： clisp 解释执行 9.3 秒，编译后 0.85 秒；sbcl 0.21 秒。 类似地，s7 计算 (fib 40) 需要 0.8 秒，大约与 sbcl 相同。 Guile 2.2.3 需要 7 秒。
s7 的时间测试在其 tools 目录中。脚本 valcall.scm 通过 callgrind 运行它们。结果 可以在 s7.c 的末尾找到。 如果你对标准 Scheme 基准测试感兴趣，可以 将 s7 添加到该包中。首先，s7-prelude.scm 和 s7-postlude.scm 需要添加到基准测试的 src 目录中。 s7-postlude.scm 可以为空。我的 s7-prelude.scm 版本是：
(define (this-scheme-implementation-name) "s7") (define exact-integer? integer?) (define (exact-integer-sqrt i) (let ((sq (floor (sqrt i)))) (values sq (- i (* sq sq))))) (define inexact exact->inexact) (define exact inexact->exact) (define (square x) (* x x)) (define (vector-map f v) (copy v)) ; for quicksort.scm (define-macro (import . args) #f) (define (jiffies-per-second) 1000) (define (current-jiffy) (round (* (jiffies-per-second) (*s7* 'cpu-time)))) (define (current-second) (floor (*s7* 'cpu-time))) (define make-bytevector make-byte-vector) (define bytevector-u8-set! byte-vector-set!) (set! (*s7* 'symbol-quote?) #t)如果你想运行 gcbench，从 r7rs.scm 添加 define-record-type macro。 以下是 bench 脚本的 diff：
141a142 > S7=${S7:-"/home/bil/motif-snd/repl"} 187a189 > s7 for s7 406a409,421 > # Definitions specific to s7 > > s7_comp () > { > : > } > > s7_exec () > { > time ${S7} "$1" < "$2" > } > > # ----------------------------------------------------------------------------- 940a957,966 > > s7) NAME='s7' > COMP=s7_comp > EXEC=s7_exec > COMPOPTS="" > EXTENSION="scm" > EXTENSIONCOMP="scm" > COMPCOMMANDS="" > EXECCOMMANDS="" > ;;我将 s7 的独立版本称为 "repl"，所以它的路径是 /home/bil/motif-snd/repl。要构建 repl，从 https://ccrma.stanford.edu/software/s7/s7.tar.gz 获取 s7.tar.gz； 如果不使用 gcc 或 clang，将空文件 mus-config.h 添加到 tarball 的内容中， 然后（在 Linux 中）：
gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -ldl -lm -Wl,-export-dynamic ;; tcc -o s7 s7.c -I. -lm -DWITH_MAIN -ldl -rdynamic -DWITH_C_LOADER对于时间测试，我添加 "-fomit-frame-pointer -funroll-loops -march=native"。 mus-config.h 通常包含
#define HAVE_COMPLEX_NUMBERS 1 #define HAVE_COMPLEX_TRIG 1但 s7.c 有默认值，所以 mus-config.h 可以为空，或不存在。 最后，回到基准测试目录并执行
bench s7 allpi.scm 和 chudnovsky.scm 需要 gmp 版本的 s7。 截至 2023 年 10 月 24 日，s7 将 '<> 视为 (#_quote <>)，所以 dynamic.scm 无法运行，peval.scm 得到错误结果， 但 (set! (*7s* 'symbol-quote?) #t) 可以修复此问题。 我在 AMD 3950X 机器上运行了 bench 脚本，得到以下结果（以秒为单位）： ack: 6.6, array1: 6.4, browse: 11.2, bv2string: 4.1, cat: 0.4, compiler: 16.9, conform: 30.0, cpstak: 42.8, ctak: 16.6, deriv: 9.7, destruc: 8.6, diviter: 3.7, divrec: 4.6, dynamic: 12.6, earley: 25.5, equal: 0.3, fft: 12.5, fib: 6.1, fibc: 8.6, fibfp: 1.1, gcbench: 12.9, graphs: 72.5, lattice: 63.4, matrix: 21.0, maze: 11.4, mazefun: 9.8, mbrot: 12.6, mbrotZ: 8.0, mperm: 18.9, nboyer: 20.1, nqueens: 27.0, ntakl: 8.0, nucleic: 8.3, paraffins: 4.4, parsing: 20.7, peval: 15.2, pnpoly: 9.8, primes: 10.2, puzzle: 10.2, quicksort: 40.0, ray: 8.3, read1: 0.2, sboyer: 19.1, scheme: 29.5, simplex: 26.9, slatex: 4.2, string: 0.3, sum1: 0.2, sum: 4.1, sumfp: 2.2, tail: 0.1, tak: 7.1, takl: 8.1, triangl: 16.4, wc: 4.9。在 gmp 情况下，chudnovsky: 0.017, pi: .01。
在 s7 中，只有一种 begin 语句， 它可以包含定义和表达式。它们按出现顺序 在求值点的环境中求值。我将它 视为一个小 REPL。begin 不会在当前环境中引入新帧， 所以 define 发生在外层环境中。 最后，begin，无论是显式的还是隐式的，都不假装模拟 letrec*。
如果我们允许在任何地方定义，"词法作用域"的概念就变得有问题。 Scheme 在这方面已经是一团糟：
(let ((x 1)) (do ((y x x) (x 3)) ((> y 1) y)))在
(y x x)中，第一个 x 是外层的，第二个是 后面的 do 变量，所以这返回 3！但坚持使用 define，在(let ((x 1)) (define y x) (define x 2) y)s7 返回 1，即使从技术上讲第二个 x 在 y 的环境中。 由于我们将此视为 REPL，y 从定义时点上唯一定义的 x 获取值。然而，
(let ((x 1)) (define y (lambda () x)) (define x 2) (y))在 s7 中返回 2，因为 y 函数体中的 x 直到第二个 x 被定义后才被求值。 define 向后传播，但：
(list x (define x 0))，或(list x (begin (define x 0) x))。r7rs 兼容性代码在 r7rs.scm 中，也内置于 s7。
(set (*s7* 'scheme-version) 'r7rs)可以获得 r7rs 而不是原生 s7。 r7rs 中的错误处理例程均未实现；详见 r7rs.scm 中的注释。 floor/ 和 truncate/ 无法按预期工作：它们假设多个值 不会被拼接。"division library" 是一个微不足道、无意义的微优化。 s7 没有内置的 parameters。r7rs.scm 中有 command-line 函数，使（至少在 Linux 上）将 s7 用作脚本引擎更容易。假设我们有一个编译好的 s7 repl.c 并加载到文件 "repl" 中， 还有一个名为 "runit" 的文件，内容如下：
#!repl !# (load "r7rs.scm") (display (command-line)) (newline) (exit)现在通过 chmod 使 runit 可执行，并用一些参数运行它：
runit 123 abc它打印：("repl" "runit" "123" "abc")