イテレータ生成メソッドと複合イテレータ

イテレータ・クラスのオブジェクトを作る、というのもやってみたけど、どうも無駄に仕様が大きくなっていくだけな気がしてすっきりしない。結局、Gauche が採用しているように関数オブジェクトで返すのが一番自由を感じられて良いのかな、と。それらを格納するだけの箱としてクラスを作れば循環参照もしないし。
というわけで、コレクションに対して順方向のイテレータを作る関数をいくつか。イマドキの言葉では、こういうのは enumerator とか呼んだほうがいいのかな。

(defmethod make-iterator ((coll list) &key (start 0))
  (setq coll (nthcdr start coll))
  (values #'(lambda () (null coll))
          #'(lambda () (pop coll))))

(defmethod make-iterator ((coll vector) &key (start 0))
  (check-type start (integer 0 *))
  (let ((i (1- start)))
    (cond
      ((stringp coll)
       (let ((len (length coll)))
         (values #'(lambda () (>= (1+ i) len))
                 (if (simple-string-p coll)
                     #'(lambda () (schar coll (incf i)))
                     #'(lambda () (char coll (incf i)))))))
      ((simple-vector-p coll)
       (let ((len (length coll)))
         (values #'(lambda () (>= (1+ i) len))
                 #'(lambda () (svref coll (incf i))))))
      ((array-has-fill-pointer-p coll)
       (values #'(lambda () (>= (1+ i) (fill-pointer coll)))
               #'(lambda () (aref coll (incf i)))))
      (t
       (values #'(lambda () (not (array-in-bounds-p coll (1+ i))))
               #'(lambda () (aref coll (incf i))))))))

(defmethod make-iterator ((coll hash-table) &key)
  (with-hash-table-iterator (next coll)
    (let (got? key val (used? t))
      (values #'(lambda ()
                  (if used?
                      (progn
                        (multiple-value-setq (got? key val) (next))
                        (if got?
                            (setq used? nil)
                            t))
                      (not got?)))
              #'(lambda ()
                  (if used?
                      (progn
                        (multiple-value-setq (got? key val) (next))
                        (values key val))
                      (progn
                        (setq used? t)
                        (values key val))))))))


(defun call-with-iterator (fn coll &optional (start 0))
  (multiple-value-call fn
    (make-iterator coll :start start)))

(defmacro with-iterator ((end-pred gen-next coll &optional (start 0))
                         &body body)
  `(call-with-iterator #'(lambda (,end-pred ,gen-next) ,@body)
                       ,coll
                       ,start))

make-iterator はコレクションを受け取って２つの関数を返す。1つ目は、走査が完了したかどうかを返す関数。２つ目は、次の要素を生成する関数。走査完了後に後者を呼んだときの動作は未定義。
call-with-iterator は関数とコレクション（オプションでイテレートの初期インデクス）を受け取り、コレクションのイテレータを作って、それを引数として与えられた関数を呼ぶ。
with-iterator は本体をクロージャにして call-with-iterator に渡すだけのマクロ。変数にそのまま関数オブジェクトを代入するのでなく、with-hash-table-iterator みたいに関数形式で呼び出せるようにするというのも考えたけど、外部イテレータの醍醐味が失われてしまうのは個人的に楽しくない。

せっかくなので、これらを並行して動かす複合イテレータも用意してみた。map が外部イテレータで実現できる。

(defun make-compound-iterator (&rest colls)
  (if (null colls)
      nil
      (let (end-pred-list gen-next-list)
        (loop for c in colls do
             (multiple-value-bind (end-pred gen-next) (make-iterator c)
               (push end-pred end-pred-list)
               (push gen-next gen-next-list)))
        (setq end-pred-list (nreverse end-pred-list)
              gen-next-list (nreverse gen-next-list))
        (values #'(lambda ()
                    (member t (mapcar #'funcall end-pred-list)
                            :test #'eq))
                #'(lambda ()
                    (mapcar #'funcall gen-next-list))))))


(defun call-with-compound-iterator (fn &rest colls)
  (multiple-value-call fn
    (apply #'make-compound-iterator colls)))

(defmacro with-compound-iterator ((end-pred gen-next &rest colls)
                                  &body body)
  `(call-with-compound-iterator
    #'(lambda (,end-pred ,gen-next) ,@body)
    ,@colls))

使用例：

CL-USER> (with-compound-iterator (end? next #(a b c d) '(0 1 2) "Hello")
           (loop until (funcall end?)
              do
                (print (funcall next))))

(A 0 #\H) 
(B 1 #\e) 
(C 2 #\l) 
NIL