src/sicp/ex3_21.rkt

   1 #lang r5rs
   2
   3 (define error display)
   4
   5 (define (front-ptr queue) (car queue))
   6 (define (rear-ptr queue) (cdr queue))
   7 (define (set-front-ptr! queue item) (set-car! queue item))
   8 (define (set-rear-ptr! queue item) (set-cdr! queue item))
   9
  10 (define (empty-queue? queue) (null? (front-ptr queue)))
  11 (define (make-queue) (cons '() '()))
  12 (define (front-queue queue)
  13   (if (empty-queue? queue)
  14       (error "FRONT called with an empty queue" queue)
  15       (car (front-ptr queue))))
  16 (define (insert-queue! queue item)
  17   (let ((new-pair (cons item '())))
  18     (cond
  19       ((empty-queue? queue)
  20        (set-front-ptr! queue new-pair)
  21        (set-rear-ptr! queue new-pair)
  22        queue)
  23       (else
  24        (set-cdr! (rear-ptr queue) new-pair)
  25        (set-rear-ptr! queue new-pair)
  26        queue))))
  27 (define (delete-queue! queue)
  28   (cond
  29     ((empty-queue? queue)
  30      (error "DELETE! called on an empty queue" queue))
  31     (else
  32      (set-front-ptr! queue (cdr (front-ptr queue)))
  33      queue)))
  34
  35 (define (print-queue queue)
  36   (define (copy-queue q1)
  37     (let ((q2 (make-queue)))
  38       (set-front-ptr! q2 (front-ptr q1))
  39       (set-rear-ptr! q2 (rear-ptr q1))
  40       q2))
  41   (let ((q (copy-queue queue)))
  42     (if (not (empty-queue? q))
  43         (begin
  44           (display (front-queue q))
  45           (display " ")
  46           (print-queue (delete-queue! q))))))
  47
  48
  49