Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-09-08

KMRCLを眺める(202) GENERALIZED-EQUAL-FIELDED-OBJECT

| 12:51 | KMRCLを眺める(202) GENERALIZED-EQUAL-FIELDED-OBJECT - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(202) GENERALIZED-EQUAL-FIELDED-OBJECT - わだばLisperになる

今回は、KMRCLのequal.lispからGENERALIZED-EQUAL-FIELDED-OBJECTです。

今回も、名前からしてクラス/構造体の同値性を判定するものと思われます。

定義は、

(defun generalized-equal-fielded-object (obj1 obj2)
  (block test
    (when (not (equal (class-of obj1) (class-of obj2)))
      (return-from test nil))
    (dolist (field (class-slot-names (class-name (class-of obj1))))
      (unless (generalized-equal (slot-value obj1 field) (slot-value obj2 field))
        (return-from test nil)))
    (return-from test t)))
  1. CLASS-OF でクラスを判定して一致していなかったら脱出
  2. 次に前回眺めたCLASS-SLOT-NAMESで各スロットの名前をとりだし、SLOT-VALUEで取り出した値を再帰的にGENERALIZED-EQUALですべてを比較

という感じでしょうか。

動作は、

(DEFSTRUCT FOO X Y Z)

(DEFCLASS BAR ()
  ((A :INITARG :A)
   (B :INITARG :B)
   (C :INITARG :C)))

(KL::GENERALIZED-EQUAL-FIELDED-OBJECT (MAKE-FOO :X 1 :Y 2 :Z 3)
                                      (MAKE-FOO :X 1 :Y 2 :Z 3))
;⇒ T

(KL::GENERALIZED-EQUAL-FIELDED-OBJECT (MAKE-INSTANCE 'BAR :A 1 :B 2 :C 3)
                                      (MAKE-INSTANCE 'BAR :A 1 :B 2 :C 4))
;⇒ NIL

というところ。