SICP 読み (63) 2.5.2 異る型のデータの統合

この節はハードル高そう。とりあえずコツコツと片づけていきたいんですが、先は全然見えてません。とりあえず、p.115 にある apply-generic 周辺の試験をしてみよう。
とは言え、とりあえず put-coercion とか get-coercion などの動作確認を先に。手続きの定義は以下で OK か。(局所表な make-table 手続きは定義済みが前提)

(define coercion-table (make-table))
(define get-coercion (coercion-table 'lookup-proc))
(define put-coercion (coercion-table 'insert-proc!))

しまった。試験ドリブンなのに先に手続きを書いてしまった。試験確認なソレとしては以下か。(p.114 の scheme-number->complex が本体に盛り込まれているのが前提)

 ("coercion test"
  (setup (lambda () 
	   (install-scheme-number-package)
	   (install-complex-package)
	   (install-rectangular-package)))
  ("put-coercion test (1)"
   (assert-equal 'ok 
		 (put-coercion 'scheme-number 'complex scheme-number->complex))
   )

  ("put-coercion test (2)"
   (let ((dummy (put-coercion 'scheme-number 'complex scheme-number->complex)))
     (assert-false (get-coercion 'complex 'complex))
     (assert-false (get-coercion 'scheme-number 'scheme-number))
     (assert-equal scheme-number->complex
		   (get-coercion 'scheme-number 'complex))
     (assert-equal (make-complex-from-real-imag 1 0)
		   ((get-coercion 'scheme-number 'complex) 1)))
   )
  )

一応、強制型変換なソレは実装できている模様。ちなみに install-rectangular-package を忘れててハマりました。

次は改良版 apply-generic の試験か。これは先に試験を検討。整理しておく必要があるのは get が #f を返却するケース。

gosh> (install-shcme-number-package)
done
gosh> (install-complex-package)
done
gosh> (install-rectangular-package)
done
gosh> (apply-generic 'add (make-scheme-number 1) (make-complex-from-real-imag 1 1))
*** ERROR: No method for these types -- APPLY-GENERIC (add (scheme-number complex))
Stack Trace:
_______________________________________
gosh>

2.5.1 節の apply-generic だと get が偽を返却したら error にしています。で、試験をざっくり検討してみたのが以下。

 ("apply-generic-R test"
  (setup (lambda () 
	   (install-scheme-number-package)
	   (install-complex-package)
	   (install-rational-package)
	   (install-rectangular-package)
	   (put-coercion 'scheme-number 'complex scheme-number->complex)))
  ("apply-generic-R test"
   (assert-equal 3
		 (apply-generic 'add
				(make-scheme-number 1)
				(make-scheme-number 2)))
   (assert-error (lambda ()
		   (apply-generic 'add
				  (make-scheme-number 1)
				  (make-complex-from-real-imag 1 1)
				  (make-complex-from-real-imag 1 1))))
   (assert-error (lambda ()
		   (apply-generic 'add
				  (make-scheme-number 1)
				  (make-rational 1 1))))
   (assert-error (lambda ()
		   (apply-generic 'add
				  (make-rational 1 1)
				  (make-scheme-number 1))))
   (assert-equal (make-complex-from-real-imag 2 1)
		 (apply-generic 'add
				(make-scheme-number 1)
				(make-complex-from-real-imag 1 1)))
   (assert-equal (make-complex-from-real-imag 2 1)
		 (apply-generic 'add
				(make-complex-from-real-imag 1 1)
				(make-scheme-number 1)))
   )
  )

実装してみたらどうなるか。assert-error に渡す引数が引数無しの手続きという事を忘れててハマりましたが一発ツモ。(違

2 章終盤なんですが、密度が濃すぎだよ。とりあえず今日はここで止めます。次回は問題 2.81 を検討予定。