SICP問題3.22

局所状態を持つ手続きとして表現されたキュー
局所状態は通常のリストの最初と最後へのポインタからなる

(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 (front-queue)
      (if (empty-queue?)
          (error "FRONT called with an empty queue" front-ptr)
          (car front-ptr)))
    (define (rear-queue)
      (if (empty-queue?)
          (error "REAR called with an empty queue" rear-ptr)
          (car rear-ptr)))
    (define (insert-queue! item)
      (let ((new-pair (cons item '())))
        (cond ((empty-queue?)
               (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-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called with an empty queue" front-ptr))
            (else
             (set-front-ptr! (cdr front-ptr))
             front-ptr)))
    (define (print-queue)
      front-ptr)
    (define (dispatch m)
      (cond ((eq? m 'insert-queue!) insert-queue!)
            ((eq? m 'delete-queue!) delete-queue!)
            ((eq? m 'front-queue) front-queue)
            ((eq? m 'rear-queue) rear-queue)
            ((eq? m 'print-queue) print-queue)
            (else
             (error "Undefined operation -- MAKE-QUEUE" m))
      ))
    dispatch))

テスト

(define q1 (make-queue))
; q1
q1
; #<closure (make-queue dispatch)>
((q1 'print-queue ))
; ()
((q1 'insert-queue!) 'a)
; (a)
((q1 'insert-queue!) 'b)
; (a b)
((q1 'delete-queue!))
; (b)
((q1 'delete-queue!))
; ()

OK