最近書いた define-setf-expander の例
この文章は、 Lisp SETF Advent Calendar 2018 - Qiita の 12/10分の記事として書かれました。
最近作った cl-json-pointer
という適当なライブラリで、簡単な define-setf-expander
を書いたのでご紹介です。
簡単に cl-json-pointer
紹介
RFC 6901 - JavaScript Object Notation (JSON) Pointer の実装です。
といっても JSON 自体を読んだりはせず、Common Lisp にある たくさんの JSON read/write ライブラリ のどれかと併用することとしています。 どのライブラリを使っても、 assoc-list か、 property-list か、 hash-table か、 standard-object のどれかで表現されるんだろ と見繕って、型を見て適当に引っ掛けています。
以下は、 cl-json
での例です。
(use-package :cl-json-pointer) (defparameter *json-str* "{ \"foo\": 0, \"bar\": 1}") (defparameter *json-obj* (json:decode-json-from-string *json-str*)) ;; => ((:FOO . 0) (:BAR . 1)) (get-by-json-pointer *json-obj* "/foo") ;; => 0 (get-by-json-pointer *json-obj* "/bar") ;; => 1 (get-by-json-pointer *json-obj* "/baz") ;; => NIL (setf *json-object-flavor* :cl-json) ; cl-json の alist 規約に合わせるための設定 (setf *json-obj* (set-by-json-pointer *json-obj* "/baz" 999)) ;; => ((:BAZ . 999) (:FOO . 0) (:BAR . 1)) (get-by-json-pointer *json-obj* "/baz") ;; => 999
setf
に対応させるには
目的
上では、値を取得する関数 (get-by-json-pointer
) と、値を設定する関数 (set-by-json-pointer
) は別々になっています。
しかし、やはり setf
でまとめたいものです。以下のようになって欲しいですね:
(defparameter *json-str* "{}") (defparameter *json-obj* (json:decode-json-from-string *json-str*)) ;; => NIL (get-by-json-pointer *json-obj* "/baz") ;; => NIL (setf (get-by-json-pointer *json-obj* "/baz") 999) ; こう書きたい! ;; => 999 *json-obj* ;; => ((:BAZ . 999)) (get-by-json-pointer *json-obj* "/baz") ;;=> 999
しかし、これは一筋縄ではいきません。これをやるためには、以下のフォームを見て・・
(setf (get-by-json-pointer *json-obj* "/baz") 999)
get-by-json-pointer
式の第一引数の箇所(この場合 *json-obj*
)を書き換えなければいけません。
特に今回の場合は、 *json-obj*
は nil だったので、 新しい alist を割り当て、 *json-obj*
変数がそれを指すようにする 必要があります。
setf 関数は?
setf 関数では実現できません。以下のように書いても・・
(defun (setf get-by-json-pointer) (newval obj pointer &key (flavor *json-object-flavor*)) (setf obj (set-by-json-pointer obj pointer newval :flavor flavor)) newval)
残念ながら、 obj
は関数内のローカルな変数なので、そこに代入しても意味がありません。
defsetf
では?
defsetf
でも実現できません。以下のように書けばいいのかなと思いますが・・
(defsetf get-by-json-pointer (obj pointer &key (flavor *json-object-flavor*)) (newval) `(progn (setf ,obj (set-by-json-pointer ,obj ,pointer ,newval :flavor ,flavor)) ,newval))
obj
には gensym
された一時変数が bind されるので、 この obj
を変更しても今回欲しい効果は得られません。 CLHS より:
During the evaluation of the forms, the variables in the lambda-list and the store-variables are bound to names of temporary variables, generated as if by gensym or gentemp, that will be bound by the expansion of setf to the values of those subforms.
define-setf-expander を使う
この例の場合、元の setf
フォームを受け取って、そこに *json-obj*
と記述されているということを知らなければなりません。
このように、生の setf
フォームに触れなければならない場合は、 define-setf-expander
が必要になります。
今回は、以下のように定義することで所望の動作を実現できました。
(define-setf-expander get-by-json-pointer (obj pointer &key (flavor '*json-object-flavor*) &environment env) "A setf expansion for allowing `setf' to `(get-by-json-pointer ...)' forms." (multiple-value-bind (o-tmps o-vals o-newval o-setter o-getter) (get-setf-expansion obj env) (unless (length= o-newval 1) (error "setf to get-by-json-pointer requires the first arg is one value.")) (with-gensyms (p-tmp flavor-tmp store) (values (list* p-tmp flavor-tmp o-tmps) (list* pointer flavor o-vals) (list store) `(let ((,(first o-newval) ; this binding influences `o-setter'. (set-by-json-pointer ,o-getter ,p-tmp ,store :flavor ,flavor-tmp))) ,o-setter ,store) `(get-by-json-pointer ,o-getter ,p-tmp :flavor ,flavor-tmp)))))
まとめ
普段はほとんど使わない define-setf-expander
ですが、ついに必要な場面に出会ってしまったので改めてめっちゃ調べてコードを書きました。そんな私の忘備録も兼ねてご紹介しました。
どの setf
定義を使うかですが:
- 大抵の場合 :: setf 関数
- マクロじゃないと困る時 ::
defsetf
- どうしても生の setf フォームに触れないといけないとき ::
define-setf-expander
という感じかなと思います。