sicp(sicp37)m3.23

delete-rear-queue!がなければ、次の値だけ保持するようなデータ構造でO(1)の処理ができる。
（delete-rear-queue!だけはO(N)になってしまう。）

(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-element entry)
      (cons entry (cons '() '())))
    (define (show)
      (define (loop item)
        (if (null? item)
            '()
            (begin
              (display (car item))
              (display " ->")
              (loop (cddr item)))))
      (loop front-ptr))
    (define (front-queue queue)
      (if (empty-queue?)
          (error "FRONT called with an empty queue")
          (car front-ptr)))
    (define (insert-front-queue! item)
      (let ((new-element (make-element item)))
		        ;;(entry prev next)
        (cond ((empty-queue?)
               (set-front-ptr! new-element)
               (set-rear-ptr! new-element)
               (show))
              (else
               (set-cdr! (cdr new-element) front-ptr)
               (set-car! (cdr front-ptr) new-element)
               (set-front-ptr! new-element)
               (show)))))
    (define (insert-rear-queue! item)
      (let ((new-element (make-element item)))
        (cond ((empty-queue?)
               (set-front-ptr! new-element)
               (set-rear-ptr! new-element)
               (show))
              (else
               (set-car! (cdr new-element) rear-ptr)
               (set-cdr! (cdr rear-ptr) new-element)
               (set-rear-ptr!  new-element)
               (show)))))
    (define (delete-front-queue!)
      (cond ((empty-queue?)
             (error "DELTE! called with an empty queue"))
            (else
             (set-front-ptr! (cddr front-ptr))
             ;(set-car! (cdr front-ptr) '())
             (show))))
    (define (delete-rear-queue!)
      (cond ((empty-queue?)
             (error "DELTE! called with an empty queue"))
            (else
             (set-rear-ptr! (cadr rear-ptr))
                 (if (null? rear-ptr)
                     (set-front-ptr! '())
                     (set-cdr! (cdr rear-ptr) '()))
             (show))))
    (define (dispatch m)
      (let ((methods (list
                      (cons 'empty-queue? empty-queue?)
                      (cons 'front-queue front-queue)
                      (cons 'insert-front-queue! insert-front-queue!)
                      (cons 'insert-rear-queue! insert-rear-queue!)
                      (cons 'delete-front-queue! delete-front-queue!)
                      (cons 'delete-rear-queue! delete-rear-queue!))))
        (define (loop methods)
          (cond ((null? methods)
                 (error "this method is not found " m))
                ((eq? m (caar methods))
;;                  (print (caar methods) " is called.")
                 (cdar methods))
                (else (loop (cdr methods)))))
        (loop methods)))
    dispatch))
(define q (make-queue))
((q 'insert-front-queue!) 'a)
((q 'insert-rear-queue!) 'b)
((q 'insert-front-queue!) 'c)
((q 'insert-rear-queue!) 'd)
((q 'delete-front-queue!))
((q 'delete-rear-queue!))
	;; 55:user> => q
	;; 56:user> a ->=> ()
	;; 57:user> a ->b ->=> ()
	;; 58:user> c ->a ->b ->=> ()
	;; 59:user> c ->a ->b ->d ->=> ()
	;; 60:user> a ->b ->d ->=> ()
	;; 61:user> a ->b ->=> ()