queue.scm 598 B

12345678910111213141516171819202122232425262728293031
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Richard Kelsey, Jonathan Rees
  3. ; Queues
  4. (define (make-queue)
  5. (cons '() '()))
  6. (define (queue-empty? q)
  7. (and (null? (car q))
  8. (null? (cdr q))))
  9. (define (enqueue! q obj)
  10. (set-car! q (cons obj (car q))))
  11. (define (dequeue! q)
  12. (normalize-queue! q)
  13. (let ((head (car (cdr q))))
  14. (set-cdr! q (cdr (cdr q)))
  15. head))
  16. (define (normalize-queue! q)
  17. (if (null? (cdr q))
  18. (begin (set-cdr! q (reverse (car q)))
  19. (set-car! q '()))))
  20. (define (queue-head q)
  21. (normalize-queue! q)
  22. (car (cdr q)))