(ice-9 q)

[mike@olan.com (Michael N. Livshin)]

Whoever wrote the ice-9/q.scm as now distributed with Guile?

Observations:

1. Why a perfectly good Andrew Wilcox's implementation was thrown
   out?
2. The implementation that *is* used instead sports linear-time
   enq! and deq!. Wow.
3. The whole thing is obviously not used at all by anybody, because it
   assumes (eq? #t (eq? '() #f)) and nobody complains.

With the following observations in mind, I suggest that the following
code (Andrew Wilcox's original implementation, Guille'ified and slightly
tweaked by yours truly) be used instead.

The interface is kept unchanged, except that q-remove! is not
implemented (and I'm not afraid to break somebody's code - see point 3 above).

If you think I was alittle rude, sorry.

------------------>8--------- cut here ----------8<---------------------
;;;; q.scm --- Queues/Stacks
;;;;
;;;;    Copyright (C) 1998 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program 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 General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;

(define-module (ice-9 q))

;;;;
;;; Q: Guile'ified:
;;;
;;; "queue.scm"  Queues/Stacks for Scheme
;;;  Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.
;;;

; Elements in a queue are stored in a list.  The last pair in the list
; is stored in the queue type so that datums can be added in constant
; time.

(define queue:record-type
  (make-record-type "queue" '(first-pair last-pair length)))

;; make-q
;;  Construct a Q.
(define-public make-q
  (let ((construct-queue (record-constructor queue:record-type)))
    (lambda ()
      (construct-queue '() '() 0))))

(define-public q? (record-predicate queue:record-type))

(define queue:first-pair (record-accessor queue:record-type
                                          'first-pair))
(define queue:set-first-pair! (record-modifier queue:record-type
                                               'first-pair))
(define queue:last-pair (record-accessor queue:record-type
                                         'last-pair))
(define queue:set-last-pair! (record-modifier queue:record-type
                                              'last-pair))
(define queue:set-length! (record-modifier queue:record-type
                                           'length))

;; q-empty?
(define-public (q-empty? q)
  (null? (queue:first-pair q)))

;; q-empty-check q
;;  Throw a q-empty exception if Q is empty.
(define-public (q-empty-check q) (if (q-empty? q) (throw 'q-empty q)))

;; q-length
(define-public q-length (record-accessor queue:record-type
                                         'length))

;; q-front
;;  First elt
(define-public (q-front q)
  (let ((first-pair (queue:first-pair q)))
    (if (null? first-pair)
        (throw 'q-empty q))
    (car first-pair)))

;; q-rear
;;  Last elt
(define-public (q-rear q)
  (let ((last-pair (queue:last-pair q)))
    (if (null? last-pair)
        (throw 'q-empty q))
    (car last-pair)))

;; q-push!
;;  Add elt at the front
(define-public (q-push! q datum)
  (let* ((old-first-pair (queue:first-pair q))
         (new-first-pair (cons datum old-first-pair)))
    (queue:set-first-pair! q new-first-pair)
    (if (null? old-first-pair)
        (queue:set-last-pair! q new-first-pair))
    (queue:set-length! q (+ 1 (q-length q))))
  q)

;; enq!
;;  Add elt at the rear
(define-public (enq! q datum)
  (let ((new-pair (cons datum '())))
    (cond ((null? (queue:first-pair q))
           (queue:set-first-pair! q new-pair))
          (else
           (set-cdr! (queue:last-pair q) new-pair)))
    (queue:set-last-pair! q new-pair)
    (queue:set-length! q (+ 1 (q-length q))))
  q)

;; deq!
;;  Hey, you really read these comments???
(define-public (deq! q)
  (let ((first-pair (queue:first-pair q)))
    (if (null? first-pair)
        (throw 'q-empty q))
    (let ((first-cdr (cdr first-pair)))
      (queue:set-first-pair! q first-cdr)
      (if (null? first-cdr)
          (queue:set-last-pair! q '()))
      (queue:set-length! q (- (q-length q) 1))
      (car first-pair))))

(define-public q-pop! deq!)