数字电路模拟器
Intro
这是 sicp 第三章的一节 A Simulator for Digital Circuits，目的是设计一个数字模拟器，模拟了与或非门，半加器，全加器，行波进位加法器(ripple-carry adder)。虽然看起来跟程序设计无关，但其中涉及的事件驱动编程范式很值得学习。可以看到，上世纪八十年代，这种编程范式就已经被编入了教材之中。
事件驱动程序设计（英语：Event-driven programming）是一种计算机程序设计模型。这种模型的程序运行流程是由用户的动作（如鼠标的按键，键盘的按键动作）或者是由其他程序的消息来决定的。
示例
这里通过模拟一个半加器的执行来分析程序原理。通过自顶向下分析，看不懂的方法后面会解释，可以先从大体上了解这个系统。
半加器
先定义一个 agenda 和一些基础门的延迟。agenda 后面会说明，可以先简单地看作一种按照时间顺序来处理事件的数据结构。
(define the-agenda (make-agenda))
(define inverter-delay 2) ; 非门延迟
(define and-gate-delay 3) ; 与门延迟
(define or-gate-delay 5) ; 或门延迟
定义一些 wires，wires 会携带数字信号(digital signals)，信号的值就是 0 或 1。
(define input-1 (make-wire))
(define input-2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))
下面定义一个 probe procedure，用来探测 wire 上面信号的值，当 wire 上面信号发生改变时，它会打印出信号的值和其他信息。通过在 wire 上添加一个 action 来实现。
(define (probe name wire)
(add-action!
wire
(lambda ()
(newline)
(display name)
(display " ")
(display (current-time the-agenda))
(display " New-value = ")
(display (get-signal wire)))))
调用 probe 在 sum 和 carry 这两条 wire 上，打印了它们各自的信息，信号值都为 0。
(probe 'sum sum)
sum 0 New-value = 0
(probe 'carry carry)
carry 0 New-value = 0
连接一个半加器
(half-adder input-1 input-2 sum carry)
ok
修改 input-1 上面的信号的值为 1
(set-signal! input-1 1)
done
调用 propagate 来开启事件循环，看到 sum 上面的信号值在 8 个单位时间后变成了 1。
(propagate)
sum 8 New-value = 1
done
再修改 input-2 上面的信号值为 1，carry 上面的信号在 11 个单位时间后变成了 1，sum 上面的信号在 16 个单位时间后变成了 0。
(set-signal! input-2 1)
done
(propagate)
carry 11 New-value = 1
sum 16 New-value = 0
done
分析
先脱离代码，通过半加器的图示来分析它的作用：
-
一个半加器由一个或门，两个与门，一个非门组成
-
接受输入信号 A, B，输出信号 S, C
-
当且仅当 A 或 B 为 1，S 才为 1
-
当 A 和 B 都为 1 时，C 才为 1
input-1 对应与 A， input-2 对应于 B，sum 对应于 S，carry 对应于 C。
所以上面的模拟结果是符合半加器特性的。
程序分析
给出半加器对应的 procedure，来分析一下程序是如何模拟半加器的执行。
(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))
;; logic gate
(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)
(define (or-gate a1 a2 output)
(define (or-action-procedure)
(let ((new-value
(logical-or (get-signal a1)
(get-signal a2))))
(after-delay or-gate-delay
(lambda ()
(set-signal! output new-value)))))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)
(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))))
Wire
procedure 内部会有个变量 signal-value，在被更改且是不同值时，set-my-signal! 会调用内部保存的 action-procedures list 里的所有 procedure。
在调用 accept-action-procedure! 时，会添加 procedure 到 action-procedures list 里，并调用一次该procedure。
(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-procedure! 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))
声明两个 wire，d 和 e。
调用 (or-gate a b d)，对 a 添加一个 action，该 action 的作用是，当 a 或 b 的信号发生变化时，计算逻辑或的值，在一段延迟之后，设置 d 的值。这里也对 b 添加了相同的 action。也就是说只要输入端 a 或 b 信号发生了变化，就计算 a 和 b 的逻辑或值，传送到 d 输出端。
and-gate，inverter 同理。所以，a, b 各自添加了 or-action-procedure，and-action-procedure，c 添加了 invert-input，d 和 e 各自添加了 and-action-procedure。
当 a 或 b 的信号发生改变，通过添加的 or-action-procedure，d 的值也被改变，通过添加的 and-action-procedure，c 的值也发生了改变。c 通过添加的 invert-input 改变了 e。d 或 e 通过添加的 and-action-procedure 改变了 s。
有一点还没讲，那就是 agenda 的概念。因为这些添加的 action，不会马上就被执行。
Agenda
agenda 是由 time-segment 组成的 list。每个 time-segment 是有 time 和 queue 组成的 pair。
agenda 的头节点时 current time，初始值时 0，调用 (first-agenda-item agenda) 后会更新为第一个 agenda item 的 time。
(add-to-agenda! time action agenda) 调用时，会根据 time 从小大到插入 action，如果找到了相同 time 的 segment，就添加到 segement 对应的 queue。如果 time 小于遍历中的一个 segment 的 time，就在这之前新建一个 segment，并插入。如果 time 大于所有的 segment 的 time，就新建一个 segment 到尾端。
前面的逻辑门里的 action procedure，会调用 (after-delay delay action) 来添加 action 到 agenda 中。time 为 agenda current-time 加上指定的 delay 时间。这样，添加到 agenda 的 action 都是按照 time 从小到大排序。
(define (after-delay delay action)
(add-to-agenda!
(+ delay (current-time the-agenda))
action
the-agenda))
这也是为什么通过 add-action! 调用 (accept-action-procedure! proc) 需要执行一遍 (proc)，因为不执行就不会把 action 添加到 agenda 中。对应于习题 3.31。
(define (or-gate a1 a2 output)
(define (or-action-procedure)
(let ((new-value
(logical-or (get-signal a1)
(get-signal a2))))
(after-delay or-gate-delay
(lambda ()
(set-signal! output new-value)))))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)
;; make-wire
(define (accept-action-procedure! proc)
(set! action-procedures
(cons proc action-procedures))
(proc))
agenda 程序
;; agenda operations
(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)))
;; time segment
(define (make-time-segment time queue)
(cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))
添加 action 和指定时间到 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))))
访问 agenda 的第一个 item
(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)))))
移除第一个 agenda item，会先从 queue 里移除 action，如果 queue 为空，移除这个 segment。
(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)))))
事件循环
事件循环就是一段不断调用自己的代码，直到 agenda 为空。如果不为空，取出 agenda 的第一个 item，并执行它，接着再调用自己。目的是按照时间顺序调用完 agenda 里的所有 item。
(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))))
总结
通过上面精巧的例子，可以看出，事件驱动程序设计是非常”响应”的，通过执行一个事件，到触发另一个事件，这些都是自动会发生。而具体编码是通过类似观察者模式，改变一个对象的值，触发一系列 lambda 的调用，这些 lambda 的调用又改变了其包含变量的值，进而又触发了一系列 lambda 的调用。看起来很像我之前分析的 FBLPromise 例子。看起来这也是一种很通用的编程方法。