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