SICP/ex-3_28-xx.scm

(load "util.scm")
(load "misc/agenda.scm")
(load "misc/queue.scm")

(display "\nexample - simulator of digital circuits\n")

(define (call-each procedures)
  (if (null? procedures)
      'done
      (begin
        ((car procedures))
        (call-each (cdr procedures)))))

(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 (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 (probe name wire)
  (add-action! wire
               (lambda ()
                 (newline)
                 (display name)
                 (display " ")
                 (display (current-time the-agenda))
                 (display "  New-value = ")
                 (display (get-signal wire)))))

(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 the-agenda (make-agenda))
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)

(define (logical-not s)
  (cond ((= s 0) 1)
        ((= s 1) 0)
        (else (error "NOT - invalid signal" s))))

(define (logical-and s1 s2)
  (cond ((and (= s1 0) (= s2 0)) 0)
        ((and (= s1 0) (= s2 1)) 0)
        ((and (= s1 1) (= s2 0)) 0)
        ((and (= s1 1) (= s2 1)) 1)
        (else (error "AND - invalid signal"))))

(define (logical-or s1 s2)
  (cond ((and (= s1 0) (= s2 0)) 0)
        ((and (= s1 0) (= s2 1)) 1)
        ((and (= s1 1) (= s2 0)) 1)
        ((and (= s1 1) (= s2 1)) 1)
        (else (error "OR - invalid signal"))))

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

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

(assert (logical-and 1 0) 0)
(assert (logical-and 1 1) 1)

(display "\nex-3.28 - or-gate\n")

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

(assert (logical-or 0 1) 1)
(assert (logical-or 1 1) 1)


(display "\nex-3.29 - or-gate via and-gate and inverter\n")

(define (nand-gate a1 a2 output)
  (let ((b (make-wire)))
    (and-gate a1 a2 b)
    (inverter b output)
    'ok))

(define (or-gate-via a1 a2 output)
  (let ((na1 (make-wire)) (na2 (make-wire)))
    (inverter a1 na1)
    (inverter a2 na2)
    (nand-gate na1 na2 output)
    'ok))

; The or-gate has three inverter delays and one and-gate delay. The first two
; inverters can run in parallel so if we implement after-delay correct the
; total delay should only be two inverter delays and one and-gate delay.

(define a (make-wire))
(define b (make-wire))
(define out (make-wire))
;(probe 'out out)

(or-gate-via a b out)

(set-signal! a 1)
(set-signal! b 1)
(propagate)
(assert (get-signal out) 1)

(set-signal! a 0)
(set-signal! b 0)
(propagate)
(assert (get-signal out) 0)

(display "\nex-3.30 - ripple-carry-adder\n")

; Each full-adder has a delay of three or-gates, four and-gates and two
; inverters. Again, some of chips in the half-adder could run in parallel, so
; if after-delay is implemented accordingly the time will be shorter. The delay
; of the ripple-carry-adder is the delay of the full-adder times the number of
; input signals n.

(define (ripple-carry-adder as bs ss c)
  (define c-in (make-wire))
  (define (wire-ripple-carry-adder as bs ss c-in)
    (let ((ak (car as)) (bk (car bs))
          (sk (car ss)) (ck (make-wire)))
      (if (null? (cdr ss))
        (full-adder ak bk c-in sk c)
        (begin
          (full-adder ak bk c-in sk ck)
          (wire-ripple-carry-adder
            (cdr as) (cdr bs) (cdr ss) ck)))))
  (wire-ripple-carry-adder as bs ss c-in))

(let ((a1 (make-wire)) (a2 (make-wire)) (a3 (make-wire))
      (b1 (make-wire)) (b2 (make-wire)) (b3 (make-wire))
      (s1 (make-wire)) (s2 (make-wire)) (s3 (make-wire))
      (co (make-wire)))
  (ripple-carry-adder (list a1 a2 a3) (list b1 b2 b3) (list s1 s2 s3) co)
  (set-signal! a1 1)
  (set-signal! a2 1)
  (set-signal! a3 1)
  (set-signal! b1 1)
  (set-signal! b2 1)
  (set-signal! b3 0)
  (propagate)
  (assert (get-signal s1) 0)
  (assert (get-signal s2) 1)
  (assert (get-signal s3) 0)
  (assert (get-signal co) 1))


(display "\nex-3.31 - accept-action-procedure!\n")

(define input-1 (make-wire))
(define input-2 (make-wire))
(define sum (make-wire))
(define carry (make-wire))
; (probe 'sum sum)
; (probe 'carry carry)

(set-signal! input-1 1)
(set-signal! input-2 1)
(half-adder input-1 input-2 sum carry)
(propagate)

(assert (get-signal sum) 0)
(assert (get-signal carry) 1)

; It is necessary to call the action procedure upon the initialization of the
; gate to make sure that all wires are set to their correct value initially.

; For the example with the half-adder the carry-bit stays at zero because the
; AND-gate is not initialized to the correct value for two 1s as input. To
; avoid the issue we would have to make sure that each signal changes at least
; one.

(display "\nex-3.32\n")