(setf getf)の定義が難しかった

getfはplistの値を操作するアクセス関数です。
取得する方の構文は、

(getf plist indicator &optional default)

みたいな感じです。
設定の方はこんな感じ。

(setf (getf place indicator &optional default) new-value)

説明では、setfでgetfを使うときにdefaultが無視されると記載されています。
ああそうなんだ、defaultは無視でいいんだなと思って、 ただ式を評価するだけで値を捨てていたのですが、 規約をちゃんと見直すと、setfマクロのときだけdefaultの意味がないのであって、 例えばincfマクロではちゃんと使うよ、と例文付きで紹介されていました。

それがこれ。

(let ((plist '()))
  (incf (getf plist 'count 0))
  plist) =>  (COUNT 1)

これ、どうやって実現するんだ？
まず(setf getf)の定義はdefunでは無理で、 必ずdefine-setf-expanderを使う必要があります。
なぜならオブジェクトに設定するのではなく、 nilの場合はplaceにconsを設定する必要があるためです。

最初はこんな感じで作成していました。

(define-setf-expander getf-error (place indicator &optional default)
  (with-gensyms (g1 g2 g3 g4)
    (multiple-value-bind (a b g w r) (get-setf-expansion place)
      (let ((g3 (car g)))
        (values
          `(,g2 ,g4 ,@a)
          `(,indicator ,default ,@b)
          `(,g1)
          `(let ((,g3 (setplist ,g2 ,g1 ,r)))
             ,w
             ,g1)
          `(getf ,r ,g2))))))

こいつはいつ見てもわかりづらい。
式自体は簡単なのですが、引数にplaceがあるので、 いったい何の値をどうしたいのか混乱してしまいます。

上記の文は、write項にsetplistという関数が使われていますが、 これはplistの設定関数です。
こんな感じ。

(defun setplist (key value list) ...)

もしlistにkeyがあればvalueを設定し直し、 listにkeyが無ければ(key value)をlistに追加して返却するというもの。
Lispで書けばごちゃごちゃしてわかりづらいですが次のようになります。

(defun setplist (key value list)
  (do ((next list))
    ((null next)
     (list* key value list))
    (destructuring-bind (x y . tail) next
      (when (eql x key)
        (setf (cadr next) value)
        (return list))
      (setq next tail))))

ではdefaultを追加する場合はどのように修正したらよいでしょうか。
最初はsetplist関数にdefault引数を追加しようと思ったのですが、これは間違い。
setplistの値はvalueに設定するともう決まっているのですから。

変更はreaderの項に行います。
つまり、

`(getf ,r ,g2)

ではなく、もしlistにkeyが無かったら、defaultを返却するように変更します。
変更内容は下記の通り。

`(multiple-value-bind (,g5 ,g6 ,g7) (get-properties ,r (list ,g2))
   (declare (ignore ,g5))
   (if ,g7
     ,g6
     ,g4))

【追記します】
よく考えたら、こんなことしなくても次の書き換えでいいんですね。

`(getf ,r ,g2 ,g4)

何で思いつかなかったのか。
では完成したgetfのdefine-setf-expanderを下記に示します。

(define-setf-expander getf! (place indicator &optional default)
  (with-gensyms (g1 g2 g3 g4)
    (multiple-value-bind (a b g w r) (get-setf-expansion place)
      (let ((g3 (car g)))
        (values
          `(,g2 ,g4 ,@a)
          `(,indicator ,default ,@b)
          `(,g1)
          `(let ((,g3 (setplist ,g2 ,g1 ,r)))
             ,w
             ,g1)
          `(getf ,r ,g2 ,g4))))))

実行してみましょう。

(let (x y)
  (setf (getf! x 10 20) 30)
  (format t "~A~%" x)
  (incf (getf! y 10 20))
  (format t "~A~%" y))

結果は下記の通り。

(10 30)
(10 21)

うまく行きました。

普通だったら、defaultを無視するなんて発想は出てこないと思います。
だって引数に意味がないなら規約で削除しているはずじゃない？
そう思わなかった理由が(setf macro-function)です。

macro-function関数は&optionalでenvironmentを受け取ります。
同じように(setf macro-function)もenvironmentがあるのですが、 setfの方に限りenvironmentが指定されている場合はエラーか無視されます。
sbclはエラーで、clisp, cclは無視されました。

無視の意味としては、macroletのマクロ関数を変更することができないということです。
なぜ意味のない引数が規約として生きているのかは知りませんが、 この例がずっと頭の中にあったため、 「(setf ...)の&optionalは意味がない場合がある」と何となく勘違いしてしまいました。