]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex3_30.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / 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