用变动数据做模拟

  1. 为了模拟那些由具有不断变化的状态组成的系统，我们除了需要做复合数据对象的构 造和成员选择之外，还可能需要修改它们；
  2. 为了模拟具有不断变化的状态的复合对象，我们将设计出与之对应的数据抽象，使其 中不但包含了选择函数和构造函数，还有包含一些称为 改变函数 的操作，这种操 作能够修改有关的数据对象；
  3. 定义了改变函数的数据对象称为 变动数据对象;

变动的表结构

  1. 针对序对的基本改变函数使 set-car! 和 set-cdr!, set-car! 要求两个参 数，其中的第一个参数必须是一个序对， set-car! 修改这个序对，将它的 car 指针替换为指向 set-car! 的第二个参数的指针；
  2. set-cdr! 操作与 set-car! 类似，它们之间的差异就在于这里被取代的是序对 的 cdr 指针，而不是 car 指针；
  3. cons 通过 创建新序对 的方式构造新的表，而 set-car! 和 set-cdr! 则 是修改现存的序对；
  4. 一般而言，用 cons 构造出的表结构总是序对的一个相互链接的结构，其中可能会 有许多独立的序对被一些不同结构所共享；
  5. 如果只要 cons car cdr 对各种表进行操作，其中的共享就 完全不会被察觉, 然而，如果允许改变表结构的话，共享的情况就会显现出来了；
  6. 谓词 (eq? x y) 实际上检查 x 和 y 是否为同一个对象（也就是数，x 和 y 作 为指针是否相等）；
  7. 利用共享结构可以极大地扩展能够用于序对表示地数据结构的范围，另一方面，共 享也可能带来危险，因为对这种结构的修改将会影响那些恰好共享着被修改了的序 对的结构；
  8. 从理论上来说，为了表现变动数据的行为，所需要的全部东西也就是赋值；

练习 3.12-3.20

3.12

1
2
3
4
5
6

;; 画图就省了；
;; 使用 append:
;; (cdr x): (list 'b)

;; 使用 append!:
;; (cdr x): (list 'b 'c 'd)

3.13

1
2
3
4
5
6
7
8
9

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(define z (make-cycle (list 'a 'b 'c 'd)))

;; z: (list 'a 'b 'c 'd 'a 'b 'c 'd ....) deathloop!

;; (last-pair z): deathloop too

3.14

1
2
3
4
5
6

;; 翻转
;; v: (list 'a 'b 'c 'd)

;; 最后打印
;; w: (list 'd 'c 'b 'a)
;; v: (list 'a)

3.15

1

;; 很简单，画图就省了。

3.16

1
2
3
4

;; 利用共享结构可以很容易地构造出复合需求地表结构；

;; 而使过程根本就不返回就是使序对的 car 部分或者 cdr 部分指向序对自己，过程执行
;; 将会进入无限递归，解释器报错 exceeds maximum recursion depth。

3.17

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

;; 使用谓词 eq? 分辨前后遇到的序对是否是同一个序对
;; 过程 memq 主要基于谓词 eq?

(define (count-pairs x)
  (let ((checked '()))
    (define (recursive x)
      (cond ((memq x checked) 0)
	    ((not (pair? x)) 0)
	    (else
	     (begin
	       (set! checked (cons x checked))
	       (+ (recursive (car x))
		  (recursive (cdr x))
		  1)))))
    (recursive x)))

3.18

1
2
3
4
5
6
7
8
9

(define (infinite? l)
  (let ((checked '()))
    (define (recursive x)
      (cond ((null? x) #f)
	    ((memq x checked) #t)
	    (else
	     (begin (set! checked (cons x checked))
		    (recursive (cdr x))))))
    (recursive l)))

3.19

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

;; 不是很明白这个算法的原理
;; 详情请参考 http://en.wikipedia.org/wiki/Cycle_detection

(define (contains-cycle? lst)
  (define (safe-cdr l)
    (if (pair? l)
	(cdr l)
	'()))
  (define (iter a b)
    (cond ((not (pair? a)) #f)
	  ((not (pair? b)) #f)
	  ((eq? a b) #t)
	  ((eq? a (safe-cdr b)) #t)
	  (else (iter (safe-cdr a) (safe-cdr (safe-cdr b))))))
  (iter (safe-cdr lst) (safe-cdr (safe-cdr lst))))

3.20

1

;; 虽然有点复杂，只是繁琐并不难，画图就省了。

队列的表示

  1. 将队列表示为一个序对，car 部分和 cdr 部分分别指向一个常规表中的第一个序对 和最后一个序对，这样的设计使队列操作都只需要 theta(1) 步就能完成；

练习 3.21-3.23

3.21

1
2
3
4
5

;; 因为过程 delete-queue! 只修改一个队列表示的 front-ptr 部分

(define (print-queue q)
  (display
   (front-ptr q)))

3.22

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

(define (make-queue)
  (let ((front-ptr '())
	(rear-ptr '()))
    (define (empty-queue?)
      (null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
	  (error "FRONT called with an empty queue")
	  (car front-ptr)))
    (define (insert-queue! item)
      (let ((new-pair (cons item '())))
	(cond ((empty-queue?)
	       (set! front-ptr new-pair)
	       (set! rear-ptr new-pair)
	       front-ptr)
	      (else
	       (set-cdr! rear-ptr new-pair)
	       (set! rear-ptr new-pair)
	       front-ptr))))
    (define (delete-queue!)
      (cond ((empty-queue?)
	     (error "DELETE! called with an empty queue"))
	    (else
	     (set! front-ptr (cdr front-ptr))
	     front-ptr)))
    (define (dispatch m)
      (cond ((eq? m 'empty-queue?) empty-queue?)
	    ((eq? m 'front-queue) front-queue)
	    ((eq? m 'insert-queue!) insert-queue!)
	    ((eq? m 'delete-queue!) delete-queue!)))
    dispatch))

(define (empty-queue? queue)
  ((queue 'empty-queue?)))

(define (front-queue queue)
  ((queue 'front-queue)))

(define (insert-queue! queue item)
  ((queue 'insert-queue!) item))

(define (delete-queue! queue)
  ((queue 'delete-queue!)))

3.23

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

(define (make-deque)
  (cons '() '()))

(define (front-ptr deque)
  (car deque))

(define (rear-ptr deque)
  (cdr deque))

(define (set-front-ptr! deque item)
  (set-car! deque item))

(define (set-rear-ptr! deque item)
  (set-cdr! deque item))

(define (empty-deque? deque)
  (null? (front-ptr deque)))

(define (front-deque deque)
  (if (empty-deque? deque)
      (error "FRONT called with an empty deque"
	     (display-deque deque))
      (car (front-ptr deque))))

(define (rear-deque deque)
  (if (empty-deque? deque)
      (error "FRONT called with an empty deque"
	     (display-deque deque))
      (car (rear-ptr deque))))

(define (make-pair item front rear)
  (cons item (cons front rear)))

(define (front-rear-pair pair)
  (cdr pair))

(define (set-pair-front pair front)
  (set-car! (front-rear-pair pair) front))

(define (set-pair-rear pair rear)
  (set-cdr! (front-rear-pair pair) rear))

(define (pair-item pair)
  (car pair))

(define (pair-rear pair)
  (cdr (front-rear-pair pair)))

(define (pair-front pair)
  (car (front-rear-pair pair)))

(define (front-insert-deque! deque item) ;insert to the front
  (let ((new-pair (make-pair item '() '())))
    (cond ((empty-deque? deque)
	   (set-front-ptr! deque new-pair)
	   (set-rear-ptr! deque new-pair)
	   (display-deque deque))
	  (else
	   (set-pair-front (front-ptr deque) new-pair)
	   (set-pair-rear new-pair (front-ptr deque))
	   (set-front-ptr! deque new-pair)
	   (display-deque deque)))))

(define (rear-insert-deque! deque item)	;insert to the end
  (let ((new-pair (make-pair item '() '())))
    (cond ((empty-deque?
	    deque)
	   (set-rear-ptr! deque new-pair)
	   (set-front-ptr! deque new-pair)
	   (display-deque deque))
	  (else
	   (set-pair-rear (rear-ptr deque) new-pair)
	   (set-pair-front new-pair (rear-ptr deque))
	   (set-rear-ptr! deque new-pair)
	   (display-deque deque)))))

(define (front-delete-deque! deque)	;delete the front one
  (cond ((empty-deque? deque)
	 (error "DELETE! called with an empty deque"
		(display-deque deque)))
	(else
	 (if (eq? (front-ptr deque) (rear-ptr deque))
	     (begin
	       (set-front-ptr! deque '())
	       (set-rear-ptr! deque '()))
	     (begin
	       (set-front-ptr! deque (pair-rear (front-ptr deque)))
	       (set-pair-front (front-ptr deque) '())))
	 (display-deque deque))))

(define (rear-delete-deque! deque)	;delete the rear one
  (cond ((empty-deque? deque)
	 (error "DELETE! called with an empty deque"
		(display-deque deque)))
	(else
	 (if (eq? (front-ptr deque) (rear-ptr deque))
	     (begin
	       (set-front-ptr! deque '())
	       (set-rear-ptr! deque '()))
	     (begin
	       (set-rear-ptr! deque (pair-front (rear-ptr deque)))
	       (set-pair-rear (rear-ptr deque) '())))
	 (display-deque deque))))

(define (display-deque deque)
  (define (fetch-item ptr)
    (if (null? ptr)
	'()
	(cons (pair-item ptr)
	      (fetch-item (pair-rear ptr)))))
  (if (not (empty-deque? deque))
      (let ((front (front-ptr deque)))
	(fetch-item front))
      '()))

表格的表示

  1. 一维表格，二维表格及使用消息传递风格创建局部表格；

练习 3.24-3.27

3.24

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

(define (make-table same-key?)
  (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)
		  #f))
	    #f)))
    (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 (assoc key records)
      (cond ((null? records) #f)
	    ((same-key? key (caar records)) (car records))
	    (else (assoc key (cdr records)))))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
	    ((eq? m 'insert-proc!) insert!)
	    (else (error "Unknown operation -- TABLE" m))))
    dispatch))

3.25

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup keys)
      (define (recursive keys table)
	(if (null? keys)
	    table
	    (let ((subtable
		   (assoc
		    (car keys)
		    table)))
	      (if subtable
		  (recursive
		   (cdr keys)
		   (cdr subtable))
		  #f))))
      (if (null? keys)
	  (error "Keys should not be null")
	  (recursive keys (cdr local-table))))
    (define (insert! keys value)
      (define (recursive keys table)
	(if (and (not (pair? (cdr table)))
		 (not (null? (cdr table))))
	    (set-cdr! table '()))	;overwrittern the key-value with new table
	(let ((subtable (assoc
			 (car keys)
			 (cdr table)))
	      (left (cdr keys))
	      (first (car keys))
	      (left-tables (cdr table)))
	  (cond ((and subtable (null? left))
		 (set-cdr! subtable value)
		 'ok)
		((and subtable (not (null? left)))
		 (recursive left subtable))
		((and (not subtable) (not (null? left)))
		 (let ((sub (cons first '())))
		   (set-cdr! table (cons sub left-tables))
		   (recursive left sub)))
		((and (not subtable) (null? left))
		 (let ((sub (cons first value)))
		   (set-cdr! table (cons sub left-tables))
		   'ok)))))
      (if (null? keys)
	  (error "Keys should not be null")
	  (recursive keys local-table)))
    (define (assoc key records)
      (cond ((null? records) #f)
	    ((equal? key (caar records)) (car records))
	    (else (assoc key (cdr records)))))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
	    ((eq? m 'insert-proc!) insert!)
	    (else (error "Unknown operation -- TABLE" m))))
    dispatch))

3.26

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

(define (lookup-t given-key set-of-records)
  (cond ((null? set-of-records) #f)
	((= given-key (key (entry set-of-records)))
	 (entry set-of-records))
	((> given-key (key (entry set-of-records)))
	 (lookup-t given-key (right-branch set-of-records)))
	((< given-key (key (entry set-of-records)))
	 (lookup-t given-key (left-branch set-of-records)))))

(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
  (list entry left right))

(define (adjoin-set data set)
  (let ((k (key data))
	(i (item data)))
    (cond ((null? set) (make-tree data '() '()))
	  ((= k (key (entry set)))
	   (begin (set-item! (entry set) i) set))
	  ((< k (key (entry set)))
	   (make-tree (entry set)
		      (adjoin-set data (left-branch set))
		      (right-branch set)))
	  ((> k (key (entry set)))
	   (make-tree (entry set)
		      (left-branch set)
		      (adjoin-set data (right-branch set)))))))

;; table

(define (make-data key item)
  (list key item))

(define (key data)
  (car data))

(define (item data)
  (cadr data))

(define (set-item! data item)
  (set-car! (cdr data) item))

(define (make-table)
  (let ((local-table '()))
    (define (lookup key-1 key-2)	;also applicable to key-list (recursive proc needed)
      (let ((subtable (lookup-t key-1 local-table)))
	(if subtable
	    (let ((record (lookup-t key-2 (item subtable))))
	      (if record
		  (item record)
		  #f))
	    #f)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (lookup-t key-1 local-table)))
	(if subtable
	    (let ((record (lookup-t key-2 (item subtable))))
	      (if record
		  (set-item! record item) ;overwrittern
		  (set-item! subtable
			(adjoin-set
			 (make-data key-2 value)
			 (item subtable)))))
	    (let ((new-subtable
		   (make-data
		    key-1
		    (make-tree
		     (make-data key-2 value)
		     '()
		     '()))))
	      (set! local-table (adjoin-set new-subtable local-table))))
      local-table))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
	    ((eq? m 'insert-proc!) insert!)
	    (else (error "Unknown operation -- TABLE" m))))
    dispatch))

3.27

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12

;; memo-fib 能以正比于 n 的步数计算出第 n 个斐波那契数；

;; 是因为在斐波那契的树形递归过程中，memo-fib 过程将对于更小的 n 计算完成的中间
;; 结果存储在表格中，然后在计算更大的 n 的斐波那契数时就可以直接去表格里去取 n-1
;; 和 n-2 的对应结果，然后相加即完成计算，这样一次计算只需要常量步骤；

;; 所以结论成立。

;; 将 memo-fib 定义为 (memoize fib), 这一模式就不能工作了，只会以原来的 fib 的工
;; 作模式运行，消耗大量时间计算，因为 fib 的过程体中并没有调用 memo-fib 而是 fib
;; 自己，也就是说，(let ((result (f x)))) 这行代码将使用 fib 直接计算出结果而不
;; 会利用表格存储中间结果。

数字电路的模拟器

  1. 事件驱动的模拟程序系统：在这类系统里，一些活动（“事件”）引发另一些在随后 时间发生的事件，它们又会引发随后的事件，并如此继续下去；
  2. 在一个可以将过程当作对象的语言里，在“过程”和“数据”之间并没有本质性的差异， 因此我们可以自由选择自己所需的语法糖衣，以便按自己选定的风格去做程序设计；

练习 3.28-3.32

3.28

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

(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 (logical-and s1 s2)
  (cond ((or (= s1 0) (= s2 0)) 0)
	((and (= s1 1) (= s2 1)) 1)
	(else
	 (error "Invalid signal" s1 s2))))

(define (logical-or s1 s2)
  (cond ((or (= s1 1) (= s2 1)) 1)
	((and (= s1 0) (= s2 0)) 0)
	(else
	 (error "Invalid signal" s1 s2))))

3.29

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

;; (A or B) 等价于 (not ((not A) and (not B)))

(define (or-gate a1 a2 output)
  (let ((invert-1 (make-wire))
	(invert-2 (make-wire))
	(and-invert1-invert2 (make-wire)))
    (inverter a1 invert-1)
    (inverter a2 invert-2)
    (and-gate invert-1 invert-2 and-invert1-invert2)
    (inverter and-invert1-invert2 output))
  'ok)

;; 这样的或门最大延时 (+ (* 3 inverter-delay) and-gate-delay)

3.30

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

(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 a c1)
    (half-adder a s sum c2)
    (or-gate c1 c2 c-out)
    'ok))

(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 (ripple-carry-adder a b s c)
  (let ((c0 (make-wire))
	(c1 (make-wire)))
    (set-signal! c0 0)
    (define (recursive a b c-in sum c-out)
      (if (null? (cdr a))
	  (begin
	    (full-adder (car a) (car b) c-in (car s) c)
	    'ok)
	  (begin (full-adder (car a) (car b) c-in (car s) c-out)
		 (let ((c-in c-out)
		       (c-out (make-wire)))
		   (recursive (cdr a) (cdr b) c-in (cdr s) c-out)))))
    (recursive a b c0 s c1)))

;; 大概统计：
;; let ((half-adder-delay (+ or-gate-delay (* 2 and-gate-delay) inverter-delay)))
;; let ((full-adder-delay (+ (* 2 half-adder-delay) or-gate-delay)))
;; let ((ripple-darry-adder-n-delay (* n full-adder-delay)))

3.31

1
2
3
4
5
6

;; 当一个新的动作过程加入线路时，这一过程应立即运行，这样将会把一项新日程加入日
;; 程表，当调用过程 propagate 时就会按时间顺序调用日程；

;; 如果不这样做的话，以反门为例子，如果不在新的动作加入输入线路时立即执行，那么
;; 日程表里将没有项目，propagate 过程没有任何调用活动立即结束，而反门的输出将保
;; 持默认值不被修改，而这是与反门的逻辑相违背的。

3.32

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

;; 有些时候后续操作将依赖于前面的操作；

;; 与门，输入在一个时间段里从 0 1 变为 1 0；

;; 当 input1 从 0 变为 1 时，input2 仍然是 1；
;; input1 的信号变化将一日程项目加入日程表，而此日程项目的局部状态变量
;; new-value 将是当前两个输入值的逻辑与，即为 1;

;; 依次类推，input2 从 1 变为 0 时，input1 为 1;
;; 则...
;; 新加入的日程项目的局部状态变量将是 0;

;; 按后进先出顺序处理日程项目，所以 input2 相关的项目先调用，input1 的后调用；
;; 此后与门的输出为 1，与与门逻辑不符合。

约束的传播

  1. 描绘一种语言的设计，这种语言将使我们可以基于各种关系进行工作，这一语言里 的基本元素就是 基本约束, 它们描述了在不同量之间的某种特定关系；还提供了 一些方法，使它们可以用于组合各种基本约束，以便去描绘更复杂的关系；
  2. 非定向的计算是基于约束的系统的标志性特征；

练习 3.33-3.37

3.33

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

(define a (make-connector))
(define b (make-connector))
(define c (make-connector))

(define (averager a b c)
  (let ((u (make-connector))
	(v (make-connector)))
    (multiplier u c v)
    (adder a b v)
    (constant 2 u)
    'ok))

3.34

1
2
3
4
5

;; 如果只是设置了 a 的值，b 的值是可以计算出来的；
;; 反之则不然；
;; 因为当我们想计算 b 的平方根时，必须设置 b 的值同时使 a 忘记值；
;; multiplier 过程的内部过程 process-new-value 中的所有 cond 条件全部无法通过；
;; 无法为 a 设置新值。

3.35

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

(define (squarer a b)
  (define (process-new-value)
    (if (has-value? b)
	(if (< (get-value b) 0)
	    (error "square less than 0 -- SQUARER" (get-value b))
	    (set-value! a
			(sqrt (get-value b))
			me))
	(if (has-value? a)
	    (set-value! b
			(square (get-value a))
			me))))
  (define (process-forget-value)
    (forget-value! a me)
    (forget-value! b 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 -- SQUARER" request))))
  (connect a me)
  (connect b me)
  me)

3.36

1
2

;; 这个题目应该还是 ex 3.35 的后续；
;; 没必要画图，耐心一些总能画出来，总体环境结构再复杂也是由简单环境组成的。

3.37

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

;; 暂时忘掉底层抽象，在更高的抽象层次上思考问题。

(define (celsius-fahrenheit-converter x)
  (c+ (c* (c/ (cv 9) (cv 5))
	  x)
      (cv 32)))

(define C (make-connector))
(define F (celsius-fahrenheit-converter C))

(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

(define (cv x)
  (let ((y (make-connector)))
    (constant x y)
    y))

(define (c* x y)
  (let ((z (make-connector)))
    (multiplier x y z)
    z))

(define (c/ x y)
  (let ((z (make-connector)))
    (multiplier y z x)
    z))

(define (c- x y)
  (let ((z (make-connector)))
    (adder y z x)
    z))