75 lines
1.9 KiB
Scheme
75 lines
1.9 KiB
Scheme
|
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
|
||
|
|
|
||
|
|
; This file is no longer used.
|
||
|
|
|
||
|
|
; Queues implemented as doubly linked lists (because the thread package needs
|
||
|
|
; to delete queue entries quickly).
|
||
|
|
|
||
|
|
; The exported procedures are those of the simpler queue package, with the
|
||
|
|
; addition of DELETE-QUEUE-ENTRY!. ENQUEUE! returns a queue-entry which can
|
||
|
|
; then be passed to DELETE-QUEUE-ENTRY! to remove the thing from the queue.
|
||
|
|
|
||
|
|
(define-record-type q-entry :q-entry
|
||
|
|
(make-q-entry data prev next)
|
||
|
|
q-entry?
|
||
|
|
(data q-entry-data)
|
||
|
|
(prev q-entry-prev set-q-entry-prev!)
|
||
|
|
(next q-entry-next set-q-entry-next!))
|
||
|
|
|
||
|
|
(define queue? q-entry?)
|
||
|
|
|
||
|
|
(define (make-queue)
|
||
|
|
(let ((e (make-q-entry #f #f #f)))
|
||
|
|
(set-q-entry-prev! e e)
|
||
|
|
(set-q-entry-next! e e)
|
||
|
|
e))
|
||
|
|
|
||
|
|
(define (queue-empty? q)
|
||
|
|
(eq? (q-entry-next q) q))
|
||
|
|
|
||
|
|
(define (enqueue! q thing)
|
||
|
|
(let* ((prev (q-entry-prev q))
|
||
|
|
(e (make-q-entry thing prev q)))
|
||
|
|
(set-q-entry-prev! q e)
|
||
|
|
(set-q-entry-next! prev e)
|
||
|
|
e))
|
||
|
|
|
||
|
|
(define (queue-head q)
|
||
|
|
(let ((e (q-entry-next q)))
|
||
|
|
(if (eq? q e) ;(queue-empty? q)
|
||
|
|
(error "empty queue" q)
|
||
|
|
(q-entry-data e))))
|
||
|
|
|
||
|
|
(define (dequeue! q)
|
||
|
|
(let ((e (q-entry-next q)))
|
||
|
|
(cond ((eq? q e) ;(queue-empty? q)
|
||
|
|
(error "empty queue" q))
|
||
|
|
(else
|
||
|
|
(set-q-entry-next! q (q-entry-next e))
|
||
|
|
(set-q-entry-prev! (q-entry-next q) q)
|
||
|
|
(q-entry-data e)))))
|
||
|
|
|
||
|
|
(define (delete-queue-entry! e)
|
||
|
|
(let ((next (q-entry-next e))
|
||
|
|
(prev (q-entry-prev e)))
|
||
|
|
(set-q-entry-next! prev next)
|
||
|
|
(set-q-entry-prev! next prev)))
|
||
|
|
|
||
|
|
(define (queue->list q)
|
||
|
|
(do ((e (q-entry-prev q) (q-entry-prev e))
|
||
|
|
(l '() (cons (q-entry-data e) l)))
|
||
|
|
((eq? q e) l)))
|
||
|
|
|
||
|
|
(define (queue-length q)
|
||
|
|
(do ((e (q-entry-prev q) (q-entry-prev e))
|
||
|
|
(l 0 (+ l 1)))
|
||
|
|
((eq? q e) l)))
|
||
|
|
|
||
|
|
(define (delete-from-queue! q v)
|
||
|
|
(let loop ((e (q-entry-next q)))
|
||
|
|
(cond ((eq? e q))
|
||
|
|
((eq? (q-entry-data e) v)
|
||
|
|
(delete-queue-entry! e))
|
||
|
|
(else
|
||
|
|
(loop (q-entry-next e))))))
|