]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/circuit-simulation.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / circuit-simulation.rkt
1 #lang racket
2
3 (define (inverter input output)
4   (define (invert-input)
5     (let ((new-value (logical-not (get-signal input))))
6       (after-delay inverter-delay
7                    (lambda ()
8                      (set-signal! output new-value)))))
9   
10   (add-action! input invert-input)
11   'ok)
12
13 (define (logical-not input)
14   (cond ((= input 0) 1)
15         ((= input 1) 0)
16         (else (error "LOGICAL-NOT: invalid input value" input))))
17
18 (define (and-gate a1 a2 output)
19   (define (and-action-procedure)
20     (let ((new-value (logical-and (get-signal a1)
21                                   (get-signal a2))))
22       (after-delay and-gate-delay
23                    (lambda ()
24                      (set-signal! output new-value)))))
25   
26   (add-action! a1 and-action-procedure)
27   (add-action! a2 and-action-procedure)
28   'ok)
29
30 ;; wires
31 (define (make-wire)
32   (let ((signal-value 0)
33         (action-procedures '()))
34     (define (set-my-signal! new-value)
35       (if (not (= signal-value new-value))
36           (begin
37             (set! signal-value new-value)
38             (call-each action-procedures))
39           'done))
40     (define (accept-action-procedure! proc)
41       (set! action-procedures (cons proc action-procedures))
42       (proc))
43     (define (dispatch m)
44       (cond ((eq? m 'set-signal!) set-my-signal!)
45             ((eq? m 'get-signal)  signal-value)
46             ((eq? m 'add-action!) accept-action-procedure!)
47             (else (error "Unknown operation -- wire" m))))
48     dispatch))
49
50 (define (call-each procedures)
51   (if (null? procedures)
52       'done
53       (begin
54         ((car procedures))
55         (call-each (cdr procedures)))))
56
57 (define (get-signal wire)
58   (wire 'get-signal))
59
60 (define (set-signal! wire value)
61   ((wire 'set-signal!) value))
62
63 (define (add-action! wire proc)
64   ((wire 'add-action!) proc))
65