3.3 Modeling with Mutable Data - CloneableX/SICP-learning GitHub Wiki
在第 2 章介绍过处理包含多个部件的复合数据方法，同时也讲解了关于数据抽象的规则，也就是关于数据对象构造器和选择器的使用及构建。不过我们又学习了关于数据的新知识，这些是在第 2 章没有提及的。本节的目标是修改复合对象系统中复合数据的状态，并能够正常对其应用构造器和选择器。为了修改复合对象模型中的状态，需要在数据抽象的设计中添加称为 变动函数（mutators） 的操作，可以通过它修改数据对象。在实际情况中，银行系统应该允许修改账户余额，所以表示银行账户的数据结构也要能够进行如下操作：
(set-balance! <account> <new-value>)上述操作能够将指定账户的余额修改。包含变动函数的数据对象被称为 可变数据对象（mutable data objects）。
在第 2 章介绍过序对是拼合数据常用方式。所以在本节的开头我们先为序对定义变动函数，这样可以为构建可变数据对象打下基础。变动函数除了依然能够构建之间学习过的序列和树型结构之外，还能够极大提升序对的表现力。这样可以为后续通过带有本地状态的多个对象构建类似模拟器的复杂系统提供便利。
序对的基本操作有 cons、car 和 cdr，它们可以用于构建列表结构和提取列表中的组件，但无法修改列表。就像 append 和 list 这些通过 cons、car 和 cdr 定义的程式一样，它们只能拥有构建列表和提取列表元素的能力。如果要修改列表必须引入新的操作。
序对的基础变动函数是 set-car! 和 set-cdr!。set-car! 程式接收两个参数，其中第一个参数为序对，它能够将序对中 car 的值修改为第二个参数值。
例如，x 与 ((a b) c d) 绑定，y 与 (e f) 绑定，如下图。执行 (set-car! x y) 时就会修改 x 对应的列表，会将 x 对应列表的 car 替换为 y 的值。运算结果在下面第二张图中，此时 x 的值已经被修改，x 的打印结果将变为 ((e f) c d)。而 (a b) 由于被替换，将从原有列表结构中脱离。
比较下图与上图，其实上图展示的结果与 (define z (cons y (cdr x))) 结果相同。不过 z 的绑定对象是通过 cons 创建的新序对，而 x 的绑定关系并没有发生变化。
set-cdr! 与 set-car! 相似，不同点在于 set-cdr! 替换的是序对的 cdr 指针。(set-cdr! x y) 的结果如下图。x 的 cdr 指针被指向 (e f) 的指针替换，原先 x 的 cdr 指针 (c d) 将从原列表结构中脱离。
与 cons 创建新序对不同，set-car! 和 set-cdr! 只是修改存在的序对。不仅如此，我们还可以通过 set-car! 和 set-cdr! 加上 get-new-pair（返回没有引用其他已经存在序对元素的全新序对） 实现 cons 程式。具体实现如下：
(define (cons x y)
(let ((new (get-new-pair)))
(set-car! new x)
(set-cdr! new y)
new))在之前的章节我们讨论过由于赋值操作的引入导致的同一性和状态变化的问题。当序对在不同数据对象之间共享时也会出现。例如，思考下列操作。
(define x (list 'a 'b))
(define z1 (cons x x))如下图所示，z1 的 car 和 cdr 指针都指向同一个序对 x，这个结果与 cons 的具体实现有关。通常来说，通过 cons 构建的列表都是基于共享序对的内部链接结构。
与上图对比，下图展示了 (define z2 (cons (list 'a 'b) (list 'a 'b))) 创建的结构。
在这个结构中，尽管列表元素是共享的，但它们是两个不同的 (a b) 列表。
从列表的角度考虑，其实 z1 和 z2 表示的都是相同的列表 ((a b) a b)。并且通常来说，如果只通过 cons、car 和 cdr 操作列表这种共享情况根本无法察觉。不过，如果使用变动函数维护列表，共享效果将变得十分明显。下面再举个关于共享的例子，思考下列程式，它将修改列表结构的 car 指针。
(define (set-to-wow! x) (set-car! (car x) 'wow) x)虽然 z1 和 z2 是相同的列表结构，但通过 set-to-wow! 产生的结果并不相同。在运算 z1 时，由于 z1 的 car 和 cdr 是同一序对，所以 car 和 cdr 都会被修改。而对于 z2，它的 car 和 cdr 是不同序对，所以只有 car 的序对被修改。
z1
((a b) a b)
(set-to-wow! z1)
((wow b) wow b)
z2
((a b) a b)
(set-to-wow! z2)
((wow b) a b)其实可以通过 eq? 检测列表结构中是否存在共享，就像在之前章节中介绍的检测标识是否相同的方法一样。更通俗地说，(eq? x y) 可以检测 x 和 y 是否为同一个对象（也就是 x 和 y 的指针是否相同）。所以 (eq? (car z1) (cdr z1)) 的结果是 true，而 (eq? (car z2) (cdr z2)) 的结果是 false。
在接下来的内容中，我们可以利用共享机制更好地扩展通过序对表示的数据结构。另一方面，共享机制也有风险，因为对共享部分的修改会导致其他使用相同共享的结构也受到影响。所以在使用变动函数 set-car! 和 set-cdr! 时要格外小心，如果没有理解数据对象共享的范围，修改操作将造成无法预料的结果。
在前面介绍复合数据时，有提及可以只通过程式实现序对的表现形式。
(define (cons x y)
(define (dispatch m)
(cond ((eq? m 'car) x)
((eq? m 'cdr) y)
(else (error "Undefined operation: CONS" m))))
dispatch)
(define (car z) (z 'car))
(define (cdr z) (z 'cdr))对于可变数据也可以进行类似的实现，需要使用赋值操作和本地状态。其实，可以像银行账号的例子一样实现 set-car! 和 set-cdr!。
(define (cons x y)
(define (set-x! v) (set! x v))
(define (set-y! v) (set! y v))
(define (dispatch m)
(cond ((eq? m 'car) x)
((eq? m 'cdr) y)
((eq? m 'set-car!) set-x!)
((eq? m 'set-cdr!) set-y!)
(else
(error "Undefined operation: CONS" m))))
dispatch)
(define (car z) (z 'car))
(define (cdr z) (z 'cdr))
(define (set-car! z new-value)
((z 'set-car!) new-value) z)
(define (set-cdr! z new-value)
((z 'set-cdr!) new-value) z)理论上，在可变数据的操作中赋值无处不在。所以一旦在编程语言中引入了 set! 操作，所有关于赋值操作的问题通常也是可变数据的问题。
变动函数 set-car! 和 set-cdr! 使我们拥有了除 cons、car 和 cdr 之外利用序对构建其他数据结构的能力。本节内容将展示通过序对构建队列的方式，以及下一节将讲解构建表的方式。
队列（queue） 是一种序列，这种序列只允许从一端添加数据（称为队列的后端）从另一端删除数据（称为队列的前端）。下图展示了对队列操作元素的过程。首先向空队列添加元素 a 和 b。然后将 a 移除，并添加 c 和 d，然后再移除 b。由于元素问题按添加时的顺序被移除，所以队列也称为 FIFO（先进先出）缓存。
在数据抽象层面，可以认为队列由下列操作构成：
- 构造器
(make-queue)，它能够返回一个空队列（队列中没有任何元素） - 两个选择器
-
(empty-queue? <queue>)检验队列是否为空 -
(front-queue <queue>)返回队列前端的元素，如果队列为空将报错，但它并不会修改队列
-
- 两个变动函数
-
(insert-queue! <queue> <item>)在指定队列的后端添加元素，将返回变动后的队列 -
(delete-queue! <queue>)从队列前端移除元素，并将修改后的队列返回，如果删除操作前队列为空将报错
-
因为队列的本质就是序列，所以完全可以通过列表构建队列。队列的前端就是列表的 car，在队列后端加入元素相当于在列表后端附加新元素，从队列中删除元素相当于列表的 cdr 操作。但这种实现方式不够高效，因为对于向队列添加元素的操作而言，需要扫描整个列表直到找到列表尾部为止。扫描列表需要不断调用 cdr 操作，整个时间增长趋势为 O(n)。如果要克服这个缺陷就要将队列操作的时间增长趋势降为 O(1)，也就是说队列操作不能与列表长度相关。
现在已经了解了使用列表实现队列的难点，为了解决此问题，可以增加一个指针指向列表的最后一个序对。使用此方案便可以避免向队列添加元素时扫描整个列表。
所以构建列表时需要一对指针，front-ptr 和 rear-ptr，它们分别指向列表的第一个序对和最后一个序对。可以通过 cons 将两个指针组合的方式将队列构建为可识别的对象，所以队列的内容就是通过 cons 组合的两个指针。下图描述了完整的队列结构。
队列的相关程式具体实现如下：
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item)
(set-car! queue item))
(define (set-rear-ptr! queue item)
(set-cdr! queue item))
(define (empty-queue? queue)
(null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
(if (empty-queue? queue)
(error "FRONT called with an empty queue" queue)
(car (front-ptr queue))))向队列添加元素时有些变化。首先创建一个序对，其中 car 部分为被添加的元素，cdr 部分为空列表。如果此时队列为空，队列的前端指针和后端指针都指向当前元素。否则，将队列中的最后一个序对指向新序对，并将后端指针也指向新序对。
(define (insert-queue! queue item)
(let ((new-pair (cons item '())))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-pair)
(set-rear-ptr! queue new-pair)
queue)
(else
(set-cdr! (rear-ptr queue) new-pair)
(set-rear-ptr! queue new-pair)
queue))))上述程式的操作过程如下图。
如果要删除队列前端的元素，只需要将前端指针指向队列的第二个元素即可。
(define (delete-queue! queue)
(cond ((empty-queue? queue)
(error "DELETE! called with an empty queue" queue))
(else (set-front-ptr! queue (cdr (front-ptr queue)))
queue)))具析操作过程可以参考下图。
在第 2 章我们用不同的方式构建了集合，而且其中有部分内容涉及表的相关操作。在数据导向编程的相关内容中甚至涉及二维表的操作，所以有必要在本节讲解通过可变列表结构构建表的方法。
先从较简单的情况开始，先处理一维表的情况，其中的每一条数据都对应着一个唯一的键。我们可以通过将记录组织成列表形式，然后将记录与对应键值使用 cons 关联。于是记录便是一个序对列表，通过 car 可以不断访问到记录，这些序对构成了表格的骨架。为了方便向表格中添加新记录，需要通过 带头列表（headed list） 构建表格。在带头列表的第一个骨架序对为虚拟记录，可以是任意符号的标识，不过一般为 *table*。下图展示了含有下列记录的表格。
a: 1
b: 2
c: 3
如果要从表格中查找记录，可以通过 lookup 程式，它能够通过键值查找对应的记录（如果不存在对应记录是返回 false）。lookup 通过 assoc 进行运算，assoc 需要键值和记录列表作为参数。需要注意的是，assoc 从不了解虚拟记录，它只是对比真实记录的键值与目标键值，并返回对应的记录。lookup 会根据 assoc 返回的结果是否为 false 决定返回 false 或者记录的数值。
(define (lookup key table)
(let ((record (assoc key (cdr table))))
(if record
(cdr record)
false)))
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))如果要将记录添加至表格中，需要先通过 assoc 查找表格中是否已经存在相同键值的记录。如果不存在，则将键值与数值组合而成的新记录添加在表格记录列表的首位。如果表格中已经存在相同键值的记录，则将记录中的数值修改为新记录的数值。表格的头部虚拟记录给我们提供了添加新记录时的相对定位功能。
(define (insert! key value table)
(let ((record (assoc key (cdr table))))
(if record
(set-cdr! record value)
(set-cdr! table
(cons (cons key vlaue)
(cdr table)))))
'ok)要构建表格可以通过创建首个元素是 *table* 的列表实现。
(define (make-table)
(list '*table*))在二维表格中，需要两个键值才能定位记录，所以可以通过创建一个记录为表格的一维表格实现。下图展示了下列数据对应的表格结构。
math: +: 43 letters: a: 97
-: 45 b: 98
*: 42
其中有两个子表（子表不需要表头符号，因为键值可以实现标识子表的作用）。
查找记录时，需要通过第一个键值查找对应的子表，然后通过第二个键值在子表中查找对应记录。
(define (lookup key-1 key-2 table)
(let ((subtable
(assoc key-1 (cdr table))))
(if subtable
(let ((record (assoc key2 (cdr subtable))))
(if record
(cdr record)
false))
false)))添加新记录时，先通过第一个键值查找是否存在对应的子表。如果子表不存在，则创建新子表并将 (key-2 value) 记录添加至新子表中，然后将新子表添加至主表中并使用第一个键值标识。如果子表已经存在，直接使用一维表格添加记录的方法将记录添加至子表中即可。
(define (insert! key-1 key-2 value table)
(let ((subtable (assoc key-1 (cdr table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! table
(cons (list key-1 (cons key-2 value))
(cdr table)))))
'ok)之前定义的 lookup 和 insert! 都以表格作为参数，所以可以通过这些程序访问多个表格。处理多表格的方式是为每个表格建立自己的 lookup 和 insert! 程式，也就是说需要将表格的表现方式程式化，就像一个对象将表格作为它的本地状态维护一样。当发送相应的信息时，表格对象会对内部表格进行相应的操作。下面是对二维表格构造器的改写。
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2 (cdr subtable))))
(if record (cdr record) false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1 (cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation: TABLE" m))))
dispatch))通过 make-table 便可以实现数据导向编程示例中的 get 和 put 操作。
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))类似电脑的数字系统设计是一种重要的工程活动。数字系统由一些简单的元素组合而成，尽管每个元素的功能都十分简单，但组合后它们将拥有复杂的功能。使用电脑模拟电路设计是工程师在设计系统时的重要工具，所以本节将设计一个逻辑信号模拟系统。此系统由 事件驱动模拟（event-driven simulation） 的程序构成，这种程序中的行为（事件）将引发其他的事件，然后事件会再次相互触发。
电路的计算模型由构成电路的元素组成。其中存在一些线路，用于传导数字信号。任何时候数字信号的数值只能是 0 或 1 的其中一个。除此之外，还有数字功能模块，它们负责接收线路传导的数字信号，并将输入信号的计算结果输出到另一线路中。输出信号的延迟与具体的功能模块有关。比如，反门（inverter） 模块能够将输入的数字信号反转，也就是输入信号为 0，经过一个反门延迟时间单位之后输出信号为 1。在下图中标识了反门。在下图中也标识了 与门（and-gate），它能够将两个转入信号转换为一个数字信号输出，输出结果是两个输入信号的逻辑与运算结果。也就量说，当输入信号都为 1 时，经过一个与门单位时间的延迟将输出为 1 的信号，否则将输出结果为 0 的信号。或门（or-gate） 与之类似，它能够将两个输入信号通过逻辑或运算合并为一个信号输出。如果输入信号中至少存在一个为 1 的信号，则输出信号为 1，否则输出信号为 0。
在这些基础功能模块的之上，通过线路将一个模块的输出信号输入另一个功能模块，便能够构建更加复杂的功能模块。例如，半加器（half-adder） 电路如下图所示，它由一个或门，两个与门和一个反门组成。半加器接收两个输入信号 A 和 B，并输出两个信号 S 和 C。只要 A 和 B 中有一个为 1，则 S 便为 1；只有 A 和 B 都为 1 时 C 才为 1。通过图示可以看出，由于不同的功能模块产生的延迟，最后的输出信号也将在不同时间生成。而数字电路的设计难点也多来自于此。
现在可以编写数字电路的建模程序，其中需要有扮演线路的对象，它将持有信号。功能模块被设计为线路的有序集合。
整个模拟器最基础的程式是 make-wire，它能够构建线路。比如，通过下列表达式可以创建 6 条线路。
(define a (make-wire))
(define b (make-wire))
(define c (make-wire))
(define d (make-wire))
(define e (make-wire))
(define s (make-wire))功能模块由一组线路组成，构建功能模块的程式的参数表示与当前模块相接触的线路。例如，可以按下列方式构建半加器中的与门、或门及反门。
(or-gate a b d)
(and-gate a b c)
(inverter c e)
(and-gate d e s)然后利用上述程式构建的组件定义 half-adder 程式。
(define (half-adder a b s c)
(let ((d (make-wire)) (e (make-wire)))
(or-gate a b d)
(and-gate a b c)
(inverter c e)
(and-gate d e s)
'ok))将半加器定义为程式的好处在于，我们可以将其作为组件构建更加复杂的电路。例如下图中的 全加器（full-adder），它需要两个半加器和一个或门组成。
全加器的具体实现如下。
(define (full-adder a b c-in sum c-out)
(let ((s (make-wire)) (c1 (make-wire)) (c2 (make-wire)))
(half-adder b c-in s c1)
(half-adder a s sum c2)
(or-gate c1 c2 c-out)
'ok))同理，被定义为程式的全加器也可以作为组件构建更加复杂的数字电路。
就本质而言，我们构建的模拟器是一门用于构建电路的语言。如果从接触一门类似 Lisp 的编程语言角度出发，基础功能模块就是编程语言中的基础元素，将不同功能模块链接的过程就是程式抽象的过程。
基础功能模块需要实现获取线路信号和修改线路信号的能力。所以需要通过下列程式对线路信号进行操作。
-
(get-signal <wire>)返回线路中的当前信号数值 -
(set-signal! <wire> <new value>)将线路中信号值修改为新信号值 -
(add-action! <wire> <procedure of no arguments>)当线路中的信号改变时需要执行传入的程式。这个程式充当当前线路信号变动时与其中线路沟通的工具。
并且，需要通过 after-delay 在指定延迟发生后执行相应程式。通过以上程式，便可以开始定义基础数字逻辑模块。如果使用反门连接两条线路，则需要通过 add-action! 为输入线路添加一个程式，此程式将在输入线路信号变化时运行。接着通过 logical-not 计算转入信号，并在 inverter-delay 后将运算结果传递给输出信号。
(define (inverter input output)
(define (invert-input)
(let ((new-value (logical-not (get-signal input))))
(after-delay inverter-delay
(lambda () (set-signal! output new-value)))))
(add-action! input invert-input) 'ok)
(define (logical-not s)
(cond ((= s 0) 1)
((= s 1) 0)
(else (error "Invalid signal" s))))与门会更复杂一些，因为与门的任何一条输入线路信号变化都需要运行行为程式。它通过 logical-and 计算输入信号值，并在 and-gate-delay 延迟后将计算结果传递给输出线路。
(define (and-gate a1 a2 output)
(define (and-action-procedure)
(let ((new-value
(logical-and (get-signal a1) (get-signal a2))))
(after-delay
and-gate-delay
(lambda () (set-signal! output new-value)))))
(add-action! a1 and-action-procedure)
(add-action! a2 and-action-procedure)
'ok)在我们的模拟器中，线路是一个 singal-value（初始值为 0）和一组信号变化时将要执行的 action-procedures 本地状态变量的计算对象。我们希望像银行账号的示例一样，按照消息传递的风格实现线路对象。
(define (make-wire)
(let ((signal-value 0) (action-procedures '()))
(define (set-my-signal! new-value)
(if (not (= signal-value new-value))
(begin (set! signal-value new-value)
(call-each action-procedures))
'done))
(define (accept-action-procedures! proc)
(set! action-procedures
(cons proc action-procedures))
(proc))
(define (dispatch m)
(cond ((eq? m 'get-signal) signal-value)
((eq? m 'set-signal!) set-my-signal!)
((eq? m 'add-action!) accept-action-procedure!)
(else (error "Unknown operation: WIRE" m))))
dispatch))局部程式 set-my-signal! 会检测新的信号值是否会修改原有信号值。如果原有信号值会被修改，则此线路中的所有行为程式需要被逐个执行，其中 call-each 逐个执行行为程式，具体实现如下。
(define (call-each procedures)
(if (null? procedures)
'done
(begin ((car procedures))
(call-each (cdr procedures)))))局部程式 accept-action-procedure! 负责将新程式加入行为程式列表，并且运行一次新加入的行为程式。
dispatch 程式负责定义线路对象的接口规范，可以通过下列程式操作线路对象。
(define (get-signal wire) (wire 'get-signal))
(define (set-signal! wire new-value)
((wire 'set-signal!) new-value))
(define (add-action! wire action-procedure)
((wire 'add-action!) action-procedure))线路中既有随时变化的信号，还有增量连接的模块，所以它是典型的可变对象。根据分析，我们将线路对象设计为通过赋值操作修改本地状态变量的程式。当一条新线路被创建时，一组新的状态变量也将产生，并且返回一个新创建的 dispatch 程式，通过 dispatch 程式便能够获取线路状态变量所处的环境。
线路通过与不同模块连接的方式被各个模块共享，所以与其相连的某个模块变动信号时其他与之相连的模块也会受到影响。当线路与模块的连接建立后，线路通过调用行为程式实现与其他相连模块沟通的目标。
目前仅剩 after-delay 尚未实现。为了实现 after-delay，需要引入相应的数据结构 待办事项表（agenda），它包含一个待办事项的日程表。下列程式都用于操作待办事项表。
-
(make-agenda)返回一个空的待办事项表 -
(empty-agenda? <agenda>)当行为事项表为空时将返回 true -
(remove-first-agenda-item! <agenda>)将移除待办事项表的首项元素 -
(add-to-agenda! <time> <action> <agenda>)在行为事项表中添加一个行为程式，此行为程式将在指定时间后运行 -
(current-time <agenda>)返回当前模拟的时间
我们通过 the-agenda 表示指定的待办事项表，而 after-delay 将向 the-agenda 添加新元素。
(define (after-delay delay action)
(add-to-agenda! (+ delay (current-time the-agenda))
action
the-agenda))整个待办事项的处理主要由 propagate 推动，它将按待办事项表中顺序执行程式。一般情况下，在待办事项被处理的过程中还会有新元素被加入到待办事项表，所以只要待办事项表中还有元素 propagate 就会持续运行。
(define (propagate)
(if (empty-agenda? the-agenda)
'done
(let ((first-item (first-agenda-item the-agenda)))
(first-item)
(remove-first-agenda-item! the-agenda)
(propagate))))下列程式是一个线路中的探针，用于展示模拟器中的行为。探针会描述线路中信号改变的时间，并打印新的信号值、线路名称和当前时间。
(define (probe name wire)
(add-action! wire
(lambda ()
(newline)
(display name) (display " ")
(display (current-time the-agenda))
(display " New-value = ")
(display (get-signal wire)))))接着初始化待办事项表，以及定义基础功能模块的延迟时间。
(define the-agenda (make-agenda))
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)然后定义四条线路，并为其中两条线路设置探针。
(define input-1 (make-wire))
(define input-2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))
(probe 'sum sum)
sum 0 New-value = 0
(probe 'carry carry)
carry 0 New-value = 0接下来再组装半加器，不过需要将 input-1 的信号值设为 1。
(half-adder input-1 input-2 sum carry)
ok
(set-signal! input-1 1)
done
(propagate)
sum 8 New-value = 1
donesum 的信号值经过 8 个单位时间转变为 1，也就是说距离模拟开始过去了 8 个单位时间。接着可以将 input-2 的信号值设置为 1 观察结果。
(set-signal! input-2 1)
done
(propagate)
carry 11 New-value = 1
sum 16 New-value = 0
done当 carry 信号转变为 1 时经过了 11 个单位时间，而 sum 的信号转变为 0 时经过了 16 个单位时间。
最后，我们还需要实现待办事项表的细节。待办事项表其实是 时间片段（time segments） 的变体。时间片段是一个序对，由一个数字（也就是时间）和一个队列组成，队列中存储着对应时间要执行的程式。
(define (make-time-segment time queue)
(cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))接下来需要使用之前讲解过的队列操作处理时间片段队列。待办事件列表是一个一维表格，它与之前介绍的表格不同之处在于需要将时间片段按时间的升序排列，并且要在待办事项表表头存储当前时间（也就是被执行的最后一个行为的时间）。新创建的待办事项表没有时间片段，并且当前时间为 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 (reset-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-time 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)))))按照传统，计算机程序被组织为单向计算，也就是向程式传递预先指定的参数并得到预期的结果。另一方面，我们又常常需要对各种量之间的关系进行建模。例如，在一个机械结构的数据模型中可能存在这种情况，一根金属杆的偏转量 d 与施加于杆上的力 F、杆的长度 L 、横截面 A 及弹性系数 E 有关，表示为下列等式。
dAE=FL
上述等式并不属于单向计算。虽然在已知其中四个量的情况下可以计算第五个量，但这种将其强行转换为计算机程序的方式使我们只能以其中一个量作为计算结果。也就是说，如果某个程式能够计算横截面 A 的值，便不能计算偏转量 d，即使 A 与 d 是同一等式中的量。
在本节，我们将设计一种能够处理量之间关系的编程语言。这门语言的基础元素是 基本约束（primitive constraints），它是一种描述量之间关系的状态。例如，(adder a b c) 表示 a、b、c 这三个量符合 a+b=c 的等式关系，(multiplier x y z) 表示 xy=z 的约束，以及 (constant 3.14 x) 表示 x 的值就是 3.14。
为了表示更加复杂的约束，这门语言需要提供组合基本约束的方法。我们可以通过 约束网络（constraint network） 组合约束，它能够通过 连接器（connector） 组合约束。连接器对象能够处理参与一个或多个约束的值。例如，下列等式描述了华氏度与摄氏度的转换关系。
9C=5(F-32)
我们可以认为它是一个由加法约束、乘法约束和常量约束三种约束构成的约束网络，如下图。在图示中，左边的乘法约束模块有三个关系，分别是 m1、m2 和 p，它们共同组成了该乘法约束的约束网络。其中的 m1 关系连接连接器 C，用于表示摄氏温度。m2 关系用于连接连接器 w，该连接器用于连接 9 的常量模块。p 关系是 m1 与 m2 由乘法约束运算的积，它也连接于另一个乘法模块，这个乘法模块中 m1 连接加法约束中加数，m2 链接常量 5。
约束网络的按这样的方式进行计算，当连接器提供一个值时（由用户或约束模块提供），它将唤起所有与之相关的约束（除了唤起连接器的约束），并告知此连接器有一个数值。每唤起一个约束，都需要检查它的连接器是否有足够的信息能够计算某一连接器的数值。如果条件满足，此约束模块会重新设置连接器，然后再唤起与此连接器相关的所有约束，一直重复下去。例如，在转换摄氏度和华氏度的过程中，w、x 和 y 分别被设置为常量约束模块 9、5 和 32。这些连接器会唤起乘法和加法约束模块，并判断这些约束模块中是否拥有足够的信息使计算能够继续。如果用户将 C 设置为 25，则最左侧的乘法约束模块将被唤起，然后将 u 设置为 25*9=225。接着 u 将唤起另一个乘法约束模块，将 v 设置为 45，最后 v 将唤起加法约束模块，并将 f 设置为 77。
要使用约束系统进行之前的温度转换计算，首先要创建两个连接器 C 和 F。通过 make-connector 可以创建它们，然后将 C 和 F 连接到相应的网络中。
(define C (make-connector))
(define F (make-connector))
(cesius-fahrenheit-converter C F)
ok创建网络的具体实现如下。
(define (celsius-fahrenheit-converter c f)
(let ((u (make-connector))
(v (make-connector))
(w (make-connector))
(x (make-connector))
(y (make-connector)))
(multiplier c w u)
(multiplier v x u)
(adder v y f)
(constant 9 w)
(constant 5 x)
(constant 32 y)
'ok))上述程式创建了内部连接器 u、v、w、x 和 y，它们的连接关系就像之前图例展示的一样。并且也与数字电路模拟器类似，都相当于提供了一门编程语言中的基础元素及组合方法。
为了运作中的网络可视化，我们将为连接器 C 和 F 添加探针，也是使用 probe 程式。无论连接器在何时被设置了数值，应用于连接器的探针都将打印相关信息。
(probe "Celsius temp" C)
(probe "Fahrenheit temp" F)接下来需要将 C 的值设置为 25，通过 set-value! 的第三个参数可以告知 C 此数值来自于用户设置。
(set-value! C 25 'user)
Probe: Celsius temp = 25
Probe: Fahrenheit temp = 77
doneC 的探针被唤起，并打印了 C 的数值。C 同时通过约束网络传播它的数值，最后将 F 的值设置为 77，并由 F 的探针打印。
现在尝试将 F 的值设置为 212 看看将发生什么。
(set-value! F 212 'user)
Error! Contradiction (77 212)连接器报告了一个它感知到的矛盾点，因为此时连接器 F 的值为 77，但有人想设置为 212。如果我们希望再次使用网络，需要让 C 忘记原数值。
(forget-value! C 'user)
Probe: Celsius temp = ?
Probe: Fahrenheit temp = ?
doneC 查找之前 user 设置的数值，并将其抹除，并且将这个变化通过约束网络进行传递。当传递至 F 时，F 认为没有任何理由再继续信赖当前的数值结果 77，于是 F 也将它的数值抹除。
现在 F 已经没有了数值，我们可以尝试为其设置值 212。
(set-value! F 212 'user)
Probe: Fahrenheit temp = 212
Probe: Celsius temp = 100
done新的数值也将通过约束网络传递，直到将 C 的数值转换为 100。这两个例子说明同一个约束网格既可以通过 F 计算 C，也可以通过 C 计算 F。所以约束系统的不同之外在于可以进行非定向运算。
约束系统通过带有本地状态的程式对象实现，它与数字电路模拟器系统十分相似。虽然约束系统中的基础对象更加复杂，但整个系统更加简单，因为它不需要关心待办事项表和逻辑模块的时间延迟。
关于连接器的基本操作如下：
-
(has-value? <connector>)可以判断连接器是否存在数值 -
(get-value <connector>)返回连接器的当前数值 -
(set-value! <connector> <new-value> <informant>)可以为连接器设计新数值并标识其来源 -
(forget-value! <connector> <retractor>)可以使连接器抹除指定来源的数值 -
(connect <connector> <new-constraint>)为连接器关联新的约束
连接器通过 inform-about-value 与关联约束交流，用于通知关联约束当前连接器存在一个数值；inform-about-no-value 将通知关联约束当前连接器已经抹除了数值。
adder 由连接器 a1、a2 和 sum 连接器共同构成加法约束。加法约束模块通过拥有本地状态的程式实现。
(define (adder a1 a2 sum)
(define (process-new-value)
(cond ((and (has-value? a1) (has-value? a2))
(set-value! sum
(+ (get-value a1) (get-value a2))
me))
((and (has-value? a1) (has-value? sum))
(set-value! a2
(- (get-value sum) (get-value a1))
me))
((and (has-value? a2) (has-value? sum))
(set-value! a1
(- (get-value sum) (get-value a2))
me))))
(define (process-forget-value)
(forget-value! sum me)
(forget-value! a1 me)
(forget-value! a2 me)
(process-new-value))
(define (me request)
(cond ((eq? request 'I-have-a-value) (process-new-value))
((eq? request 'I-lost-my-value) (process-forget-value))
(else (error "Unknown request: ADDER" request))))
(connect a1 me)
(connect a2 me)
(connect sum me)
me)adder 将相关的连接器组合成加法约束模块，并返回结果。其中 me 表示加法约束本身，它与 dispatch 的功能相似。下列的语法接口用于连接分发操作。
(define (inform-about-value constraint)
(constraint 'I-have-a-value))
(define (inform-about-no-value constraint)
(constraint 'I-lost-my-value))当其他连接器存在数值并通知加法约束器时，加法约束器将调用 process-new-value。加法约束模块首先会检查 a1 和 a2 是否有值，如果都有值，会将 sum 连接器的值设置为 a1 和 a2 的加法运算结果。set-value! 中的 informant 参数值为 me，也就是加法约束模块本身。如果 sum 有值而 a1 或 a2 其中一个有值，将会通过加法的反向操作计算得到其中一个加数。如果加法约束模块中的任意连接器被抹除数值，则它所有的连接器都需要进行抹除数值操作，不过只有通过加法约束模块本身添加的数值才会真正被抹除。并在抹除操作的最后一步执行 process-new-value，这是因为抹除数值业务完成时，可能还有连接器存在数值（连接器的值可能并不是由加法约束模块设置的），而这些数值需要加法约束模块传播回去。
乘法约束模块与加法约束模块十分相似，不过只要因数中有一个为 0，则积便是 0，无论是否所有的因数都有值。
(define (multiplier m1 m2 product)
(define (process-new-value)
(cond ((or (and (has-value? m1) (= (get-value m1) 0))
(and (has-value? m2) (= (get-value m2) 0)))
(set-value! product 0 me))
((and (has-value? m1) (has-value? m2))
(set-value! product
(* (get-value m1) (get-value m2))
me))
((and (has-value? product) (has-value? m1))
(set-value! m2
(/ (get-value product) (get-value m1))
me))
((and (has-value? product) (has-value? m2))
(set-value! m1
(/ (get-value product) (get-value m2))
me))))
(define (process-forget-value)
(forget-value! product me)
(forget-value! m1 me)
(forget-value! m2 me)
(process-new-value))
(define (me request)
(cond ((eq? request 'I-have-a-value) (process-new-value))
((eq? request 'I-lost-my-value) (process-forget-value))
(else (error "Unknown request: MULTIPLIER"
request))))
(connect m1 me)
(connect m2 me)
(connect product me)
me)constant 构造器只负责将数值放置到对应的连接器，任何 I-hava-a-value 和 I-lost-my-value 都会导致错误出现。
(define (constant value connector)
(define (me request)
(error "Unknown request: CONSTANT" request))
(connect connector me)
(set-value! connector value me)
me)最后，探针将打印连接器的设置或抹除数值的相关信息。
(define (probe name connector)
(define (print-probe value)
(newline) (display "Probe: ") (display name)
(display " = ") (display value))
(define (process-new-value)
(print-probe (get-value connector)))
(define (process-forget-value) (print-probe "?"))
(define (me request)
(cond ((eq? request 'I-have-a-value) (process-new-value))
((eq? request 'I-lost-my-value) (process-forget-value))
(else (error "Unknown request: PROBE" request))))
(connect connector me)
me)连接器可以使用带有本地状态变量的程式对象实现，其中本地变量 value 表示当前连接器的数值，informant 表示设置连接器数值的来源对象，constraints 是一个列表，用于表示与连接器相关的约束。
(define (make-connector)
(let ((value false) (informant false) (constraints '()))
(define (set-my-value newval setter)
(cond ((not (has-value? me))
(set! value newval)
(set! informant setter)
(for-each-except setter
inform-about-value
constraints))
((not (= value newval))
(error "Contradiction" (list value newval)))
(else 'ignored)))
(define (forget-my-value retractor)
(if (eq? retractor informant)
(begin (set! informant false)
(for-each-except retractor
inform-about-no-value
constraints))
'ignored))
(define (connect new-constraint)
(if (not (memq new-constraint constraints))
(set! constraints
(cons new-constraint constraints)))
(if (has-value? me)
(inform-about-value new-constraint))
'done)
(define (me request)
(cond ((eq? request 'has-value?)
(if informant true false))
((eq? request 'value) value)
((eq? request 'set-value!) set-my-value)
((eq? request 'forget) forget-my-value)
((eq? request 'connect) connect)
(else (error "Unknown operation: CONNECTOR"
request))))
me))当需要设置连接器值时连接器将调用本地程式 set-my-value，如果连接器当前没有数值，则进行赋值操作并记录下请求设置数据的来源。然后连接器将提醒除发起请求的约束之外所有相关的约束当前连接器发生了赋值操作。对约束列表进行通知的具体实现如下。
(define (for-each-except exception procedure list)
(define (loop items)
(cond ((null? items) 'done)
((eq? (car items) exception) (loop (cdr items)))
(else (procedure (car items))
(loop (cdr items)))))
(loop list))如果连接器进行的是抹除数值操作，连接器将执行本地程式 forget-my-value，并首先检查抹除操作的请求来源是否与赋值操作的来源一致。如果来源一致，连接器会将自身数值被抹除的消息传播给其他约束。
本地程式 connect 会将不存在于约束列表的新约束添加到约束列表中，并且如果添加约束时当前连接器已经存在数值则会向新添加的约束发出通知。
连接器程式 me 的工作与 dispatch 类似，下列程式实现了分发的语法接口。
(define (has-value? connector)
(connector 'has-value?))
(define (get-value connector)
(connector 'value))
(define (set-value! connector new-value informant)
((connector 'set-value!) new-value informant))
(define (forget-value! connector retractor)
((connector 'forget) retractor))
(define (connect connector new-constraint)
((connector 'connect) new-constraint))