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関連記事

Lisp-Parenscript カテゴリーの記事一覧 - eshamster’s diary


*1:出ないパターンもあるので直接ドット記法に対するエラーではないようですが。いまいち警告文の意味するところが分かっていないです。

*2:最初は"!"と1文字でしたが、"!="が"="になるという事象が起きたので2文字にしました("!!="とは書けます)。"!="自体はdeprecatedなので使うべきではないですが。