Parenscriptで少し遊んで見る (2)ドット記法編
@マクロが長い
Parenscriptを書いていると真っ先に気になってくるのが@マクロです。下記の最初の例のように一つ程度ではそうでもないですが、いくつか並ぶと主張が激しく気になってきます。newに至っては単体でもだいぶ見づらいです。
CL-USER> (import 'ps:@) T CL-USER> (ps:ps (setf (@ $scope -test) 20)) "$scope.Test = 20;" CL-USER> (ps:ps (ps:new ((@ test create) 10))) "new test.create(10);"
試しにドット記法で書いてみると一応動きますが警告が出ます*1。
CL-USER> (ps:ps (setf $scope.-test 20)) ; Warning: Symbol $SCOPE.-TEST contains one of '.[]' - this compound naming convention is no longer supported by Parenscript! "$scope.Test = 20;"
また、実際に問題になるのは他の機能と連携が取れないという部分で、例えばwith-slotsによるシンボル置き換えに反応してくれません。
; 警告とダブルクォーテーションの出力を省略 CL-USER> (ps:ps (with-slots (-test) $scope (setf (@ -test a1) 20) (setf -test.a2 20))) $scope.Test.a1 = 20; Test.a2 = 20;
力業でドット記法に対応する
要はドットがあったら「test.abc.def → (@ test abc def)」のように変換すればいいわけですよね、ということで、コードツリーを全走査して見つけたドット記法を片っ端から置き換えるps.マクロを作るという力業に出てみます。
(ql:quickload :parenscript) (ql:quickload :cl-ppcre) (defun replace-dot-sep (elem) (if (and (symbolp elem) (not (null (symbol-package elem)))) ; gensym case (let ((name (symbol-name elem)) (pack-name (package-name (symbol-package elem)))) (cond ((and (> (length name) 1) (string= name "!!" :start1 0 :end1 2)) (intern (subseq name 2) pack-name)) ((ppcre:scan "\\." name) `(ps:@ ,@(mapcar (lambda (x) (intern x pack-name)) (ppcre:split "\\." name)))) (t elem))) elem)) (defun replace-dot-in-tree (tree) (labels ((rec (rest) (let (result) (when rest (dolist (elem rest) (push (if (listp elem) (rec elem) (replace-dot-sep elem)) result))) (nreverse result)))) (rec tree))) (defmacro ps. (&body body) `(ps:ps ,@(replace-dot-in-tree body)))
2015/11/13追記: gensymで作られたシンボルのように、パッケージにinternされていないシンボルを渡された場合、(symbol-package elem)がNILとなってsymbol-name関数でエラーとなることがあったため、replace-dot-sep関数にNILチェックを追加しました。
シンボル名の頭に"!!"があるときは変換しないという逃げ道もつけてみました*2。余計かもしれません。試し打ちしてみます。
(ps. (setf $scope.abc.def 123) (with-slots (abc) $scope (setf abc.def 123) (setf !!abc.def 123))))
=> $scope.abc.def = 123; $scope.abc.def = 123; abc.def = 123;
ps.マクロの展開結果も見てみます。
(PARENSCRIPT:PS (SETF (@ $SCOPE ABC DEF) 123) (WITH-SLOTS (ABC) $SCOPE (SETF (@ ABC DEF) 123) (SETF ABC.DEF 123)))
いい感じですが、まだ問題があります。defmacro+psで定義したマクロなど、ps.マクロの外で作ったものを持ち込むと反応できません。
(ps:defmacro+ps test-mac (a) `(ps:with-slots (abc) ,a (ps:setf abc.value 100))) (print (ps. (test-mac $scope)))
=> abc.value = 100;
ps.マクロ側ではいかんともしがたいので、defmacro+ps側をラップしてdefmacro.psマクロを作成します。
(defmacro defmacro.ps (name args &body body) `(ps:defmacro+ps ,name ,args ,@(replace-dot-in-tree body))) (defmacro.ps test-mac (a) `(ps:with-slots (abc) ,a (ps:setf abc.value 100))) (print (ps. (test-mac $scope)))
=> $scopeabc.value = 100;
まだ抜けがあるかもしれませんが、その都度defmacro.psのように3行程度書けば対応可能なはずです。
ひとまとめ。
=> $scope.abc.def = 123; $scope.abc.def = 123; abc.def = 123; $scope.abc.value = 100;
別解(リンク)
もっときれいに、しかもCommon Lispのパッケージシステムの中に取り込む形で解決しているのが「http://e-arrows.sakura.ne.jp/2011/01/cl-wrapper-for-google-closure.html」です。
- 前の記事:「Parenscriptで遊んで見る (1) defun編 - eshamster’s diary」
- 次の記事:「Parenscriptで少し遊んで見る (3)キャメルケース編 - eshamster’s diary」
Parenscript関連記事
Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary