Seriesの色々 — #:g1

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の実行が大切である。
リーダーマクロが導入されるに留まらず、letdefunfuncallが改造されてしまう。この辺りは好き嫌いが分かれるだろう。ちなみに筆者はあまり好きではない。

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

implicit-mapTだとこのように書ける

(let ((e (scan-range))
      (s (scan "響け!ユーフォニアム")))
  (collect (list e s)))
;=> ((0 #\響)
;   (1 #\け)
;   (2 #\!)
;   (3 #\ユ)
;   (4 #\ー)
;   (5 #\フ)
;   (6 #\ォ)
;   (7 #\ニ)
;   (8 #\ア)
;   (9 #\ム)) 

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

恐らくこの機能は、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) ;=> #Z(#\響 #\け #\! #\ユ #\ー #\フ #\ォ #\ニ #\ア #\ム #\響 #\け #\! #\ユ #\ー #\フ #\ォ #\ニ #\ア #\ム)

(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)))))))

さらにlambdaletに纏めることが可能。

(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)))))

(響け!ユーフォニアム) ;>> 響け!ユーフォニアム ;>> け!ユーフォニアム響 ;>> !ユーフォニアム響け ;>> ユーフォニアム響け! ;>> ーフォニアム響け!ユ ;>> フォニアム響け!ユー ;>> ォニアム響け!ユーフ ;>> ニアム響け!ユーフォ ;>> アム響け!ユーフォニ ;>> ム響け!ユーフォニア ;>> 響け!ユーフォニアム ;=> nil

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

(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も快適に使えたりするのかもしれない。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus