#:g1: 実践SETF定義:define-setf-expanderで型破りなsetf構文を作ろう

Posted 2018-12-10 17:46:17 GMT

Lisp SETF Advent Calendar 2018 11日目 》

setf関数、defsetfと紹介してきましたが、今回は一番汎用的なdefine-setf-expanderの紹介です。
実際、defsetfや、define-modify-macroも、define-setf-expanderの定義に展開している処理系も多いです。

define-setf-expanderを簡単に説明すると、

(setf (x y z) a b c)

のようなフォームのxyzabcという部品を好きなように配置することが可能です。

好きなように、といっても一応xyzは変数としての振舞い、abcは値としての振舞いをする必要はありますので、作法に則る必要はあります。

CPLの代入構文のallを作ってみよう

左辺値について調べている際に、CPLが左辺値、右辺値を整理したとWikipediaに書いてあったので、ちょっと眺めてみましたが、Fortran、Algolに比較すれば、左辺値が拡張された感じはします。

左辺値にリスト表現や配列をとって、変数を複数同時に代入できたり、リストを分解して変数に代入できたり、1963年の言語にしては先進的ですが、拡張のバリエーションとして、

all a, b, c := 0

という書法がありました。

上記の場合は、変数全部に0が代入されるわけですが、左辺と右辺で微妙に対称性がなく、イレギュラーなsetf定義の例に良さそうなので、ちょっと考えてみましょう。
まず、構文の見た目ですが、こんな感じになるかなと思います。

(setf (all a b c) 0)

(list a b c)(0 0 0)

構文全体としては直感的なのですが、allというゲッターを考えるに、これは単独では存在できそうにないですが、どうなんでしょう。
それはさておきこんな感じに書いてみました。

(define-setf-expander all (&rest places &environment env)
  (loop :with store := (gensym "all-")
        :for p :in places
        :for (d v sv setter getter) := (multiple-value-list (get-setf-expansion p env))
        :append d :into ds
        :append v :into vs
        :append sv :into svs
        :collect setter :into setters
        :collect getter :into getters
        :finally (return 
                  (values ds
                          vs
                          `(,store)
                          `(let (,@(mapcar (lambda (v)
                                             `(,v ,store))
                                           svs))
                             (values ,@setters))
                          `(values ,@getters)))))

下記のフォームをマクロ展開してみると、

(let ((x 0)
      (y 0)
      (z 0))
  (incf (all x y z) 100)
  (list x y z))(100 100 100)

こんな感じになります。

(let ((x 0) (y 0) (z 0))
  (let* ()
    (let* ()
      (let ((#:|all-128690| (+ (values x y z) 100)))
        (let ((#:|Store-Var-128691| #:|all-128690|)
              (#:|Store-Var-128692| #:|all-128690|)
              (#:|Store-Var-128693| #:|all-128690|))
          (values (setq x #:|Store-Var-128691|)
                  (setq y #:|Store-Var-128692|)
                  (setq z #:|Store-Var-128693|))))))
  (list x y z))

大体の場所でallは機能が成立するようです。

(let ((x (list 0 1 2))
      (y 0)
      (z 1))
  (setf (all (values (car x) (cadr x)) y z) 
        42)
  (list x y z))((42 42 2) 42 42) 

(let ((v (make-sequence 'vector 7))) (setf (all (elt v 1) (elt v 3) (elt v 5)) '- (all (elt v 0) (elt v 2) (elt v 4) (elt v 6)) '+) v) → #(+ - + - + - +)

しかし、pushpopの挙動は良く分かりません。
push/popした後のリストがallによって同値になるので、これであってるような間違っているような。

(let ((x (list 1 2 3))
      (y (list 0 0 0)))
  (push 'a (all x y))
  (list x y))((a 1 2 3) (a 1 2 3)) 

(let ((x (list 1 2 3)) (y (list 0 0 0))) (pop (all x (cdr y))) (list x y))((2 3) (0 2 3))

まとめ

変った代入構文をみつけたら、また定義に挑戦してみようと思います。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus