2010/12/07

SERIES の producing

今日、千葉さんに producing を教えてもらったので、 cl-ppcre:split を series にしてみた。

どうも multiple-value-bind の中の setq は拾ってくれないらしく、ダミーの setq を書いて回避した。

これで Clojure の何でもシーケンスみたいに、何でもシリーズができそうだ。

(defun scan-re-split (regex string)
(declare (optimizable-series-function))
(producing (z) ((r regex) (s string) (scan-start 0) subseq-start subseq-end)
(loop
(tagbody
;; multiple-value-bind の中での setq は認識されないのでダミーで setq する。
(setq scan-start scan-start
subseq-start subseq-start
subseq-end subseq-end)
(multiple-value-bind (start end) (ppcre:scan r s :start scan-start)
(unless start
(if (< (length s) scan-start)
(terminate-producing)
(setq start (length s)
end (1+ start))))
(setq subseq-start scan-start
subseq-end start
scan-start end))
(next-out z (subseq s subseq-start subseq-end))))))

(assert (equal '("a" "b" "c") (collect (scan-re-split "/" "a/b/c"))))
(assert (equal '("") (collect (scan-re-split "/" ""))))
(assert (equal '("" "") (collect (scan-re-split "/" "/"))))
(assert (equal '("" "a") (collect (scan-re-split "/" "/a"))))
(assert (equal '("" "a" "") (collect (scan-re-split "/" "/a/"))))
(assert (equal '("" "" "a" "" "") (collect (scan-re-split "/" "//a//"))))
(assert (equal '("a" "b" "cc" "d") (collect (scan-re-split "\\s+" "a b cc
d"
))))

(collect (scan-re-split "/" "a/b/c")) をマクロ展開すると次のようになる。

(COMMON-LISP:LET* ((#:OUT-1354 "a/b/c"))
(COMMON-LISP:LET ((#:SCAN-1349 0)
(#:SUBSEQ-1348 NIL)
(#:SUBSEQ-1347 NIL)
#:Z-1350
(#:LASTCONS-1344 (LIST NIL))
#:LST-1345)
(DECLARE (TYPE CONS #:LASTCONS-1344)
(TYPE LIST #:LST-1345))
(SETQ #:LST-1345 #:LASTCONS-1344)
(TAGBODY
#:LL-1355
(PROGN
(SETQ #:SCAN-1349 #:SCAN-1349)
(SETQ #:SUBSEQ-1348 #:SUBSEQ-1348)
(SETQ #:SUBSEQ-1347 #:SUBSEQ-1347))
(MULTIPLE-VALUE-CALL
#'(LAMBDA (&OPTIONAL (START) (END) &REST #:G12-1346)
(DECLARE (IGNORE #:G12-1346))
(IF START
NIL
(PROGN
(IF (< (LENGTH #:OUT-1354) #:SCAN-1349)
(GO SERIES::END)
(PROGN
(SETQ START (LENGTH #:OUT-1354))
(SETQ END (1+ START))))))
(PROGN
(SETQ #:SUBSEQ-1348 #:SCAN-1349)
(SETQ #:SUBSEQ-1347 START)
(SETQ #:SCAN-1349 END)))
(CL-PPCRE:SCAN "/" #:OUT-1354 :START #:SCAN-1349))
(SETQ #:Z-1350 (SUBSEQ #:OUT-1354 #:SUBSEQ-1348 #:SUBSEQ-1347))
(SETQ #:LASTCONS-1344 (SETF (CDR #:LASTCONS-1344) (CONS #:Z-1350 NIL)))
(GO #:LL-1355)
SERIES::END)
(CDR #:LST-1345)))

0 件のコメント: