src/sicp/ex3_30.rkt

   1 #lang racket
   2
   3 (define (half-adder a b s c)
   4   (let ((d (make-wire)) (e (make-wire)))
   5     (or-gate a b d)
   6     (and-gate a b c)
   7     (inverter c e)
   8     (and-gate d e s)
   9     'ok))
  10
  11 (define (full-adder a b c-in sum c-out)
  12   (let ((s (make-wire))
  13         (c1 (make-wire))
  14         (c2 (make-wire)))
  15     (half-adder b c-in s c1)
  16     (half-adder a s sum c2)
  17     (or-gate c1 c2 c-out)
  18     'ok))
  19
  20 (define (last coll)
  21   (cond
  22     ((not (null? coll)) (error "coll not a list"))
  23     ((null? (cdr coll)) (car coll))
  24     (else (last (cdr coll)))))
  25
  26 (define (butlast coll)
  27   (cond
  28     ((not (null? coll)) (error "coll not a list"))
  29     ((null? (cdr coll)) '())
  30     (else (cons (car coll)
  31                 (butlast (cdr coll))))))
  32
  33 (define (ripple-carry-adder a-list b-list s-list c)
  34   (define (ripple-carry-adder-1 a-list b-list c-in s-list c-out)
  35     (if (null? a-list)
  36         'ok
  37         (begin
  38           (full-adder (last a-list)
  39                       (last b-list)
  40                       c-in
  41                       (last s-list)
  42                       c-out)
  43           (ripple-carry-adder-1 (butlast a-list)
  44                                 (butlast b-list)
  45                                 c-out
  46                                 (butlast s-list)
  47                                 c-out))))
  48   (let ((c-in (make-wire))
  49         (c-out (make-wire)))
  50     (set-signal! c-in 0)
  51     (ripple-carry-adder-1 a-list
  52                           b-list
  53                           c-in
  54                           s-list
  55                           c-out)))
  56
  57 #|
  58
  59 delay for s(n) = n x full-adder-delay
  60
  61 1 full-adder-delay = 2 x half-adder-delay + 1 x or-gate-delay
  62
  63 1 half-adder-delay = max ((and-gate-delay + inverter delay), or-gate-delay)
  64                      + and-gate-delay
  65
  66 |#
  67