Common Lisp Advent Calendar 2012で iterate というloopマクロに似たイテレーションライブラリが紹介されていました。 (iterateを使ってloopマクロの呪縛から解き放たれる)
loopマクロと異なり拡張ができるようなので、 OOPのデザインパターンに出てくる(has-next/nextを使った)イテレーターパターンっぽいコードでループできるようにしてみました。
;; イテレーターパターンっぽいインターフェースと実装を定義 ;; iterator-next メソッドと has-next-p メソッドを実装したクラスを定義する (ql:quickload :cl-fad) (ql:quickload :cl-annot) (defpackage pattern.iterator (:use :cl :cl-annot)) (in-package :pattern.iterator) (enable-annot-syntax) @export (defgeneric has-next-p (obj)) @export (defgeneric iterator-next (obj)) @export (defclass <sequence-iterator> () ((seq :initarg :seq) (pos :initarg :pos :initform 0))) (defmethod has-next-p ((obj <sequence-iterator>)) (with-slots (seq pos) obj (< pos (length seq)))) (defmethod iterator-next ((obj <sequence-iterator>)) (with-slots (seq pos) obj (prog1 (elt seq pos) (incf pos)))) @export (defun sequence-iterator (seq) (make-instance '<sequence-iterator> :seq seq)) @export (defclass <directory-walker> () ((rest :initform nil))) @export (defun directory-walker (root) (make-instance '<directory-walker> :root root)) (defmethod initialize-instance ((obj <directory-walker>) &key (root "./") &allow-other-keys) (call-next-method) (push (fad:canonical-pathname root) (slot-value obj 'rest))) (defmethod has-next-p ((obj <directory-walker>)) (with-slots (rest) obj (not (null rest)))) (defmethod iterator-next ((obj <directory-walker>)) (with-slots (rest) obj (let ((path (pop rest))) (when (fad:directory-exists-p path) (setf rest (nconc (fad:list-directory path) rest))) path)))
;; ドライバの実装 ;; iterator-nextとhas-next-pを使ったループをiterateに組み込む。 (ql:quickload "iterate") (ql:quickload :cl-fad) (in-package :cl-user) (defpackage test (:use :cl :iterate :pattern.iterator)) (in-package :test) ;; IN-ITERATORというキーワードでイテレータパターン風の処理でループできるように拡張 (defmacro-driver (FOR var IN-ITERATOR obj) (let ((gitr (gensym)) (kwd (if generate 'generate 'for))) `(progn (with ,gitr = ,obj) (while (pattern.iterator:has-next-p ,gitr)) (,kwd ,var next (pattern.iterator:iterator-next ,gitr)))))
(iter (for x in-iterator (pattern.iterator:sequence-iterator '(1 2))) (collect x)) ;; => (1 2) ;; 以下のディレクトリ構成で実行 ;; ./ (/home/kurohuku/tmp) ;; |- A.txt ;; |- B ;; | |- B1.txt ;; | |- B2.lisp ;; |- C.txt (iter (for x IN-ITERATOR (directory-walker "./")) (collect x)) ;; => (#P"" #P"/home/kurohuku/tmp/A.txt" #P"/home/kurohuku/tmp/B/" ;; #P"/home/kurohuku/tmp/B/B1.txt" #P"/home/kurohuku/tmp/B/B2.lisp" ;; #P"/home/kurohuku/tmp/C.txt") (iter (for x IN-ITERATOR (directory-walker "./")) (when (string-equal (pathname-type x) "txt") (collect x))) ;; => (#P"/home/kurohuku/tmp/A.txt" #P"/home/kurohuku/tmp/B/B1.txt" ;; #P"/home/kurohuku/tmp/C.txt")