Let's start Scheme

2013-12-28

change-class

MOP ACに参加してしまったのでMOPサポートを手厚くしたいなぁという欲求が勝手に高まってきている。サポートしていない機能のもっとも大きなものとしてchange-classとクラスの再定義がある。個人的にどちらもあまり(サポートしてないのだから当然だが)使わない機能で今一どういうものかよく分かっていない。とりあえず、オリジナルのAMOPを当たってみることにした。

AMOPで使われているソースはclossette.lispと呼ばれるものらしく、ググって見るとまぁ簡単に見つかった。これとか。

っで、とりあえず、change-classの骸骨だけ作ってみたのが以下。
(import (rnrs) (clos user) (clos core)
        (sagittarius)
        (sagittarius control))

(define (slot-exists? obj slot)
  (slot-exists-using-class? (class-of obj) obj slot))

(define-method slot-exists-using-class? (class obj slot)
  (not (not (assq slot (class-slots class)))))

(define-method change-class ((old <object>) (new-class <class>) :rest initargs)
  (let ((new (allocate-instance new-class initargs)))
    (dolist (slot-name (map slot-definition-name (class-slots new-class)))
      (when (and (slot-exists? old slot-name)
                 (slot-bound? old slot-name))
        (slot-set! new slot-name (slot-ref old slot-name))))
    ;; TODO
    ;;(%swap-slots new old)
    ;;(%swap-class new old)
    (apply update-instance-for-different-class new old initargs)
    old))

(define-method update-instance-for-different-class
  ((old <object>) (new <object>) :rest initargs)
  (let ((added-slots (remove (lambda (slot-name)
                               (slot-exists? old slot-name))
                             (map slot-definition-name 
                                  (class-slots (class-of new))))))
    (apply shared-initialize new added-slots initargs)))

(define-method shared-initialize ((instance <object>) slot-names :rest all-keys)
  (dolist (slot (class-slots (class-of instance)))
    (let ((slot-name (slot-definition-name slot))
          (init-key   (slot-definition-option slot :init-keyword #f))
          (init-value (slot-definition-option slot :init-value #f))
          (init-thunk (slot-definition-option slot :init-thunk #f)))
      ;; init-keyword is the strongest
      (cond ((and init-key (get-keyword init-key all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-value (get-keyword init-value all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-thunk (get-keyword init-thunk all-keys #f))
             => (lambda (v) (slot-set! instance slot-name (v)))))))
  instance)
ほぼオリジナルのコピー。違いはオリジナルはrotatefでスロットとクラスも変更できるがSagittariusではそんなことできないので本体に何かしら手を入れる必要があるといった点と、shared-initializeが美しくない点か。(普通にinitialize呼び出せばいいじゃん、と思ったのだが、そうすると引数チェックとかがユーザーによって定義されていると嬉しくないのだろう。実際多分嬉しくない)

っで多分以下のように使える(予定)。
(define-class <member> ()
  ((name       :init-keyword :name)
   (occupation :init-keyword :occupation)))

(define-class <member2> ()
  ((first-name :init-keyword :first-name)
   (last-name  :init-keyword :last-name)
   (occupation :init-keyword :occupation)
   ))

(define m (make <member> :name "Takashi" :occupation "Programmer"))

(change-class m <member2> :last-name "Kato" :first-name "Takashi")
CLHSのchange-classにある例では明示的に呼んでいるのでこうあるべきなのだろう。

closseteではクラスの再定義は禁止してるみたいなんだけど、CL、Gaucheともに同名のクラスが既にあった場合クラスの再定義プロセスが走るみたいだが、これどうしたものかな。

4 comments:

Shiro Kawai said...

目的によりますね…CLのクラス再定義は、ずーっとREPLが走ってる開発環境でクラスの定義を変えて読み込ませたらこれまでのインスタンスも新しいクラスに変化してほしい、ってな動機があると思います。(この変形で、永続化されたオブジェクトについてソースのクラス定義が変わったら保存してあったインスタンスも自動的に変化してくれる、なんてのもあります)。

最近は定義を変えるごとにREPL再立ち上げしても問題にならないことが多いので、クラス再定義みたいな機能の必要性は減ってるんじゃないかと思います。サーバだって「たくさん走らせといて順番に入れ替えてけばいい」(Pythonに転向したPeter Norvigが、ILCで「Lispの動的特性が欲しくならないか」と聞かれた時の答え) ので。

kei said...

まさにそこなんですよね。クラスの再定義が動的にできて嬉しい場面というのが思いつかないです。(クラスは静的に作られるというイメージが大きいというのもあるとは思うのですが。)

Shiro Kawai said...

プロセスの再起動が速くなって「メモリ上のイメージを保持してこねこね変えてゆくより、staticなソース変えたら動的なメモリイメージは再構築すればいいっしょ」という時代になったわけですが、今後(1)主記憶が永続的になる(2)柔軟なUIなど、参照すべき可塑的な学習データが巨大になる、という時代になったら、再びイメージをメモリに置いたままゆるやかに変えてゆくというモデルが復活するかもしれません。

kei said...

(2)のオプションは富豪的プログラミングの行き着く先とかにありそうですね。ただ、そういう場合だとクラスの定義よりはデータの持ち方の方が変わっていくのかなぁという気もしないではないですが。(全てはメモリ上にあるデータだと言ってしまえはそれまでなんですけど。)

Post a Comment