計算機プログラムの構造と解釈 第二版 P156 問題3.22

この問題はちょっと骨だった。

りあえず、ここまでの説明ページのアレやこれやを
make-queueに入れ込んじゃう事で、解決しちゃった。
つまりこんな感じ

(define (make-queue)
  (define (front-ptr queue)
    (car queue))
  (define (rear-ptr queue)
    (cdr queue))
  (define (set-front-ptr! queue item)
    (set-car! queue item))
  (define (set-rear-ptr! queue item)
    (set-cdr! queue item))
  (define (empty-queue? queue)
    (null? (front-ptr queue)))
  (define queue (cons '() '()))
  (define (dispatch m)
    (cond ((eq? m 'front)
           (if (empty-queue? queue)
             (error "FRONT called with an empty queue" queue)
             (car (front-ptr queue))))
          ((eq? m 'insert!)
           (lambda (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)))))
          ((eq? m 'delete!)
           (cond ((empty-queue? queue)
                  (error "DELETE! called with an empty queue" queue))
                 (else
                   (set-front-ptr! queue (cdr (front-ptr queue)))
                   queue)))

          ((eq? m 'print)
           (print (front-ptr queue)))

          (else (error "Unknown request --MAKE-ACCOUNT"
                       m))))
  dispatch)

実際にこの実装でも問題なく動いた。
でも教科書ではこういう書き方をしろと書いてある。

(define (make-queue)
  (let ((front-ptr ...)
        (rear-ptr ... ))
    <内部手続きの定義>
    (define (dispatch m) ...)
    dispatch))

結構考えて解ったのが、front-ptrとrear-ptrは一つのqueueみたいなリストで持ってる必要ないってこと。
ここまで思いついちゃえば後はスルッと解けました。

実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(define nil '())
(define disp display)
(define nl newline)

(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))

    (define (empty?)
      (null? front-ptr))

    (define (front)
      (if (empty?) (error "FRONT called with an empty queue" front-ptr)
        (car front-ptr)))

    (define (delete!)
      (if (empty?) (error "DELETE! called with an empty queue" front-ptr)
        (set! front-ptr (cdr front-ptr))))

    (define (insert!)
      (lambda (item)
        (let ((new-pair (cons item '())))
          (cond ((empty?)
                 (set! rear-ptr new-pair)
                 (set! front-ptr new-pair))
                (else
                  (set-cdr! rear-ptr new-pair)
                  (set! rear-ptr (cdr rear-ptr)))))))

    (define (dispatch m)
      (cond ((eq? m 'front) (front))
            ((eq? m 'insert!) (insert!))
            ((eq? m 'delete!) (delete!))
            ((eq? m 'print) (print front-ptr))
            (else (error "Unknown request --MAKE-ACCOUNT"
                         m))))
    dispatch))


(define q1 (make-queue))

;; main
(define (main args)
  ((q1 'insert!) 'a)
  (q1 'print)
  ((q1 'insert!) 'b)
  (q1 'print)
  ((q1 'insert!) 'c)
  (q1 'print)

  (q1 'delete!)
  (q1 'print)

  (print (q1 'front))

  ((q1 'insert!) 'd)
  (q1 'print)

  0)

実行

(a)
(a b)
(a b c)
(b c)
b
(b c d)

どうでしょう？