计算机程序的构造和解释习题3.22

计算机程序的构造和解释习题3.22

Here is the implementation of QUEUE as a procedure with local state.

[plain]  view plain copy

1. ;;;QUEUE as a procedure with local state  
2. (define (make-queue)  
3.   (let ((front-ptr nil)  
4.         (rear-ptr nil))  
5.     (define (dispatch m)  
6.       (cond ((eq? m 'empty-queue?) empty-queue?)  
7.             ((eq? m 'front-queue) front-queue)  
8.             ((eq? m 'insert-queue!) insert-queue!)  
9.             ((eq? m 'delete-queue!) delete-queue!)  
10.             ((eq? m 'print-queue) print-queue)  
11.             (else (error "Undefined operation -- MAKE-QUEUE" m))))  
12.     (define (empty-queue?)  
13.       (null? front-ptr))  
14.     (define (front-queue)  
15.       (if (empty-queue?)  
16.           (error "FRONT called with an empty queue")  
17.           (car front-ptr)))  
18.     (define (insert-queue! item)  
19.       (let ((new-pair (cons item nil)))  
20.         (if (empty-queue?)  
21.             (begin (set! front-ptr new-pair)  
22.                    (set! rear-ptr new-pair))  
23.             (begin (set-cdr! rear-ptr new-pair)  
24.                    (set! rear-ptr new-pair)))))  
25.     (define (delete-queue!)  
26.       (if (empty-queue?)  
27.           (error "DELETE called with an empty queue")  
28.           (set! front-ptr (cdr front-ptr))))     
29.     (define (print-queue)  
30.       (display front-ptr))  
31.     dispatch))  
32.   
33. ;;;QUEUE OPERATIONS  
34. (define (empty-queue? queue)   
35.   ((queue 'empty-queue?)))  
36. (define (front-queue queue)  
37.   ((queue 'front-queue)))  
38. (define (insert-queue! queue item)  
39.   ((queue 'insert-queue!) item)  
40.   queue)  
41. (define (delete-queue! queue)  
42.   ((queue 'delete-queue!))  
43.   queue)  
44. (define (print-queue queue)  
45.   ((queue 'print-queue)))  

The test code is as follows:

[plain]  view plain copy

1. ;;;TEST  
2. (define q1 (make-queue))  
3. (print-queue (insert-queue! q1 'a))  
4. (newline)  
5. (print-queue (insert-queue! q1 'b))  
6. (newline)  
7. (print-queue (delete-queue! q1))  
8. (newline)  
9. (print-queue (delete-queue! q1))  
10. (newline)  
11. (empty-queue? q1)  

And the result of the test is:

[plain]  view plain copy

1. (a)  
2. (a b)  
3. (b)  
4. ()  
5. #t