#:g1: sbcl: Iterator Protocolの紹介

Posted 2014-12-07 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の342日目です。

sbcl: Iterator Protocolとはなにか

 sbcl: Iterator Protocolは、sbclの拡張で、ユーザー定義のsequenceを扱える繰り返し規約です。


パッケージ名sbcl: Iterator Protocol
ドキュメントsbcl User Manual: Iterator Protocol




 341日目で紹介した、sbcl: Extensible Sequencesに近いところですが、ユーザー定義のsequenceを扱う繰り返し規約を定義できる仕組みです。
繰り返し規約というと、DylanのIteration Protocolを思い出しますが、Dylanのものにかなり影響を受けています。


(defclass kons (sequence standard-object)
  ((kar :accessor kar :initarg :kar)
   (kdr :accessor kdr :initarg :kdr))) 

(defun kons (x y) (make-instance 'kons :kar x :kdr y))

(defun lyst (&rest xs) (loop :for x :in (reverse xs) :for tail := (kons x nil) :then (kons x tail) :finally (return tail)))

(defmethod sequence:iterator-endp ((seq kons) iterator limit from-end) (eq iterator limit))

(defmethod sequence:iterator-step ((s kons) iterator from-end) (if from-end (if (eq iterator s) SB-IMPL::*EXHAUSTED* (do* ((xs s (kdr xs))) ((eq (kdr xs) iterator) xs))) (kdr iterator)))

(defmethod sequence:iterator-element ((s kons) iterator) (kar iterator))

(defmethod (setf sequence:iterator-element) (o (s kons) iterator) (setf (kar iterator) o))

(defmethod sequence:iterator-index ((s kons) iterator) ;; FIXME: this sucks. (In my defence, it is the equivalent of the ;; Apple implementation in Dylan...) (do ((tail s (kdr tail)) (i 0 (1+ i))) ((null tail)) (when (eq tail iterator) (return i))))

(defmethod sequence:iterator-copy ((s kons) iterator) iterator)

(defmethod sequence:length ((s kons)) (do ((tail s (kdr tail)) (i 0 (1+ i))) ((null tail) i)))

(defun nthkdr (n kons) (do ((tail kons (kdr tail)) (i 0 (1+ i))) ((or (null tail) (= n i)) tail)))

(defun kons-last (kons &optional (n 1)) (do ((tail kons (kdr tail))) ((null (nthkdr n tail)) tail)))

(defmethod sequence:make-simple-sequence-iterator ((s kons) &key from-end (start 0) end) (if from-end (let* ((termination (if (= start 0) sb-impl::*exhausted* (nthkdr (1- start) s))) (init (if (<= (or end (length s)) start) termination (if end (kons-last s (- (length s) (1- end))) (kons-last s))))) (values init termination t)) (cond ((not end) (values (nthkdr start s) nil nil)) (t (let ((st (nthkdr start s))) (values st (nthkdr (- end start) st) nil))))))


(sequence:dosequence (e (lyst 0 1 2 3))
  (print e))
;>>  0 
;>>  1 
;>>  2 
;>>  3 
;=>  NIL


(map nil #'print (lyst 0 1 2 3))
;>>  0 
;>>  1 
;>>  2 
;>>  3 
;=>  NIL


(loop :for e :being :the :elements :in (lyst 0 1 2 3)
      :collect e)
;=>  (0 1 2 3)

(loop :for e :being :each :element :of (lyst 0 1 2 3) :collect e) ;=> (0 1 2 3)


 今回は、sbcl: Iterator Protocolを紹介してみました。

comments powered by Disqus