関数型言語の勉強にSICPを読もう - (34) 3章 - 標準部品化力、オブジェクトおよび状態 (156ページ)

問題3.22

え？手続きで出来るの?と思って一瞬でも疑った自分を恥じます。
Scheme楽しいよ。楽しすぎるよ。

(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    ;; public interface
    (define (empty-queue?)
      (null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
          (error "empty 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)))))
    (define (delete-queue!)
      (cond ((empty-queue?)
             (error "empty queue"))
            (else
             (set! front-ptr (cdr front-ptr)))))
    (define (display-queue)
      (define (display-queue-internal q)
        (cond ((eq? q rear-ptr)
               (display " ")
               (display (car q)))
              (else
               (begin (display " ")
                      (display (car q))
                      (display-queue-internal (cdr q))))))
      (if (empty-queue?)
          (display "empty queue\n")
          (begin
            (display "(")
            (display-queue-internal front-ptr)
            (display ")\n"))))
    (define (dispatch m . args)
      (cond ((eq? m 'insert-queue!) (insert-queue! (car args)))
            ((eq? m 'delete-queue!) (delete-queue!))
            ((eq? m 'display-queue) (display-queue))
            (else (erro "hoge"))))
    dispatch))


;; make-queue test
(define q1 (make-queue))
(q1 'display-queue)
;; empty queue

(q1 'insert-queue! 'a)
(q1 'display-queue)
;;( a)


(q1 'insert-queue! 'b)
(q1 'display-queue)
;;( a b)


(q1 'delete-queue!)
(q1 'display-queue)
;;( b)


(q1 'delete-queue!)
(q1 'display-queue)
;; empty queue