計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)
開発環境
- OS X Mavericks - Apple(OS)
- Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
- Scheme (プログラミング言語)
- Gauche (処理系)
計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の3(標準部品化力、オブジェクトおよび状態)、3.3(可変データでのモデル化)、3.3.4(デジタル回路のシミュレーター)、次第書きの実装、問題 3.32.を解いてみる。
その他参考書籍
- Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
- プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
問題 3.32.
コード(BBEdit, Emacs)
simulator_for_digital_circuits.scm
#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-
(load "./queue.scm")
(define (inverter input output)
(define (inverter-input)
(let ((new-value (logical-not (get-signal input))))
(after-delay inverter-delay
(lambda ()
(set-signal! output new-value)))))
(add-action! input inverter-input)
'ok)
(define (logical-not s)
(cond ((= s 0) 1)
((= s 1) 0)
(else
(error "Invalid signal -- LOGICAL-NOT" s))))
(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)
(cond ((and (= s1 1) (= s2 1)) 1)
((or (= s1 0) (= s2 0)) 0)
(else
(error "Invalid signal -- LOGICAL-AND" s1 s2))))
(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 s1 s2)
(cond ((or (and (= s1 1) (= s2 1))
(and (= s1 1) (= s2 0))
(and (= s1 0) (= s2 1)))
1)
((and (= s1 0) (= s2 0)) 0)
(else
(error "Invalid signal -- LOGICAL-OR" s1 s2))))
(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 (call-each procedures)
(if (null? procedures)
'done
(begin
((car procedures))
(call-each (cdr procedures)))))
(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))
(define (after-delay delay action)
(add-to-agenda! (+ delay (current-time the-agenda))
action
the-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 (probe name wire)
(add-action! wire
(lambda ()
(print name " "
(current-time the-agenda) " "
"New-value = " (get-signal wire)))))
(define (make-time-segment time queue) (cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))
(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)))
(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)
rest))
(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 -- FIRST-AGENDA-ITEM")
(let ((first-seg (first-segment agenda)))
(set-current-time! agenda (segment-time first-seg))
(front-queue (segment-queue first-seg)))))
sample3_32.scm
#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-
(load "./simulator_for_digital_circuits.scm")
(print "queueの場合")
(define the-agenda (make-agenda))
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)
(define a1 (make-wire))
(define a2 (make-wire))
(define output (make-wire))
(and-gate a1 a2 output)
(print "初期値")
(probe 'a1 a1)
(probe 'a2 a2)
(probe 'output output)
(print "入力を0, 1に設定")
(set-signal! a1 0)
(set-signal! a2 1)
(propagate)
(print "入力を1, 0に変更")
(set-signal! a1 1)
(set-signal! a2 0)
(propagate)
(print "通常のリストの場合")
(define (make-time-segment time items) (cons time items))
(define (segment-time s) (car s))
(define (segment-list s) (cdr s))
(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)))
(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)
(make-time-segment time (list action)))
(define (add-to-segments! segments)
(if (= (segment-time (car segments)) time)
(let ((items (segment-list (car segments))))
(set! items (cons action items)))
(let ((rest (cdr segments)))
(if (belongs-before? rest)
(set-cdr!
segments
(cons (make-new-time-segment time action)
rest))
(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 ((items (segment-list (first-segment agenda))))
(set! items (cdr items))
(if (null? items)
(set-segments! agenda (rest-segments agenda)))))
(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))
(car (segment-list first-seg)))))
(define the-agenda (make-agenda))
;; (define inverter-delay 2)
;; (define and-gate-delay 3)
;; (define or-gate-delay 5)
(define a1 (make-wire))
(define a2 (make-wire))
(define output (make-wire))
(and-gate a1 a2 output)
(print "初期値")
(probe 'a1 a1)
(probe 'a2 a2)
(probe 'output output)
(print "入力を0, 1に設定")
(set-signal! a1 0)
(set-signal! a2 1)
(propagate)
(print "入力を1, 0に変更")
(set-signal! a1 1)
(set-signal! a2 0)
(propagate)
入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))
$ ./sample3_32.scm queueの場合 初期値 a1 0 New-value = 0 a2 0 New-value = 0 output 0 New-value = 0 入力を0, 1に設定 a2 0 New-value = 1 入力を1, 0に変更 a1 3 New-value = 1 a2 3 New-value = 0 output 6 New-value = 1 output 6 New-value = 0 通常のリストの場合 初期値 a1 0 New-value = 0 a2 0 New-value = 0 output 0 New-value = 0 入力を0, 1に設定 a2 0 New-value = 1 入力を1, 0に変更 a1 3 New-value = 1 a2 3 New-value = 0 output 6 New-value = 1 $
queueではなく、通常のリストだと、回線outputの信号が正しくないことが分かる。
0 コメント:
コメントを投稿