Scheme - 抽象データの多重表現(強制型変換、型の塔とレベルを下げる手続き、新しい数の追加とシステムの修正)

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• プログラミング言語: MIT/GNU Scheme

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.5(汎用演算のシステム)、2.5.2(異なる型のデータの統合)、強制型変換、型の階層構造、階層構造の不適切さの問題 2.85、問題 2.86を解いてみる。

その他参考書籍

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

問題 2.85

コード

sample.scm

;; apply-generic op . args
          (if proc
              (drop (apply proc (map contents args-1)))
              (error "No method for these types"
                     (list op type-tags))))))))


;; 汎用に実装
(define (project x) (apply-generic 'project x))
(define (drop x)
  (let ((projected (project x)))
    (if (equ? x (raise projected))
        (drop projected)
        x)))

;; install-rational-package
  (define (rational->integer x)
    (make-integer (round (* 1.0 (/ (numer x)
                                   (denom x))))))
  (put 'project '(rational) rational->integer)

;; install-real-package
  (define (real->integer x) (make-integer (round x)))
  (put 'project '(real) real->integer)

;; install-complex-package
  (define (complex->real z) (make-real (real-part z)))
  (put 'project '(complex) complex->real)

問題 2.86

コード

sample.scm

;; 汎用
(define (sine x) (apply-generic 'sine x))
(define (cosine x) (apply-generic 'cosine x))

;; install-integer-package
  (put 'sine '(integer)
       (lambda (x) (tag (sin x))))
  (put 'cosine '(integer)
       (lambda (x) (tag (cos x))))

;; install-rational-package
  (put 'sine '(rational)
       (lambda (x) (tag (sin x))))
  (put 'cosine '(rational)
       (lambda (x) (tag (cos x))))

;; install-real-package
  (put 'sine '(real)
       (lambda (x) (tag (sin x))))
  (put 'cosine '(real)
       (lambda (x) (tag (cos x))))

;; install-rectangular-package
  (define (make-from-mag-ang r a)
    (cons (mul r (cosine a)) (mul r (sine a))))

;; install-polar-package
  (define (real-part z)
    (mul (magnitude z) (cosine (angle z))))
  (define (imag-part z)
    (mul (magnitude z) (sine (angle z))))