1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 2 665c255d 2023-08-04 jrmu   (newline)
 3 665c255d 2023-08-04 jrmu   (display "Actual:   ")
 4 665c255d 2023-08-04 jrmu   (display actual)
 5 665c255d 2023-08-04 jrmu   (newline)
 6 665c255d 2023-08-04 jrmu   (display "Expected: ")
 7 665c255d 2023-08-04 jrmu   (display expected)
 8 665c255d 2023-08-04 jrmu   (newline))
 9 665c255d 2023-08-04 jrmu 
10 665c255d 2023-08-04 jrmu (define (front-ptr queue) (car queue))
11 665c255d 2023-08-04 jrmu (define (rear-ptr queue) (cdr queue))
12 665c255d 2023-08-04 jrmu (define (set-front-ptr! queue item) (set-car! queue item))
13 665c255d 2023-08-04 jrmu (define (set-rear-ptr! queue item) (set-cdr! queue item))
14 665c255d 2023-08-04 jrmu (define (empty-queue? queue) (null? (front-ptr queue)))
15 665c255d 2023-08-04 jrmu (define (make-queue) (cons '() '()))
16 665c255d 2023-08-04 jrmu (define (front-queue queue)
17 665c255d 2023-08-04 jrmu   (if (empty-queue? queue)
18 665c255d 2023-08-04 jrmu       (error "FRONT called with an empty queue" queue)
19 665c255d 2023-08-04 jrmu       (car (front-ptr queue))))
20 665c255d 2023-08-04 jrmu (define (insert-queue! queue item)
21 665c255d 2023-08-04 jrmu   (let ((new-pair (cons item '())))
22 665c255d 2023-08-04 jrmu     (cond ((empty-queue? queue)
23 665c255d 2023-08-04 jrmu 	   (set-front-ptr! queue new-pair)
24 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! queue new-pair)
25 665c255d 2023-08-04 jrmu 	   queue)
26 665c255d 2023-08-04 jrmu 	  (else
27 665c255d 2023-08-04 jrmu 	   (set-cdr! (rear-ptr queue) new-pair)
28 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! queue new-pair)
29 665c255d 2023-08-04 jrmu 	   queue))))
30 665c255d 2023-08-04 jrmu (define (delete-queue! queue)
31 665c255d 2023-08-04 jrmu   (cond ((empty-queue? queue)
32 665c255d 2023-08-04 jrmu 	 (error "DELETE! called with an empty queue" queue))
33 665c255d 2023-08-04 jrmu 	(else
34 665c255d 2023-08-04 jrmu 	 (set-front-ptr! queue (cdr (front-ptr queue)))
35 665c255d 2023-08-04 jrmu 	 queue)))
36 665c255d 2023-08-04 jrmu 
37 665c255d 2023-08-04 jrmu ;; Exercise 3.21
38 665c255d 2023-08-04 jrmu 
39 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. 
40 665c255d 2023-08-04 jrmu 
41 665c255d 2023-08-04 jrmu (define (print-queue queue)
42 665c255d 2023-08-04 jrmu   (newline)
43 665c255d 2023-08-04 jrmu   (newline)
44 665c255d 2023-08-04 jrmu   (display (front-ptr queue))
45 665c255d 2023-08-04 jrmu   (newline)
46 665c255d 2023-08-04 jrmu   (front-ptr queue))
47 665c255d 2023-08-04 jrmu 
48 665c255d 2023-08-04 jrmu (define q (make-queue))
49 665c255d 2023-08-04 jrmu (insert-queue! q 'a)
50 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(a))
51 665c255d 2023-08-04 jrmu (insert-queue! q 'b)
52 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(a b))
53 665c255d 2023-08-04 jrmu (insert-queue! q 'c)
54 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(a b c))
55 665c255d 2023-08-04 jrmu (insert-queue! q 'd)
56 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(a b c d))
57 665c255d 2023-08-04 jrmu (insert-queue! q 'e)
58 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(a b c d e))
59 665c255d 2023-08-04 jrmu (delete-queue! q)
60 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(b c d e))
61 665c255d 2023-08-04 jrmu (delete-queue! q)
62 665c255d 2023-08-04 jrmu (test-case (print-queue q) '(c d e))
63 665c255d 2023-08-04 jrmu