#1 (defun (setf ) ...)

xyzzy-lisp closette
  • CLOS に興味がわいた、というか欲しくなった
  • closette というのは CLOS の subset らしい
  • 見てみたら2000行ちょいくらいだった
  • ふるい common-lisp らしいので読めそうな雰囲気だった
  • 「誰か移植しないかな」とかどっかで見かけた

とゆーわけでやってみる。

で

(defun (setf getf*) (new-value plist key)
  ...)

みたいなのをちょくちょく使ってるんだけど、xyzzy だとそんな関数名認めないとか怒られる。ちょっとググったりしたけどはっきりしたことがわからない。というか CLHS の defun には載ってなかったんで、ひょっとしたら今は使われてない書き方なのかも。

しょうがないので使ってるコードから本来の挙動を想像して実装してみた。

(setf (access-fn arg1 arg2) value)

としたときに defun-setf した関数に value arg1 arg2 が渡されるっぽい。

defsetf に関数渡すのと一緒かなと思ったのに引数の順番が違う（defsetf で設定する update-fn だと value が最後になる）。lambda-list の方をごにょごにょしようかと思ったけどどう考えても &rest とかめんどいので、引数の順番変えるだけの関数で包むことにした。

(defmacro closette::defun (name (&rest lambda-list) &body body)
  (if (and (consp name)
           (eq (car name) 'setf)
           (symbolp (cadr name))
           (null (cddr name)))
      (let ((access-fn (cadr name)))
        ;; from lisp/setf.l::defsetf
        `(eval-when (:compile-toplevel :load-toplevel :execute)
           (si:*putprop ',access-fn (lambda (&rest #1=#:args)
                                      (apply (lambda ,lambda-list ,@body)
                                             (append (last #1#) (butlast #1#))))
                        'lisp::setf-update)
           (si:*putprop ',access-fn ,(when (stringp #2=(car body)) #2#)
                        'lisp::setf-documentation)
           (remprop ',access-fn 'lisp::setf-lambda)
           (remprop ',access-fn 'lisp::setf-method)
           '(setf ,access-fn)))
    ;; from lisp/evalmacs.l::defun
    '(let ()
      (si:*fset ',name
                (si:*set-function-name
                 #'(lambda ,lambda-list ,@body)
                 ',name)))))

ところで移植ってふつーどうやるんだろう。とりあえず元のソースを xyzzy に喰わせてエラー吐いたりしたとこを修正してく方が楽かなぁと思いつつ、手動コピーしながら「これ動かねーだろ」と思ったとこを動くように変更したりしてる。