Scheme - 標準部品化力、オブジェクトおよび状態(可変データでのモデル化(可変リスト構造(変更は単なる代入(代入と局所状態を使った手続きによる変更の実装))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第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.1(可変リスト構造)、変更は単なる代入、問題 3.20.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 3.20.

環境の図。

;; 大域環境
;; 手続き
cons
;; パラメーター
x
y
;; 本体
(define (set-x! v) (set! x v))
(define (set-y! v) (set! y v))
(define (dispatch m)
  (cond ((eq? m 'car) x)
        ((eq? m 'cdr) y)
        ((eq? m 'set-car!) set-x!)
        ((eq? m 'set-cdr!) set-y!)
        (else (error "Undefined operation -- CONS" m))))
dispatch

;; 手続き
car
;; パラメーター
z
;; 本体
(z 'car)

;; 手続き
cdr
;; パラメーター
z
;; 本体
(z 'cdr)

;; 手続き
set-car!
;; パラメーター
z
new-value
;; 本体
((z 'set-car!) new-value)
z

;; 手続き
set-cdr!
;; パラメーター
z
new-value
;; 本体
((z 'set-cdr!) new-value)
z

;; 大域環境
(define x (cons 1 2))
;; 手続き
x
;; パラメーター
m
;; 本体
(cond ((eq? m 'car) 1)
      ((eq? m 'cdr) 2)
      ((eq? m 'set-car!) set-x!)
      ((eq? m 'set-cdr!) set-y!)
      (else (error "Undefined operation -- CONS" m)))

;; 大域環境
(define z (cons x x))
;; 手続き
z
;; パラメーター
m
;; 本体
(cond ((eq? m 'car) x)
      ((eq? m 'cdr) x)
      ((eq? m 'set-car!) set-x!)
      ((eq? m 'set-cdr!) set-y)
      (else (error "Undefined operation -- CONS" m)))

;; 大域環境
(set-car! (cdr z) 17)

;; E1 -> 大域環境
z: (cdr z)
new-value: 17

(cond ((eq? 'cdr 'car) x)
      ((eq? 'cdr 'cdr) x)
      ((eq? 'cdr 'set-car!) set-x!)
      ((eq? 'cdr 'set-cdr!) set-y)
      (else (error "Undefined operation -- CONS" 'cdr)))

z: x
new-value: 17

(set-car! x 17)
((x 'set-car!) 17)

((cond ((eq? set-car! 'car) 1)
       ((eq? set-car! 'cdr) 2)
       ((eq? set-car! 'set-car!) set-x!)
       ((eq? set-car! 'set-cdr!) set-y!)

       (else (error "Undefined operation -- CONS" set-car!)))
 17)

(set-x! 17)

x: 17

;; 大域環境
(car x)

;; E2 -> 大域環境
z: x

((cond ((eq? 'car 'car) x)
       ((eq? 'car 'cdr) x)
       ((eq? 'car 'set-car!) set-x!)
       ((eq? 'car 'set-cdr!) set-y)
       (else (error "Undefined operation -- CONS" 'car)))
 'car)

x
17

コード(BBEdit, Emacs)

sample3_20.scm

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

(define (cons x y)
  (define (set-x! v) (set! x v))
  (define (set-y! v) (set! y v))
  (define (dispatch m)
    (cond ((eq? m 'car) x)
          ((eq? m 'cdr) y)
          ((eq? m 'set-car!) set-x!)
          ((eq? m 'set-cdr!) set-y!)
          (else (error "Undefined operation -- CONS" m))))
  dispatch)

(define (car z) (z 'car))
(define (cdr z) (z 'cdr))

(define (set-car! z new-value)
  ((z 'set-car!) new-value)
  z)
(define (set-cdr! z new-value)
  ((z 'set-cdr!!) new-value)
  z)

(define x (cons 1 2))
(define z (cons x x))

(for-each print
          (list (set-car! (cdr z) 17)
                (car x)))

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

$ ./sample3_20.scm 
#<closure (cons dispatch)>
17
$