Posted 2017-04-27 16:36:10 GMT

久々にSeriesのブログ記事を見掛けたが、ブログ中にこんな疑問があった

``上のコード、実行するたびに以下のようなwarningが出るんですよね。なんとかならないものか。''

これは大抵の場合、seriesのパイプラインに載ってないのが理由である。

Seriesでは最適なコードを出すには色々な制約があり、色々繁雑な作法があるのだった。

この流れて行くと元のコードをSeries的に最適化して、やったね!という締めになりそうだが、このコードを最適化するのはどうも大変っぽいので別の書き方をすることにした。

とりあえずは、パッケージの定義から

( defpackage :Z ( :use :cl :series ) ) (in-package :Z) (series::install :implicit-map T)

まず、Seriesを最適化するには series::install の実行が大切である。

リーダーマクロが導入されるに留まらず、 let や defun や funcall が改造されてしまう。この辺りは好き嫌いが分かれるだろう。ちなみに筆者はあまり好きではない。

implicit-map はデフォルトでは nil だが筆者はこの怪しい機能が好きなので T にしたい。

implicit-map が T だとこのように書ける

( let ( ( e ( scan-range ) ) ( s ( scan "響け！ユーフォニアム" ) ) ) ( collect ( list e s ) ) )

ぱっと見普通だが良く考えると色々変なことになっている。

恐らくこの機能は、seriesの前身のLetSの構文を実現するものなのではないかなと考えているが実際はどうなのだろう。

閑話休題。それで、とりあえず、clojureの cycle みたいなユーティリティを考えてみる。

( defun cycle ( seq ) ( declare ( optimizable-series-function 1 ) ) ( let ( ( len ( length seq ) ) ) ( scan-fn ' ( values character fixnum ) ( lambda ( ) ( values ( elt seq 0 ) 0 ) ) ( lambda ( c prv &aux ( cur ( 1+ prv ) ) ) ( declare ( ignore c ) ) ( values ( elt seq ( mod cur len ) ) cur ) ) ( constantly nil ) ) ) ) (subseries (cycle "響け！ユーフォニアム") 0 20)

(declare (optimizable-series-function 1)) が肝だが、 defun もSeriesの独自定義のものに差し換えられており、後々ループに組み直す為に定義時に中身が分解されて格納されたりしている。

defun マクロを展開すると通常の cl:defun とは似ても似つかない内容になっているので眺めてみよう。

それで、本体だが、一文字ずつずらしながら改行されているということは、該当の場所の文字を改行に置き換えてしまえば良いのではないかということで、このように書いた

( defun 響け！ユーフォニアム ( ) ( let* ( ( str "響け！ユーフォニアム" ) ( len ( length str ) ) ) ( collect-ignore ( #2M ( lambda ( c i ) ( write-char ( if ( = len ( mod i ( 1+ len ) ) ) #\Newline c ) ) ) ( cycle str ) ( scan-range :length ( * len ( + 2 len ) ) ) ) ) ) )

なお、 implicit-map が有効なので、 #2M は取ってしまえるので、こうなる

( defun 響け！ユーフォニアム ( ) ( let* ( ( str "響け！ユーフォニアム" ) ( len ( length str ) ) ) ( collect-ignore ( ( lambda ( c i ) ( write-char ( if ( = len ( mod i ( 1+ len ) ) ) #\Newline c ) ) ) ( cycle str ) ( scan-range :length ( * len ( + 2 len ) ) ) ) ) ) )

さらに lambda も let に纏めることが可能。

( defun 響け！ユーフォニアム ( ) ( let* ( ( str "響け！ユーフォニアム" ) ( len ( length str ) ) ( c ( cycle str ) ) ( i ( scan-range :length ( * len ( + 2 len ) ) ) ) ) ( collect-ignore ( write-char ( if ( = len ( mod i ( 1+ len ) ) ) #\Newline c ) ) ) ) ) (響け！ユーフォニアム)

そして、この定義をマクロ展開すると、こんな恐しいことになっている (実行可能なように #: は取ってある)

( defun 響け！ユーフォニアム ( ) ( cl:let* ( ( str "響け！ユーフォニアム" ) ) ( cl:let ( len ) ( setq len ( length str ) ) ( cl:let ( out-137857 ) ( setq out-137857 ( * len ( + 2 len ) ) ) ( cl:let ( out-137847 ) ( setq out-137847 ( length str ) ) ( cl:let ( out-137846 out-137845 ) ( setq out-137846 #' ( lambda ( c prv &aux ( cur ( 1+ prv ) ) ) ( declare ( ignore c ) ) ( values ( elt str ( mod cur out-137847 ) ) cur ) ) ) ( setq out-137845 ( constantly nil ) ) ( cl:let ( state-137844 ( state-137843 0 ) items-137848 ( items-137842 0 ) ( i ( coerce ( - 0 1 ) 'number ) ) ( counter-137854 out-137857 ) ) ( declare ( type fixnum state-137843 ) ( type fixnum items-137842 ) ( type number i ) ( type fixnum counter-137854 ) ) ( locally ( declare ( type character state-137844 ) ( type character items-137848 ) ) ( values ( cl:let* ( ) ( cl:multiple-value-bind ( |Store-Var-137865| |Store-Var-137866| ) ( ( lambda ( ) ( values ( elt str 0 ) 0 ) ) ) ( cl:let* ( ) ( values ( setq state-137844 |Store-Var-137865| ) ( setq state-137843 |Store-Var-137866| ) ) ) ) ) ) ( tagbody ll-137864 ( if ( cl:funcall out-137845 state-137844 state-137843 ) ( go series::end ) nil ) ( setq items-137848 state-137844 items-137842 state-137843 ) ( values ( cl:let* ( ) ( cl:multiple-value-bind ( |Store-Var-137867| |Store-Var-137868| ) ( cl:funcall out-137846 state-137844 state-137843 ) ( cl:let* ( ) ( values ( setq state-137844 |Store-Var-137867| ) ( setq state-137843 |Store-Var-137868| ) ) ) ) ) ) ( setq i ( + i ( coerce 1 'number ) ) ) ( if ( not ( plusp counter-137854 ) ) ( go series::end ) nil ) ( cl:let* ( ) ( cl:let* ( ) ( cl:let ( ( |Store-Var-137869| ( - counter-137854 1 ) ) ) ( setq counter-137854 |Store-Var-137869| ) ) ) ) ( write-char ( if ( = len ( mod i ( 1+ len ) ) ) #\Newline items-137848 ) ) ( go ll-137864 ) series::end ) nil ) ) ) ) ) ) ) )

おわかり頂けただろうか……別々に定義した関数の中身が合体していることが分かると思う。

結び

筆者も以前はSeriesを好んで利用していたが最近は面倒なのでSeriesを使って書いたりしていない。

どうもSeriesを使って何か書いていると、Seriesが上手く最適化されないなーなどとチューニングの為に横道に逸れてしまうことが多いのだった。

Seriesだと繰り返しを関数の組み合わせのように書けるが、実際の所はまさしく黒魔術なマクロでループに式を変形していて、Seriesの作法を知らないとビシッとループには展開されない。

綺麗にループに展開されない場合は、非効率なコードが出てしまうが、冒頭の警告の話は、このような背景による。

この辺りはコンパイラがすべきことなんじゃないかなあと思ってしまうが、マクロの可能性の一つではあるのかもしれない。

とりあえず、Seriesの標準のユーティリティにあまり使い易いものはないが、Clojureあたりを参考にユーティリティを作る所から始めれば、Seriesも快適に使えたりするのかもしれない。

■

