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