sicp-ex-3.30

  
 ;; 
 (define (ripple-carry-adder a-list b-list s-list c) 
   (let ((c-list (map (lambda (x) (make-wire)) (cdr a-list))) 
         (c-0 (make-wire))) 
     (map full-adder 
          a-list 
          b-list 
          (append c-list (list c-0)) 
          s-list 
          (cons c c-list)) 
     'ok)) 
  

  
 ;;a 
 (define (ripple-carry-adder Ak Bk Sk C) 
   (define (iter A B S c-in c-out) 
     (if (null? A) 
         S 
         (begin (full-adder (car A) (car B) 
                            c-in (car S) c-out) 
                (iter (cdr A) (cdr B) (cdr S) 
                      (c-out) (make-wire))))) 
   (iter Ak Bk Sk C (make-wire))) 
  

  
  
 ;;a 
 (define (ripple-carry-adder a b s c) 
   (let ((c-in (make-wire))) 
         (if (null? (cdr a)) 
           (set-signal! c-in 0) 
           (ripple-carry-adder (cdr a) (cdr b) (cdr s) c-in)) 
         (full-adder (car a) (car b) c-in (car s) c))) 

  
  
 (define (ripple-carry-adder a b c-in sum) 
     (if (not (null? a)) 
         (let ((carry (make-wire))) 
               (full-adder         (car a) (car b) c-in (car sum) carry) 
               (ripple-carry-adder (cdr a) (cdr b) carry (cdr sum))))) 
  
  
 ;;some convinience methods to test the adder 
 (define (build-wires input-signals) 
         (if (null? input-signals) 
             '() 
             (let ((new-wire (make-wire))) 
                  (set-signal! new-wire (car input-signals)) 
                  (cons new-wire (build-wires (cdr input-signals)))))) 
                 
 (define (get-signals wires) 
       (map (lambda (w) (get-signal w)) wires)) 
  
  
 ;;biggest digit first 
 (define (to-binary number) 
         (if  (< number 2) 
              (list number) 
              (cons (mod number 2) (to-binary (div number 2)) ))) 
  
 ;;simulation 
 (define the-agenda (make-agenda)) 
 (define inverter-delay 1) 
 (define and-gate-delay 1) 
 (define or-gate-delay 1) 
  
 (define a (build-wires '(0 0 1 0 0 0))) ;;4 
 (define b (build-wires '(1 1 0 1 0 0))) ;;11 
 (define s (build-wires '(0 0 0 0 0 0))) 
 (define c-in (make-wire)) 
 (ripple-carry-adder a b c-in s) 
  
 (propagate) 
 (get-signals s) ;;should be 15 

(+ Cn-1-delay
   (* 2 and-gate-delay)
   or-gate-delay
   (max or-gate-delay
        (+ and-gate-delay
           inverter-delay)))

(+ (* 2 n and-gate-delay)
   (* n or-gate-delay)
   (* n (max or-gate-delay
             (+ and-gate-delay
                inverter-delay)))

(+ Cn-1-delay
   (* 2
      and-gate-delay)
   (* 2
      (max or-gate-delay
           (+ and-gate-delay
              inverter-delay))))

(+ (* 2 n and-gate-delay)
   (* (- n 1) or-gate-delay)
   (* (+ n 1) (max or-gate-delay
                   (+ and-gate-delay
                      inverter-delay)))

  
  
 (define (ripple-carry-adder a-list b-list s-list c) 
     (if (null? a-list) 
         (begin (set-signal! c 0) c) 
         (begin 
             (full-adder 
                 (car a-list) 
                 (car b-list) 
                 (ripple-carry-adder 
                     (cdr a-list) 
                     (cdr b-list) 
                     (cdr s-list) 
                     (make-wire)) 
                 (car s-list) 
                 c) 
             c))) 
  
  
 ;; ============================test============================ 
  
 (define (inc init) 
     (lambda (m) 
         (cond ((number? m) 
                 (set! init (+ init m))) 
             ((eq? m 'get) init)))) 
  
 (define counter (inc 0)) 
  
 (define (read-count)     
     (counter 1) 
     (counter 'get)) 
  
 (define (make-wire) 
     (cons'c (read-count))) 
  
 (define set-signal! set-cdr!) 
  
 (define (full-adder a b c-in sum c-out) 
     (newline) 
     (display (list a b c-in sum c-out))) 
  
  
 (load "ripple-carry-adder.scm") 
  
 (ripple-carry-adder 
     (list 1 2 3 4 5 6 7 8) 
     (list 1 2 3 4 5 6 7 8) 
     (list 1 2 3 4 5 6 7 8) 
     (cons 'c 'out)) 
  
  
  
 ; (define t-and and-gate-delay) 
 ; (define t-or or-gate-delay) 
 ; (define t-not inverter-delay) 
  
 ; (define t-ha-s (+ t-and (max t-or (+ t-not t-and)))) 
 ; (define t-ha-s 
     ; (if (>= t-or (+ t-not t-and)) 
         ; (+ t-and t-or) 
         ; (+ (* 2 t-and) t-not))) 
          
 ; (define t-ha-c t-and) 
  
  
 ; (define t-fa-s (+ t-ha-s (max 0 t-ha-s))) 
 ; (define t-fa-s (* 2 t-ha-s)) 
  
 ; (define t-fa-c (+ t-or (max t-ha-c (+ t-ha-c (max 0 t-ha-s))))) 
 ; (define t-fa-c (+ t-or t-ha-c t-ha-s)) 
 ; (define t-fa-c (+ t-or t-and t-ha-s)) 
  
 ; (= (- t-fa-s t-fa-c) (- t-ha-s t-or t-and)) 
 ; (if (>= t-or (+ t-not t-and)) 
     ; (= t-fa-s t-fa-c) 
     ; (>= t-fa-s t-fa-c)) 
 ; (= (max t-fa-s t-fa-c) t-fa-s) 
 ; (define t-fa t-fa-s) 
  
  
 ; (define t-rca-c (+ t-fa-c (max 0 0 t-rca-c1))) 
 ; (define t-rca-c (+ t-fa-c t-rca-c1)) 
 ; (define t-rca-ci (+ t-fa-c t-rca-ci+1)) 
  
 ; (define t-rca-s1 (+ t-fa-s (max 0 0 t-rca-c1))) 
 ; (define t-rca-s1 (+ t-fa-s t-rca-c1)) 
  
 ; (define t-rca (max t-rca-c t-rca-s1 t-rca-s2 ... t-rca-sn)) 
 ; (define t-rca t-rca-s1) 
 ; (define t-rca (+ t-fa-s t-rca-cn (* (- n 1) t-fa-c))) 
  
 ; (define t-rca-cn 0) 
  
 ; (define t-rca 
     ; (+  (* (- n 1) t-or) 
         ; (* (- n 1) t-and) 
         ; (* (+ n 1) t-ha-s))) 
 ; (define t-rca 
     ; (if (>= t-or (+ t-not t-and)) 
         ; (* 2 n (+ t-or t-and)) 
         ; (+ (* (- n 1) t-or) 
            ; (* (+ n 1) t-not) 
            ; (* (+ (* 3 n) 1) t-and))))