Elispでplist-getをsetfに対応させる方法

背景

setf という便利な関数があります。

これは汎変数に対する setq と説明できるのですが、この短かい紹介では表せないほどの汎用性と利便性を提供してくれます。

汎変数についてはkawabataさんの神記事(Qiita - Emacs Lispの汎変数（とその他）)があるので、まずそちらを参照していただければと思います。

さて、問題は alist-get は汎変数として定義されているのに、なぜか plist-get の汎変数が定義されていないことです。

alist も plist もlispの基本構造で、本質的に同じなので alist だけ使えて plist だけ使えないというのは 無意味な非対称性を感じます。

今回は plist に対して setf を使えるようにすることを目的とします。

汎変数の定義

magit などの大きな(そして注意深く実装されている)パッケージを読んでいると、いきなり gv- から始まるS式を見ることがあります。

これが汎変数の定義であり、標準で提供されていない汎変数を独自に定義することができます。

汎変数の定義についてもkawabataさんの記事(Qiita - Emacs Lispの汎変数（とその他）#汎変数の定義方法)に記載があります。

ここでは gv.el の実装を参考に、汎変数を定義する方法を解説します。

gv-define-simple-setter

最も簡単なのは gv-define-simple-setter を使用できる場合です。 セッターを組み立てる際、 get <-> set / put の対応が取れている関数が用意されている場合で、単に関数シンボルを替えるだけで良い場合に使用できます。

(gv-define-simple-setter aref aset)
(gv-define-simple-setter car setcar)
(gv-define-simple-setter cdr setcdr)
(gv-define-simple-setter get put)
(gv-define-simple-setter default-value set-default)
(gv-define-simple-setter process-get process-put)

setf や rotatef はこのように展開され、意図通りにリストが変更されます。

(ppp-macroexpand-all
 (let ((target '(a b c)))
   (setf (car target) 'modify)
   target))
;;=> (let ((target '(a b c)))
;;     (let* ((v target))
;;       (setcar v 'modify))
;;     target)

(let ((target '(a b c)))
  (setf (car target) 'modify)
  target)
;;=> (modify b c)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ppp-macroexpand-all
 (let ((target '(a b c)))
   (cl-rotatef (car target) (cadr target))
   target))
;;=> (let ((target '(a b c)))
;;     (let* ((v target)
;;            (--cl-rotatef-- (car v)))
;;       (progn
;;         (setcar v
;;                 (let* ((v target))
;;                   (prog1 (car (cdr v))
;;                     (setcar
;;                      (cdr v)
;;                      --cl-rotatef--))))
;;         nil))
;;     target)

(let ((target '(a b c)))
  (cl-rotatef (car target) (cadr target))
  target)
;;=> (b a c)

gv-define-setter

gv-define-setter はセッターを組み立てる際に、単に関数シンボル置き換えでは実現できない場合に使用します。

基本的にはこのマクロを使うことになるかと思います。 なお、先程の gv-define-simple-setter は gv-define-setter を生成するマクロとして定義されていました。

(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
(gv-define-setter elt (store seq n)
  `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
     (aset ,seq ,n ,store)))
(gv-define-setter gethash (val k h &optional _d)
 `(puthash ,k ,val ,h))

gv-define-setter の使用方法は眺めていると分かってきますが、 第1引数に汎変数を定義する関数シンボル、第2引数に関数の引数、第3引数にマクロ展開部を指定します。 第2引数は先頭に変更先の値を受け取って、その後に関数の引数を並べることになっているようです。

setf や rotatef はこのように展開され、意図通りにリストが変更されます。

(ppp-macroexpand-all
 (let ((target '(a b c)))
   (setf (cadr target) 'modify)
   target))
;;=> (let ((target '(a b c)))
;;     (let* ((v target))
;;       (setcar (cdr v) 'modify))
;;     target)

(let ((target '(a b c)))
  (setf (cadr target) 'modify)
  target)
;;=> (a modify c)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ppp-macroexpand-all
 (let ((target '(a b c)))
   (cl-rotatef (cadr target) (caddr target))
   target))
;;=> (let ((target '(a b c)))
;;     (let* ((v target)
;;            (--cl-rotatef-- (car (cdr v))))
;;       (progn
;;         (setcar
;;          (cdr v)
;;          (let* ((v (cdr (cdr target))))
;;            (prog1 (car v)
;;              (setcar v --cl-rotatef--))))
;;         nil))
;;     target)

(let ((target '(a b c)))
  (cl-rotatef (cadr target) (caddr target))
  target)
;;=> (a c b)

gv-define-expander

gv-define-expander はセッターを生成する際にセッターを使いたい場合など、特別な処理を要する関数に使用します。

alist-get の汎変数はこのマクロで定義されています。

なお、先程の gv-define-setter は gv-define-expander を生成するマクロとして定義されていました。

(gv-define-expander alist-get
  (lambda (do key alist &optional default remove testfn)
    (macroexp-let2 macroexp-copyable-p k key
      (gv-letplace (getter setter) alist
        (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
                                  (assoc ,k ,getter ,testfn)
                                (assq ,k ,getter))
          (funcall do (if (null default) `(cdr ,p)
                        `(if ,p (cdr ,p) ,default))
                   (lambda (v)
                     (macroexp-let2 nil v v
                       (let ((set-exp
                              `(if ,p (setcdr ,p ,v)
                                 ,(funcall setter
                                           `(cons (setq ,p (cons ,k ,v))
                                                  ,getter)))))
                         `(progn
                            ,(cond
                             ((null remove) set-exp)
                             ((or (eql v default)
                                  (and (eq (car-safe v) 'quote)
                                       (eq (car-safe default) 'quote)
                                       (eql (cadr v) (cadr default))))
                              `(if ,p ,(funcall setter `(delq ,p ,getter))))
                             (t
                              `(cond
                                ((not (eql ,default ,v)) ,set-exp)
                                (,p ,(funcall setter
                                              `(delq ,p ,getter))))))
                            ,v))))))))))

alist-get の汎変数の定義がこのように複雑になっているのは、「alistに存在しないキーに対して setf したときにコンスセルごと追加する」という処理があるからです。

(ppp-macroexpand-all
 (let ((target '((a ."a") (b . "b") (c . "c"))))
   (setf (alist-get 'd target) "modify")
   target))
;;=> (let ((target '((a . "a") (b . "b") (c . "c"))))
;;     (let* ((p (if (and nil (not (eq nil 'eq)))
;;                   (assoc 'd target nil)
;;                 (assq 'd target))))
;;       (progn
;;         (if p
;;             (setcdr p "modify")
;;           (setq target (cons (setq p (cons 'd "modify")) target)))
;;         "modify"))
;;     target)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'a target) "modify")
  target)
;;=> ((a . "modify") (b . "b") (c . "c"))

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'd target) "modify")
  target)
;;=> ((d . "modify") (a . "a") (b . "b") (c . "c"))

「alistに存在しないキーに対して setf したときにコンスセルごと追加する」という処理が必要ない場合、 gv-define-setter を使って簡単に定義することができます。 (さらに簡単のため、 alist-get の default 、 remove 、 testfn 引数も無視します。)

(gv-define-setter alist-get (val key alist &optional _default _remove _testfn)
  `(setcdr (assq ,key ,alist) ,val))
;;=> ...

(ppp-macroexpand-all
 (let ((target '((a ."a") (b . "b") (c . "c"))))
   (setf (alist-get 'a target) "modify")
   target))
;;=> (let ((target '((a . "a") (b . "b") (c . "c"))))
;;     (let* ((v target))
;;       (setcdr (assq 'a v) "modify"))
;;     target)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'a target) "modify")
  target)
;;=> ((a . "modify") (b . "b") (c . "c"))

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'd target) "modify")
  target)
;;=> Debugger entered--Lisp error: (wrong-type-argument consp nil)
;;     setcdr(nil "modify")
;;     (let* ((v target)) (setcdr (assq 'd v) "modify"))
;;     (setf (alist-get 'd target) "modify")
;;     (let ((target '((a . "a") (b . "b") (c . "c")))) (setf (alist-get 'd target) "modify") target)
;;     (progn (let ((target '((a . "a") (b . "b") (c . "c")))) (setf (alist-get 'd target) "modify") target))
;;     eval((progn (let ((target '((a . "a") (b . "b") (c . "c")))) (setf (alist-get 'd target) "modify") target)) t)

このように簡単に定義できますが、alistに存在しないキーに対して作用させようとするとエラーになってしまいます。 alist-get の汎変数はこのような要件を満たすために複雑な定義になっています。

なお、 gv-define-expander は gv-define-setter から生成されるので、 gv-define-setter がどのような式を生成するかを眺めることでも使用法を予想することができます。

(ppp-macroexpand
  (gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val)))
;;=> (gv-define-expander cddr
;;     (lambda (do &rest args)
;;       (declare-function gv--defsetter "gv"
;;                         (name setter do args &optional vars))
;;       (gv--defsetter 'cddr
;;                      (lambda (val x) `(setcdr (cdr ,x) ,val))
;;                      do args)))

alist-getの汎変数余談

gv-define-setter は分かりやすいので、どうにかして alist-get の汎変数を gv-define-setter で定義できないでしょうか。 まず思いつくのはこのような定義です。

(macroexp-let2 は第1引数が nil のときに、第2引数の名前で make-symbol したものに第3引数の値をlet束縛するものです。

これはマクロ展開のイディオムを簡略化するものであり、望まない変数捕捉を避けるものです。(マクロの変数捕捉についてはOnlisp(Onlisp - 変数捕捉)参照))

(gv-define-setter alist-get (val key alist &optional _default _remove _testfn)
  (macroexp-let2 nil p `(assq ,key ,alist)
    `(if ,p
         (setcdr ,p ,val)
       (setq ,alist (cons (cons ,key ,val) ,alist)))))
;;=> ...

(ppp-macroexpand-all
 (let ((target '((a ."a") (b . "b") (c . "c"))))
   (setf (alist-get 'a target) "modify")
   target))
;;=> (let ((target '((a . "a") (b . "b") (c . "c"))))
;;     (let* ((v target)
;;            (p (assq 'a v)))
;;       (if p
;;           (setcdr p "modify")
;;         (setq v (cons (cons 'a "modify") v))))
;;     target)
;;   nil

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'a target) "modify")
  target)
;;=> ((a . "modify") (b . "b") (c . "c"))

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'd target) "modify")
  target)
;;=> ((a . "a") (b . "b") (c . "c"))

しかし上手く動いてないようです。マクロ展開結果を注意深く見れば分かるのですが、letで一時的に束縛された変数にsetqしてしまっています。 これではグローバルの値を変更できていません。

先程確認したように gv-define-setter は gv--defsetter を展開し、これに含まれる macroexp-let2 によりalistをlet束縛してしまいます。 gv-define-expander を直接使うことで macroexp-let2 を展開せず、 gv-letplace でグローバル値のセッターを得ることができます。

(defun gv--defsetter (name setter do args &optional vars)
  "Helper function used by code generated by `gv-define-setter'.
NAME is the name of the getter function.
SETTER is a function that generates the code for the setter.
NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
VARS is used internally for recursive calls."
  (if (null args)
      (let ((vars (nreverse vars)))
        (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
    ;; FIXME: Often it would be OK to skip this `let', but in general,
    ;; `do' may have all kinds of side-effects.
    (macroexp-let2 nil v (car args)
      (gv--defsetter name setter do (cdr args) (cons v vars)))))

(ppp-macroexpand
 (gv-define-setter alist-get (val key alist &optional _default _remove _testfn)
   (gv-letplace (getter setter) alist
     (macroexp-let2 nil p `(assq ,key ,alist)
       `(if ,p
            (setcdr ,p ,val)
          ,(funcall setter `(cons (cons ,key ,val) ,getter)))))))
;;=> (gv-define-expander alist-get
;;     (lambda (do &rest args)
;;       (declare-function gv--defsetter "gv"
;;                         (name setter do args &optional vars))
;;       (gv--defsetter 'alist-get
;;                      (lambda (val key alist &optional _default _remove _testfn)
;;                        (gv-letplace (getter setter) alist
;;                          (macroexp-let2 nil p `(assq ,key ,alist)
;;                            `(if ,p
;;                                 (setcdr ,p ,val)
;;                               ,(funcall setter `(cons (cons ,key ,val)
;;                                           ,getter))))))
;;                      do args)))
;;   nil

(ppp-macroexpand
 (gv-define-expander alist-get
   (lambda (do key alist &optional _default _remove _testfn)
     (gv-letplace (getter setter) alist
       (macroexp-let2 nil p `(assq ,key ,alist)
         (funcall do '_getter
                  (lambda (val)
                    `(if ,p
                         (setcdr ,p ,val)
                       ,(funcall setter `(cons (cons ,key ,val) ,getter))))))))))
;;=> (function-put 'alist-get 'gv-expander
;;                 (lambda (do key alist &optional _default _remove _testfn)
;;                   (gv-letplace (getter setter) alist
;;                     (macroexp-let2 nil p `(assq ,key ,alist)
;;                       (funcall do '_getter
;;                                (lambda (val)
;;                                  `(if ,p
;;                                       (setcdr ,p ,val)
;;                                     ,(funcall setter `(cons (cons ,key ,val)
;;                                                 ,getter)))))))))
;;   nil

次に示すように、 gv-define-setter では上手くいかず、 gv-define-expander を使うと上手くいきます。

(gv-define-setter alist-get (val key alist &optional _default _remove _testfn)
  (gv-letplace (getter setter) alist
    (macroexp-let2 nil p `(assq ,key ,alist)
      `(if ,p
           (setcdr ,p ,val)
         ,(funcall setter `(cons (cons ,key ,val) ,getter))))))
;;=> ...

(ppp-macroexpand-all
 (let ((target '((a ."a") (b . "b") (c . "c"))))
   (setf (alist-get 'd target) "modify")
   target))
;;=> (let ((target '((a . "a")
;;                   (b . "b")
;;                   (c . "c"))))
;;     (let* ((v target)
;;            (p (assq 'd v)))
;;       (if p
;;           (setcdr p "modify")
;;         (setq v (cons (cons 'd "modify") v))))
;;     target)
;;   nil

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'd target) "modify")
  target)
;;=> ((a . "a") (b . "b") (c . "c"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(gv-define-expander alist-get
  (lambda (do key alist &optional _default _remove _testfn)
    (gv-letplace (getter setter) alist
      (macroexp-let2 nil p `(assq ,key ,alist)
        (funcall do '_getter
                 (lambda (val)
                   `(if ,p
                        (setcdr ,p ,val)
                      ,(funcall setter `(cons (cons ,key ,val) ,getter)))))))))
;;=> ...

(ppp-macroexpand-all
 (let ((target '((a ."a") (b . "b") (c . "c"))))
   (setf (alist-get 'd target) "modify")
   target))
;;=> (let ((target '((a . "a")
;;                   (b . "b")
;;                   (c . "c"))))
;;     (let* ((p (assq 'd target)))
;;       (if p
;;           (setcdr p "modify")
;;         (setq target (cons (cons 'd "modify") target))))
;;     target)
;;   nil

(let ((target '((a ."a") (b . "b") (c . "c"))))
  (setf (alist-get 'd target) "modify")
  target)
;;=> ((d . "modify") (a . "a") (b . "b") (c . "c"))

まとめ

setf はとても便利なので、ぜひ使いこなして頂ければと思います。

今回、汎変数を定義する方法についてまとめたので、自作パッケージでも汎変数を定義しておいてあげるとユーザーが便利に使えるパッケージになると思います。

なお、今回の目的である plist-get の汎変数については gv-define-setter を使って、次のように定義しました。

後でemacs-develにも投稿しておきたいと思います。 本家に取り入れられればこのパッチなしで plit-get に対する setf を使用できるようになります。

(gv-define-expander plist-get
  (lambda (do plist prop)
    (macroexp-let2 macroexp-copyable-p key prop
      (gv-letplace (getter setter) plist
        (macroexp-let2 nil p `(plist-member ,getter ,key)
          (funcall do
                   `(cadr ,p)
                   (lambda (val)
                     `(if (plist-member ,plist ,key) (setcar (cdr (plist-member ,plist ,key)) ,val)
                        ,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
;;=> ...

(ppp-macroexpand-all
 (let ((target '(:a "a" :b "b" :c "c")))
   (setf (plist-get target :a) "modify")
   target))
;;=> (let ((target '(:a "a" :b "b" :c "c")))
;;     (let* ((p (plist-member target :a)))
;;       (if (plist-member target :a)
;;           (setcar
;;            (cdr (plist-member target :a))
;;            "modify")
;;         (setq target (cons :a (cons "modify" target)))))
;;     target)
;;   nil

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((target '(:a "a" :b "b" :c "c")))
  (setf (plist-get target :a) "modify")
  target)
;;=> (:a "modify" :b "b" :c "c")

(let ((target '(:a "a" :b "b" :c "c")))
  (cl-rotatef (plist-get target :a) (plist-get target :c))
  target)
;;=> (:a "c" :b "b" :c "a")

(let ((target '(:a "a" :b "b" :c "c")))
  (setf (plist-get target :d) "modify")
  target)
;;=> (:d "modify" :a "a" :b "b" :c "c")

参考