Blob


1 ;; Exercise 3.22. Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form
3 ;; it's better to hide front-ptr, rear-ptr, set-front-ptr!, and set-rear-ptr! since these are really implementation details
5 (define (make-queue)
6 (let ((front-ptr '())
7 (rear-ptr '()))
8 (define (empty-queue?)
9 (null? front-ptr))
10 (define (front-queue)
11 (if (empty-queue?)
12 (error "FRONT called with an empty queue" dispatch)
13 (car front-ptr)))
14 (define (insert-queue! item)
15 (let ((new-pair (cons item '())))
16 (cond ((empty-queue?)
17 (set! front-ptr new-pair)
18 (set! rear-ptr new-pair))
19 (else
20 (set-cdr! rear-ptr new-pair)
21 (set! rear-ptr new-pair)))
22 dispatch))
23 (define (delete-queue!)
24 (cond ((empty-queue?)
25 (error "DELETE! called with an empty queue" dispatch))
26 (else
27 (set! front-ptr (cdr front-ptr))
28 dispatch)))
29 (define (dispatch m)
30 (cond ((eq? m 'empty-queue?) (empty-queue?))
31 ((eq? m 'front-queue) (front-queue))
32 ((eq? m 'insert-queue!) insert-queue!)
33 ((eq? m 'delete-queue!) (delete-queue!))
34 ((eq? m 'queue->list) front-ptr)
35 (else (error "undefined operation -- MAKE-QUEUE" m))))
36 dispatch))
38 ;; publicly visible interface
40 (define (empty-queue? queue)
41 (queue 'empty-queue?))
42 (define (front-queue queue)
43 (queue 'front-queue))
44 (define (insert-queue! queue item)
45 ((queue 'insert-queue!) item))
46 (define (delete-queue! queue)
47 (queue 'delete-queue!))
48 (define (queue->list queue)
49 (queue 'queue->list))
51 (define (test-case actual expected)
52 (newline)
53 (display "Actual: ")
54 (display actual)
55 (newline)
56 (display "Expected: ")
57 (display expected)
58 (newline))
60 ;; Exercise 3.21
62 ;; Define a procedure print-queue that takes a queue as input and prints the sequence of items in the queue.
64 (define (print-queue queue)
65 (newline)
66 (newline)
67 (display (queue->list queue))
68 (newline)
69 (queue->list queue))
71 (define q (make-queue))
72 (insert-queue! q 'a)
73 (test-case (print-queue q) '(a))
74 (insert-queue! q 'b)
75 (test-case (print-queue q) '(a b))
76 (insert-queue! q 'c)
77 (test-case (print-queue q) '(a b c))
78 (insert-queue! q 'd)
79 (test-case (print-queue q) '(a b c d))
80 (insert-queue! q 'e)
81 (test-case (print-queue q) '(a b c d e))
82 (delete-queue! q)
83 (test-case (print-queue q) '(b c d e))
84 (delete-queue! q)
85 (test-case (print-queue q) '(c d e))