控制操作

本章介绍了作为Scheme程序控制结构的语法式和过程。第一部分覆盖了最基本的控制结构、过程应用,其余部分覆盖了顺序、条件求值、递归、映射、延续、延迟求值,多值及在运行时构建的程序的求值。

5.1 过程应用

语法:(expr0 expr1 ...)
返回:将expr0的值应用于expr1 ... 的值所产生的值

过程应用是最基本的Scheme的控制结构。任何结构化的式子,第一个位置是语法关键字的除外,都是一个过程调用。表达式expr0expr1 ...,都会被求值,且每个表达式都会得到单个值。所有这些表达式求值后,expr0的值会被应用于expr1 ... 这些表达式的值。若expr0求值之后不是一个过程,或者该过程接受的参数个数跟提供的不同,此时会抛出一个条件类型为&assertion的异常。

至于过程本身和其参数表达式的求值顺序是不定的。可以是从左到右、从右到左,或任意其他顺序。然而求值是有次序保证的,即,不管选择何种顺序,每个表达式都会在下一个表达式开始求值之前求值完成。

(+ 3 4) => 7

((if (odd? 3) + -) 6 2) => 8

((lambda (x) x) 5) => 5

(let ([f (lambda (x) (+ x x))])
  (f 8)) => 16

过程:(apply procedure obj ... list)
返回:将procedure应用于obj... 和list的元素而得到的值
:(rnrs base), (rnrs)

apply调用procedure,将第一个obj作为第一个参数传递,将第二个obj作为第二个参数传递,按照此方式依次处理obj ... 中的每一个对象。并按顺序传递list的元素作为其余参数传递给过程。因此,调用procedure的参数与objslist的元素一样多。

当要传递给过程一些或所有参数都在列表内时,apply非常有用,因为这会让程序员免于显式地对列表进行解构。

(apply + '(4 5)) => 9

(apply min '(6 8 3 2 5)) => 2

(apply min  5 1 3 '(6 8 3 2 5)) => 1

(apply vector 'a 'b '(c d e)) => #(a b c d e)

(define first
  (lambda (ls)
    (apply (lambda (x . y) x) ls)))
(define rest
  (lambda (ls)
    (apply (lambda (x . y) y) ls)))
(first '(a b c d)) => a
(rest '(a b c d)) => (b c d)

(apply append
  '(1 2 3)
  '((a b) (c d e) (f))) => (1 2 3 a b c d e f)

5.2 顺序

语法:(begin expr1 expr2 ...)
返回:最后一个子表达式的值
:(rnrs base), (rnrs)

表达式expr1 expr2 ... 会依次从左到右被求值。begin常用来顺序化赋值、输入/输出,或其他导致副作用的操作。

(define x 3)
(begin
  (set! x (+ x 1))
  (+ x x)) => 8

begin式可以包含零个或多个定义来代替表达式expr1 expr2 ...,在这种情况下,它被认为是一个定义,只有在定义有效的位置才会出现。

(let ()
  (begin (define x 3) (define y 4))
  (+ x y)) => 7

这种形式的begin主要用于必须扩展为多个定义的语法扩展。(参见101 页)

很多语法式的主体,包括lambdacase-lambdaletlet*letrec,以及condcasedo的结果子句,都被视为在一个隐含的begin内部。也就是说,组成主体或结果子句的表达式按顺序执行,并且将最后一个表达式的值作为结果返回。

(define swap-pair!
  (lambda (x)
    (let ([temp (car x)])
      (set-car! x (cdr x))
      (set-cdr! x temp)
      x)))
(swap-pair! (cons 'a 'b)) => (b . a)

5.3 条件式

语法:(if test consequent alternative)
语法:(if test consequent)
返回:取决于test的值,会返回其中consequentalternative的值
:(rnrs base), (rnrs)

testconsequentalternative子式必须为表达式。若test求值后为真值(除#f之外的任何值),consequent会被求值并返回其值。否则,alternative会被求值并返回其值。使用第二个没有alternative的单支式子,若test求值之后为假值,此时结果未指定。

(let ([ls '(a b c)])
  (if (null? ls)
      '()
      (cdr ls))) => (b c)

(let ([ls '()])
  (if (null? ls)
      '()
      (cdr ls))) => ()

(let ([abs
       (lambda (x)
         (if (< x 0)
             (- 0 x)
             x))])
  (abs -4)) => 4

(let ([x -4])
  (if (< x 0)
      (list 'minus (- 0 x))
      (list 'plus 4))) => (minus 4)

过程:(not obj)
返回:若obj为假,返回#t,否则返回#f
:(rnrs base), (rnrs)

not等价于(lambda (x) (if x #f #t))

(not #f) => #t
(not #t) => #f
(not '()) => #f
(not (< 4 5)) => #f

语法:(and expr ...)
返回:见下文
:(rnrs base), (rnrs)

如果不包含子表达式,即(and)and式值为#t。否则,and会依次从左到右对每个子表达式求值,直到剩余一个子表达式或遇到一个表达式返回#f。如果剩余一个子表达式,该表达式会被求值,并返回其值。若遇到一个表达式返回#fand直接返回#f,后续的子表达式不会被求值。62 页介绍了一种and的语法定义。

(let ([x 3])
  (and (> x 2) (< x 4))) => #t

(let ([x 5])
  (and (> x 2) (< x 4))) => #f

(and #f '(a b) '(c d)) => #f
(and '(a b) '(c d) '(e f)) => (e f)

语法:(or expr ...)
返回:见下文
:(rnrs base), (rnrs)

若不包含子表达式,即(or)or式值为#f。否则,or会依次从左到右对每个子表达式求值,直到剩余一个子表达式或遇到一个表达式返回非#f的值。如果剩余一个子表达式,该表达式会被求值,并返回其值。若遇到一个表达式返回非#f的值,or直接返回该值,后续的子表达式不会被求值。63 页介绍了一种or的语法定义。

(let ([x 3])
  (or (< x 2) (> x 4))) => #f

(let ([x 5])
  (or (< x 2) (> x 4))) => #t

(or #f '(a b) '(c d)) => (a b)

语法:(cond clause1 clause2 ...)
返回:见下文
:(rnrs base), (rnrs)

除了最后一个,每个clause必须符合以下其中之一的形式。

(test) (test expr1 expr2 ...) (test => expr)

最后一个子式可以是以上其中任意之一的形式,或是一个形式如下的“else子式” (else expr1 expr2 ...)

每个test依次会被求值,直到其中之一求值为真,或所有的测试表达式都已被求值。若第一个子式的test求值为真且符合以上第一个形式,此时会返回test的值。

若第一个子式的test求值为真,且符合以上第二个形式,表达式expr1 expr2...会依次被求值,并返回最后一个表达式的值。

若第一个子式的test求值为真,且符合以上第三个形式,表达式expr会被求值。它的值是一个单个参数的过程,该过程会应用于test的值。会返回这个过程调用的值。

若没有测试表达式求值为真,且有else子句,else子式的表达式expr1 expr2 ... 会依次被求值,并返回最后一个表达式的值。

若没有测试表达式求值为真,并且没有else子句,则返回值不确定。

305 页提供了cond的一种语法定义。

(let ([x 0])
  (cond
    [(< x 0) (list 'minus (abs x))]
    [(> x 0) (list 'plus x)]
    [else (list 'zero x)])) => (zero 0)

(define select
  (lambda (x)
    (cond
      [(not (symbol? x))]
      [(assq x '((a . 1) (b . 2) (c . 3))) => cdr]
      [else 0])))

(select 3) => #t
(select 'b) => 2
(select 'e) => 0

语法:else
返回:=>
:(rnrs base), (rnrs exceptions), (rnrs)

这些标识符都是cond的辅助关键字。这两个关键字都可以作为guard的辅助关键字,else也可以作为case的辅助关键字。引用这些标识符是违法语法的,除非在它们被识别为辅助关键字的上下文中。

语法:(when test-expr expr1 expr2 ...)
语法:(unless test-expr expr1 expr2 ...)
返回:见下文
:(rnrs control), (rnrs)

对于when,如果test-expr求值为真,则表达式expr1 expr2 ... 会依次被求值,并返回最后一个表达式的值。如果test-expr求值为假,则任何其他的表达式都不会被求值,并且when的值未指定。

对于unless,若test-expr求值为假,表达式expr1 expr2 ... 会依次被求值,且返回最后一个表达式的值。若test-expr求值为真,则任何其他的表达式都不会被求值,并且unless的值未指定。

whenunless表达式通常比相应的单分支if表达式更为清晰。

(let ([x -4] [sign 'plus])
  (when (< x 0)
    (set! x (- 0 x))
    (set! sign 'minus))
  (list sign x)) => (minus 4)

(define check-pair
  (lambda (x)
    (unless (pair? x)
      (syntax-violation 'check-pair "invalid argument" x))
    x))

(check-pair '(a b c)) => (a b c)

when可定义如下:

define-syntax when
  (syntax-rules ()
    [(_ e0 e1 e2 ...)
     (if e0 (begin e1 e2 ...))]))

unless可定义如下:

(define-syntax unless
  (syntax-rules ()
    [(_ e0 e1 e2 ...)
     (if (not e0) (begin e1 e2 ...))]))

unless使用when定义如下:

(define-syntax unless
  (syntax-rules ()
    [(_ e0 e1 e2 ...)
     (when (not e0) e1 e2 ...)]))

语法:(case expr0 clause1 clause2 ...)
返回:见下文
:(rnrs base), (rnrs)

除了最后一个子式,每个子式必须符合形式

((key ...) expr1 expr2 ...)

其中,与其他键不同,key是一个数据。最后一个子式可以是上述的形式,或是具有如下形式的一个else子式

(else expr1 expr2 ...)

expr0会被求值,其值会与每个子式的键依次比较(使用eqv?)。如果找到一个包含匹配键的子式,表达式expr1 expr2 ... 会被依次求值,并且最后一个表达式的值作为结果返回。

如果没有包含匹配键的子式,且包含else子式,else的表达式expr1 expr2 ... 会被依次求值,并且最后一个表达式的值作为结果返回。

如果没有包含匹配键的子式,且不存在else子式,则其值未指定。

参见306case的一个语法定义。

(let ([x 4] [y 5])
  (case (+ x y)
    [(1 3 5 7 9) 'odd]
    [(0 2 4 6 8) 'even]
    [else 'out-of-range])) => odd

5.4 递归和迭代

语法:(let name ((var expr) ...) body1 body2 ...)
返回:最后一个主体(body)表达式的值
:(rnrs base), (rnrs)

这种形式的let,称之为命名的let,是一种通用的迭代和递归结构。它类似于更常见的let式(见4.4 部分)的body1 body2 ... 内的变量var ... 到expr ... 的绑定,这些绑定的处理和求值类似于lambda的主体。除此之外,在过程主体内绑定的变量name可以被调用以实现循环或迭代。过程的参数会变成变量var .... 新的值。

一个形式如下的命名的let表达式

(let name ((var expr) ...) body1 body2 ...)

可以使用letrec重写为: ((letrec ((name (lambda (var ...) body1 body2 ...))) name) expr ...)

可以在312 页找到实现此转换并处理未命名的 letlet的语法定义。

下面定义的divisors过程使用了命名的let计算一个非负整数的非平凡除数。

 (define divisors
  (lambda (n)
    (let f ([i 2])
      (cond
        [(>= i n) '()]
        [(integer? (/ n i)) (cons i (f (+ i 1)))]
        [else (f (+ i 1))]))))

(divisors 5) => ()
(divisors 32) => (2 4 8 16)

当找到除数时,上面的版本是一个非尾递归,而当找不到除数时,则是一个尾递归。下面的版本是完全尾递归的。它以相反的顺序构建列表,但如果需要,可以通过在退出时反转列表来轻松修复。

(define divisors
  (lambda (n)
    (let f ([i 2] [ls '()])
      (cond
        [(>= i n) ls]
        [(integer? (/ n i)) (f (+ i 1) (cons i ls))]
        [else (f (+ i 1) ls)]))))

语法:(do ((var init update) ...) (test result ...) expr ...)
返回:最后一个result表达式的值
:(rnrs control), (rnrs)

do允许简洁地表达一种常见的受限形式的迭代。变量var ... 初始时会绑定init ... 的值,并随着每次的迭代重新绑定为update ... 的值。表达式testupdate ..., expr ...,和result... 都在var ... 建立的绑定作用域内。

在每个步骤中,测试表达式test会被求值。如果test的值为真,则迭代停止,表达式result ... 会依次被求值,并返回最后一个表达式的值。若不存在结果表达式,则do表达式的值是未指定的。

如果test的值为假,则表达式expr ... 会依次被求值,并计算表达式update ...,此时会创建变量var ... 到update ... 的新绑定,并继续迭代。

表达式expr ... 求值仅仅为了副作用,通常可以全部省略。任何的update表达式也可以忽略,这种情况下,效果等同于update仅仅就是对应的var

尽管在大多数编程语言中,循环结构需要通过赋值更新循环操作数,而do需要循环操作数var ... 通过重新绑定得以更新。实际上,在do表达式的求值过程中不涉及任何副作用,除非其子表达式有显式地执行副作用。

313 页有do的语法定义。

下面的factorialfibonacci的定义是3.2 节中给出的尾递归的命名let版本的直接转换。

(define factorial
  (lambda (n)
    (do ([i n (- i 1)] [a 1 (* a i)])
        ((zero? i) a))))

(factorial 10) => 3628800

(define fibonacci
  (lambda (n)
    (if (= n 0)
        0
        (do ([i n (- i 1)] [a1 1 (+ a1 a2)] [a2 0 a1])
            ((= i 1) a1)))))

(fibonacci 6) => 8

下面的divisors的定义类似于上面我们使用命名let描述的尾递归版本。

(define divisors
  (lambda (n)
    (do ([i 2 (+ i 1)]
         [ls '()
             (if (integer? (/ n i))
                 (cons i ls)
                 ls)])
        ((>= i n) ls))))

下面的scale-vector!定义展示了非空do主体的使用,其对向量v的每个元素按常数k进行缩放。

(define scale-vector!
  (lambda (v k)
    (let ([n (vector-length v)])
      (do ([i 0 (+ i 1)])
          ((= i n))
        (vector-set! v i (* (vector-ref v i) k))))))

(define vec (vector 1 2 3 4 5))
(scale-vector! vec 2)
vec => #(2 4 6 8 10)

5.5 映射和折叠

当一个程序必须循环或迭代列表元素时,使用映射或折叠运算符常常会更方便。这些运算符通过将一个过程逐个应用于列表的元素,从而抽象了空列表的判断和显式的递归。一些映射运算符也可用于向量和字符串。

过程:(map procedure list1 list2 ...)
返回:每个元素执行过程的结果组成的列表
:(rnrs base), (rnrs)

mapprocedure应用在列表list1 list2 ... 对应的元素上,并返回结果值的一个列表。列表list1 list2 ... 必须具有相同的长度。procedure接收的参数的数目应与列表的数目相同,应该返回单个值,并且不能修改传入的list参数。

(map abs '(1 -2 3 -4 5 -6)) => (1 2 3 4 5 6)

(map (lambda (x y) (* x y))
     '(1 2 3 4)
     '(8 7 6 5)) => (8 14 18 20)

虽然过程应用本身发生的顺序是未指定的,但输出列表中的元素值的顺序与输入列表里的相应的元素值的顺序是相同的。

map可以定义如下:

(define map
  (lambda (f ls . more)
    (if (null? more)
        (let map1 ([ls ls])
          (if (null? ls)
              '()
              (cons (f (car ls))
                    (map1 (cdr ls)))))
        (let map-more ([ls ls] [more more])
          (if (null? ls)
              '()
              (cons
                (apply f (car ls) (map car more))
                (map-more (cdr ls) (map cdr more))))))))

这个版本的map不会进行错误检查,f假定是一个过程,且其他参数假定都是相同长度的正规列表。这个定义的一个有趣的特点是map使用其自身取出输入列表组成的列表的头和尾,之所以能工作是因为有了单个列表情况的特殊处理。

过程:(for-each procedure list1 list2 ...)
返回:未指定
:(rnrs base), (rnrs)

for-each类似于map,除了for-each不创建和返回结果值的列表,并且for-each保证按从左到右的顺序应用列表元素。procedure接收的参数的数目应该与列表的数目相同,且不能修改传入的list参数。没有错误检查的for-each可以定义如下。

define for-each
  (lambda (f ls . more)
    (do ([ls ls (cdr ls)] [more more (map cdr more)])
        ((null? ls))
      (apply f (car ls) (map car more)))))

(let ([same-count 0])
  (for-each
    (lambda (x y)
      (when (= x y)
        (set! same-count (+ same-count 1))))
    '(1 2 3 4 5 6)
    '(2 3 3 4 7 6))
  same-count) => 3

过程:(exists procedure list1 list2 ...)
返回:见下文
:(rnrs lists), (rnrs)

list1 list2 ... 列表必须具有相同的长度。procedure接收的参数的数目应该与列表的数目相同,且不能修改传入的list参数。若传入的列表为空(没有list),exists返回#f。否则,exists会将procedure依次应用在列表list1 list2 ... 对应的元素上,直到每个列表只有一个元素,或procedure返回一个真值t。在前一种情况下,exists尾调用procedure,将其应用于每个列表的剩余元素。在后一种情况下,exists返回t

(exists symbol? '(1.0 #\a "hi" '())) => #f

(exists member
        '(a b c)
        '((c b) (b a) (a c))) => (b a)

(exists (lambda (x y z) (= (+ x y) z))
        '(1 2 3 4)
        '(1.2 2.3 3.4 4.5)
        '(2.3 4.4 6.4 8.6)) => #t

exists可定义如下(有些低效且没有错误检查):

(define exists
  (lambda (f ls . more)
    (and (not (null? ls))
      (let exists ([x (car ls)] [ls (cdr ls)] [more more])
        (if (null? ls)
            (apply f x (map car more))
            (or (apply f x (map car more))
                (exists (car ls) (cdr ls) (map cdr more))))))))

过程:(for-all procedure list1 list2 ...)
返回:见下文
:(rnrs lists), (rnrs)

list1 list2 ... 列表必须具有相同的长度。procedure接收的参数的数目应该与列表的数目相同,且不能修改传入的list参数。若传入的列表为空(没有list),for-all返回#t。否则,for-all会将procedure依次应用在列表list1 list2 ... 的对应的元素上,直到每个列表只有一个元素,或procedure返回一个假值#f。在前一种情况下,for-all尾调用procedure,将其应用于每个列表的剩余元素。在后一种情况下,for-all返回#f

(for-all symbol? '(a b c d)) => #t

(for-all =
         '(1 2 3 4)
         '(1.0 2.0 3.0 4.0)) => #t

(for-all (lambda (x y z) (= (+ x y) z))
         '(1 2 3 4)
         '(1.2 2.3 3.4 4.5)
         '(2.2 4.3 6.5 8.5)) => #f

for-all可定义如下(有些低效且没有错误检查):

(define for-all
  (lambda (f ls . more)
    (or (null? ls)
      (let for-all ([x (car ls)] [ls (cdr ls)] [more more])
        (if (null? ls)
            (apply f x (map car more))
            (and (apply f x (map car more))
                 (for-all (car ls) (cdr ls) (map cdr more))))))))

过程:(fold-left procedure obj list1 list2 ...)
返回:见下文
:(rnrs lists), (rnrs)

list参数应该都具有相同的长度。procedure应该接收比list参数的数目多一个参数并返回单个值。它不应该修改list参数。

如果list参数为空,fold-left返回obj。如果不为空,fold-left会将procedure应用在obj和每个列表list1 list2 ... 的头(car)上,然后使用procedure返回的值代替obj,并用list各列表的尾(cdr)替换list

(fold-left cons '() '(1 2 3 4)) => ((((() . 1) . 2) . 3) . 4)

(fold-left
  (lambda (a x) (+ a (* x x)))
  0 '(1 2 3 4 5)) => 55

(fold-left
  (lambda (a . args) (append args a))
  '(question)
  '(that not to)
  '(is to be)
  '(the be: or)) => (to be or not to be: that is the question)

过程:(fold-right procedure obj list1 list2 ...)
返回:见下文
:(rnrs lists), (rnrs)

list参数应该都具有相同的长度。procedure应该接收比list参数的数目多一个参数并返回单个值。它不应该修改list参数。

如果list参数为空,fold-right返回obj。若不为空,fold-right会反复使用list各列表的尾(cdr)替换list,然后将procedure应用于列表list1 list2 ... 的头(car)和递归返回的结果。

(fold-right cons '() '(1 2 3 4)) => (1 2 3 4)

(fold-right
  (lambda (x a) (+ a (* x x)))
  0 '(1 2 3 4 5)) => 55

(fold-right
  (lambda (x y a) (cons* x y a))   => (parting is such sweet sorrow
  '((with apologies))                  gotta go see ya tomorrow
  '(parting such sorrow go ya)         (with apologies))
  '(is sweet gotta see tomorrow))

过程:(vector-map procedure vector1 vector2 ...)
返回:各结果值组成的向量
:(rnrs base), (rnrs)

vector-mapprocedure应用在vector1 vector2 ... 对应的各元素上,并返回结果值的向量。各向量vector1 vector2 ... 必须具有相同的长度,除此以外procedure接收的参数的数目应该与参数中向量的个数相同,且procedure返回单个值。

(vector-map abs '#(1 -2 3 -4 5 -6)) => #(1 2 3 4 5 6)
(vector-map (lambda (x y) (* x y))
  '#(1 2 3 4)
  '#(8 7 6 5)) => #(8 14 18 20)

虽然应用本身的顺序未指定,但输出向量的各元素值的顺序与输入向量中对应的元素值的顺序相同。

过程:(vector-for-each procedure vector1 vector2 ...)
返回:未指定
:(rnrs base), (rnrs)

vector-for-each类似于vector-map,除了vector-for-each没有创建和返回结果值的向量,且vector-for-each保证按从左到右的顺序应用列表元素。

(let ([same-count 0])
  (vector-for-each
    (lambda (x y)
      (when (= x y)
        (set! same-count (+ same-count 1))))
    '#(1 2 3 4 5 6)
    '#(2 3 3 4 7 6))
  same-count) => 3

过程:(string-for-each procedure string1 string2 ...)
返回:未指定
:(rnrs base), (rnrs)

string-for-each类似于for-eachvector-for-each,除了输入是字符串而不是列表或向量。

(let ([ls '()])
  (string-for-each
    (lambda r (set! ls (cons r ls)))
    "abcd"
    "===="
    "1234")
  (map list->string (reverse ls))) => ("a=1" "b=2" "c=3" "d=4")

5.6 延续

Scheme中的延续在计算中代表从某个点开始的剩余部分计算的函数,可通过call-with-current-continuation获得,可简写为call/cc

过程:(call/cc procedure)
过程:(call-with-current-continuation procedure)
返回:见下文
:(rnrs base), (rnrs)

这些过程都是相同的。短名字常被使用的明显原因是它需要更少的击键次数。

call/cc获得它的延续,并将它传给接收一个参数的procedure过程。延续本身由一个过程表示。每次将这个过程应用于零个或多个值时,它将值返回给call/cc应用的延续。也就是说,当延续过程被调用时,它会将其参数返回作为call/cc应用的值。

若传递延续过程给procedure时,且procedure正常返回,procedure返回的值就是call/cc返回的值。

延续允许实现非局部退出,回溯 [14 ,29 ], 协程[16 ],和多任务[10 ,32 ].

下面的示例说明了使用延续从一个循环里执行非局部退出。

(define member
  (lambda (x ls)
    (call/cc
      (lambda (break)
        (do ([ls ls (cdr ls)])
            ((null? ls) #f)
          (when (equal? x (car ls))
            (break ls)))))))

(member 'd '(a b c)) => #f
(member 'b '(a b c)) => (b c)

其他示例在3.312.11 章节给出。

当前延续通常在内部表示为过程激活记录的堆栈,并且获得延续涉及将栈封装到过程对象里。由于一个封装的堆栈可有无限的扩展性,因此必须使用一些机制来无限期地保持堆栈的内容。这需要有可观的易用性和效率,且不会对不使用延续的程序造成影响17

过程:(dynamic-wind in body out)
返回body表达式产生的值
:(rnrs base), (rnrs)

dynamic-wind会为延续的调用提供“保护”。当进入或离开body时必须要执行一定任务时,dynamic-wind对这种情况的处理非常有用,这种进入或离开可以是正常的,也可以是由延续应用造成的。

inbodyout这三个参数必须是过程,并且接收零个参数,也就是说,它们应该是thunks(任务盒)。在应用body之前,每次调用通过body内部创建的延续随后进入body时,in任务盒会被应用。每次从body正常退出或调用body外创建的延续导致body退出时,out任务盒会被应用。

这样的话,能保证in至少被调用一次。此外,若body返回,out至少被调用一次。

以下的示例展示了使用dynamic-wind确保输入端口(port)在处理后关闭,无论处理是否正常完成。

(let ([p (open-input-file "input-file")])
  (dynamic-wind
    (lambda () #f)
    (lambda () (process p))
    (lambda () (close-port p))))

Common Lisp提供了一种类似的工具(unwind-protect) 以防止非局部退出。通常情况下,这就足够了。unwind-protect仅提供了与out等价的能力,因为Common Lisp不支持完全通用的延续。这里是使用dynamic-wind实现unwind-protect一种方式。

(define-syntax unwind-protect
  (syntax-rules ()
    [(_ body cleanup ...)
     (dynamic-wind
       (lambda () #f)
       (lambda () body)
       (lambda () cleanup ...))]))

((call/cc
   (let ([x 'a])
     (lambda (k)
       (unwind-protect
         (k (lambda () x))
         (set! x 'b)))))) => b

一些Scheme实现支持一种受控形式的赋值-fluid binding;在这种结构里,某变量会在指定的计算里采取一个临时的值,并在计算完成时恢复到原有的值。下面fluid-let语法式使用dynamic-wind定义,允许在b1 b2 .... 体里单个变量x流动绑定到表达式e的值上。

(define-syntax fluid-let
  (syntax-rules ()
    [(_ ((x e)) b1 b2 ...)
     (let ([y e])
       (let ([swap (lambda () (let ([t x]) (set! x y) (set! y t)))])
         (dynamic-wind swap (lambda () b1 b2 ...) swap)))]))

支持fluid-let的实现通常将其扩展为接收无限多对(x e),就像let一样。

若在fluid-let体内没有延续被调用,其行为等价于变量在进入时赋新值并在退出时赋旧值。

(let ([x 3])
  (+ (fluid-let ([x 5])
       x)
     x)) => 8

如果在fluid-let外创建的延续被调用,则流动绑定的变量也会恢复到旧值。

(let ([x 'a])
  (let ([f (lambda () x)])
    (cons (call/cc
            (lambda (k)
              (fluid-let ([x 'b])
                (k (f)))))
          (f)))) => (b . a)

如果代码控制离开了fluid-let体,不管正常或是由于延续的调用,当延续调用导致控制重新进入了代码体时,则流动绑定变量的临时值会恢复。此外,任何对临时值的更改都会保持并在在重新进入时反映出来。

(define reenter #f)
(define x 0)
(fluid-let ([x 1])
  (call/cc (lambda (k) (set! reenter k)))
  (set! x (+ x 1))
  x) => 2
x => 0
(reenter '*) => 3
(reenter '*) => 4
x => 0

假设dynamic-wind没有内建在实现里,一个用于展示其实现的库如下。除了定义了dynamic-wind,下面的代码还定义了call/cc的一个版本,其作用是支持dynamic-wind

(library (dynamic-wind)
  (export dynamic-wind call/cc
    (rename (call/cc call-with-current-continuation)))
  (import (rename (except (rnrs) dynamic-wind) (call/cc rnrs:call/cc)))

  (define winders '())

  (define common-tail
    (lambda (x y)
      (let ([lx (length x)] [ly (length y)])
        (do ([x (if (> lx ly) (list-tail x (- lx ly)) x) (cdr x)]
             [y (if (> ly lx) (list-tail y (- ly lx)) y) (cdr y)])
            ((eq? x y) x)))))

  (define do-wind
    (lambda (new)
      (let ([tail (common-tail new winders)])
        (let f ([ls winders])
          (if (not (eq? ls tail))
              (begin
                (set! winders (cdr ls))
                ((cdar ls))
                (f (cdr ls)))))
        (let f ([ls new])
          (if (not (eq? ls tail))
              (begin
                (f (cdr ls))
                ((caar ls))
                (set! winders ls)))))))

  (define call/cc
    (lambda (f)
      (rnrs:call/cc
        (lambda (k)
          (f (let ([save winders])
               (lambda (x)
                 (unless (eq? save winders) (do-wind save))
                 (k x))))))))

  (define dynamic-wind
    (lambda (in body out)
      (in)
      (set! winders (cons (cons in out) winders))
      (let-values ([ans* (body)])
        (set! winders (cdr winders))
        (out)
        (apply values ans*)))))

同时,dynamic-windcall/cc管理一个winders的列表。一个winder是调用dynamic-wind创建的inout的任务盒的序对。当dynamic-wind被调用时,in任务盒会被调用,一个包含inout任务盒的新的winder会放置在winders列表的头上,body任务盒被调用,该winder会从列表中移除,并且out任务盒会被调用。这个顺序确保了只有当控制经过in还没进入out时,该winder才会在winders列表内。在任何时候获得延续时,winders列表会被保存;当该延续被调用时,会恢复被保存的winders列表。在winders列表恢复期间,所有在当前winders列表且不在保存的winders列表内的winderout任务盒会被调用,随后所有在保存的winders列表内且不在当前winders列表内的winderin任务盒被调用。winders列表会递增的更新,同样也是为了确保只有当控制经过in还没进入out时,该winder才会在当前winders列表内。

call/cc内执行的测试表达式(not (eq? save winders))不是严格必需的,但这是为了在保存的winders列表和当前的winders列表相同时,降低延续的调用成本。

5.7 延迟求值

可以结合使用语法式delay和过程force以实现惰性求值。一个惰性求值的表达式不会被求值,直到它的值被需要时,并且一旦求值过,不会再重新被求值。

语法:(delay expr)
返回:一个promise
过程:(force promise)
返回:强制执行promise的结果
:(rnrs r5rs)

首次用forcedelay创建的promise求值时,expr会被求值,并”记住“该结果值。从此之后,每次promise强制求值,都会返回这个“记住”的值而非重新对expr求值。

delayforce通常仅在没有副作用时使用,如,有赋值时不能使用,所以求值的顺序时无关紧要的。

使用delayforce的好处是若该表达式延迟至绝对必要时,可以完全避免一些计算量。延迟计算可以用作构建概念上无限的列表,或streams)。下面的例子展示了怎么使用delayforce构造流抽象。一个流是一种promise,当强制求值时,该promise返回一个其尾是流的序对。

(define stream-car
  (lambda (s)
    (car (force s))))

(define stream-cdr
  (lambda (s)
    (cdr (force s))))

(define counters
  (let next ([n 1])
    (delay (cons n (next (+ n 1))))))

(stream-car counters) => 1

(stream-car (stream-cdr counters)) => 2

(define stream-add
  (lambda (s1 s2)
    (delay (cons
             (+ (stream-car s1) (stream-car s2))
             (stream-add (stream-cdr s1) (stream-cdr s2))))))

(define even-counters
  (stream-add counters counters))

(stream-car even-counters) => 2

(stream-car (stream-cdr even-counters)) => 4

delay可定义为:

(define-syntax delay
  (syntax-rules ()
    [(_ expr) (make-promise (lambda () expr))]))

其中,make-promise可定义如下:

(define make-promise
  (lambda (p)
    (let ([val #f] [set? #f])
      (lambda ()
        (unless set?
          (let ([x (p)])
            (unless set?
              (set! val x)
              (set! set? #t))))
        val))))

使用这个定义的delayforce简单调用promise去强制求值或去检索保存的值。

(define force
  (lambda (promise)
    (promise)))

make-promise中对变量set?的第二次检查是必要的,若在应用p的时候,产生promise递归强制求值的情况。由于一个promise必须总是返回同样的值,因此将返回第一次应用p的结果值。

至于delayforce是否处理多个返回值是未指定的;以上给出的实现没有处理,但下面的版本借助call-with-valuesapply可以处理这种情况。

(define make-promise
  (lambda (p)
    (let ([vals #f] [set? #f])
      (lambda ()
        (unless set?
          (call-with-values p
            (lambda x
              (unless set?
                (set! vals x)
                (set! set? #t)))))
        (apply values vals)))))

(define p (delay (values 1 2 3)))
(force p) => 1
             2
             3
(call-with-values (lambda () (force p)) +) => 6

这两个实现都不是很正确,因为没有考虑到当它的参数不是promise的情况下,force必须抛出条件类型为&assertion的异常。因为区分由make-promise创建的过程与其他的过程是不可能的,所以force不能可靠地实现这种情况。下面make-promiseforce的重新实现将promise表示为类型为promise的记录,借此允许force对参数做一些必要的检查。

(define-record-type promise
  (fields (immutable p) (mutable vals) (mutable set?))
  (protocol (lambda (new) (lambda (p) (new p #f #f)))))

(define force
  (lambda (promise)
    (unless (promise? promise)
      (assertion-violation 'promise "invalid argument" promise))
    (unless (promise-set? promise)
      (call-with-values (promise-p promise)
        (lambda x
          (unless (promise-set? promise)
            (promise-vals-set! promise x)
            (promise-set?-set! promise #t)))))
    (apply values (promise-vals promise))))

5.8 多值

虽然所有Scheme的原始过程和大部分用户自定义的过程都返回一个值,但通过返回零个值,多个值,或甚至可变数量的值能最好地解决一些编程问题。例如,将一个值的列表分成两个子列表的过程需要返回两个值。虽然生产者可以将多个值打包到一个数据结构,然后消费者从该数据结构提取多个值是可能的,但使用内置的多值接口通常更简洁。该接口包含两个过程:valuescall-with-values。 前者产生多个值,后者链接产生多个值的过程和消耗这些值的过程。

过程:(values obj ...)
返回obj ...
:(rnrs base), (rnrs)

values过程接收任意数目的参数,简单地传递(返回)参数给它的延续。

(values) =>

(values 1) => 1

(values 1 2 3) => 1
                  2
                  3

(define head&tail
  (lambda (ls)
    (values (car ls) (cdr ls))))

(head&tail '(a b c)) => a
                        (b c)

过程:(call-with-values producer consumer)
返回:见下文
:(rnrs base), (rnrs)

producerconsumer必须是过程。call-with-values会将consumer应用于通过不带参数调用producer返回的值。

(call-with-values
  (lambda () (values 'bond 'james))
  (lambda (x y) (cons y x))) => (james . bond)

(call-with-values values list) => '()

在第二个示例中,values本身作为生产者。 它不接收任何参数,因此不返回任何值。这样list不应用于任何参数,因此返回空列表。

下面定义的过程dxdy计算坐标由(x . y) 对表示的一对点的xy坐标的变化。

(define dxdy
  (lambda (p1 p2)
    (values (- (car p2) (car p1))
            (- (cdr p2) (cdr p1)))))

(dxdy '(0 . 0) '(0 . 5)) => 0
                            5

dxdy可用于计算由两个端点表示的线段的长度和斜率。

(define segment-length
  (lambda (p1 p2)
    (call-with-values
      (lambda () (dxdy p1 p2))
      (lambda (dx dy) (sqrt (+ (* dx dx) (* dy dy)))))))

(define segment-slope
  (lambda (p1 p2)
    (call-with-values
      (lambda () (dxdy p1 p2))
      (lambda (dx dy) (/ dy dx)))))

(segment-length '(1 . 4) '(4 . 8)) => 5
(segment-slope '(1 . 4) '(4 . 8)) => 4/3

我们当然可以将它们组合起来形成一个返回两个值的过程。

define describe-segment
  (lambda (p1 p2)
    (call-with-values
      (lambda () (dxdy p1 p2))
      (lambda (dx dy)
        (values
          (sqrt (+ (* dx dx) (* dy dy)))
          (/ dy dx))))))

(describe-segment '(1 . 4) '(4 . 8)) => 5
                                                       => 4/3

下面的示例使用多个值将列表非破坏性地划分为两个交替元素的子列表。

(define split
  (lambda (ls)
    (if (or (null? ls) (null? (cdr ls)))
        (values ls '())
        (call-with-values
          (lambda () (split (cddr ls)))
          (lambda (odds evens)
            (values (cons (car ls) odds)
                    (cons (cadr ls) evens)))))))

(split '(a b c d e f)) => (a c e)
                          (b d f)

在递归的每一层,过程split返回两个值:来自于参数列表中的奇数索引的元素列表和偶数索引的元素列表(索引从1开始)。

values的调用的延续不需要通过调用call-with-values来建立,也不能仅使用values来返回到由call-with-values建立的延续。 特别是,(values e) 和e是等价的表达式。例如:

(+ (values 2) 4) => 6

(if (values #t) 1 2) => 1

(call-with-values
  (lambda () 4)
  (lambda (x) x)) => 4

类似地,values可用于将任意数量的值传递给忽略值的延续,如下所示。

(begin (values 1 2 3) 4) => 4

因为延续可以接受零个或多个值,所以通过call/cc获得的延续可以接受零个或多个参数。

(call-with-values
  (lambda ()
    (call/cc (lambda (k) (k 2 3))))
  (lambda (x y) (list x y))) => (2 3)

当期望恰好一个参数值的延续接收零值或多于一个值时,其行为未指定。 例如,以下每个表达式的行为都是未指定的。某些实现会抛出异常,而其他实现会静默忽略其他值或为缺失值提供默认值。

(if (values 1 2) 'x 'y)

(+ (values) 5)

希望强制在特定上下文中忽略额外值的程序可以通过显式调用call-with-values轻松完成。 一个可称之为first的语法形式可以被定义为抽象“在只需要一个值时抽象丢弃多个值”这一行为。

(define-syntax first
  (syntax-rules ()
    [(_ expr)
     (call-with-values
       (lambda () expr)
       (lambda (x . y) x))]))

(if (first (values #t #f)) 'a 'b) => a

因为如果过程不接受传递给它的参数数量,实现会被要求抛出条件类型为&assertion的异常,因此以下每个都会抛出异常。

(call-with-values
  (lambda () (values 2 3 4))
  (lambda (x y) x))

(call-with-values
  (lambda () (call/cc (lambda (k) (k 0))))
  (lambda (x y) x))

由于producer通常是lambda表达式,因此为了便于阅读,使用抑制lambda表达式的语法扩展通常很方便。

(define-syntax with-values
  (syntax-rules ()
    [(_ expr consumer)
     (call-with-values (lambda () expr) consumer)]))

(with-values (values 1 2) list) => (1 2)
(with-values (split '(1 2 3 4))
  (lambda (odds evens)
    evens)) => (2 4)

如果consumer也是lambda表达式,则4.5 节中描述的letlet*的多值变体通常更方便。

(let-values ([(odds evens) (split '(1 2 3 4))])
  evens) => (2 4)

(let-values ([ls (values 'a 'b 'c)])
  ls) => (a b c)

许多标准的语法式和过程都传递多个值。 其中大多数都是“自动的”,从某种意义上说实现不需要做任何特殊的事情来实现这一点。 let通常扩展为直接的lambda调用,这会自动传播由let主体产生的多个值。 其他运算符必须经过特殊编码才能传递多个值。 例如,call-with-port过程(7.6 节)调用其类型为过程的参数,然后在返回过程的值之前关闭port参数,因此它必须临时保存值。 这可以通过let-values,apply和values轻松完成:

(define call-with-port
  (lambda (port proc)
    (let-values ([val* (proc port)])
      (close-port port)
      (apply values val*))))

如果在返回单个值时这看起来像是太多开销,代码可以使用call-with-valuescase-lambda来更有效地处理单值情况:

(define call-with-port
  (lambda (port proc)
    (call-with-values (lambda () (proc port))
      (case-lambda
        [(val) (close-port port) val]
        [val* (close-port port) (apply values val*)]))))

下面的库中valuescall-with-values的定义(伴随着call/cc的重新定义)表明:如果多返回值接口没有内置的话,可以在Scheme中实现。但是,对于将多个值返回到单值上下文(例如if表达式的测试部分)的情况,不能进行错误检查。

(library (mrvs)
  (export call-with-values values call/cc
    (rename (call/cc call-with-current-continuation)))
  (import
    (rename
      (except (rnrs) values call-with-values)
      (call/cc rnrs:call/cc)))

  (define magic (cons 'multiple 'values))

  (define magic?
    (lambda (x)
      (and (pair? x) (eq? (car x) magic))))

  (define call/cc
    (lambda (p)
      (rnrs:call/cc
        (lambda (k)
          (p (lambda args
               (k (apply values args))))))))

  (define values
    (lambda args
      (if (and (not (null? args)) (null? (cdr args)))
          (car args)
          (cons magic args))))

  (define call-with-values
    (lambda (producer consumer)
      (let ([x (producer)])
        (if (magic? x)
            (apply consumer (cdr x))
            (consumer x))))))

可以更有效地实现多个值[2 ],但是此代码用于说明运算符的含义,并且可用于在不支持它们的较旧的非标准实现中提供多个值。

5.9 Eval

Scheme的eval过程允许程序员编写构建和求值其他程序的程序。这种运行时元编程的能力不应过度使用,但在需要时很方便。

过程:(eval obj environment)
返回:在environment中由obj表示的Scheme表达式的值
:(rnrs eval)

如果obj不表示语法上有效的表达式,则eval会抛出条件类型为&syntax的异常。由environmentscheme-report-environmentnull-environment返回的环境是不可变的。 因此,如果对表达式中的任何环境变量赋值,则eval还会引发条件类型为&syntax的异常。

(define cons 'not-cons)
(eval '(let ([x 3]) (cons x 4)) (environment '(rnrs))) => (3 . 4)

(define lambda 'not-lambda)
(eval '(lambda (x) x) (environment '(rnrs))) => #<procedure>

(eval '(cons 3 4) (environment)) => *exception*

过程:(environment import-spec ...)
返回:一个环境
:(rnrs eval)

environment返回由给定导入说明符的绑定组成形成的环境。每个import-spec必须是一个表示有效导入说明符的s-表达式(参见第10 章)。

(define env (environment '(rnrs) '(prefix (rnrs lists) $)))
(eval '($cons* 3 4 (* 5 8)) env) => (3 4 . 40)

过程:(null-environment version)
过程:(scheme-report-environment version)
返回:一个R5RS兼容的环境
:(rnrs r5rs)

version必须是精确的整数 5。

null-environment返回一个环境,其中包含关键字的绑定,其含义由Revised5 Report on Scheme定义,以及辅助关键字else=>..._的绑定。

scheme-report-environment返回一个环境,该环境包含与null-environment返回的环境相同的关键字绑定以及其含义由Revised5 Report on Scheme定义的变量的绑定,除了那些未经Revised6 Report定义的那些:loadinteraction -environmenttranscript-ontranscript-offchar-ready?

这些过程返回的环境中每个标识符的绑定都是相应的Revised6 Report库的绑定,因此即使未使用例外的标识符绑定,也不提供完全向后的兼容性。

results matching ""

    No results matching ""