[Jscheme-user] Norvig's queue code.

[Ken A. <kan...@bb...>]

Every year or so, i need a queue.  So, i look up Peter Norvig's clever implementation.  Here's a JScheme version including synchronized procedures, and an example.

k

;;; Norvig's very clever queue, PAIP p 342.
;;; A queue is a (last . contents) pair.

;;; Unfortuantely, it is circular, and thus not printable in Scheme,
;;; so we wrap it in a thunk.
(define (queue-contents q) (cdr (q)))

(define (make-queue)
  ;; Build a new queue, with no elements.
  (let ((q (cons '() '())))
    (set-car! q q)
    (lambda () q)))

(define (enqueue item queue)
  ;; Insert item at the end of the queue.
  (let ((q (queue)))
    (set-car! q (set-cdr! (car q) (cons item '()))))
  queue)

(define (dequeue q)
  ;; Remove an item from the front of the queue.
  (let ((q (q)))
    (set-cdr! q (cdr (cdr q)))
    (if (null? (cdr q)) (set-car! q q)))
  q)

(define (front q) (car (queue-contents q)))

(define (empty-queue? q) (null? (queue-contents q)))

(define (queue-pop q)
  (let ((it (front q)))
    (dequeue q)
    it))

;;; Synchronized versions.
(define (senqueue item q)
  ;; Synchronized version of (enqueue).
  (synchronize q
               (lambda (q)
                 (enqueue item q)
                 (.notify q))))

(define (squeue-pop q)
  ;; Synchronized version of (queue-pop)
  (synchronize q
               (lambda (q)
                 (let loop ()
                   (if (empty-queue? q)
                       (begin
                         (.wait q)
                         (loop))))
                 (queue-pop q))))

(define (Runner)
  ;; Example.  Returns a procedure that takes a thunk.  When the
  ;; procedure is invoked, the thunk is placed on a queue and a
  ;; separate Thread executes it.  Multiple tasks can be enqueued, the
  ;; are executed sequentially.
  (let* ((q (make-queue))
         (thread (Thread. (lambda ()
                            (let loop ((it (squeue-pop q)))
                              (it)
                              (loop (squeue-pop q)))))))
    (.start thread)
    (lambda (action) (senqueue action q))))