iter.ss

(library (iter (1))
         (export range iter-through-list iter-through-vector
                 loop map fold filter
                 collect-into-list collect-into-vector)
         (import (except (rnrs base (6)) map)
                 (only (rnrs r5rs (6)) inexact->exact)
                 (rnrs control (6))
                 (rnrs mutable-pairs (6))
                 (rnrs arithmetic fixnums (6)))
;; (iter 'next acc) => (values val iter/end?)
;; with NEXT message, each iterator consumes an maybe usable accumulator, the
;; first result of the iterator VAL is the value if the second result ITER/END?
;; is not #f, and the second result ITER/END? would be the next iterator.

;; (iter 'count) => count
;; with COUNT message, each iterator returns the number of rest values if
;; possible, or #f.

;; (iter . args) => #f

;;; iters

;; (range x) = (range 0 x 1)
;; (range x y) = (range x y 1)
;; (range x y z) returns an iterator iterate from x to y by z, the iterator
;; consumes 'next and 'count
(define range
  (case-lambda
    ((x) (range 0 x 1))
    ((x y) (range x y 1))
    ((x y z)
     (define cmp (if (< z 0) > <))
     (case-lambda
       ((message unused)
        (cond
          ((eq? 'next message)
           (if (cmp x y)
               (values x (range (+ x z) y z))
               (values 0 #f)))))
       ((message)
        (cond
          ((eq? 'count message)
           (inexact->exact (floor (/ (- y x) z))))))
       ((message . args) #f)))))

;; (iter-through-list list) returns a iterator consumes 'next
(define (iter-through-list list)
  (case-lambda
    ((message acc)
     (cond ((eq? 'next message)
            (if (null? list)
                (values 0 #f)
                (values (car list) (iter-through-list (cdr list)))))))
    ((message . args) #f)))

;; (iter-through-vector vec)
;; (iter-through-vector vec from to) returns a iterator consumes 'next and
;; 'count
(define iter-through-vector
  (case-lambda
    ((vec)
     (iter-through-vector vec 0 (vector-length vec)))
    ((vec from to)
     (let ((len (vector-length vec)))
       (when (> to len)
         (set! to len))
       (case-lambda
         ((message unused)
          (cond ((eq? 'next message)
                 (if (< from to)
                     (values
                       (vector-ref vec from)
                       (iter-through-vector vec (+ 1 from) to))
                     (values 0 #f)))))
         ((message)
          (cond ((eq? 'count message)
                 (- to from))))
         ((message . args) #f))))))

;;; iter utilities

;; (loop init iter body [make-result])
;; init : any
;; iter : iter
;; body : (lambda (acc val) (values next-acc break?))
;; make-result : (lambda (x) y)
;; LOOP iterate through the iterator ITER by executing BODY, returns what
;; MAKE-RESULT return.
;; INIT could be any value, which is the ACC in BODY for the first ITERATION.
;; BODY consumes the accumulator and what ITER produce, stop the loop if BREAK?
;; is symbol 'break.
;; MAKE-RESULT consumes INIT or NEXT-ACC to build the result of the whole LOOP,
;; MAKE-RESULT default to be (lambda (x) '())
(define loop
  (case-lambda
    ((x iter body)
     (loop x iter body (lambda (x) '())))
    ((x iter body make-res)
     (call-with-values
       (lambda ()
         (iter 'next x))
       (lambda (y iter)
         (if iter
             (call-with-values
               (lambda () (body x y))
               (lambda (z ctn?)
                 (if (not (eq? ctn? 'break))
                     (loop z iter body make-res)
                     (make-res z))))
             (make-res x)))))))

;; returns a new iterator map the original iterator through F
(define (map f iter)
  (case-lambda
    ((message acc)
     (if (eq? 'next message)
         (call-with-values
           (lambda () (iter 'next acc))
           (lambda (x iter)
             (if iter
                 (values (f x) (map f iter))
                 (values 0 iter))))))
    ((message . args)
     (apply iter message args))))

(define (fold init f iter)
  (loop init iter
    (lambda (acc val)
      (values (f acc val) 'go-on))
    values))

;; returns a new iterator filter the original iterator through F
(define (filter f iter)
  (define (next iter acc)
    (call-with-values
      (lambda () (iter 'next acc))
      (lambda (val iter)
        (if iter
            (if (f val)
                (values val (filter f iter))
                (next iter acc))
            (values 0 iter)))))
  (case-lambda
    ((message acc)
     (cond ((eq? 'next message)
            (next iter acc))))
    ((message)
     (cond ((eq? 'count message) #f)))
    ((message . args)
     (apply iter message args))))

;; convert an iterator to list
(define (collect-into-list iter)
  (let* ((head (cons 0 '()))
         (tail head)) 
    (loop tail iter
      (lambda (tail val)
        (set-cdr! tail (cons val '()))
        (values (cdr tail) 'go-on))
      (lambda (tail)
        (cdr head)))))

;; convert an iterator to vector
(define (collect-into-vector iter)
  (let ((len (iter 'count)))
    (if (fixnum? len)
        (let ((res (make-vector len)))
          (loop 0 iter
            (lambda (i val)
              (vector-set! res i val)
              (values (+ 1 i) 'go-on))
            (lambda (unused) res)))
        (let ((res (collect-into-list iter)))
          (list->vector res)))))
) ; library