105 lines
3.4 KiB
Racket
105 lines
3.4 KiB
Racket
#lang racket/base
|
|
|
|
(require (for-syntax racket/base
|
|
unstable/wrapc))
|
|
|
|
;; A Queue contains a linked list with mutable cdrs, holding two pointers
|
|
;; to the head and the tail -- where items are pulled from the head and
|
|
;; pushed on the tail. It is not thread safe: mutating a queue from
|
|
;; different threads can break it.
|
|
(struct queue (head tail) #:mutable)
|
|
;; (Note: uses #f for `head' to mark an empty queue, but in those cases
|
|
;; the tail will be set to #f too, to avoid holding on to values that
|
|
;; should be collected.)
|
|
(struct link (value [tail #:mutable]))
|
|
|
|
(define (make-queue) (queue #f #f))
|
|
|
|
(define (queue-empty? q) (not (queue-head q)))
|
|
|
|
(define (nonempty-queue? v) (and (queue? v) (queue-head v) #t))
|
|
|
|
(define (enqueue! q v)
|
|
(unless (queue? q) (raise-type-error enqueue! "queue" 0 q))
|
|
(let ([new (link v #f)])
|
|
(if (queue-head q)
|
|
(set-link-tail! (queue-tail q) new)
|
|
(set-queue-head! q new))
|
|
(set-queue-tail! q new)))
|
|
|
|
(define (dequeue! q)
|
|
(unless (queue? q) (raise-type-error dequeue! "queue" 0 q))
|
|
(let ([old (queue-head q)])
|
|
(unless old (error 'dequeue! "empty queue"))
|
|
(set-queue-head! q (link-tail old))
|
|
(link-value old)))
|
|
|
|
(define (queue->list queue)
|
|
(let loop ([link (queue-head queue)]
|
|
[out '()])
|
|
(if (not link)
|
|
(reverse out)
|
|
(loop (link-tail link) (cons (link-value link) out)))))
|
|
|
|
;; queue->vector could be implemented as (list->vector (queue->list q))
|
|
;; but this is somewhat slow. a direct translation between queue's and
|
|
;; vector's should be fast so the ideal situation is not to use a list
|
|
;; as an intermediate data structure.
|
|
;; maybe add the elements to a gvector and use gvector->vector?
|
|
|
|
;; could use (length (queue->list q)) here but that would double
|
|
;; the time it takes to get the length
|
|
;; probably if `queue->vector' gets implemented it would be better to
|
|
;; do (vector-length (queue->vector q))
|
|
(define (queue-length queue)
|
|
(let loop ([link (queue-head queue)]
|
|
[count 0])
|
|
(if (not link)
|
|
count
|
|
(loop (link-tail link) (add1 count)))))
|
|
|
|
(define (in-queue queue)
|
|
(in-list (queue->list queue)))
|
|
|
|
(define-sequence-syntax in-queue*
|
|
(lambda () #'in-queue)
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
([(var) (in-queue* queue-expression)]
|
|
(with-syntax ([queue-expression/c (wrap-expr/c #'queue? #'queue-expression
|
|
#:macro #'in-queue*)])
|
|
#'[(var)
|
|
(:do-in ([(queue) queue-expression/c])
|
|
(void) ;; handled by contract
|
|
([link (queue-head queue)])
|
|
link
|
|
([(var) (link-value link)])
|
|
#t
|
|
#t
|
|
((link-tail link)))]))
|
|
([(var ...) (in-queue* queue-expression)]
|
|
#f))))
|
|
|
|
;; --- contracts ---
|
|
|
|
(require racket/contract)
|
|
|
|
(define queue/c
|
|
(flat-named-contract "queue" queue?))
|
|
|
|
(define nonempty-queue/c
|
|
(flat-named-contract "nonempty-queue" nonempty-queue?))
|
|
|
|
;; Eli: Are these needed? (vs just providing `queue?', `make-queue' and
|
|
;; `queue-empty?'.)
|
|
(provide/contract
|
|
[queue/c flat-contract?]
|
|
[nonempty-queue/c flat-contract?]
|
|
[queue? (-> any/c boolean?)]
|
|
[make-queue (-> queue/c)]
|
|
[queue-empty? (-> queue/c boolean?)]
|
|
[queue-length (-> queue/c integer?)]
|
|
[queue->list (-> queue/c (listof any/c))])
|
|
|
|
(provide enqueue! dequeue! (rename-out [in-queue* in-queue]))
|