]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex3_21.rkt
rewrite `quote->cons' using `match'.
[sicp.git] / 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