;;; This holds generalized data structures
(in-package 'USER)


;------------------------Macros-------------------------



;------------------------Functions----------------------

;;; A list that can be interated through where updates to the list are only noted on the
;;; next iteration.

(defvar *iteration-list* '(dummy))
(defvar *current-place* *iteration-list*)
(defvar *new-nodes* ())
(defvar *last-new-node* ())
(defvar *already-advanced* t)

(defun iter-make-iter-list ()
  (setf *iteration-list* (list 'dummy))
  (setf *new-nodes* ())
  (setf *last-new-node* ())
  (iter-reset-list)
  nil)

(defun iter-next-node ()
  (if *already-advanced*
      (progn
	(setf *already-advanced* nil)
	(second *current-place*))
    (progn
      (pop *current-place*)
      (second *current-place*))))
  
(defun iter-current-node ()
  (second *current-place*))

(defun iter-remove-current ()
  (rplacd *current-place* (nthcdr 2 *current-place*))
  (setf *already-advanced* t)
  nil)

(defun iter-reset-list ()
  (unless (null *new-nodes*)
    (rplacd *last-new-node* (rest *iteration-list*))
    (rplacd *iteration-list* *new-nodes*)
    (setf *new-nodes* ()))
  (setf *current-place* *iteration-list*)
  (setf *already-advanced* t)
  (setf *last-new-node* ())
 nil)

(defun iter-insert-node (node)
  (push node *new-nodes*)
  (when (null (rest *new-nodes*))
    (setf *last-new-node* *new-nodes*))
  nil)

(defun iter-finished ()
  (null (rest *current-place*)))

(defun iter-get-list () (rest *iteration-list*))

;;; Debugging

(defun test-iter-list ()
  (do ((current (progn (iter-reset-list)
			   (iter-next-node))
		    (iter-next-node))
       (count (1- (length *iteration-list*)) (1- count)))
      ((iter-finished) count)
    (iter-remove-current)))

;-------------------------------------------------------------------

(defvar *backup-iteration-list* '(dummy))
(defvar *backup-current-place* *backup-iteration-list*)
(defvar *backup-new-nodes* ())
(defvar *backup-last-new-node* ())
(defvar *backup-already-advanced* t)

(defun backup-iter-make-iter-list ()
  (setf *backup-iteration-list* (list 'dummy))
  (setf *backup-new-nodes* ())
  (setf *backup-last-new-node* ())
  (iter-reset-list)
  nil)

(defun backup-iter-next-node ()
  (if *backup-already-advanced*
      (progn
	(setf *backup-already-advanced* nil)
	(second *backup-current-place*))
    (progn
      (pop *backup-current-place*)
      (second *backup-current-place*))))
  
(defun backup-iter-current-node ()
  (second *backup-current-place*))

(defun backup-iter-remove-current ()
  (rplacd *backup-current-place* (nthcdr 2 *backup-current-place*))
  (setf *backup-already-advanced* t)
  nil)

(defun backup-iter-reset-list ()
  (unless (null *backup-new-nodes*)
    (rplacd *backup-last-new-node* (rest *backup-iteration-list*))
    (rplacd *backup-iteration-list* *backup-new-nodes*)
    (setf *backup-new-nodes* ()))
  (setf *backup-current-place* *backup-iteration-list*)
  (setf *backup-already-advanced* t)
  (setf *backup-last-new-node* ())
 nil)

(defun backup-iter-insert-node (node)
  (push node *backup-new-nodes*)
  (when (null (rest *backup-new-nodes*))
    (setf *backup-last-new-node* *backup-new-nodes*))
  nil)

(defun backup-iter-finished ()
  (null (rest *backup-current-place*)))

(defun backup-iter-get-list () (rest *backup-iteration-list*))

;;; Debugging

(defun backup-test-iter-list ()
  (do ((current (progn (iter-reset-list)
			   (iter-next-node))
		    (iter-next-node))
       (count (1- (length *backup-iteration-list*)) (1- count)))
      ((iter-finished) count)
    (iter-remove-current)))


; ---------------------------FIFO Queue------------------------------

(defstruct queue
  (head ())
  (tail ())
  (length 0))

(defstruct queue-node
  (front ())
  (back ())
  (contents ()))

(defun enqueue (the-queue new-guy)
  (let ((new-node (make-queue-node :contents new-guy)))
    (incf (queue-length the-queue))
    (if (null (queue-tail the-queue))
	(progn
	 (setf (queue-tail the-queue) new-node)
	 (setf (queue-head the-queue) new-node))
      (progn
	(setf (queue-node-back (queue-tail the-queue)) new-node)
	(setf (queue-node-front new-node) (queue-tail the-queue))
	(setf (queue-tail the-queue) new-node)))
    ()))



;;; put a guy back in the front of the queue.
(defun requeue (the-queue new-guy)
  (let ((new-node (make-queue-node :contents new-guy)))
    (incf (queue-length the-queue))
    (if (null (queue-head the-queue))
	(progn
	 (setf (queue-tail the-queue) new-node)
	 (setf (queue-head the-queue) new-node))
      (progn
	(setf (queue-node-front (queue-head the-queue)) new-node)
	(setf (queue-node-back new-node) (queue-head the-queue))
	(setf (queue-head the-queue) new-node)))
    ()))


;;; put a guy back in the front of the queue and then put it in its proper position
;;; using the supplied "predicate" function.
(defun ordered-requeue (the-queue new-guy predicate)
  (requeue the-queue new-guy)
  (shuffle-back the-queue (queue-head the-queue) predicate)
  ())

(defun shuffle-back (the-queue qnode predicate)
  (unless (or (null (queue-node-back qnode))
	      (funcall predicate
		       (queue-node-contents qnode)
		       (queue-node-contents (queue-node-back qnode))))
    (let* ((q-front (queue-node-front qnode))
	   (q-back (queue-node-back qnode))
	   (q-back-back (unless (null q-back) (queue-node-back q-back))))
      (if (null q-front)
	  (setf (queue-head the-queue) q-back)
	(setf (queue-node-back q-front) q-back))
      (if (null q-back-back)
	  (setf (queue-tail the-queue) qnode)
	(setf (queue-node-front q-back-back) qnode))
      (unless (null q-back)
	(setf (queue-node-back q-back) qnode)
	(setf (queue-node-front q-back) q-front))
      (setf (queue-node-back qnode) q-back-back)
      (setf (queue-node-front qnode) q-back)
      (shuffle-back the-queue qnode predicate))))
	   



      

(defun dequeue (the-queue)
  (if (null (queue-head the-queue)) nil
    (let ((front-guy (queue-head the-queue)))
      (decf (queue-length the-queue))
      (if (null (queue-node-back front-guy)) ; last one in queue
	  (progn
	    (setf (queue-head the-queue) nil)
	    (setf (queue-tail the-queue) nil))
	(progn
	  (setf (queue-node-front (queue-node-back front-guy)) nil)
	  (setf (queue-head the-queue) (queue-node-back front-guy))))
      (queue-node-contents front-guy))))

(defun queue-empty? (the-queue) (not (null (queue-head the-queue))))

(defun peek-at-queue (the-queue)
  (if (null (queue-head the-queue)) nil
    (queue-node-contents (queue-head the-queue))))


;debugging

(defun print-queue (the-queue)
  (do ((ptr (queue-head the-queue) (queue-node-back ptr)))
      ((null ptr) (format t "~%"))
    (format t "~a " (queue-node-contents ptr))))