Serendip

Web Studio

問題2.84

2つの型を引数にとり "型の塔" の中でより高い方の型を返す手続き。
"型の塔" に新レベルを追加するには (tower '(complex real rational scheme-number)) に型を追加すればよい。

(define (higher-type x y)
  (let ((tower '(complex real rational scheme-number))) ;; 型の塔
       (define (iter twr)
         (if (null? twr)
             #f
             (cond ((eq? x (car twr)) x)
                   ((eq? y (car twr)) y)
                   (else (iter (cdr twr))))))
       (iter tower)))

2つの数からなるリストとり、より高い方の型に合わせて型変換したリストを返す手続き。

(define (coerce-higher-type items)
  (let ((item1 (car items))
        (item2 (cadr items)))
       (let ((type1 (type-tag item1))
             (type2 (type-tag item2)))
            (if (eq? type1 type2)
                items
                (let ((tag (higher-type type1 type2)))
                     (if (eq? tag type1)
                         (coerce-higher-type (list item1 (raise item2)))
                         (coerce-higher-type (list (raise item1) item2))))))))

raise 演算を使った apply-generic 手続き。

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
       (let ((proc (get op type-tags)))
            (if proc
                (apply proc (map contents args))
                (if (= (length args) 2)
                    (let ((type1 (car type-tags))
                          (type2 (cadr type-tags)))
                         (if (eq? type1 type2)
                             (error "E1. No method for these types" (list op type-tags))
                             (let ((coerced-args (coerce-higher-type args)))
                                  (let ((proc (get op (map type-tag coerced-args))))
                                       (if proc
                                           (apply proc (map contents coerced-args))
                                           (error "E2.No method for these types" (list op type-tags)))))))
                    (error "E3. No method for these types" (list op type-tags)))))))

実行結果

(define i 2)
(define r (make-real 2.0))
(define ra (make-rational 1 2))
(define c (make-complex-from-real-imag 1 3))

(higher-type (type-tag i) (type-tag r))
gosh> real
(higher-type (type-tag r) (type-tag ra))
gosh> real
(higher-type (type-tag i) (type-tag ra))
gosh> rational
(higher-type (type-tag i) (type-tag c))
gosh> complex

(coerce-higher-type (list r i))
gosh> ((real . 2.0) (real . 2.0))
(coerce-higher-type (list c ra))
gosh> ((complex rectangular 1 . 3) (complex rectangular 0.5 . 0))
(coerce-higher-type (list ra i))
gosh> ((rational 1 . 2) (rational 2 . 1))

(add i r)
gosh> (real . 4.0)
(add i ra)
gosh> (rational 5 . 2)
(add r c)
gosh> (complex rectangular 3.0 . 3)

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る