SICP 読書ノート#32 - 3.3.4 ディジタル回路のシミュレータ (pp.160-168)

「§3.3.4 ディジタル回路のシミュレータ」から。

全体のソースコードはGitHubに置いています。

https://github.com/uents/sicp/blob/master/ch3/ch3.3.4.scm

回路の実装

論理回路の実装

テキストのこの章のコードを写経しないとシミュレーションを走らせることができないので、先に全て写経してしまう。

まずは入出力を反転させるinverterから。

after-delayは、手続きを指定した時間分だけ遅延させて実行させる
set-signal!は、回線の信号を新しい値に変更する
acc-action!は、回線の信号が値を変えた時、手続きを実行させる

よってinputの信号が変わるとinvert-inputが実行され、*interter-delay*時間後にoutputへ新しい値が設定される。

(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)
  (if (= s 0)
       1
       0))

同様に論理積関数であるand-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 (logical-and x y)
  (if (and (= x 1) (= y 1))
      1
      0))

さらに論理和関数であるor-gateがあるとしてそれらを回線でつなぐことで、半加算器、全加算器も実装できる。

(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))

回線の実装

論理回路が実装できたので、次に回路同士をつなぐ回線（wire）を実装する。

回線は次のインターフェースを持つ。

手続き	機能
get-signal	回線の信号の現在値を返す
set-signal!	回線の信号を新しい値に変更する
add-action!	回線の信号の値が変更された時に、指定した手続きを実行する

これら特性をもつ回線のコンストラクタとインターフェース手続きは以下のように実装される。

(define (make-wire)
  (let ((signal-value 0)
        (action-procedures '()))
    (define (call-each procedures)
      (if (null? procedures)
          'done
          (begin ((car procedures))
                 (call-each (cdr 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))

(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))

シミュレーションの実装

回路を構成するモジュールは出揃ったので、次はシミュレーションを実行していく。

まずは前述の手続きを遅延時間後に実行させるafter-delay。*the-agenda* というアジェンダ（次第書き）に手続きを追加する。

(define (after-delay delay action)
  (add-to-agenda! (+ delay (current-time *the-agenda*))
                  action
                  *the-agenda*))

手続きpropagateはアジェンダに登録されている手続きを全て実行させる。remove-first-agenda-item!という手続きを呼ぶことから、１度実行した手続きはアジェンダから削除されることがわかる。

(define (propagate)
  (if (empty-agenda? *the-agenda*)
      'done
      (begin ((first-agenda-item *the-agenda*))
             (remove-first-agenda-item! *the-agenda*)
             (propagate))))

手続きprobeは回線の値の変更時に現在値をプリントさせる。回線の状態のモニタリングで使える。

(define (probe name wire)
  (add-action! wire
               (lambda ()
                 (display name)
                 (display " ")
                 (display (current-time *the-agenda*))
                 (display " New-value = ")
                 (display (get-signal wire))
                 (newline))))

アジェンダの実装

アジェンダのコンストラクタ

最後にスケジューラに相当するアジェンダを実装する。現在時間current-timeと、time-segmentと呼ばれる時間とその時間に到達した際に実行する手続きリストの対から構成される。

まずはagendaを実装。

(define (make-agenda) (cons 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))

次にtime-segmentを実装。手続きリストはキューで実現する。

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

アジェンダの操作手続き

アジェンダが空かどうかチェックするempty-agenda?。

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

アジェンダに手続きを追加するadd-to-agenda。

(define (add-to-agenda! time action agenda)
  ; segmentsの終端かtimeの直前にsegmentがあればtrueを返す
  (define (belongs-before? segs)
;  (display (format "belongs-before? ~a ~%" segs))
    (or (null? segs)
        (< time (segment-time (car segs)))))
  ; segmentを作成
  (define (make-new-time-segment)
;  (display (format "make-new-time-segments! ~%"))
    (let ((q (make-queue)))
      (insert-queue! q action)
      (make-time-segment time q)))
  ; segmentを追加
  (define (add-to-segments! segs)
;  (display (format "add-to-segments! ~a ~%" segs))
    (if (= time (segment-time (car segs)))
        (insert-queue! (segment-queue (car segs))
                       action)
        (if (belongs-before? (cdr segs))
            (set-cdr! segs (cons (make-new-time-segment)
                                 (cdr segs)))
            (add-to-segments! (cdr segs)))))

  (let ((segs (segments agenda)))
    (if (belongs-before? segs)
        (set-cdr! agenda (cons (make-new-time-segment)
                               segs))
        (add-to-segments! segs))))

アジェンダの現在時間を先頭セグメントの時間に更新し、先頭セグメントのキューに登録されている手続きを返すfirst-agenda-item。

(define (first-agenda-item agenda)
  (if (empty-agenda? agenda)
      (error "Agenda is empty -- FIRST-AGENDA-ITEM")
      (let ((seg (car (segments agenda))))
        (set-current-time! agenda (segment-time seg))
        (front-queue (segment-queue seg)))))

アジェンダの先頭セグメントのキューの手続きを削除し、キューが空であればセグメント自体もアジェンダから取り除くremove-first-agenda-item! 。

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

キューの実装

§3.3.2 で実装したキューをそのまま持ってくればよい。

シミュレーションの設定

論理回路の遅延時間を設定する。

(define *inverter-delay* 2)
(define *and-gate-delay* 3)
(define *or-gate-delay* 5)

アジェンダを作成する。

(define *the-agenda* (make-agenda))

ここまできてようやく回路シミュレーションを走らせることができる。長かった。。

練習問題

問題 3.28

論理和関数であるor-gateを実装する。

(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 x y)
  (if (or (= x 1) (= y 1))
      1
      0))

テスト。どちらか一方の入力を1とすれば*or-gate-delay*時間後に出力も1となっている。

racket@> (define in-1 (make-wire))
(define in-2 (make-wire))
(define out (make-wire))

racket@> (probe 'in-1 in-1)
(probe 'in-2 in-2)
(probe 'out out)
in-1 0 New-value = 0
in-2 0 New-value = 0
out 0 New-value = 0

racket@> (or-gate in-1 in-2 out)
'ok

racket@> (set-signal! in-1 1)
'done
racket@> (propagate)
in-1 0 New-value = 1
out 5 New-value = 1
'done

racket@> (set-signal! in-1 0)
'done
racket@> (propagate)
in-1 5 New-value = 0
out 10 New-value = 0
'done

racket@> (set-signal! in-2 1)
'done
racket@> (propagate)
in-2 10 New-value = 1
out 15 New-value = 1
'done

racket@> (set-signal! in-2 0)
'done
racket@> (propagate)
in-2 15 New-value = 0
out 20 New-value = 0
'done

問題 3.29

orをnotとandで実装する。論理演算の法則があったと思うけど、思い出せず。。。論理回路を適当にこねくり回したらできた。

(define (or-gate-ex a b output)
  (let ((c (make-wire))
        (d (make-wire))
        (e (make-wire)))
    (inverter a c)
    (inverter b d)
    (and-gate c d e)
    (inverter e output)
    'ok))

テストの様子は問題3.28と同じなので省略。入出力の遅延は2 * inverter-delay + and-gate-delayとなる。

全加算器のテスト

問題3.28でor-gateが実装できたので、全加算器をテストしてみる。

まずは回路を作成。

racket@> (define a (make-wire))
'ok
racket@> (define b (make-wire))
'ok
racket@> (define c-in (make-wire))
'ok
racket@> (define sum (make-wire))
'ok
racket@> (define c-out (make-wire))
'ok

racket@> (probe 'a a)
a 0 New-value = 0
racket@> (probe 'b b)
b 0 New-value = 0
racket@> (probe 'c-in c-in)
c-in 0 New-value = 0
racket@> (probe 'sum sum)
sum 0 New-value = 0
racket@> (probe 'c-out c-out)
c-out 0 New-value = 0

racket@> (full-adder a b c-in sum c-out)
'ok

値を変更させてテスト。sumに入力の和がc-outに桁上げの値が代入される。

racket@> (set-signal! a 1)
a 0 New-value = 1
'done
racket@> (propagate)
sum 8 New-value = 1
'done

racket@> (set-signal! b 1)
b 8 New-value = 1
'done
racket@> (propagate)
c-out 24 New-value = 1
sum 24 New-value = 0
'done

racket@> (set-signal! c-in 1)
c-in 24 New-value = 1
'done
racket@> (propagate)
sum 40 New-value = 1
'done

問題 3.30

図3.27の通り全加算器を繰り返し構成して繰り上がり伝播加算器を実装する。

(define (ripple-carry-adder a-list b-list sum-list c-out)
  (define (iter a-list b-list sum-list c-in)
    (if (not (null? a-list))
        (let ((a-k (car a-list))
              (b-k (car b-list))
              (sum-k (car sum-list))
              (c-out (make-wire)))
          (full-adder a-k b-k c-in sum-k c-out)
          (iter (cdr a-list) (cdr b-list) (cdr sum-list) c-out))
        'ok))
  (iter a-list b-list sum-list c-out))

繰り上がり伝播加算器と入出力回線を接線する。

racket@> (define a1 (make-wire))
(define a2 (make-wire))
(define a3 (make-wire))
(define a4 (make-wire))
(define b1 (make-wire))
(define b2 (make-wire))
(define b3 (make-wire))
(define b4 (make-wire))
(define s1 (make-wire))
(define s2 (make-wire))
(define s3 (make-wire))
(define s4 (make-wire))
(define a (list a1 a2 a3 a4))
(define b (list b1 b2 b3 b4))
(define s (list s1 s2 s3 s4))
(define c (make-wire))

racket@> (probe 's1 s1)
(probe 's2 s2)
(probe 's3 s3)
(probe 's4 s4)
(probe 'c c)
s1 0 New-value = 0
s2 0 New-value = 0
s3 0 New-value = 0
s4 0 New-value = 0
c 0 New-value = 0

racket@> (ripple-carry-adder a b s c)
'ok

回線の値を変更してテスト。正しく桁上がりしていることがわかる。

racket@> (set-signal! a1 1)
'done
racket@> (propagate)
s1 8 New-value = 1
'done
racket@> (set-signal! b1 1)
'done
racket@> (propagate)
s1 24 New-value = 0
s2 40 New-value = 1
'done
racket@> (set-signal! a2 1)
'done
racket@> (propagate)
s2 48 New-value = 0
s3 64 New-value = 1
'done

問題 3.31

回線を作成するmake-wireの内部手続きaccept-action-procedure!で、新しいアクション手続きが追加された際に即座にそれを走らせる理由を述べよ。

回答

論理回路 inverter、and-gate、or-gateはいずれもadd-action!に渡す手続きは内部でafter-delayを実行する。このafter-delayは内部でadd-to-agenda!を実行して、アジェンダにアクション手続きを登録する。

そこでadd-action!の実体であるaccept-action-procedure!において、追加されたアクション手続きを即座に走らせることで、アジェンダにアクション手続きが登録されるため、それらが必要となる。

仮にaccept-action-procedure!で追加されたアクション手続きを即座に走らせないようにすると、アジェンダに手続きが追加されないためpropagateを実行しても何も起きない。

2016/08/15 追記

sicp-zemi.hatenablog.jp

にて、「accept-action-procedure!でアジェンダに手続きが追加されない」という理解は間違いじゃないか？という指摘を受けて、動作を見直してみた。(ちなみに「アジェンダが空」なんて言ったつもりはないんだけど…）

例として、指摘元にならいテキストの図3.25の半加算器を実装して動作させる。

racket@ch3.3.4.scm> (define in-1 (make-wire))
(define in-2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))

racket@ch3.3.4.scm> (probe 'sum sum)
sum 0 New-value = 0
racket@ch3.3.4.scm> (probe 'carry carry)
carry 0 New-value = 0

racket@ch3.3.4.scm> (half-adder in-1 in-2 sum carry)
'ok
racket@ch3.3.4.scm> (set-signal! in-1 0)
'done
racket@ch3.3.4.scm> (set-signal! in-2 1)
'done
racket@ch3.3.4.scm> (propagate)
sum 8 New-value = 1
'done

次に、accept-action-procedure!で(proc)を行わない形にで動作させてみる。

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

racket@> (define in-1 (make-wire))
(define in-2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))

racket@> (probe 'sum sum)
racket@> (probe 'carry carry)

racket@> (half-adder in-1 in-2 sum carry)
'ok
racket@> (set-signal! in-1 0)
'done
racket@> (set-signal! in-2 1)
'done
racket@> (propagate)
'done

racket@> (get-signal sum)
0
racket@> (get-signal carry)
0

sumやcarryのprobeで初期値が出力されないのは、 probeでの出力手続きがaccept-action-procedure!の変更で呼ばれなくなったため、まあその通り。

では、(set-sitnal! in-2 1)でsumへ出力が伝播しなかった理由だが、これは(half-adder in-1 in-2 sum carry)で入出力を結線する際の(and-gate d e s)において、add-action!に渡す手続きand-action-procedureが実行されないため、このand-gateの出力sが変わることができずこのようなことになる。

つまり、