SICP 読み (59) 2.5.1 汎用算術演算

なんとなく方向性は見えてるんで問題 2.78 は楽かも。

問題 2.78

修正した部分のみ、以下に。

(define (type-tag datum)
  (cond ((number? datum) 'scheme-number)
	((pair? datum) (car datum))
	(else
	 (error "Bad tagged datum -- TYPE TAG" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
	((pair? datum) (cdr datum))
	(else
	 (error "Bad tagged datum -- CONTENTS" datum))))

(define (install-scheme-number-package)
  (put 'add '(scheme-number scheme-number) 
       (lambda (x y) (+ x y)))
  (put 'sub '(scheme-number scheme-number)
       (lambda (x y) (- x y)))
  (put 'mul '(scheme-number scheme-number)
       (lambda (x y) (* x y)))
  (put 'div '(scheme-number scheme-number)
       (lambda (x y) (/ x y)))
  (put 'make 'scheme-number
       (lambda (x) x))
  'done)

put するのは + とか - でも良いような気が。

(define (install-scheme-number-package)
  (put 'add '(scheme-number scheme-number) +)

  (put 'sub '(scheme-number scheme-number) -)

  (put 'mul '(scheme-number scheme-number) *)

  (put 'div '(scheme-number scheme-number) /)

  (put 'make 'scheme-number
       (lambda (x) x))
  'done)

これでも OK でした。試験ですが、以前載せたコードは car とか cdr 使ってるので使い物にならず。以下のように修正。

  ("scheme-number test"
   (setup (lambda () (install-scheme-number-package)))
   ("make-scheme-number test"
    (assert-equal 'scheme-number (type-tag (make-scheme-number 5)))
    (assert-equal '5 (contents (make-scheme-number 5)))
    )

   ("add test"
    (assert-equal 'scheme-number (type-tag (add (make-scheme-number 1)
						(make-scheme-number 2))))
    (assert-equal 3 (contents (add (make-scheme-number 1)
				   (make-scheme-number 2))))
    )

   ("sub test"
    (assert-equal 'scheme-number (type-tag (sub (make-scheme-number 5)
						(make-scheme-number 2))))
    (assert-equal 3 (contents (sub (make-scheme-number 5)
				   (make-scheme-number 2))))
    )

   ("mul test"
    (assert-equal 'scheme-number (type-tag (mul (make-scheme-number 3)
						(make-scheme-number 2))))
    (assert-equal 6 (contents (mul (make-scheme-number 3)
				   (make-scheme-number 2))))
    )

   ("div test"
    (assert-equal 'scheme-number (type-tag (div (make-scheme-number 6)
						(make-scheme-number 2))))
    (assert-equal 3 (contents (div (make-scheme-number 6)
				   (make-scheme-number 2))))
    )
   )

で、これなんですがメソッドのオーバーロードじゃん、と。(今頃
scheme の算術演算子、という意味ではなくて、add と sub とかの手続きが、という事です。あ、違うな。クラスが違うからオーバーロードにはならん。むしろ用意されたインターフェースをオーバーライドする、というのに似てるのかな??