Iterators, sketch

iter.lisp

(defmacro ->> (obj &rest fns)
  (labels ((rec (ls acc)
             (if ls
                 (destructuring-bind (fst . rst) ls
                   (rec rst (if (listp fst)
                                (destructuring-bind (fn . args) fst
                                  `(,fn ,acc ,@args))
                                `(,fst ,acc))))
                 acc)))
    (rec fns obj)))

(define-condition iterator-end (condition)
  ())

(defmacro catch-iter-end (form)
  `(handler-case ,form
     (iterator-end (err)
       err)))

(defmacro iter-stop ()
  `(signal 'iterator-end))

(defclass iter ()
  ())

(defclass iter-list (iter)
  ((seq :type list
        :accessor seq
        :initarg :seq)))

(defmethod iter ((seq list))
  (make-instance 'iter-list :seq seq))

(defmethod next ((iter iter-list))
  (with-slots (seq) iter
    (if (null seq)
        (error 'iterator-end)
        (prog1 (first seq)
          (setf seq (rest seq))))))



(defclass iter-vec (iter)
  ((seq :type vector
        :accessor seq
        :initarg :seq)
   (ind :type integer
        :accessor ind
        :initform 0
        :initarg :ind)))


(defmethod iter ((seq vector))
  (make-instance 'iter-vec :seq seq))

(defmethod next ((iter iter-vec))
  (with-slots (seq ind) iter
    (if (< ind (length seq))
        (prog1 (aref seq ind)
          (incf ind))
        (iter-stop))))

(defclass map-lazy (iter)
  ((fn :type function
       :accessor fn
       :initarg :fn)
   (it :type iter
       :accessor it
       :initarg :it)))


(defmethod map-lazy ((it iter) (fn function))
  (make-instance 'map-lazy :fn fn :it it))


(defmethod next ((map map-lazy))
  (with-slots (fn it) map
    (multiple-value-call fn (next it))))


(defmacro doit ((vars it) &body body)
  (let ((iter (gensym "IT")))
    `(let ((,iter ,it))
       (loop :until
             (typep (catch-iter-end (multiple-value-bind ,vars (next ,iter))
                                   ,@body)
                    'iterator-end)))))




(defmethod collect ((it iter) (with function) (type (eql 'vector)))
  (let ((res (make-array 0 :adjustable t :fill-pointer 0)))
    (loop (let ((val (catch-iter-end (multiple-value-call with (next it)))))
            (if (typep val 'iterator-end)
                (return)
                (vector-push-extend val res))))
    res))

(defmethod collect ((it iter) (with function) (type (eql 'list)))
  (loop :for val := (catch-iter-end (multiple-value-call with (next it)))
        :until (typep val 'iterator-end)
        :collect val))


(defmethod for-each ((it iter) (fn function))
  (loop :until (typep
                (catch-iter-end (multiple-value-call fn (next it)))
                'iterator-end)))



(defmethod fold ((it iter) init (fn function))
  (loop (let ((val (catch-iter-end (multiple-value-call fn init (next it)))))
          (if (typep val 'iterator-end)
              (return init)
              (setf init val)))))


(defmethod find-it ((it iter) (fn function))
  (loop (let ((ls (multiple-value-list (next it))))
          (when (apply fn ls)
            (return (values-list ls))))))



(defclass repeater (iter)
  ((item :accessor item
         :initarg :item)))

(defmethod repeat ((item t))
  (make-instance 'repeater :item item))

(defmethod next ((iter repeater))
  (item iter))


(defclass scan-lazy (iter)
  ((state :accessor state
          :initarg :state)
   (fn :type function
       :accessor fn
       :initarg :fn)))

(defmethod scan-lazy ((init t) (fn function))
  (make-instance 'scan-lazy :state init :fn fn))


(defmethod next ((scan scan-lazy))
  (let ((ret (state scan)))
    (setf (state scan) (funcall (fn scan) ret))
    ret))



(defclass take-lazy (iter)
  ((n :type integer
      :accessor n
      :initarg :n
      :initform 0)
   (lim :type integer
        :accessor lim
        :initarg :lim)
   (it :type iter
       :accessor it
       :initarg :it)))


(defmethod take-lazy ((it iter) (lim integer))
  (make-instance 'take-lazy :lim lim :it it))

(defmethod next ((take take-lazy))
  (with-slots (n lim it) take
    (if (< n lim)
        (multiple-value-prog1 (next it)
          (incf n))
        (iter-stop))))



(defclass take-while-lazy (iter)
  ((pred :type function
         :accessor pred
         :initarg :pred)
   (it :type iter
       :accessor it
       :initarg :it)))


(defmethod take-while-lazy ((it iter) (pred function))
  (make-instance 'take-while-lazy :pred pred :it it))

(defmethod next ((take take-while-lazy))
  (with-slots (pred it done) take
    (let ((ls (multiple-value-list (next it))))
      (if (apply pred ls)
          (values-list ls)
          (iter-stop)))))



(defclass filter-lazy (iter)
  ((it :type iter
       :accessor it
       :initarg :it)
   (fn :type function
       :accessor fn
       :initarg :fn)))

(defmethod filter-lazy ((it iter) (fn function))
  (make-instance 'filter-lazy :it it :fn fn))

(defmethod next ((filter filter-lazy))
  (with-slots (it fn) filter
    (loop (let ((ls (multiple-value-list (next it))))
            (when (apply fn ls)
              (return (values-list ls)))))))


(defclass enumerate (iter)
  ((it :type iter
       :accessor it
       :initarg :it)
   (ind :type integer
        :accessor ind
        :initform 0)))


(defmethod enumerate ((it iter))
  (make-instance 'enumerate :it it))

(defmethod next ((enum enumerate))
  (with-slots (it ind) enum
    (let ((i ind))
      (incf ind)
      (multiple-value-call #'values i (next it)))))

(defclass range (iter)
  ((from :type integer
         :accessor from
         :initarg :from)
   (to :type (or null integer)
       :accessor to
       :initarg :to)
   (stp :type integer
        :accessor stp
        :initarg :stp
        :initform 1)))

(defmethod range ((from integer) &key to (stp 1))
  (make-instance 'range :from from :to to :stp stp))

(defmethod next ((rn range))
  (with-slots (from to stp) rn
    (if to
        (if (< from to)
            (prog1 from
              (incf from stp))
            (iter-stop))
        (prog1 from
          (incf from stp)))))


(defclass zip-lazy (iter)
  ((fit :type iter
        :accessor fit
        :initarg :fit)
   (sit :type iter
        :accessor sit
        :initarg :sit)))

(defmethod zip-lazy ((fit iter) (sit iter))
  (make-instance 'zip-lazy :fit fit :sit sit))


(defmethod next ((zip zip-lazy))
  (with-slots (fit sit) zip
    (multiple-value-call #'values (next fit) (next sit))))

(defclass lines (iter)
  ((stream :type stream
           :initarg :stream)))

(defmethod lines ((stream stream))
  (make-instance 'lines :stream stream))


(defmethod next ((ln lines))
  (with-slots (stream) ln
    (or (read-line stream nil nil)
        (iter-stop))))