values への setf

xyzzy lisp

defsetf とか define-setf-method とかの使い方はよく知らんのだけど、まぁ何とかなるかなーと思ってた。世の中そんなに甘くなかった。

define-setf-method

(setf (access-fn args) new-value)

とゆー風に呼び出される access-fn への setf を定義する define-setf-method は

(define-setf-method access-fn <lambda-list>
  ...)

で定義するんだけど、setf 呼び出しの args が define-setf-method の に渡されて、define-setf-method の body 部分で

  • (temp-var-1 temp-var-2 ...)
  • (value-form-1 value-form-2 ...)
  • (store-var)
  • storing-form
  • access-form

の5つを多値で返すことになってる。

実際に setf 式を評価（展開）すると

define-setf-method で定義された関数を呼び出して返ってきたこの5つのリストやら式やらが、setf の展開形として最終的にはこんな感じで使われる。access-form がなにに使われるのかはわからない。

(let* ((temp-var-1 value-form-1)
       (temp-var-2 value-form-2)
       ...
       (store-var new-value))
  storing-form)

とゆーわけで、(setf (values ...) new-value) をどーにかしようとしても、setf の展開形は new-value を let* で受け取ってるんで２つ目以降は捨てられてしまう。dead end

setf.l

define-setf-method の store-var がリストになっているのは、将来多値に対応することができるように、とゆー理由だと聞いたことがあるような気がしたので、対応させてみる。

最終的に

(let* ((temp-var-1 value-form-1)
       (temp-var-2 value-form-2)
       ...)
  (multiple-value-bind (store-vars) new-value
    storing-form))

になればおｋなはず。

まず setf-expand-1 の最後

        (if (or vars stores)
            `(let* ,(mapcar #'list vars vals)
               (multiple-value-bind ,stores ,(car newvalue)
                 ,store-form)))
          store-form)))))

get-setf-method 内で stores が複数あったらエラー投げちゃってくれてるのでやめれ。

optimize-setf-method がなぜか stores の cdr を捨ててしまってくれやがる。この関数は元の setf-expand-1 だと (let* ((var val) ...) ...) の val が定数や変数（symbol）だったら、いちいち var に束縛するんじゃなくて store-form に埋め込んでしまえ、ということをしてるようだ。はんはん、なるほど。

めんどいので stores/newvalues は触らずそのまま返すようにした。以下は、ちゃんとやる気になったときのためのメモ:

  • newvalues は (<多値を返す式>) なので、cdr は常に nil（car しかない）なはず
    • 回すなら stores の各要素と (cdar newvalues) の各要素
  • (car newvalues) が '(values ...) なら
    • (multiple-value-bind (values ) )
    • と の対応が取れてる＆ が constant/symbol なら store-form を置換して、, から削除していい。
    • が足りない＝ が余る分は、store-form の余った を nil に置換可能。
    • が足りない＝ が余る分は、単に余った が不要。
    • , が無くなったら、multiple-value-bind が不要。

ついでに、というかその前に

  • setf-expand-1 で問答無用で multiple-value-bind にしてるが、そもそも stores が1つだけなら元の let* で無問題。
(define-setf-method values (&rest places)
  (let ((syms (mapcar #'gensym places)))
    (values nil nil syms
            (cons 'setf
                  (mapcan #'list places syms)))))
=> (setf values)

(setf (values foo bar baz) (values 1 2 3))
=> 3

(list foo bar baz)
=> (1 2 3)

(setf (values foo bar baz) (values-list '(x y z)))
=> z

(list foo bar baz)
=> (x y z)

おｋ