hu.dwim.walker を使ってみる

Common Lisp といえばマクロ。マクロのいきつく先といえばコードウォーカー。ということで hu.dwim.walker というコードウォーカ一を使ってみた。

使い方としては次のような感じ。

1. フォーム(S式)を hu.dwim.walker:walk-form で CLOS オブジェクトのAST(抽象構文木)にする。
2. AST を hu.dwim.walker:substitute-ast-if や hu.dwim.walker:rewrite-ast を使って書き換える。
3. hu.dwim.walker:unwalk-form で AST をフォーム(S式)に戻す。

cl-json を使うと次のように JSON をデコードできる。

(json:decode-json-from-string "{\"a\": 1, \"b\": {\"bb\": 2}, \"c\": 3}")
;;⇒ ((:A . 1) (:B (:BB . 2)) (:C . 3))

これに対する assoc をちまち書きたくないので、シンボル1つで次のように展開されるマクロを書いてみる。

@a ⇒ (ASSOC "A" '((:A . 1) (:B (:BB . 2)) (:C . 3)) :TEST #'STRING-EQUAL)
@b.bb ⇒ (CDR (ASSOC "BB"
                     (CDR (ASSOC "B" '((:A . 1) (:B (:BB . 2)) (:C . 3)) :TEST #'STRING-EQUAL))
                     :TEST #'STRING-EQUAL))

これだけなら S式を単純に置換していくだけでも可能だけど

• @で始まるシンボルでも let 等で束縛されていれば、上記の展開を行なわない。
• マクロがネストされても問題ないようにする。

となるとコードウォーカーが必要になる。

ちゃんとしたドキュメントとかないようなので、テストやソースを見ながら書いたのがこれ。

(ql:quickload "hu.dwim.walker")
(ql:quickload "cl-json")
(ql:quickload "split-sequence")

(defun symbol-to-assoc-form (symbol decoded)
  (let ((names (split-sequence:split-sequence #\. (subseq (symbol-name symbol) 1))))
    (hu.dwim.walker:walk-form
     (reduce (lambda (acc x)
               `(cdr (assoc ,x ,acc :test #'string-equal)))
             names
             :initial-value decoded))))

(defun free-and-@-p (form)
  (and (typep form 'hu.dwim.walker:free-variable-reference-form)
       (char= #\@ (char (symbol-name (hu.dwim.walker:name-of form)) 0))))

(defun walk-with-json-body (decoded form env)
  (let* ((walked (hu.dwim.walker:walk-form form
                                           :environment (hu.dwim.walker:make-walk-environment env)))
         (walked (hu.dwim.walker:rewrite-ast
                  walked
                  (lambda (parent field form)
                    (declare (ignore parent field))
                    (if (free-and-@-p form)
                        (symbol-to-assoc-form (hu.dwim.walker:name-of form) decoded)
                        form)))))
    (hu.dwim.walker:unwalk-form walked)))

(defmacro with-json (json &body body &environment env)
  (let ((decoded (gensym)))
    `(let ((,decoded (json:decode-json-from-string ,json)))
       ,@(mapcar (lambda (form)
                   (walk-with-json-body decoded form env))
                 body))))

;; @a と @b.bb は json の値 1, 2 に @c は let の 999 になる。
;; with-json がネストしてても問題ない。
(with-json "{\"a\": 1, \"b\": {\"bb\": 2}, \"c\": 3}"
  (let ((@c 999))
    (list @a @b.bb @c
          (with-json "{\"a\": 10, \"b\": {\"bb\": 20}, \"c\": 30}"
            (let ((@c 9990))
              (list @a @b.bb @c))))))
;;⇒ (1 2 999 (10 20 9990))