;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;******************************************************************************
;;;;FILE:               pjb-queue.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             emacs
;;;;USER-INTERFACE:     emacs
;;;;DESCRIPTION
;;;;
;;;;    This module exports a queue type. This is a structure optimized for
;;;;    FIFO operations, keeping a pointer to the head and the tail of a list.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;;    2001-11-12 <PJB> Creation.
;;;;    2001-12-31 <PJB> Added pjb-queue-requeue.
;;;;                     Corrected the return value of some methods.
;;;;BUGS
;;;;LEGAL
;;;;    LGPL
;;;;
;;;;    Copyright Pascal J. Bourguignon 1990 - 2011
;;;;
;;;;    This library is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU Lesser General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    This library is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;;    Lesser General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Lesser General Public
;;;;    License along with this library; if not, write to the Free Software
;;;;    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
;;;;
;;;;******************************************************************************
(provide 'pjb-queue)
(require 'pjb-utilities)  ;; import commented-out


(defun pjb-queue-new ()
  "DO:      Creates a new pjb-queue.
POST:    (and (pjb-queue-p (pjb-queue-new))
              (= 0 (pjb-queue-length queue)))
RETURN:  The new queue.
NOTE:    The structure of a pjb-queue is as follow:

            +------+------+
queue ----> | head | tail |
            +------+------+
               |      |
               V      |
       'pjb-queue  +--+
                   |
                   V
            +------+------+
            | head | tail |--------------------------+
            +------+------+                          |
               |                                     |
               V                                     V
        +------+------+    +------+------+    +------+------+
        | elem | next |--->| elem | next |--->| elem | next |--->nil
        +------+------+    +------+------+    +------+------+
           |                  |                  |
           V                  V                  V
        +------+           +------+           +------+
        | elem |           | elem |           | elem |
        +------+           +------+           +------+
"
  (cons 'pjb-queue (cons nil nil))
  );;pjb-queue-new


(defun pjb-queue-p (queue)
  "RETURN:  Whether queue is a queue.
DO:      Checks that head points to a list whose last element is tail"
  (and
   (consp queue)
   (eq 'pjb-queue (car queue))
   (let ( (head (cadr queue))
          (tail (cddr queue)) )
     (and
      (listp head)
      (listp tail)
      (or (and (null head)             (null tail))
          (and (not (null (cdr head))) (null (cdr tail)))
          (let ( (current head) )
            (if (eq current tail)
                t ;; only one element
              (while (and (not (or (eq current head) (eq current tail))))
                (setq current (cdr current)))
              (eq current tail)))))))
  );;pjb-queue-p


(defun pjb-queue-length (queue)
  "PRE:     (pjb-queue-p queue)
RETURN:  The number of elements in the queue."
  (if (not (eq 'pjb-queue (car queue))) (error "Parameter must be a queue."))
  (length (cadr queue))
  );;pjb-queue-length


(defun pjb-queue-first-element (queue)
  "PRE:     (pjb-queue-p queue)
RETURN:  The first element of the queue."
  (if (not (eq 'pjb-queue (car queue))) (error "Parameter must be a queue."))
  (caar (cdr queue))
  );;pjb-queue-first-element


(defun pjb-queue-last-element (queue)
  "PRE:     (pjb-queue-p queue)
RETURN:  The last element of the queue."
  (if (not (eq 'pjb-queue (car queue))) (error "Parameter must be a queue."))
  (cadr (cdr queue))
  );;pjb-queue-last-element


(defun pjb-queue-enqueue  (queue element)
  "PRE:     (pjb-queue-p queue)
            l=(pjb-queue-length queue)
POST:    (eq (pjb-queue-last-element queue) element),
         (pjb-queue-p queue),
         l+1=(pjb-queue-length queue)
RETURN:  queue"
  (if (not (eq 'pjb-queue (car queue))) (error "Parameter must be a queue."))
  (let ( (q (cdr queue)) )
    ;; (car q) = head      (cdr q) = tail
    (if (car q)
        (progn
          ;; There's already an element, just add to the tail.
          (setcdr (cdr q) (cons element nil))
          (setcdr q       (cddr q)) )
      ;; The queue is empty, let's set the head.
      (setcar q (cons element nil))
      (setcdr q (car q)))
    );;let
  queue
  );;pjb-queue-enqueue


(defun pjb-queue-dequeue (queue)
  "PRE:     (pjb-queue-p queue)
            l=(pjb-queue-length queue)
            f=(pjb-queue-first-element queue)
POST:    l>0 ==> l-1=(pjb-queue-length queue)
         l=0 ==> 0=(pjb-queue-length queue)
RETURN:  f"
  (let* ( (result   (pjb-queue-first-element queue))
          (q        (cdr queue))
          (second   (cdar q)) )
    (if second
        ;; remains at least one element.
        (setcar q second)
      ;; removing the last element, now queue is empty.
      (setcar q nil)
      (setcdr q nil))
    result
    );;let
  );;pjb-queue-dequeue


(defun pjb-queue-requeue (queue element)
  "DO:      Insert the element at the beginning of the queue.
PRE:     (pjb-queue-p queue)
         l=(pjb-queue-length queue)
POST:    (eq (pjb-queue-first-element queue) element)
         (pjb-queue-p queue),
         l+1=(pjb-queue-length queue)
RETURN:  queue"
  (if (not (eq 'pjb-queue (car queue))) (error "Parameter must be a queue."))
  (let ( (q (cdr queue)) )
    (if (car q)
        ;; There's already an element, just insert before the head.
        (setcar q (cons element (car q)))
      ;; queue is empty, let's set the head.
      (setcar q (cons element nil))
      (setcdr q (car q)))
    );;let
  queue
  );;pjb-queue-requeue;


(defun pjb-queue-test ()
  "DO:     Test the queue data type. Insert test log at the point."
  (let (q
        (check (lambda (q)
                 (insert
                  (if (not (pjb-queue-p q))
                      (format "   NOT A QUEUE !\n%S\n" q)
                    (concat
                     (format "   Length=%2d\n" (pjb-queue-length q))
                     (if (< 0 (pjb-queue-length q))
                         (format "      Head=%S\n      Tail=%S\n"
                                 (pjb-queue-first-element q)
                                 (pjb-queue-last-element q))
                       "")
                     (format "   Queue=%S\n" q)
                     )))) )
        )

    (insert  "Creating a queue\n")
    (setq q (pjb-queue-new))
    (funcall check  q)

    (insert  "Dequeuing empty queue\n")
    (insert (format "%S\n" (pjb-queue-dequeue q)))
    (funcall check  q)

    (insert  "Enqueuing...\n")
    (pjb-queue-enqueue q '(first))
    (funcall check  q)

    (insert  "Enqueuing...\n")
    (pjb-queue-enqueue q '(second))
    (funcall check  q)

    (insert  "Enqueuing...\n")
    (pjb-queue-enqueue q '(third))
    (funcall check  q)

    (insert  "Enqueuing...\n")
    (pjb-queue-enqueue q '(fourth))
    (funcall check  q)

    (insert  "Requeuing...\n")
    (pjb-queue-requeue q '(zeroeth))
    (funcall check  q)

    (while (< 0 (pjb-queue-length q))
      (insert  "Dequeuing queue\n")
      (insert (format "%S\n" (pjb-queue-dequeue q)))
      (funcall check  q)
      )

    (insert  "Requeuing empty queue...\n")
    (pjb-queue-requeue q '(first))
    (funcall check  q)

    (insert  "Requeuing...\n")
    (pjb-queue-requeue q '(second))
    (funcall check  q)

    (insert  "Enqueuing...\n")
    (pjb-queue-enqueue q '(last))
    (funcall check  q)

    (while (< 0 (pjb-queue-length q))
      (insert  "Dequeuing queue\n")
      (insert (format "%S\n" (pjb-queue-dequeue q)))
      (funcall check  q)
      )

    ));;pjb-queue-test;



;;;; pjb-queue.el                     -- 2001-12-31 04:15:29 -- pascal   ;;;;