Exercise 3.31 · 习题

Exercise 3.31: The internal procedure
accept-action-procedure! defined in make-wire specifies that when
a new action procedure is added to a wire, the procedure is immediately run.
Explain why this initialization is necessary. In particular, trace through the
half-adder example in the paragraphs above and say how the system’s response
would differ if we had defined accept-action-procedure! as

(define (accept-action-procedure! proc)
(set! action-procedures
(cons proc action-procedures)))

Implementing the agenda

Finally, we give details of the agenda data structure, which holds the
procedures that are scheduled for future execution.

The agenda is made up of
time segments. Each time segment is a pair
consisting of a number (the time) and a queue (see Exercise 3.32) that
holds the procedures that are scheduled to be run during that time segment.

(define (make-time-segment time queue)
(cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))

We will operate on the time-segment queues using the queue operations described
in 3.3.2.

The agenda itself is a one-dimensional table of time segments. It differs from
the tables described in 3.3.3 in that the segments will be sorted
in order of increasing time. In addition, we store the
current time
(i.e., the time of the last action that was processed) at the head of the
agenda. A newly constructed agenda has no time segments and has a current time
of 0:

(define (make-agenda) (list 0))
(define (current-time agenda) (car agenda))
(define (set-current-time! agenda time)
(set-car! agenda time))
(define (segments agenda) (cdr agenda))
(define (set-segments! agenda segments)
(set-cdr! agenda segments))
(define (first-segment agenda)
(car (segments agenda)))
(define (rest-segments agenda)
(cdr (segments agenda)))

An agenda is empty if it has no time segments:

(define (empty-agenda? agenda)
(null? (segments agenda)))

To add an action to an agenda, we first check if the agenda is empty. If so,
we create a time segment for the action and install this in the agenda.
Otherwise, we scan the agenda, examining the time of each segment. If we find
a segment for our appointed time, we add the action to the associated queue.
If we reach a time later than the one to which we are appointed, we insert a
new time segment into the agenda just before it. If we reach the end of the
agenda, we must create a new time segment at the end.

(define (add-to-agenda! time action agenda)
(define (belongs-before? segments)
(or (null? segments)
( time
(segment-time (car segments)))))
(define (make-new-time-segment time action)
(let ((q (make-queue)))
(insert-queue! q action)
(make-time-segment time q)))
(define (add-to-segments! segments)
(if (= (segment-time (car segments)) time)
(insert-queue!
(segment-queue (car segments))
action)
(let ((rest (cdr segments)))
(if (belongs-before? rest)
(set-cdr!
segments
(cons (make-new-time-segment
time
action)
(cdr segments)))
(add-to-segments! rest)))))
(let ((segments (segments agenda)))
(if (belongs-before? segments)
(set-segments!
agenda
(cons (make-new-time-segment
time
action)
segments))
(add-to-segments! segments))))

The procedure that removes the first item from the agenda deletes the item at
the front of the queue in the first time segment. If this deletion makes the
time segment empty, we remove it from the list of segments:

(define (remove-first-agenda-item! agenda)
(let ((q (segment-queue
(first-segment agenda))))
(delete-queue! q)
(if (empty-queue? q)
(set-segments!
agenda
(rest-segments agenda)))))

The first agenda item is found at the head of the queue in the first time
segment. Whenever we extract an item, we also update the current
time:

(define (first-agenda-item agenda)

(if (empty-agenda? agenda)

(error "Agenda is empty:

FIRST-AGENDA-ITEM")

(let ((first-seg

(first-segment agenda)))

(set-current-time!

agenda

(segment-time first-seg))

(front-queue

(segment-queue first-seg)))))

练习 3.31：在 make-wire 中定义的内部过程 accept-action-procedure! 规定：当一个新的动作过程被加入连线时，该过程立即执行一次。请解释为何这一初始化是必要的。具体而言，请追踪上面段落中的半加器示例，说明若将 accept-action-procedure! 定义为如下形式，系统的响应将有何不同：

(define (accept-action-procedure! proc)
(set! action-procedures
(cons proc action-procedures)))

实现议程

最后，我们给出议程数据结构的细节，它保存着已调度待执行的各过程。

议程由若干时间段 (time segments) 构成。每个时间段是一个序对，由一个数（时刻）和一个队列（参见练习 3.32）组成，队列中保存在该时间段内计划运行的各过程。

(define (make-time-segment time queue)
(cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))

我们将使用 3.3.2 节中描述的队列操作来操作各时间段的队列。

议程本身是一个由时间段组成的一维表。它与 3.3.3 节中描述的表不同之处在于：各时间段按时间递增顺序排列。此外，我们将当前时间（即最近处理的动作的时刻）存储在议程的首部。新创建的议程不含任何时间段，当前时间为 0：

(define (make-agenda) (list 0))
(define (current-time agenda) (car agenda))
(define (set-current-time! agenda time)
(set-car! agenda time))
(define (segments agenda) (cdr agenda))
(define (set-segments! agenda segments)
(set-cdr! agenda segments))
(define (first-segment agenda)
(car (segments agenda)))
(define (rest-segments agenda)
(cdr (segments agenda)))

若议程不含任何时间段，则它为空：

(define (empty-agenda? agenda)
(null? (segments agenda)))

向议程中添加动作时，我们首先检查议程是否为空。若是，则为该动作创建一个时间段并安装到议程中。否则，扫描议程，逐一检查各时间段的时刻：若找到与预定时刻相同的时间段，则将该动作加入其关联的队列；若遇到时刻晚于预定时刻的时间段，则在其前面插入一个新时间段；若到达议程末尾，则在末尾创建一个新时间段。

(define (add-to-agenda! time action agenda)
(define (belongs-before? segments)
(or (null? segments)
(< time
(segment-time (car segments)))))
(define (make-new-time-segment time action)
(let ((q (make-queue)))
(insert-queue! q action)
(make-time-segment time q)))
(define (add-to-segments! segments)
(if (= (segment-time (car segments)) time)
(insert-queue!
(segment-queue (car segments))
action)
(let ((rest (cdr segments)))
(if (belongs-before? rest)
(set-cdr!
segments
(cons (make-new-time-segment
time
action)
(cdr segments)))
(add-to-segments! rest)))))
(let ((segments (segments agenda)))
(if (belongs-before? segments)
(set-segments!
agenda
(cons (make-new-time-segment
time
action)
segments))
(add-to-segments! segments))))

从议程中移除第一项的过程，删除第一个时间段队列前端的项。若此删除使该时间段变为空，则将其从时间段表中移除：

(define (remove-first-agenda-item! agenda)
(let ((q (segment-queue
(first-segment agenda))))
(delete-queue! q)
(if (empty-queue? q)
(set-segments!
agenda
(rest-segments agenda)))))

议程中的第一项位于第一个时间段的队列首端。每次取出一项时，同时更新当前时间：

(define (first-agenda-item agenda)
(if (empty-agenda? agenda)
(error “Agenda is empty:\nFIRST-AGENDA-ITEM”)
(let ((first-seg
(first-segment agenda)))
(set-current-time!
agenda
(segment-time first-seg))
(front-queue
(segment-queue first-seg)))))