3.3.4数字电路的模拟器（代码加注释）
#lang sicp
#|
假定已经有连线（导线），与，或，非，门这些构造电路的基本元素，借助它们构造半加器和全加器
|#
(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))
(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))
#|
假定拥有一些基本功能块,使用这些基本功能块来构建门电路(不包括运行)
get-signal:返回连线上信号的当前值
set-signal!:修改连线信号上的值
add-action!如果信号值改变,就运行指定的过程
after-delay:在给定的时延后执行指定过程
make-wire:定义一个连线（这个在前面上面一层抽象也使用了）
通过这些基本功能块,可以构建出与，或，非门
构造门的核心思路是：门电路是一个门的功能的过程，被连接到的输入端都要参与这个过程。一旦输入端有变化，就执行这个过程
|#
(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 (logical-or a1 a2);;实现或的核心逻辑
(cond ((and (= a1 0) (= a2 0)) 0)
(else 1)))
(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"))))
(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 (logical-and s1 s2);;实现与的核心逻辑
(if (and (= s1 1) (= s2 1))
1
0))
#|
接下来要实现线路的表示。线路有两个核心作用，一是保存着当前这条连线上的信号值（signal-value），
二是保存了一个表，一旦信号值改变就运行表里的过程序列(action-procedure).这里实际上是把过程传递给了待处理表
线路要支持一些操作：读取信号值，改变信号值，向过程序列里面加入过程
|#
(define (make-wire)
(let ((signal-value 0) (action-procedure '()))
(define (set-my-signal! new-value);;改变信号值
(if (not (= new-value signal-value))
(begin (set! signal-value new-value)
(call-each action-procedure));;依次执行过程序列里的所有过程
'done))
(define (accept-action-procedure! proc);;向过程序列加入过程
(set! action-procedure (cons proc action-procedure))
(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 "unknowm opreation" m))))
dispatch))
(define (call-each procedure);;依次执行过程序列里的所有过程
(if (null? procedure)
'done
(begin
((car procedure));;两重括号，第一重取出过程，第二重执行过程
(call-each (cdr procedure)))))
;;以下几个过程都是语法糖，函数式风格包装
(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))
#|
假定有待处理表agenda，包含的是需要完成的事项
支持以下操作：
make-agenda:返回一个空待处理表
empty-agenda?:判断处理表是否为空
first-agenda-item:返回待处理表的第一个项目
remove-first-agenda-item!:删除第一个项目
current-time：返回当前时间
通过上述功能块after-delay和Propate.
|#
(define (after-delay delay action);;在给定的时延后执行指定过程
(add-to-agenda! (+ delay (current-time the-agenda))
action
the-agenda))
(define (proprate);;顺序执行表中的每一个过程
(if (empty-agenda? the-agenda)
'done
(let ((first-item (first-agenda-item the-agenda)))
(first-item)
(remove-first-agenda-item! the-agenda)
(proprate))))
#|
待处理表的具体实现
待处理表示一个(时间-队列）对偶，时间是指当前时间，队列称为为一级队列
待处理表第二个元素——队列中的每个元素都是一个时间和队列。这里队列中的每个元素都是过程。
表示在特定时候要执行的过程。这里队列称为二级队列
|#
(define (make-time-segment time queue);;待处理表第二个元素的每个元素（《时间，过程序列》）的实现
(cons time queue))
(define (segment-time s);;选出时间
(car s))
(define (segment-queue s);;选出过程序列
(cdr s));;;这里一开始写成cadr了，绷，debug一晚上，属于是糖完了
;;set-car!和set-cdr!是系统自带的，自己写的用不了
(define (make-agenda);;待处理表的实现。返回空表，当前时间为0
(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")
(let ((first-seg (first-segment agenda)))
(set-current-time! agenda (segment-time first-seg))
(front-queue (segment-queue first-seg)))))
(define (probe name wire);;放置一个监视器，打印名字，当前时间和线路上的值
(add-action! wire
(lambda ()
(newline)
(display name)
(display " ")
(display (current-time the-agenda))
(display " new-value = ")
(display (get-signal wire)))))
#|
显然,上述实现需要用得到数据结构--队列。以下是队列的实现与其支持的操作(先进先出)
这里队列结构较为特殊,队列表示为一对指针,car是头指针,cdr是尾指针
|#
(define (make-queue);;创建一个空表
(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 (front-queue queue);;取出队列的第一个元素
(if (empty-queue? queue)
(error "front with the empty queue" queue)
(car (front-ptr queue))))
(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 with the empty queue" queue))
(else
(set-front-ptr! queue (cdr (front-ptr queue)))
queue)))
;;test
(define the-agenda (make-agenda))
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)
(define input1 (make-wire))
(define input2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))
(probe 'sum sum)
(probe 'carry carry)
(half-adder input1 input2 sum carry)
(set-signal! input1 1)
(proprate)
(set-signal! input2 1)
(proprate)
实际上，线路上保存的过程不是实现门电路功能的过程。在把包装好的过程加入线路时，这个过程会先执行一次（但这个过程不执行信号的判断与修改），作用是把实际过程加入待处理表。然后在待处理表用proprate驱动完成整个时间的模拟
3.3.4数字电路的模拟器（代码加注释）
https://zzhygs.cn/index.php/archives/42/