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