#lang sicp

(#%require "3_21.rkt")  ;; for queue
(#%require racket/trace)

(define (make-agenda) (list 0))

(define the-agenda (make-agenda))
(define inverter-delay 1)
(define and-gate-delay 10)
(define or-gate-delay 100)


;;;SECTION 3.3.4

;: (define a (make-wire))
;: (define b (make-wire))
;: (define c (make-wire))
;: (define d (make-wire))
;: (define e (make-wire))
;: (define s (make-wire))
;: 
;: (or-gate a b d)
;: (and-gate a b c)
;: (inverter c e)
;: (and-gate d e s)


;;NB. To use half-adder, need or-gate from exercise 3.28
(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 (logical-not s)
  (cond ((= s 0) 1)
        ((= s 1) 0)
        (else (error "Invalid signal" s))))

;; *following uses logical-and -- see ch3support.scm
(define (logical-and x y)
  (cond ((and (= x 1) (= y 1)) 1)
	((or
	  (and (= x 0) (= y 0))
	  (and (= x 0) (= y 1))
	  (and (= x 1) (= y 0)))
	 0)
	(else
         (error "Invalid signal" x y))))

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


(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 (call-each procedures)
  (if (null? procedures)
      'done
      (begin
        ((car procedures))
        (call-each (cdr procedures)))))

(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 (after-delay delay action)
  (add-to-agenda! (+ delay (current-time the-agenda))
                  action
                  the-agenda))

(define (propagate)
  (if (empty-agenda? the-agenda)
      'done
      (let ((first-item (first-agenda-item the-agenda)))
        (first-item)
        (remove-first-agenda-item! the-agenda)
        (propagate))))

(define (probe name wire)
  (add-action! wire
               (lambda ()        
                 (newline)
                 (display name)
                 (display " ")
                 (display (current-time the-agenda))
                 (display "  New-value = ")
                 (display (get-signal wire))
                 (newline))))


;;;Implementing agenda

(define (make-time-segment time queue)
  (cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))

(define (current-time agenda) (car agenda))
(define (set-current-time! agenda time)
  (set-car! agenda time))

(define (segments agenda) (cdr agenda))
(define (set-segments! agenda segments)
  (set-cdr! agenda segments))
(define (first-segment agenda) (car (segments agenda)))
(define (rest-segments agenda) (cdr (segments agenda)))

(define (empty-agenda? agenda)
  (null? (segments agenda)))

(define (add-to-agenda! time action agenda)
  (define (belongs-before? segments)
    (or (null? segments)
        (< time (segment-time (car segments)))))
  (define (make-new-time-segment time action)
    (let ((q (make-queue)))
      (insert-queue! q action)
      (make-time-segment time q)))
  (define (add-to-segments! segments)
    (if (= (segment-time (car segments)) time)
        (insert-queue! (segment-queue (car segments))
                       action)
        (let ((rest (cdr segments)))
          (if (belongs-before? rest)
              (set-cdr!
               segments
               (cons (make-new-time-segment time action)
                     (cdr segments)))
              (add-to-segments! rest)))))
  (let ((segments (segments agenda)))
    (if (belongs-before? segments)
        (set-segments!
         agenda
         (cons (make-new-time-segment time action)
               segments))
        (add-to-segments! segments))))

(define (remove-first-agenda-item! agenda)
  (let ((q (segment-queue (first-segment agenda))))
    (delete-queue! q)
    (if (empty-queue? q)
        (set-segments! agenda (rest-segments agenda)))))

(define (first-agenda-item agenda)
  (if (empty-agenda? agenda)
      (error "Agenda is empty -- FIRST-AGENDA-ITEM")
      (let ((first-seg (first-segment agenda)))
        (set-current-time! agenda (segment-time first-seg))
        (front-queue (segment-queue first-seg)))))

;; 3.28

(define (logical-or x y)
  (cond ((and (= x 0) (= y 0)) 0)
	((or
	  (and (= x 0) (= y 1))
	  (and (= x 1) (= y 0))
          (and (= x 1) (= y 1)))
         1)
	(else
         (error "Invalid signals" x y))))

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

;;; Sample simulation

(#%require (only racket/base module+))

(module+ sample-simulation

  (define input-1 (make-wire))
  (define input-2 (make-wire))
  (define sum (make-wire))
  (define carry (make-wire))
  
  (probe 'sum sum)
  (probe 'carry carry)
  
  (half-adder input-1 input-2 sum carry)
  (set-signal! input-1 1)
  (propagate)
  
  (set-signal! input-2 1)
  (propagate))

(module+ test
  (#%require rackunit)

  (define (or-test or-gate probe? or-min-delay or-max-delay)
    (let ((input-1 (make-wire))
          (input-2 (make-wire))
          (output (make-wire))
          (start-time (current-time the-agenda)))
      (or-gate input-1 input-2 output)
      (if probe?
          (begin
            (probe 'input-1 input-1)
            (probe 'input-2 input-2)
            (probe 'output output)))

      (set-signal! input-1 1)
      (set-signal! input-2 1)
      (propagate)
      (check-equal? (get-signal output) 1)

      (set-signal! input-1 1)
      (set-signal! input-2 0)
      (propagate)
      (check-equal? (get-signal output) 1)
      
      (set-signal! input-1 0)
      (set-signal! input-2 1)
      (propagate)
      (check-equal? (get-signal output) 1)

      (set-signal! input-1 0)
      (set-signal! input-2 0)
      (propagate)
      (check-equal? (get-signal output) 0)

      (let* ((end-time (current-time the-agenda))
             (elapsed-time (- end-time start-time)))
        (check <= elapsed-time (* 4 or-max-delay))
        (check >= elapsed-time (* 4 or-min-delay)))))

  (test-case "Or gate 3.28"
    (or-test or-gate #f or-gate-delay or-gate-delay)))

;; 3.29 Or gate from and gates

;; a or b
;; (not (not (a or b)))
;; (not ((not a) and (not b))) 

;; Delay is 2*inverter-delay + and-gate-delay

(define (or-from-and-gates a b output)
  (let ((c (make-wire))
        (d (make-wire))
        (e (make-wire)))
    (inverter a c)
    (inverter b d)
    (and-gate c d e)
    (inverter e output)
    'ok))

(module+ test
  ;; The final inverter will not be activated if the and gate's output
  ;; doesn't change, so the minimum time is 1 less than the maximum.
  (test-case "Or gate from and gates 3.29"
    (or-test or-from-and-gates #f (+ inverter-delay and-gate-delay)
             (+ (* 2 inverter-delay) and-gate-delay))))
 

;; 3.30 Ripple adder
;;
;; Half-adder delay: max: (+ (max (+ and not) or) and)
;; min (either or or and could not trigger the following component):
;; (min (min or (+ and not and)) (+ or and))  
;; Full-adder delay: 2 * half-adder + or
;; Ripple adder delay: n * full-adder = n * (2 * (max((and + not), or) + and) + or)
(define (ripple-carry-adder a b s c)
  (define (add-full-adder a b s c)
    (if (and (pair? a)
             (pair? b)
             (pair? s))
        (let ((ci (make-wire)))
          (full-adder (car a)
                      (car b)
                      ci
                      (car s)
                      c)
          (add-full-adder (cdr a)
                          (cdr b)
                          (cdr s)
                          ci))))
  (if (= (length a)
         (length b)
         (length s))
      (add-full-adder a b s c)))

(define half-adder-max-delay
  (+ (max (+ and-gate-delay inverter-delay) or-gate-delay)
     and-gate-delay))

(define half-adder-min-delay
  (min (min or-gate-delay
            (+ (* 2 and-gate-delay) inverter-delay))
       (+ or-gate-delay and-gate-delay)))

(define full-adder-max-delay
  (+ (* 2 half-adder-max-delay)
     or-gate-delay))

(define full-adder-min-delay
  (* 2 half-adder-min-delay))

(define (ripple-adder-max-delay n)
  (* n full-adder-max-delay))

;; If the first full adder doesn't change its outputs, none of the
;; rest are activated.
(define ripple-adder-min-delay full-adder-min-delay)

(module+ test

  (define (make-wire-list values)
    (cond ((null? values) '())
          (else
           (let ((w (make-wire)))
             (set-signal! w (car values))
             (cons w (make-wire-list (cdr values)))))))

  (define (make-empty-wire-list length)
    (define (make-zeroes length)
      (if (= length 0)
          '()
          (cons 0 (make-zeroes (- length 1)))))
    (make-wire-list (make-zeroes length)))

  (define (get-wire-signals wire-list)
    (map get-signal wire-list))

  (define (test-ripple-adder a1 a2 sum carry)
    (let ((a (make-wire-list a1))
          (b (make-wire-list a2))
          (s (make-empty-wire-list (length a1)))
          (c (make-wire))
          (before (current-time the-agenda))
          (ripple-adder-time
           (* (length a1)
              (+
               (* 2
                  (+ (max (+ and-gate-delay inverter-delay)
                          or-gate-delay)
                     and-gate-delay))
               or-gate-delay))))
      (ripple-carry-adder a b s c)
      (propagate)
      (check-equal? (get-wire-signals s) sum)
      (check-equal? (get-signal c) carry)
      (let* ((after (current-time the-agenda))
             (elapsed-time (- after before)))
        (check <= elapsed-time (ripple-adder-max-delay (length a1)))
        (check >= elapsed-time ripple-adder-min-delay))))
  
  (test-case "Ripple carry adder 3.30 (15+0)"
    (test-ripple-adder
     '(1 1 1 1)
     '(0 0 0 0)
     '(1 1 1 1)
     0))

  (test-case "Ripple carry adder 3.30 (1+1)"
    (test-ripple-adder
     '(1)
     '(1)
     '(0)
     1))

  (test-case "Ripple carry adder 3.30 (3+1)"
    (test-ripple-adder
     '(1 1)
     '(0 1)
     '(0 0)
     1))

  (test-case "Ripple carry adder 3.30 (15+1)"
    (test-ripple-adder
     '(1 1 1 1)
     '(0 0 0 1)
     '(0 0 0 0)
     1)))    

;; EXERCISE 3.31
;: (define (accept-action-procedure! proc)
;:   (set! action-procedures (cons proc action-procedures)))
;; If the definition above is used, all wires are left at their starting values.
;; In particular, for the half adder, the wire after the inverter remains at
;; 0 despite its input being 0.  As a result, the sum is not set correctly.

;; Exercise 3.32
;; If we use a stack instead of a queue for the agenda segments, then for each segment
;; the tasks will be removed in the reverse order to that which they were added.  In
;; the case of the and gate, the output value is calculated at the time of the signal change
;; (i.e. before the delay) and held in the closure.  While the values of the input signals
;; will be played back in the correct order, the value of the output will be played back
;; in reverse.  If the order of the inputs is: (0,0), (1,0), (1,1), (0,1), then the output
;; will be set to 0 by the last change and then 1 by the penultimate change, which is not
;; the correct answer.