問題3-23 (3.3.2 Representing Queues)

キューの両端から追加と削除ができる，deque を作る問題．
追加，削除はで，という制約付き．

本文に書いてある queue の実装をパクればほぼ OK とか思っていたんですけど，それだと終端からの要素の削除がにはならないですね．
結局，双方向線形リストを作って，deque を作ってみた．
番兵を使えばもうちょっとキレいだったと思いますが，もはや作ってしまったので後の祭り．

;; deque を構成するノード
(define (make-node c p n)
  (let ((content c)
	(prev p)
	(next n))
    (define (set-prev! new-prev)
      (set! prev new-prev))
    (define (set-next! new-next)
      (set! next new-next))
    
    (define (dispatch m)
      (cond ((eq? m 'get-content) content)
	    ((eq? m 'get-prev) prev)
	    ((eq? m 'get-next) next)
	    ((eq? m 'set-prev) set-prev!)
	    ((eq? m 'set-next) set-next!)
	    (else
	     (error "UNDEFINED COMMAND"))))
    dispatch))

(define (get-content node) (node 'get-content))
(define (get-prev node) (node 'get-prev))
(define (get-next node) (node 'get-next))
(define (set-prev! node new-prev)
  ((node 'set-prev) new-prev))
(define (set-next! node new-next)
  ((node 'set-next) new-next))

;; deque の実装
(define (make-deque)
  (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-deque?)
      (null? front-ptr))
    (define (front-deque)
      (if (empty-deque?)
	  (error "FRONT called with an empty queue")
	  (get-content front-ptr)))
    (define (rear-deque)
      (if (empty-deque?)
	  (error "FRONT called with an empty queue")
	  (get-content rear-ptr)))
    (define (first-insert-node! item)
      (let ((node (make-node item '() '())))
	(set-front-ptr! node)
	(set-rear-ptr! node)
	dispatch))
    (define (front-insert-deque! item)
      (let ((new-node (make-node item '() front-ptr)))
	(cond ((empty-deque?)
	       (first-insert-node! item))
	      (else
	       (set-prev! front-ptr new-node)
	       (set-front-ptr! new-node)))))
    (define (rear-insert-deque! item)
      (let ((new-node (make-node item rear-ptr '())))
	(cond ((empty-deque?)
	       (first-insert-node! item))
	      (else
	       (set-next! rear-ptr new-node)
	       (set-rear-ptr! new-node)))))
    (define (front-delete-deque!)
      (cond ((empty-deque?)
	     (error "DELETE! called with an empty queue"))
	    (else
	     (set-front-ptr! (get-next front-ptr))
	     (if (null? front-ptr)
		 (begin (set-front-ptr! '())
			(set-rear-ptr! '()))
		 (set-prev! front-ptr '())))))
    (define (rear-delete-deque!)
      (cond ((empty-deque?)
	     (error "DELETE! called with an empty queue"))
	    (else
	     (set-rear-ptr! (get-prev rear-ptr))
	     (if (null? rear-ptr)
		 (begin (set-rear-ptr! '())
			(set-front-ptr! '()))
		 (set-next! rear-ptr '())))))
    (define (print-deque next)
      (cond ((null? next) (display ")") (print))
	    (else
	     (display (get-content next))
	     (display " ")
	     (print-deque (get-next next)))))
    
    (define (dispatch m)
      (cond ((eq? m 'front-deque) front-deque)
	    ((eq? m 'rear-deque) rear-deque)
	    ((eq? m 'front-insert-deque!) front-insert-deque!)
	    ((eq? m 'rear-insert-deque!) rear-insert-deque!)
	    ((eq? m 'front-delete-deque!) (front-delete-deque!))
	    ((eq? m 'rear-delete-deque!) (rear-delete-deque!))
	    ((eq? m 'print-deque) 
	     (display "( ")
	     (print-deque front-ptr))
	    (else
	     error "UNDEFINED COMMAND ON DEQUE!")))
    dispatch))

(define (front-deque queue) (queue 'front-deque))
(define (rear-deque queue) (queue 'rear-deque))
(define (front-insert-deque! queue item)
  ((queue 'front-insert-deque!) item))
(define (rear-insert-deque! queue item)
  ((queue 'rear-insert-deque!) item))
(define (front-delete-deque! queue) (queue 'front-delete-deque!))
(define (rear-delete-deque! queue) (queue 'rear-delete-deque!))
(define (print-deque queue) (queue 'print-deque))

(define dq (make-deque))
(front-insert-deque! dq 'c) 
(print-deque dq)             ; ( c )
(front-insert-deque! dq 'b)
(print-deque dq)             ; ( b c )
(rear-insert-deque! dq 'd)
(print-deque dq)             ; ( b c d )
(front-insert-deque! dq 'a)
(print-deque dq)             ; ( a b c d )
(front-delete-deque! dq)
(print-deque dq)             ; ( b c d )
(rear-delete-deque! dq)
(print-deque dq)             ; ( b c )
(rear-delete-deque! dq)
(print-deque dq)             ; ( b )
(front-delete-deque! dq)
(print-deque dq)             ; ( )
(front-delete-deque! dq)     ; *** ERROR: DELETE! called with an empty queue