ほぼ一ヶ月 SICP 放置してたんですけど，ディジタル回路シミュレーション，ほとんど写経という体たらくですがとりあえず動いた．
抽象化して，データ構造をブラックボックス化させた話をするのは理解させるという目的の上ではいいんだろうなと思うのですが，ブラックボックスの中身が後段にならないと出てこないので，そのあたりでむーーーーとかなってました．問題を解こうにも，動かせないのでテストができない*1 *2．
結局問題を解くのを後回しにして，テキストを先読みし，理解に努めてみた．
詰まっていた点
全体としての動き
結局のところ，時間順に並んだイベントキューを用意して，順に実行させるという一般的なイベントドリブンシミュレーションぽい．
なんで wire，しかも入力側の wire に add-action! しているのか
入力側の wire は，その入力信号の変化を捉えることができる．
一方，論理ゲートは信号が変化してから出力を変える必要がある．
結果として入力側の wire に，入力信号が変わったときに実行されるフックを用意してその中に action を定義しておき，入力信号が変わった段階で出力を変化させるイベントを発生させるのが一番シンプル
;;; ;;; queue ;;; (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)))) (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))) ;;; ;;; wire ;;; (define (make-wire) (let ((signal-value 0) (action-procedures '())) ; シグナルの値が変わっていれば，各 action procedure を実行する (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) ; 実行される procedure に加える (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 (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (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: すべきことのスケジュールを含んだデータ構造 ;;; (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))) ; time segment がない場合，agenda は空 (define (empty-agenda? agenda) (null? (segments agenda))) ; 新しいアクションを the-agenda に加える (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) ; agenda 中のスケジュールを順に実行 (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 (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 が empty なら time segment を構築し，それを agenda に install する． ; そうでないなら各セグメントの時間を走査し，自分が割り当てた時間をみつけると ; そのキューに action を加える．もし一致するのがないなら，適切な位置に time segment ; を install する． (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 (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))))) ;;; ;;; time-segment ;;; (define (make-time-segment time queue) (cons time queue)) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) ;;; ;;; logical circuit (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 (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 (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)))) (define (logical-and a b) (cond ((and (= a 1) (= b 1)) 1) ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) (else (error "Invalid signal" s)))) (define (logical-or a b) (cond ((and (= a 1) (= b 1)) 1) ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 1) ((and (= a 1) (= b 0)) 1) (else (error "Invalid signal" s)))) (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 (probe name wire) (add-action! wire (lambda () (newline) (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire))))) ;;; ;;; simulation ;;; (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) (probe 'carry carry) (half-adder input-1 input-2 sum carry) (set-signal! input-1 1) (propagate)
