#:g1: マクロに付くコンパイラマクロの使い道 (2)

Posted 2020-10-05 15:45:04 GMT

三年前のブログネタのメモに、「マクロにコンパイラマクロ allegro clのcompose-stringを改良する」とあったので、Allegro CLのcompose-stringの仕様を確認してみましたが、一体何が気に入らなかったのか思い出せません。

compose-stringの仕様ですが、基本的にコンパイル時(マクロ展開時)に文字列を合成してしまおうというもので、展開時に文字列リテラルとして確定できる場合は、文字列を、確定できない場合は、compose-string-fnを呼び出す式へ展開、という仕様です。

(compose-string "foo" "bar" :[ 3042 :] "foo" newline)
===> "foobarあfoo
"

(compose-string "foo" "bar" :[ 3042 :] "foo" newline :eval "foo")
===> (compose-string-fn "foo" "bar" 12354 "foo" #\Newline "foo")

三年前の自分の気持ちを察するに、マクロ展開時に色々やりすぎというところだったのかもしれません。
Common Lispでマクロ展開時とコンパイル時を同一視する人は多いですが、厳密にはマクロ展開は、インタプリタ動作時にも実行されるため、あまりマクロ展開での重い仕事はインタプリタを遅くすることになります。
まあSBCLのような処理系が主流の今となっては誰も気にしていないと思いますが。

マクロ展開での重い仕事をコンパイル時に移行する手段としては、コンパイラマクロがありますが、多分、compose-stringをこのような作りに仕立ててみるということがやりたかった気がするので、そういう風なものを作成してみましょう。

compose-stringのマクロ展開を軽くする

とりあえずですが、下請けの、compose-string-fnを定義します。

(defun compose-string-fn (&rest args)
  (with-output-to-string (out)
    (dolist (a args)
      (typecase a
        (CHARACTER 
         (write-char a out))
        (INTEGER 
         (write-char (code-char a) out))
        (STRING
         (write-string a out))
        (T (write-string (string a) out))))))

次に、compose-stringの引数を、compose-string-fnが解釈できるような形式に変換する関数を作成します。

(defun compose-string-process-args (&rest args)
  (labels ((err (args)
             (error "Invalid argument to compose-string: :] in ~S" args))
           (compstr (args acc)
             (if (endp args)
                 (nreverse acc)
                 (typecase (car args)
                   ((OR STRING CHARACTER INTEGER) 
                    (compstr (cdr args)
                             (cons (car args) acc)))
                   ((EQL :])
                    (err args))
                   ((EQL :[)
                    (let ((pos (position :] (cdr args))))
                      (if pos
                          (compstr (append
                                    (mapcar (lambda (x)
                                              (parse-integer (write-to-string x) :radix 16.))
                                            (subseq (cdr args) 0 pos))
                                    (nthcdr (1+ pos) (cdr args)))
                                   acc)
                          (err args))))
                   ((EQL :EVAL)
                    (compstr (cddr args)
                             (cons (cadr args)
                                   acc)))
                   (SYMBOL 
                    (compstr (cons (name-char (string (car args)))
                                   (cdr args))
                             acc))
                   (T (err args))))))
    (compstr args nil)))

これらをcompose-stringとしてまとめます。

(defmacro compose-string (&rest args)
  `(compose-string-fn ,@(apply #'compose-string-process-args args)))

動作

(compose-string "foo" "bar" :eval 12354 :[ 3042 :] "foo")
===>
(compose-string-fn "foo" "bar" 12354 12354 "foo")

コンパイラマクロを追加

とりあえず上記のような動作ですが、引数処理時に全部が文字列であることが判定できる場合は、展開時に文字列を返すような最適化をコンパイラマクロで追加します。

(define-compiler-macro compose-string (&whole w &rest args)
  (let ((args (apply #'compose-string-process-args args)))
    (if (every #'stringp args)
        (apply #'concatenate 'string args)
        w)))

(compiler-macroexpand '(compose-string "foo" "bar" "foo"))
→ "foobarfoo"

多分三年前の自分はこんな動作をさせたかったのでしょう。

一方Allegro CLでの動作は

元々のAllegro CLのcompose-stringでは、:evalオプションがなければ、マクロ展開時に全部計算してしまいます。

大体、上記コンパイラマクロ版の定義と同じですが、再現するとしたら下記にようになるでしょうか。

(defun compose-string-process-args (&rest args)
  (labels ((err (args)
             (error "Invalid argument to compose-string: :] in ~S" args))
           (compstr (args acc)
             (if (endp args)
                 (nreverse acc)
                 (typecase (car args)
                   (STRING 
                    (compstr (cdr args)
                             (typecase (car acc)
                               (STRING (cons (concatenate 'string
                                                          (car acc)
                                                          (car args))
                                             (cdr acc)))
                               (T (cons (car args) acc)))))
                   (CHARACTER
                    (compstr (cons (string (car args))
                                   (cdr args))
                             acc))
                   ((EQL :])
                    (err args))
                   ((EQL :[)
                    (let ((pos (position :] (cdr args))))
                      (if pos
                          (compstr (append
                                    (mapcar (lambda (x)
                                              (parse-integer (write-to-string x) :radix 16.))
                                            (subseq (cdr args) 0 pos))
                                    (nthcdr (1+ pos) (cdr args)))
                                   acc)
                          (err args))))
                   (INTEGER 
                    (compstr (cons (code-char (car args))
                                   (cdr args))
                             acc))
                   ((EQL :EVAL)
                    (compstr (cddr args)
                             (cons `(:eval ,(cadr args))
                                   acc)))
                   (SYMBOL 
                    (compstr (cons (name-char (string (car args)))
                                   (cdr args))
                             acc))
                   (T (err args))))))
    (compstr args nil)))

(defun strip-eval-mark (args) (mapcar (lambda (x) (etypecase x (STRING x) ((cons (eql :eval) *) (cadr x)))) args))

(defmacro compose-string (&rest args) (let ((args (apply #'compose-string-process-args args))) (if (every #'stringp args) (apply #'concatenate 'string args) `(compose-string-fn ,@(strip-eval-mark args)))))

(compose-string "foo" "bar" :[ 3042 :] "foo") ===> "foobarあfoo"

コンパイラマクロ版を更に改良

前述のマクロにコンパイラマクロを付ける方式だと、compose-string-fnの文字列の融合までは処理されません。
しかし、compose-string-fnの方にもコンパイラマクロを付ければ解決できるでしょう。

(define-compiler-macro compose-string-fn (&whole w &rest args)
  (if (every #'stringp args)
      (apply #'concatenate 'string args)
      w))

(compiler-macroexpand '(compose-string-fn "foobarあfoo
"
                   "foo"))
→ "foobarあfoo
foo" 

まとめ

以上、インタプリタ動作でのマクロ展開は軽くしつつ、コンパイル動作の場合はコンパイル時に最適化処理はしてしまう、というのを考えてみました。
基本的に引数の最適化処理はコンパイラマクロの主要な使い道(&keyの最適化等)なので、使える場所があったら使ってみるのが良いかなと思います。

参照


HTML generated by 3bmd in LispWorks Personal Edition 7.1.2

comments powered by Disqus