sicp-ex-3.22

I suggest implement queue just like the way implement 'cons' in the section : Mutation is just assignment.

The benefit of doing in this way:

1.The expression that call of queue operation won't change. We can call them just like before: (insert-queue! q 'a)

2.Keep good abstraction barrier. Notice that the code of empty-queue?, front-queue, insert-queue!, delete-queue! don't need change at all

 #lang sicp 
  
 ;; One level of abstraction: select and to modify the front and rear pointers of a queue: 
 (define (make-queue) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
     (define (set-front-ptr! item) 
       (set! front-ptr item)) 
     (define (set-rear-ptr! item) 
       (set! rear-ptr item)) 
     (define (dispatch m) 
       (cond ((eq? m 'front-ptr) front-ptr) 
             ((eq? m 'rear-ptr) rear-ptr) 
             ((eq? m 'set-front-ptr!) set-front-ptr!) 
             ((eq? m 'set-rear-ptr!) set-rear-ptr!) 
             (else 
              (error "Undefined operation: QUEUE" m)))) 
     dispatch)) 
  
 (define (front-ptr q) (q 'front-ptr)) 
 (define (rear-ptr q) (q 'rear-ptr)) 
 (define (set-front-ptr! q item) 
   ((q 'set-front-ptr!) item)) 
 (define (set-rear-ptr! q item) 
   ((q 'set-rear-ptr!) item)) 
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; Next level abstraction: Queue operations. No change. 
 (define (empty-queue? queue) 
   (null? (front-ptr queue))) 
 (define (front-queue queue) 
   (if (empty-queue? queue) 
       (error "FRONT called with an empty queue" queue) 
       (car (front-ptr queue)))) 
 (define (insert-queue! queue item) 
   (let ((new-pair (cons item '()))) 
     (cond ((empty-queue? queue) 
            (set-front-ptr! queue new-pair) 
            (set-rear-ptr! queue new-pair) 
            queue) 
           (else 
            (set-cdr! (rear-ptr queue) new-pair) 
            (set-rear-ptr! queue new-pair) 
            queue)))) 
 (define (delete-queue! queue) 
   (cond ((empty-queue? queue) 
          (error "DELETE! called with an empty queue" queue)) 
         (else (set-front-ptr! queue (cdr (front-ptr queue))) 
               queue))) 
  
 ;; TEST 
 (define q (make-queue)) 
 (insert-queue! q 'a) (front-ptr q);a 
 (front-queue q) ;a 
 (insert-queue! q 'b)(front-ptr q) ;a b 
 (delete-queue! q) (front-ptr q);b 
 (insert-queue! q 'c) (front-ptr q);b c 
 (insert-queue! q 'd) (front-ptr q);b c d 
 (delete-queue! q) (front-ptr q);c d 

  
  
  
 (define (make-queue) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
         (define (emtpy-queue?) (null? front-ptr)) 
         (define (set-front-ptr! item) (set! front-ptr item)) 
         (define (set-rear-ptr! item) (set! rear-ptr item)) 
         (define (front-queue)  
           (if (emtpy-queue?) 
             (error "FRONT called with an empty queue") 
             (car front-ptr))) 
         (define (insert-queue! item) 
           (let ((new-pair (cons item '()))) 
             (cond ((emtpy-queue?) 
                     (set-front-ptr! new-pair) 
                     (set-rear-ptr! new-pair)) 
                   (else  
                     (set-cdr! rear-ptr new-pair) 
                     (set-rear-ptr! new-pair))))) 
         (define (delete-queue!) 
           (cond ((emtpy-queue?) 
                   (error "DELETE called with an emtpy queue")) 
                 (else (set-front-ptr! (cdr front-ptr))))) 
      
         (define (print-queue) front-ptr) 
  
         (define (dispatch m) 
           (cond ((eq? m 'empty-queue) emtpy-queue?) 
                 ((eq? m 'front-queue) front-queue) 
                 ((eq? m 'insert-queue!) insert-queue!) 
                 ((eq? m 'delete-queue!) delete-queue!) 
                 ((eq? m 'print-queue) print-queue) 
                 (else (error "undefined operation -- QUEUE" m)))) 
         dispatch)) 
  
 }}}} 

  
 ;;there is a little error in meteorgan's answer, in dispatch, should be (empty-queue?), not empty-queue, the same as delete-queue! 
  
 (define (make-queue) 
   (let ((front-ptr '()) (rear-ptr '())) 
     (define (set-front-ptr! item) (set! front-ptr item)) 
     (define (set-rear-ptr! item) (set! rear-ptr item)) 
  
     (define (empty-queue?) (null? front-ptr)) 
     ;;(define (make-queue) (cons '() '())) 
     (define (front-queue) 
       (if (empty-queue?) 
           (error "FRONT called with an empty queue" queue) 
           (car front-ptr))) 
  
     (define (insert-queue! item) 
       (let ((new-pair (cons item '()))) 
         (cond ((empty-queue?) 
                (set-front-ptr! new-pair) 
                (set-rear-ptr! new-pair)) 
               (else 
                (set-cdr! rear-ptr new-pair) 
                (set-rear-ptr! new-pair))) 
         front-ptr))  
  
     (define (delete-queue!) 
       (cond ((empty-queue?) 
              (error "DELETE! called with an empty queue" queue)) 
             (else 
              (set-front-ptr! (cdr front-ptr)))) 
       front-ptr)  
  
     (define (dispatch m) 
       (cond ((eq? m 'empty-queue?) (empty-queue?)) 
             ((eq? m 'front-queue) (front-queue)) 
             ((eq? m 'insert-queue!) insert-queue!) 
             ((eq? m 'delete-queue!) (delete-queue!)) 
             (else (error "Undefined oepration")))) 
  
     dispatch)) 
  
 }}}} 

Here is the answer with tests

  
 (define (make-queue) 
   (let ((front-ptr '()) 
           (rear-ptr '())) 
     (define (set-front-ptr! item) (set! front-ptr item)) 
     (define (set-rear-ptr! item) (set! rear-ptr item)) 
     (define (empty-queue?) (null? front-ptr)) 
     (define new-queue (cons front-ptr rear-ptr)) 
     (define (front-queue) 
       (cond ((empty-queue?) 
                   (error "FRONT-QUEUE called with an empty queue")) 
                  (else (car front-ptr)))) 
     (define (insert-queue!) 
       (lambda (item) 
         (let ((new-pair (cons item '()))) 
           (cond ((empty-queue?) 
                       (set-front-ptr! new-pair) 
                       (set-rear-ptr! new-pair) 
                       (cons front-ptr rear-ptr)) 
                      (else 
                        (set-cdr! rear-ptr new-pair) 
                        (set-rear-ptr! new-pair) 
                        (cons front-ptr rear-ptr)))))) 
     (define (delete-queue!) 
       (cond ((empty-queue?) 
                   (error "DELETE-QUEUE! called with an empty queue")) 
                  (else 
                   (set-front-ptr! (cdr front-ptr)) 
                   (if (pair? front-ptr) 
                       (cons front-ptr rear-ptr) 
                       new-queue)))) 
     (define (dispatch m) 
       (cond ((eq? m 'empty?) (empty-queue?)) 
                  ((eq? m 'front) (front-queue)) 
                  ((eq? m 'insert) (insert-queue!)) 
                  ((eq? m 'delete) (delete-queue!)) 
                  (else (error "DISPATCH called with unknown operation")))) 
     dispatch)) 
  
 (define q (make-queue)) 
 (q 'empty?)      ; #t 
 ((q 'insert) 'a)   ; ((a) a) 
 (q 'front)           ; a 
 (q 'empty?)      ; #f      
 ((q 'insert) 'b)   ; ((a b) b) 
 (q 'front)           ; a 
  
 (q 'delete)      ; ((b) b) 
 (q 'delete)      ; (()) 
  

#lang sicp
(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (insert-q! item)
      (let ((new-pair (cons item '())))
        (cond ((null? front-ptr) (set! front-ptr new-pair)
                                 (set! rear-ptr new-pair) front-ptr)
              (else (set-cdr! rear-ptr new-pair)
                    (set! rear-ptr new-pair) front-ptr))))
    (define (delete-q!)
      (cond ((null? front-ptr)
             (error "DELETE! called with an empty queue" front-ptr))
            (else (set! front-ptr (cdr front-ptr )) front-ptr)))
    (define (front-q)
      (if (null? front-ptr)
          (error "FRONT called with an empty queue" front-ptr)
          (car front-ptr)))
    (define (dispatch m)
      (cond ((eq? m 'insert) insert-q!)
            ((eq? m 'delete) (delete-q!))
            ((eq? m 'front) (front-q))
            (else (error "Unknown command:" m))))
    dispatch))