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-07

KMRCLを眺める(201) CLASS-SLOT-NAMES

| 22:21 | KMRCLを眺める(201) CLASS-SLOT-NAMES - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(201) CLASS-SLOT-NAMES - わだばLisperになる

今回は、KMRCLのequal.lispからCLASS-SLOT-NAMESです。

名前からするとクラスのスロット(他の言語でいうメンバー変数のことをLISP系ではスロットと呼ぶ)の名前を取得するもののようです。

(defun class-slot-names (c-name)
  "Given a CLASS-NAME, returns a list of the slots in the class."
  #+(or allegro cmu lispworks sbcl scl)
  (mapcar #'kmr-mop:slot-definition-name
          (kmr-mop:class-slots (kmr-mop:find-class c-name)))
  #+(and mcl (not openmcl))
  (let* ((class (find-class c-name nil)))
    (when (typep class 'standard-class)
      (nconc (mapcar #'car (ccl:class-instance-slots class))
             (mapcar #'car (ccl:class-class-slots class)))))
  #-(or allegro lispworks cmu sbcl scl (and mcl (not openmcl)))
  (declare (ignore c-name))
  #-(or allegro lispworks cmu sbcl scl (and mcl (not openmcl)))
  (error "class-slot-names is not defined on this platform")
  )

定義の内容としては、

(MAPCAR #'closer-mop:SLOT-DEFINITION-NAME 
        (closer-mop:CLASS-SLOTS (FIND-CLASS 'FOO)))

というのが本体で、MOPの領域になりますが、

  1. FIND-CLASSでCLASSを取り出して
  2. CLASS-SLOTSでSLOTを取り出して(リスト)
  3. SLOT-DEFINITION-NAMEで名前を得る

という感じです。

動作は、

(DEFSTRUCT FOO X Y Z)
(KL::CLASS-SLOT-NAMES 'FOO)
;⇒ (X Y Z)

(DEFCLASS BAR ()
  (A B C))

(CLOSER-MOP:FINALIZE-INHERITANCE (FIND-CLASS 'BAR))

(KL::CLASS-SLOT-NAMES 'FOO)
;⇒ (A B C)

というところ

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20100907