compute-effective-slot-definition の第三引数がリストであることの理由

どうして compute-effective-slot-definition の第三引数が direct-slot-definition ではなく direct-slot-definition のリストなんだろう？ と不思議に思っていた。リストだとディスパッチできないじゃないか、って。

Elephant のソースにこんなコメントを見つけた。

    ;; Effective slots are indexed only if the most recent slot definition
    ;; is indexed.  NOTE: Need to think more about inherited indexed slots

なるほど、継承関係で同じスロット名が複数あったときのためにリストなんだ。

(defclass a ()
  ((s1 :initarg :s1 :initform "a" :accessor s1)))

(defclass b ()
  ((s1 :initarg :s1 :initform "b" :accessor s1)))

(defmethod sb-mop:compute-effective-slot-definition :before
  ((class standard-class)
   slot-name
   direct-slot-definitions)
  (print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
  (mapc #'describe direct-slot-definitions)
  (print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"))

(defclass c (b a)
  ())

(make-instance 'c)

#|
"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
  [standard-object]

Slots with :INSTANCE allocation:
  NAME                  = S1
  INITFORM              = "b"
  INITFUNCTION          = #<FUNCTION (LAMBDA ()) {1004B24749}>
  READERS               = (S1)
  WRITERS               = ((SETF S1))
  INITARGS              = (:S1)
  %TYPE                 = T
  %TYPE-CHECK-FUNCTION  = NIL
  %DOCUMENTATION        = NIL
  %CLASS                = #<STANDARD-CLASS B>
  ALLOCATION            = :INSTANCE
  ALLOCATION-CLASS      = NIL
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
  [standard-object]

Slots with :INSTANCE allocation:
  NAME                  = S1
  INITFORM              = "a"
  INITFUNCTION          = #<FUNCTION (LAMBDA ()) {1004B18B99}>
  READERS               = (S1)
  WRITERS               = ((SETF S1))
  INITARGS              = (:S1)
  %TYPE                 = T
  %TYPE-CHECK-FUNCTION  = NIL
  %DOCUMENTATION        = NIL
  %CLASS                = #<STANDARD-CLASS A>
  ALLOCATION            = :INSTANCE
  ALLOCATION-CLASS      = NIL

"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|#

リストであることの理由は納得できたけど、どうにもスロットのクラスによってディスパッチしにくいことについては、納得いかない。

manardb でも苦肉のスペシャル変数で回避しているようだし。どうにかならないものでしょうか。

(defvar *mop-hack-effective-slot-definition-class* nil) ;; as compute-effective-slot-definition-initargs is not available portably

といいつつも、manardb でやっているように、なんとか回避できる手段があるところが Common Lisp のいいところだよね。

X Server DPI

X Server DPI に書かれている。

~/.Xresources に Xft.dpi: 96 を追加する。

Emacs*useXIM: false
Xft.dpi: 96

しかし↓の 132 はどこからきているんだろう？

~% xdpyinfo | grep reso
  resolution:    131x132 dots per inch

/var/log/Xorg.0.log に↓とあった。

(--) Feb 04 23:34:48 NVIDIA(0): DPI set to (131, 132); computed from "UseEdidDpi" X config

UseEdidDpi って何だろう？

allocate-instance と class-prototype

Common Lisp でのクラスメソッド にかんして Jianshi Huang さんに allocate-instance を使うというのを教えてもらった。ありがとうございます。

make-instance を使うと、initialize-instance :after あるいは shared-initialize が呼ばされるので、よくない気がします。 (allocate-instance (find-class 'foo)) を使った方がいいと思います。

そういえば class-prototype なんてのもあった。 http://www.gigamonkeys.com/book/object-reorientation-classes.html には次のように書かれていた。

class-prototype, that returns an instance of a class that can be used to access class slots.

そうか :allocation :class したスロットについても一緒に考えなきゃいけないんだ。

curl で BASIC 認証で POST

curl --basic --user user:password --form-string 'experience[title]=aaa' --form-string 'experience[content]=bbb' 'http://www.example.com/spots/961/experiences.xml'

ポストデータをファイルから読み込む方法もあるらしい。

Common Lisp でのクラスメソッド

#|
Common Lisp でのクラスメソッド。
Common Lisp は (defclass foo ... のようにしても foo には何も束縛されない。
そうするとクラスメソッドを実装するにあたって困ってしまう。
|#

(defclass foo () ())
;; #<STANDARD-CLASS FOO>

(defclass bar (foo) ())
;; #<STANDARD-CLASS BAR>


#|
eql スペシャライザを使ってクラスメソッドを定義する。
|#
(defmethod f1 ((x (eql (find-class 'foo))))
  (class-name x))
;; #<STANDARD-METHOD F1 ((EQL #<STANDARD-CLASS FOO>)) {1005489BA1}>

(f1 (find-class 'foo))
;; FOO

(f1 (find-class 'bar))
;; bar クラスを渡してもエラー

(f1 (make-instance 'foo))
;; インスタンスを渡してもエラー

(f1 (class-of (make-instance 'foo)))
;; FOO

#|
eql スペシャライザを使うのは find-class がめんどうだ。
そういえば make-instance はシンボルを引数にとる。
|#

(defmethod f2 ((x (eql 'foo)))
  (class-name x))
;; #<STANDARD-METHOD F1 ((EQL #<STANDARD-CLASS FOO>)) {1005489BA1}>

(f2 'foo)
;; エラー

#|
シンボルだから class-name は適用できない。
あくまでもシンボルとして扱わなければならない。

それじゃ defclass の戻り値はクラス自身だから、それを defparameter で束縛してしまおう。
これで find-class は必要なくなる。
|#

(defparameter baz (defclass baz () ()))
;; BAZ

baz
;; #<STANDARD-CLASS BAZ>

(defmethod f3 ((x (eql baz)))
  (class-name x))
;; #<STANDARD-METHOD F3 ((EQL #<STANDARD-CLASS BAZ>)) {1003E08771}>

(f3 baz)
;; BAZ

#|
これでもまだ eql がわずらわしい。

こうなったらメタクラスを使ってみよう。
|#

(defclass my-class (standard-class) ())
;; #<STANDARD-CLASS MY-CLASS>

(defmethod sb-mop:validate-superclass ((class my-class) (super standard-class))
  t)
;; #<STANDARD-METHOD SB-MOP:VALIDATE-SUPERCLASS (MY-CLASS STANDARD-CLASS) {10039FC841}>

(defparameter hoge (defclass hoge ()
                     ()
                     (:metaclass my-class)))
;; HOGE

hoge
;; #<MY-CLASS HOGE>

(defparameter huga (defclass huga ()
                     ()
                     (:metaclass my-class)))
;; HUGA

huga
;; #<MY-CLASS HUGA>

(defmethod que ((x my-class))
  (class-name x))
;; #<STANDARD-METHOD QUE (MY-CLASS) {1004B746D1}>

(que hoge)
;; HOGE

(que huga)
;; HUGA

#|
あるいは
|#

(defmethod que ((x symbol))
  (que (find-class x)))
;; #<STANDARD-METHOD QUE (SYMBOL) {1004AA3471}>

(que 'hoge)
;; HOGE

(que 'huga)
;; HUGA

#|
どれもいまいち。すっきりしない。
Common Lisp でのクラスメソッドはどう定義したらいいのだろう？
|#