On this page:
5.1 传递续文的解释器
5.2 跳跃式解释器
5.3 指令式解释器
5.4 异常
5.5 线程

5 传递续文的解释器

表达式,我们用环境的概念探讨绑定行为,建立每部分程序执行的数据上下文。 这里,我们将用类似方式探讨每部分程序执行的控制上下文 (control context)。 我们将介绍续文 (continuation) 的概念,用来抽象控制上下文。我们将要编写的 解释器会取一续文参数,从而彰显控制上下文。

考虑下面的Scheme阶乘函数定义。

(define fact
  (lambda (n)
    (if (zero? n) 1 (* n (fact (- n 1))))))

我们可以用推导建模 fact 的计算过程:

  (fact 4)

= (* 4 (fact 3))

= (* 4 (* 3 (fact 2)))

= (* 4 (* 3 (* 2 (fact 1))))

= (* 4 (* 3 (* 2 (* 1 (fact 0)))))

= (* 4 (* 3 (* 2 (* 1 1))))

= (* 4 (* 3 (* 2 1)))

= (* 4 (* 3 2))

= (* 4 6)

= 24

这是阶乘的自然递归定义。每次调用 fact 都保证返回值与调用处的 n 相乘。 这样,随着计算进行,fact 在越来越大的控制上下文 中调用。比较这一行为 与下列过程。

(define fact-iter
  (lambda (n)
    (fact-iter-acc n 1)))
 
(define fact-iter-acc
  (lambda (n a)
    (if (zero? n) a (fact-iter-acc (- n 1) (* n a)))))

用这个定义,我们计算:

  (fact-iter 4)

= (fact-iter-acc 4 1)

= (fact-iter-acc 3 4)

= (fact-iter-acc 2 12)

= (fact-iter-acc 1 24)

= (fact-iter-acc 0 24)

= 24

这里,fact-iter-acc 总是在同样的控制上下文内调用:在本例中,是没有任何上下 文。当 fact-iter-acc 调用自身时,它在 fact-iter-acc 执行的 “尾端”,除了把返回值作为 fact-iter-acc 调用的结 果,不需再做任何保证。我们称之为尾调用 (tail call)。这样,上述推导中的每 一步都形如 (fact-iter-acc n a)

fact 这样的过程执行时,每次递归调用都要记录额外的控制信息,此信息保留到 调用返回为止。在上面的第一个推导中,这反映了控制上下文的增长。这样的过程呈现 出递归性控制行为 (recursive control behavior)。

与之相对,fact-iter-acc 调用自身时,不需记录额外的控制信息。递归调用发生在 表达式的同一层(上述推导的最外层)反映了这一点。在这种情况下,当递归深度(没有对 应返回的递归调用数目)增加时,系统不需要不断增长的内存存放控制上下文。只需使用有 限内存存放控制信息的过程呈现出迭代性控制行为 (iterative control behavior)。

为什么这些程序呈现出不同的控制行为呢?在阶乘的递归定义中,过程 fact操作数位置 (operand position) 调用。我们需要保存这个调用的上下文, 因为我们需要记住,过程调用执行完毕之后,仍需求出操作数的值,并执行外层调用,在本 例中,是完成待做的乘法。这给出一条重要原则:

不是过程调用,而是操作数的求值导致控制上下文扩大。

本章,我们学习如何跟踪和操作控制上下文。我们的核心工具是 名为续文 (continuation) 的数据类型。就像环境是数据上下文的抽象表示,续文 是控制上下文的抽象表示。我们将探索续文,编写直接传递续文参数的解释器,就像之前直 接传递环境参数的解释器。一旦处理了简单情况,我们就能明白如何给语言添加组件,以更 加复杂的方式处理控制上下文,譬如异常和线程。

续文传递风格,我们展示如何用转换解释器的技术转换所有程序。我们说以这种方式转换 而得的程序具有续文传递风格 (continuation-passing style)。续文传递风格还 展示了续文的其他一些重要应用。

5.1 传递续文的解释器

在我们的新解释器中,value-of 等主要过程将取第三个参数。这一参数——续 文——用来抽象每个表达式求值时的控制上下文。

我们从,即LETREC:支持递归过程的语言中的 LETREC 语言解释器入手。我们把 value-of-program 的结果叫做 \mathit{FinalAnswer},以强调这个表达值是程 序的最终值。

\mathit{FinalAnswer} = \mathit{ExpVal}
 
value-of-program : \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (value-of exp1 (init-env))))))
 
value-of : \mathit{Exp} \times \mathit{Env} \to \mathit{ExpVal}
(define value-of
  (lambda (exp env)
    (cases expression exp
      (const-exp (num) (num-val num))
      (var-exp (var) (apply-env env var))
      (diff-exp (exp1 exp2)
        (let ((num1 (expval->num (value-of exp1 env)))
              (num2 (expval->num (value-of exp2 env))))
          (num-val (- num1 num2))))
      (zero?-exp (exp1)
        (let ((num1 (expval->num (value-of exp1 env))))
          (if (zero? num1) (bool-val #t) (bool-val #f))))
      (if-exp (exp1 exp2 exp3)
        (if (expval->bool (value-of exp1 env))
          (value-of exp2 env)
          (value-of exp3 env)))
      (let-exp (var exp1 body)
        (let ((val1 (value-of exp1 env)))
          (value-of body (extend-env var val1 env))))
      (proc-exp (var body)
        (proc-val (procedure var body env)))
      (call-exp (rator rand)
        (let ((proc1 (expval->proc (value-of rator env)))
              (arg (value-of rand env)))
          (apply-procedure proc1 arg)))
      (letrec-exp (p-name b-var p-body letrec-body)
        (value-of letrec-body
          (extend-env-rec p-name b-var p-body env))))))
 
apply-procedure : \mathit{Proc} \times \mathit{ExpVal} \to \mathit{ExpVal}
(define apply-procedure
  (lambda (proc1 val)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of body (extend-env var val saved-env))))))

传递环境的解释器

我们的目标是重写解释器,避免在调用 value-of 时产生控制上下文。当控制上下文 需要增加时,我们扩展续文参数,就像在表达式中,程序产生数据上下文时,扩展 解释器的环境一样。彰显控制上下文,我们就能看到它如何消长。之后, 从异常线程,我们将用它给我们的语言添加新的控制行为。

现在,我们知道环境表示一个从符号到指代值的函数。续文表示什么呢?表达式的续文表示 一个过程,它取表达式的结果,完成计算。所以我们的接口必须包含一个过程 apply-cont,它取一续文 cont,一个表达值 val,完成由 cont 指 定的计算。apply-cont 的合约为:

\mathit{FinalAnswer} = \mathit{ExpVal}
apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{FinalAnswer}

我们把 apply-cont 的结果叫做 \mathit{FinalAnswer} 是为了提醒自己,它是 计算最终的值:程序的其他部分都不用它。

接口应该包含什么样的续文构造器?随着我们分析解释器,这些续文构造器自会显现。首先, 我们需要一个续文构造器,在不需再对计算值进行操作时生成上下文。我们把这个续文叫做 (end-cont),其定义为:

(apply-cont (end-cont) val)

= (begin

    (eopl:printf "计算结束.~%")

    val)

调用 (end-cont) 打印出一条计算结束消息,并返回程序的值。因为 (end-cont) 打印出一条消息,我们可以看出它调用了多少次。在正确的计算中,它只 应调用一次。

我们把 value-of-program 重写为:

value-of-program : \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (value-of/k exp1 (init-env) (end-cont))))))

现在我们可以写出 value-of/k。我们依次考虑 value-of 的各个分支。 value-of 的前几行只是算出一个值,然后返回,不会再次调用 value-of。在传 递续文的解释器中,这些行调用 apply-cont,把对应的值传给续文:

value-of/k : \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{ExpVal}
(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      (const-exp (num) (apply-cont cont (num-val num)))
      (var-exp (var) (apply-cont cont (apply-env env var)))
      (proc-exp (var body)
        (apply-cont cont
          (proc-val (procedure var body env))))
      ...)))

目前,cont 唯一可能的值是终止续文,但这马上就会改变。很容易看出,如果程序为 上述表达式之一,表达式的值将传给 end-cont(通过 apply-cont)。

letrec 的行为也不复杂:它不调用 value-of,而是创建一个新环境,然后在新 环境中求主体的值,主体的值就是整个表达式的值。这表明主体和整个表达式在同样的控制 上下文中执行。因此,主体的值应返回给整个表达式的续文。所以我们写:

    (letrec-exp (p-name p-var p-body letrec-body)
      (value-of/k letrec-body
        (extend-env-rec p-name p-var p-body env)
        cont))

这解释了一条通用原则:

尾调用不扩大续文

exp_1 的值作为 exp_2 的值返回,则 exp_1exp_2 应在同样的续文中执行。

写成这样是不对的:

    (letrec-exp (p-name p-var p-body letrec-body)
      (apply-cont cont
        (value-of/k letrec-body
          (extend-env-rec p-name p-var p-body env)
          (end-cont))))

因为调用 value-of/k 是在操作数位置:它要作为 apply-cont 的操作数。另外, 由于使用续文 (end-cont) 会在计算完成之前打印出计算结束消息,这种错误很容易 排查。

接下来我们考虑 zero? 表达式。在 zero? 表达式中,我们得求出实参的值,然 后返回给依赖该值的续文。所以我们要在新的续文中求实参的值,这个续文会取得返回值, 然后做适当处理。

那么,在 value-of/k 中,我们写:

    (zero?-exp (exp1)
      (value-of/k exp1 env
        (zero1-cont cont)))

其中,(zero1-cont cont) 是一续文,具有如下性质:

(apply-cont (zero1-cont cont) val)

= (apply-cont cont

    (bool-val

      (zero? (expval->num val))))

就像 letrec,我们不能把 value-of/k 写成:

    (zero?-exp (exp1)
      (let ((val (value-of/k exp1 env (end-cont))))
        (apply-cont cont
          (bool-val
            (zero? (expval->num val))))))

因为调用 value-of/k 是在操作数位置。let 声明的右边是在操作数位置,因为 (let ((var exp_1)) exp_2) 等效于 ((lambda (var) exp_2) exp_1)value-of/k 调用的值最终成为 expval->num 的操作 数。像之前那样,如果我们运行这段代码,计算结束消息会出现两次:一次在计算中间,一 次在真正结束时。

let 表达式只比 zero? 表达式稍微复杂一点:求出声明右侧的值之后,我们在 适当的扩展环境内求主体的值。原来的 let 代码为:

    (let-exp (var exp1 body)
      (let ((val1 (value-of exp1 env)))
        (value-of body
          (extend-env var val1 env))))

在传递续文的解释器中,我们在完成剩余计算的上下文中求 exp_1 的值。所以,在 value-of/k 中我们写:

    (let-exp (var exp1 body)
      (value-of/k exp1 env
        (let-exp-cont var body env cont)))

然后我们给续文的接口添加规范:

(apply-cont (let-exp-cont var body env cont) val)

= (value-of/k body (extend-env var val env) cont)

let 表达式主体的值成为 let 表达式的值,所以求 let 表达式主体时的 续文与求整个 let 表达式的相同。这是尾调用不扩大续文的又一例子。

下面我们处理 if 表达式。在 if 表达式中,我们首先求条件的值,但条件的结 果不是整个表达式的值。我们要新生成一个续文,查看条件表达式的结果是否为真,然后求 真值表达式或假值表达式的值。所以在 value-of/k 中我们写:

    (if-exp (exp1 exp2 exp3)
      (value-of/k exp1 env
        (if-test-cont exp2 exp3 body env cont)))

其中,if-test-cont 是另一个续文构造器,满足如下规范:

(apply-cont (if-test-cont exp_2 exp_3 env cont) val)

= (if (expval->bool val)

    (value-of/k exp_2 env cont)

    (value-of/k exp_3 env cont))

现在,我们有了四个续文构造器。我们可以用过程表示法或者数据结构表示法实现它们。过 程表示法如 所示,数据结构表示法使用 define-datatype, 如 所示。

\mathit{Cont} = \mathit{ExpVal} -> \mathit{FinalAnswer}
 
end-cont : \mathit{()} \to \mathit{Cont}
(define end-cont
  (lambda ()
    (lambda (val)
      (begin
        (eopl:printf "计算结束.~%")
        val))))
 
zero1-cont : \mathit{Cont} \to \mathit{Cont}
(define zero1-cont
  (lambda (cont)
    (lambda (val)
      (apply-cont cont
        (bool-val
          (zero? (expval->num val)))))))
 
let-exp-cont : \mathit{Var} \times \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{Cont}
(define let-exp-cont
  (lambda (var body env cont)
    (lambda (val)
      (value-of/k body (extend-env var val env) cont))))
 
if-test-cont : \mathit{Exp} \times \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{Cont}
 : Exp × Exp × Env × Cont  Cont
(define if-test-cont
  (lambda (exp2 exp3 env cont)
    (lambda (val)
      (if (expval->bool val)
        (value-of/k exp2 env cont)
        (value-of/k exp3 env cont)))))
 
apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{FinalAnswer}
(define apply-cont
  (lambda (cont v)
    (cont v)))

用过程表示续文

(define-datatype continuation continuation?
  (end-cont)
  (zero1-cont
    (cont continuation?))
  (let-exp-cont
    (var identifier?)
    (body expression?)
    (env environment?)
    (cont continuation?))
  (if-test-cont
    (exp2 expression?)
    (exp3 expression?)
    (env environment?)
    (cont continuation?)))
 
apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{FinalAnswer}
(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (end-cont ()
        (begin
          (eopl:printf "计算结束.~%")
          val))
      (zero1-cont (saved-cont)
        (apply-cont saved-cont
          (bool-val
            (zero? (expval->num val)))))
      (let-exp-cont (var body saved-env saved-cont)
        (value-of/k body
          (extend-env var val saved-env) saved-cont))
      (if-test-cont (exp2 exp3 saved-env saved-cont)
        (if (expval->bool val)
          (value-of/k exp2 saved-env saved-cont)
          (value-of/k exp3 saved-env saved-cont))))))

用数据结构表示续文

下面这个简单算例展示了各部分如何配合。像 PROC:有过程的语言那样,我们用 \textnormal{\guillemotleft} exp \textnormal{\guillemotright} 指代表达式 exp 的抽象语法树。设 \rho_0 是一环境,b 在其中绑定到 (bool-val #t)cont_0 是初始续文,即 (end-cont) 的值。注释说明不是正式的,应与 value-of/k 的定义和 apply-cont 的规范对照阅读。这个例子是预测性的,因 为我们让 letrec 引入了过程,但还不知道如何调用它。

(value-of/k <>

  \rho_0 cont_0)

= \rho_0(extend-env-rec ... \rho_0)

(value-of/k <> \rho_1 cont_0)

= 然后,求条件表达式的值

(value-of/k <> \rho_1 (test-cont <<3>> <<4>> \rho_1 cont_0))

= b的值传给续文

(apply-cont (test-cont <<3>> <<4>> \rho_1 cont_0)

            (bool-val #f))

= 求真值表达式

(value-of/k <<3>> \rho_1 cont_0)

= 把表达式的值传给续文

(apply-cont cont_0 (num-val 3))

= 在最后的续文中处理最终答案

(begin (eopl:printf ...) (num-val 3))

差值表达式给我们的解释器带来了新困难,因为它得求两个操作数的值。我们还像 if 那样开始,先求第一个实参:

    (diff-exp (exp1 exp2)
      (value-of/k exp1 env
        (diff1-cont exp2 env cont)))

(diff1-cont exp2 env cont) 收到一个值,它应求 exp2 的值,求值时的上 下文应保存 exp1 的值。我们将其定义为:

(apply-cont (diff1-cont exp_2 env cont) val1)

= (value-of/k exp_2 env

    (diff2-cont val1 cont))

(diff2-cont val1 cont) 收到一个值,我们得到了两个操作数的值,所以,我们 可以把二者的差继续传给等待中的 cont。定义为:

(apply-cont (diff2-cont val1 cont) val2)

= (let ((num1 (expval->num val1))

        (num2 (expval->num val2)))

    (apply-cont cont

      (num-val (- num1 num2))))

让我们看看该系统的例子。

(value-of/k

  <<-(-(44,11),3)>>

  \rho_0

  #(struct:end-cont))

= 开始处理第一个操作数

(value-of/k

  <<-(44,11)>>

  \rho_0

  #(struct:diff1-cont <<3>> \rho_0

     #(struct:end-cont)))

= 开始处理第一个操作数

(value-of/k

   <<44>>

  \rho_0

  #(struct:diff1-cont <<11>> \rho_0

     #(struct:diff1-cont <<3>> \rho_0

        #(struct:end-cont))))

= <<44>> 的值传给续文

(apply-cont

  #(struct:diff1-cont <<11>> \rho_0

    #(struct:diff1-cont <<3>> \rho_0

       #(struct:end-cont)))

  (num-val 44))

= 现在,开始处理第二个操作数

(value-of/k

   <<11>>

  \rho_0

  #(struct:diff2-cont (num-val 44)

     #(struct:diff1-cont <<3>> \rho_0

        #(struct:end-cont))))

= 把值传给续文

(apply-cont

  #(struct:diff2-cont (num-val 44)

     #(struct:diff1-cont <<3>> \rho_0

        #(struct:end-cont)))

  (num-val 11))

= 44-11等于33,传给续文

(apply-cont

  #(struct:diff1-cont <<3>> \rho_0

     #(struct:end-cont))

  (num-val 33))

= 开始处理第二个操作数 <<3>>

(value-of/k

   <<3>>

  \rho_0

  #(struct:diff2-cont (num-val 33)

     #(struct:end-cont)))

= 把值传给续文

(apply-cont

  #(struct:diff2-cont (num-val 33)

     #(struct:end-cont))

  (num-val 3))

= 33-3等于30,传给续文

(apply-cont

  #(struct:end-cont)

  (num-val 30))

apply-cont 打印出消息“计算结束”,返回计算的最终 结果 (num-val 30)

我们的语言中最后要处理的是过程调用。在传递环境的解释器中,我们写:

    (call-exp (rator rand)
      (let ((proc1 (expval->proc (value-of rator env)))
            (arg (value-of rand env)))
        (apply-procedure proc1 arg)))

就像在 diff-exp 中一样,这里要处理两个调用。所以我们必须先择其一,然后转换 余下部分来处理第二个。此外,我们必须把续文传给 apply-procedure,因为 apply-procedure 要调用 value-of/k

我们选择先求操作符的值,所以在 value-of/k 中我们写:

    (call-exp (rator rand)
      (value-of/k rator
        (rator-cont rand env cont)))

就像 diff-exprator-cont 在适当的环境中求操作数的值:

(apply-cont (rator-cont rand env cont) val1)

= (value-of/k rand env

    (rand-cont val1 cont))

rand-cont 收到一个值,它就可以调用过程了:

(apply-cont (rand-cont val1 cont) val2)

= (let ((proc1 (expval->proc val1)))

    (apply-procedure/k proc1 val2 cont))

最后,我们还要修改 apply-procedure,以符合续文传递风格:

apply-procedure/k : \mathit{Proc} \times \mathit{ExpVal} \times \mathit{Cont} \to \mathit{FinalAnswer}
(define apply-procedure/k
  (lambda (proc1 val cont)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of/k body
          (extend-env var val saved-env)
          cont)))))

传递续文的解释器展示完毕。完整的解释器如fig-5.5 所示。续文的完整规范如 所示。

value-of-program : \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (value-of/k exp1 (init-env) (end-cont))))))
 
value-of/k : \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{FinalAnswer}
(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      (const-exp (num) (apply-cont cont (num-val num)))
      (var-exp (var) (apply-cont cont (apply-env env var)))
      (proc-exp (var body)
        (apply-cont cont
          (proc-val
            (procedure var body env))))
      (letrec-exp (p-name b-var p-body letrec-body)
        (value-of/k letrec-body
          (extend-env-rec p-name b-var p-body env)
          cont))
      (zero?-exp (exp1)
        (value-of/k exp1 env
          (zero1-cont cont)))
      (if-exp (exp1 exp2 exp3)
        (value-of/k exp1 env
          (if-test-cont exp2 exp3 env cont)))
      (let-exp (var exp1 body)
        (value-of/k exp1 env
          (let-exp-cont var body env cont)))
      (diff-exp (exp1 exp2)
        (value-of/k exp1 env
          (diff1-cont exp2 env cont)))
      (call-exp (rator rand)
        (value-of/k rator env
          (rator-cont rand env cont))))))

传递续文的解释器(第1部分)

apply-procedure : \mathit{Proc} \times \mathit{ExpVal} \times \mathit{FinalAnswer} \to \mathit{FinalAnswer}
(define apply-procedure/k
  (lambda (proc1 val cont)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of/k body
          (extend-env var val saved-env)
          cont)))))

传递续文的解释器(第2部分)

现在我们可以验证断言:不是过程调用,而是实参的求 值扩大了控制上下文。具体来说,如果我们在某个续文 cont_1 中求过程调用 (exp_1 exp_2) 的值,求 exp_1 得到的过程主体也将在 cont_1 中 求值。

但过程调用本身不会增大控制上下文。考虑 (exp_1 exp_2) 的求值,其中 exp_1 的值是一个过程 proc_1exp_2 的值是某个表达值 val_2

(value-of/k <<(< /span>exp_1 exp_2)>> \rho_1 cont_1)

= 求操作符的值

(value-of/k <<< /span>exp_1>> \rho_1

  (rator-cont <<< /span>exp_2>> \rho_1 cont_1))

= 把过程值传给续文

(apply-cont

  (rator-cont <<< /span>exp_2>> \rho_1 cont_1)

  proc_1)

= 求操作符的值

(value-of/k <<< /span>exp_2>> \rho_1

  (rand-cont <<< /span>proc_1>> cont_1))

= 把参数值传给续文

(apply-cont

  (rand-cont <<< /span>proc_1>> cont_1)

  val_2)

= 调用过程

(apply-procedure/k proc_1 val_2 cont_1)

所以,过程调用时,过程主体在过程调用所在的续文中求值。操作数的求值需要控制上下文, 进入过程主体则不需要。

(apply-cont (end-cont) val)

= (begin

    (eopl:printf

      "计算结束.~%")

    val)

 

(apply-cont (diff1-cont exp_2 env cont) val1)

= (value-of/k exp_2 env (diff2-cont val1 cont))

 

(apply-cont (diff2-cont val1 cont) val2)

= (let ((num1 (expval->num val1))

        (num2 (expval->num val2)))

    (apply-cont cont (num-val (- num1 num2))))

 

(apply-cont (rator-cont rand env cont) val1)

= (value-of/k rand env (rand-cont val1 cont))

 

(apply-cont (rand-cont val1 cont) val2)

= (let ((proc1 (expval->proc val1)))

    (apply-procedure/k proc1 val2 cont))

 

(apply-cont (zero1-cont cont) val)

= (apply-cont cont (bool-val (zero? (expval->num val))))

 

(apply-cont (if-test-cont exp_2 exp_3 env cont) val)

= (if (expval->bool val)

    (value-of/k exp_2 env cont)

    (value-of/k exp_3 env cont))

 

(apply-cont (let-exp-cont var body env cont) val1)

= (value-of/k body (extend-env var val1 env) cont)

中续文的规范

\textnormal{[}{\star}\textnormal{]}  用过程表示法实现续文数据类型。

\textnormal{[}{\star}\textnormal{]}  用数据结构表示法实现续文数据类型。

\textnormal{[}{\star}\textnormal{]} 给解释器添加 let2let2 表达式就像 let 表达式,但要指定两个变量。

\textnormal{[}{\star}\textnormal{]} 给解释器添加 let3let3 表达式就像 let 表达式,但要指定三个变量。

\textnormal{[}{\star}\textnormal{]}  给语言添加 中的列表。

\textnormal{[}{\star}{\star}\textnormal{]}  给语言添加 中的 list 表达式。提示:添加两个续文构造器, 一个用来求列表首元素的值,一个用来求列表剩余元素的值。

\textnormal{[}{\star}{\star}\textnormal{]}  给解释器添加多声明的 let)。

\textnormal{[}{\star}{\star}\textnormal{]}  给解释器添加多参数过程()。

\textnormal{[}{\star}{\star}\textnormal{]}  修改这个解释器,实现 IMPLICIT-REFS 语言。提示:添加新的续文构造器 (set-rhs-cont env var cont)

\textnormal{[}{\star}{\star}\textnormal{]} 修改前一题的解答,不要在续文中保存环境。

\textnormal{[}{\star}{\star}\textnormal{]}  给传递续文的解释器添加 中的 begin 表达式。确保调用 value-ofvalue-of-rands 时不需要生成控制上下文。

\textnormal{[}{\star}\textnormal{]} fig-5.6 的解释器添加辅助过程,生成类似 cps-computation 计算的输出。

\textnormal{[}{\star}\textnormal{]} factfact-iter 翻译为 LETREC 语言。你可以给语言添加乘法操作符。 然后,用前一道练习中带有辅助组件的解释器计算 (fact 4)(fact-iter 4)。 将它们和本章开头的计算比较。在 (fact 4) 的跟踪日志中找出 (* 4 (* 3 (* 2 (fact 1))))。调用 (fact 1) 时,apply-procedure/k 的续文是什么?

\textnormal{[}{\star}\textnormal{]}  前面练习中的辅助组件产生大量输出。修改辅助组件,只跟踪计算过程中最大续文 的尺寸。我们用续文构造器的使用次数衡量续文的大小,所 以cps-computation的计算中,续文最大尺寸是 3。然后,用 factfact-iter 计算几个操作数的值。验证 fact 使用的续文最大尺寸随其参数递增, 但 fact-iter 使用的续文最大尺寸是常数。

\textnormal{[}{\star}\textnormal{]}  我们的续文数据类型只有一个常量 end-cont,所有其他续文构造器都有一个续文参数。 用列表表示和实现续文。用空列表表示 end-cont,用首项为其他数据结构 (名为 (frame) 或活跃记录表 (activation record)),余项为已保 存续文的非空列表表示其他续文。观察可知,解释器把这些列表当成(帧的)堆栈。

\textnormal{[}{\star}{\star}\textnormal{]}  扩展传递续文的解释器,处理 中的语言。给 result-of 传递 一个续文参数,确保 result-of 不在扩大控制上下文的位置调用。因为语句不返回值, 需要区分普通续文和语句续文;后者通常叫命令续文 (command continuation)。 续文接口应包含过程 apply-command-cont,它取一命令续文并使用它。用数据结构和 无参数过程两种方式实现命令续文。

5.2 跳跃式解释器

有人可能想用普通的过程式语言转译解释器,使用数据结构表示续文,从而避免高阶函数。 但是,用大多数过程式语言做这种翻译都很困难:它们不只在 必要时才扩大控制上下文,而且在每个函数调用处扩大控制上下文(即堆栈!)。在我们的 系统中,由于过程调用在计算结束之前不返回,在那之前,系统的堆栈将一直增高。

这种行为不无道理:在这种语言中,几乎所有的过程调用 都出现在赋值语句的右边,所以几乎所有过程调用都要扩大控制上下文,以便记录待完成的 赋值。因此,体系结构为这种最常见的情形做了优化。而且,由于大多数语言在堆栈中存储 环境信息,所有过程调用生成的控制上下文都不能忘了移除这一信息。

在这种语言中,一种解决方案是使用跳跃 (trampolining) 技术。为了避免产生无 限长的调用链,我们把调用链打断,让解释器中的某个过程返回一个无参数过程。这个过程 在调用时继续计算。整个计算由一个名叫跳床 (trampoline) 的过程驱动,它从一 个过程调用弹射到另一个。例如,我们可以在 apply-procedure/k的主体周围插入一 个 (lambda () ...),因为在我们的语言中,只要不执行过程调用,表达式的运行时 间就是有限的。

得出的代码如 所示,它也展示了解释器中所有的尾调用。因为我们 修改了 apply-procedure/k,不再让它返回一个 \mathit{ExpVal},而是返回一 个过程,我们得重写它和它所调用所有过程的合约。所以,我们必须检查解释器中所有过程 的合约。

我们从 value-of-program 开始。由于这是调用解释器的过程,它的合约保持不变。 它调用 value-of/k,把结果传给 trampoline。因为我们要操作 value-of/k 的结果,所以它不是 \mathit{FinalAnswer}。我们明明没有修改 value-of/k 的代码,怎么会这样呢?过程 value-of/k 在尾部递归调用 apply-contapply-cont 在尾部递归调用 apply-procedure/k,所以 apply-procedure/k 的任何结果都可能成为 value-of/k 的结果。而我们修改了 apply-procedure/k,它的返回值与之前不同。

我们引入弹球 (\mathit{Bounce}),作为 value-of/k 的可能结果(我们 叫它弹球,因为它是跳床的输入)。这一集合的值是什么呢?value-of/k 在尾部递归 调用自身和 apply-cont,这些是它里面所有的尾递归。所以能成为 value-of/k 结果的值只能是 apply-cont 的结果。而且,apply-procedure/k 在尾部递归调 用 value-of/k,所以不论 \mathit{Bounce} 是什么,它是 value-of/kapply-contapply-procedure/k 结果的集合。

过程 value-of/kapply-cont 只是在尾部调用其他过程。真正把值放入 \mathit{Bounce} 中的是 apply-procedure/k。这些是什么样的值呢?我们来看 代码。

(define apply-procedure/k
  (lambda (proc1 val cont)
    (cases proc proc1
      (... (value-of/k body ...)))))

已知 apply-procedure/k 返回无参数的过程,该过程在调用时返回一个 \mathit{ExpVal},或调用 value-of/kapply-contapply-procedure/k 之一的结果,也就是 \mathit{Bounce}。所以, apply-procedure/k 可能的取值由如下集合描述: \mathit{ExpVal} \cup (() \to \mathit{Bounce})

这和 value-of/k 的可能结果相同,所以我们得出结论: \mathit{Bounce} = \mathit{ExpVal} \cup (() \to \mathit{Bounce}) 合约为: \begin{alignedat}{-1} &value-of-program : \mathit{Program} \to \mathit{FinalAnswer} \\ &trampoline : \mathit{Bounce} \to \mathit{FinalAnswer} \\ &value-of/k : \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{Bounce} \\ &apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{Bounce} \\ &apply-procedure/k : \mathit{Proc} \times \mathit{ExpVal} \times \mathit{FinalAnswer} \to \mathit{Bounce} \end{alignedat}

过程 trampoline 满足其合约:首先给它传入一个 \mathit{Bounce}。如果其参 数是一个\mathit{ExpVal}(也是 \mathit{FinalAnswer}),那么返回;否则,参 数一定是一个返回值为 \mathit{Bounce} 的过程。所以,它调用这个无参数过程,然 后调用自身处理其结果,返回值总是一个 \mathit{Bounce}(在 INFERRED:带有类型推导的语言我们将 看到如何自动完成这个推理过程)。

apply-procedure/k 返回的每个无参数过程都表示计算流程中的一个快照。我们可以 在计算中的不同位置返回这样的快照。在 线程,我们将看到如何用这一思想模拟 多线程程序中的原子操作。

\mathit{Bounce} = \mathit{ExpVal} \cup (() \to \mathit{Bounce})
 
value-of-program : \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp)
        (trampoline
          (value-of/k exp (init-env) (end-cont)))))))
 
trampoline : \mathit{Bounce} \to \mathit{FinalAnswer}
(define trampoline
  (lambda (bounce)
    (if (expval? bounce)
      bounce
      (trampoline (bounce)))))
 
value-of/k : \mathit{Exp} \times \mathit{Env} \times \mathit{Cont} \to \mathit{Bounce}
(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      (... (value-of/k ...))
      (... (apply-cont ...)))))
 
apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{Bounce}
(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (... val)
      (... (value-of/k ...))
      (... (apply-cont ...))
      (... (apply-procedure/k ...)))))
 
apply-procedure/k : \mathit{Proc} \times \mathit{ExpVal} \times \mathit{Cont} \to \mathit{Bounce}
(define apply-procedure/k
  (lambda (proc1 val cont)
    (lambda ()
      (cases procedure proc1
        (... (value-of/k ...))))))

用过程表示跳床

\textnormal{[}{\star}\textnormal{]} 修改跳跃式解释器,把所有调用 apply-procedure/k 的地方(只有一处)放入 (lambda () ...) 中。这一修改需要更改合约吗?

\textnormal{[}{\star}\textnormal{]}  中的跳床系统使用过程表示 \mathit{Bounce}。改用数据结构 表示法。

\textnormal{[}{\star}\textnormal{]} 不要在 apply-procedure/k 主体周围插入 (lambda () ...),改为在 apply-cont 的主体周围插入。修改合约,使之符合这一更改。\mathit{Bounce} 的定义需要修改吗?然后,用数据结构表示法替换过程表示法表示 \mathit{Bounce}, 像 那样。

\textnormal{[}{\star}\textnormal{]}  中,trampoline 返回 \mathit{FinalAnswer} 之前的 最后一颗弹球形如 (apply-cont (end-cont) val),其中,val\mathit{ExpVal}。利用这一点优化 中弹球的表示。

\textnormal{[}{\star}{\star}\textnormal{]} 用普通的过程式语言实现跳跃式解释器。用 中的数据结构表示快照, 把 trampoline 中对自身的递归调用替换为普通的 while 或其它循环结构。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  有人可能想用普通的过程式语言转译表达式中传递环境的解释器。同样是因 为上述原因,除了最简单的情况,这种转换都会失败。跳跃技 术在这种情况下也有效吗?

5.3 指令式解释器

状态中我们看到,给共享变量赋值有时可以替代绑定。 考虑 顶部的老例子 evenodd

可以用 中间的程序替代它们。其中,共享变量 x 供两个过程 交换信息。在顶部的例子中,过程主体在环境中查找相关数据;在另一个程序中,它们从存 储器中查找相关数据。

考虑 底部的计算跟踪日志。它可能是二者中任一计算跟踪日志。当 我们记录调用的过程和实参时,它是第一个计算的跟踪日志;当我们记录调用的过程和寄存 器 x 的值时,它是第二个计算的跟踪日志。

而当我们记录程序计数器的位置和寄存器 x 的内容时,这又可以解释为 goto(名为流程图程序 (flowchart program))的跟踪日志。

letrec

 even(x) = if zero?(x)

           then 1

           else (odd sub1(x))

 odd(x) = if zero?(x)

          then 0

          else (even sub1(x))

in (odd 13)

\rule{\linewidth}{1pt}

let x = 0

in letrec

    even() = if zero?(x)

             then 1

             else let d = set x = sub1(x)

                  in (odd)

    odd() = if zero?(x)

            then 0

            else let d = set x = sub1(x)

                 in (even)

   in let d = set x = 13

      in (odd)

\rule{\linewidth}{0.5pt}

      x = 13;

      goto odd;

even: if (x=0) then return(1)

               else {x = x-1;

                     goto odd;}

odd:  if (x=0) then return(0)

               else {x = x-1;

                     goto even;}

\rule{\linewidth}{0.5pt}

  (odd 13)

= (even 12)

= (odd 11)

...

= (odd 1)

= (even 0)

= 1

跟踪日志相同的三个程序

能如此,只是因为原代码中 evenodd 的调用不扩大控制上下文:它们是尾 调用。我们不能这样转换 fact,因为 fact 的跟踪日志无限增长: “程序计数器”不是像这里一样出现在跟踪日志的最外层,而 是出现在控制上下文中。

任何不需要控制上下文的程序都可以这样转换。这给了我们一条重要原理:

无参数的尾调用等同于跳转。

如果一组过程只通过尾调用互相调用,那么我们可以像像 那样,翻 译程序,用赋值代替绑定,然后把赋值程序转译为流程图程序。

本节,我们用这一原理翻译传递续文的解释器,将其转换为适合无高阶过程语言的形式。

我们首先从fig-5.5 中的解释器开始,用数据结构 表示续文。续文的数据结构表示如fig-5.10 所示。

[!ht]
(define-datatype continuation continuation?
  (end-cont)
  (zero1-cont
    (saved-cont continuation?))
  (let-exp-cont
    (var identifier?)
    (body expression?)
    (saved-env environment?)
    (saved-cont continuation?))
  (if-test-cont
    (exp2 expression?)
    (exp3 expression?)
    (saved-env environment?)
    (saved-cont continuation?))
  (diff1-cont
    (exp2 expression?)
    (saved-env environment?)
    (saved-cont continuation?))
  (diff2-cont
    (val1 expval?)
    (saved-cont continuation?))
  (rator-cont
    (rand expression?)
    (saved-env environment?)
    (saved-cont continuation?))
  (rand-cont
    (val1 expval?)
    (saved-cont continuation?)))

用数据结构实现的续文(第1部分)

我们的第一个任务是列出需要通过共享寄存器通信的过程。这些过程及其形参为:

(value-of/k exp env cont)
(apply-cont cont val)
(apply-procedure/k proc1 val cont)

所以我们需要五个寄存器:expenvcontvalproc1。 上面的三个过程各改为一个无参数过程,每个实参的值存入对应的寄存器,调用无参数过程, 换掉上述过程的调用。所以,这段代码

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      (const-exp (num) (apply-cont cont (num-val num)))
      ...)))

可以替换为:

(define value-of/k
  (lambda ()
    (cases expression exp
      (const-exp (num)
        (set! cont cont)
        (set! val (num-val num))
        (apply-cont))
      ...)))
apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{Bounce}
(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (end-cont ()
        (begin
          (eopl:printf
            "计算结束.~%")
          val))
      (zero1-cont (saved-cont)
        (apply-cont saved-cont
          (bool-val
            (zero? (expval->num val)))))
      (let-exp-cont (var body saved-env saved-cont)
        (value-of/k body
          (extend-env var val saved-env) saved-cont))
      (if-test-cont (exp2 exp3 saved-env saved-cont)
        (if (expval->bool val)
          (value-of/k exp2 saved-env saved-cont)
          (value-of/k exp3 saved-env saved-cont)))
      (diff1-cont (exp2 saved-env saved-cont)
        (value-of/k exp2
          saved-env (diff2-cont val saved-cont)))
      (diff2-cont (val1 saved-cont)
        (let ((num1 (expval->num val1))
              (num2 (expval->num val)))
          (apply-cont saved-cont
            (num-val (- num1 num2)))))
      (rator-cont (rand saved-env saved-cont)
        (value-of/k rand saved-env
          (rand-cont val saved-cont)))
      (rand-cont (val1 saved-cont)
        (let ((proc (expval->proc val1)))
          (apply-procedure/k proc val saved-cont))))))

用数据结构实现的续文(第2部分)

现在,我们依次转换四个过程。我们还要修改 value-of-program 的主体,因为那是 最初调用 value-of/k的地方。只有三点小麻烦:

  1. 存储器在过程调用之间往往保持不变。这对应上例中的赋值 (set! cont cont)。我们大可移除这样的赋值。

  2. 我们必须确保 cases 表达式中的字段不与寄存器重名。否则字段会遮蔽寄存 器,寄存器就无法访问了。例如,在 value-of-program 中,如果我们写:

         (cases program pgn
           (a-program (exp)
             (value-of/k exp (init-env) (end-cont))))

    那么 exp 绑定到局部变量,我们无法给全局寄存器 exp 赋值。解决方法是重 命名局部变量,避免冲突:

         (cases program pgn
           (a-program (exp1)
             (value-of/k exp1 (init-env) (end-cont))))

    然后,可以写:

         (cases program pgn
           (a-program (exp1)
             (set! cont (end-cont))
             (set! exp exp1)
             (set! env (init-env))
             (value-of/k)))

    我们已仔细挑选数据类型中的字段名,避免这种冲突。

  3. 一次调用中如果两次使用同一寄存器,又会造成一点麻烦。考虑转换 (cons (f (car x)) (f (cdr x))) 中的第一个调用,其中,xf 的形参。不做过多 考虑的话,这个调用可以转换为:

    (begin
      (set! x (car x))
      (set! cont (arg1-cont x cont))
      (f))

    但这是不对的,因为它给寄存器 x 赋了新值,但 x 原先的值还有用。解决方 法是调整赋值顺序,把正确的值放入寄存器中,或者使用临时变量。大多情况下,要避免 这种问题,可以先给续文变量赋值:

    (begin
      (set! cont (arg1-cont x cont))
      (set! x (car x))
      (f))

    有时临时变量无法避免;考虑 (f y x),其中 xyf 的形参。 我们的例子中还未遇到这种麻烦。

翻译完的解释器如fig-5.14 所示。这个过程 叫做寄存 (registerization)。很容易用支持跳转的指令式语言翻译它。

(define exp 'uninitialized)
(define env 'uninitialized)
(define cont 'uninitialized)
(define val 'uninitialized)
(define proc1 'uninitialized)
 
value-of-program : \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (set! cont (end-cont))
        (set! exp exp1)
        (set! env (init-env))
        (value-of/k)))))
 
value-of/k : \mathit{()} \to \mathit{FinalAnswer}
用法 : 依赖寄存器
exp : \mathit{Exp}
env : \mathit{Env}
cont : \mathit{Cont}
(define value-of/k
  (lambda ()
    (cases expression exp
      (const-exp (num)
        (set! val (num-val num))
        (apply-cont))
      (var-exp (var)
        (set! val (apply-env env var))
        (apply-cont))
      (proc-exp (var body)
        (set! val (proc-val (procedure var body env)))
        (apply-cont))
      (letrec-exp (p-name b-var p-body letrec-body)
        (set! exp letrec-body)
        (set! env (extend-env-rec p-name b-var p-body env))
        (value-of/k))
\begin{comment})))
 
\end{comment} \smallskip

指令式解释器(第1部分)

[!ht]
\smallskip \begin{comment}
 
(((
\end{comment}
      (zero?-exp (exp1)
        (set! cont (zero1-cont cont))
        (set! exp exp1)
        (value-of/k))
      (let-exp (var exp1 body)
        (set! cont (let-exp-cont var body env cont))
        (set! exp exp1)
        (value-of/k))
      (if-exp (exp1 exp2 exp3)
        (set! cont (if-test-cont exp2 exp3 env cont))
        (set! exp exp1)
        (value-of/k))
      (diff-exp (exp1 exp2)
        (set! cont (diff1-cont exp2 env cont))
        (set! exp exp1)
        (value-of/k))
      (call-exp (rator rand)
        (set! cont (rator-cont rand env cont))
        (set! exp rator)
        (value-of/k)))))

指令式解释器(第2部分)

[!ht]
apply-cont : \mathit{()} \to \mathit{FinalAnswer}
用法 : 读取寄存器
cont : \mathit{Cont}
val : \mathit{ExpVal}
(define apply-cont
  (lambda ()
    (cases continuation cont
      (end-cont ()
        (eopl:printf "计算结束.~%")
        val)
      (zero1-cont (saved-cont)
        (set! cont saved-cont)
        (set! val (bool-val (zero? (expval->num val))))
        (apply-cont))
      (let-exp-cont (var body saved-env saved-cont)
        (set! cont saved-cont)
        (set! exp body)
        (set! env (extend-env var val saved-env))
        (value-of/k))
      (if-test-cont (exp2 exp3 saved-env saved-cont)
        (set! cont saved-cont)
        (if (expval->bool val)
          (set! exp exp2)
          (set! exp exp3))
        (set! env saved-env)
        (value-of/k))
\begin{comment})))
 
\end{comment} \smallskip

指令式解释器(第3部分)

\smallskip \begin{comment}
 
(((
\end{comment}
      (diff1-cont (exp2 saved-env saved-cont)
        (set! cont (diff2-cont val saved-cont))
        (set! exp exp2)
        (set! env saved-env)
        (value-of/k))
      (diff2-cont (val1 saved-cont)
        (let ((num1 (expval->num val1))
               (num2 (expval->num val)))
          (set! cont saved-cont)
          (set! val (num-val (- num1 num2)))
          (apply-cont)))
      (rator-cont (rand saved-env saved-cont)
        (set! cont (rand-cont val saved-cont))
        (set! exp rand)
        (set! env saved-env)
        (value-of/k))
      (rand-cont (rator-val saved-cont)
        (let ((rator-proc (expval->proc rator-val)))
          (set! cont saved-cont)
          (set! proc1 rator-proc)
          (set! val val)
          (apply-procedure/k))))))
 
apply-procedure/k : \mathit{()} \to \mathit{FinalAnswer}
用法 : 依赖寄存器
proc1 : \mathit{Proc}
val : \mathit{ExpVal}
cont : \mathit{Cont}
(define apply-procedure/k
  (lambda ()
    (cases proc proc1
      (procedure (var body saved-env)
        (set! exp body)
        (set! env (extend-env var val saved-env))
        (value-of/k)))))

指令式解释器(第4部分)

\textnormal{[}{\star}\textnormal{]} 如果删去解释器某一分支中的“goto”会怎样?解释器会出什 么错?

\textnormal{[}{\star}\textnormal{]} 设计一些例子,解释上文提到的每个麻烦。

\textnormal{[}{\star}{\star}\textnormal{]}  寄存支持多参数过程的解释器()。

\textnormal{[}{\star}\textnormal{]}  用跳床转换这个解释器,用 (set! pc apply-procedure/k) 替换 apply-procedure/k 的调用,并使用下面这样的驱动器:

(define trampoline
  (lambda (pc)
    (if pc (trampoline (pc)) val)))

\textnormal{[}{\star}\textnormal{]} 设计一个语言特性,导致最后给 cont 赋值时,必须用临时变量。

\textnormal{[}{\star}\textnormal{]} 给本节的解释器添加 中的辅助组件。由于续文表示方式相同,可以 复用那里的代码。验证本节的指令式解释器生成的跟踪日志与 中的 解释器完全相同。

\textnormal{[}{\star}\textnormal{]}  转换本节的 fact-iterfact-iter)。

\textnormal{[}{\star}{\star}\textnormal{]}  修改本节的解释器,让过程使用 中的动态绑定。提示:像本章这样 转换 中的解释器;二者不同的部分转换后才会不同。 像 那样给解释器添加辅助组件。观察可知,就像当前状态中只有一 个续文,当前状态只会压入或弹出一个环境,而且环境与续文同时压入或弹出。由此我们得 出结论,动态绑定具有动态期限 (dynamic extent):即,形参的绑定保留 到过程返回为止。词法绑定则与之不同,绑定包裹在闭包内时可以无限期地保留。

\textnormal{[}{\star}\textnormal{]} 添加全局寄存器,排除本节代码中剩余的 let 表达式。

\textnormal{[}{\star}{\star}\textnormal{]} 改进前一题的解答,尽可能减少全局寄存器的数量。不到 5 个就可以。除了本节解释器中 已经用到的,不要使用其他数据结构。

\textnormal{[}{\star}{\star}\textnormal{]}  把本节的解释器翻译为指令式语言。做两次,一次使用宿主语言中的无参数过程调用,一次 使用 goto。计算量增加时,这二者性能如何?

\textnormal{[}{\star}{\star}\textnormal{]} imperative-lang所述,用大多数指令式语言都难以完成这种翻译,因为它们 在所有过程调用中使用堆栈,即使是尾调用。而且,对大型解释器,由 goto 链接的 代码可能太过庞大,以致某些编译器无法处理。把本节的解释器翻译为指令式语言, 用 中的跳跃技术规避这一难题。

5.4 异常

迄今为止,我们只用续文管理语言中的普通控制流。但是续文还能让我们修改控制上下文。让 我们来给我们的语言添加异常处理 (exception handling)。我们给语言新 增两个生成式:

\begin{align*}\mathit{Expression} &::= try \mathit{Expression} catch (\mathit{Identifier}) \mathit{Expression} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{try-exp (exp1 var handler-exp)} \\[5pt] \mathit{Expression} &::= raise \mathit{Expression} \\[-3pt] &\mathrel{\phantom{::=}} \fbox{raise-exp (exp)}\end{align*}

try 表达式在 catch 从句描述的异常处理上下文中求第一个参数的值。如果该 表达式正常返回,它的值就是整个 try 表达式的值,异常处理器(即 handler-exp)则被移除。

raise 表达式求出参数的值,以该值抛出一个异常。这个值会传给最接近的异常处理 器,并绑定到这个处理器的变量。然后,处理器主体将被求值。处理器主体可以返回一个值, 这个值称为对应 try 表达式的值;或者,它可以抛出另一个异常, 将异常传播 (propagate) 出去;这时,该异常会传给第二接近的异常处理器。

这里是一个例子(暂时假设我们给语言添加了字符串)。

let list-index =

     proc (str)

      letrec inner (lst)

       = if null?(lst)

         then raise("ListIndexFailed")

         else if string-equal?(car(lst), str)

              then 0

              else -((inner cdr(lst)), -1)

过程 list-index 是个咖喱式过程,它取一个字符串,一个字符串列表,返回字符串 在列表中的位置。如果找不到期望的列表元素,inner 抛出一个异常,跳过所有待做 的减法,把 "ListIndexFailed" 传给最接近的异常处理器。

这个异常处理器可以利用调用处的信息对异常做适当处理。

let find-member-number =

     proc (member-name)

      ... try ((list-index member-name) member-list)

            catch (exn)

             raise("CantFindMemberNumber")

过程 find-member-number 取一字符串,用 list-index 找出字符串在列表 member-name 中的位置。find-member-number 的调用者没办法知道 list-index,所以 find-member-number 把错误消息翻译成调用者能够理解的异 常。

根据程序的用途,还有一种可能是,元素名不在列表中时,find-member-number 返回 一个默认值。

let find-member-number =

     proc (member-name)

      ... try ((list-index member-name) member-list)

           catch (exn)

            the-default-member-number

在这些程序中,我们忽略了异常的值。在其他情况下,raise 传出的值可能包含一部 分可供调用者利用的信息。

用传递续文的解释器实现这种异常处理机制直截了当。我们从 try 表达式开始。在续 文的数据结构表示中,我们添加两个构造器:

    (try-cont
      (var identifier?)
      (handler-exp expression?)
      (env environment?)
      (cont continuation?))
    (raise1-cont
      (saved-cont continuation?))

value-of/k 中,我们给 try 添加下面的从句:

    (try-exp (exp1 var handler-exp)
      (value-of/k exp1 env
        (try-cont var handler-exp env cont)))

try 表达式主体的值时会发生什么呢?如果主体正常返回,那么这个值应该传给 try 表达式的续文,也就是此处的 cont

(apply-cont (try-cont var handler\mbox{-}exp env cont) val)

= (apply-cont cont val)

如果一个异常抛出了呢?首先,我们当然得求出 raise 参数的值。

    (raise-exp (exp1)
      (value-of/k exp1 env
        (raise1-cont cont)))

exp1 的值返回给 raise1-cont 时,我们要查找续文中最接近的异常处理器, 即最上层的 try-cont 续文。所以,我们把续文规范写成:

(apply-cont (raise1-cont cont) val)

= (apply-handler val cont)

其中,apply-handler 是一过程,它找出最接近的异常处理器,然后调用它 ()。

[!t]
apply-handler : \mathit{ExpVal} \times \mathit{Cont} \to \mathit{FinalAnswer}
(define apply-handler
  (lambda (val cont)
    (cases continuation cont
      (try-cont (var handler-exp saved-env saved-cont)
        (value-of/k handler-exp
          (extend-env var val saved-env)
          saved-cont))
      (end-cont ()
        (report-uncaught-exception))
      (diff1-cont (exp2 saved-env saved-cont)
        (apply-handler val saved-cont))
      (diff2-cont (val1 saved-cont)
        (apply-handler val saved-cont))
      ...)))

过程 apply-handler

要明白怎样将这些结合到一起,我们考虑用被定语言实现的 index。令 exp_0 指 代表达式:

let index

     = proc (n)

        letrec inner (lst)

          = if null? (lst)

            then raise 99

            else if zero?(-(car(lst), n))

                 then 0

                 else -((inner cdr(lst)), -1)

          in proc (lst)

              try (inner lst)

               catch (x) -1

in ((index 5) list(2, 3))

我们从任意环境 \rho_0 和续文 cont_0 开始求 exp_0 的值,只展示计算的 关键部分,并插入注释。

(value-of/k

   <>

  \rho_0

  cont_0)

= 执行let主体

(value-of/k

   <<((index 5) list(2, 3))>>

  ((index               称之为\rho_1

     #(struct:proc-val

        #(struct:procedure n <> \rho_0)))

   (i #(struct:num-val 1))

   (v #(struct:num-val 5))

   (x #(struct:num-val 10)))

  #(struct:end-cont))

= 最后求try的值

(value-of/k

   <>

  ((lst                 称之为\rho_{lst=(2 \ 3)}

     #(struct:list-val

        (#(struct:num-val 2) #(struct:num-val 3))))

   (inner ...)

   (n #(struct:num-val 5))

   \rho_0)

  #(struct:end-cont))

= try-cont续文中求try主体的值

(value-of/k

   <<(inner lst)>>

  \rho_{lst=(2 \ 3)}

  #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:end-cont)))

= lst绑定到(2 \ 3)inner主体的值

(value-of/k

   <>

  \rho_{lst=(2 \ 3)}

  #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:end-cont)))

= 求条件的值,进入递归所在的行

(value-of/k

  <<-((inner cdr(lst)), -1)>>

  \rho_{lst=(2 \ 3)}

  #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:end-cont)))

= diff-exp第一个参数的值

(value-of/k

   <<(inner cdr(lst))>>

  \rho_{lst=(2 \ 3)}

  #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:end-cont))))

= lst绑定到(3)inner主体的值

(value-of/k

   <>

  ((lst #(struct:list-val (#(struct:num-val 3)))) 称之为\rho_{lst=(3)}

   (inner ...)

   \rho_0)

  #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:end-cont))))

= 求条件的值,进入递归所在的行

(value-of/k

  <<-((inner cdr(lst)), -1)>>

  \rho_{lst=(3)}

  #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:end-cont))))

= diff-exp第一个参数的值

(value-of/k

   <<(inner cdr(lst))>>

  \rho_{lst=(3)}

  #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

           #(struct:end-cont)))))

= lst绑定到()inner主体的值

(value-of/k

   <>

  ((lst #(struct:list-val ()))     称之为\rho_{lst=()}

   (inner ...)

   (n #(struct:num-val 5))

   ...)

  #(struct:diff1-cont <<-1>> \rho_{lst=(3)}

     #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

           #(struct:end-cont)))))

= raise表达式参数的值

(value-of/k

   <<99>>

  \rho_{lst=()}

  #(struct:raise1-cont

     #(struct:diff1-cont <<-1>> \rho_{lst=(3)}

        #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

           #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

              #(struct:end-cont))))))

 

= apply-handler展开续文,直到找出一个异常处理器

(apply-handler

  #(struct:num-val 99)

     #(struct:diff1-cont <<-1>> \rho_{lst=(3)}

        #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

           #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

              #(struct:end-cont)))))

=

(apply-handler

  #(struct:num-val 99)

  #(struct:diff1-cont <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

        #(struct:end-cont))))

=

(apply-handler

  #(struct:num-val 99)

  #(struct:try-cont x <<-1>> \rho_{lst=(2 \ 3)}

     #(struct:end-cont)))

= 找到异常处理器;把异常值绑定到x

(value-of/k

  #(struct:const-exp -1)

  ((x #(struct:num-val 99))

  \rho_{lst=(2 \ 3)} ...)

  #(struct:end-cont))

=

(apply-cont #(struct:end-cont) #(struct:const-exp -1))

=

#(struct:const-exp -1)

如果列表包含期望值,那么我们不需调用 apply-handler,而是调用 apply-cont,并执行续文中所有待完成的 diff

\textnormal{[}{\star}{\star}\textnormal{]} 这种实现很低效,因为异常抛出时,apply-handler 必须在续文中线性查找处理器。 让所有续文都能直接使用 try-cont 续文,从而避免这种查找。

\textnormal{[}{\star}\textnormal{]} 另一种避免 apply-handler 线性查找的设计是使用两个续文,一个正常续文,一个异 常续文。修改本节的解释器,改用两个续文,实现这一目标。

\textnormal{[}{\star}\textnormal{]} 修改被定语言,在过程调用的实参数目错误时抛出异常。

\textnormal{[}{\star}\textnormal{]} 修改被定语言,添加除法表达式,并在被零除时抛出异常。

\textnormal{[}{\star}{\star}\textnormal{]} 目前,异常处理器可以重新抛出异常,把它传播出去;或者返回一个值,作为 try 表 达式的值。还可以这样设计语言:允许计算从异常抛出的位置继续。修改本节的解释器,在 raise 调用处的续文中运行异常处理器的主体,完成这种设计。

\textnormal{[}{\star}{\star}{\star}\textnormal{]} raise 异常处的续文作为第二个参数传递,使被定语言中的异常处理器既能返回也 能继续。这可能需要把续文作为一种新的表达值。为用值调用续文设计恰当的语法。

\textnormal{[}{\star}{\star}{\star}\textnormal{]}  我们展示了如何用数据结构表示的续文实现异常。我们没办法马上用过程表示法中的 步骤得到过程表示法,因为我们现在有两个观测器:apply-handlerapply-cont。用一对过程实现本节的续文:一个单参数过程,表示 apply-cont 中续文的动作;一个无参数过程,表示 apply-handler 中续文的动作。

\textnormal{[}{\star}{\star}\textnormal{]}  前一道练习只在抛出异常时捕获续文。添加形式 letcc \mathit{Identifier} in \mathit{Expression},允许在语言中的任意位置捕获续文,其规范为:

(value-of/k (letcc var body) \rho cont)

= (value-of/k body (extend-env var cont \rho) cont)

这样捕获的续文可用 throw 调用:表达式 throw \mathit{Expression} to \mathit{Expression} 求出两个子表达式的值。第二个表达式应返回一续文,应用于 第一个表达式的值。throw 表达式当前的续文则被忽略。

\textnormal{[}{\star}{\star}\textnormal{]} 修改前一道练习被定语言中的 letcc,把捕获的续文作为一种新的过程,这样就能写 (exp_1 exp_2),而不必写 throw \mathit{Expression} to \mathit{Expression}

\textnormal{[}{\star}{\star}\textnormal{]} 前面练习里的 letccthrow 还有一种设计方式,只需给语言添加一个过程。 这个过程在 Scheme 中叫做 call-with-current-continuation,它取一个单参数过程 p,并给 p 传递一个单参数过程,这个过程在调用时,将其参数传递给当前的续 文contcall-with-current-continuation 可用 letccthrow 定义如下:

let call-with-current-continuation

      = proc (p)

          letcc cont

          in (p proc (v) throw v to cont)

in ...

给语言添加 call-with-current-continuation。然后写一个翻译器,用只有 call-with-current-continuation 的语言翻译具有 letccthrow 的语 言。

5.5 线程

许多编程任务中,可能需要一次进行多项计算。当这些计算作为同一进程的一部分,运行在 同一地址空间,通常称它们为线程 (thread)。本节,我们将看到如何修改解释器, 模拟多线程程序的执行。

我们的多线程解释器不做单线程计算,而且维护多个线程。就像本章之前展示的那样,每 个线程包含一项正在进行的计算。线程使用状态中的赋值,通过共享内存通信。

在我们的系统中,整个计算包含一个线程 (pool)。每个 线程在运行 (running)、可运行 (runnable) 或者受 阻塞 (blocked)。在我们的系统中,一次只能有一个线程在运行。在多 CPU 系统中,可以有若干线程 同时运行。可运行的线程记录在名为就绪队列 (ready queue)的队列中。还有些线 程因为种种原因未能就绪,我们说这些线程受阻塞。本节稍后介绍受阻塞线程。

线程调度由调度器 (scheduler) 执行,就绪队列为其状态的一部分。 此外,它保存一个计时器,当一个线程执行若干步骤(即线程的时间片 (time slice) 量子 (quantum))时,它中断线程,将其放回就绪队列,并从就绪队列中选出一 个新的线程来运行。这叫做抢占式调度 (pre-emptive scheduling)。

我们的新语言基于 IMPLICIT-REFS,名叫 THREADS。在 THREADS 中,新线程由名为 spawn 的结构创建。spawn 取一参数,该参数的值应为一个过程。新创建的线程 运行时,给那个过程传递一个任意参数。该线程不是立刻运行,而是放入就绪队列中,轮到 它时才运行。spawn 的执行只求效果;在我们的系统中,我们为它任选一个返回值 73。

我们来看这种语言的两个示例程序。 定义了一个过程 noisy, 它取一个列表,打印出列表的第一个元素,然后递归处理列表的剩余部分。这里,主体中的 表达式创建两个线程,分别打印列表 [1,2,3,4,5][6,7,8,9,10]。两个列表 究竟如何穿插取决于调度器;在本例中,在被调度器打断之前,每个线程打印出列表中的两 个元素,

[!ht]

test: two-non-cooperating-threads

 

letrec

  noisy (l) = if null?(l)

              then 0

              else begin print(car(l)); (noisy cdr(l)) end

in

   begin

    spawn(proc (d) (noisy [1,2,3,4,5]));

    spawn(proc (d) (noisy [6,7,8,9,10]));

    print(100);

    33

   end

 

100

1

2

6

7

3

4

8

9

5

10

正确结果: 33

实际结果: #(struct:num-val 33)

正确

两个交错运行的线程

展示了一个生产者和一个消费者,由初始值为 0 的缓存相联系。 生产者取一参数 n,进入 wait,循环 5 次,然后把 n 放入缓存。每次进 入 wait 循环,它打印一个倒数计时器(以 200s 为单位)的值。消费者取一参数 (但忽略它),进入一循环,等待缓存变成非零值。每次进入循环时,它打印一个计数器 (以 100s 为单位)的值,以展示它等结果等了多久。主线程将生产者放入就绪队列,打印 出 300,并在自身中启动消费者。所以,前两项,300 和 205,分别由主线程和生产者线程 打印。原文为So the first two items, 300 and 205, are printed by the main thread. 实则205是生产者所在线程打印。就像前一个例子那样,在被打断之前,消费者线 程和生产者线程各自循环大约两次。

let buffer = 0

in let producer = proc (n)

        letrec

         wait(k) = if zero?(k)

                   then set buffer = n

                   else begin

                         print(-(k,-200));

                         (wait -(k,1))

                        end

         in (wait 5)

   in let consumer = proc (d)

           letrec busywait (k) = if zero?(buffer)

                                 then begin

                                       print(-(k,-100));

                                       (busywait -(k,-1))

                                      end

                                 else buffer

           in (busywait 0)

      in begin

          spawn(proc (d) (producer 44));

          print(300);

          (consumer 86)

         end

 

300

205

100

101

204

203

102

103

202

201

104

105

正确结果: 44

实际结果: #(struct:num-val 44)

正确

由缓存连接的生产者和消费者

实现从 IMPLICIT-REFS 语言传递续文的解释器开始。这与传递续文的解释器中的类似,只是多 了 IMPLICIT-REFS 中的存储器(当然!),以及 中的续文构造器 set-rhs-cont

我们给这个解释器添加一个调度器。调度器状态由四个值组成,接口提供六个过程来操作这 些值,如 所示。

展示了本接口的实现。这里 (enqueue q val) 返回 一队列,除了把 val 放在末尾之外,与 q 相同。(dequeue q f) 取出队头及剩余部分,将它们作为参数传递给 f

我们用无参数且返回表达值的 Scheme 过程表示线程:

\mathit{Thread} = () \to \mathit{ExpVal}

如果就绪队列非空,那么过程 run-next-thread 从就绪队列取出第一个线程并运行, 赋予它一个大小为 the-max-time-slice 的新时间片。如果还有就绪线程,它还把 the-ready-queue 设置为剩余线程队列。如果就绪队列为空,run-next-thread 返回 the-final-answer,计算至此全部终止。

然后我们来看解释器。spawn 表达式在某个续文中求参数的值,这个续文执行时,将 一个新线程放入就绪队列,并将 73 返回给 spawn 的调用者。新的线程执行时,将一 个任意值(这里选 28)传给 spawn 参数求值得到的过程。要完成这些,我们给 value-of/k 新增从句:

    (spawn-exp (exp)
      (value-of/k exp env
        (spawn-cont cont)))

apply-cont 新增从句:

    (spawn-cont (saved-cont)
      (let ((proc1 (expval->proc val)))
        (place-on-ready-queue!
          (lambda ()
            (apply-procedure/k proc1
              (num-val 28)
              (end-subthread-cont))))
        (apply-cont saved-cont (num-val 73))))

[!ht]

\begin{cornerbox}[title=调度器的内部状态]

the-ready-queue

 

就绪队列

the-final-answer

 

主线程结束时的值

the-max-time-slice

 

每个线程运行的步数

the-time-remaining

 

当前运行线程剩余的步数

\end{cornerbox}

\begin{cornerbox}[title=调度器的接口]

initialize-scheduler!

 

: \mathit{Int} \to \mathit{Unspecified}

 

初始化调度器状态

place-on-ready-queue!

 

: \mathit{Thread} \to \mathit{Unspecified}

 

把线程放入就绪队列

run-next-thread

 

: \mathit{()} \to \mathit{FinalAnswer}

 

运行下一个线程。如果没有就绪线程,返回最终答案。

set-final-answer!

 

: \mathit{ExpVal} \to \mathit{Unspecified}

 

设置最终答案

time-expired?

 

: \mathit{()} \to \mathit{Bool}

 

判断计时器是否为0

decrement-timer!

 

: \mathit{()} \to \mathit{Unspecified}

 

递减the-time-remaining

\end{cornerbox}

调度器的状态和接口

initialize-scheduler! : \mathit{Int} \to \mathit{Unspecified}
(define initialize-scheduler!
  (lambda (ticks)
    (set! the-ready-queue (empty-queue))
    (set! the-final-answer 'uninitialized)
    (set! the-max-time-slice ticks)
    (set! the-time-remaining the-max-time-slice)))
 
place-on-ready-queue! : \mathit{Thread} \to \mathit{Unspecified}
(define place-on-ready-queue!
  (lambda (th)
    (set! the-ready-queue
      (enqueue the-ready-queue th))))
 
run-next-thread : \mathit{()} \to \mathit{FinalAnswer}
(define run-next-thread
  (lambda ()
    (if (empty? the-ready-queue)
        (begin
          (when (debug-mode?)
            (eopl:printf "计算结束.~%"))
          the-final-answer)
        (begin
          (when (debug-mode?)
            (eopl:printf "切换到另一线程.~%"))
          (dequeue the-ready-queue
            (lambda (first-ready-thread other-ready-thread)
              (set! the-ready-queue other-ready-thread)
              (set! the-time-remaining the-max-time-slice)
              (first-ready-thread)))))))
 
set-final-answer! : \mathit{ExpVal} \to \mathit{Unspecified}
(define set-final-answer!
  (lambda (val)
    (set! the-final-answer val)))
 
time-expired? : \mathit{ExpVal} \to \mathit{Bool}
(define time-expired?
  (lambda ()
    (zero? the-time-remaining)))
 
decrease-timer! : \mathit{()} \to \mathit{Unspecified}
(define decrease-timer!
  (lambda ()
    (set! the-time-remaining (- the-time-remaining 1))))

调度器

let x = 0

in let mut = mutex()

   in let incr_x = proc (id)

                    proc (dummy)

                     set x = -(x,-1)

      in begin

          spawn((incr_x 100));

          spawn((incr_x 200));

          spawn((incr_x 300))

         end

不安全的计数器

跳跃式解释器生成快照时也要做这样:它将计算打包(这里的 (lambda () (apply-procedure/k ...))),然后把它传给另一个过程处理。在跳床的例子中,我们把 线程传给跳床,后者直接执行前者。这里,我们把新线程放入就绪队列,继续我们的现有计 算。

这带来一个关键问题:每个线程应在什么续文中运行?

由此我们得出两种新续文,其行为由 apply-cont 中的以下几行实现:

    (end-main-thread-cont ()
      (set-final-answer! val)
      (run-next-thread))
     
    (end-subthread-cont ()
      (run-next-thread))

我们从 value-of-program 入手整个系统:

value-of-program : \mathit{Int} \times \mathit{Program} \to \mathit{FinalAnswer}
(define value-of-program
  (lambda (timeslice pgm)
    (initialize-store!)
    (initialize-scheduler! timeslice)
    (cases program pgm
      (a-program (exp1)
        (value-of/k
          exp1
          (init-env)
          (end-main-thread-cont))))))

最后,我们修改 apply-cont,让它在每次调用时递减计时器。如果计时器到期,那就 中止当前计算。在实现时,我们先把一个线程放入就绪队列,它用调用 run-next-thread 时恢复的计时器再次调用 apply-cont

apply-cont : \mathit{Cont} \times \mathit{ExpVal} \to \mathit{FinalAnswer}
(define apply-cont
  (lambda (cont val)
    (if (time-expired?)
      (begin
        (place-on-ready-queue!
          (lambda () (apply-cont cont val)))
        (run-next-thread))
      (begin
        (decrement-timer!)
        (cases continuation cont
          ...)))))

共享变量不是可靠的通信方式,因为多个线程可能试图写同一变量。例如, 考虑 中的程序。这里,我们创建了三个线程,试图累加同一个计数 器 x。如果一个线程读取了计数器,但在更新计数器之前被打断,那么两个线程将把 计数器设置成同样的值。因此,计数器可能变成 2,甚至是 1,而不是 3。

我们想要确保不会发生这种混乱。同样地,我们想要组织我们的程序, 避免 中的程序空转。恰恰相反,它应该能够进入休眠状态,并在生 产者向共享缓存插入值时唤醒。

有许多方式设计这类同步组件。一种简单的方式是使用互斥锁 (mutex exclusion, mutex) 或二元信号量 (binary semaphore)。

互斥锁可能打开 (open) 或关闭 (closed)。它还包含一个等待互斥锁打 开的线程队列。互斥锁有三种操作:

这些属性保证在一对连续的 waitsignal 之间,只有一个线程可以执行。这 部分程序叫做关键区域 (critical region)。在关键区域内,两个线程不可能同时 执行。例如, 展示了我们之前的例子,只是在关键行周围插入了一 把互斥锁。在这个程序中,一次只有一个线程可以执行 set x = -(x,-1);所以计数 器一定能够到达终值 3。

[!t]

let x = 0

in let mut = mutex()

   in let incr_x = proc (id)

                    proc (dummy)

                      begin

                        wait(mut);

                        set x = -(x,-1);

                        signal(mut)

                      end

      in begin

          spawn((incr_x 100));

          spawn((incr_x 200));

          spawn((incr_x 300))

         end

使用互斥锁的安全计数器

我们用两个引用模拟互斥锁:一个指向其状态(开启或关闭),一个指向等待这把锁的线程 列表。我们还把互斥锁作为一种表达值。

(define-datatype mutex mutex?
  (a-mutex
    (ref-to-closed? reference?)
    (ref-to-wait-queue reference?)))

我们给 value-of/k 添加适当的行:

    (mutex-exp ()
      (apply-cont cont (mutex-val (new-mutex))))

其中:

new-mutex : \mathit{()} \to \mathit{Mutex}
(define new-mutex
  (lambda ()
    (a-mutex
     (newref #f)
     (newref '()))))

waitsignal 作为新的单参数操作,只是调用过程 wait-for-mutexsignal-mutexwaitsignal 都求出它们唯一参数的值,所以,在 apply-cont 中我们写:

    (wait-cont
      (saved-cont)
      (wait-for-mutex
        (expval->mutex val)
        (lambda () (apply-cont saved-cont (num-val 52)))))
     
    (signal-cont
      (saved-cont)
      (signal-mutex
        (expval->mutex val)
        (lambda () (apply-cont saved-cont (num-val 53)))))

现在,我们可以写出 wait-for-mutexsignal-mutex。这些过程取两个参数: 一个互斥锁,一个线程,其工作方式如上所述()。

wait-for-mutex : \mathit{Mutex} \times \mathit{Thread} \to \mathit{FinalAnswer}
用法 : 等待互斥锁开启,然后关闭它
(define wait-for-mutex
  (lambda (m th)
    (cases mutex m
      (a-mutex (ref-to-closed? ref-to-wait-queue)
        (cond
          ((deref ref-to-closed?)
            (setref! ref-to-wait-queue
              (enqueue (deref ref-to-wait-queue) th))
            (run-next-thread))
          (else
            (setref! ref-to-closed? #t)
            (th)))))))
 
signal-mutex : \mathit{Mutex} \times \mathit{Thread} \to \mathit{FinalAnswer}
(define signal-mutex
  (lambda (m th)
    (cases mutex m
      (a-mutex (ref-to-closed? ref-to-wait-queue)
        (let ((closed? (deref ref-to-closed?))
              (wait-queue (deref ref-to-wait-queue)))
          (if closed?
            (if (empty? wait-queue)
              (begin
                (setref! ref-to-closed? #f)
                (th))
              (begin
                (dequeue
                  wait-queue
                  (lambda (first-waiting-th other-waiting-ths)
                    (place-on-ready-queue!
                      first-waiting-th)
                    (setref!
                      ref-to-wait-queue
                      other-waiting-ths)))
                (th)))
            (th)))))))

wait-for-mutexsignal-mutex

\textnormal{[}{\star}\textnormal{]} 给本节的语言添加形式 yield。线程不论何时执行 yield,都将自身放入就绪队 列之中,就绪队列头部的线程接着执行。当线程继续时,就好像调用 yield 返回了 99。

\textnormal{[}{\star}{\star}\textnormal{]}  的系统中,线程放入就绪队列,既可能是因为耗尽时间片,也可 能是因为它选择让步。在后一种情况下,线程会以一个完整的时间片重启。修改系统,让就 绪队列记录每个线程的剩余时间片(如果有的话),在线程重启时仍使用剩余的时间片。

\textnormal{[}{\star}\textnormal{]} 如果剩余两个子线程,二者都在等待另一个子线程持有的互斥锁会怎样?

\textnormal{[}{\star}\textnormal{]}  我们用过程表示线程。将其改为数据结构表示法。

\textnormal{[}{\star}\textnormal{]}  为 THREADS 完成(用堆栈上的帧表示续文)。

\textnormal{[}{\star}{\star}\textnormal{]}  寄存本节的解释器。必须寄存的互递归尾调用过程有哪些?

\textnormal{[}{\star}{\star}{\star}\textnormal{]} 我们想要组织我们的程序,避免 中的程序空转。恰恰相反,它应该 能够进入休眠状态,并在生产者向共享缓存插入值时唤醒。用具有互斥锁的程序完成这些, 或者实现一种同步操作符完成这些。

\textnormal{[}{\star}{\star}{\star}\textnormal{]} 写出使用互斥锁的程序,如,但主线程等待所有三个子线程结束, 然后返回 x 的值。

\textnormal{[}{\star}{\star}{\star}\textnormal{]} 修改线程的表示,添加线程描述符 (thread identifier)。每个新线程都有一个新 的线程描述符。当子线程创建时,传给它的不是本节中的任意值 28,而是它的线程描述符。 子线程的描述符也作为 spawn 表达式的值返回给父线程。给解释器添加辅助组件,跟 踪线程描述符的创建。验证就绪队列中一个线程描述符至多出现一次。子线程如何获知父线 程的描述符?原程序的线程描述符应如何处理?

\textnormal{[}{\star}{\star}\textnormal{]}  的解释器添加组件 killkill 结构取一线程号,在 就绪队列或所有等待队列中找出对应的线程,然后删除它。此外,当它找到目标线程时,返 回真;在所有队列中都找不到指定线程号时,返回假。

\textnormal{[}{\star}{\star}\textnormal{]}  的解释器添加线程通信组件,一个线程可以用另一线程的描述符 给它发送一个值。线程可以选择接收消息,没有线程给它发消息时可以阻塞。

\textnormal{[}{\star}{\star}\textnormal{]} 修改 的解释器,不要使用共享存储器,而是让每个线程具有自己的 存储器。在这种语言中,几乎可以排除互斥锁。重写本节语言的示例程序,但不用互斥锁。

\textnormal{[}{\star}{\star}{\star}\textnormal{]} 在你最爱的操作系统教材中,有各种各样的同步机制。挑出三种,在本节的框架下实现它们。

\textnormal{[}绝对 {\star}\textnormal{]}  和朋友吃些披萨吧,但是一人一次一定只拿一块!