Scheme - 標準部品化力、オブジェクト及び状態(可変データでのモデル化(キューの表現(印字手続き、局所状態を持つ手続き)))

計算機プログラムの構造と解釈 第2版
原著

開発環境

• macOS Sierra - Apple (OS)
• Emacs (Text Editor)
• Scheme (プログラミング言語)
• kscm (ksc、ksi)(github) (コンパイラー、インタプリタ(翻訳系、解釈系(処理系)))

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第3章(標準部品化力、オブジェクト及び状態)、3.3(可変データでのモデル化)、3.3.2(キューの表現)、問題3.21、22.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題3.21、22.

コード(Emacs)

(begin
  (define (p obj)
    (display obj)
    (newline))

  (p "3.21")
  (define (make-queue)
    (cons '() '()))
  (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 (front-queue queue)
    (if (empty-queue? queue)
        (error "FRONT called with an empty queue" queue)
        (car (front-ptr queue))))
  (define (insert-queue! queue item)
    ((lambda (new-pair)
       (if (empty-queue? queue)
           (begin
             (set-front-ptr! queue new-pair)
             (set-rear-ptr! queue new-pair)
             queue)
           (begin
             (set-cdr! (rear-ptr queue) new-pair)
             (set-rear-ptr! queue new-pair)
             queue)))
     (cons item '())))
  (define (delete-queue! queue)
    (if (empty-queue? queue)
        (error "DELETE! called with an empty queue" queue)
        (begin
          (set-front-ptr! queue (cdr (front-ptr queue)))
          queue)))
  (define (print-queue queue)
    (display (front-ptr queue))
    (newline))
  (define q1 (make-queue))

  (print-queue (insert-queue! q1 'a))
  (print-queue (insert-queue! q1 'b))
  (print-queue (delete-queue! q1))
  (print-queue (delete-queue! q1))

  (p "3.22")
  (define (make-queue)
    (define front-ptr '())
    (define rear-ptr '())

    (define (front-queue)
      (if (null? front-ptr)
          (error "FRONT called with an empty queue")
          (car front-ptr)))
    (define (insert-queue! item)
      ((lambda (new-pair)
         (if (null? front-ptr)
             (begin
               (set! front-ptr new-pair)
               (set! rear-ptr new-pair))
             (begin
               (set-cdr! rear-ptr new-pair)
               (set! rear-ptr new-pair))))
       (cons item '())))
    (define (delete-queue!)
      (if (null? front-ptr)
          (error "DELETE! called with an empty queue")
          (set! front-ptr (cdr front-ptr))))
            
    (define (print-queue)
      (display front-ptr)
      (newline))
    (define (dispatch m)
      (if (eq? m 'front-queue)
          front-queue
          (if (eq? m 'insert-queue!)
              insert-queue!
              (if (eq? m 'delete-queue!)
                  delete-queue!
                  (if (eq? m 'print-queue)
                      print-queue)))))
    dispatch)
  
  (define q (make-queue))
  ((q 'insert-queue!) 'a)
  ((q 'print-queue))
  (p ((q 'front-queue)))
  ((q 'insert-queue!) 'b)
  ((q 'print-queue))
  (p ((q 'front-queue)))
  ((q 'delete-queue!))
  ((q 'print-queue))
  (p ((q 'front-queue)))
  ((q 'delete-queue!))
  ((q 'print-queue))
  )

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ ksi < sample21.scm
ksi> 3.21
(a)
(a b)
(b)
()
3.22
(a)
a
(a b)
a
(b)
b
()
=> #<unspecified>
ksi> $