SICP 問題 2.82（可変長引数の手続きに対するapply-genericの一般化）

Scheme SICP

問題

多くの引数を持つ一般の場合に、強制型変換が使えるよう、apply-genericをどう一般化すればよいか示せ。一つの戦略は全ての引数を第一引数の型、次に第二引数の型等々強制変換を試みることである。この戦略が（そして上の第二引数版が）十分に一般的で無い状況の例をあげよ。（ヒント：表の中に試みられない何か適当な混合型の演算がある場合を考えよ。）

解答

前問は、引数２つだけだったが、今度は可変長引数でapply-genericを定義せよとな。


疑問が一つ。
例えば「有理数、整数、複素数、実数」の順序の４つの引数を持つ演算があったとすると、一発目、「有理数」をベースに、その他の値を「有理数に強制型変換」させてみると、第２引数の「整数」は有理数にできるが、第３引数、第４引数は強制型変換できないのでそのまま放置する。が、これを繰り替えしていくと以下のケースでの「※」部分はどうなるんだろう。。２階層以上上位への変換はできる、って解釈でいいんだろうか。。



元データ　　　　　：( 有理数    整数   複素数   実数  )

　　　　　　　　　　　　　　　　 ↓　　　 ↓×　    ↓×

第一引数の型で変換：( 有理数  [有理数] 複素数   実数  )

　　　　　　　　　　　　　 　　　↓　　　 ↓×　    ↓×

第二引数の型で変換：( 有理数   有理数  複素数   実数  )

　　　　　　　　　　　　?　　　　?　　　 　      ↓　　　←(※「?」の箇所は、２階層以上の上位の型への変換になる。。)

第三引数の型で変換：([複素数] [複素数] 複素数 [複素数])

　　　　　　　　　　　　↓　　　　↓　　　 　      ↓

第四引数の型で変換：( 複素数   複素数  複素数  複素数 )
もっと簡単に言うと、complexパッケージには自分より下位の型全ての型変換手続き、
  • 整数からの強制型変換手続き
  • 有理数からの強制型変換手続き
  • 実数からの強制型変換手続き
が定義されていて、realパッケージにはやはり自分より下位の型全ての型変換手続き、
  • 整数からの強制型変換手続き
  • 有理数からの強制型変換手続き
が定義されているという解釈で良いのか、ということ。
ま、「自分より下位の型情報は解釈できて変換できるよ」と考えるのはそんなに不自然なことじゃないわな。
とりあえずここではそういう解釈でapply-genericを再定義してみることにしよう。


では早速。

(define (apply-generic op . args)
  ;引数を受け取り、該当する引数に適した手続きを返却する
  (define (get-proc args)
    (let ((type-tags (map type-tag args)))
      (get op type-tags)))

  ;指定した型タグを使ってargsリストのデータを強制型変換する。
  (define (convert-types-by target-type-tag args)
    (map (lambda (arg)
       (if (eq? target-type-tag (type-tag arg))
           ;型タグが等しければそのままデータを返却
           arg
           ;異なる型タグだった場合は強制型変換処理を行う。
           (let ((proc (get-coercion (type-tag arg) target-type-tag)))
         (if proc
             ;該当する強制型変換手続きが存在した場合は変換したデータを返却
             (proc arg)
             ;手続きが存在しなかった場合はデータをそのまま返却
             arg))))
     args))

  ;強制型変換を行い、その結果をリストで返却する。
  (define (convert-types args)
    (let loop ((dst args)  ;型変換後の結果
           (index 0))  ;どの引数まで型変換が進んだか。
      (if (< index (length dst))
      ;インデックス内の場合は変換後のdstで、指定要素の型を使って変換を行う。
      (loop (convert-types-by (type-tag (ref dst index)) dst)
        (+ 1 index))
      ;最後の要素まで変換してきた場合は最終変換結果を返却する
      dst)))

  ;メイン処理。まずは受け取った引数でそのままチェック。
  (let ((proc (get-proc args)))
    (if proc
    ;ヒットしたらそれを適用
    (apply proc (map contents args))
    ;ヒットしなかったら強制型変換して適用可能な手続きを探す。
    (let* ((args1 (convert-types args))
           (proc1 (get-proc args1)))
      (if proc1
          (apply proc1 (map contents args1))
          (error "No method for these types"
             (list op type-tags)))))))

こんな感じでいけるんじゃないかなぁ。put-coercionとget-coercionを実装してないから試せないけど。。
以前にputとgetやった時はパッケージ関連の全体像がまったく理解できてなくて、結果的に自分が何をやっているかすらわからなかったからhashtableまで実装して実験してみたけど、今回は一応理解できてるからなぁ。やらなくていっか。
多分実際に動かしてみたら、ここで定義したapply-genericにバグは存在するだろうけど、概念的には合ってると思うのでよしとしてしまおう。先に進みたいし。