SICP 読み (107) 3.3.2 キューの表現

なんか現実トウヒなソレだったんですが、さくっとデキた。

問題 3.22

細かい部分がローカルな手続きになるので試験はざっくり

test/test-3.3.2.scm

#!/usr/bin/env gosh

(use test.unit)
(require "3.3.2")

(define-test-suite "3.3.2"

 ("insert-queue! test"
 ("insert & front & delete"
  (let ((q (make-queue)))
    (assert-equal '() ((q 'print)))

    ((q 'insert) 1)
    (assert-equal '(1) ((q 'print)))
    (assert-equal 1 ((q 'front)))

    ((q 'insert) 2)
    (assert-equal '(1 2) ((q 'print)))
    (assert-equal 1 ((q 'front)))

    ((q 'insert) 3)
    (assert-equal '(1 2 3) ((q 'print)))
    (assert-equal 1 ((q 'front)))

    ((q 'delete))
    (assert-equal '(2 3) ((q 'print)))
    (assert-equal 2 ((q 'front)))

    ((q 'delete))
    (assert-equal '(3) ((q 'print)))
    (assert-equal 3 ((q 'front)))

    ((q 'delete))
    (assert-equal '() ((q 'print)))
    )
  )
 )
 )

適当に作ったら動きました。(を

lib/3.3.2.scm

(define (make-queue)
 (let ((queue (cons '() '()))
       (front-ptr car)
       (rear-ptr cdr)
       (set-front-ptr! set-car!)
       (set-rear-ptr! set-cdr!))

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

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

   (define (insert-queue! 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))))

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

   (define (print-queue) (front-ptr queue))

   (define (dispatch m)
     (cond ((eq? m 'print) print-queue)
           ((eq? m 'insert) insert-queue!)
           ((eq? m 'delete) delete-queue!)
           ((eq? m 'front) front-queue)
           (else
            (error "Undefined operation -- MAKE-QUEUE --" m))))

   dispatch))

次のソレも現実逃避ベースで何とかなりそう。(って何