;;;SECTION 3.3.4

;; building all logic from transistors:
;;
;; nand | 0 1
;; -----+----
;;    0 | 1 1
;;    1 | 1 0
;;
;; all cost can be derived from the number of nands needed, where
;; cost_nand = 1
;; FUN: make flip-flops, j-k-flip-flops, etc.

;; the basic transistor, execution cost = 1
(define (l-nand a b)
  (if (and (= a 1) (= b 1))
      0
    1))

;; same values on both ports: inversion
(define (l-not a)
  (l-nand a a))

;; invert nand
(define (l-and a b)
  (l-not (l-nand a b)))

;; not(a or b) = (not a) and (not b)
(define (l-or a b)
  (l-not (l-and (l-not a) (l-not b))))

;; a xor b = (a or b) and (not (a and b))
;; a xor b = (a or b) and (a nand b)
;; simplify into nands only
(define (l-xor a b)
  (l-and (l-or a b) (l-nand a b)))

(define (l-test)
  (define (test-one func)
    (let ((t ((0 0) (0 1) (1 0) (1 1))))
      ;; iterate over t for func
      ))
  ;; call test-one for each l-* func
  )

;;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 (l-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)
        (t (error "Invalid signal %s" s))))

;;For Section 3.3.4, used by and-gate
;;Note: logical-and should test for valid signals, as logical-not does
(define (logical-and x y)
  (if (and (= x 1) (= y 1))
      1
    0))

;; hipster
(define (logical-or x y)
  (if (or (= x 1) (= y 1))
      1
    0))

;; *following uses logical-and -- see ch3support.scm

(define (and-gate a1 a2 output)
  (define (and-action-procedure)
    (let ((new-value
           (l-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)

;; hipster
(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((new-value
           (l-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)

(define (make-wire)
  (let ((signal-value 0) (action-procedures '()))
    (define (set-my-signal! new-value)
      (if (not (= signal-value new-value))
          (progn (setq signal-value new-value)
                 (call-each action-procedures))
        'done))
    (define (accept-action-procedure! proc)
      (setq 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!)
            (t (error "Unknown operation -- WIRE: %s" m))))
    dispatch))

(define (call-each procedures)
  (if (null procedures)
      'done
    (progn
     ((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 ()
                 (princ name)
                 (princ " ")
                 (princ (current-time the-agenda))
                 (princ "  New-value = ")
                 (princ (get-signal wire))
                 (princ "\n"))))

;;;SECTION 3.3.2
;; queue, needed by agenda

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (setcar queue item))
(define (set-rear-ptr! queue item) (setcdr queue item))

(define (empty-queue? queue) (null (front-ptr queue)))
(define (make-queue) (cons '() '()))

(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue: %s" queue)
      (car (front-ptr queue))))

(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (t
           (setcdr (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue)))) 

(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue: %s" queue))
        (t
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue))) 

;;;Implementing agenda

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

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

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

(define (segments agenda) (cdr agenda))
(define (set-segments! agenda segments)
  (setcdr 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)
            (setcdr
             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)))))

(define the-agenda (make-agenda))
;;(define inverter-delay 2)
;;(define and-gate-delay 3)
;;(define or-gate-delay 5)
(define inverter-delay 1)               ; 1 nand
(define and-gate-delay 2)               ; 2 nands
(define or-gate-delay 5)                ; 5 nands

(define (sample-simulation)
  (define input-1 (make-wire))
  (define input-2 (make-wire))
  (define sum (make-wire))
  (define carry (make-wire))

  ;;(probe 'input1 input-1)
  ;;(probe 'input2 input-2)
  (probe 'carry carry)
  (probe 'sum sum)

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

  (set-signal! input-2 1)
  (propagate))